pexpr.pas 120 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060
  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 is_objcclass(ttypesym(sym).typedef)) and
  1180. not(block_type in [bt_type,bt_const_type,bt_var_type]) then
  1181. p1:=cloadvmtaddrnode.create(p1);
  1182. end;
  1183. end;
  1184. constsym:
  1185. begin
  1186. p1.free;
  1187. p1:=genconstsymtree(tconstsym(sym));
  1188. end;
  1189. staticvarsym:
  1190. begin
  1191. { typed constant is a staticvarsym
  1192. now they are absolutevarsym }
  1193. p1.free;
  1194. p1:=cloadnode.create(sym,sym.Owner);
  1195. end;
  1196. absolutevarsym:
  1197. begin
  1198. p1.free;
  1199. p1:=nil;
  1200. { typed constants are absolutebarsyms now to handle storage properly }
  1201. propaccesslist_to_node(p1,nil,tabsolutevarsym(sym).ref);
  1202. end
  1203. else
  1204. internalerror(16);
  1205. end;
  1206. end;
  1207. end;
  1208. {****************************************************************************
  1209. Factor
  1210. ****************************************************************************}
  1211. function is_member_read(sym: tsym; st: tsymtable; var p1: tnode;
  1212. out memberparentdef: tdef): boolean;
  1213. var
  1214. hdef : tdef;
  1215. begin
  1216. result:=true;
  1217. memberparentdef:=nil;
  1218. case st.symtabletype of
  1219. ObjectSymtable,
  1220. recordsymtable:
  1221. begin
  1222. memberparentdef:=tdef(st.defowner);
  1223. exit;
  1224. end;
  1225. WithSymtable:
  1226. begin
  1227. if assigned(p1) then
  1228. internalerror(2007012002);
  1229. hdef:=tnode(twithsymtable(st).withrefnode).resultdef;
  1230. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  1231. if not(hdef.typ in [objectdef,classrefdef]) then
  1232. exit;
  1233. if (hdef.typ=classrefdef) then
  1234. hdef:=tclassrefdef(hdef).pointeddef;
  1235. memberparentdef:=hdef;
  1236. end;
  1237. else
  1238. result:=false;
  1239. end;
  1240. end;
  1241. {$maxfpuregisters 0}
  1242. function factor(getaddr,typeonly:boolean) : tnode;
  1243. {---------------------------------------------
  1244. Factor_read_id
  1245. ---------------------------------------------}
  1246. procedure factor_read_id(out p1:tnode;var again:boolean);
  1247. var
  1248. srsym : tsym;
  1249. srsymtable : TSymtable;
  1250. hdef : tdef;
  1251. orgstoredpattern,
  1252. storedpattern : string;
  1253. callflags: tcallnodeflags;
  1254. t : ttoken;
  1255. unit_found : boolean;
  1256. begin
  1257. { allow post fix operators }
  1258. again:=true;
  1259. { first check for identifier }
  1260. if token<>_ID then
  1261. begin
  1262. srsym:=generrorsym;
  1263. srsymtable:=nil;
  1264. consume(_ID);
  1265. end
  1266. else
  1267. begin
  1268. if typeonly then
  1269. searchsym_type(pattern,srsym,srsymtable)
  1270. else
  1271. searchsym(pattern,srsym,srsymtable);
  1272. { handle unit specification like System.Writeln }
  1273. unit_found:=try_consume_unitsym(srsym,srsymtable,t);
  1274. storedpattern:=pattern;
  1275. orgstoredpattern:=orgpattern;
  1276. consume(t);
  1277. { named parameter support }
  1278. found_arg_name:=false;
  1279. if not(unit_found) and
  1280. named_args_allowed and
  1281. (token=_ASSIGNMENT) then
  1282. begin
  1283. found_arg_name:=true;
  1284. p1:=cstringconstnode.createstr(storedpattern);
  1285. consume(_ASSIGNMENT);
  1286. exit;
  1287. end;
  1288. { if nothing found give error and return errorsym }
  1289. if assigned(srsym) then
  1290. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg)
  1291. else
  1292. begin
  1293. identifier_not_found(orgstoredpattern);
  1294. srsym:=generrorsym;
  1295. srsymtable:=nil;
  1296. end;
  1297. end;
  1298. { Access to funcret or need to call the function? }
  1299. if (srsym.typ in [absolutevarsym,localvarsym,paravarsym]) and
  1300. (vo_is_funcret in tabstractvarsym(srsym).varoptions) and
  1301. { result(x) is not allowed }
  1302. not(vo_is_result in tabstractvarsym(srsym).varoptions) and
  1303. (
  1304. (token=_LKLAMMER) or
  1305. (
  1306. (
  1307. (m_tp7 in current_settings.modeswitches) or
  1308. (m_delphi in current_settings.modeswitches)
  1309. ) and
  1310. (afterassignment or in_args)
  1311. )
  1312. ) then
  1313. begin
  1314. hdef:=tdef(srsym.owner.defowner);
  1315. if assigned(hdef) and
  1316. (hdef.typ=procdef) then
  1317. srsym:=tprocdef(hdef).procsym
  1318. else
  1319. begin
  1320. Message(parser_e_illegal_expression);
  1321. srsym:=generrorsym;
  1322. end;
  1323. srsymtable:=srsym.owner;
  1324. end;
  1325. begin
  1326. case srsym.typ of
  1327. absolutevarsym :
  1328. begin
  1329. if (tabsolutevarsym(srsym).abstyp=tovar) then
  1330. begin
  1331. p1:=nil;
  1332. propaccesslist_to_node(p1,nil,tabsolutevarsym(srsym).ref);
  1333. p1:=ctypeconvnode.create(p1,tabsolutevarsym(srsym).vardef);
  1334. include(p1.flags,nf_absolute);
  1335. end
  1336. else
  1337. p1:=cloadnode.create(srsym,srsymtable);
  1338. end;
  1339. staticvarsym,
  1340. localvarsym,
  1341. paravarsym,
  1342. fieldvarsym :
  1343. begin
  1344. { check if we are reading a field of an object/class/ }
  1345. { record. is_member_read() will deal with withsymtables }
  1346. { if needed. }
  1347. p1:=nil;
  1348. if is_member_read(srsym,srsymtable,p1,hdef) then
  1349. begin
  1350. { if the field was originally found in an }
  1351. { objectsymtable, it means it's part of self
  1352. if only method from which it was called is
  1353. not class static }
  1354. if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
  1355. if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
  1356. p1:=cloadvmtaddrnode.create(ctypenode.create(current_procinfo.procdef.struct))
  1357. else
  1358. p1:=load_self_node;
  1359. { now, if the field itself is part of an objectsymtab }
  1360. { (it can be even if it was found in a withsymtable, }
  1361. { e.g., "with classinstance do field := 5"), then }
  1362. { let do_member_read handle it }
  1363. if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  1364. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[])
  1365. else
  1366. { otherwise it's a regular record subscript }
  1367. p1:=csubscriptnode.create(srsym,p1);
  1368. end
  1369. else
  1370. { regular non-field load }
  1371. p1:=cloadnode.create(srsym,srsymtable);
  1372. end;
  1373. syssym :
  1374. begin
  1375. p1:=statement_syssym(tsyssym(srsym).number);
  1376. end;
  1377. typesym :
  1378. begin
  1379. hdef:=ttypesym(srsym).typedef;
  1380. if not assigned(hdef) then
  1381. begin
  1382. again:=false;
  1383. end
  1384. else
  1385. begin
  1386. { We need to know if this unit uses Variants }
  1387. if (hdef=cvarianttype) and
  1388. not(cs_compilesystem in current_settings.moduleswitches) then
  1389. current_module.flags:=current_module.flags or uf_uses_variants;
  1390. { if we get a generic then check that it is not an inline specialization }
  1391. if (df_generic in hdef.defoptions) and
  1392. (token=_LT) and
  1393. (m_delphi in current_settings.modeswitches) then
  1394. generate_specialization(hdef,false,'');
  1395. if try_to_consume(_LKLAMMER) then
  1396. begin
  1397. p1:=comp_expr(true,false);
  1398. consume(_RKLAMMER);
  1399. { type casts to class helpers aren't allowed }
  1400. if is_objectpascal_helper(hdef) then
  1401. Message(parser_e_no_category_as_types)
  1402. { recovery by not creating a conversion node }
  1403. else
  1404. p1:=ctypeconvnode.create_explicit(p1,hdef);
  1405. end
  1406. else { not LKLAMMER }
  1407. if (token=_POINT) and
  1408. (is_object(hdef) or is_record(hdef)) then
  1409. begin
  1410. consume(_POINT);
  1411. { handles calling methods declared in parent objects
  1412. using "parentobject.methodname()" }
  1413. if assigned(current_structdef) and
  1414. not(getaddr) and
  1415. current_structdef.is_related(hdef) then
  1416. begin
  1417. p1:=ctypenode.create(hdef);
  1418. { search also in inherited methods }
  1419. searchsym_in_class(tobjectdef(hdef),tobjectdef(current_structdef),pattern,srsym,srsymtable,true);
  1420. if assigned(srsym) then
  1421. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1422. consume(_ID);
  1423. do_member_read(tabstractrecorddef(hdef),false,srsym,p1,again,[]);
  1424. end
  1425. else
  1426. begin
  1427. { handles:
  1428. * @TObject.Load
  1429. * static methods and variables }
  1430. p1:=ctypenode.create(hdef);
  1431. { TP allows also @TMenu.Load if Load is only }
  1432. { defined in an anchestor class }
  1433. srsym:=search_struct_member(tabstractrecorddef(hdef),pattern);
  1434. if assigned(srsym) then
  1435. begin
  1436. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1437. consume(_ID);
  1438. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[]);
  1439. end
  1440. else
  1441. Message1(sym_e_id_no_member,orgpattern);
  1442. end;
  1443. end
  1444. else
  1445. begin
  1446. { Normally here would be the check against the usage
  1447. of "TClassHelper.Something", but as that might be
  1448. used inside of system symbols like sizeof and
  1449. typeinfo this check is put into ttypenode.pass_1
  1450. (for "TClassHelper" alone) and tcallnode.pass_1
  1451. (for "TClassHelper.Something") }
  1452. { class reference ? }
  1453. if is_class(hdef) or
  1454. is_objcclass(hdef) then
  1455. begin
  1456. if getaddr and (token=_POINT) then
  1457. begin
  1458. consume(_POINT);
  1459. { allows @Object.Method }
  1460. { also allows static methods and variables }
  1461. p1:=ctypenode.create(hdef);
  1462. { TP allows also @TMenu.Load if Load is only }
  1463. { defined in an anchestor class }
  1464. srsym:=search_struct_member(tobjectdef(hdef),pattern);
  1465. if assigned(srsym) then
  1466. begin
  1467. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1468. consume(_ID);
  1469. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[]);
  1470. end
  1471. else
  1472. begin
  1473. Message1(sym_e_id_no_member,orgpattern);
  1474. consume(_ID);
  1475. end;
  1476. end
  1477. else
  1478. begin
  1479. p1:=ctypenode.create(hdef);
  1480. { For a type block we simply return only
  1481. the type. For all other blocks we return
  1482. a loadvmt node }
  1483. if not(block_type in [bt_type,bt_const_type,bt_var_type]) then
  1484. p1:=cloadvmtaddrnode.create(p1);
  1485. end;
  1486. end
  1487. else
  1488. p1:=ctypenode.create(hdef);
  1489. end;
  1490. end;
  1491. end;
  1492. enumsym :
  1493. begin
  1494. p1:=genenumnode(tenumsym(srsym));
  1495. end;
  1496. constsym :
  1497. begin
  1498. if tconstsym(srsym).consttyp=constresourcestring then
  1499. begin
  1500. p1:=cloadnode.create(srsym,srsymtable);
  1501. do_typecheckpass(p1);
  1502. p1.resultdef:=cansistringtype;
  1503. end
  1504. else
  1505. p1:=genconstsymtree(tconstsym(srsym));
  1506. end;
  1507. procsym :
  1508. begin
  1509. p1:=nil;
  1510. { check if it's a method/class method }
  1511. if is_member_read(srsym,srsymtable,p1,hdef) then
  1512. begin
  1513. { not srsymtable.symtabletype since that can be }
  1514. { withsymtable as well }
  1515. if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  1516. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[])
  1517. else
  1518. { no procsyms in records (yet) }
  1519. internalerror(2007012006);
  1520. end
  1521. else
  1522. begin
  1523. { regular procedure/function call }
  1524. if not unit_found then
  1525. callflags:=[]
  1526. else
  1527. callflags:=[cnf_unit_specified];
  1528. do_proc_call(srsym,srsymtable,nil,
  1529. (getaddr and not(token in [_CARET,_POINT,_LECKKLAMMER])),
  1530. again,p1,callflags);
  1531. end;
  1532. end;
  1533. propertysym :
  1534. begin
  1535. p1:=nil;
  1536. { property of a class/object? }
  1537. if is_member_read(srsym,srsymtable,p1,hdef) then
  1538. begin
  1539. if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
  1540. if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
  1541. { no self node in static class methods }
  1542. p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))
  1543. else
  1544. p1:=load_self_node;
  1545. { not srsymtable.symtabletype since that can be }
  1546. { withsymtable as well }
  1547. if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  1548. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[])
  1549. else
  1550. { no propertysyms in records (yet) }
  1551. internalerror(2009111510);
  1552. end
  1553. else
  1554. { no method pointer }
  1555. begin
  1556. handle_propertysym(tpropertysym(srsym),srsymtable,p1);
  1557. end;
  1558. end;
  1559. labelsym :
  1560. begin
  1561. { Support @label }
  1562. if getaddr then
  1563. begin
  1564. if srsym.owner<>current_procinfo.procdef.localst then
  1565. CGMessage(parser_e_label_outside_proc);
  1566. p1:=cloadnode.create(srsym,srsym.owner)
  1567. end
  1568. else
  1569. begin
  1570. consume(_COLON);
  1571. if tlabelsym(srsym).defined then
  1572. Message(sym_e_label_already_defined);
  1573. if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
  1574. begin
  1575. tlabelsym(srsym).nonlocal:=true;
  1576. exclude(current_procinfo.procdef.procoptions,po_inline);
  1577. end;
  1578. if tlabelsym(srsym).nonlocal and
  1579. (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
  1580. Message(sym_e_interprocgoto_into_init_final_code_not_allowed);
  1581. tlabelsym(srsym).defined:=true;
  1582. p1:=clabelnode.create(nil,tlabelsym(srsym));
  1583. tlabelsym(srsym).code:=p1;
  1584. end;
  1585. end;
  1586. errorsym :
  1587. begin
  1588. p1:=cerrornode.create;
  1589. if try_to_consume(_LKLAMMER) then
  1590. begin
  1591. parse_paras(false,false,_RKLAMMER);
  1592. consume(_RKLAMMER);
  1593. end;
  1594. end;
  1595. else
  1596. begin
  1597. p1:=cerrornode.create;
  1598. Message(parser_e_illegal_expression);
  1599. end;
  1600. end; { end case }
  1601. end;
  1602. end;
  1603. {---------------------------------------------
  1604. Factor_Read_Set
  1605. ---------------------------------------------}
  1606. { Read a set between [] }
  1607. function factor_read_set:tnode;
  1608. var
  1609. p1,p2 : tnode;
  1610. lastp,
  1611. buildp : tarrayconstructornode;
  1612. old_allow_array_constructor : boolean;
  1613. begin
  1614. buildp:=nil;
  1615. { be sure that a least one arrayconstructn is used, also for an
  1616. empty [] }
  1617. if token=_RECKKLAMMER then
  1618. buildp:=carrayconstructornode.create(nil,buildp)
  1619. else
  1620. repeat
  1621. { nested array constructors are not allowed, see also tests/webtbs/tw17213.pp }
  1622. old_allow_array_constructor:=allow_array_constructor;
  1623. allow_array_constructor:=false;
  1624. p1:=comp_expr(true,false);
  1625. if try_to_consume(_POINTPOINT) then
  1626. begin
  1627. p2:=comp_expr(true,false);
  1628. p1:=carrayconstructorrangenode.create(p1,p2);
  1629. end;
  1630. { insert at the end of the tree, to get the correct order }
  1631. if not assigned(buildp) then
  1632. begin
  1633. buildp:=carrayconstructornode.create(p1,nil);
  1634. lastp:=buildp;
  1635. end
  1636. else
  1637. begin
  1638. lastp.right:=carrayconstructornode.create(p1,nil);
  1639. lastp:=tarrayconstructornode(lastp.right);
  1640. end;
  1641. allow_array_constructor:=old_allow_array_constructor;
  1642. { there could be more elements }
  1643. until not try_to_consume(_COMMA);
  1644. factor_read_set:=buildp;
  1645. end;
  1646. {---------------------------------------------
  1647. PostFixOperators
  1648. ---------------------------------------------}
  1649. { returns whether or not p1 has been changed }
  1650. function postfixoperators(var p1:tnode;var again:boolean): boolean;
  1651. { tries to avoid syntax errors after invalid qualifiers }
  1652. procedure recoverconsume_postfixops;
  1653. begin
  1654. repeat
  1655. if not try_to_consume(_CARET) then
  1656. if try_to_consume(_POINT) then
  1657. try_to_consume(_ID)
  1658. else if try_to_consume(_LECKKLAMMER) then
  1659. begin
  1660. repeat
  1661. comp_expr(true,false);
  1662. until not try_to_consume(_COMMA);
  1663. consume(_RECKKLAMMER);
  1664. end
  1665. else if try_to_consume(_LKLAMMER) then
  1666. begin
  1667. repeat
  1668. comp_expr(true,false);
  1669. until not try_to_consume(_COMMA);
  1670. consume(_RKLAMMER);
  1671. end
  1672. else
  1673. break;
  1674. until false;
  1675. end;
  1676. procedure handle_variantarray;
  1677. var
  1678. p4 : tnode;
  1679. newstatement : tstatementnode;
  1680. tempresultvariant,
  1681. temp : ttempcreatenode;
  1682. paras : tcallparanode;
  1683. newblock : tnode;
  1684. countindices : aint;
  1685. begin
  1686. { create statements with call initialize the arguments and
  1687. call fpc_dynarr_setlength }
  1688. newblock:=internalstatements(newstatement);
  1689. { get temp for array of indicies,
  1690. we set the real size later }
  1691. temp:=ctempcreatenode.create(s32inttype,4,tt_persistent,false);
  1692. addstatement(newstatement,temp);
  1693. countindices:=0;
  1694. repeat
  1695. p4:=comp_expr(true,false);
  1696. addstatement(newstatement,cassignmentnode.create(
  1697. ctemprefnode.create_offset(temp,countindices*s32inttype.size),p4));
  1698. inc(countindices);
  1699. until not try_to_consume(_COMMA);
  1700. { set real size }
  1701. temp.size:=countindices*s32inttype.size;
  1702. consume(_RECKKLAMMER);
  1703. { we need only a write access if a := follows }
  1704. if token=_ASSIGNMENT then
  1705. begin
  1706. consume(_ASSIGNMENT);
  1707. p4:=comp_expr(true,false);
  1708. { create call to fpc_vararray_put }
  1709. paras:=ccallparanode.create(cordconstnode.create
  1710. (countindices,s32inttype,true),
  1711. ccallparanode.create(caddrnode.create_internal
  1712. (ctemprefnode.create(temp)),
  1713. ccallparanode.create(ctypeconvnode.create_internal(p4,cvarianttype),
  1714. ccallparanode.create(ctypeconvnode.create_internal(p1,cvarianttype)
  1715. ,nil))));
  1716. addstatement(newstatement,ccallnode.createintern('fpc_vararray_put',paras));
  1717. addstatement(newstatement,ctempdeletenode.create(temp));
  1718. end
  1719. else
  1720. begin
  1721. { create temp for result }
  1722. tempresultvariant:=ctempcreatenode.create(cvarianttype,cvarianttype.size,tt_persistent,true);
  1723. addstatement(newstatement,tempresultvariant);
  1724. { create call to fpc_vararray_get }
  1725. paras:=ccallparanode.create(cordconstnode.create
  1726. (countindices,s32inttype,true),
  1727. ccallparanode.create(caddrnode.create_internal
  1728. (ctemprefnode.create(temp)),
  1729. ccallparanode.create(p1,
  1730. ccallparanode.create(
  1731. ctemprefnode.create(tempresultvariant)
  1732. ,nil))));
  1733. addstatement(newstatement,ccallnode.createintern('fpc_vararray_get',paras));
  1734. addstatement(newstatement,ctempdeletenode.create(temp));
  1735. { the last statement should return the value as
  1736. location and type, this is done be referencing the
  1737. temp and converting it first from a persistent temp to
  1738. normal temp }
  1739. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempresultvariant));
  1740. addstatement(newstatement,ctemprefnode.create(tempresultvariant));
  1741. end;
  1742. p1:=newblock;
  1743. end;
  1744. var
  1745. protsym : tpropertysym;
  1746. p2,p3 : tnode;
  1747. srsym : tsym;
  1748. srsymtable : TSymtable;
  1749. structh : tabstractrecorddef;
  1750. { shouldn't be used that often, so the extra overhead is ok to save
  1751. stack space }
  1752. dispatchstring : ansistring;
  1753. nodechanged : boolean;
  1754. calltype: tdispcalltype;
  1755. label
  1756. skipreckklammercheck;
  1757. begin
  1758. result:=false;
  1759. again:=true;
  1760. while again do
  1761. begin
  1762. { we need the resultdef }
  1763. do_typecheckpass_changed(p1,nodechanged);
  1764. result:=result or nodechanged;
  1765. if codegenerror then
  1766. begin
  1767. recoverconsume_postfixops;
  1768. exit;
  1769. end;
  1770. { handle token }
  1771. case token of
  1772. _CARET:
  1773. begin
  1774. consume(_CARET);
  1775. { support tp/mac procvar^ if the procvar returns a
  1776. pointer type }
  1777. if ((m_tp_procvar in current_settings.modeswitches) or
  1778. (m_mac_procvar in current_settings.modeswitches)) and
  1779. (p1.resultdef.typ=procvardef) and
  1780. (tprocvardef(p1.resultdef).returndef.typ=pointerdef) then
  1781. begin
  1782. p1:=ccallnode.create_procvar(nil,p1);
  1783. typecheckpass(p1);
  1784. end;
  1785. if (p1.resultdef.typ<>pointerdef) then
  1786. begin
  1787. { ^ as binary operator is a problem!!!! (FK) }
  1788. again:=false;
  1789. Message(parser_e_invalid_qualifier);
  1790. recoverconsume_postfixops;
  1791. p1.destroy;
  1792. p1:=cerrornode.create;
  1793. end
  1794. else
  1795. p1:=cderefnode.create(p1);
  1796. end;
  1797. _LECKKLAMMER:
  1798. begin
  1799. if is_class_or_interface_or_object(p1.resultdef) or
  1800. is_dispinterface(p1.resultdef) or is_record(p1.resultdef) then
  1801. begin
  1802. { default property }
  1803. protsym:=search_default_property(tabstractrecorddef(p1.resultdef));
  1804. if not(assigned(protsym)) then
  1805. begin
  1806. p1.destroy;
  1807. p1:=cerrornode.create;
  1808. again:=false;
  1809. message(parser_e_no_default_property_available);
  1810. end
  1811. else
  1812. begin
  1813. { The property symbol is referenced indirect }
  1814. protsym.IncRefCount;
  1815. handle_propertysym(protsym,protsym.owner,p1);
  1816. end;
  1817. end
  1818. else
  1819. begin
  1820. consume(_LECKKLAMMER);
  1821. repeat
  1822. { in all of the cases below, p1 is changed }
  1823. case p1.resultdef.typ of
  1824. pointerdef:
  1825. begin
  1826. { support delphi autoderef }
  1827. if (tpointerdef(p1.resultdef).pointeddef.typ=arraydef) and
  1828. (m_autoderef in current_settings.modeswitches) then
  1829. p1:=cderefnode.create(p1);
  1830. p2:=comp_expr(true,false);
  1831. { Support Pbytevar[0..9] which returns array [0..9].}
  1832. if try_to_consume(_POINTPOINT) then
  1833. p2:=crangenode.create(p2,comp_expr(true,false));
  1834. p1:=cvecnode.create(p1,p2);
  1835. end;
  1836. variantdef:
  1837. begin
  1838. handle_variantarray;
  1839. { the RECKKLAMMER is already read }
  1840. goto skipreckklammercheck;
  1841. end;
  1842. stringdef :
  1843. begin
  1844. p2:=comp_expr(true,false);
  1845. { Support string[0..9] which returns array [0..9] of char.}
  1846. if try_to_consume(_POINTPOINT) then
  1847. p2:=crangenode.create(p2,comp_expr(true,false));
  1848. p1:=cvecnode.create(p1,p2);
  1849. end;
  1850. arraydef:
  1851. begin
  1852. p2:=comp_expr(true,false);
  1853. { support SEG:OFS for go32v2 Mem[] }
  1854. if (target_info.system in [system_i386_go32v2,system_i386_watcom]) and
  1855. (p1.nodetype=loadn) and
  1856. assigned(tloadnode(p1).symtableentry) and
  1857. assigned(tloadnode(p1).symtableentry.owner.name) and
  1858. (tloadnode(p1).symtableentry.owner.name^='SYSTEM') and
  1859. ((tloadnode(p1).symtableentry.name='MEM') or
  1860. (tloadnode(p1).symtableentry.name='MEMW') or
  1861. (tloadnode(p1).symtableentry.name='MEML')) then
  1862. begin
  1863. if try_to_consume(_COLON) then
  1864. begin
  1865. p3:=caddnode.create(muln,cordconstnode.create($10,s32inttype,false),p2);
  1866. p2:=comp_expr(true,false);
  1867. p2:=caddnode.create(addn,p2,p3);
  1868. if try_to_consume(_POINTPOINT) then
  1869. { Support mem[$a000:$0000..$07ff] which returns array [0..$7ff] of memtype.}
  1870. p2:=crangenode.create(p2,caddnode.create(addn,comp_expr(true,false),p3.getcopy));
  1871. p1:=cvecnode.create(p1,p2);
  1872. include(tvecnode(p1).flags,nf_memseg);
  1873. include(tvecnode(p1).flags,nf_memindex);
  1874. end
  1875. else
  1876. begin
  1877. if try_to_consume(_POINTPOINT) then
  1878. { Support mem[$80000000..$80000002] which returns array [0..2] of memtype.}
  1879. p2:=crangenode.create(p2,comp_expr(true,false));
  1880. p1:=cvecnode.create(p1,p2);
  1881. include(tvecnode(p1).flags,nf_memindex);
  1882. end;
  1883. end
  1884. else
  1885. begin
  1886. if try_to_consume(_POINTPOINT) then
  1887. { Support arrayvar[0..9] which returns array [0..9] of arraytype.}
  1888. p2:=crangenode.create(p2,comp_expr(true,false));
  1889. p1:=cvecnode.create(p1,p2);
  1890. end;
  1891. end;
  1892. else
  1893. begin
  1894. if p1.resultdef.typ<>undefineddef then
  1895. Message(parser_e_invalid_qualifier);
  1896. p1.destroy;
  1897. p1:=cerrornode.create;
  1898. comp_expr(true,false);
  1899. again:=false;
  1900. end;
  1901. end;
  1902. do_typecheckpass(p1);
  1903. until not try_to_consume(_COMMA);
  1904. consume(_RECKKLAMMER);
  1905. { handle_variantarray eats the RECKKLAMMER and jumps here }
  1906. skipreckklammercheck:
  1907. end;
  1908. end;
  1909. _POINT :
  1910. begin
  1911. consume(_POINT);
  1912. if (p1.resultdef.typ=pointerdef) and
  1913. (m_autoderef in current_settings.modeswitches) and
  1914. { don't auto-deref objc.id, because then the code
  1915. below for supporting id.anyobjcmethod isn't triggered }
  1916. (p1.resultdef<>objc_idtype) then
  1917. begin
  1918. p1:=cderefnode.create(p1);
  1919. do_typecheckpass(p1);
  1920. end;
  1921. { procvar.<something> can never mean anything so always
  1922. try to call it in case it returns a record/object/... }
  1923. maybe_call_procvar(p1,false);
  1924. case p1.resultdef.typ of
  1925. recorddef:
  1926. begin
  1927. if token=_ID then
  1928. begin
  1929. structh:=tabstractrecorddef(p1.resultdef);
  1930. searchsym_in_record(structh,pattern,srsym,srsymtable);
  1931. if assigned(srsym) then
  1932. begin
  1933. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1934. consume(_ID);
  1935. do_member_read(structh,getaddr,srsym,p1,again,[]);
  1936. end
  1937. else
  1938. begin
  1939. Message1(sym_e_id_no_member,orgpattern);
  1940. p1.destroy;
  1941. p1:=cerrornode.create;
  1942. { try to clean up }
  1943. consume(_ID);
  1944. end;
  1945. end
  1946. else
  1947. consume(_ID);
  1948. end;
  1949. enumdef:
  1950. begin
  1951. if token=_ID then
  1952. begin
  1953. srsym:=tsym(tenumdef(p1.resultdef).symtable.Find(pattern));
  1954. p1.destroy;
  1955. if assigned(srsym) and (srsym.typ=enumsym) then
  1956. begin
  1957. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1958. p1:=genenumnode(tenumsym(srsym));
  1959. end
  1960. else
  1961. begin
  1962. Message1(sym_e_id_no_member,orgpattern);
  1963. p1:=cerrornode.create;
  1964. end;
  1965. end;
  1966. consume(_ID);
  1967. end;
  1968. variantdef:
  1969. begin
  1970. { dispatch call? }
  1971. { lhs := v.ident[parameters] -> property get
  1972. lhs := v.ident(parameters) -> method call
  1973. v.ident[parameters] := rhs -> property put
  1974. v.ident(parameters) := rhs -> also property put }
  1975. if token=_ID then
  1976. begin
  1977. dispatchstring:=orgpattern;
  1978. consume(_ID);
  1979. calltype:=dct_method;
  1980. if try_to_consume(_LKLAMMER) then
  1981. begin
  1982. p2:=parse_paras(false,true,_RKLAMMER);
  1983. consume(_RKLAMMER);
  1984. end
  1985. else if try_to_consume(_LECKKLAMMER) then
  1986. begin
  1987. p2:=parse_paras(false,true,_RECKKLAMMER);
  1988. consume(_RECKKLAMMER);
  1989. calltype:=dct_propget;
  1990. end
  1991. else
  1992. p2:=nil;
  1993. { property setter? }
  1994. if (token=_ASSIGNMENT) and not(afterassignment) then
  1995. begin
  1996. consume(_ASSIGNMENT);
  1997. { read the expression }
  1998. p3:=comp_expr(true,false);
  1999. { concat value parameter too }
  2000. p2:=ccallparanode.create(p3,p2);
  2001. p1:=translate_disp_call(p1,p2,dct_propput,dispatchstring,0,voidtype);
  2002. end
  2003. else
  2004. { this is only an approximation
  2005. setting useresult if not necessary is only a waste of time, no more, no less (FK) }
  2006. if afterassignment or in_args or (token<>_SEMICOLON) then
  2007. p1:=translate_disp_call(p1,p2,calltype,dispatchstring,0,cvarianttype)
  2008. else
  2009. p1:=translate_disp_call(p1,p2,calltype,dispatchstring,0,voidtype);
  2010. end
  2011. else { Error }
  2012. Consume(_ID);
  2013. end;
  2014. classrefdef:
  2015. begin
  2016. if token=_ID then
  2017. begin
  2018. structh:=tobjectdef(tclassrefdef(p1.resultdef).pointeddef);
  2019. searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,true);
  2020. if assigned(srsym) then
  2021. begin
  2022. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  2023. consume(_ID);
  2024. do_member_read(structh,getaddr,srsym,p1,again,[]);
  2025. end
  2026. else
  2027. begin
  2028. Message1(sym_e_id_no_member,orgpattern);
  2029. p1.destroy;
  2030. p1:=cerrornode.create;
  2031. { try to clean up }
  2032. consume(_ID);
  2033. end;
  2034. end
  2035. else { Error }
  2036. Consume(_ID);
  2037. end;
  2038. objectdef:
  2039. begin
  2040. if token=_ID then
  2041. begin
  2042. structh:=tobjectdef(p1.resultdef);
  2043. searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,true);
  2044. if assigned(srsym) then
  2045. begin
  2046. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  2047. consume(_ID);
  2048. do_member_read(structh,getaddr,srsym,p1,again,[]);
  2049. end
  2050. else
  2051. begin
  2052. Message1(sym_e_id_no_member,orgpattern);
  2053. p1.destroy;
  2054. p1:=cerrornode.create;
  2055. { try to clean up }
  2056. consume(_ID);
  2057. end;
  2058. end
  2059. else { Error }
  2060. Consume(_ID);
  2061. end;
  2062. pointerdef:
  2063. begin
  2064. if (p1.resultdef=objc_idtype) then
  2065. begin
  2066. { objc's id type can be used to call any
  2067. Objective-C method of any Objective-C class
  2068. type that's currently in scope }
  2069. if search_objc_method(pattern,srsym,srsymtable) then
  2070. begin
  2071. consume(_ID);
  2072. do_proc_call(srsym,srsymtable,nil,
  2073. (getaddr and not(token in [_CARET,_POINT])),
  2074. again,p1,[cnf_objc_id_call]);
  2075. { we need to know which procedure is called }
  2076. do_typecheckpass(p1);
  2077. end
  2078. else
  2079. begin
  2080. consume(_ID);
  2081. Message(parser_e_methode_id_expected);
  2082. end;
  2083. end
  2084. else
  2085. begin
  2086. Message(parser_e_invalid_qualifier);
  2087. if tpointerdef(p1.resultdef).pointeddef.typ in [recorddef,objectdef,classrefdef] then
  2088. Message(parser_h_maybe_deref_caret_missing);
  2089. end
  2090. end;
  2091. else
  2092. begin
  2093. if p1.resultdef.typ<>undefineddef then
  2094. Message(parser_e_invalid_qualifier);
  2095. p1.destroy;
  2096. p1:=cerrornode.create;
  2097. { Error }
  2098. consume(_ID);
  2099. end;
  2100. end;
  2101. end;
  2102. else
  2103. begin
  2104. { is this a procedure variable ? }
  2105. if assigned(p1.resultdef) and
  2106. (p1.resultdef.typ=procvardef) then
  2107. begin
  2108. { Typenode for typecasting or expecting a procvar }
  2109. if (p1.nodetype=typen) or
  2110. (
  2111. assigned(getprocvardef) and
  2112. equal_defs(p1.resultdef,getprocvardef)
  2113. ) then
  2114. begin
  2115. if try_to_consume(_LKLAMMER) then
  2116. begin
  2117. p1:=comp_expr(true,false);
  2118. consume(_RKLAMMER);
  2119. p1:=ctypeconvnode.create_explicit(p1,p1.resultdef);
  2120. end
  2121. else
  2122. again:=false
  2123. end
  2124. else
  2125. begin
  2126. if try_to_consume(_LKLAMMER) then
  2127. begin
  2128. p2:=parse_paras(false,false,_RKLAMMER);
  2129. consume(_RKLAMMER);
  2130. p1:=ccallnode.create_procvar(p2,p1);
  2131. { proc():= is never possible }
  2132. if token=_ASSIGNMENT then
  2133. begin
  2134. Message(parser_e_illegal_expression);
  2135. p1.free;
  2136. p1:=cerrornode.create;
  2137. again:=false;
  2138. end;
  2139. end
  2140. else
  2141. again:=false;
  2142. end;
  2143. end
  2144. else
  2145. again:=false;
  2146. end;
  2147. end;
  2148. { we only try again if p1 was changed }
  2149. if again or
  2150. (p1.nodetype=errorn) then
  2151. result:=true;
  2152. end; { while again }
  2153. end;
  2154. {---------------------------------------------
  2155. Factor (Main)
  2156. ---------------------------------------------}
  2157. var
  2158. l : longint;
  2159. ic : int64;
  2160. qc : qword;
  2161. p1 : tnode;
  2162. code : integer;
  2163. srsym : tsym;
  2164. srsymtable : TSymtable;
  2165. pd : tprocdef;
  2166. hclassdef : tobjectdef;
  2167. d : bestreal;
  2168. cur : currency;
  2169. hs,hsorg : string;
  2170. hdef : tdef;
  2171. filepos : tfileposinfo;
  2172. callflags : tcallnodeflags;
  2173. again,
  2174. updatefpos,
  2175. nodechanged : boolean;
  2176. begin
  2177. { can't keep a copy of p1 and compare pointers afterwards, because
  2178. p1 may be freed and reallocated in the same place! }
  2179. updatefpos:=false;
  2180. p1:=nil;
  2181. filepos:=current_tokenpos;
  2182. again:=false;
  2183. if token=_ID then
  2184. begin
  2185. again:=true;
  2186. { Handle references to self }
  2187. if (idtoken=_SELF) and
  2188. not(block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) and
  2189. assigned(current_structdef) then
  2190. begin
  2191. p1:=load_self_node;
  2192. consume(_ID);
  2193. again:=true;
  2194. end
  2195. else
  2196. factor_read_id(p1,again);
  2197. if assigned(p1) then
  2198. begin
  2199. { factor_read_id will set the filepos to after the id,
  2200. and in case of _SELF the filepos will already be the
  2201. same as filepos (so setting it again doesn't hurt). }
  2202. p1.fileinfo:=filepos;
  2203. filepos:=current_tokenpos;
  2204. end;
  2205. { handle post fix operators }
  2206. updatefpos:=postfixoperators(p1,again);
  2207. end
  2208. else
  2209. begin
  2210. updatefpos:=true;
  2211. case token of
  2212. _RETURN :
  2213. begin
  2214. consume(_RETURN);
  2215. if not(token in [_SEMICOLON,_ELSE,_END]) then
  2216. p1 := cexitnode.create(comp_expr(true,false))
  2217. else
  2218. p1 := cexitnode.create(nil);
  2219. end;
  2220. _INHERITED :
  2221. begin
  2222. again:=true;
  2223. consume(_INHERITED);
  2224. if assigned(current_procinfo) and
  2225. assigned(current_structdef) and
  2226. (current_structdef.typ=objectdef) then
  2227. begin
  2228. { for record helpers in mode Delphi "inherited" is not
  2229. allowed }
  2230. if is_objectpascal_helper(current_structdef) and
  2231. (m_delphi in current_settings.modeswitches) and
  2232. is_record(tobjectdef(current_structdef).extendeddef) then
  2233. Message(parser_e_inherited_not_in_record);
  2234. hclassdef:=tobjectdef(current_structdef).childof;
  2235. { Objective-C categories *replace* methods in the class
  2236. they extend, or add methods to it. So calling an
  2237. inherited method always calls the method inherited from
  2238. the parent of the extended class }
  2239. if is_objccategory(current_structdef) then
  2240. hclassdef:=hclassdef.childof;
  2241. { if inherited; only then we need the method with
  2242. the same name }
  2243. if token <> _ID then
  2244. begin
  2245. hs:=current_procinfo.procdef.procsym.name;
  2246. hsorg:=current_procinfo.procdef.procsym.realname;
  2247. anon_inherited:=true;
  2248. { For message methods we need to search using the message
  2249. number or string }
  2250. pd:=tprocdef(tprocsym(current_procinfo.procdef.procsym).ProcdefList[0]);
  2251. srdef:=nil;
  2252. if (po_msgint in pd.procoptions) then
  2253. searchsym_in_class_by_msgint(hclassdef,pd.messageinf.i,srdef,srsym,srsymtable)
  2254. else
  2255. if (po_msgstr in pd.procoptions) then
  2256. searchsym_in_class_by_msgstr(hclassdef,pd.messageinf.str^,srsym,srsymtable)
  2257. else
  2258. { helpers have their own ways of dealing with inherited }
  2259. if is_objectpascal_helper(current_structdef) then
  2260. searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,true)
  2261. else
  2262. searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable,true);
  2263. end
  2264. else
  2265. begin
  2266. hs:=pattern;
  2267. hsorg:=orgpattern;
  2268. consume(_ID);
  2269. anon_inherited:=false;
  2270. { helpers have their own ways of dealing with inherited }
  2271. if is_objectpascal_helper(current_structdef) then
  2272. searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,true)
  2273. else
  2274. searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable,true);
  2275. end;
  2276. if assigned(srsym) then
  2277. begin
  2278. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  2279. { load the procdef from the inherited class and
  2280. not from self }
  2281. case srsym.typ of
  2282. procsym:
  2283. begin
  2284. if is_objectpascal_helper(current_structdef) then
  2285. begin
  2286. { for a helper load the procdef either from the
  2287. extended type, from the parent helper or from
  2288. the extended type of the parent helper
  2289. depending on the def the found symbol belongs
  2290. to }
  2291. if (srsym.Owner.defowner.typ=objectdef) and
  2292. is_objectpascal_helper(tobjectdef(srsym.Owner.defowner)) then
  2293. if current_structdef.is_related(tdef(srsym.Owner.defowner)) and
  2294. assigned(tobjectdef(current_structdef).childof) then
  2295. hdef:=tobjectdef(current_structdef).childof
  2296. else
  2297. hdef:=tobjectdef(srsym.Owner.defowner).extendeddef
  2298. else
  2299. hdef:=tdef(srsym.Owner.defowner);
  2300. end
  2301. else
  2302. hdef:=hclassdef;
  2303. if (po_classmethod in current_procinfo.procdef.procoptions) or
  2304. (po_staticmethod in current_procinfo.procdef.procoptions) then
  2305. hdef:=tclassrefdef.create(hdef);
  2306. p1:=ctypenode.create(hdef);
  2307. { we need to allow helpers here }
  2308. ttypenode(p1).helperallowed:=true;
  2309. end;
  2310. propertysym:
  2311. ;
  2312. else
  2313. begin
  2314. Message(parser_e_methode_id_expected);
  2315. p1:=cerrornode.create;
  2316. end;
  2317. end;
  2318. callflags:=[cnf_inherited];
  2319. if anon_inherited then
  2320. include(callflags,cnf_anon_inherited);
  2321. do_member_read(hclassdef,getaddr,srsym,p1,again,callflags);
  2322. end
  2323. else
  2324. begin
  2325. if anon_inherited then
  2326. begin
  2327. { For message methods we need to call DefaultHandler }
  2328. if (po_msgint in pd.procoptions) or
  2329. (po_msgstr in pd.procoptions) then
  2330. begin
  2331. searchsym_in_class(hclassdef,hclassdef,'DEFAULTHANDLER',srsym,srsymtable,true);
  2332. if not assigned(srsym) or
  2333. (srsym.typ<>procsym) then
  2334. internalerror(200303171);
  2335. p1:=nil;
  2336. do_proc_call(srsym,srsym.owner,hclassdef,false,again,p1,[]);
  2337. end
  2338. else
  2339. begin
  2340. { we need to ignore the inherited; }
  2341. p1:=cnothingnode.create;
  2342. end;
  2343. end
  2344. else
  2345. begin
  2346. Message1(sym_e_id_no_member,hsorg);
  2347. p1:=cerrornode.create;
  2348. end;
  2349. again:=false;
  2350. end;
  2351. { turn auto inheriting off }
  2352. anon_inherited:=false;
  2353. end
  2354. else
  2355. begin
  2356. { in case of records we use a more clear error message }
  2357. if assigned(current_structdef) and
  2358. (current_structdef.typ=recorddef) then
  2359. Message(parser_e_inherited_not_in_record)
  2360. else
  2361. Message(parser_e_generic_methods_only_in_methods);
  2362. again:=false;
  2363. p1:=cerrornode.create;
  2364. end;
  2365. postfixoperators(p1,again);
  2366. end;
  2367. _INTCONST :
  2368. begin
  2369. {Try first wether the value fits in an int64.}
  2370. val(pattern,ic,code);
  2371. if code=0 then
  2372. begin
  2373. consume(_INTCONST);
  2374. int_to_type(ic,hdef);
  2375. p1:=cordconstnode.create(ic,hdef,true);
  2376. end
  2377. else
  2378. begin
  2379. { try qword next }
  2380. val(pattern,qc,code);
  2381. if code=0 then
  2382. begin
  2383. consume(_INTCONST);
  2384. int_to_type(qc,hdef);
  2385. p1:=cordconstnode.create(qc,hdef,true);
  2386. end;
  2387. end;
  2388. if code<>0 then
  2389. begin
  2390. { finally float }
  2391. val(pattern,d,code);
  2392. if code<>0 then
  2393. begin
  2394. Message(parser_e_invalid_integer);
  2395. consume(_INTCONST);
  2396. l:=1;
  2397. p1:=cordconstnode.create(l,sinttype,true);
  2398. end
  2399. else
  2400. begin
  2401. consume(_INTCONST);
  2402. p1:=crealconstnode.create(d,pbestrealtype^);
  2403. end;
  2404. end
  2405. else
  2406. { the necessary range checking has already been done by val }
  2407. tordconstnode(p1).rangecheck:=false;
  2408. end;
  2409. _REALNUMBER :
  2410. begin
  2411. val(pattern,d,code);
  2412. if code<>0 then
  2413. begin
  2414. Message(parser_e_error_in_real);
  2415. d:=1.0;
  2416. end;
  2417. consume(_REALNUMBER);
  2418. {$ifdef FPC_REAL2REAL_FIXED}
  2419. if current_settings.fputype=fpu_none then
  2420. Message(parser_e_unsupported_real);
  2421. if (current_settings.minfpconstprec=s32real) and
  2422. (d = single(d)) then
  2423. p1:=crealconstnode.create(d,s32floattype)
  2424. else if (current_settings.minfpconstprec=s64real) and
  2425. (d = double(d)) then
  2426. p1:=crealconstnode.create(d,s64floattype)
  2427. else
  2428. {$endif FPC_REAL2REAL_FIXED}
  2429. p1:=crealconstnode.create(d,pbestrealtype^);
  2430. {$ifdef FPC_HAS_STR_CURRENCY}
  2431. val(pattern,cur,code);
  2432. if code=0 then
  2433. trealconstnode(p1).value_currency:=cur;
  2434. {$endif FPC_HAS_STR_CURRENCY}
  2435. end;
  2436. _STRING :
  2437. begin
  2438. string_dec(hdef,true);
  2439. { STRING can be also a type cast }
  2440. if try_to_consume(_LKLAMMER) then
  2441. begin
  2442. p1:=comp_expr(true,false);
  2443. consume(_RKLAMMER);
  2444. p1:=ctypeconvnode.create_explicit(p1,hdef);
  2445. { handle postfix operators here e.g. string(a)[10] }
  2446. again:=true;
  2447. postfixoperators(p1,again);
  2448. end
  2449. else
  2450. p1:=ctypenode.create(hdef);
  2451. end;
  2452. _FILE :
  2453. begin
  2454. hdef:=cfiletype;
  2455. consume(_FILE);
  2456. { FILE can be also a type cast }
  2457. if try_to_consume(_LKLAMMER) then
  2458. begin
  2459. p1:=comp_expr(true,false);
  2460. consume(_RKLAMMER);
  2461. p1:=ctypeconvnode.create_explicit(p1,hdef);
  2462. { handle postfix operators here e.g. string(a)[10] }
  2463. again:=true;
  2464. postfixoperators(p1,again);
  2465. end
  2466. else
  2467. begin
  2468. p1:=ctypenode.create(hdef);
  2469. end;
  2470. end;
  2471. _CSTRING :
  2472. begin
  2473. p1:=cstringconstnode.createpchar(ansistring2pchar(cstringpattern),length(cstringpattern));
  2474. consume(_CSTRING);
  2475. end;
  2476. _CCHAR :
  2477. begin
  2478. p1:=cordconstnode.create(ord(pattern[1]),cchartype,true);
  2479. consume(_CCHAR);
  2480. end;
  2481. _CWSTRING:
  2482. begin
  2483. p1:=cstringconstnode.createwstr(patternw);
  2484. consume(_CWSTRING);
  2485. end;
  2486. _CWCHAR:
  2487. begin
  2488. p1:=cordconstnode.create(ord(getcharwidestring(patternw,0)),cwidechartype,true);
  2489. consume(_CWCHAR);
  2490. end;
  2491. _KLAMMERAFFE :
  2492. begin
  2493. consume(_KLAMMERAFFE);
  2494. got_addrn:=true;
  2495. { support both @<x> and @(<x>) }
  2496. if try_to_consume(_LKLAMMER) then
  2497. begin
  2498. p1:=factor(true,false);
  2499. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2500. begin
  2501. again:=true;
  2502. postfixoperators(p1,again);
  2503. end
  2504. else
  2505. consume(_RKLAMMER);
  2506. end
  2507. else
  2508. p1:=factor(true,false);
  2509. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2510. begin
  2511. again:=true;
  2512. postfixoperators(p1,again);
  2513. end;
  2514. got_addrn:=false;
  2515. p1:=caddrnode.create(p1);
  2516. p1.fileinfo:=filepos;
  2517. if cs_typed_addresses in current_settings.localswitches then
  2518. include(p1.flags,nf_typedaddr);
  2519. { Store the procvar that we are expecting, the
  2520. addrn will use the information to find the correct
  2521. procdef or it will return an error }
  2522. if assigned(getprocvardef) and
  2523. (taddrnode(p1).left.nodetype = loadn) then
  2524. taddrnode(p1).getprocvardef:=getprocvardef;
  2525. end;
  2526. _LKLAMMER :
  2527. begin
  2528. consume(_LKLAMMER);
  2529. p1:=comp_expr(true,false);
  2530. consume(_RKLAMMER);
  2531. { it's not a good solution }
  2532. { but (a+b)^ makes some problems }
  2533. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2534. begin
  2535. again:=true;
  2536. postfixoperators(p1,again);
  2537. end;
  2538. end;
  2539. _LECKKLAMMER :
  2540. begin
  2541. consume(_LECKKLAMMER);
  2542. p1:=factor_read_set;
  2543. consume(_RECKKLAMMER);
  2544. end;
  2545. _PLUS :
  2546. begin
  2547. consume(_PLUS);
  2548. p1:=factor(false,false);
  2549. p1:=cunaryplusnode.create(p1);
  2550. end;
  2551. _MINUS :
  2552. begin
  2553. consume(_MINUS);
  2554. if (token = _INTCONST) and not(m_isolike_unary_minus in current_settings.modeswitches) then
  2555. begin
  2556. { ugly hack, but necessary to be able to parse }
  2557. { -9223372036854775808 as int64 (JM) }
  2558. pattern := '-'+pattern;
  2559. p1:=sub_expr(oppower,false,false);
  2560. { -1 ** 4 should be - (1 ** 4) and not
  2561. (-1) ** 4
  2562. This was the reason of tw0869.pp test failure PM }
  2563. if p1.nodetype=starstarn then
  2564. begin
  2565. if tbinarynode(p1).left.nodetype=ordconstn then
  2566. begin
  2567. tordconstnode(tbinarynode(p1).left).value:=-tordconstnode(tbinarynode(p1).left).value;
  2568. p1:=cunaryminusnode.create(p1);
  2569. end
  2570. else if tbinarynode(p1).left.nodetype=realconstn then
  2571. begin
  2572. trealconstnode(tbinarynode(p1).left).value_real:=-trealconstnode(tbinarynode(p1).left).value_real;
  2573. trealconstnode(tbinarynode(p1).left).value_currency:=-trealconstnode(tbinarynode(p1).left).value_currency;
  2574. p1:=cunaryminusnode.create(p1);
  2575. end
  2576. else
  2577. internalerror(20021029);
  2578. end;
  2579. end
  2580. else
  2581. begin
  2582. if m_isolike_unary_minus in current_settings.modeswitches then
  2583. p1:=sub_expr(opmultiply,false,false)
  2584. else
  2585. p1:=sub_expr(oppower,false,false);
  2586. p1:=cunaryminusnode.create(p1);
  2587. end;
  2588. end;
  2589. _OP_NOT :
  2590. begin
  2591. consume(_OP_NOT);
  2592. p1:=factor(false,false);
  2593. p1:=cnotnode.create(p1);
  2594. end;
  2595. _TRUE :
  2596. begin
  2597. consume(_TRUE);
  2598. p1:=cordconstnode.create(1,pasbool8type,false);
  2599. end;
  2600. _FALSE :
  2601. begin
  2602. consume(_FALSE);
  2603. p1:=cordconstnode.create(0,pasbool8type,false);
  2604. end;
  2605. _NIL :
  2606. begin
  2607. consume(_NIL);
  2608. p1:=cnilnode.create;
  2609. { It's really ugly code nil^, but delphi allows it }
  2610. if token in [_CARET] then
  2611. begin
  2612. again:=true;
  2613. postfixoperators(p1,again);
  2614. end;
  2615. end;
  2616. _OBJCPROTOCOL:
  2617. begin
  2618. { The @protocol keyword is used in two ways in Objective-C:
  2619. 1) to declare protocols (~ Object Pascal interfaces)
  2620. 2) to obtain the metaclass (~ Object Pascal) "class of")
  2621. of a declared protocol
  2622. This code is for handling the second case. Because of 1),
  2623. we cannot simply use a system unit symbol.
  2624. }
  2625. consume(_OBJCPROTOCOL);
  2626. consume(_LKLAMMER);
  2627. p1:=factor(false,false);
  2628. consume(_RKLAMMER);
  2629. p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
  2630. end;
  2631. else
  2632. begin
  2633. Message(parser_e_illegal_expression);
  2634. p1:=cerrornode.create;
  2635. { recover }
  2636. consume(token);
  2637. end;
  2638. end;
  2639. end;
  2640. { generate error node if no node is created }
  2641. if not assigned(p1) then
  2642. begin
  2643. {$ifdef EXTDEBUG}
  2644. Comment(V_Warning,'factor: p1=nil');
  2645. {$endif}
  2646. p1:=cerrornode.create;
  2647. updatefpos:=true;
  2648. end;
  2649. { get the resultdef for the node }
  2650. if (not assigned(p1.resultdef)) then
  2651. begin
  2652. do_typecheckpass_changed(p1,nodechanged);
  2653. updatefpos:=updatefpos or nodechanged;
  2654. end;
  2655. if assigned(p1) and
  2656. updatefpos then
  2657. p1.fileinfo:=filepos;
  2658. factor:=p1;
  2659. end;
  2660. {$maxfpuregisters default}
  2661. {****************************************************************************
  2662. Sub_Expr
  2663. ****************************************************************************}
  2664. const
  2665. { Warning these stay be ordered !! }
  2666. operator_levels:array[Toperator_precedence] of set of NOTOKEN..last_operator=
  2667. ([_LT,_LTE,_GT,_GTE,_EQ,_NE,_OP_IN],
  2668. [_PLUS,_MINUS,_OP_OR,_PIPE,_OP_XOR],
  2669. [_CARET,_SYMDIF,_STARSTAR,_STAR,_SLASH,
  2670. _OP_AS,_OP_IS,_OP_AND,_AMPERSAND,_OP_DIV,_OP_MOD,_OP_SHL,_OP_SHR],
  2671. [_STARSTAR] );
  2672. function sub_expr(pred_level:Toperator_precedence;accept_equal,typeonly:boolean):tnode;
  2673. {Reads a subexpression while the operators are of the current precedence
  2674. level, or any higher level. Replaces the old term, simpl_expr and
  2675. simpl2_expr.}
  2676. var
  2677. p1,p2 : tnode;
  2678. oldt : Ttoken;
  2679. filepos : tfileposinfo;
  2680. begin
  2681. if pred_level=highest_precedence then
  2682. p1:=factor(false,typeonly)
  2683. else
  2684. p1:=sub_expr(succ(pred_level),true,typeonly);
  2685. repeat
  2686. if (token in [NOTOKEN..last_operator]) and
  2687. (token in operator_levels[pred_level]) and
  2688. ((token<>_EQ) or accept_equal) then
  2689. begin
  2690. oldt:=token;
  2691. filepos:=current_tokenpos;
  2692. consume(token);
  2693. if pred_level=highest_precedence then
  2694. p2:=factor(false,false)
  2695. else
  2696. p2:=sub_expr(succ(pred_level),true,typeonly);
  2697. case oldt of
  2698. _PLUS :
  2699. p1:=caddnode.create(addn,p1,p2);
  2700. _MINUS :
  2701. p1:=caddnode.create(subn,p1,p2);
  2702. _STAR :
  2703. p1:=caddnode.create(muln,p1,p2);
  2704. _SLASH :
  2705. p1:=caddnode.create(slashn,p1,p2);
  2706. _EQ:
  2707. p1:=caddnode.create(equaln,p1,p2);
  2708. _GT :
  2709. p1:=caddnode.create(gtn,p1,p2);
  2710. _LT :
  2711. p1:=caddnode.create(ltn,p1,p2);
  2712. _GTE :
  2713. p1:=caddnode.create(gten,p1,p2);
  2714. _LTE :
  2715. p1:=caddnode.create(lten,p1,p2);
  2716. _SYMDIF :
  2717. p1:=caddnode.create(symdifn,p1,p2);
  2718. _STARSTAR :
  2719. p1:=caddnode.create(starstarn,p1,p2);
  2720. _OP_AS :
  2721. p1:=casnode.create(p1,p2);
  2722. _OP_IN :
  2723. p1:=cinnode.create(p1,p2);
  2724. _OP_IS :
  2725. p1:=cisnode.create(p1,p2);
  2726. _OP_OR,
  2727. _PIPE {macpas only} :
  2728. begin
  2729. p1:=caddnode.create(orn,p1,p2);
  2730. if (oldt = _PIPE) then
  2731. include(p1.flags,nf_short_bool);
  2732. end;
  2733. _OP_AND,
  2734. _AMPERSAND {macpas only} :
  2735. begin
  2736. p1:=caddnode.create(andn,p1,p2);
  2737. if (oldt = _AMPERSAND) then
  2738. include(p1.flags,nf_short_bool);
  2739. end;
  2740. _OP_DIV :
  2741. p1:=cmoddivnode.create(divn,p1,p2);
  2742. _OP_NOT :
  2743. p1:=cnotnode.create(p1);
  2744. _OP_MOD :
  2745. p1:=cmoddivnode.create(modn,p1,p2);
  2746. _OP_SHL :
  2747. p1:=cshlshrnode.create(shln,p1,p2);
  2748. _OP_SHR :
  2749. p1:=cshlshrnode.create(shrn,p1,p2);
  2750. _OP_XOR :
  2751. p1:=caddnode.create(xorn,p1,p2);
  2752. _ASSIGNMENT :
  2753. p1:=cassignmentnode.create(p1,p2);
  2754. _NE :
  2755. p1:=caddnode.create(unequaln,p1,p2);
  2756. end;
  2757. p1.fileinfo:=filepos;
  2758. end
  2759. else
  2760. break;
  2761. until false;
  2762. sub_expr:=p1;
  2763. end;
  2764. function comp_expr(accept_equal,typeonly:boolean):tnode;
  2765. var
  2766. oldafterassignment : boolean;
  2767. p1 : tnode;
  2768. begin
  2769. oldafterassignment:=afterassignment;
  2770. afterassignment:=true;
  2771. p1:=sub_expr(opcompare,accept_equal,typeonly);
  2772. { get the resultdef for this expression }
  2773. if not assigned(p1.resultdef) then
  2774. do_typecheckpass(p1);
  2775. afterassignment:=oldafterassignment;
  2776. comp_expr:=p1;
  2777. end;
  2778. function expr(dotypecheck : boolean) : tnode;
  2779. var
  2780. p1,p2 : tnode;
  2781. filepos : tfileposinfo;
  2782. oldafterassignment,
  2783. updatefpos : boolean;
  2784. begin
  2785. oldafterassignment:=afterassignment;
  2786. p1:=sub_expr(opcompare,true,false);
  2787. { get the resultdef for this expression }
  2788. if not assigned(p1.resultdef) and
  2789. dotypecheck then
  2790. do_typecheckpass(p1);
  2791. filepos:=current_tokenpos;
  2792. if token in [_ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
  2793. afterassignment:=true;
  2794. updatefpos:=true;
  2795. case token of
  2796. _POINTPOINT :
  2797. begin
  2798. consume(_POINTPOINT);
  2799. p2:=sub_expr(opcompare,true,false);
  2800. p1:=crangenode.create(p1,p2);
  2801. end;
  2802. _ASSIGNMENT :
  2803. begin
  2804. consume(_ASSIGNMENT);
  2805. if (p1.resultdef.typ=procvardef) then
  2806. getprocvardef:=tprocvardef(p1.resultdef);
  2807. p2:=sub_expr(opcompare,true,false);
  2808. if assigned(getprocvardef) then
  2809. handle_procvar(getprocvardef,p2);
  2810. getprocvardef:=nil;
  2811. p1:=cassignmentnode.create(p1,p2);
  2812. end;
  2813. _PLUSASN :
  2814. begin
  2815. consume(_PLUSASN);
  2816. p2:=sub_expr(opcompare,true,false);
  2817. p1:=gen_c_style_operator(addn,p1,p2);
  2818. end;
  2819. _MINUSASN :
  2820. begin
  2821. consume(_MINUSASN);
  2822. p2:=sub_expr(opcompare,true,false);
  2823. p1:=gen_c_style_operator(subn,p1,p2);
  2824. end;
  2825. _STARASN :
  2826. begin
  2827. consume(_STARASN );
  2828. p2:=sub_expr(opcompare,true,false);
  2829. p1:=gen_c_style_operator(muln,p1,p2);
  2830. end;
  2831. _SLASHASN :
  2832. begin
  2833. consume(_SLASHASN );
  2834. p2:=sub_expr(opcompare,true,false);
  2835. p1:=gen_c_style_operator(slashn,p1,p2);
  2836. end;
  2837. else
  2838. updatefpos:=false;
  2839. end;
  2840. { get the resultdef for this expression }
  2841. if not assigned(p1.resultdef) and
  2842. dotypecheck then
  2843. do_typecheckpass(p1);
  2844. afterassignment:=oldafterassignment;
  2845. if updatefpos then
  2846. p1.fileinfo:=filepos;
  2847. expr:=p1;
  2848. end;
  2849. function get_intconst:TConstExprInt;
  2850. {Reads an expression, tries to evalute it and check if it is an integer
  2851. constant. Then the constant is returned.}
  2852. var
  2853. p:tnode;
  2854. begin
  2855. result:=0;
  2856. p:=comp_expr(true,false);
  2857. if not codegenerror then
  2858. begin
  2859. if (p.nodetype<>ordconstn) or
  2860. not(is_integer(p.resultdef)) then
  2861. Message(parser_e_illegal_expression)
  2862. else
  2863. result:=tordconstnode(p).value;
  2864. end;
  2865. p.free;
  2866. end;
  2867. function get_stringconst:string;
  2868. {Reads an expression, tries to evaluate it and checks if it is a string
  2869. constant. Then the constant is returned.}
  2870. var
  2871. p:tnode;
  2872. begin
  2873. get_stringconst:='';
  2874. p:=comp_expr(true,false);
  2875. if p.nodetype<>stringconstn then
  2876. begin
  2877. if (p.nodetype=ordconstn) and is_char(p.resultdef) then
  2878. get_stringconst:=char(int64(tordconstnode(p).value))
  2879. else
  2880. Message(parser_e_illegal_expression);
  2881. end
  2882. else
  2883. get_stringconst:=strpas(tstringconstnode(p).value_str);
  2884. p.free;
  2885. end;
  2886. end.