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