pexpr.pas 134 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Does parsing of expression for Free Pascal
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit pexpr;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. symtype,symdef,symbase,
  22. node,ncal,
  23. tokens,globtype,globals,constexp;
  24. { reads a whole expression }
  25. function expr(dotypecheck:boolean) : tnode;
  26. { reads an expression without assignements and .. }
  27. function comp_expr(accept_equal,typeonly:boolean):tnode;
  28. { reads a single factor }
  29. function factor(getaddr,typeonly:boolean) : tnode;
  30. procedure string_dec(var def: tdef; allowtypedef: boolean);
  31. function parse_paras(__colon,__namedpara : boolean;end_of_paras : ttoken) : tnode;
  32. { the ID token has to be consumed before calling this function }
  33. procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags);
  34. function get_intconst:TConstExprInt;
  35. function get_stringconst:string;
  36. { Does some postprocessing for a generic type (especially when nested types
  37. of the specialization are used) }
  38. procedure post_comp_expr_gendef(var def: tdef);
  39. implementation
  40. uses
  41. { common }
  42. cutils,
  43. { global }
  44. verbose,
  45. systems,widestr,
  46. { symtable }
  47. symconst,symtable,symsym,defutil,defcmp,
  48. { module }
  49. fmodule,ppu,
  50. { pass 1 }
  51. pass_1,htypechk,
  52. nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
  53. { parser }
  54. scanner,
  55. pbase,pinline,ptype,pgenutil,
  56. { codegen }
  57. cgbase,procinfo,cpuinfo
  58. ;
  59. { sub_expr(opmultiply) is need to get -1 ** 4 to be
  60. read as - (1**4) and not (-1)**4 PM }
  61. type
  62. Toperator_precedence=(opcompare,opaddition,opmultiply,oppower);
  63. const
  64. highest_precedence = oppower;
  65. function sub_expr(pred_level:Toperator_precedence;accept_equal,typeonly:boolean;factornode:tnode):tnode;forward;
  66. const
  67. { true, if the inherited call is anonymous }
  68. anon_inherited : boolean = false;
  69. { last def found, only used by anon. inherited calls to insert proper type casts }
  70. srdef : tdef = nil;
  71. procedure string_dec(var def:tdef; allowtypedef: boolean);
  72. { reads a string type with optional length }
  73. { and returns a pointer to the string }
  74. { definition }
  75. var
  76. p : tnode;
  77. begin
  78. def:=cshortstringtype;
  79. consume(_STRING);
  80. if token=_LECKKLAMMER then
  81. begin
  82. if not(allowtypedef) then
  83. Message(parser_e_no_local_para_def);
  84. consume(_LECKKLAMMER);
  85. p:=comp_expr(true,false);
  86. if not is_constintnode(p) then
  87. begin
  88. Message(parser_e_illegal_expression);
  89. { error recovery }
  90. consume(_RECKKLAMMER);
  91. end
  92. else
  93. begin
  94. if (tordconstnode(p).value<=0) then
  95. begin
  96. Message(parser_e_invalid_string_size);
  97. tordconstnode(p).value:=255;
  98. end;
  99. if tordconstnode(p).value>255 then
  100. begin
  101. { longstring is currently unsupported (CEC)! }
  102. { t:=tstringdef.createlong(tordconstnode(p).value))}
  103. Message(parser_e_invalid_string_size);
  104. tordconstnode(p).value:=255;
  105. def:=tstringdef.createshort(int64(tordconstnode(p).value));
  106. end
  107. else
  108. if tordconstnode(p).value<>255 then
  109. def:=tstringdef.createshort(int64(tordconstnode(p).value));
  110. consume(_RECKKLAMMER);
  111. end;
  112. p.free;
  113. end
  114. else
  115. begin
  116. if cs_ansistrings in current_settings.localswitches then
  117. def:=getansistringdef
  118. else
  119. def:=cshortstringtype;
  120. end;
  121. end;
  122. function parse_paras(__colon,__namedpara : boolean;end_of_paras : ttoken) : tnode;
  123. var
  124. p1,p2,argname : tnode;
  125. prev_in_args,
  126. old_named_args_allowed,
  127. old_allow_array_constructor : boolean;
  128. begin
  129. if token=end_of_paras then
  130. begin
  131. parse_paras:=nil;
  132. exit;
  133. end;
  134. { save old values }
  135. prev_in_args:=in_args;
  136. old_allow_array_constructor:=allow_array_constructor;
  137. old_named_args_allowed:=named_args_allowed;
  138. { set para parsing values }
  139. in_args:=true;
  140. named_args_allowed:=false;
  141. allow_array_constructor:=true;
  142. p2:=nil;
  143. repeat
  144. if __namedpara then
  145. begin
  146. if token=_COMMA then
  147. begin
  148. { empty parameter }
  149. p2:=ccallparanode.create(cnothingnode.create,p2);
  150. end
  151. else
  152. begin
  153. named_args_allowed:=true;
  154. p1:=comp_expr(true,false);
  155. named_args_allowed:=false;
  156. if found_arg_name then
  157. begin
  158. argname:=p1;
  159. p1:=comp_expr(true,false);
  160. p2:=ccallparanode.create(p1,p2);
  161. tcallparanode(p2).parametername:=argname;
  162. end
  163. else
  164. p2:=ccallparanode.create(p1,p2);
  165. found_arg_name:=false;
  166. end;
  167. end
  168. else
  169. begin
  170. p1:=comp_expr(true,false);
  171. p2:=ccallparanode.create(p1,p2);
  172. end;
  173. { it's for the str(l:5,s); }
  174. if __colon and (token=_COLON) then
  175. begin
  176. consume(_COLON);
  177. p1:=comp_expr(true,false);
  178. p2:=ccallparanode.create(p1,p2);
  179. include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
  180. if try_to_consume(_COLON) then
  181. begin
  182. p1:=comp_expr(true,false);
  183. p2:=ccallparanode.create(p1,p2);
  184. include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
  185. end
  186. end;
  187. until not try_to_consume(_COMMA);
  188. allow_array_constructor:=old_allow_array_constructor;
  189. in_args:=prev_in_args;
  190. named_args_allowed:=old_named_args_allowed;
  191. parse_paras:=p2;
  192. end;
  193. function gen_c_style_operator(ntyp:tnodetype;p1,p2:tnode) : tnode;
  194. var
  195. hp : tnode;
  196. hdef : tdef;
  197. temp : ttempcreatenode;
  198. newstatement : tstatementnode;
  199. begin
  200. { Properties are not allowed, because the write can
  201. be different from the read }
  202. if (nf_isproperty in p1.flags) then
  203. begin
  204. Message(type_e_variable_id_expected);
  205. { We can continue with the loading,
  206. it'll not create errors. Only the expected
  207. result can be wrong }
  208. end;
  209. hp:=p1;
  210. while assigned(hp) and
  211. (hp.nodetype in [derefn,subscriptn,vecn,typeconvn]) do
  212. hp:=tunarynode(hp).left;
  213. if not assigned(hp) then
  214. internalerror(200410121);
  215. if (hp.nodetype=calln) then
  216. begin
  217. typecheckpass(p1);
  218. result:=internalstatements(newstatement);
  219. hdef:=tpointerdef.create(p1.resultdef);
  220. temp:=ctempcreatenode.create(hdef,sizeof(pint),tt_persistent,false);
  221. addstatement(newstatement,temp);
  222. addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(temp),caddrnode.create_internal(p1)));
  223. addstatement(newstatement,cassignmentnode.create(
  224. cderefnode.create(ctemprefnode.create(temp)),
  225. caddnode.create(ntyp,
  226. cderefnode.create(ctemprefnode.create(temp)),
  227. p2)));
  228. addstatement(newstatement,ctempdeletenode.create(temp));
  229. end
  230. else
  231. result:=cassignmentnode.create(p1,caddnode.create(ntyp,p1.getcopy,p2));
  232. end;
  233. function statement_syssym(l : byte) : tnode;
  234. var
  235. p1,p2,paras : tnode;
  236. err,
  237. prev_in_args : boolean;
  238. def : tdef;
  239. begin
  240. prev_in_args:=in_args;
  241. case l of
  242. in_new_x :
  243. begin
  244. if afterassignment or in_args then
  245. statement_syssym:=new_function
  246. else
  247. statement_syssym:=new_dispose_statement(true);
  248. end;
  249. in_dispose_x :
  250. begin
  251. statement_syssym:=new_dispose_statement(false);
  252. end;
  253. in_ord_x :
  254. begin
  255. consume(_LKLAMMER);
  256. in_args:=true;
  257. p1:=comp_expr(true,false);
  258. consume(_RKLAMMER);
  259. p1:=geninlinenode(in_ord_x,false,p1);
  260. statement_syssym := p1;
  261. end;
  262. in_exit :
  263. begin
  264. if try_to_consume(_LKLAMMER) then
  265. begin
  266. if not (m_mac in current_settings.modeswitches) then
  267. begin
  268. if not(try_to_consume(_RKLAMMER)) then
  269. begin
  270. p1:=comp_expr(true,false);
  271. consume(_RKLAMMER);
  272. if (not assigned(current_procinfo) or
  273. is_void(current_procinfo.procdef.returndef)) then
  274. begin
  275. Message(parser_e_void_function);
  276. { recovery }
  277. p1.free;
  278. p1:=nil;
  279. end;
  280. end
  281. else
  282. p1:=nil;
  283. end
  284. else
  285. begin
  286. if not (current_procinfo.procdef.procsym.name = pattern) then
  287. Message(parser_e_macpas_exit_wrong_param);
  288. consume(_ID);
  289. consume(_RKLAMMER);
  290. p1:=nil;
  291. end
  292. end
  293. else
  294. p1:=nil;
  295. statement_syssym:=cexitnode.create(p1);
  296. end;
  297. in_break :
  298. begin
  299. statement_syssym:=cbreaknode.create
  300. end;
  301. in_continue :
  302. begin
  303. statement_syssym:=ccontinuenode.create
  304. end;
  305. in_leave :
  306. begin
  307. if m_mac in current_settings.modeswitches then
  308. statement_syssym:=cbreaknode.create
  309. else
  310. begin
  311. Message1(sym_e_id_not_found, orgpattern);
  312. statement_syssym:=cerrornode.create;
  313. end;
  314. end;
  315. in_cycle :
  316. begin
  317. if m_mac in current_settings.modeswitches then
  318. statement_syssym:=ccontinuenode.create
  319. else
  320. begin
  321. Message1(sym_e_id_not_found, orgpattern);
  322. statement_syssym:=cerrornode.create;
  323. end;
  324. end;
  325. in_typeof_x :
  326. begin
  327. consume(_LKLAMMER);
  328. in_args:=true;
  329. p1:=comp_expr(true,false);
  330. consume(_RKLAMMER);
  331. if p1.nodetype=typen then
  332. ttypenode(p1).allowed:=true;
  333. { Allow classrefdef, which is required for
  334. Typeof(self) in static class methods }
  335. if not(is_objc_class_or_protocol(p1.resultdef)) and
  336. ((p1.resultdef.typ = objectdef) or
  337. (assigned(current_procinfo) and
  338. ((po_classmethod in current_procinfo.procdef.procoptions) or
  339. (po_staticmethod in current_procinfo.procdef.procoptions)) and
  340. (p1.resultdef.typ=classrefdef))) then
  341. statement_syssym:=geninlinenode(in_typeof_x,false,p1)
  342. else
  343. begin
  344. Message(parser_e_class_id_expected);
  345. p1.destroy;
  346. statement_syssym:=cerrornode.create;
  347. end;
  348. end;
  349. in_sizeof_x,
  350. in_bitsizeof_x :
  351. begin
  352. consume(_LKLAMMER);
  353. in_args:=true;
  354. p1:=comp_expr(true,false);
  355. consume(_RKLAMMER);
  356. if ((p1.nodetype<>typen) and
  357. (
  358. (is_object(p1.resultdef) and
  359. (oo_has_constructor in tobjectdef(p1.resultdef).objectoptions)) or
  360. is_open_array(p1.resultdef) or
  361. is_array_of_const(p1.resultdef) or
  362. is_open_string(p1.resultdef)
  363. )) or
  364. { keep the function call if it is a type parameter to avoid arithmetic errors due to constant folding }
  365. (p1.resultdef.typ=undefineddef) then
  366. begin
  367. statement_syssym:=geninlinenode(in_sizeof_x,false,p1);
  368. { no packed bit support for these things }
  369. if l=in_bitsizeof_x then
  370. statement_syssym:=caddnode.create(muln,statement_syssym,cordconstnode.create(8,sinttype,true));
  371. end
  372. else
  373. begin
  374. { allow helpers for SizeOf and BitSizeOf }
  375. if p1.nodetype=typen then
  376. ttypenode(p1).helperallowed:=true;
  377. if (p1.resultdef.typ=forwarddef) then
  378. Message1(type_e_type_is_not_completly_defined,tforwarddef(p1.resultdef).tosymname^);
  379. if (l = in_sizeof_x) or
  380. (not((p1.nodetype = vecn) and
  381. is_packed_array(tvecnode(p1).left.resultdef)) and
  382. not((p1.nodetype = subscriptn) and
  383. is_packed_record_or_object(tsubscriptnode(p1).left.resultdef))) then
  384. begin
  385. statement_syssym:=cordconstnode.create(p1.resultdef.size,sinttype,true);
  386. if (l = in_bitsizeof_x) then
  387. statement_syssym:=caddnode.create(muln,statement_syssym,cordconstnode.create(8,sinttype,true));
  388. end
  389. else
  390. statement_syssym:=cordconstnode.create(p1.resultdef.packedbitsize,sinttype,true);
  391. { p1 not needed !}
  392. p1.destroy;
  393. end;
  394. end;
  395. in_typeinfo_x,
  396. in_objc_encode_x :
  397. begin
  398. if (l=in_typeinfo_x) or
  399. (m_objectivec1 in current_settings.modeswitches) then
  400. begin
  401. consume(_LKLAMMER);
  402. in_args:=true;
  403. p1:=comp_expr(true,false);
  404. { When reading a class type it is parsed as loadvmtaddrn,
  405. typeinfo only needs the type so we remove the loadvmtaddrn }
  406. if p1.nodetype=loadvmtaddrn then
  407. begin
  408. p2:=tloadvmtaddrnode(p1).left;
  409. tloadvmtaddrnode(p1).left:=nil;
  410. p1.free;
  411. p1:=p2;
  412. end;
  413. if p1.nodetype=typen then
  414. begin
  415. ttypenode(p1).allowed:=true;
  416. { allow helpers for TypeInfo }
  417. if l=in_typeinfo_x then
  418. ttypenode(p1).helperallowed:=true;
  419. end;
  420. { else
  421. begin
  422. p1.destroy;
  423. p1:=cerrornode.create;
  424. Message(parser_e_illegal_parameter_list);
  425. end;}
  426. consume(_RKLAMMER);
  427. p2:=geninlinenode(l,false,p1);
  428. statement_syssym:=p2;
  429. end
  430. else
  431. begin
  432. Message1(sym_e_id_not_found, orgpattern);
  433. statement_syssym:=cerrornode.create;
  434. end;
  435. end;
  436. in_unaligned_x :
  437. begin
  438. err:=false;
  439. consume(_LKLAMMER);
  440. in_args:=true;
  441. p1:=comp_expr(true,false);
  442. p2:=ccallparanode.create(p1,nil);
  443. p2:=geninlinenode(in_unaligned_x,false,p2);
  444. consume(_RKLAMMER);
  445. statement_syssym:=p2;
  446. end;
  447. in_assigned_x :
  448. begin
  449. err:=false;
  450. consume(_LKLAMMER);
  451. in_args:=true;
  452. p1:=comp_expr(true,false);
  453. { When reading a class type it is parsed as loadvmtaddrn,
  454. typeinfo only needs the type so we remove the loadvmtaddrn }
  455. if p1.nodetype=loadvmtaddrn then
  456. begin
  457. p2:=tloadvmtaddrnode(p1).left;
  458. tloadvmtaddrnode(p1).left:=nil;
  459. p1.free;
  460. p1:=p2;
  461. end;
  462. if not codegenerror then
  463. begin
  464. case p1.resultdef.typ of
  465. procdef, { procvar }
  466. pointerdef,
  467. procvardef,
  468. classrefdef : ;
  469. objectdef :
  470. if not is_implicit_pointer_object_type(p1.resultdef) then
  471. begin
  472. Message(parser_e_illegal_parameter_list);
  473. err:=true;
  474. end;
  475. arraydef :
  476. if not is_dynamic_array(p1.resultdef) then
  477. begin
  478. Message(parser_e_illegal_parameter_list);
  479. err:=true;
  480. end;
  481. else
  482. if p1.resultdef.typ<>undefineddef then
  483. begin
  484. Message(parser_e_illegal_parameter_list);
  485. err:=true;
  486. end;
  487. end;
  488. end
  489. else
  490. err:=true;
  491. if not err then
  492. begin
  493. p2:=ccallparanode.create(p1,nil);
  494. p2:=geninlinenode(in_assigned_x,false,p2);
  495. end
  496. else
  497. begin
  498. p1.free;
  499. p2:=cerrornode.create;
  500. end;
  501. consume(_RKLAMMER);
  502. statement_syssym:=p2;
  503. end;
  504. in_addr_x :
  505. begin
  506. consume(_LKLAMMER);
  507. in_args:=true;
  508. p1:=comp_expr(true,false);
  509. p1:=caddrnode.create(p1);
  510. consume(_RKLAMMER);
  511. statement_syssym:=p1;
  512. end;
  513. in_ofs_x :
  514. begin
  515. consume(_LKLAMMER);
  516. in_args:=true;
  517. p1:=comp_expr(true,false);
  518. p1:=caddrnode.create(p1);
  519. do_typecheckpass(p1);
  520. { Ofs() returns a cardinal/qword, not a pointer }
  521. p1.resultdef:=uinttype;
  522. consume(_RKLAMMER);
  523. statement_syssym:=p1;
  524. end;
  525. in_seg_x :
  526. begin
  527. consume(_LKLAMMER);
  528. in_args:=true;
  529. p1:=comp_expr(true,false);
  530. p1:=geninlinenode(in_seg_x,false,p1);
  531. consume(_RKLAMMER);
  532. statement_syssym:=p1;
  533. end;
  534. in_high_x,
  535. in_low_x :
  536. begin
  537. consume(_LKLAMMER);
  538. in_args:=true;
  539. p1:=comp_expr(true,false);
  540. p2:=geninlinenode(l,false,p1);
  541. consume(_RKLAMMER);
  542. statement_syssym:=p2;
  543. end;
  544. in_succ_x,
  545. in_pred_x :
  546. begin
  547. consume(_LKLAMMER);
  548. in_args:=true;
  549. p1:=comp_expr(true,false);
  550. p2:=geninlinenode(l,false,p1);
  551. consume(_RKLAMMER);
  552. statement_syssym:=p2;
  553. end;
  554. in_inc_x,
  555. in_dec_x :
  556. begin
  557. consume(_LKLAMMER);
  558. in_args:=true;
  559. p1:=comp_expr(true,false);
  560. if try_to_consume(_COMMA) then
  561. p2:=ccallparanode.create(comp_expr(true,false),nil)
  562. else
  563. p2:=nil;
  564. p2:=ccallparanode.create(p1,p2);
  565. statement_syssym:=geninlinenode(l,false,p2);
  566. consume(_RKLAMMER);
  567. end;
  568. in_slice_x:
  569. begin
  570. if not(in_args) then
  571. begin
  572. message(parser_e_illegal_slice);
  573. consume(_LKLAMMER);
  574. in_args:=true;
  575. comp_expr(true,false).free;
  576. if try_to_consume(_COMMA) then
  577. comp_expr(true,false).free;
  578. statement_syssym:=cerrornode.create;
  579. consume(_RKLAMMER);
  580. end
  581. else
  582. begin
  583. consume(_LKLAMMER);
  584. in_args:=true;
  585. p1:=comp_expr(true,false);
  586. Consume(_COMMA);
  587. if not(codegenerror) then
  588. p2:=ccallparanode.create(comp_expr(true,false),nil)
  589. else
  590. p2:=cerrornode.create;
  591. p2:=ccallparanode.create(p1,p2);
  592. statement_syssym:=geninlinenode(l,false,p2);
  593. consume(_RKLAMMER);
  594. end;
  595. end;
  596. in_initialize_x:
  597. begin
  598. statement_syssym:=inline_initialize;
  599. end;
  600. in_finalize_x:
  601. begin
  602. statement_syssym:=inline_finalize;
  603. end;
  604. in_copy_x:
  605. begin
  606. statement_syssym:=inline_copy;
  607. end;
  608. in_concat_x :
  609. begin
  610. consume(_LKLAMMER);
  611. in_args:=true;
  612. { Translate to x:=x+y[+z]. The addnode will do the
  613. type checking }
  614. p2:=nil;
  615. repeat
  616. p1:=comp_expr(true,false);
  617. if p2<>nil then
  618. p2:=caddnode.create(addn,p2,p1)
  619. else
  620. begin
  621. { Force string type if it isn't yet }
  622. if not(
  623. (p1.resultdef.typ=stringdef) or
  624. is_chararray(p1.resultdef) or
  625. is_char(p1.resultdef)
  626. ) then
  627. inserttypeconv(p1,cshortstringtype);
  628. p2:=p1;
  629. end;
  630. until not try_to_consume(_COMMA);
  631. consume(_RKLAMMER);
  632. statement_syssym:=p2;
  633. end;
  634. in_read_x,
  635. in_readln_x,
  636. in_readstr_x:
  637. begin
  638. if try_to_consume(_LKLAMMER) then
  639. begin
  640. paras:=parse_paras(false,false,_RKLAMMER);
  641. consume(_RKLAMMER);
  642. end
  643. else
  644. paras:=nil;
  645. p1:=geninlinenode(l,false,paras);
  646. statement_syssym := p1;
  647. end;
  648. in_setlength_x:
  649. begin
  650. statement_syssym := inline_setlength;
  651. end;
  652. in_objc_selector_x:
  653. begin
  654. if (m_objectivec1 in current_settings.modeswitches) then
  655. begin
  656. consume(_LKLAMMER);
  657. in_args:=true;
  658. { don't turn procsyms into calls (getaddr = true) }
  659. p1:=factor(true,false);
  660. p2:=geninlinenode(l,false,p1);
  661. consume(_RKLAMMER);
  662. statement_syssym:=p2;
  663. end
  664. else
  665. begin
  666. Message1(sym_e_id_not_found, orgpattern);
  667. statement_syssym:=cerrornode.create;
  668. end;
  669. end;
  670. in_length_x:
  671. begin
  672. consume(_LKLAMMER);
  673. in_args:=true;
  674. p1:=comp_expr(true,false);
  675. p2:=geninlinenode(l,false,p1);
  676. consume(_RKLAMMER);
  677. statement_syssym:=p2;
  678. end;
  679. in_write_x,
  680. in_writeln_x,
  681. in_writestr_x :
  682. begin
  683. if try_to_consume(_LKLAMMER) then
  684. begin
  685. paras:=parse_paras(true,false,_RKLAMMER);
  686. consume(_RKLAMMER);
  687. end
  688. else
  689. paras:=nil;
  690. p1 := geninlinenode(l,false,paras);
  691. statement_syssym := p1;
  692. end;
  693. in_str_x_string :
  694. begin
  695. consume(_LKLAMMER);
  696. paras:=parse_paras(true,false,_RKLAMMER);
  697. consume(_RKLAMMER);
  698. p1 := geninlinenode(l,false,paras);
  699. statement_syssym := p1;
  700. end;
  701. in_val_x:
  702. Begin
  703. consume(_LKLAMMER);
  704. in_args := true;
  705. p1:= ccallparanode.create(comp_expr(true,false), nil);
  706. consume(_COMMA);
  707. p2 := ccallparanode.create(comp_expr(true,false),p1);
  708. if try_to_consume(_COMMA) then
  709. p2 := ccallparanode.create(comp_expr(true,false),p2);
  710. consume(_RKLAMMER);
  711. p2 := geninlinenode(l,false,p2);
  712. statement_syssym := p2;
  713. End;
  714. in_include_x_y,
  715. in_exclude_x_y :
  716. begin
  717. consume(_LKLAMMER);
  718. in_args:=true;
  719. p1:=comp_expr(true,false);
  720. consume(_COMMA);
  721. p2:=comp_expr(true,false);
  722. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
  723. consume(_RKLAMMER);
  724. end;
  725. in_pack_x_y_z,
  726. in_unpack_x_y_z :
  727. begin
  728. consume(_LKLAMMER);
  729. in_args:=true;
  730. p1:=comp_expr(true,false);
  731. consume(_COMMA);
  732. p2:=comp_expr(true,false);
  733. consume(_COMMA);
  734. paras:=comp_expr(true,false);
  735. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,ccallparanode.create(paras,nil))));
  736. consume(_RKLAMMER);
  737. end;
  738. in_assert_x_y :
  739. begin
  740. consume(_LKLAMMER);
  741. in_args:=true;
  742. p1:=comp_expr(true,false);
  743. if try_to_consume(_COMMA) then
  744. p2:=comp_expr(true,false)
  745. else
  746. begin
  747. { then insert an empty string }
  748. p2:=cstringconstnode.createstr('');
  749. end;
  750. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
  751. consume(_RKLAMMER);
  752. end;
  753. in_get_frame:
  754. begin
  755. statement_syssym:=geninlinenode(l,false,nil);
  756. end;
  757. (*
  758. in_get_caller_frame:
  759. begin
  760. if try_to_consume(_LKLAMMER) then
  761. begin
  762. {You used to call get_caller_frame as get_caller_frame(get_frame),
  763. however, as a stack frame may not exist, it does more harm than
  764. good, so ignore it.}
  765. in_args:=true;
  766. p1:=comp_expr(true,false);
  767. p1.destroy;
  768. consume(_RKLAMMER);
  769. end;
  770. statement_syssym:=geninlinenode(l,false,nil);
  771. end;
  772. *)
  773. in_default_x:
  774. begin
  775. consume(_LKLAMMER);
  776. in_args:=true;
  777. def:=nil;
  778. single_type(def,[stoAllowSpecialization]);
  779. statement_syssym:=cerrornode.create;
  780. if def=generrordef then
  781. Message(type_e_type_id_expected)
  782. else
  783. if def.typ=forwarddef then
  784. Message1(type_e_type_is_not_completly_defined,tforwarddef(def).tosymname^)
  785. else
  786. begin
  787. statement_syssym.free;
  788. statement_syssym:=geninlinenode(in_default_x,false,ctypenode.create(def));
  789. end;
  790. { consume the right bracket here for a nicer error position }
  791. consume(_RKLAMMER);
  792. end;
  793. else
  794. internalerror(15);
  795. end;
  796. in_args:=prev_in_args;
  797. end;
  798. function maybe_load_methodpointer(st:TSymtable;var p1:tnode):boolean;
  799. begin
  800. maybe_load_methodpointer:=false;
  801. if not assigned(p1) then
  802. begin
  803. case st.symtabletype of
  804. withsymtable :
  805. begin
  806. if (st.defowner.typ=objectdef) then
  807. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  808. end;
  809. ObjectSymtable,
  810. recordsymtable:
  811. begin
  812. { We are calling from the static class method which has no self node }
  813. if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
  814. p1:=cloadvmtaddrnode.create(ctypenode.create(current_procinfo.procdef.struct))
  815. else
  816. p1:=load_self_node;
  817. { We are calling a member }
  818. maybe_load_methodpointer:=true;
  819. end;
  820. end;
  821. end;
  822. end;
  823. { reads the parameter for a subroutine call }
  824. procedure do_proc_call(sym:tsym;st:TSymtable;obj:tabstractrecorddef;getaddr:boolean;var again : boolean;var p1:tnode;callflags:tcallnodeflags);
  825. var
  826. membercall,
  827. prevafterassn : boolean;
  828. i : integer;
  829. para,p2 : tnode;
  830. currpara : tparavarsym;
  831. aprocdef : tprocdef;
  832. begin
  833. prevafterassn:=afterassignment;
  834. afterassignment:=false;
  835. membercall:=false;
  836. aprocdef:=nil;
  837. { when it is a call to a member we need to load the
  838. methodpointer first
  839. }
  840. membercall:=maybe_load_methodpointer(st,p1);
  841. { When we are expecting a procvar we also need
  842. to get the address in some cases }
  843. if assigned(getprocvardef) then
  844. begin
  845. if (block_type=bt_const) or
  846. getaddr then
  847. begin
  848. aprocdef:=Tprocsym(sym).Find_procdef_byprocvardef(getprocvardef);
  849. getaddr:=true;
  850. end
  851. else
  852. if ((m_tp_procvar in current_settings.modeswitches) or
  853. (m_mac_procvar in current_settings.modeswitches)) and
  854. not(token in [_CARET,_POINT,_LKLAMMER]) then
  855. begin
  856. aprocdef:=Tprocsym(sym).Find_procdef_byprocvardef(getprocvardef);
  857. if assigned(aprocdef) then
  858. getaddr:=true;
  859. end;
  860. end;
  861. { only need to get the address of the procedure? }
  862. if getaddr then
  863. begin
  864. { Retrieve info which procvar to call. For tp_procvar the
  865. aprocdef is already loaded above so we can reuse it }
  866. if not assigned(aprocdef) and
  867. assigned(getprocvardef) then
  868. aprocdef:=Tprocsym(sym).Find_procdef_byprocvardef(getprocvardef);
  869. { generate a methodcallnode or proccallnode }
  870. { we shouldn't convert things like @tcollection.load }
  871. p2:=cloadnode.create_procvar(sym,aprocdef,st);
  872. if assigned(p1) then
  873. begin
  874. { for loading methodpointer of an inherited function
  875. we use self as instance and load the address of
  876. the function directly and not through the vmt (PFV) }
  877. if (cnf_inherited in callflags) then
  878. begin
  879. include(tloadnode(p2).loadnodeflags,loadnf_inherited);
  880. p1.free;
  881. p1:=load_self_node;
  882. end;
  883. if (p1.nodetype<>typen) then
  884. tloadnode(p2).set_mp(p1)
  885. else
  886. p1.free;
  887. end;
  888. p1:=p2;
  889. { no postfix operators }
  890. again:=false;
  891. end
  892. else
  893. begin
  894. para:=nil;
  895. if anon_inherited then
  896. begin
  897. if not assigned(current_procinfo) then
  898. internalerror(200305054);
  899. for i:=0 to current_procinfo.procdef.paras.count-1 do
  900. begin
  901. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  902. if not(vo_is_hidden_para in currpara.varoptions) then
  903. begin
  904. { inheritance by msgint? }
  905. if assigned(srdef) then
  906. { anonymous inherited via msgid calls only require a var parameter for
  907. both methods, so we need some type casting here }
  908. para:=ccallparanode.create(ctypeconvnode.create_internal(ctypeconvnode.create_internal(
  909. cloadnode.create(currpara,currpara.owner),cformaltype),tparavarsym(tprocdef(srdef).paras[i]).vardef),
  910. para)
  911. else
  912. para:=ccallparanode.create(cloadnode.create(currpara,currpara.owner),para);
  913. end;
  914. end;
  915. end
  916. else
  917. begin
  918. if try_to_consume(_LKLAMMER) then
  919. begin
  920. para:=parse_paras(false,false,_RKLAMMER);
  921. consume(_RKLAMMER);
  922. end;
  923. end;
  924. { indicate if this call was generated by a member and
  925. no explicit self is used, this is needed to determine
  926. how to handle a destructor call (PFV) }
  927. if membercall then
  928. include(callflags,cnf_member_call);
  929. if assigned(obj) then
  930. begin
  931. if not (st.symtabletype in [ObjectSymtable,recordsymtable]) then
  932. internalerror(200310031);
  933. p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1,callflags);
  934. end
  935. else
  936. p1:=ccallnode.create(para,tprocsym(sym),st,p1,callflags);
  937. end;
  938. afterassignment:=prevafterassn;
  939. end;
  940. procedure handle_procvar(pv : tprocvardef;var p2 : tnode);
  941. var
  942. hp,hp2 : tnode;
  943. hpp : ^tnode;
  944. currprocdef : tprocdef;
  945. begin
  946. if not assigned(pv) then
  947. internalerror(200301121);
  948. if (m_tp_procvar in current_settings.modeswitches) or
  949. (m_mac_procvar in current_settings.modeswitches) then
  950. begin
  951. hp:=p2;
  952. hpp:=@p2;
  953. while assigned(hp) and
  954. (hp.nodetype=typeconvn) do
  955. begin
  956. hp:=ttypeconvnode(hp).left;
  957. { save orignal address of the old tree so we can replace the node }
  958. hpp:=@hp;
  959. end;
  960. if (hp.nodetype=calln) and
  961. { a procvar can't have parameters! }
  962. not assigned(tcallnode(hp).left) then
  963. begin
  964. currprocdef:=tcallnode(hp).symtableprocentry.Find_procdef_byprocvardef(pv);
  965. if assigned(currprocdef) then
  966. begin
  967. hp2:=cloadnode.create_procvar(tprocsym(tcallnode(hp).symtableprocentry),currprocdef,tcallnode(hp).symtableproc);
  968. if (po_methodpointer in pv.procoptions) then
  969. tloadnode(hp2).set_mp(tcallnode(hp).methodpointer.getcopy);
  970. hp.destroy;
  971. { replace the old callnode with the new loadnode }
  972. hpp^:=hp2;
  973. end;
  974. end;
  975. end;
  976. end;
  977. { checks whether sym is a static field and if so, translates the access
  978. to the appropriate node tree }
  979. function handle_staticfield_access(sym: tsym; nested: boolean; var p1: tnode): boolean;
  980. var
  981. static_name: shortstring;
  982. srsymtable: tsymtable;
  983. begin
  984. result:=false;
  985. { generate access code }
  986. if (sp_static in sym.symoptions) then
  987. begin
  988. result:=true;
  989. if not nested then
  990. static_name:=lower(sym.owner.name^)+'_'+sym.name
  991. else
  992. static_name:=lower(generate_nested_name(sym.owner,'_'))+'_'+sym.name;
  993. if sym.owner.defowner.typ=objectdef then
  994. searchsym_in_class(tobjectdef(sym.owner.defowner),tobjectdef(sym.owner.defowner),static_name,sym,srsymtable,true)
  995. else
  996. searchsym_in_record(trecorddef(sym.owner.defowner),static_name,sym,srsymtable);
  997. if assigned(sym) then
  998. check_hints(sym,sym.symoptions,sym.deprecatedmsg);
  999. p1.free;
  1000. p1:=nil;
  1001. { static syms are always stored as absolutevarsym to handle scope and storage properly }
  1002. propaccesslist_to_node(p1,nil,tabsolutevarsym(sym).ref);
  1003. end;
  1004. end;
  1005. { the following procedure handles the access to a property symbol }
  1006. procedure handle_propertysym(propsym : tpropertysym;st : TSymtable;var p1 : tnode);
  1007. var
  1008. paras : tnode;
  1009. p2 : tnode;
  1010. membercall : boolean;
  1011. callflags : tcallnodeflags;
  1012. propaccesslist : tpropaccesslist;
  1013. sym: tsym;
  1014. begin
  1015. { property parameters? read them only if the property really }
  1016. { has parameters }
  1017. paras:=nil;
  1018. if (ppo_hasparameters in propsym.propoptions) then
  1019. begin
  1020. if try_to_consume(_LECKKLAMMER) then
  1021. begin
  1022. paras:=parse_paras(false,false,_RECKKLAMMER);
  1023. consume(_RECKKLAMMER);
  1024. end;
  1025. end;
  1026. { indexed property }
  1027. if (ppo_indexed in propsym.propoptions) then
  1028. begin
  1029. p2:=cordconstnode.create(propsym.index,propsym.indexdef,true);
  1030. paras:=ccallparanode.create(p2,paras);
  1031. end;
  1032. { we need only a write property if a := follows }
  1033. { if not(afterassignment) and not(in_args) then }
  1034. if token=_ASSIGNMENT then
  1035. begin
  1036. if getpropaccesslist(propsym,palt_write,propaccesslist) then
  1037. begin
  1038. sym:=propaccesslist.firstsym^.sym;
  1039. case sym.typ of
  1040. procsym :
  1041. begin
  1042. callflags:=[];
  1043. { generate the method call }
  1044. membercall:=maybe_load_methodpointer(st,p1);
  1045. if membercall then
  1046. include(callflags,cnf_member_call);
  1047. p1:=ccallnode.create(paras,tprocsym(sym),st,p1,callflags);
  1048. addsymref(sym);
  1049. paras:=nil;
  1050. consume(_ASSIGNMENT);
  1051. { read the expression }
  1052. if propsym.propdef.typ=procvardef then
  1053. getprocvardef:=tprocvardef(propsym.propdef);
  1054. p2:=comp_expr(true,false);
  1055. if assigned(getprocvardef) then
  1056. handle_procvar(getprocvardef,p2);
  1057. tcallnode(p1).left:=ccallparanode.create(p2,tcallnode(p1).left);
  1058. { mark as property, both the tcallnode and the real call block }
  1059. include(p1.flags,nf_isproperty);
  1060. getprocvardef:=nil;
  1061. end;
  1062. fieldvarsym :
  1063. begin
  1064. { generate access code }
  1065. if not handle_staticfield_access(sym,false,p1) then
  1066. propaccesslist_to_node(p1,st,propaccesslist);
  1067. include(p1.flags,nf_isproperty);
  1068. consume(_ASSIGNMENT);
  1069. { read the expression }
  1070. p2:=comp_expr(true,false);
  1071. p1:=cassignmentnode.create(p1,p2);
  1072. end
  1073. else
  1074. begin
  1075. p1:=cerrornode.create;
  1076. Message(parser_e_no_procedure_to_access_property);
  1077. end;
  1078. end;
  1079. end
  1080. else
  1081. begin
  1082. p1:=cerrornode.create;
  1083. Message(parser_e_no_procedure_to_access_property);
  1084. end;
  1085. end
  1086. else
  1087. begin
  1088. if getpropaccesslist(propsym,palt_read,propaccesslist) then
  1089. begin
  1090. sym := propaccesslist.firstsym^.sym;
  1091. case sym.typ of
  1092. fieldvarsym :
  1093. begin
  1094. { generate access code }
  1095. if not handle_staticfield_access(sym,false,p1) then
  1096. propaccesslist_to_node(p1,st,propaccesslist);
  1097. include(p1.flags,nf_isproperty);
  1098. { catch expressions like "(propx):=1;" }
  1099. include(p1.flags,nf_no_lvalue);
  1100. end;
  1101. procsym :
  1102. begin
  1103. callflags:=[];
  1104. { generate the method call }
  1105. membercall:=maybe_load_methodpointer(st,p1);
  1106. if membercall then
  1107. include(callflags,cnf_member_call);
  1108. p1:=ccallnode.create(paras,tprocsym(sym),st,p1,callflags);
  1109. paras:=nil;
  1110. include(p1.flags,nf_isproperty);
  1111. include(p1.flags,nf_no_lvalue);
  1112. end
  1113. else
  1114. begin
  1115. p1:=cerrornode.create;
  1116. Message(type_e_mismatch);
  1117. end;
  1118. end;
  1119. end
  1120. else
  1121. begin
  1122. { error, no function to read property }
  1123. p1:=cerrornode.create;
  1124. Message(parser_e_no_procedure_to_access_property);
  1125. end;
  1126. end;
  1127. { release paras if not used }
  1128. if assigned(paras) then
  1129. paras.free;
  1130. end;
  1131. { the ID token has to be consumed before calling this function }
  1132. procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags);
  1133. var
  1134. isclassref:boolean;
  1135. begin
  1136. if sym=nil then
  1137. begin
  1138. { pattern is still valid unless
  1139. there is another ID just after the ID of sym }
  1140. Message1(sym_e_id_no_member,orgpattern);
  1141. p1.free;
  1142. p1:=cerrornode.create;
  1143. { try to clean up }
  1144. again:=false;
  1145. end
  1146. else
  1147. begin
  1148. if assigned(p1) then
  1149. begin
  1150. if not assigned(p1.resultdef) then
  1151. do_typecheckpass(p1);
  1152. isclassref:=(p1.resultdef.typ=classrefdef);
  1153. end
  1154. else
  1155. isclassref:=false;
  1156. { we assume, that only procsyms and varsyms are in an object }
  1157. { symbol table, for classes, properties are allowed }
  1158. case sym.typ of
  1159. procsym:
  1160. begin
  1161. do_proc_call(sym,sym.owner,structh,
  1162. (getaddr and not(token in [_CARET,_POINT])),
  1163. again,p1,callflags);
  1164. { we need to know which procedure is called }
  1165. do_typecheckpass(p1);
  1166. { calling using classref? }
  1167. if isclassref and
  1168. (p1.nodetype=calln) and
  1169. assigned(tcallnode(p1).procdefinition) and
  1170. not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
  1171. not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
  1172. Message(parser_e_only_class_members_via_class_ref);
  1173. end;
  1174. fieldvarsym:
  1175. begin
  1176. if not handle_staticfield_access(sym,true,p1) then
  1177. begin
  1178. if isclassref then
  1179. if assigned(p1) and
  1180. (
  1181. is_self_node(p1) or
  1182. (assigned(current_procinfo) and (current_procinfo.procdef.no_self_node) and
  1183. (current_procinfo.procdef.struct=structh))) then
  1184. Message(parser_e_only_class_members)
  1185. else
  1186. Message(parser_e_only_class_members_via_class_ref);
  1187. p1:=csubscriptnode.create(sym,p1);
  1188. end;
  1189. end;
  1190. propertysym:
  1191. begin
  1192. if isclassref and not (sp_static in sym.symoptions) then
  1193. Message(parser_e_only_class_members_via_class_ref);
  1194. handle_propertysym(tpropertysym(sym),sym.owner,p1);
  1195. end;
  1196. typesym:
  1197. begin
  1198. p1.free;
  1199. if try_to_consume(_LKLAMMER) then
  1200. begin
  1201. p1:=comp_expr(true,false);
  1202. consume(_RKLAMMER);
  1203. p1:=ctypeconvnode.create_explicit(p1,ttypesym(sym).typedef);
  1204. end
  1205. else
  1206. begin
  1207. p1:=ctypenode.create(ttypesym(sym).typedef);
  1208. if (is_class(ttypesym(sym).typedef) or is_objcclass(ttypesym(sym).typedef)) and
  1209. not(block_type in [bt_type,bt_const_type,bt_var_type]) then
  1210. p1:=cloadvmtaddrnode.create(p1);
  1211. end;
  1212. end;
  1213. constsym:
  1214. begin
  1215. p1.free;
  1216. p1:=genconstsymtree(tconstsym(sym));
  1217. end;
  1218. staticvarsym:
  1219. begin
  1220. { typed constant is a staticvarsym
  1221. now they are absolutevarsym }
  1222. p1.free;
  1223. p1:=cloadnode.create(sym,sym.Owner);
  1224. end;
  1225. absolutevarsym:
  1226. begin
  1227. p1.free;
  1228. p1:=nil;
  1229. { typed constants are absolutebarsyms now to handle storage properly }
  1230. propaccesslist_to_node(p1,nil,tabsolutevarsym(sym).ref);
  1231. end
  1232. else
  1233. internalerror(16);
  1234. end;
  1235. end;
  1236. end;
  1237. function handle_factor_typenode(hdef:tdef;getaddr:boolean;var again:boolean;sym:tsym;typeonly:boolean):tnode;
  1238. var
  1239. srsym : tsym;
  1240. srsymtable : tsymtable;
  1241. begin
  1242. if sym=nil then
  1243. sym:=hdef.typesym;
  1244. { allow Ordinal(Value) for type declarations since it
  1245. can be an enummeration declaration or a set lke:
  1246. (OrdinalType(const1)..OrdinalType(const2) }
  1247. if (not typeonly or is_ordinal(hdef))and try_to_consume(_LKLAMMER) then
  1248. begin
  1249. result:=comp_expr(true,false);
  1250. consume(_RKLAMMER);
  1251. { type casts to class helpers aren't allowed }
  1252. if is_objectpascal_helper(hdef) then
  1253. Message(parser_e_no_category_as_types)
  1254. { recovery by not creating a conversion node }
  1255. else
  1256. result:=ctypeconvnode.create_explicit(result,hdef);
  1257. end
  1258. else { not LKLAMMER }
  1259. if (token=_POINT) and
  1260. (is_object(hdef) or is_record(hdef)) then
  1261. begin
  1262. consume(_POINT);
  1263. { handles calling methods declared in parent objects
  1264. using "parentobject.methodname()" }
  1265. if assigned(current_structdef) and
  1266. not(getaddr) and
  1267. current_structdef.is_related(hdef) then
  1268. begin
  1269. result:=ctypenode.create(hdef);
  1270. ttypenode(result).typesym:=sym;
  1271. { search also in inherited methods }
  1272. searchsym_in_class(tobjectdef(hdef),tobjectdef(current_structdef),pattern,srsym,srsymtable,true);
  1273. if assigned(srsym) then
  1274. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1275. consume(_ID);
  1276. do_member_read(tabstractrecorddef(hdef),false,srsym,result,again,[]);
  1277. end
  1278. else
  1279. begin
  1280. { handles:
  1281. * @TObject.Load
  1282. * static methods and variables }
  1283. result:=ctypenode.create(hdef);
  1284. ttypenode(result).typesym:=sym;
  1285. { TP allows also @TMenu.Load if Load is only }
  1286. { defined in an anchestor class }
  1287. srsym:=search_struct_member(tabstractrecorddef(hdef),pattern);
  1288. if assigned(srsym) then
  1289. begin
  1290. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1291. consume(_ID);
  1292. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[]);
  1293. end
  1294. else
  1295. Message1(sym_e_id_no_member,orgpattern);
  1296. end;
  1297. end
  1298. else
  1299. begin
  1300. { Normally here would be the check against the usage
  1301. of "TClassHelper.Something", but as that might be
  1302. used inside of system symbols like sizeof and
  1303. typeinfo this check is put into ttypenode.pass_1
  1304. (for "TClassHelper" alone) and tcallnode.pass_1
  1305. (for "TClassHelper.Something") }
  1306. { class reference ? }
  1307. if is_class(hdef) or
  1308. is_objcclass(hdef) then
  1309. begin
  1310. if getaddr and (token=_POINT) then
  1311. begin
  1312. consume(_POINT);
  1313. { allows @Object.Method }
  1314. { also allows static methods and variables }
  1315. result:=ctypenode.create(hdef);
  1316. ttypenode(result).typesym:=sym;
  1317. { TP allows also @TMenu.Load if Load is only }
  1318. { defined in an anchestor class }
  1319. srsym:=search_struct_member(tobjectdef(hdef),pattern);
  1320. if assigned(srsym) then
  1321. begin
  1322. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1323. consume(_ID);
  1324. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[]);
  1325. end
  1326. else
  1327. begin
  1328. Message1(sym_e_id_no_member,orgpattern);
  1329. consume(_ID);
  1330. end;
  1331. end
  1332. else
  1333. begin
  1334. result:=ctypenode.create(hdef);
  1335. ttypenode(result).typesym:=sym;
  1336. { For a type block we simply return only
  1337. the type. For all other blocks we return
  1338. a loadvmt node }
  1339. if not(block_type in [bt_type,bt_const_type,bt_var_type]) then
  1340. result:=cloadvmtaddrnode.create(result);
  1341. end;
  1342. end
  1343. else
  1344. begin
  1345. result:=ctypenode.create(hdef);
  1346. ttypenode(result).typesym:=sym;
  1347. end;
  1348. end;
  1349. end;
  1350. {****************************************************************************
  1351. Factor
  1352. ****************************************************************************}
  1353. {---------------------------------------------
  1354. PostFixOperators
  1355. ---------------------------------------------}
  1356. { returns whether or not p1 has been changed }
  1357. function postfixoperators(var p1:tnode;var again:boolean;getaddr:boolean): boolean;
  1358. { tries to avoid syntax errors after invalid qualifiers }
  1359. procedure recoverconsume_postfixops;
  1360. begin
  1361. repeat
  1362. if not try_to_consume(_CARET) then
  1363. if try_to_consume(_POINT) then
  1364. try_to_consume(_ID)
  1365. else if try_to_consume(_LECKKLAMMER) then
  1366. begin
  1367. repeat
  1368. comp_expr(true,false);
  1369. until not try_to_consume(_COMMA);
  1370. consume(_RECKKLAMMER);
  1371. end
  1372. else if try_to_consume(_LKLAMMER) then
  1373. begin
  1374. repeat
  1375. comp_expr(true,false);
  1376. until not try_to_consume(_COMMA);
  1377. consume(_RKLAMMER);
  1378. end
  1379. else
  1380. break;
  1381. until false;
  1382. end;
  1383. procedure handle_variantarray;
  1384. var
  1385. p4 : tnode;
  1386. newstatement : tstatementnode;
  1387. tempresultvariant,
  1388. temp : ttempcreatenode;
  1389. paras : tcallparanode;
  1390. newblock : tnode;
  1391. countindices : aint;
  1392. begin
  1393. { create statements with call initialize the arguments and
  1394. call fpc_dynarr_setlength }
  1395. newblock:=internalstatements(newstatement);
  1396. { get temp for array of indicies,
  1397. we set the real size later }
  1398. temp:=ctempcreatenode.create(s32inttype,4,tt_persistent,false);
  1399. addstatement(newstatement,temp);
  1400. countindices:=0;
  1401. repeat
  1402. p4:=comp_expr(true,false);
  1403. addstatement(newstatement,cassignmentnode.create(
  1404. ctemprefnode.create_offset(temp,countindices*s32inttype.size),p4));
  1405. inc(countindices);
  1406. until not try_to_consume(_COMMA);
  1407. { set real size }
  1408. temp.size:=countindices*s32inttype.size;
  1409. consume(_RECKKLAMMER);
  1410. { we need only a write access if a := follows }
  1411. if token=_ASSIGNMENT then
  1412. begin
  1413. consume(_ASSIGNMENT);
  1414. p4:=comp_expr(true,false);
  1415. { create call to fpc_vararray_put }
  1416. paras:=ccallparanode.create(cordconstnode.create
  1417. (countindices,s32inttype,true),
  1418. ccallparanode.create(caddrnode.create_internal
  1419. (ctemprefnode.create(temp)),
  1420. ccallparanode.create(ctypeconvnode.create_internal(p4,cvarianttype),
  1421. ccallparanode.create(ctypeconvnode.create_internal(p1,cvarianttype)
  1422. ,nil))));
  1423. addstatement(newstatement,ccallnode.createintern('fpc_vararray_put',paras));
  1424. addstatement(newstatement,ctempdeletenode.create(temp));
  1425. end
  1426. else
  1427. begin
  1428. { create temp for result }
  1429. tempresultvariant:=ctempcreatenode.create(cvarianttype,cvarianttype.size,tt_persistent,true);
  1430. addstatement(newstatement,tempresultvariant);
  1431. { create call to fpc_vararray_get }
  1432. paras:=ccallparanode.create(cordconstnode.create
  1433. (countindices,s32inttype,true),
  1434. ccallparanode.create(caddrnode.create_internal
  1435. (ctemprefnode.create(temp)),
  1436. ccallparanode.create(p1,
  1437. ccallparanode.create(
  1438. ctemprefnode.create(tempresultvariant)
  1439. ,nil))));
  1440. addstatement(newstatement,ccallnode.createintern('fpc_vararray_get',paras));
  1441. addstatement(newstatement,ctempdeletenode.create(temp));
  1442. { the last statement should return the value as
  1443. location and type, this is done be referencing the
  1444. temp and converting it first from a persistent temp to
  1445. normal temp }
  1446. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempresultvariant));
  1447. addstatement(newstatement,ctemprefnode.create(tempresultvariant));
  1448. end;
  1449. p1:=newblock;
  1450. end;
  1451. function parse_array_constructor(arrdef:tarraydef): tnode;
  1452. var
  1453. newstatement,assstatement:tstatementnode;
  1454. arrnode:ttempcreatenode;
  1455. temp2:ttempcreatenode;
  1456. assnode:tnode;
  1457. paracount:integer;
  1458. begin
  1459. result:=internalstatements(newstatement);
  1460. { create temp for result }
  1461. arrnode:=ctempcreatenode.create(arrdef,arrdef.size,tt_persistent,true);
  1462. addstatement(newstatement,arrnode);
  1463. paracount:=0;
  1464. { check arguments and create an assignment calls }
  1465. if try_to_consume(_LKLAMMER) then
  1466. begin
  1467. assnode:=internalstatements(assstatement);
  1468. repeat
  1469. { arr[i] := param_i }
  1470. addstatement(assstatement,
  1471. cassignmentnode.create(
  1472. cvecnode.create(
  1473. ctemprefnode.create(arrnode),
  1474. cordconstnode.create(paracount,arrdef.rangedef,false)),
  1475. comp_expr(true,false)));
  1476. inc(paracount);
  1477. until not try_to_consume(_COMMA);
  1478. consume(_RKLAMMER);
  1479. end
  1480. else
  1481. assnode:=nil;
  1482. { get temp for array of lengths }
  1483. temp2:=ctempcreatenode.create(sinttype,sinttype.size,tt_persistent,false);
  1484. addstatement(newstatement,temp2);
  1485. { one dimensional }
  1486. addstatement(newstatement,cassignmentnode.create(
  1487. ctemprefnode.create_offset(temp2,0),
  1488. cordconstnode.create
  1489. (paracount,s32inttype,true)));
  1490. { create call to fpc_dynarr_setlength }
  1491. addstatement(newstatement,ccallnode.createintern('fpc_dynarray_setlength',
  1492. ccallparanode.create(caddrnode.create_internal
  1493. (ctemprefnode.create(temp2)),
  1494. ccallparanode.create(cordconstnode.create
  1495. (1,s32inttype,true),
  1496. ccallparanode.create(caddrnode.create_internal
  1497. (crttinode.create(tstoreddef(arrdef),initrtti,rdt_normal)),
  1498. ccallparanode.create(
  1499. ctypeconvnode.create_internal(
  1500. ctemprefnode.create(arrnode),voidpointertype),
  1501. nil))))
  1502. ));
  1503. { add assignment statememnts }
  1504. addstatement(newstatement,ctempdeletenode.create(temp2));
  1505. if assigned(assnode) then
  1506. addstatement(newstatement,assnode);
  1507. { the last statement should return the value as
  1508. location and type, this is done be referencing the
  1509. temp and converting it first from a persistent temp to
  1510. normal temp }
  1511. addstatement(newstatement,ctempdeletenode.create_normal_temp(arrnode));
  1512. addstatement(newstatement,ctemprefnode.create(arrnode));
  1513. end;
  1514. var
  1515. protsym : tpropertysym;
  1516. p2,p3 : tnode;
  1517. srsym : tsym;
  1518. srsymtable : TSymtable;
  1519. structh : tabstractrecorddef;
  1520. { shouldn't be used that often, so the extra overhead is ok to save
  1521. stack space }
  1522. dispatchstring : ansistring;
  1523. nodechanged : boolean;
  1524. calltype: tdispcalltype;
  1525. label
  1526. skipreckklammercheck;
  1527. begin
  1528. result:=false;
  1529. again:=true;
  1530. while again do
  1531. begin
  1532. { we need the resultdef }
  1533. do_typecheckpass_changed(p1,nodechanged);
  1534. result:=result or nodechanged;
  1535. if codegenerror then
  1536. begin
  1537. recoverconsume_postfixops;
  1538. exit;
  1539. end;
  1540. { handle token }
  1541. case token of
  1542. _CARET:
  1543. begin
  1544. consume(_CARET);
  1545. { support tp/mac procvar^ if the procvar returns a
  1546. pointer type }
  1547. if ((m_tp_procvar in current_settings.modeswitches) or
  1548. (m_mac_procvar in current_settings.modeswitches)) and
  1549. (p1.resultdef.typ=procvardef) and
  1550. (tprocvardef(p1.resultdef).returndef.typ=pointerdef) then
  1551. begin
  1552. p1:=ccallnode.create_procvar(nil,p1);
  1553. typecheckpass(p1);
  1554. end;
  1555. if (p1.resultdef.typ<>pointerdef) then
  1556. begin
  1557. { ^ as binary operator is a problem!!!! (FK) }
  1558. again:=false;
  1559. Message(parser_e_invalid_qualifier);
  1560. recoverconsume_postfixops;
  1561. p1.destroy;
  1562. p1:=cerrornode.create;
  1563. end
  1564. else
  1565. p1:=cderefnode.create(p1);
  1566. end;
  1567. _LECKKLAMMER:
  1568. begin
  1569. if is_class_or_interface_or_object(p1.resultdef) or
  1570. is_dispinterface(p1.resultdef) or is_record(p1.resultdef) then
  1571. begin
  1572. { default property }
  1573. protsym:=search_default_property(tabstractrecorddef(p1.resultdef));
  1574. if not(assigned(protsym)) then
  1575. begin
  1576. p1.destroy;
  1577. p1:=cerrornode.create;
  1578. again:=false;
  1579. message(parser_e_no_default_property_available);
  1580. end
  1581. else
  1582. begin
  1583. { The property symbol is referenced indirect }
  1584. protsym.IncRefCount;
  1585. handle_propertysym(protsym,protsym.owner,p1);
  1586. end;
  1587. end
  1588. else
  1589. begin
  1590. consume(_LECKKLAMMER);
  1591. repeat
  1592. { in all of the cases below, p1 is changed }
  1593. case p1.resultdef.typ of
  1594. pointerdef:
  1595. begin
  1596. { support delphi autoderef }
  1597. if (tpointerdef(p1.resultdef).pointeddef.typ=arraydef) and
  1598. (m_autoderef in current_settings.modeswitches) then
  1599. p1:=cderefnode.create(p1);
  1600. p2:=comp_expr(true,false);
  1601. { Support Pbytevar[0..9] which returns array [0..9].}
  1602. if try_to_consume(_POINTPOINT) then
  1603. p2:=crangenode.create(p2,comp_expr(true,false));
  1604. p1:=cvecnode.create(p1,p2);
  1605. end;
  1606. variantdef:
  1607. begin
  1608. handle_variantarray;
  1609. { the RECKKLAMMER is already read }
  1610. goto skipreckklammercheck;
  1611. end;
  1612. stringdef :
  1613. begin
  1614. p2:=comp_expr(true,false);
  1615. { Support string[0..9] which returns array [0..9] of char.}
  1616. if try_to_consume(_POINTPOINT) then
  1617. p2:=crangenode.create(p2,comp_expr(true,false));
  1618. p1:=cvecnode.create(p1,p2);
  1619. end;
  1620. arraydef:
  1621. begin
  1622. p2:=comp_expr(true,false);
  1623. { support SEG:OFS for go32v2 Mem[] }
  1624. if (target_info.system in [system_i386_go32v2,system_i386_watcom]) and
  1625. (p1.nodetype=loadn) and
  1626. assigned(tloadnode(p1).symtableentry) and
  1627. assigned(tloadnode(p1).symtableentry.owner.name) and
  1628. (tloadnode(p1).symtableentry.owner.name^='SYSTEM') and
  1629. ((tloadnode(p1).symtableentry.name='MEM') or
  1630. (tloadnode(p1).symtableentry.name='MEMW') or
  1631. (tloadnode(p1).symtableentry.name='MEML')) then
  1632. begin
  1633. if try_to_consume(_COLON) then
  1634. begin
  1635. p3:=caddnode.create(muln,cordconstnode.create($10,s32inttype,false),p2);
  1636. p2:=comp_expr(true,false);
  1637. p2:=caddnode.create(addn,p2,p3);
  1638. if try_to_consume(_POINTPOINT) then
  1639. { Support mem[$a000:$0000..$07ff] which returns array [0..$7ff] of memtype.}
  1640. p2:=crangenode.create(p2,caddnode.create(addn,comp_expr(true,false),p3.getcopy));
  1641. p1:=cvecnode.create(p1,p2);
  1642. include(tvecnode(p1).flags,nf_memseg);
  1643. include(tvecnode(p1).flags,nf_memindex);
  1644. end
  1645. else
  1646. begin
  1647. if try_to_consume(_POINTPOINT) then
  1648. { Support mem[$80000000..$80000002] which returns array [0..2] of memtype.}
  1649. p2:=crangenode.create(p2,comp_expr(true,false));
  1650. p1:=cvecnode.create(p1,p2);
  1651. include(tvecnode(p1).flags,nf_memindex);
  1652. end;
  1653. end
  1654. else
  1655. begin
  1656. if try_to_consume(_POINTPOINT) then
  1657. { Support arrayvar[0..9] which returns array [0..9] of arraytype.}
  1658. p2:=crangenode.create(p2,comp_expr(true,false));
  1659. p1:=cvecnode.create(p1,p2);
  1660. end;
  1661. end;
  1662. else
  1663. begin
  1664. if p1.resultdef.typ<>undefineddef then
  1665. Message(parser_e_invalid_qualifier);
  1666. p1.destroy;
  1667. p1:=cerrornode.create;
  1668. comp_expr(true,false);
  1669. again:=false;
  1670. end;
  1671. end;
  1672. do_typecheckpass(p1);
  1673. until not try_to_consume(_COMMA);
  1674. consume(_RECKKLAMMER);
  1675. { handle_variantarray eats the RECKKLAMMER and jumps here }
  1676. skipreckklammercheck:
  1677. end;
  1678. end;
  1679. _POINT :
  1680. begin
  1681. consume(_POINT);
  1682. if (p1.resultdef.typ=pointerdef) and
  1683. (m_autoderef in current_settings.modeswitches) and
  1684. { don't auto-deref objc.id, because then the code
  1685. below for supporting id.anyobjcmethod isn't triggered }
  1686. (p1.resultdef<>objc_idtype) then
  1687. begin
  1688. p1:=cderefnode.create(p1);
  1689. do_typecheckpass(p1);
  1690. end;
  1691. { procvar.<something> can never mean anything so always
  1692. try to call it in case it returns a record/object/... }
  1693. maybe_call_procvar(p1,false);
  1694. case p1.resultdef.typ of
  1695. recorddef:
  1696. begin
  1697. if token=_ID then
  1698. begin
  1699. structh:=tabstractrecorddef(p1.resultdef);
  1700. searchsym_in_record(structh,pattern,srsym,srsymtable);
  1701. if assigned(srsym) then
  1702. begin
  1703. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1704. consume(_ID);
  1705. do_member_read(structh,getaddr,srsym,p1,again,[]);
  1706. end
  1707. else
  1708. begin
  1709. Message1(sym_e_id_no_member,orgpattern);
  1710. p1.destroy;
  1711. p1:=cerrornode.create;
  1712. { try to clean up }
  1713. consume(_ID);
  1714. end;
  1715. end
  1716. else
  1717. consume(_ID);
  1718. end;
  1719. enumdef:
  1720. begin
  1721. if token=_ID then
  1722. begin
  1723. srsym:=tsym(tenumdef(p1.resultdef).symtable.Find(pattern));
  1724. p1.destroy;
  1725. if assigned(srsym) and (srsym.typ=enumsym) then
  1726. begin
  1727. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1728. p1:=genenumnode(tenumsym(srsym));
  1729. end
  1730. else
  1731. begin
  1732. Message1(sym_e_id_no_member,orgpattern);
  1733. p1:=cerrornode.create;
  1734. end;
  1735. end;
  1736. consume(_ID);
  1737. end;
  1738. arraydef:
  1739. begin
  1740. if is_dynamic_array(p1.resultdef) then
  1741. begin
  1742. if token=_ID then
  1743. begin
  1744. if pattern='CREATE' then
  1745. begin
  1746. consume(_ID);
  1747. p2:=parse_array_constructor(tarraydef(p1.resultdef));
  1748. p1.destroy;
  1749. p1:=p2;
  1750. end
  1751. else
  1752. begin
  1753. Message2(scan_f_syn_expected,'CREATE',pattern);
  1754. p1.destroy;
  1755. p1:=cerrornode.create;
  1756. consume(_ID);
  1757. end;
  1758. end;
  1759. end
  1760. else
  1761. begin
  1762. Message(parser_e_invalid_qualifier);
  1763. p1.destroy;
  1764. p1:=cerrornode.create;
  1765. consume(_ID);
  1766. end;
  1767. end;
  1768. variantdef:
  1769. begin
  1770. { dispatch call? }
  1771. { lhs := v.ident[parameters] -> property get
  1772. lhs := v.ident(parameters) -> method call
  1773. v.ident[parameters] := rhs -> property put
  1774. v.ident(parameters) := rhs -> also property put }
  1775. if token=_ID then
  1776. begin
  1777. dispatchstring:=orgpattern;
  1778. consume(_ID);
  1779. calltype:=dct_method;
  1780. if try_to_consume(_LKLAMMER) then
  1781. begin
  1782. p2:=parse_paras(false,true,_RKLAMMER);
  1783. consume(_RKLAMMER);
  1784. end
  1785. else if try_to_consume(_LECKKLAMMER) then
  1786. begin
  1787. p2:=parse_paras(false,true,_RECKKLAMMER);
  1788. consume(_RECKKLAMMER);
  1789. calltype:=dct_propget;
  1790. end
  1791. else
  1792. p2:=nil;
  1793. { property setter? }
  1794. if (token=_ASSIGNMENT) and not(afterassignment) then
  1795. begin
  1796. consume(_ASSIGNMENT);
  1797. { read the expression }
  1798. p3:=comp_expr(true,false);
  1799. { concat value parameter too }
  1800. p2:=ccallparanode.create(p3,p2);
  1801. p1:=translate_disp_call(p1,p2,dct_propput,dispatchstring,0,voidtype);
  1802. end
  1803. else
  1804. { this is only an approximation
  1805. setting useresult if not necessary is only a waste of time, no more, no less (FK) }
  1806. if afterassignment or in_args or (token<>_SEMICOLON) then
  1807. p1:=translate_disp_call(p1,p2,calltype,dispatchstring,0,cvarianttype)
  1808. else
  1809. p1:=translate_disp_call(p1,p2,calltype,dispatchstring,0,voidtype);
  1810. end
  1811. else { Error }
  1812. Consume(_ID);
  1813. end;
  1814. classrefdef:
  1815. begin
  1816. if token=_ID then
  1817. begin
  1818. structh:=tobjectdef(tclassrefdef(p1.resultdef).pointeddef);
  1819. searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,true);
  1820. if assigned(srsym) then
  1821. begin
  1822. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1823. consume(_ID);
  1824. do_member_read(structh,getaddr,srsym,p1,again,[]);
  1825. end
  1826. else
  1827. begin
  1828. Message1(sym_e_id_no_member,orgpattern);
  1829. p1.destroy;
  1830. p1:=cerrornode.create;
  1831. { try to clean up }
  1832. consume(_ID);
  1833. end;
  1834. end
  1835. else { Error }
  1836. Consume(_ID);
  1837. end;
  1838. objectdef:
  1839. begin
  1840. if token=_ID then
  1841. begin
  1842. structh:=tobjectdef(p1.resultdef);
  1843. searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,true);
  1844. if assigned(srsym) then
  1845. begin
  1846. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1847. consume(_ID);
  1848. do_member_read(structh,getaddr,srsym,p1,again,[]);
  1849. end
  1850. else
  1851. begin
  1852. Message1(sym_e_id_no_member,orgpattern);
  1853. p1.destroy;
  1854. p1:=cerrornode.create;
  1855. { try to clean up }
  1856. consume(_ID);
  1857. end;
  1858. end
  1859. else { Error }
  1860. Consume(_ID);
  1861. end;
  1862. pointerdef:
  1863. begin
  1864. if (p1.resultdef=objc_idtype) then
  1865. begin
  1866. { objc's id type can be used to call any
  1867. Objective-C method of any Objective-C class
  1868. type that's currently in scope }
  1869. if search_objc_method(pattern,srsym,srsymtable) then
  1870. begin
  1871. consume(_ID);
  1872. do_proc_call(srsym,srsymtable,nil,
  1873. (getaddr and not(token in [_CARET,_POINT])),
  1874. again,p1,[cnf_objc_id_call]);
  1875. { we need to know which procedure is called }
  1876. do_typecheckpass(p1);
  1877. end
  1878. else
  1879. begin
  1880. consume(_ID);
  1881. Message(parser_e_methode_id_expected);
  1882. end;
  1883. end
  1884. else
  1885. begin
  1886. Message(parser_e_invalid_qualifier);
  1887. if tpointerdef(p1.resultdef).pointeddef.typ in [recorddef,objectdef,classrefdef] then
  1888. Message(parser_h_maybe_deref_caret_missing);
  1889. end
  1890. end;
  1891. else
  1892. begin
  1893. if p1.resultdef.typ<>undefineddef then
  1894. Message(parser_e_invalid_qualifier);
  1895. p1.destroy;
  1896. p1:=cerrornode.create;
  1897. { Error }
  1898. consume(_ID);
  1899. end;
  1900. end;
  1901. end;
  1902. else
  1903. begin
  1904. { is this a procedure variable ? }
  1905. if assigned(p1.resultdef) and
  1906. (p1.resultdef.typ=procvardef) then
  1907. begin
  1908. { Typenode for typecasting or expecting a procvar }
  1909. if (p1.nodetype=typen) or
  1910. (
  1911. assigned(getprocvardef) and
  1912. equal_defs(p1.resultdef,getprocvardef)
  1913. ) then
  1914. begin
  1915. if try_to_consume(_LKLAMMER) then
  1916. begin
  1917. p1:=comp_expr(true,false);
  1918. consume(_RKLAMMER);
  1919. p1:=ctypeconvnode.create_explicit(p1,p1.resultdef);
  1920. end
  1921. else
  1922. again:=false
  1923. end
  1924. else
  1925. begin
  1926. if try_to_consume(_LKLAMMER) then
  1927. begin
  1928. p2:=parse_paras(false,false,_RKLAMMER);
  1929. consume(_RKLAMMER);
  1930. p1:=ccallnode.create_procvar(p2,p1);
  1931. { proc():= is never possible }
  1932. if token=_ASSIGNMENT then
  1933. begin
  1934. Message(parser_e_illegal_expression);
  1935. p1.free;
  1936. p1:=cerrornode.create;
  1937. again:=false;
  1938. end;
  1939. end
  1940. else
  1941. again:=false;
  1942. end;
  1943. end
  1944. else
  1945. again:=false;
  1946. end;
  1947. end;
  1948. { we only try again if p1 was changed }
  1949. if again or
  1950. (p1.nodetype=errorn) then
  1951. result:=true;
  1952. end; { while again }
  1953. end;
  1954. function is_member_read(sym: tsym; st: tsymtable; var p1: tnode;
  1955. out memberparentdef: tdef): boolean;
  1956. var
  1957. hdef : tdef;
  1958. begin
  1959. result:=true;
  1960. memberparentdef:=nil;
  1961. case st.symtabletype of
  1962. ObjectSymtable,
  1963. recordsymtable:
  1964. begin
  1965. memberparentdef:=tdef(st.defowner);
  1966. exit;
  1967. end;
  1968. WithSymtable:
  1969. begin
  1970. if assigned(p1) then
  1971. internalerror(2007012002);
  1972. hdef:=tnode(twithsymtable(st).withrefnode).resultdef;
  1973. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  1974. if not(hdef.typ in [objectdef,classrefdef]) then
  1975. exit;
  1976. if (hdef.typ=classrefdef) then
  1977. hdef:=tclassrefdef(hdef).pointeddef;
  1978. memberparentdef:=hdef;
  1979. end;
  1980. else
  1981. result:=false;
  1982. end;
  1983. end;
  1984. {$maxfpuregisters 0}
  1985. function factor(getaddr,typeonly:boolean) : tnode;
  1986. {---------------------------------------------
  1987. Factor_read_id
  1988. ---------------------------------------------}
  1989. procedure factor_read_id(out p1:tnode;var again:boolean);
  1990. var
  1991. srsym : tsym;
  1992. srsymtable : TSymtable;
  1993. hdef : tdef;
  1994. orgstoredpattern,
  1995. storedpattern : string;
  1996. callflags: tcallnodeflags;
  1997. t : ttoken;
  1998. unit_found : boolean;
  1999. begin
  2000. { allow post fix operators }
  2001. again:=true;
  2002. { first check for identifier }
  2003. if token<>_ID then
  2004. begin
  2005. srsym:=generrorsym;
  2006. srsymtable:=nil;
  2007. consume(_ID);
  2008. end
  2009. else
  2010. begin
  2011. if typeonly then
  2012. searchsym_type(pattern,srsym,srsymtable)
  2013. else
  2014. searchsym(pattern,srsym,srsymtable);
  2015. { handle unit specification like System.Writeln }
  2016. unit_found:=try_consume_unitsym(srsym,srsymtable,t,true);
  2017. storedpattern:=pattern;
  2018. orgstoredpattern:=orgpattern;
  2019. consume(t);
  2020. { named parameter support }
  2021. found_arg_name:=false;
  2022. if not(unit_found) and
  2023. named_args_allowed and
  2024. (token=_ASSIGNMENT) then
  2025. begin
  2026. found_arg_name:=true;
  2027. p1:=cstringconstnode.createstr(storedpattern);
  2028. consume(_ASSIGNMENT);
  2029. exit;
  2030. end;
  2031. { check hints, but only if it isn't a potential generic symbol;
  2032. that is checked in sub_expr if it isn't a generic }
  2033. if assigned(srsym) and
  2034. not (
  2035. (srsym.typ=typesym) and
  2036. (ttypesym(srsym).typedef.typ in [recorddef,objectdef,arraydef,procvardef,undefineddef]) and
  2037. not (sp_generic_para in srsym.symoptions) and
  2038. (token in [_LT, _LSHARPBRACKET])
  2039. ) then
  2040. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  2041. { if nothing found give error and return errorsym }
  2042. if not assigned(srsym) or
  2043. { is this a generic dummy symbol? }
  2044. ((srsym.typ=typesym) and
  2045. assigned(ttypesym(srsym).typedef) and
  2046. (ttypesym(srsym).typedef.typ=undefineddef) and
  2047. not (sp_generic_para in srsym.symoptions) and
  2048. not (token in [_LT, _LSHARPBRACKET]) and
  2049. not (
  2050. { in non-Delphi modes the generic class' name without a
  2051. "specialization" or "<T>" may be used to identify the
  2052. current class }
  2053. (sp_generic_dummy in srsym.symoptions) and
  2054. assigned(current_structdef) and
  2055. (df_generic in current_structdef.defoptions) and
  2056. not (m_delphi in current_settings.modeswitches) and
  2057. (upper(srsym.realname)=copy(current_structdef.objname^,1,pos('$',current_structdef.objname^)-1))
  2058. )) and
  2059. { it could be a rename of a generic para }
  2060. { Note: if this generates false positives we'll need to
  2061. include a "basesym" to tsym to track the original
  2062. symbol }
  2063. not (sp_explicitrename in srsym.symoptions) then
  2064. begin
  2065. identifier_not_found(orgstoredpattern);
  2066. srsym:=generrorsym;
  2067. srsymtable:=nil;
  2068. end;
  2069. end;
  2070. { Access to funcret or need to call the function? }
  2071. if (srsym.typ in [absolutevarsym,localvarsym,paravarsym]) and
  2072. (vo_is_funcret in tabstractvarsym(srsym).varoptions) and
  2073. { result(x) is not allowed }
  2074. not(vo_is_result in tabstractvarsym(srsym).varoptions) and
  2075. (
  2076. (token=_LKLAMMER) or
  2077. (
  2078. (
  2079. (m_tp7 in current_settings.modeswitches) or
  2080. (m_delphi in current_settings.modeswitches)
  2081. ) and
  2082. (afterassignment or in_args)
  2083. )
  2084. ) then
  2085. begin
  2086. hdef:=tdef(srsym.owner.defowner);
  2087. if assigned(hdef) and
  2088. (hdef.typ=procdef) then
  2089. srsym:=tprocdef(hdef).procsym
  2090. else
  2091. begin
  2092. Message(parser_e_illegal_expression);
  2093. srsym:=generrorsym;
  2094. end;
  2095. srsymtable:=srsym.owner;
  2096. end;
  2097. begin
  2098. case srsym.typ of
  2099. absolutevarsym :
  2100. begin
  2101. if (tabsolutevarsym(srsym).abstyp=tovar) then
  2102. begin
  2103. p1:=nil;
  2104. propaccesslist_to_node(p1,nil,tabsolutevarsym(srsym).ref);
  2105. p1:=ctypeconvnode.create(p1,tabsolutevarsym(srsym).vardef);
  2106. include(p1.flags,nf_absolute);
  2107. end
  2108. else
  2109. p1:=cloadnode.create(srsym,srsymtable);
  2110. end;
  2111. staticvarsym,
  2112. localvarsym,
  2113. paravarsym,
  2114. fieldvarsym :
  2115. begin
  2116. { check if we are reading a field of an object/class/ }
  2117. { record. is_member_read() will deal with withsymtables }
  2118. { if needed. }
  2119. p1:=nil;
  2120. if is_member_read(srsym,srsymtable,p1,hdef) then
  2121. begin
  2122. { if the field was originally found in an }
  2123. { objectsymtable, it means it's part of self }
  2124. { if only method from which it was called is }
  2125. { not class static }
  2126. if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
  2127. { if we are accessing a owner procsym from the nested }
  2128. { class we need to call it as a class member }
  2129. if assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then
  2130. p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))
  2131. else
  2132. if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
  2133. p1:=cloadvmtaddrnode.create(ctypenode.create(current_procinfo.procdef.struct))
  2134. else
  2135. p1:=load_self_node;
  2136. { now, if the field itself is part of an objectsymtab }
  2137. { (it can be even if it was found in a withsymtable, }
  2138. { e.g., "with classinstance do field := 5"), then }
  2139. { let do_member_read handle it }
  2140. if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  2141. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[])
  2142. else
  2143. { otherwise it's a regular record subscript }
  2144. p1:=csubscriptnode.create(srsym,p1);
  2145. end
  2146. else
  2147. { regular non-field load }
  2148. p1:=cloadnode.create(srsym,srsymtable);
  2149. end;
  2150. syssym :
  2151. begin
  2152. p1:=statement_syssym(tsyssym(srsym).number);
  2153. end;
  2154. typesym :
  2155. begin
  2156. hdef:=ttypesym(srsym).typedef;
  2157. if not assigned(hdef) then
  2158. begin
  2159. again:=false;
  2160. end
  2161. else
  2162. begin
  2163. { We need to know if this unit uses Variants }
  2164. if (hdef=cvarianttype) and
  2165. not(cs_compilesystem in current_settings.moduleswitches) then
  2166. current_module.flags:=current_module.flags or uf_uses_variants;
  2167. p1:=handle_factor_typenode(hdef,getaddr,again,srsym,typeonly);
  2168. end;
  2169. end;
  2170. enumsym :
  2171. begin
  2172. p1:=genenumnode(tenumsym(srsym));
  2173. end;
  2174. constsym :
  2175. begin
  2176. if tconstsym(srsym).consttyp=constresourcestring then
  2177. begin
  2178. p1:=cloadnode.create(srsym,srsymtable);
  2179. do_typecheckpass(p1);
  2180. p1.resultdef:=getansistringdef;
  2181. end
  2182. else
  2183. p1:=genconstsymtree(tconstsym(srsym));
  2184. end;
  2185. procsym :
  2186. begin
  2187. p1:=nil;
  2188. { check if it's a method/class method }
  2189. if is_member_read(srsym,srsymtable,p1,hdef) then
  2190. begin
  2191. { if we are accessing a owner procsym from the nested }
  2192. { class we need to call it as a class member }
  2193. if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) and
  2194. assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then
  2195. p1:=cloadvmtaddrnode.create(ctypenode.create(hdef));
  2196. { not srsymtable.symtabletype since that can be }
  2197. { withsymtable as well }
  2198. if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  2199. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[])
  2200. else
  2201. { no procsyms in records (yet) }
  2202. internalerror(2007012006);
  2203. end
  2204. else
  2205. begin
  2206. { regular procedure/function call }
  2207. if not unit_found then
  2208. callflags:=[]
  2209. else
  2210. callflags:=[cnf_unit_specified];
  2211. do_proc_call(srsym,srsymtable,nil,
  2212. (getaddr and not(token in [_CARET,_POINT,_LECKKLAMMER])),
  2213. again,p1,callflags);
  2214. end;
  2215. end;
  2216. propertysym :
  2217. begin
  2218. p1:=nil;
  2219. { property of a class/object? }
  2220. if is_member_read(srsym,srsymtable,p1,hdef) then
  2221. begin
  2222. if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
  2223. { if we are accessing a owner procsym from the nested }
  2224. { class we need to call it as a class member }
  2225. if assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then
  2226. p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))
  2227. else
  2228. if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
  2229. { no self node in static class methods }
  2230. p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))
  2231. else
  2232. p1:=load_self_node;
  2233. { not srsymtable.symtabletype since that can be }
  2234. { withsymtable as well }
  2235. if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  2236. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[])
  2237. else
  2238. { no propertysyms in records (yet) }
  2239. internalerror(2009111510);
  2240. end
  2241. else
  2242. { no method pointer }
  2243. begin
  2244. handle_propertysym(tpropertysym(srsym),srsymtable,p1);
  2245. end;
  2246. end;
  2247. labelsym :
  2248. begin
  2249. { Support @label }
  2250. if getaddr then
  2251. begin
  2252. if srsym.owner<>current_procinfo.procdef.localst then
  2253. CGMessage(parser_e_label_outside_proc);
  2254. p1:=cloadnode.create(srsym,srsym.owner)
  2255. end
  2256. else
  2257. begin
  2258. consume(_COLON);
  2259. if tlabelsym(srsym).defined then
  2260. Message(sym_e_label_already_defined);
  2261. if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
  2262. begin
  2263. tlabelsym(srsym).nonlocal:=true;
  2264. exclude(current_procinfo.procdef.procoptions,po_inline);
  2265. end;
  2266. if tlabelsym(srsym).nonlocal and
  2267. (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
  2268. Message(sym_e_interprocgoto_into_init_final_code_not_allowed);
  2269. tlabelsym(srsym).defined:=true;
  2270. p1:=clabelnode.create(nil,tlabelsym(srsym));
  2271. tlabelsym(srsym).code:=p1;
  2272. end;
  2273. end;
  2274. errorsym :
  2275. begin
  2276. p1:=cerrornode.create;
  2277. if try_to_consume(_LKLAMMER) then
  2278. begin
  2279. parse_paras(false,false,_RKLAMMER);
  2280. consume(_RKLAMMER);
  2281. end;
  2282. end;
  2283. else
  2284. begin
  2285. p1:=cerrornode.create;
  2286. Message(parser_e_illegal_expression);
  2287. end;
  2288. end; { end case }
  2289. end;
  2290. end;
  2291. {---------------------------------------------
  2292. Factor_Read_Set
  2293. ---------------------------------------------}
  2294. { Read a set between [] }
  2295. function factor_read_set:tnode;
  2296. var
  2297. p1,p2 : tnode;
  2298. lastp,
  2299. buildp : tarrayconstructornode;
  2300. old_allow_array_constructor : boolean;
  2301. begin
  2302. buildp:=nil;
  2303. { be sure that a least one arrayconstructn is used, also for an
  2304. empty [] }
  2305. if token=_RECKKLAMMER then
  2306. buildp:=carrayconstructornode.create(nil,buildp)
  2307. else
  2308. repeat
  2309. { nested array constructors are not allowed, see also tests/webtbs/tw17213.pp }
  2310. old_allow_array_constructor:=allow_array_constructor;
  2311. allow_array_constructor:=false;
  2312. p1:=comp_expr(true,false);
  2313. if try_to_consume(_POINTPOINT) then
  2314. begin
  2315. p2:=comp_expr(true,false);
  2316. p1:=carrayconstructorrangenode.create(p1,p2);
  2317. end;
  2318. { insert at the end of the tree, to get the correct order }
  2319. if not assigned(buildp) then
  2320. begin
  2321. buildp:=carrayconstructornode.create(p1,nil);
  2322. lastp:=buildp;
  2323. end
  2324. else
  2325. begin
  2326. lastp.right:=carrayconstructornode.create(p1,nil);
  2327. lastp:=tarrayconstructornode(lastp.right);
  2328. end;
  2329. allow_array_constructor:=old_allow_array_constructor;
  2330. { there could be more elements }
  2331. until not try_to_consume(_COMMA);
  2332. factor_read_set:=buildp;
  2333. end;
  2334. {---------------------------------------------
  2335. Factor (Main)
  2336. ---------------------------------------------}
  2337. var
  2338. l : longint;
  2339. ic : int64;
  2340. qc : qword;
  2341. p1 : tnode;
  2342. code : integer;
  2343. srsym : tsym;
  2344. srsymtable : TSymtable;
  2345. pd : tprocdef;
  2346. hclassdef : tobjectdef;
  2347. d : bestreal;
  2348. cur : currency;
  2349. hs,hsorg : string;
  2350. hdef : tdef;
  2351. filepos : tfileposinfo;
  2352. callflags : tcallnodeflags;
  2353. again,
  2354. updatefpos,
  2355. nodechanged : boolean;
  2356. begin
  2357. { can't keep a copy of p1 and compare pointers afterwards, because
  2358. p1 may be freed and reallocated in the same place! }
  2359. updatefpos:=false;
  2360. p1:=nil;
  2361. filepos:=current_tokenpos;
  2362. again:=false;
  2363. if token=_ID then
  2364. begin
  2365. again:=true;
  2366. { Handle references to self }
  2367. if (idtoken=_SELF) and
  2368. not(block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) and
  2369. assigned(current_structdef) then
  2370. begin
  2371. p1:=load_self_node;
  2372. consume(_ID);
  2373. again:=true;
  2374. end
  2375. else
  2376. factor_read_id(p1,again);
  2377. if assigned(p1) then
  2378. begin
  2379. { factor_read_id will set the filepos to after the id,
  2380. and in case of _SELF the filepos will already be the
  2381. same as filepos (so setting it again doesn't hurt). }
  2382. p1.fileinfo:=filepos;
  2383. filepos:=current_tokenpos;
  2384. end;
  2385. { handle post fix operators }
  2386. updatefpos:=postfixoperators(p1,again,getaddr);
  2387. end
  2388. else
  2389. begin
  2390. updatefpos:=true;
  2391. case token of
  2392. _RETURN :
  2393. begin
  2394. consume(_RETURN);
  2395. if not(token in [_SEMICOLON,_ELSE,_END]) then
  2396. p1 := cexitnode.create(comp_expr(true,false))
  2397. else
  2398. p1 := cexitnode.create(nil);
  2399. end;
  2400. _INHERITED :
  2401. begin
  2402. again:=true;
  2403. consume(_INHERITED);
  2404. if assigned(current_procinfo) and
  2405. assigned(current_structdef) and
  2406. (current_structdef.typ=objectdef) then
  2407. begin
  2408. { for record helpers in mode Delphi "inherited" is not
  2409. allowed }
  2410. if is_objectpascal_helper(current_structdef) and
  2411. (m_delphi in current_settings.modeswitches) and
  2412. is_record(tobjectdef(current_structdef).extendeddef) then
  2413. Message(parser_e_inherited_not_in_record);
  2414. hclassdef:=tobjectdef(current_structdef).childof;
  2415. { Objective-C categories *replace* methods in the class
  2416. they extend, or add methods to it. So calling an
  2417. inherited method always calls the method inherited from
  2418. the parent of the extended class }
  2419. if is_objccategory(current_structdef) then
  2420. hclassdef:=hclassdef.childof;
  2421. { if inherited; only then we need the method with
  2422. the same name }
  2423. if token <> _ID then
  2424. begin
  2425. hs:=current_procinfo.procdef.procsym.name;
  2426. hsorg:=current_procinfo.procdef.procsym.realname;
  2427. anon_inherited:=true;
  2428. { For message methods we need to search using the message
  2429. number or string }
  2430. pd:=tprocdef(tprocsym(current_procinfo.procdef.procsym).ProcdefList[0]);
  2431. srdef:=nil;
  2432. if (po_msgint in pd.procoptions) then
  2433. searchsym_in_class_by_msgint(hclassdef,pd.messageinf.i,srdef,srsym,srsymtable)
  2434. else
  2435. if (po_msgstr in pd.procoptions) then
  2436. searchsym_in_class_by_msgstr(hclassdef,pd.messageinf.str^,srsym,srsymtable)
  2437. else
  2438. { helpers have their own ways of dealing with inherited }
  2439. if is_objectpascal_helper(current_structdef) then
  2440. searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,true)
  2441. else
  2442. searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable,true);
  2443. end
  2444. else
  2445. begin
  2446. hs:=pattern;
  2447. hsorg:=orgpattern;
  2448. consume(_ID);
  2449. anon_inherited:=false;
  2450. { helpers have their own ways of dealing with inherited }
  2451. if is_objectpascal_helper(current_structdef) then
  2452. searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,true)
  2453. else
  2454. searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable,true);
  2455. end;
  2456. if assigned(srsym) then
  2457. begin
  2458. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  2459. { load the procdef from the inherited class and
  2460. not from self }
  2461. case srsym.typ of
  2462. procsym:
  2463. begin
  2464. if is_objectpascal_helper(current_structdef) then
  2465. begin
  2466. { for a helper load the procdef either from the
  2467. extended type, from the parent helper or from
  2468. the extended type of the parent helper
  2469. depending on the def the found symbol belongs
  2470. to }
  2471. if (srsym.Owner.defowner.typ=objectdef) and
  2472. is_objectpascal_helper(tobjectdef(srsym.Owner.defowner)) then
  2473. if current_structdef.is_related(tdef(srsym.Owner.defowner)) and
  2474. assigned(tobjectdef(current_structdef).childof) then
  2475. hdef:=tobjectdef(current_structdef).childof
  2476. else
  2477. hdef:=tobjectdef(srsym.Owner.defowner).extendeddef
  2478. else
  2479. hdef:=tdef(srsym.Owner.defowner);
  2480. end
  2481. else
  2482. hdef:=hclassdef;
  2483. if (po_classmethod in current_procinfo.procdef.procoptions) or
  2484. (po_staticmethod in current_procinfo.procdef.procoptions) then
  2485. hdef:=tclassrefdef.create(hdef);
  2486. p1:=ctypenode.create(hdef);
  2487. { we need to allow helpers here }
  2488. ttypenode(p1).helperallowed:=true;
  2489. end;
  2490. propertysym:
  2491. ;
  2492. else
  2493. begin
  2494. Message(parser_e_methode_id_expected);
  2495. p1:=cerrornode.create;
  2496. end;
  2497. end;
  2498. callflags:=[cnf_inherited];
  2499. if anon_inherited then
  2500. include(callflags,cnf_anon_inherited);
  2501. do_member_read(hclassdef,getaddr,srsym,p1,again,callflags);
  2502. end
  2503. else
  2504. begin
  2505. if anon_inherited then
  2506. begin
  2507. { For message methods we need to call DefaultHandler }
  2508. if (po_msgint in pd.procoptions) or
  2509. (po_msgstr in pd.procoptions) then
  2510. begin
  2511. searchsym_in_class(hclassdef,hclassdef,'DEFAULTHANDLER',srsym,srsymtable,true);
  2512. if not assigned(srsym) or
  2513. (srsym.typ<>procsym) then
  2514. internalerror(200303171);
  2515. p1:=nil;
  2516. do_proc_call(srsym,srsym.owner,hclassdef,false,again,p1,[]);
  2517. end
  2518. else
  2519. begin
  2520. { we need to ignore the inherited; }
  2521. p1:=cnothingnode.create;
  2522. end;
  2523. end
  2524. else
  2525. begin
  2526. Message1(sym_e_id_no_member,hsorg);
  2527. p1:=cerrornode.create;
  2528. end;
  2529. again:=false;
  2530. end;
  2531. { turn auto inheriting off }
  2532. anon_inherited:=false;
  2533. end
  2534. else
  2535. begin
  2536. { in case of records we use a more clear error message }
  2537. if assigned(current_structdef) and
  2538. (current_structdef.typ=recorddef) then
  2539. Message(parser_e_inherited_not_in_record)
  2540. else
  2541. Message(parser_e_generic_methods_only_in_methods);
  2542. again:=false;
  2543. p1:=cerrornode.create;
  2544. end;
  2545. postfixoperators(p1,again,getaddr);
  2546. end;
  2547. _INTCONST :
  2548. begin
  2549. {Try first wether the value fits in an int64.}
  2550. val(pattern,ic,code);
  2551. if code=0 then
  2552. begin
  2553. consume(_INTCONST);
  2554. int_to_type(ic,hdef);
  2555. p1:=cordconstnode.create(ic,hdef,true);
  2556. end
  2557. else
  2558. begin
  2559. { try qword next }
  2560. val(pattern,qc,code);
  2561. if code=0 then
  2562. begin
  2563. consume(_INTCONST);
  2564. int_to_type(qc,hdef);
  2565. p1:=cordconstnode.create(qc,hdef,true);
  2566. end;
  2567. end;
  2568. if code<>0 then
  2569. begin
  2570. { finally float }
  2571. val(pattern,d,code);
  2572. if code<>0 then
  2573. begin
  2574. Message(parser_e_invalid_integer);
  2575. consume(_INTCONST);
  2576. l:=1;
  2577. p1:=cordconstnode.create(l,sinttype,true);
  2578. end
  2579. else
  2580. begin
  2581. consume(_INTCONST);
  2582. p1:=crealconstnode.create(d,pbestrealtype^);
  2583. end;
  2584. end
  2585. else
  2586. { the necessary range checking has already been done by val }
  2587. tordconstnode(p1).rangecheck:=false;
  2588. end;
  2589. _REALNUMBER :
  2590. begin
  2591. val(pattern,d,code);
  2592. if code<>0 then
  2593. begin
  2594. Message(parser_e_error_in_real);
  2595. d:=1.0;
  2596. end;
  2597. consume(_REALNUMBER);
  2598. {$ifdef FPC_REAL2REAL_FIXED}
  2599. if current_settings.fputype=fpu_none then
  2600. Message(parser_e_unsupported_real);
  2601. if (current_settings.minfpconstprec=s32real) and
  2602. (d = single(d)) then
  2603. p1:=crealconstnode.create(d,s32floattype)
  2604. else if (current_settings.minfpconstprec=s64real) and
  2605. (d = double(d)) then
  2606. p1:=crealconstnode.create(d,s64floattype)
  2607. else
  2608. {$endif FPC_REAL2REAL_FIXED}
  2609. p1:=crealconstnode.create(d,pbestrealtype^);
  2610. {$ifdef FPC_HAS_STR_CURRENCY}
  2611. val(pattern,cur,code);
  2612. if code=0 then
  2613. trealconstnode(p1).value_currency:=cur;
  2614. {$endif FPC_HAS_STR_CURRENCY}
  2615. end;
  2616. _STRING :
  2617. begin
  2618. string_dec(hdef,true);
  2619. { STRING can be also a type cast }
  2620. if try_to_consume(_LKLAMMER) then
  2621. begin
  2622. p1:=comp_expr(true,false);
  2623. consume(_RKLAMMER);
  2624. p1:=ctypeconvnode.create_explicit(p1,hdef);
  2625. { handle postfix operators here e.g. string(a)[10] }
  2626. again:=true;
  2627. postfixoperators(p1,again,getaddr);
  2628. end
  2629. else
  2630. p1:=ctypenode.create(hdef);
  2631. end;
  2632. _FILE :
  2633. begin
  2634. hdef:=cfiletype;
  2635. consume(_FILE);
  2636. { FILE can be also a type cast }
  2637. if try_to_consume(_LKLAMMER) then
  2638. begin
  2639. p1:=comp_expr(true,false);
  2640. consume(_RKLAMMER);
  2641. p1:=ctypeconvnode.create_explicit(p1,hdef);
  2642. { handle postfix operators here e.g. string(a)[10] }
  2643. again:=true;
  2644. postfixoperators(p1,again,getaddr);
  2645. end
  2646. else
  2647. begin
  2648. p1:=ctypenode.create(hdef);
  2649. end;
  2650. end;
  2651. _CSTRING :
  2652. begin
  2653. p1:=cstringconstnode.createpchar(ansistring2pchar(cstringpattern),length(cstringpattern));
  2654. consume(_CSTRING);
  2655. end;
  2656. _CCHAR :
  2657. begin
  2658. p1:=cordconstnode.create(ord(pattern[1]),cchartype,true);
  2659. consume(_CCHAR);
  2660. end;
  2661. _CWSTRING:
  2662. begin
  2663. p1:=cstringconstnode.createwstr(patternw);
  2664. consume(_CWSTRING);
  2665. end;
  2666. _CWCHAR:
  2667. begin
  2668. p1:=cordconstnode.create(ord(getcharwidestring(patternw,0)),cwidechartype,true);
  2669. consume(_CWCHAR);
  2670. end;
  2671. _KLAMMERAFFE :
  2672. begin
  2673. consume(_KLAMMERAFFE);
  2674. got_addrn:=true;
  2675. { support both @<x> and @(<x>) }
  2676. if try_to_consume(_LKLAMMER) then
  2677. begin
  2678. p1:=factor(true,false);
  2679. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2680. begin
  2681. again:=true;
  2682. postfixoperators(p1,again,getaddr);
  2683. end
  2684. else
  2685. consume(_RKLAMMER);
  2686. end
  2687. else
  2688. p1:=factor(true,false);
  2689. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2690. begin
  2691. again:=true;
  2692. postfixoperators(p1,again,getaddr);
  2693. end;
  2694. got_addrn:=false;
  2695. p1:=caddrnode.create(p1);
  2696. p1.fileinfo:=filepos;
  2697. if cs_typed_addresses in current_settings.localswitches then
  2698. include(p1.flags,nf_typedaddr);
  2699. { Store the procvar that we are expecting, the
  2700. addrn will use the information to find the correct
  2701. procdef or it will return an error }
  2702. if assigned(getprocvardef) and
  2703. (taddrnode(p1).left.nodetype = loadn) then
  2704. taddrnode(p1).getprocvardef:=getprocvardef;
  2705. end;
  2706. _LKLAMMER :
  2707. begin
  2708. consume(_LKLAMMER);
  2709. p1:=comp_expr(true,false);
  2710. consume(_RKLAMMER);
  2711. { it's not a good solution }
  2712. { but (a+b)^ makes some problems }
  2713. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2714. begin
  2715. again:=true;
  2716. postfixoperators(p1,again,getaddr);
  2717. end;
  2718. end;
  2719. _LECKKLAMMER :
  2720. begin
  2721. consume(_LECKKLAMMER);
  2722. p1:=factor_read_set;
  2723. consume(_RECKKLAMMER);
  2724. end;
  2725. _PLUS :
  2726. begin
  2727. consume(_PLUS);
  2728. p1:=factor(false,false);
  2729. p1:=cunaryplusnode.create(p1);
  2730. end;
  2731. _MINUS :
  2732. begin
  2733. consume(_MINUS);
  2734. if (token = _INTCONST) and not(m_isolike_unary_minus in current_settings.modeswitches) then
  2735. begin
  2736. { ugly hack, but necessary to be able to parse }
  2737. { -9223372036854775808 as int64 (JM) }
  2738. pattern := '-'+pattern;
  2739. p1:=sub_expr(oppower,false,false,nil);
  2740. { -1 ** 4 should be - (1 ** 4) and not
  2741. (-1) ** 4
  2742. This was the reason of tw0869.pp test failure PM }
  2743. if p1.nodetype=starstarn then
  2744. begin
  2745. if tbinarynode(p1).left.nodetype=ordconstn then
  2746. begin
  2747. tordconstnode(tbinarynode(p1).left).value:=-tordconstnode(tbinarynode(p1).left).value;
  2748. p1:=cunaryminusnode.create(p1);
  2749. end
  2750. else if tbinarynode(p1).left.nodetype=realconstn then
  2751. begin
  2752. trealconstnode(tbinarynode(p1).left).value_real:=-trealconstnode(tbinarynode(p1).left).value_real;
  2753. trealconstnode(tbinarynode(p1).left).value_currency:=-trealconstnode(tbinarynode(p1).left).value_currency;
  2754. p1:=cunaryminusnode.create(p1);
  2755. end
  2756. else
  2757. internalerror(20021029);
  2758. end;
  2759. end
  2760. else
  2761. begin
  2762. if m_isolike_unary_minus in current_settings.modeswitches then
  2763. p1:=sub_expr(opmultiply,false,false,nil)
  2764. else
  2765. p1:=sub_expr(oppower,false,false,nil);
  2766. p1:=cunaryminusnode.create(p1);
  2767. end;
  2768. end;
  2769. _OP_NOT :
  2770. begin
  2771. consume(_OP_NOT);
  2772. p1:=factor(false,false);
  2773. p1:=cnotnode.create(p1);
  2774. end;
  2775. _TRUE :
  2776. begin
  2777. consume(_TRUE);
  2778. p1:=cordconstnode.create(1,pasbool8type,false);
  2779. end;
  2780. _FALSE :
  2781. begin
  2782. consume(_FALSE);
  2783. p1:=cordconstnode.create(0,pasbool8type,false);
  2784. end;
  2785. _NIL :
  2786. begin
  2787. consume(_NIL);
  2788. p1:=cnilnode.create;
  2789. { It's really ugly code nil^, but delphi allows it }
  2790. if token in [_CARET] then
  2791. begin
  2792. again:=true;
  2793. postfixoperators(p1,again,getaddr);
  2794. end;
  2795. end;
  2796. _OBJCPROTOCOL:
  2797. begin
  2798. { The @protocol keyword is used in two ways in Objective-C:
  2799. 1) to declare protocols (~ Object Pascal interfaces)
  2800. 2) to obtain the metaclass (~ Object Pascal) "class of")
  2801. of a declared protocol
  2802. This code is for handling the second case. Because of 1),
  2803. we cannot simply use a system unit symbol.
  2804. }
  2805. consume(_OBJCPROTOCOL);
  2806. consume(_LKLAMMER);
  2807. p1:=factor(false,false);
  2808. consume(_RKLAMMER);
  2809. p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
  2810. end;
  2811. else
  2812. begin
  2813. Message(parser_e_illegal_expression);
  2814. p1:=cerrornode.create;
  2815. { recover }
  2816. consume(token);
  2817. end;
  2818. end;
  2819. end;
  2820. { generate error node if no node is created }
  2821. if not assigned(p1) then
  2822. begin
  2823. {$ifdef EXTDEBUG}
  2824. Comment(V_Warning,'factor: p1=nil');
  2825. {$endif}
  2826. p1:=cerrornode.create;
  2827. updatefpos:=true;
  2828. end;
  2829. { get the resultdef for the node }
  2830. if (not assigned(p1.resultdef)) then
  2831. begin
  2832. do_typecheckpass_changed(p1,nodechanged);
  2833. updatefpos:=updatefpos or nodechanged;
  2834. end;
  2835. if assigned(p1) and
  2836. updatefpos then
  2837. p1.fileinfo:=filepos;
  2838. factor:=p1;
  2839. end;
  2840. {$maxfpuregisters default}
  2841. procedure post_comp_expr_gendef(var def: tdef);
  2842. var
  2843. p1 : tnode;
  2844. again : boolean;
  2845. begin
  2846. if not assigned(def) then
  2847. internalerror(2011053001);
  2848. again:=false;
  2849. { handle potential typecasts, etc }
  2850. p1:=handle_factor_typenode(def,false,again,nil,false);
  2851. { parse postfix operators }
  2852. postfixoperators(p1,again,false);
  2853. if assigned(p1) and (p1.nodetype=typen) then
  2854. def:=ttypenode(p1).typedef
  2855. else
  2856. def:=generrordef;
  2857. end;
  2858. {****************************************************************************
  2859. Sub_Expr
  2860. ****************************************************************************}
  2861. const
  2862. { Warning these stay be ordered !! }
  2863. operator_levels:array[Toperator_precedence] of set of NOTOKEN..last_operator=
  2864. ([_LT,_LTE,_GT,_GTE,_EQ,_NE,_OP_IN],
  2865. [_PLUS,_MINUS,_OP_OR,_PIPE,_OP_XOR],
  2866. [_CARET,_SYMDIF,_STARSTAR,_STAR,_SLASH,
  2867. _OP_AS,_OP_IS,_OP_AND,_AMPERSAND,_OP_DIV,_OP_MOD,_OP_SHL,_OP_SHR],
  2868. [_STARSTAR] );
  2869. function sub_expr(pred_level:Toperator_precedence;accept_equal,typeonly:boolean;factornode:tnode):tnode;
  2870. {Reads a subexpression while the operators are of the current precedence
  2871. level, or any higher level. Replaces the old term, simpl_expr and
  2872. simpl2_expr.}
  2873. function istypenode(n:tnode):boolean;inline;
  2874. { Checks whether the given node is a type node or a VMT node containing a
  2875. typenode. This is used in the code for inline specializations in the
  2876. _LT branch below }
  2877. begin
  2878. result:=assigned(n) and
  2879. (
  2880. (n.nodetype=typen) or
  2881. (
  2882. (n.nodetype=loadvmtaddrn) and
  2883. (tloadvmtaddrnode(n).left.nodetype=typen)
  2884. )
  2885. );
  2886. end;
  2887. function gettypedef(n:tnode):tdef;inline;
  2888. { This returns the typedef that belongs to the given typenode or
  2889. loadvmtaddrnode. n must not be Nil! }
  2890. begin
  2891. if n.nodetype=typen then
  2892. result:=ttypenode(n).typedef
  2893. else
  2894. result:=ttypenode(tloadvmtaddrnode(n).left).typedef;
  2895. end;
  2896. function getgenericsym(n:tnode;out srsym:tsym):boolean;
  2897. var
  2898. srsymtable : tsymtable;
  2899. begin
  2900. srsym:=nil;
  2901. case n.nodetype of
  2902. typen:
  2903. srsym:=ttypenode(n).typedef.typesym;
  2904. loadvmtaddrn:
  2905. srsym:=ttypenode(tloadvmtaddrnode(n).left).typedef.typesym;
  2906. loadn:
  2907. if not searchsym_with_symoption(tloadnode(n).symtableentry.Name,srsym,srsymtable,sp_generic_dummy) then
  2908. srsym:=nil;
  2909. { TODO : handle const nodes }
  2910. end;
  2911. result:=assigned(srsym);
  2912. end;
  2913. label
  2914. SubExprStart;
  2915. var
  2916. p1,p2 : tnode;
  2917. oldt : Ttoken;
  2918. filepos : tfileposinfo;
  2919. again : boolean;
  2920. gendef,parseddef : tdef;
  2921. gensym : tsym;
  2922. begin
  2923. SubExprStart:
  2924. if pred_level=highest_precedence then
  2925. begin
  2926. if factornode=nil then
  2927. p1:=factor(false,typeonly)
  2928. else
  2929. p1:=factornode;
  2930. end
  2931. else
  2932. p1:=sub_expr(succ(pred_level),true,typeonly,factornode);
  2933. repeat
  2934. if (token in [NOTOKEN..last_operator]) and
  2935. (token in operator_levels[pred_level]) and
  2936. ((token<>_EQ) or accept_equal) then
  2937. begin
  2938. oldt:=token;
  2939. filepos:=current_tokenpos;
  2940. consume(token);
  2941. if pred_level=highest_precedence then
  2942. p2:=factor(false,false)
  2943. else
  2944. p2:=sub_expr(succ(pred_level),true,typeonly,nil);
  2945. case oldt of
  2946. _PLUS :
  2947. p1:=caddnode.create(addn,p1,p2);
  2948. _MINUS :
  2949. p1:=caddnode.create(subn,p1,p2);
  2950. _STAR :
  2951. p1:=caddnode.create(muln,p1,p2);
  2952. _SLASH :
  2953. p1:=caddnode.create(slashn,p1,p2);
  2954. _EQ:
  2955. p1:=caddnode.create(equaln,p1,p2);
  2956. _GT :
  2957. p1:=caddnode.create(gtn,p1,p2);
  2958. _LT :
  2959. begin
  2960. { we need to decice whether we have an inline specialization
  2961. (type nodes to the left and right of "<", mode Delphi and
  2962. ">" or "," following) or a normal "<" comparison }
  2963. { TODO : p1 could be a non type if e.g. a variable with the
  2964. same name is defined in the same unit where the
  2965. generic is defined (though "same unit" is not
  2966. necessarily needed) }
  2967. if getgenericsym(p1,gensym) and
  2968. { Attention: when nested specializations are supported
  2969. p2 could be a loadn if a "<" follows }
  2970. istypenode(p2) and
  2971. (m_delphi in current_settings.modeswitches) and
  2972. { TODO : add _LT, _LSHARPBRACKET for nested specializations }
  2973. (token in [_GT,_RSHARPBRACKET,_COMMA]) then
  2974. begin
  2975. { this is an inline specialization }
  2976. { retrieve the defs of two nodes }
  2977. gendef:=nil;
  2978. parseddef:=gettypedef(p2);
  2979. if parseddef.typesym.typ<>typesym then
  2980. Internalerror(2011051001);
  2981. { check the hints for parseddef }
  2982. check_hints(parseddef.typesym,parseddef.typesym.symoptions,parseddef.typesym.deprecatedmsg);
  2983. { generate the specialization }
  2984. generate_specialization(gendef,false,'',parseddef,gensym.RealName);
  2985. { we don't need the old left and right nodes anymore }
  2986. p1.Free;
  2987. p2.Free;
  2988. { in case of a class or a record the specialized generic
  2989. is always a classrefdef }
  2990. again:=false;
  2991. { handle potential typecasts, etc }
  2992. p1:=handle_factor_typenode(gendef,false,again,nil,false);
  2993. { parse postfix operators }
  2994. if postfixoperators(p1,again,false) then
  2995. if assigned(p1) then
  2996. p1.fileinfo:=filepos
  2997. else
  2998. p1:=cerrornode.create;
  2999. { with p1 now set we are in reality directly behind the
  3000. call to "factor" thus we need to call down to that
  3001. again }
  3002. { This is disabled until specializations on the right
  3003. hand side work as well, because
  3004. "not working expressions" is better than "half working
  3005. expressions" }
  3006. {factornode:=p1;
  3007. goto SubExprStart;}
  3008. end
  3009. else
  3010. begin
  3011. { this is a normal "<" comparison }
  3012. { potential generic types that are followed by a "<" }
  3013. { a) are not checked whether they are an undefined def,
  3014. but not a generic parameter }
  3015. if (p1.nodetype=typen) and
  3016. (ttypenode(p1).typedef.typ=undefineddef) and
  3017. assigned(ttypenode(p1).typedef.typesym) and
  3018. not (sp_generic_para in ttypenode(p1).typedef.typesym.symoptions) then
  3019. begin
  3020. identifier_not_found(ttypenode(p1).typedef.typesym.RealName);
  3021. p1.Free;
  3022. p1:=cerrornode.create;
  3023. end;
  3024. { b) don't have their hints checked }
  3025. if istypenode(p1) then
  3026. begin
  3027. gendef:=gettypedef(p1);
  3028. if gendef.typ in [objectdef,recorddef,arraydef,procvardef] then
  3029. check_hints(gendef.typesym,gendef.typesym.symoptions,gendef.typesym.deprecatedmsg);
  3030. end;
  3031. { Note: the second part of the expression will be needed
  3032. for nested specializations }
  3033. if istypenode(p2) {and
  3034. not (token in [_LT, _LSHARPBRACKET])} then
  3035. begin
  3036. gendef:=gettypedef(p2);
  3037. if gendef.typ in [objectdef,recorddef,arraydef,procvardef] then
  3038. check_hints(gendef.typesym,gendef.typesym.symoptions,gendef.typesym.deprecatedmsg);
  3039. end;
  3040. { create the comparison node for "<" }
  3041. p1:=caddnode.create(ltn,p1,p2)
  3042. end;
  3043. end;
  3044. _GTE :
  3045. p1:=caddnode.create(gten,p1,p2);
  3046. _LTE :
  3047. p1:=caddnode.create(lten,p1,p2);
  3048. _SYMDIF :
  3049. p1:=caddnode.create(symdifn,p1,p2);
  3050. _STARSTAR :
  3051. p1:=caddnode.create(starstarn,p1,p2);
  3052. _OP_AS,
  3053. _OP_IS :
  3054. begin
  3055. if token in [_LT, _LSHARPBRACKET] then
  3056. begin
  3057. { for now we're handling this as a generic declaration;
  3058. there could be cases though (because of operator
  3059. overloading) where this is the wrong decision... }
  3060. { TODO : here the same note as in _LT applies as p2 could
  3061. point to a variable, etc }
  3062. gendef:=gettypedef(p2);
  3063. if gendef.typesym.typ<>typesym then
  3064. Internalerror(2011071401);
  3065. { generate the specialization }
  3066. generate_specialization(gendef,false,'',nil,'');
  3067. { we don't need the old p2 anymore }
  3068. p2.Free;
  3069. again:=false;
  3070. { handle potential typecasts, etc }
  3071. p2:=handle_factor_typenode(gendef,false,again,nil,false);
  3072. { parse postfix operators }
  3073. if postfixoperators(p2,again,false) then
  3074. if assigned(p2) then
  3075. p2.fileinfo:=filepos
  3076. else
  3077. p2:=cerrornode.create;
  3078. { here we don't need to call back down to "factor", thus
  3079. no "goto" }
  3080. end;
  3081. { now generate the "is" or "as" node }
  3082. case oldt of
  3083. _OP_AS:
  3084. p1:=casnode.create(p1,p2);
  3085. _OP_IS:
  3086. p1:=cisnode.create(p1,p2);
  3087. end;
  3088. end;
  3089. _OP_IN :
  3090. p1:=cinnode.create(p1,p2);
  3091. _OP_OR,
  3092. _PIPE {macpas only} :
  3093. begin
  3094. p1:=caddnode.create(orn,p1,p2);
  3095. if (oldt = _PIPE) then
  3096. include(p1.flags,nf_short_bool);
  3097. end;
  3098. _OP_AND,
  3099. _AMPERSAND {macpas only} :
  3100. begin
  3101. p1:=caddnode.create(andn,p1,p2);
  3102. if (oldt = _AMPERSAND) then
  3103. include(p1.flags,nf_short_bool);
  3104. end;
  3105. _OP_DIV :
  3106. p1:=cmoddivnode.create(divn,p1,p2);
  3107. _OP_NOT :
  3108. p1:=cnotnode.create(p1);
  3109. _OP_MOD :
  3110. begin
  3111. p1:=cmoddivnode.create(modn,p1,p2);
  3112. if m_iso in current_settings.modeswitches then
  3113. include(p1.flags,nf_isomod);
  3114. end;
  3115. _OP_SHL :
  3116. p1:=cshlshrnode.create(shln,p1,p2);
  3117. _OP_SHR :
  3118. p1:=cshlshrnode.create(shrn,p1,p2);
  3119. _OP_XOR :
  3120. p1:=caddnode.create(xorn,p1,p2);
  3121. _ASSIGNMENT :
  3122. p1:=cassignmentnode.create(p1,p2);
  3123. _NE :
  3124. p1:=caddnode.create(unequaln,p1,p2);
  3125. end;
  3126. p1.fileinfo:=filepos;
  3127. end
  3128. else
  3129. break;
  3130. until false;
  3131. sub_expr:=p1;
  3132. end;
  3133. function comp_expr(accept_equal,typeonly:boolean):tnode;
  3134. var
  3135. oldafterassignment : boolean;
  3136. p1 : tnode;
  3137. begin
  3138. oldafterassignment:=afterassignment;
  3139. afterassignment:=true;
  3140. p1:=sub_expr(opcompare,accept_equal,typeonly,nil);
  3141. { get the resultdef for this expression }
  3142. if not assigned(p1.resultdef) then
  3143. do_typecheckpass(p1);
  3144. afterassignment:=oldafterassignment;
  3145. comp_expr:=p1;
  3146. end;
  3147. function expr(dotypecheck : boolean) : tnode;
  3148. var
  3149. p1,p2 : tnode;
  3150. filepos : tfileposinfo;
  3151. oldafterassignment,
  3152. updatefpos : boolean;
  3153. begin
  3154. oldafterassignment:=afterassignment;
  3155. p1:=sub_expr(opcompare,true,false,nil);
  3156. { get the resultdef for this expression }
  3157. if not assigned(p1.resultdef) and
  3158. dotypecheck then
  3159. do_typecheckpass(p1);
  3160. filepos:=current_tokenpos;
  3161. if token in [_ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
  3162. afterassignment:=true;
  3163. updatefpos:=true;
  3164. case token of
  3165. _POINTPOINT :
  3166. begin
  3167. consume(_POINTPOINT);
  3168. p2:=sub_expr(opcompare,true,false,nil);
  3169. p1:=crangenode.create(p1,p2);
  3170. end;
  3171. _ASSIGNMENT :
  3172. begin
  3173. consume(_ASSIGNMENT);
  3174. if assigned(p1.resultdef) and (p1.resultdef.typ=procvardef) then
  3175. getprocvardef:=tprocvardef(p1.resultdef);
  3176. p2:=sub_expr(opcompare,true,false,nil);
  3177. if assigned(getprocvardef) then
  3178. handle_procvar(getprocvardef,p2);
  3179. getprocvardef:=nil;
  3180. p1:=cassignmentnode.create(p1,p2);
  3181. end;
  3182. _PLUSASN :
  3183. begin
  3184. consume(_PLUSASN);
  3185. p2:=sub_expr(opcompare,true,false,nil);
  3186. p1:=gen_c_style_operator(addn,p1,p2);
  3187. end;
  3188. _MINUSASN :
  3189. begin
  3190. consume(_MINUSASN);
  3191. p2:=sub_expr(opcompare,true,false,nil);
  3192. p1:=gen_c_style_operator(subn,p1,p2);
  3193. end;
  3194. _STARASN :
  3195. begin
  3196. consume(_STARASN );
  3197. p2:=sub_expr(opcompare,true,false,nil);
  3198. p1:=gen_c_style_operator(muln,p1,p2);
  3199. end;
  3200. _SLASHASN :
  3201. begin
  3202. consume(_SLASHASN );
  3203. p2:=sub_expr(opcompare,true,false,nil);
  3204. p1:=gen_c_style_operator(slashn,p1,p2);
  3205. end;
  3206. else
  3207. updatefpos:=false;
  3208. end;
  3209. { get the resultdef for this expression }
  3210. if not assigned(p1.resultdef) and
  3211. dotypecheck then
  3212. do_typecheckpass(p1);
  3213. afterassignment:=oldafterassignment;
  3214. if updatefpos then
  3215. p1.fileinfo:=filepos;
  3216. expr:=p1;
  3217. end;
  3218. function get_intconst:TConstExprInt;
  3219. {Reads an expression, tries to evalute it and check if it is an integer
  3220. constant. Then the constant is returned.}
  3221. var
  3222. p:tnode;
  3223. begin
  3224. result:=0;
  3225. p:=comp_expr(true,false);
  3226. if not codegenerror then
  3227. begin
  3228. if (p.nodetype<>ordconstn) or
  3229. not(is_integer(p.resultdef)) then
  3230. Message(parser_e_illegal_expression)
  3231. else
  3232. result:=tordconstnode(p).value;
  3233. end;
  3234. p.free;
  3235. end;
  3236. function get_stringconst:string;
  3237. {Reads an expression, tries to evaluate it and checks if it is a string
  3238. constant. Then the constant is returned.}
  3239. var
  3240. p:tnode;
  3241. begin
  3242. get_stringconst:='';
  3243. p:=comp_expr(true,false);
  3244. if p.nodetype<>stringconstn then
  3245. begin
  3246. if (p.nodetype=ordconstn) and is_char(p.resultdef) then
  3247. get_stringconst:=char(int64(tordconstnode(p).value))
  3248. else
  3249. Message(parser_e_illegal_expression);
  3250. end
  3251. else
  3252. get_stringconst:=strpas(tstringconstnode(p).value_str);
  3253. p.free;
  3254. end;
  3255. end.