pexpr.pas 125 KB

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