pexpr.pas 120 KB

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