pexpr.pas 95 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619
  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;
  24. { reads a whole expression }
  25. function expr : tnode;
  26. { reads an expression without assignements and .. }
  27. function comp_expr(accept_equal : boolean):tnode;
  28. { reads a single factor }
  29. function factor(getaddr : boolean) : tnode;
  30. procedure string_dec(var t: ttype);
  31. procedure symlist_to_node(var p1:tnode;st:tsymtable;pl:tsymlist);
  32. function node_to_symlist(p1:tnode):tsymlist;
  33. function parse_paras(__colon : boolean;end_of_paras : ttoken) : tnode;
  34. { the ID token has to be consumed before calling this function }
  35. procedure do_member_read(classh:tobjectdef;getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callflags:tcallnodeflags);
  36. {$ifdef int64funcresok}
  37. function get_intconst:TConstExprInt;
  38. {$else int64funcresok}
  39. function get_intconst:longint;
  40. {$endif int64funcresok}
  41. function get_stringconst:string;
  42. implementation
  43. uses
  44. { common }
  45. cutils,
  46. { global }
  47. verbose,
  48. systems,widestr,
  49. { symtable }
  50. symconst,symtable,symsym,defutil,defcmp,
  51. { module }
  52. fmodule,ppu,
  53. { pass 1 }
  54. pass_1,htypechk,
  55. nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
  56. { parser }
  57. scanner,
  58. pbase,pinline,
  59. { codegen }
  60. cgbase,procinfo,cpuinfo
  61. ;
  62. { sub_expr(opmultiply) is need to get -1 ** 4 to be
  63. read as - (1**4) and not (-1)**4 PM }
  64. type
  65. Toperator_precedence=(opcompare,opaddition,opmultiply,oppower);
  66. const
  67. highest_precedence = oppower;
  68. function sub_expr(pred_level:Toperator_precedence;accept_equal : boolean):tnode;forward;
  69. const
  70. { true, if the inherited call is anonymous }
  71. anon_inherited : boolean = false;
  72. procedure string_dec(var t: ttype);
  73. { reads a string type with optional length }
  74. { and returns a pointer to the string }
  75. { definition }
  76. var
  77. p : tnode;
  78. begin
  79. t:=cshortstringtype;
  80. consume(_STRING);
  81. if try_to_consume(_LECKKLAMMER) then
  82. begin
  83. p:=comp_expr(true);
  84. if not is_constintnode(p) then
  85. begin
  86. Message(parser_e_illegal_expression);
  87. { error recovery }
  88. consume(_RECKKLAMMER);
  89. end
  90. else
  91. begin
  92. if (tordconstnode(p).value<=0) then
  93. begin
  94. Message(parser_e_invalid_string_size);
  95. tordconstnode(p).value:=255;
  96. end;
  97. consume(_RECKKLAMMER);
  98. if tordconstnode(p).value>255 then
  99. begin
  100. { longstring is currently unsupported (CEC)! }
  101. { t.setdef(tstringdef.createlong(tordconstnode(p).value))}
  102. Message(parser_e_invalid_string_size);
  103. tordconstnode(p).value:=255;
  104. t.setdef(tstringdef.createshort(tordconstnode(p).value));
  105. end
  106. else
  107. if tordconstnode(p).value<>255 then
  108. t.setdef(tstringdef.createshort(tordconstnode(p).value));
  109. end;
  110. p.free;
  111. end
  112. else
  113. begin
  114. if cs_ansistrings in aktlocalswitches then
  115. {$ifdef ansistring_bits}
  116. case aktansistring_bits of
  117. sb_16:
  118. t:=cansistringtype16;
  119. sb_32:
  120. t:=cansistringtype32;
  121. sb_64:
  122. t:=cansistringtype64;
  123. end
  124. {$else}
  125. t:=cansistringtype
  126. {$endif}
  127. else
  128. t:=cshortstringtype;
  129. end;
  130. end;
  131. procedure symlist_to_node(var p1:tnode;st:tsymtable;pl:tsymlist);
  132. var
  133. plist : psymlistitem;
  134. begin
  135. plist:=pl.firstsym;
  136. while assigned(plist) do
  137. begin
  138. case plist^.sltype of
  139. sl_load :
  140. begin
  141. if not assigned(st) then
  142. st:=plist^.sym.owner;
  143. { p1 can already contain the loadnode of
  144. the class variable. When there is no tree yet we
  145. may need to load it for with or objects }
  146. if not assigned(p1) then
  147. begin
  148. case st.symtabletype of
  149. withsymtable :
  150. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  151. objectsymtable :
  152. p1:=load_self_node;
  153. end;
  154. end;
  155. if assigned(p1) then
  156. p1:=csubscriptnode.create(plist^.sym,p1)
  157. else
  158. p1:=cloadnode.create(plist^.sym,st);
  159. end;
  160. sl_subscript :
  161. p1:=csubscriptnode.create(plist^.sym,p1);
  162. sl_typeconv :
  163. p1:=ctypeconvnode.create_explicit(p1,plist^.tt);
  164. sl_absolutetype :
  165. begin
  166. p1:=ctypeconvnode.create(p1,plist^.tt);
  167. include(p1.flags,nf_absolute);
  168. end;
  169. sl_vec :
  170. p1:=cvecnode.create(p1,cordconstnode.create(plist^.value,s32inttype,true));
  171. else
  172. internalerror(200110205);
  173. end;
  174. plist:=plist^.next;
  175. end;
  176. end;
  177. function node_to_symlist(p1:tnode):tsymlist;
  178. var
  179. sl : tsymlist;
  180. procedure addnode(p:tnode);
  181. begin
  182. case p.nodetype of
  183. subscriptn :
  184. begin
  185. addnode(tsubscriptnode(p).left);
  186. sl.addsym(sl_subscript,tsubscriptnode(p).vs);
  187. end;
  188. typeconvn :
  189. begin
  190. addnode(ttypeconvnode(p).left);
  191. if nf_absolute in ttypeconvnode(p).flags then
  192. sl.addtype(sl_absolutetype,ttypeconvnode(p).totype)
  193. else
  194. sl.addtype(sl_typeconv,ttypeconvnode(p).totype);
  195. end;
  196. vecn :
  197. begin
  198. addnode(tvecnode(p).left);
  199. if tvecnode(p).right.nodetype=ordconstn then
  200. sl.addconst(sl_vec,tordconstnode(tvecnode(p).right).value)
  201. else
  202. begin
  203. Message(parser_e_illegal_expression);
  204. { recovery }
  205. sl.addconst(sl_vec,0);
  206. end;
  207. end;
  208. loadn :
  209. sl.addsym(sl_load,tloadnode(p).symtableentry);
  210. else
  211. internalerror(200310282);
  212. end;
  213. end;
  214. begin
  215. sl:=tsymlist.create;
  216. addnode(p1);
  217. result:=sl;
  218. end;
  219. function parse_paras(__colon : boolean;end_of_paras : ttoken) : tnode;
  220. var
  221. p1,p2 : tnode;
  222. prev_in_args : boolean;
  223. old_allow_array_constructor : boolean;
  224. begin
  225. if token=end_of_paras then
  226. begin
  227. parse_paras:=nil;
  228. exit;
  229. end;
  230. { save old values }
  231. prev_in_args:=in_args;
  232. old_allow_array_constructor:=allow_array_constructor;
  233. { set para parsing values }
  234. in_args:=true;
  235. inc(parsing_para_level);
  236. allow_array_constructor:=true;
  237. p2:=nil;
  238. repeat
  239. p1:=comp_expr(true);
  240. p2:=ccallparanode.create(p1,p2);
  241. { it's for the str(l:5,s); }
  242. if __colon and (token=_COLON) then
  243. begin
  244. consume(_COLON);
  245. p1:=comp_expr(true);
  246. p2:=ccallparanode.create(p1,p2);
  247. include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
  248. if try_to_consume(_COLON) then
  249. begin
  250. p1:=comp_expr(true);
  251. p2:=ccallparanode.create(p1,p2);
  252. include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
  253. end
  254. end;
  255. until not try_to_consume(_COMMA);
  256. allow_array_constructor:=old_allow_array_constructor;
  257. dec(parsing_para_level);
  258. in_args:=prev_in_args;
  259. parse_paras:=p2;
  260. end;
  261. function gen_c_style_operator(ntyp:tnodetype;p1,p2:tnode) : tnode;
  262. var
  263. hp : tnode;
  264. htype : ttype;
  265. temp : ttempcreatenode;
  266. newstatement : tstatementnode;
  267. begin
  268. { Properties are not allowed, because the write can
  269. be different from the read }
  270. if (nf_isproperty in p1.flags) then
  271. begin
  272. Message(type_e_variable_id_expected);
  273. { We can continue with the loading,
  274. it'll not create errors. Only the expected
  275. result can be wrong }
  276. end;
  277. hp:=p1;
  278. while assigned(hp) and
  279. (hp.nodetype in [derefn,subscriptn,vecn,typeconvn]) do
  280. hp:=tunarynode(hp).left;
  281. if not assigned(hp) then
  282. internalerror(200410121);
  283. if (hp.nodetype=calln) then
  284. begin
  285. resulttypepass(p1);
  286. result:=internalstatements(newstatement);
  287. htype.setdef(tpointerdef.create(p1.resulttype));
  288. temp:=ctempcreatenode.create(htype,sizeof(aint),tt_persistent,false);
  289. addstatement(newstatement,temp);
  290. addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(temp),caddrnode.create_internal(p1)));
  291. addstatement(newstatement,cassignmentnode.create(
  292. cderefnode.create(ctemprefnode.create(temp)),
  293. caddnode.create(ntyp,
  294. cderefnode.create(ctemprefnode.create(temp)),
  295. p2)));
  296. addstatement(newstatement,ctempdeletenode.create(temp));
  297. end
  298. else
  299. result:=cassignmentnode.create(p1,caddnode.create(ntyp,p1.getcopy,p2));
  300. end;
  301. function statement_syssym(l : longint) : tnode;
  302. var
  303. p1,p2,paras : tnode;
  304. err,
  305. prev_in_args : boolean;
  306. begin
  307. prev_in_args:=in_args;
  308. case l of
  309. in_new_x :
  310. begin
  311. if afterassignment or in_args then
  312. statement_syssym:=new_function
  313. else
  314. statement_syssym:=new_dispose_statement(true);
  315. end;
  316. in_dispose_x :
  317. begin
  318. statement_syssym:=new_dispose_statement(false);
  319. end;
  320. in_ord_x :
  321. begin
  322. consume(_LKLAMMER);
  323. in_args:=true;
  324. p1:=comp_expr(true);
  325. consume(_RKLAMMER);
  326. p1:=geninlinenode(in_ord_x,false,p1);
  327. statement_syssym := p1;
  328. end;
  329. in_exit :
  330. begin
  331. if try_to_consume(_LKLAMMER) then
  332. begin
  333. if not (m_mac in aktmodeswitches) then
  334. begin
  335. p1:=comp_expr(true);
  336. consume(_RKLAMMER);
  337. if (block_type=bt_except) then
  338. begin
  339. Message(parser_e_exit_with_argument_not__possible);
  340. { recovery }
  341. p1.free;
  342. p1:=nil;
  343. end
  344. else if (not assigned(current_procinfo) or
  345. is_void(current_procinfo.procdef.rettype.def)) then
  346. begin
  347. Message(parser_e_void_function);
  348. { recovery }
  349. p1.free;
  350. p1:=nil;
  351. end;
  352. end
  353. else
  354. begin
  355. if not (current_procinfo.procdef.procsym.name = pattern) then
  356. Message(parser_e_macpas_exit_wrong_param);
  357. consume(_ID);
  358. consume(_RKLAMMER);
  359. p1:=nil;
  360. end
  361. end
  362. else
  363. p1:=nil;
  364. statement_syssym:=cexitnode.create(p1);
  365. end;
  366. in_break :
  367. begin
  368. if not (m_mac in aktmodeswitches) then
  369. statement_syssym:=cbreaknode.create
  370. else
  371. begin
  372. Message1(sym_e_id_not_found, orgpattern);
  373. statement_syssym:=cerrornode.create;
  374. end;
  375. end;
  376. in_continue :
  377. begin
  378. if not (m_mac in aktmodeswitches) then
  379. statement_syssym:=ccontinuenode.create
  380. else
  381. begin
  382. Message1(sym_e_id_not_found, orgpattern);
  383. statement_syssym:=cerrornode.create;
  384. end;
  385. end;
  386. in_leave :
  387. begin
  388. if m_mac in aktmodeswitches then
  389. statement_syssym:=cbreaknode.create
  390. else
  391. begin
  392. Message1(sym_e_id_not_found, orgpattern);
  393. statement_syssym:=cerrornode.create;
  394. end;
  395. end;
  396. in_cycle :
  397. begin
  398. if m_mac in aktmodeswitches then
  399. statement_syssym:=ccontinuenode.create
  400. else
  401. begin
  402. Message1(sym_e_id_not_found, orgpattern);
  403. statement_syssym:=cerrornode.create;
  404. end;
  405. end;
  406. in_typeof_x :
  407. begin
  408. consume(_LKLAMMER);
  409. in_args:=true;
  410. p1:=comp_expr(true);
  411. consume(_RKLAMMER);
  412. if p1.nodetype=typen then
  413. ttypenode(p1).allowed:=true;
  414. { Allow classrefdef, which is required for
  415. Typeof(self) in static class methods }
  416. if (p1.resulttype.def.deftype = objectdef) or
  417. (assigned(current_procinfo) and
  418. ((po_classmethod in current_procinfo.procdef.procoptions) or
  419. (po_staticmethod in current_procinfo.procdef.procoptions)) and
  420. (p1.resulttype.def.deftype=classrefdef)) then
  421. statement_syssym:=geninlinenode(in_typeof_x,false,p1)
  422. else
  423. begin
  424. Message(parser_e_class_id_expected);
  425. p1.destroy;
  426. statement_syssym:=cerrornode.create;
  427. end;
  428. end;
  429. in_sizeof_x :
  430. begin
  431. consume(_LKLAMMER);
  432. in_args:=true;
  433. p1:=comp_expr(true);
  434. consume(_RKLAMMER);
  435. if (p1.nodetype<>typen) and
  436. (
  437. (is_object(p1.resulttype.def) and
  438. (oo_has_constructor in tobjectdef(p1.resulttype.def).objectoptions)) or
  439. is_open_array(p1.resulttype.def) or
  440. is_open_string(p1.resulttype.def)
  441. ) then
  442. statement_syssym:=geninlinenode(in_sizeof_x,false,p1)
  443. else
  444. begin
  445. statement_syssym:=cordconstnode.create(p1.resulttype.def.size,sinttype,true);
  446. { p1 not needed !}
  447. p1.destroy;
  448. end;
  449. end;
  450. in_typeinfo_x :
  451. begin
  452. consume(_LKLAMMER);
  453. in_args:=true;
  454. p1:=comp_expr(true);
  455. { When reading a class type it is parsed as loadvmtaddrn,
  456. typeinfo only needs the type so we remove the loadvmtaddrn }
  457. if p1.nodetype=loadvmtaddrn then
  458. begin
  459. p2:=tloadvmtaddrnode(p1).left;
  460. tloadvmtaddrnode(p1).left:=nil;
  461. p1.free;
  462. p1:=p2;
  463. end;
  464. if p1.nodetype=typen then
  465. ttypenode(p1).allowed:=true
  466. else
  467. begin
  468. p1.destroy;
  469. p1:=cerrornode.create;
  470. Message(parser_e_illegal_parameter_list);
  471. end;
  472. consume(_RKLAMMER);
  473. p2:=geninlinenode(in_typeinfo_x,false,p1);
  474. statement_syssym:=p2;
  475. end;
  476. in_assigned_x :
  477. begin
  478. err:=false;
  479. consume(_LKLAMMER);
  480. in_args:=true;
  481. p1:=comp_expr(true);
  482. { When reading a class type it is parsed as loadvmtaddrn,
  483. typeinfo only needs the type so we remove the loadvmtaddrn }
  484. if p1.nodetype=loadvmtaddrn then
  485. begin
  486. p2:=tloadvmtaddrnode(p1).left;
  487. tloadvmtaddrnode(p1).left:=nil;
  488. p1.free;
  489. p1:=p2;
  490. end;
  491. if not codegenerror then
  492. begin
  493. case p1.resulttype.def.deftype of
  494. procdef, { procvar }
  495. pointerdef,
  496. procvardef,
  497. classrefdef : ;
  498. objectdef :
  499. if not is_class_or_interface(p1.resulttype.def) then
  500. begin
  501. Message(parser_e_illegal_parameter_list);
  502. err:=true;
  503. end;
  504. arraydef :
  505. if not is_dynamic_array(p1.resulttype.def) then
  506. begin
  507. Message(parser_e_illegal_parameter_list);
  508. err:=true;
  509. end;
  510. else
  511. begin
  512. Message(parser_e_illegal_parameter_list);
  513. err:=true;
  514. end;
  515. end;
  516. end
  517. else
  518. err:=true;
  519. if not err then
  520. begin
  521. p2:=ccallparanode.create(p1,nil);
  522. p2:=geninlinenode(in_assigned_x,false,p2);
  523. end
  524. else
  525. begin
  526. p1.free;
  527. p2:=cerrornode.create;
  528. end;
  529. consume(_RKLAMMER);
  530. statement_syssym:=p2;
  531. end;
  532. in_addr_x :
  533. begin
  534. consume(_LKLAMMER);
  535. in_args:=true;
  536. p1:=comp_expr(true);
  537. p1:=caddrnode.create(p1);
  538. if cs_typed_addresses in aktlocalswitches then
  539. include(p1.flags,nf_typedaddr);
  540. consume(_RKLAMMER);
  541. statement_syssym:=p1;
  542. end;
  543. in_ofs_x :
  544. begin
  545. consume(_LKLAMMER);
  546. in_args:=true;
  547. p1:=comp_expr(true);
  548. p1:=caddrnode.create(p1);
  549. do_resulttypepass(p1);
  550. { Ofs() returns a cardinal/qword, not a pointer }
  551. p1.resulttype:=uinttype;
  552. consume(_RKLAMMER);
  553. statement_syssym:=p1;
  554. end;
  555. in_seg_x :
  556. begin
  557. consume(_LKLAMMER);
  558. in_args:=true;
  559. p1:=comp_expr(true);
  560. p1:=geninlinenode(in_seg_x,false,p1);
  561. consume(_RKLAMMER);
  562. statement_syssym:=p1;
  563. end;
  564. in_high_x,
  565. in_low_x :
  566. begin
  567. consume(_LKLAMMER);
  568. in_args:=true;
  569. p1:=comp_expr(true);
  570. p2:=geninlinenode(l,false,p1);
  571. consume(_RKLAMMER);
  572. statement_syssym:=p2;
  573. end;
  574. in_succ_x,
  575. in_pred_x :
  576. begin
  577. consume(_LKLAMMER);
  578. in_args:=true;
  579. p1:=comp_expr(true);
  580. p2:=geninlinenode(l,false,p1);
  581. consume(_RKLAMMER);
  582. statement_syssym:=p2;
  583. end;
  584. in_inc_x,
  585. in_dec_x :
  586. begin
  587. consume(_LKLAMMER);
  588. in_args:=true;
  589. p1:=comp_expr(true);
  590. if try_to_consume(_COMMA) then
  591. p2:=ccallparanode.create(comp_expr(true),nil)
  592. else
  593. p2:=nil;
  594. p2:=ccallparanode.create(p1,p2);
  595. statement_syssym:=geninlinenode(l,false,p2);
  596. consume(_RKLAMMER);
  597. end;
  598. in_initialize_x:
  599. begin
  600. statement_syssym:=inline_initialize;
  601. end;
  602. in_finalize_x:
  603. begin
  604. statement_syssym:=inline_finalize;
  605. end;
  606. in_copy_x:
  607. begin
  608. statement_syssym:=inline_copy;
  609. end;
  610. in_concat_x :
  611. begin
  612. consume(_LKLAMMER);
  613. in_args:=true;
  614. p2:=nil;
  615. repeat
  616. p1:=comp_expr(true);
  617. set_varstate(p1,vs_used,[vsf_must_be_valid]);
  618. if not((p1.resulttype.def.deftype=stringdef) or
  619. ((p1.resulttype.def.deftype=orddef) and
  620. (torddef(p1.resulttype.def).typ=uchar))) then
  621. Message(parser_e_illegal_parameter_list);
  622. if p2<>nil then
  623. p2:=caddnode.create(addn,p2,p1)
  624. else
  625. p2:=p1;
  626. until not try_to_consume(_COMMA);
  627. consume(_RKLAMMER);
  628. statement_syssym:=p2;
  629. end;
  630. in_read_x,
  631. in_readln_x :
  632. begin
  633. if try_to_consume(_LKLAMMER) then
  634. begin
  635. paras:=parse_paras(false,_RKLAMMER);
  636. consume(_RKLAMMER);
  637. end
  638. else
  639. paras:=nil;
  640. p1:=geninlinenode(l,false,paras);
  641. statement_syssym := p1;
  642. end;
  643. in_setlength_x:
  644. begin
  645. statement_syssym := inline_setlength;
  646. end;
  647. in_length_x:
  648. begin
  649. consume(_LKLAMMER);
  650. in_args:=true;
  651. p1:=comp_expr(true);
  652. p2:=geninlinenode(l,false,p1);
  653. consume(_RKLAMMER);
  654. statement_syssym:=p2;
  655. end;
  656. in_write_x,
  657. in_writeln_x :
  658. begin
  659. if try_to_consume(_LKLAMMER) then
  660. begin
  661. paras:=parse_paras(true,_RKLAMMER);
  662. consume(_RKLAMMER);
  663. end
  664. else
  665. paras:=nil;
  666. p1 := geninlinenode(l,false,paras);
  667. statement_syssym := p1;
  668. end;
  669. in_str_x_string :
  670. begin
  671. consume(_LKLAMMER);
  672. paras:=parse_paras(true,_RKLAMMER);
  673. consume(_RKLAMMER);
  674. p1 := geninlinenode(l,false,paras);
  675. statement_syssym := p1;
  676. end;
  677. in_val_x:
  678. Begin
  679. consume(_LKLAMMER);
  680. in_args := true;
  681. p1:= ccallparanode.create(comp_expr(true), nil);
  682. consume(_COMMA);
  683. p2 := ccallparanode.create(comp_expr(true),p1);
  684. if try_to_consume(_COMMA) then
  685. p2 := ccallparanode.create(comp_expr(true),p2);
  686. consume(_RKLAMMER);
  687. p2 := geninlinenode(l,false,p2);
  688. statement_syssym := p2;
  689. End;
  690. in_include_x_y,
  691. in_exclude_x_y :
  692. begin
  693. consume(_LKLAMMER);
  694. in_args:=true;
  695. p1:=comp_expr(true);
  696. consume(_COMMA);
  697. p2:=comp_expr(true);
  698. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
  699. consume(_RKLAMMER);
  700. end;
  701. in_assert_x_y :
  702. begin
  703. consume(_LKLAMMER);
  704. in_args:=true;
  705. p1:=comp_expr(true);
  706. if try_to_consume(_COMMA) then
  707. p2:=comp_expr(true)
  708. else
  709. begin
  710. { then insert an empty string }
  711. p2:=cstringconstnode.createstr('',st_default);
  712. end;
  713. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
  714. consume(_RKLAMMER);
  715. end;
  716. else
  717. internalerror(15);
  718. end;
  719. in_args:=prev_in_args;
  720. end;
  721. function maybe_load_methodpointer(st:tsymtable;var p1:tnode):boolean;
  722. begin
  723. maybe_load_methodpointer:=false;
  724. if not assigned(p1) then
  725. begin
  726. case st.symtabletype of
  727. withsymtable :
  728. begin
  729. if (st.defowner.deftype=objectdef) then
  730. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  731. end;
  732. objectsymtable :
  733. begin
  734. p1:=load_self_node;
  735. { We are calling a member }
  736. maybe_load_methodpointer:=true;
  737. end;
  738. end;
  739. end;
  740. end;
  741. { reads the parameter for a subroutine call }
  742. procedure do_proc_call(sym:tsym;st:tsymtable;obj:tobjectdef;getaddr:boolean;var again : boolean;var p1:tnode;callflags:tcallnodeflags);
  743. var
  744. membercall,
  745. prevafterassn : boolean;
  746. i : integer;
  747. para,p2 : tnode;
  748. currpara : tparavarsym;
  749. aprocdef : tprocdef;
  750. begin
  751. prevafterassn:=afterassignment;
  752. afterassignment:=false;
  753. membercall:=false;
  754. aprocdef:=nil;
  755. { when it is a call to a member we need to load the
  756. methodpointer first }
  757. membercall:=maybe_load_methodpointer(st,p1);
  758. { When we are expecting a procvar we also need
  759. to get the address in some cases }
  760. if assigned(getprocvardef) then
  761. begin
  762. if (block_type=bt_const) or
  763. getaddr then
  764. begin
  765. aprocdef:=Tprocsym(sym).search_procdef_byprocvardef(getprocvardef);
  766. getaddr:=true;
  767. end
  768. else
  769. if (m_tp_procvar in aktmodeswitches) then
  770. begin
  771. aprocdef:=Tprocsym(sym).search_procdef_byprocvardef(getprocvardef);
  772. if assigned(aprocdef) then
  773. getaddr:=true;
  774. end;
  775. end;
  776. { only need to get the address of the procedure? }
  777. if getaddr then
  778. begin
  779. { Retrieve info which procvar to call. For tp_procvar the
  780. aprocdef is already loaded above so we can reuse it }
  781. if not assigned(aprocdef) and
  782. assigned(getprocvardef) then
  783. aprocdef:=Tprocsym(sym).search_procdef_byprocvardef(getprocvardef);
  784. { generate a methodcallnode or proccallnode }
  785. { we shouldn't convert things like @tcollection.load }
  786. p2:=cloadnode.create_procvar(sym,aprocdef,st);
  787. if assigned(p1) then
  788. begin
  789. if (p1.nodetype<>typen) then
  790. tloadnode(p2).set_mp(p1)
  791. else
  792. p1.free;
  793. end;
  794. p1:=p2;
  795. { no postfix operators }
  796. again:=false;
  797. end
  798. else
  799. begin
  800. para:=nil;
  801. if anon_inherited then
  802. begin
  803. if not assigned(current_procinfo) then
  804. internalerror(200305054);
  805. for i:=0 to current_procinfo.procdef.paras.count-1 do
  806. begin
  807. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  808. if not(vo_is_hidden_para in currpara.varoptions) then
  809. para:=ccallparanode.create(cloadnode.create(currpara,currpara.owner),para);
  810. end;
  811. end
  812. else
  813. begin
  814. if try_to_consume(_LKLAMMER) then
  815. begin
  816. para:=parse_paras(false,_RKLAMMER);
  817. consume(_RKLAMMER);
  818. end;
  819. end;
  820. { indicate if this call was generated by a member and
  821. no explicit self is used, this is needed to determine
  822. how to handle a destructor call (PFV) }
  823. if membercall then
  824. include(callflags,cnf_member_call);
  825. if assigned(obj) then
  826. begin
  827. if (st.symtabletype<>objectsymtable) then
  828. internalerror(200310031);
  829. p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1,callflags);
  830. end
  831. else
  832. p1:=ccallnode.create(para,tprocsym(sym),st,p1,callflags);
  833. end;
  834. afterassignment:=prevafterassn;
  835. end;
  836. procedure handle_procvar(pv : tprocvardef;var p2 : tnode);
  837. var
  838. hp,hp2 : tnode;
  839. hpp : ^tnode;
  840. currprocdef : tprocdef;
  841. begin
  842. if not assigned(pv) then
  843. internalerror(200301121);
  844. if (m_tp_procvar in aktmodeswitches) then
  845. begin
  846. hp:=p2;
  847. hpp:=@p2;
  848. while assigned(hp) and
  849. (hp.nodetype=typeconvn) do
  850. begin
  851. hp:=ttypeconvnode(hp).left;
  852. { save orignal address of the old tree so we can replace the node }
  853. hpp:=@hp;
  854. end;
  855. if (hp.nodetype=calln) and
  856. { a procvar can't have parameters! }
  857. not assigned(tcallnode(hp).left) then
  858. begin
  859. currprocdef:=tcallnode(hp).symtableprocentry.search_procdef_byprocvardef(pv);
  860. if assigned(currprocdef) then
  861. begin
  862. hp2:=cloadnode.create_procvar(tprocsym(tcallnode(hp).symtableprocentry),currprocdef,tcallnode(hp).symtableproc);
  863. if (po_methodpointer in pv.procoptions) then
  864. tloadnode(hp2).set_mp(tcallnode(hp).get_load_methodpointer);
  865. hp.destroy;
  866. { replace the old callnode with the new loadnode }
  867. hpp^:=hp2;
  868. end;
  869. end;
  870. end;
  871. end;
  872. { the following procedure handles the access to a property symbol }
  873. procedure handle_propertysym(sym : tsym;st : tsymtable;var p1 : tnode);
  874. var
  875. paras : tnode;
  876. p2 : tnode;
  877. membercall : boolean;
  878. callflags : tcallnodeflags;
  879. begin
  880. paras:=nil;
  881. { property parameters? read them only if the property really }
  882. { has parameters }
  883. if (ppo_hasparameters in tpropertysym(sym).propoptions) then
  884. begin
  885. if try_to_consume(_LECKKLAMMER) then
  886. begin
  887. paras:=parse_paras(false,_RECKKLAMMER);
  888. consume(_RECKKLAMMER);
  889. end;
  890. end;
  891. { indexed property }
  892. if (ppo_indexed in tpropertysym(sym).propoptions) then
  893. begin
  894. p2:=cordconstnode.create(tpropertysym(sym).index,tpropertysym(sym).indextype,true);
  895. paras:=ccallparanode.create(p2,paras);
  896. end;
  897. { we need only a write property if a := follows }
  898. { if not(afterassignment) and not(in_args) then }
  899. if token=_ASSIGNMENT then
  900. begin
  901. { write property: }
  902. if not tpropertysym(sym).writeaccess.empty then
  903. begin
  904. case tpropertysym(sym).writeaccess.firstsym^.sym.typ of
  905. procsym :
  906. begin
  907. callflags:=[];
  908. { generate the method call }
  909. membercall:=maybe_load_methodpointer(st,p1);
  910. if membercall then
  911. include(callflags,cnf_member_call);
  912. p1:=ccallnode.create(paras,tprocsym(tpropertysym(sym).writeaccess.firstsym^.sym),st,p1,callflags);
  913. paras:=nil;
  914. consume(_ASSIGNMENT);
  915. { read the expression }
  916. if tpropertysym(sym).proptype.def.deftype=procvardef then
  917. getprocvardef:=tprocvardef(tpropertysym(sym).proptype.def);
  918. p2:=comp_expr(true);
  919. if assigned(getprocvardef) then
  920. handle_procvar(getprocvardef,p2);
  921. tcallnode(p1).left:=ccallparanode.create(p2,tcallnode(p1).left);
  922. { mark as property, both the tcallnode and the real call block }
  923. include(p1.flags,nf_isproperty);
  924. getprocvardef:=nil;
  925. end;
  926. fieldvarsym :
  927. begin
  928. { generate access code }
  929. symlist_to_node(p1,st,tpropertysym(sym).writeaccess);
  930. include(p1.flags,nf_isproperty);
  931. consume(_ASSIGNMENT);
  932. { read the expression }
  933. p2:=comp_expr(true);
  934. p1:=cassignmentnode.create(p1,p2);
  935. end
  936. else
  937. begin
  938. p1:=cerrornode.create;
  939. Message(parser_e_no_procedure_to_access_property);
  940. end;
  941. end;
  942. end
  943. else
  944. begin
  945. p1:=cerrornode.create;
  946. Message(parser_e_no_procedure_to_access_property);
  947. end;
  948. end
  949. else
  950. begin
  951. { read property: }
  952. if not tpropertysym(sym).readaccess.empty then
  953. begin
  954. case tpropertysym(sym).readaccess.firstsym^.sym.typ of
  955. fieldvarsym :
  956. begin
  957. { generate access code }
  958. symlist_to_node(p1,st,tpropertysym(sym).readaccess);
  959. include(p1.flags,nf_isproperty);
  960. end;
  961. procsym :
  962. begin
  963. callflags:=[];
  964. { generate the method call }
  965. membercall:=maybe_load_methodpointer(st,p1);
  966. if membercall then
  967. include(callflags,cnf_member_call);
  968. p1:=ccallnode.create(paras,tprocsym(tpropertysym(sym).readaccess.firstsym^.sym),st,p1,callflags);
  969. paras:=nil;
  970. include(p1.flags,nf_isproperty);
  971. end
  972. else
  973. begin
  974. p1:=cerrornode.create;
  975. Message(type_e_mismatch);
  976. end;
  977. end;
  978. end
  979. else
  980. begin
  981. { error, no function to read property }
  982. p1:=cerrornode.create;
  983. Message(parser_e_no_procedure_to_access_property);
  984. end;
  985. end;
  986. { release paras if not used }
  987. if assigned(paras) then
  988. paras.free;
  989. end;
  990. { the ID token has to be consumed before calling this function }
  991. procedure do_member_read(classh:tobjectdef;getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callflags:tcallnodeflags);
  992. var
  993. static_name : string;
  994. isclassref : boolean;
  995. srsymtable : tsymtable;
  996. begin
  997. if sym=nil then
  998. begin
  999. { pattern is still valid unless
  1000. there is another ID just after the ID of sym }
  1001. Message1(sym_e_id_no_member,orgpattern);
  1002. p1.free;
  1003. p1:=cerrornode.create;
  1004. { try to clean up }
  1005. again:=false;
  1006. end
  1007. else
  1008. begin
  1009. if assigned(p1) then
  1010. begin
  1011. if not assigned(p1.resulttype.def) then
  1012. do_resulttypepass(p1);
  1013. isclassref:=(p1.resulttype.def.deftype=classrefdef);
  1014. end
  1015. else
  1016. isclassref:=false;
  1017. { we assume, that only procsyms and varsyms are in an object }
  1018. { symbol table, for classes, properties are allowed }
  1019. case sym.typ of
  1020. procsym:
  1021. begin
  1022. do_proc_call(sym,sym.owner,classh,
  1023. (getaddr and not(token in [_CARET,_POINT])),
  1024. again,p1,callflags);
  1025. { we need to know which procedure is called }
  1026. do_resulttypepass(p1);
  1027. { calling using classref? }
  1028. if isclassref and
  1029. (p1.nodetype=calln) and
  1030. assigned(tcallnode(p1).procdefinition) and
  1031. not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
  1032. not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
  1033. Message(parser_e_only_class_methods_via_class_ref);
  1034. end;
  1035. fieldvarsym:
  1036. begin
  1037. if (sp_static in sym.symoptions) then
  1038. begin
  1039. static_name:=lower(sym.owner.name^)+'_'+sym.name;
  1040. searchsym(static_name,sym,srsymtable);
  1041. check_hints(sym);
  1042. p1.free;
  1043. p1:=cloadnode.create(sym,srsymtable);
  1044. end
  1045. else
  1046. begin
  1047. if isclassref then
  1048. Message(parser_e_only_class_methods_via_class_ref);
  1049. p1:=csubscriptnode.create(sym,p1);
  1050. end;
  1051. end;
  1052. propertysym:
  1053. begin
  1054. if isclassref then
  1055. Message(parser_e_only_class_methods_via_class_ref);
  1056. handle_propertysym(sym,sym.owner,p1);
  1057. end;
  1058. else internalerror(16);
  1059. end;
  1060. end;
  1061. end;
  1062. {****************************************************************************
  1063. Factor
  1064. ****************************************************************************}
  1065. {$ifdef fpc}
  1066. {$maxfpuregisters 0}
  1067. {$endif fpc}
  1068. function factor(getaddr : boolean) : tnode;
  1069. {---------------------------------------------
  1070. Factor_read_id
  1071. ---------------------------------------------}
  1072. procedure factor_read_id(var p1:tnode;var again:boolean);
  1073. var
  1074. pc : pchar;
  1075. len : longint;
  1076. srsym : tsym;
  1077. possible_error : boolean;
  1078. srsymtable : tsymtable;
  1079. storesymtablestack : tsymtable;
  1080. htype : ttype;
  1081. static_name : string;
  1082. begin
  1083. { allow post fix operators }
  1084. again:=true;
  1085. consume_sym(srsym,srsymtable);
  1086. { Access to funcret or need to call the function? }
  1087. if (srsym.typ in [absolutevarsym,localvarsym,paravarsym]) and
  1088. (vo_is_funcret in tabstractvarsym(srsym).varoptions) and
  1089. (
  1090. (token=_LKLAMMER) or
  1091. (not(m_fpc in aktmodeswitches) and
  1092. (afterassignment or in_args) and
  1093. not(vo_is_result in tabstractvarsym(srsym).varoptions))
  1094. ) then
  1095. begin
  1096. storesymtablestack:=symtablestack;
  1097. symtablestack:=srsym.owner.next;
  1098. searchsym(srsym.name,srsym,srsymtable);
  1099. if not assigned(srsym) then
  1100. srsym:=generrorsym;
  1101. if (srsym.typ<>procsym) then
  1102. Message(parser_e_illegal_expression);
  1103. symtablestack:=storesymtablestack;
  1104. end;
  1105. begin
  1106. case srsym.typ of
  1107. absolutevarsym :
  1108. begin
  1109. if (tabsolutevarsym(srsym).abstyp=tovar) then
  1110. begin
  1111. p1:=nil;
  1112. symlist_to_node(p1,nil,tabsolutevarsym(srsym).ref);
  1113. p1:=ctypeconvnode.create(p1,tabsolutevarsym(srsym).vartype);
  1114. include(p1.flags,nf_absolute);
  1115. end
  1116. else
  1117. p1:=cloadnode.create(srsym,srsymtable);
  1118. end;
  1119. globalvarsym,
  1120. localvarsym,
  1121. paravarsym,
  1122. fieldvarsym :
  1123. begin
  1124. if (sp_static in srsym.symoptions) then
  1125. begin
  1126. static_name:=lower(srsym.owner.name^)+'_'+srsym.name;
  1127. searchsym(static_name,srsym,srsymtable);
  1128. check_hints(srsym);
  1129. end
  1130. else
  1131. begin
  1132. { are we in a class method, we check here the
  1133. srsymtable, because a field in another object
  1134. also has objectsymtable. And withsymtable is
  1135. not possible for self in class methods (PFV) }
  1136. if (srsymtable.symtabletype=objectsymtable) and
  1137. assigned(current_procinfo) and
  1138. (po_classmethod in current_procinfo.procdef.procoptions) then
  1139. Message(parser_e_only_class_methods);
  1140. end;
  1141. case srsymtable.symtabletype of
  1142. objectsymtable :
  1143. begin
  1144. p1:=csubscriptnode.create(srsym,load_self_node);
  1145. node_tree_set_filepos(p1,aktfilepos);
  1146. end;
  1147. withsymtable :
  1148. begin
  1149. p1:=csubscriptnode.create(srsym,tnode(twithsymtable(srsymtable).withrefnode).getcopy);
  1150. node_tree_set_filepos(p1,aktfilepos);
  1151. end;
  1152. else
  1153. p1:=cloadnode.create(srsym,srsymtable);
  1154. end;
  1155. end;
  1156. typedconstsym :
  1157. begin
  1158. p1:=cloadnode.create(srsym,srsymtable);
  1159. end;
  1160. syssym :
  1161. begin
  1162. p1:=statement_syssym(tsyssym(srsym).number);
  1163. end;
  1164. typesym :
  1165. begin
  1166. htype.setsym(srsym);
  1167. if not assigned(htype.def) then
  1168. begin
  1169. again:=false;
  1170. end
  1171. else
  1172. begin
  1173. { We need to know if this unit uses Variants }
  1174. if (htype.def=cvarianttype.def) and
  1175. not(cs_compilesystem in aktmoduleswitches) then
  1176. current_module.flags:=current_module.flags or uf_uses_variants;
  1177. if try_to_consume(_LKLAMMER) then
  1178. begin
  1179. p1:=comp_expr(true);
  1180. consume(_RKLAMMER);
  1181. p1:=ctypeconvnode.create_explicit(p1,htype);
  1182. end
  1183. else { not LKLAMMER }
  1184. if (token=_POINT) and
  1185. is_object(htype.def) then
  1186. begin
  1187. consume(_POINT);
  1188. if assigned(current_procinfo) and
  1189. assigned(current_procinfo.procdef._class) and
  1190. not(getaddr) then
  1191. begin
  1192. if current_procinfo.procdef._class.is_related(tobjectdef(htype.def)) then
  1193. begin
  1194. p1:=ctypenode.create(htype);
  1195. { search also in inherited methods }
  1196. srsym:=searchsym_in_class(tobjectdef(htype.def),pattern);
  1197. check_hints(srsym);
  1198. consume(_ID);
  1199. do_member_read(tobjectdef(htype.def),false,srsym,p1,again,[]);
  1200. end
  1201. else
  1202. begin
  1203. Message(parser_e_no_super_class);
  1204. again:=false;
  1205. end;
  1206. end
  1207. else
  1208. begin
  1209. { allows @TObject.Load }
  1210. { also allows static methods and variables }
  1211. p1:=ctypenode.create(htype);
  1212. { TP allows also @TMenu.Load if Load is only }
  1213. { defined in an anchestor class }
  1214. srsym:=search_class_member(tobjectdef(htype.def),pattern);
  1215. check_hints(srsym);
  1216. if not assigned(srsym) then
  1217. Message1(sym_e_id_no_member,orgpattern)
  1218. else if not(getaddr) and not(sp_static in srsym.symoptions) then
  1219. Message(sym_e_only_static_in_static)
  1220. else
  1221. begin
  1222. consume(_ID);
  1223. do_member_read(tobjectdef(htype.def),getaddr,srsym,p1,again,[]);
  1224. end;
  1225. end;
  1226. end
  1227. else
  1228. begin
  1229. { class reference ? }
  1230. if is_class(htype.def) then
  1231. begin
  1232. if getaddr and (token=_POINT) then
  1233. begin
  1234. consume(_POINT);
  1235. { allows @Object.Method }
  1236. { also allows static methods and variables }
  1237. p1:=ctypenode.create(htype);
  1238. { TP allows also @TMenu.Load if Load is only }
  1239. { defined in an anchestor class }
  1240. srsym:=search_class_member(tobjectdef(htype.def),pattern);
  1241. check_hints(srsym);
  1242. if not assigned(srsym) then
  1243. Message1(sym_e_id_no_member,orgpattern)
  1244. else
  1245. begin
  1246. consume(_ID);
  1247. do_member_read(tobjectdef(htype.def),getaddr,srsym,p1,again,[]);
  1248. end;
  1249. end
  1250. else
  1251. begin
  1252. p1:=ctypenode.create(htype);
  1253. { For a type block we simply return only
  1254. the type. For all other blocks we return
  1255. a loadvmt node }
  1256. if (block_type<>bt_type) then
  1257. p1:=cloadvmtaddrnode.create(p1);
  1258. end;
  1259. end
  1260. else
  1261. p1:=ctypenode.create(htype);
  1262. end;
  1263. end;
  1264. end;
  1265. enumsym :
  1266. begin
  1267. p1:=genenumnode(tenumsym(srsym));
  1268. end;
  1269. constsym :
  1270. begin
  1271. case tconstsym(srsym).consttyp of
  1272. constord :
  1273. begin
  1274. if tconstsym(srsym).consttype.def=nil then
  1275. internalerror(200403232);
  1276. p1:=cordconstnode.create(tconstsym(srsym).value.valueord,tconstsym(srsym).consttype,true);
  1277. end;
  1278. conststring :
  1279. begin
  1280. len:=tconstsym(srsym).value.len;
  1281. if not(cs_ansistrings in aktlocalswitches) and (len>255) then
  1282. len:=255;
  1283. getmem(pc,len+1);
  1284. move(pchar(tconstsym(srsym).value.valueptr)^,pc^,len);
  1285. pc[len]:=#0;
  1286. p1:=cstringconstnode.createpchar(pc,len);
  1287. end;
  1288. constreal :
  1289. p1:=crealconstnode.create(pbestreal(tconstsym(srsym).value.valueptr)^,pbestrealtype^);
  1290. constset :
  1291. p1:=csetconstnode.create(pconstset(tconstsym(srsym).value.valueptr),tconstsym(srsym).consttype);
  1292. constpointer :
  1293. p1:=cpointerconstnode.create(tconstsym(srsym).value.valueordptr,tconstsym(srsym).consttype);
  1294. constnil :
  1295. p1:=cnilnode.create;
  1296. constresourcestring:
  1297. begin
  1298. p1:=cloadnode.create(srsym,srsymtable);
  1299. do_resulttypepass(p1);
  1300. {$ifdef ansistring_bits}
  1301. case aktansistring_bits of
  1302. sb_16:
  1303. p1.resulttype:=cansistringtype16;
  1304. sb_32:
  1305. p1.resulttype:=cansistringtype32;
  1306. sb_64:
  1307. p1.resulttype:=cansistringtype64;
  1308. end;
  1309. {$else}
  1310. p1.resulttype:=cansistringtype;
  1311. {$endif}
  1312. end;
  1313. constguid :
  1314. p1:=cguidconstnode.create(pguid(tconstsym(srsym).value.valueptr)^);
  1315. end;
  1316. end;
  1317. procsym :
  1318. begin
  1319. { are we in a class method ? }
  1320. possible_error:=(srsymtable.symtabletype<>withsymtable) and
  1321. (srsym.owner.symtabletype=objectsymtable) and
  1322. not(is_interface(tdef(srsym.owner.defowner))) and
  1323. assigned(current_procinfo) and
  1324. (po_classmethod in current_procinfo.procdef.procoptions);
  1325. do_proc_call(srsym,srsymtable,nil,
  1326. (getaddr and not(token in [_CARET,_POINT])),
  1327. again,p1,[]);
  1328. { we need to know which procedure is called }
  1329. if possible_error then
  1330. begin
  1331. do_resulttypepass(p1);
  1332. if (p1.nodetype=calln) and
  1333. assigned(tcallnode(p1).procdefinition) and
  1334. not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) and
  1335. not(po_classmethod in tcallnode(p1).procdefinition.procoptions) then
  1336. Message(parser_e_only_class_methods);
  1337. end;
  1338. end;
  1339. propertysym :
  1340. begin
  1341. { access to property in a method }
  1342. { are we in a class method ? }
  1343. if (srsymtable.symtabletype=objectsymtable) and
  1344. assigned(current_procinfo) and
  1345. (po_classmethod in current_procinfo.procdef.procoptions) then
  1346. Message(parser_e_only_class_methods);
  1347. { no method pointer }
  1348. p1:=nil;
  1349. handle_propertysym(srsym,srsymtable,p1);
  1350. end;
  1351. labelsym :
  1352. begin
  1353. { Support @label }
  1354. if getaddr then
  1355. p1:=cloadnode.create(srsym,srsym.owner)
  1356. else
  1357. begin
  1358. consume(_COLON);
  1359. if tlabelsym(srsym).defined then
  1360. Message(sym_e_label_already_defined);
  1361. tlabelsym(srsym).defined:=true;
  1362. p1:=clabelnode.create(nil);
  1363. tlabelsym(srsym).code:=p1;
  1364. end;
  1365. end;
  1366. errorsym :
  1367. begin
  1368. p1:=cerrornode.create;
  1369. if try_to_consume(_LKLAMMER) then
  1370. begin
  1371. parse_paras(false,_RKLAMMER);
  1372. consume(_RKLAMMER);
  1373. end;
  1374. end;
  1375. else
  1376. begin
  1377. p1:=cerrornode.create;
  1378. Message(parser_e_illegal_expression);
  1379. end;
  1380. end; { end case }
  1381. end;
  1382. end;
  1383. {---------------------------------------------
  1384. Factor_Read_Set
  1385. ---------------------------------------------}
  1386. { Read a set between [] }
  1387. function factor_read_set:tnode;
  1388. var
  1389. p1,p2 : tnode;
  1390. lastp,
  1391. buildp : tarrayconstructornode;
  1392. begin
  1393. buildp:=nil;
  1394. { be sure that a least one arrayconstructn is used, also for an
  1395. empty [] }
  1396. if token=_RECKKLAMMER then
  1397. buildp:=carrayconstructornode.create(nil,buildp)
  1398. else
  1399. repeat
  1400. p1:=comp_expr(true);
  1401. if try_to_consume(_POINTPOINT) then
  1402. begin
  1403. p2:=comp_expr(true);
  1404. p1:=carrayconstructorrangenode.create(p1,p2);
  1405. end;
  1406. { insert at the end of the tree, to get the correct order }
  1407. if not assigned(buildp) then
  1408. begin
  1409. buildp:=carrayconstructornode.create(p1,nil);
  1410. lastp:=buildp;
  1411. end
  1412. else
  1413. begin
  1414. lastp.right:=carrayconstructornode.create(p1,nil);
  1415. lastp:=tarrayconstructornode(lastp.right);
  1416. end;
  1417. { there could be more elements }
  1418. until not try_to_consume(_COMMA);
  1419. factor_read_set:=buildp;
  1420. end;
  1421. {---------------------------------------------
  1422. PostFixOperators
  1423. ---------------------------------------------}
  1424. procedure postfixoperators(var p1:tnode;var again:boolean);
  1425. { tries to avoid syntax errors after invalid qualifiers }
  1426. procedure recoverconsume_postfixops;
  1427. begin
  1428. repeat
  1429. if not try_to_consume(_CARET) then
  1430. if try_to_consume(_POINT) then
  1431. try_to_consume(_ID)
  1432. else if try_to_consume(_LECKKLAMMER) then
  1433. begin
  1434. repeat
  1435. comp_expr(true);
  1436. until not try_to_consume(_COMMA);
  1437. consume(_RECKKLAMMER);
  1438. end
  1439. else
  1440. break;
  1441. until false;
  1442. end;
  1443. procedure handle_variantarray;
  1444. var
  1445. p4 : tnode;
  1446. newstatement : tstatementnode;
  1447. tempresultvariant,
  1448. temp : ttempcreatenode;
  1449. paras : tcallparanode;
  1450. newblock : tnode;
  1451. countindices : aint;
  1452. begin
  1453. { create statements with call initialize the arguments and
  1454. call fpc_dynarr_setlength }
  1455. newblock:=internalstatements(newstatement);
  1456. { get temp for array of indicies,
  1457. we set the real size later }
  1458. temp:=ctempcreatenode.create(sinttype,4,tt_persistent,false);
  1459. addstatement(newstatement,temp);
  1460. countindices:=0;
  1461. repeat
  1462. p4:=comp_expr(true);
  1463. addstatement(newstatement,cassignmentnode.create(
  1464. ctemprefnode.create_offset(temp,countindices*sinttype.def.size),p4));
  1465. inc(countindices);
  1466. until not try_to_consume(_COMMA);
  1467. { set real size }
  1468. temp.size:=countindices*sinttype.def.size;
  1469. consume(_RECKKLAMMER);
  1470. { we need only a write access if a := follows }
  1471. if token=_ASSIGNMENT then
  1472. begin
  1473. consume(_ASSIGNMENT);
  1474. p4:=comp_expr(true);
  1475. { create call to fpc_vararray_put }
  1476. paras:=ccallparanode.create(cordconstnode.create
  1477. (countindices,sinttype,true),
  1478. ccallparanode.create(caddrnode.create_internal
  1479. (ctemprefnode.create(temp)),
  1480. ccallparanode.create(ctypeconvnode.create_internal(p4,cvarianttype),
  1481. ccallparanode.create(p1
  1482. ,nil))));
  1483. addstatement(newstatement,ccallnode.createintern('fpc_vararray_put',paras));
  1484. addstatement(newstatement,ctempdeletenode.create(temp));
  1485. end
  1486. else
  1487. begin
  1488. { create temp for result }
  1489. tempresultvariant:=ctempcreatenode.create(cvarianttype,cvarianttype.def.size,tt_persistent,true);
  1490. addstatement(newstatement,tempresultvariant);
  1491. { create call to fpc_vararray_get }
  1492. paras:=ccallparanode.create(cordconstnode.create
  1493. (countindices,sinttype,true),
  1494. ccallparanode.create(caddrnode.create_internal
  1495. (ctemprefnode.create(temp)),
  1496. ccallparanode.create(p1,
  1497. ccallparanode.create(
  1498. ctemprefnode.create(tempresultvariant)
  1499. ,nil))));
  1500. addstatement(newstatement,ccallnode.createintern('fpc_vararray_get',paras));
  1501. addstatement(newstatement,ctempdeletenode.create(temp));
  1502. { the last statement should return the value as
  1503. location and type, this is done be referencing the
  1504. temp and converting it first from a persistent temp to
  1505. normal temp }
  1506. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempresultvariant));
  1507. addstatement(newstatement,ctemprefnode.create(tempresultvariant));
  1508. end;
  1509. p1:=newblock;
  1510. end;
  1511. var
  1512. store_static : boolean;
  1513. protsym : tpropertysym;
  1514. p2,p3 : tnode;
  1515. hsym : tsym;
  1516. classh : tobjectdef;
  1517. label
  1518. skipreckklammercheck;
  1519. begin
  1520. again:=true;
  1521. while again do
  1522. begin
  1523. { we need the resulttype }
  1524. do_resulttypepass(p1);
  1525. if codegenerror then
  1526. begin
  1527. recoverconsume_postfixops;
  1528. exit;
  1529. end;
  1530. { handle token }
  1531. case token of
  1532. _CARET:
  1533. begin
  1534. consume(_CARET);
  1535. if (p1.resulttype.def.deftype<>pointerdef) then
  1536. begin
  1537. { ^ as binary operator is a problem!!!! (FK) }
  1538. again:=false;
  1539. Message(parser_e_invalid_qualifier);
  1540. recoverconsume_postfixops;
  1541. p1.destroy;
  1542. p1:=cerrornode.create;
  1543. end
  1544. else
  1545. begin
  1546. p1:=cderefnode.create(p1);
  1547. end;
  1548. end;
  1549. _LECKKLAMMER:
  1550. begin
  1551. if is_class_or_interface(p1.resulttype.def) then
  1552. begin
  1553. { default property }
  1554. protsym:=search_default_property(tobjectdef(p1.resulttype.def));
  1555. if not(assigned(protsym)) then
  1556. begin
  1557. p1.destroy;
  1558. p1:=cerrornode.create;
  1559. again:=false;
  1560. message(parser_e_no_default_property_available);
  1561. end
  1562. else
  1563. begin
  1564. { The property symbol is referenced indirect }
  1565. inc(protsym.refs);
  1566. handle_propertysym(protsym,protsym.owner,p1);
  1567. end;
  1568. end
  1569. else
  1570. begin
  1571. consume(_LECKKLAMMER);
  1572. repeat
  1573. case p1.resulttype.def.deftype of
  1574. pointerdef:
  1575. begin
  1576. { support delphi autoderef }
  1577. if (tpointerdef(p1.resulttype.def).pointertype.def.deftype=arraydef) and
  1578. (m_autoderef in aktmodeswitches) then
  1579. begin
  1580. p1:=cderefnode.create(p1);
  1581. end;
  1582. p2:=comp_expr(true);
  1583. p1:=cvecnode.create(p1,p2);
  1584. end;
  1585. variantdef:
  1586. begin
  1587. handle_variantarray;
  1588. { the RECKKLAMMER is already read }
  1589. goto skipreckklammercheck;
  1590. end;
  1591. stringdef :
  1592. begin
  1593. p2:=comp_expr(true);
  1594. p1:=cvecnode.create(p1,p2);
  1595. end;
  1596. arraydef :
  1597. begin
  1598. p2:=comp_expr(true);
  1599. { support SEG:OFS for go32v2 Mem[] }
  1600. if (target_info.system in [system_i386_go32v2,system_i386_watcom]) and
  1601. (p1.nodetype=loadn) and
  1602. assigned(tloadnode(p1).symtableentry) and
  1603. assigned(tloadnode(p1).symtableentry.owner.name) and
  1604. (tloadnode(p1).symtableentry.owner.name^='SYSTEM') and
  1605. ((tloadnode(p1).symtableentry.name='MEM') or
  1606. (tloadnode(p1).symtableentry.name='MEMW') or
  1607. (tloadnode(p1).symtableentry.name='MEML')) then
  1608. begin
  1609. if try_to_consume(_COLON) then
  1610. begin
  1611. p3:=caddnode.create(muln,cordconstnode.create($10,s32inttype,false),p2);
  1612. p2:=comp_expr(true);
  1613. p2:=caddnode.create(addn,p2,p3);
  1614. p1:=cvecnode.create(p1,p2);
  1615. include(tvecnode(p1).flags,nf_memseg);
  1616. include(tvecnode(p1).flags,nf_memindex);
  1617. end
  1618. else
  1619. begin
  1620. p1:=cvecnode.create(p1,p2);
  1621. include(tvecnode(p1).flags,nf_memindex);
  1622. end;
  1623. end
  1624. else
  1625. p1:=cvecnode.create(p1,p2);
  1626. end;
  1627. else
  1628. begin
  1629. Message(parser_e_invalid_qualifier);
  1630. p1.destroy;
  1631. p1:=cerrornode.create;
  1632. comp_expr(true);
  1633. again:=false;
  1634. end;
  1635. end;
  1636. do_resulttypepass(p1);
  1637. until not try_to_consume(_COMMA);
  1638. consume(_RECKKLAMMER);
  1639. { handle_variantarray eats the RECKKLAMMER and jumps here }
  1640. skipreckklammercheck:
  1641. end;
  1642. end;
  1643. _POINT :
  1644. begin
  1645. consume(_POINT);
  1646. if (p1.resulttype.def.deftype=pointerdef) and
  1647. (m_autoderef in aktmodeswitches) then
  1648. begin
  1649. p1:=cderefnode.create(p1);
  1650. do_resulttypepass(p1);
  1651. end;
  1652. case p1.resulttype.def.deftype of
  1653. recorddef:
  1654. begin
  1655. if token=_ID then
  1656. begin
  1657. hsym:=tsym(trecorddef(p1.resulttype.def).symtable.search(pattern));
  1658. check_hints(hsym);
  1659. if assigned(hsym) and
  1660. (hsym.typ=fieldvarsym) then
  1661. p1:=csubscriptnode.create(hsym,p1)
  1662. else
  1663. begin
  1664. Message1(sym_e_illegal_field,pattern);
  1665. p1.destroy;
  1666. p1:=cerrornode.create;
  1667. end;
  1668. end;
  1669. consume(_ID);
  1670. end;
  1671. variantdef:
  1672. begin
  1673. end;
  1674. classrefdef:
  1675. begin
  1676. if token=_ID then
  1677. begin
  1678. classh:=tobjectdef(tclassrefdef(p1.resulttype.def).pointertype.def);
  1679. hsym:=searchsym_in_class(classh,pattern);
  1680. check_hints(hsym);
  1681. if hsym=nil then
  1682. begin
  1683. Message1(sym_e_id_no_member,orgpattern);
  1684. p1.destroy;
  1685. p1:=cerrornode.create;
  1686. { try to clean up }
  1687. consume(_ID);
  1688. end
  1689. else
  1690. begin
  1691. consume(_ID);
  1692. do_member_read(classh,getaddr,hsym,p1,again,[]);
  1693. end;
  1694. end
  1695. else { Error }
  1696. Consume(_ID);
  1697. end;
  1698. objectdef:
  1699. begin
  1700. if token=_ID then
  1701. begin
  1702. store_static:=allow_only_static;
  1703. allow_only_static:=false;
  1704. classh:=tobjectdef(p1.resulttype.def);
  1705. hsym:=searchsym_in_class(classh,pattern);
  1706. check_hints(hsym);
  1707. allow_only_static:=store_static;
  1708. if hsym=nil then
  1709. begin
  1710. Message1(sym_e_id_no_member,orgpattern);
  1711. p1.destroy;
  1712. p1:=cerrornode.create;
  1713. { try to clean up }
  1714. consume(_ID);
  1715. end
  1716. else
  1717. begin
  1718. consume(_ID);
  1719. do_member_read(classh,getaddr,hsym,p1,again,[]);
  1720. end;
  1721. end
  1722. else { Error }
  1723. Consume(_ID);
  1724. end;
  1725. pointerdef:
  1726. begin
  1727. Message(parser_e_invalid_qualifier);
  1728. if tpointerdef(p1.resulttype.def).pointertype.def.deftype in [recorddef,objectdef,classrefdef] then
  1729. Message(parser_h_maybe_deref_caret_missing);
  1730. end;
  1731. else
  1732. begin
  1733. Message(parser_e_invalid_qualifier);
  1734. p1.destroy;
  1735. p1:=cerrornode.create;
  1736. { Error }
  1737. consume(_ID);
  1738. end;
  1739. end;
  1740. end;
  1741. else
  1742. begin
  1743. { is this a procedure variable ? }
  1744. if assigned(p1.resulttype.def) and
  1745. (p1.resulttype.def.deftype=procvardef) then
  1746. begin
  1747. if assigned(getprocvardef) and
  1748. equal_defs(p1.resulttype.def,getprocvardef) then
  1749. again:=false
  1750. else
  1751. begin
  1752. if try_to_consume(_LKLAMMER) then
  1753. begin
  1754. p2:=parse_paras(false,_RKLAMMER);
  1755. consume(_RKLAMMER);
  1756. p1:=ccallnode.create_procvar(p2,p1);
  1757. { proc():= is never possible }
  1758. if token=_ASSIGNMENT then
  1759. begin
  1760. Message(parser_e_illegal_expression);
  1761. p1.free;
  1762. p1:=cerrornode.create;
  1763. again:=false;
  1764. end;
  1765. end
  1766. else
  1767. again:=false;
  1768. end;
  1769. end
  1770. else
  1771. again:=false;
  1772. end;
  1773. end;
  1774. end; { while again }
  1775. end;
  1776. {---------------------------------------------
  1777. Factor (Main)
  1778. ---------------------------------------------}
  1779. var
  1780. l : longint;
  1781. ic : int64;
  1782. qc : qword;
  1783. {$ifndef cpu64}
  1784. card : cardinal;
  1785. {$endif cpu64}
  1786. oldp1,
  1787. p1 : tnode;
  1788. code : integer;
  1789. again : boolean;
  1790. sym : tsym;
  1791. pd : tprocdef;
  1792. classh : tobjectdef;
  1793. d : bestreal;
  1794. hs,hsorg : string;
  1795. htype : ttype;
  1796. filepos : tfileposinfo;
  1797. {---------------------------------------------
  1798. Helpers
  1799. ---------------------------------------------}
  1800. procedure check_tokenpos;
  1801. begin
  1802. if (p1<>oldp1) then
  1803. begin
  1804. if assigned(p1) then
  1805. p1.fileinfo:=filepos;
  1806. oldp1:=p1;
  1807. filepos:=akttokenpos;
  1808. end;
  1809. end;
  1810. begin
  1811. oldp1:=nil;
  1812. p1:=nil;
  1813. filepos:=akttokenpos;
  1814. again:=false;
  1815. if token=_ID then
  1816. begin
  1817. again:=true;
  1818. { Handle references to self }
  1819. if (idtoken=_SELF) and
  1820. not(block_type in [bt_const,bt_type]) and
  1821. assigned(current_procinfo) and
  1822. assigned(current_procinfo.procdef._class) then
  1823. begin
  1824. p1:=load_self_node;
  1825. consume(_ID);
  1826. again:=true;
  1827. end
  1828. else
  1829. factor_read_id(p1,again);
  1830. if again then
  1831. begin
  1832. check_tokenpos;
  1833. { handle post fix operators }
  1834. postfixoperators(p1,again);
  1835. end;
  1836. end
  1837. else
  1838. case token of
  1839. _INHERITED :
  1840. begin
  1841. again:=true;
  1842. consume(_INHERITED);
  1843. if assigned(current_procinfo) and
  1844. assigned(current_procinfo.procdef._class) then
  1845. begin
  1846. classh:=current_procinfo.procdef._class.childof;
  1847. { if inherited; only then we need the method with
  1848. the same name }
  1849. if token in endtokens then
  1850. begin
  1851. hs:=current_procinfo.procdef.procsym.name;
  1852. hsorg:=current_procinfo.procdef.procsym.realname;
  1853. anon_inherited:=true;
  1854. { For message methods we need to search using the message
  1855. number or string }
  1856. pd:=tprocsym(current_procinfo.procdef.procsym).first_procdef;
  1857. if (po_msgint in pd.procoptions) then
  1858. sym:=searchsym_in_class_by_msgint(classh,pd.messageinf.i)
  1859. else
  1860. if (po_msgstr in pd.procoptions) then
  1861. sym:=searchsym_in_class_by_msgstr(classh,pd.messageinf.str)
  1862. else
  1863. sym:=searchsym_in_class(classh,hs);
  1864. end
  1865. else
  1866. begin
  1867. hs:=pattern;
  1868. hsorg:=orgpattern;
  1869. consume(_ID);
  1870. anon_inherited:=false;
  1871. sym:=searchsym_in_class(classh,hs);
  1872. end;
  1873. if assigned(sym) then
  1874. begin
  1875. check_hints(sym);
  1876. { load the procdef from the inherited class and
  1877. not from self }
  1878. if sym.typ in [procsym,propertysym] then
  1879. begin
  1880. if (sym.typ = procsym) then
  1881. begin
  1882. htype.setdef(classh);
  1883. if (po_classmethod in current_procinfo.procdef.procoptions) or
  1884. (po_staticmethod in current_procinfo.procdef.procoptions) then
  1885. htype.setdef(tclassrefdef.create(htype));
  1886. p1:=ctypenode.create(htype);
  1887. end;
  1888. end
  1889. else
  1890. begin
  1891. Message(parser_e_methode_id_expected);
  1892. p1:=cerrornode.create;
  1893. end;
  1894. do_member_read(classh,false,sym,p1,again,[cnf_inherited,cnf_anon_inherited]);
  1895. end
  1896. else
  1897. begin
  1898. if anon_inherited then
  1899. begin
  1900. { For message methods we need to call DefaultHandler }
  1901. if (po_msgint in pd.procoptions) or
  1902. (po_msgstr in pd.procoptions) then
  1903. begin
  1904. sym:=searchsym_in_class(classh,'DEFAULTHANDLER');
  1905. if not assigned(sym) or
  1906. (sym.typ<>procsym) then
  1907. internalerror(200303171);
  1908. p1:=nil;
  1909. do_proc_call(sym,sym.owner,classh,false,again,p1,[]);
  1910. end
  1911. else
  1912. begin
  1913. { we need to ignore the inherited; }
  1914. p1:=cnothingnode.create;
  1915. end;
  1916. end
  1917. else
  1918. begin
  1919. Message1(sym_e_id_no_member,hsorg);
  1920. p1:=cerrornode.create;
  1921. end;
  1922. again:=false;
  1923. end;
  1924. { turn auto inheriting off }
  1925. anon_inherited:=false;
  1926. end
  1927. else
  1928. begin
  1929. Message(parser_e_generic_methods_only_in_methods);
  1930. again:=false;
  1931. p1:=cerrornode.create;
  1932. end;
  1933. postfixoperators(p1,again);
  1934. end;
  1935. _INTCONST :
  1936. begin
  1937. {$ifdef cpu64}
  1938. { when already running under 64bit must read int64 constant, because reading
  1939. cardinal first will also succeed (code=0) for values > maxcardinal, because
  1940. range checking is off by default (PFV) }
  1941. val(pattern,ic,code);
  1942. if code=0 then
  1943. begin
  1944. consume(_INTCONST);
  1945. int_to_type(ic,htype);
  1946. p1:=cordconstnode.create(ic,htype,true);
  1947. end
  1948. else
  1949. begin
  1950. { try qword next }
  1951. val(pattern,qc,code);
  1952. if code=0 then
  1953. begin
  1954. consume(_INTCONST);
  1955. htype:=u64inttype;
  1956. p1:=cordconstnode.create(qc,htype,true);
  1957. end;
  1958. end;
  1959. {$else}
  1960. { try cardinal first }
  1961. val(pattern,card,code);
  1962. if code=0 then
  1963. begin
  1964. consume(_INTCONST);
  1965. int_to_type(card,htype);
  1966. p1:=cordconstnode.create(card,htype,true);
  1967. end
  1968. else
  1969. begin
  1970. { then longint }
  1971. val(pattern,l,code);
  1972. if code = 0 then
  1973. begin
  1974. consume(_INTCONST);
  1975. int_to_type(l,htype);
  1976. p1:=cordconstnode.create(l,htype,true);
  1977. end
  1978. else
  1979. begin
  1980. { then int64 }
  1981. val(pattern,ic,code);
  1982. if code=0 then
  1983. begin
  1984. consume(_INTCONST);
  1985. int_to_type(ic,htype);
  1986. p1:=cordconstnode.create(ic,htype,true);
  1987. end
  1988. else
  1989. begin
  1990. { try qword next }
  1991. val(pattern,qc,code);
  1992. if code=0 then
  1993. begin
  1994. consume(_INTCONST);
  1995. htype:=u64inttype;
  1996. p1:=cordconstnode.create(tconstexprint(qc),htype,true);
  1997. end;
  1998. end;
  1999. end;
  2000. end;
  2001. {$endif}
  2002. if code<>0 then
  2003. begin
  2004. { finally float }
  2005. val(pattern,d,code);
  2006. if code<>0 then
  2007. begin
  2008. Message(parser_e_invalid_integer);
  2009. consume(_INTCONST);
  2010. l:=1;
  2011. p1:=cordconstnode.create(l,sinttype,true);
  2012. end
  2013. else
  2014. begin
  2015. consume(_INTCONST);
  2016. p1:=crealconstnode.create(d,pbestrealtype^);
  2017. end;
  2018. end;
  2019. end;
  2020. _REALNUMBER :
  2021. begin
  2022. val(pattern,d,code);
  2023. if code<>0 then
  2024. begin
  2025. Message(parser_e_error_in_real);
  2026. d:=1.0;
  2027. end;
  2028. consume(_REALNUMBER);
  2029. p1:=crealconstnode.create(d,pbestrealtype^);
  2030. end;
  2031. _STRING :
  2032. begin
  2033. string_dec(htype);
  2034. { STRING can be also a type cast }
  2035. if try_to_consume(_LKLAMMER) then
  2036. begin
  2037. p1:=comp_expr(true);
  2038. consume(_RKLAMMER);
  2039. p1:=ctypeconvnode.create_explicit(p1,htype);
  2040. { handle postfix operators here e.g. string(a)[10] }
  2041. again:=true;
  2042. postfixoperators(p1,again);
  2043. end
  2044. else
  2045. p1:=ctypenode.create(htype);
  2046. end;
  2047. _FILE :
  2048. begin
  2049. htype:=cfiletype;
  2050. consume(_FILE);
  2051. { FILE can be also a type cast }
  2052. if try_to_consume(_LKLAMMER) then
  2053. begin
  2054. p1:=comp_expr(true);
  2055. consume(_RKLAMMER);
  2056. p1:=ctypeconvnode.create_explicit(p1,htype);
  2057. { handle postfix operators here e.g. string(a)[10] }
  2058. again:=true;
  2059. postfixoperators(p1,again);
  2060. end
  2061. else
  2062. begin
  2063. p1:=ctypenode.create(htype);
  2064. end;
  2065. end;
  2066. _CSTRING :
  2067. begin
  2068. p1:=cstringconstnode.createstr(pattern,st_default);
  2069. consume(_CSTRING);
  2070. end;
  2071. _CCHAR :
  2072. begin
  2073. p1:=cordconstnode.create(ord(pattern[1]),cchartype,true);
  2074. consume(_CCHAR);
  2075. end;
  2076. _CWSTRING:
  2077. begin
  2078. p1:=cstringconstnode.createwstr(patternw);
  2079. consume(_CWSTRING);
  2080. end;
  2081. _CWCHAR:
  2082. begin
  2083. p1:=cordconstnode.create(ord(getcharwidestring(patternw,0)),cwidechartype,true);
  2084. consume(_CWCHAR);
  2085. end;
  2086. _KLAMMERAFFE :
  2087. begin
  2088. consume(_KLAMMERAFFE);
  2089. got_addrn:=true;
  2090. { support both @<x> and @(<x>) }
  2091. if try_to_consume(_LKLAMMER) then
  2092. begin
  2093. p1:=factor(true);
  2094. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2095. begin
  2096. again:=true;
  2097. postfixoperators(p1,again);
  2098. end;
  2099. consume(_RKLAMMER);
  2100. end
  2101. else
  2102. p1:=factor(true);
  2103. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2104. begin
  2105. again:=true;
  2106. postfixoperators(p1,again);
  2107. end;
  2108. got_addrn:=false;
  2109. p1:=caddrnode.create(p1);
  2110. if cs_typed_addresses in aktlocalswitches then
  2111. include(p1.flags,nf_typedaddr);
  2112. { Store the procvar that we are expecting, the
  2113. addrn will use the information to find the correct
  2114. procdef or it will return an error }
  2115. if assigned(getprocvardef) and
  2116. (taddrnode(p1).left.nodetype = loadn) then
  2117. taddrnode(p1).getprocvardef:=getprocvardef;
  2118. end;
  2119. _LKLAMMER :
  2120. begin
  2121. consume(_LKLAMMER);
  2122. p1:=comp_expr(true);
  2123. consume(_RKLAMMER);
  2124. { it's not a good solution }
  2125. { but (a+b)^ makes some problems }
  2126. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2127. begin
  2128. again:=true;
  2129. postfixoperators(p1,again);
  2130. end;
  2131. end;
  2132. _LECKKLAMMER :
  2133. begin
  2134. consume(_LECKKLAMMER);
  2135. p1:=factor_read_set;
  2136. consume(_RECKKLAMMER);
  2137. end;
  2138. _PLUS :
  2139. begin
  2140. consume(_PLUS);
  2141. p1:=factor(false);
  2142. end;
  2143. _MINUS :
  2144. begin
  2145. consume(_MINUS);
  2146. if (token = _INTCONST) then
  2147. begin
  2148. { ugly hack, but necessary to be able to parse }
  2149. { -9223372036854775808 as int64 (JM) }
  2150. pattern := '-'+pattern;
  2151. p1:=sub_expr(oppower,false);
  2152. { -1 ** 4 should be - (1 ** 4) and not
  2153. (-1) ** 4
  2154. This was the reason of tw0869.pp test failure PM }
  2155. if p1.nodetype=starstarn then
  2156. begin
  2157. if tbinarynode(p1).left.nodetype=ordconstn then
  2158. begin
  2159. tordconstnode(tbinarynode(p1).left).value:=-tordconstnode(tbinarynode(p1).left).value;
  2160. p1:=cunaryminusnode.create(p1);
  2161. end
  2162. else if tbinarynode(p1).left.nodetype=realconstn then
  2163. begin
  2164. trealconstnode(tbinarynode(p1).left).value_real:=-trealconstnode(tbinarynode(p1).left).value_real;
  2165. p1:=cunaryminusnode.create(p1);
  2166. end
  2167. else
  2168. internalerror(20021029);
  2169. end;
  2170. end
  2171. else
  2172. begin
  2173. p1:=sub_expr(oppower,false);
  2174. p1:=cunaryminusnode.create(p1);
  2175. end;
  2176. end;
  2177. _OP_NOT :
  2178. begin
  2179. consume(_OP_NOT);
  2180. p1:=factor(false);
  2181. p1:=cnotnode.create(p1);
  2182. end;
  2183. _TRUE :
  2184. begin
  2185. consume(_TRUE);
  2186. p1:=cordconstnode.create(1,booltype,false);
  2187. end;
  2188. _FALSE :
  2189. begin
  2190. consume(_FALSE);
  2191. p1:=cordconstnode.create(0,booltype,false);
  2192. end;
  2193. _NIL :
  2194. begin
  2195. consume(_NIL);
  2196. p1:=cnilnode.create;
  2197. { It's really ugly code nil^, but delphi allows it }
  2198. if token in [_CARET] then
  2199. begin
  2200. again:=true;
  2201. postfixoperators(p1,again);
  2202. end;
  2203. end;
  2204. else
  2205. begin
  2206. p1:=cerrornode.create;
  2207. consume(token);
  2208. Message(parser_e_illegal_expression);
  2209. end;
  2210. end;
  2211. { generate error node if no node is created }
  2212. if not assigned(p1) then
  2213. begin
  2214. {$ifdef EXTDEBUG}
  2215. Comment(V_Warning,'factor: p1=nil');
  2216. {$endif}
  2217. p1:=cerrornode.create;
  2218. end;
  2219. { get the resulttype for the node }
  2220. if (not assigned(p1.resulttype.def)) then
  2221. do_resulttypepass(p1);
  2222. factor:=p1;
  2223. check_tokenpos;
  2224. end;
  2225. {$ifdef fpc}
  2226. {$maxfpuregisters default}
  2227. {$endif fpc}
  2228. {****************************************************************************
  2229. Sub_Expr
  2230. ****************************************************************************}
  2231. const
  2232. { Warning these stay be ordered !! }
  2233. operator_levels:array[Toperator_precedence] of set of Ttoken=
  2234. ([_LT,_LTE,_GT,_GTE,_EQUAL,_UNEQUAL,_OP_IN],
  2235. [_PLUS,_MINUS,_OP_OR,_PIPE,_OP_XOR],
  2236. [_CARET,_SYMDIF,_STARSTAR,_STAR,_SLASH,
  2237. _OP_AS,_OP_IS,_OP_AND,_AMPERSAND,_OP_DIV,_OP_MOD,_OP_SHL,_OP_SHR],
  2238. [_STARSTAR] );
  2239. function sub_expr(pred_level:Toperator_precedence;accept_equal : boolean):tnode;
  2240. {Reads a subexpression while the operators are of the current precedence
  2241. level, or any higher level. Replaces the old term, simpl_expr and
  2242. simpl2_expr.}
  2243. var
  2244. p1,p2 : tnode;
  2245. oldt : Ttoken;
  2246. filepos : tfileposinfo;
  2247. begin
  2248. if pred_level=highest_precedence then
  2249. p1:=factor(false)
  2250. else
  2251. p1:=sub_expr(succ(pred_level),true);
  2252. repeat
  2253. if (token in operator_levels[pred_level]) and
  2254. ((token<>_EQUAL) or accept_equal) then
  2255. begin
  2256. oldt:=token;
  2257. filepos:=akttokenpos;
  2258. consume(token);
  2259. if pred_level=highest_precedence then
  2260. p2:=factor(false)
  2261. else
  2262. p2:=sub_expr(succ(pred_level),true);
  2263. case oldt of
  2264. _PLUS :
  2265. p1:=caddnode.create(addn,p1,p2);
  2266. _MINUS :
  2267. p1:=caddnode.create(subn,p1,p2);
  2268. _STAR :
  2269. p1:=caddnode.create(muln,p1,p2);
  2270. _SLASH :
  2271. p1:=caddnode.create(slashn,p1,p2);
  2272. _EQUAL :
  2273. p1:=caddnode.create(equaln,p1,p2);
  2274. _GT :
  2275. p1:=caddnode.create(gtn,p1,p2);
  2276. _LT :
  2277. p1:=caddnode.create(ltn,p1,p2);
  2278. _GTE :
  2279. p1:=caddnode.create(gten,p1,p2);
  2280. _LTE :
  2281. p1:=caddnode.create(lten,p1,p2);
  2282. _SYMDIF :
  2283. p1:=caddnode.create(symdifn,p1,p2);
  2284. _STARSTAR :
  2285. p1:=caddnode.create(starstarn,p1,p2);
  2286. _OP_AS :
  2287. p1:=casnode.create(p1,p2);
  2288. _OP_IN :
  2289. p1:=cinnode.create(p1,p2);
  2290. _OP_IS :
  2291. p1:=cisnode.create(p1,p2);
  2292. _OP_OR,
  2293. _PIPE {macpas only} :
  2294. p1:=caddnode.create(orn,p1,p2);
  2295. _OP_AND,
  2296. _AMPERSAND {macpas only} :
  2297. p1:=caddnode.create(andn,p1,p2);
  2298. _OP_DIV :
  2299. p1:=cmoddivnode.create(divn,p1,p2);
  2300. _OP_NOT :
  2301. p1:=cnotnode.create(p1);
  2302. _OP_MOD :
  2303. p1:=cmoddivnode.create(modn,p1,p2);
  2304. _OP_SHL :
  2305. p1:=cshlshrnode.create(shln,p1,p2);
  2306. _OP_SHR :
  2307. p1:=cshlshrnode.create(shrn,p1,p2);
  2308. _OP_XOR :
  2309. p1:=caddnode.create(xorn,p1,p2);
  2310. _ASSIGNMENT :
  2311. p1:=cassignmentnode.create(p1,p2);
  2312. _CARET :
  2313. p1:=caddnode.create(caretn,p1,p2);
  2314. _UNEQUAL :
  2315. p1:=caddnode.create(unequaln,p1,p2);
  2316. end;
  2317. p1.fileinfo:=filepos;
  2318. end
  2319. else
  2320. break;
  2321. until false;
  2322. sub_expr:=p1;
  2323. end;
  2324. function comp_expr(accept_equal : boolean):tnode;
  2325. var
  2326. oldafterassignment : boolean;
  2327. p1 : tnode;
  2328. begin
  2329. oldafterassignment:=afterassignment;
  2330. afterassignment:=true;
  2331. p1:=sub_expr(opcompare,accept_equal);
  2332. { get the resulttype for this expression }
  2333. if not assigned(p1.resulttype.def) then
  2334. do_resulttypepass(p1);
  2335. afterassignment:=oldafterassignment;
  2336. comp_expr:=p1;
  2337. end;
  2338. function expr : tnode;
  2339. var
  2340. p1,p2 : tnode;
  2341. oldafterassignment : boolean;
  2342. oldp1 : tnode;
  2343. filepos : tfileposinfo;
  2344. begin
  2345. oldafterassignment:=afterassignment;
  2346. p1:=sub_expr(opcompare,true);
  2347. { get the resulttype for this expression }
  2348. if not assigned(p1.resulttype.def) then
  2349. do_resulttypepass(p1);
  2350. filepos:=akttokenpos;
  2351. if token in [_ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
  2352. afterassignment:=true;
  2353. oldp1:=p1;
  2354. case token of
  2355. _POINTPOINT :
  2356. begin
  2357. consume(_POINTPOINT);
  2358. p2:=sub_expr(opcompare,true);
  2359. p1:=crangenode.create(p1,p2);
  2360. end;
  2361. _ASSIGNMENT :
  2362. begin
  2363. consume(_ASSIGNMENT);
  2364. if (p1.resulttype.def.deftype=procvardef) then
  2365. getprocvardef:=tprocvardef(p1.resulttype.def);
  2366. p2:=sub_expr(opcompare,true);
  2367. if assigned(getprocvardef) then
  2368. handle_procvar(getprocvardef,p2);
  2369. getprocvardef:=nil;
  2370. p1:=cassignmentnode.create(p1,p2);
  2371. end;
  2372. _PLUSASN :
  2373. begin
  2374. consume(_PLUSASN);
  2375. p2:=sub_expr(opcompare,true);
  2376. p1:=gen_c_style_operator(addn,p1,p2);
  2377. end;
  2378. _MINUSASN :
  2379. begin
  2380. consume(_MINUSASN);
  2381. p2:=sub_expr(opcompare,true);
  2382. p1:=gen_c_style_operator(subn,p1,p2);
  2383. end;
  2384. _STARASN :
  2385. begin
  2386. consume(_STARASN );
  2387. p2:=sub_expr(opcompare,true);
  2388. p1:=gen_c_style_operator(muln,p1,p2);
  2389. end;
  2390. _SLASHASN :
  2391. begin
  2392. consume(_SLASHASN );
  2393. p2:=sub_expr(opcompare,true);
  2394. p1:=gen_c_style_operator(slashn,p1,p2);
  2395. end;
  2396. end;
  2397. { get the resulttype for this expression }
  2398. if not assigned(p1.resulttype.def) then
  2399. do_resulttypepass(p1);
  2400. afterassignment:=oldafterassignment;
  2401. if p1<>oldp1 then
  2402. p1.fileinfo:=filepos;
  2403. expr:=p1;
  2404. end;
  2405. {$ifdef int64funcresok}
  2406. function get_intconst:TConstExprInt;
  2407. {$else int64funcresok}
  2408. function get_intconst:longint;
  2409. {$endif int64funcresok}
  2410. {Reads an expression, tries to evalute it and check if it is an integer
  2411. constant. Then the constant is returned.}
  2412. var
  2413. p:tnode;
  2414. begin
  2415. result:=0;
  2416. p:=comp_expr(true);
  2417. if not codegenerror then
  2418. begin
  2419. if (p.nodetype<>ordconstn) or
  2420. not(is_integer(p.resulttype.def)) then
  2421. Message(parser_e_illegal_expression)
  2422. else
  2423. result:=tordconstnode(p).value;
  2424. end;
  2425. p.free;
  2426. end;
  2427. function get_stringconst:string;
  2428. {Reads an expression, tries to evaluate it and checks if it is a string
  2429. constant. Then the constant is returned.}
  2430. var
  2431. p:tnode;
  2432. begin
  2433. get_stringconst:='';
  2434. p:=comp_expr(true);
  2435. if p.nodetype<>stringconstn then
  2436. begin
  2437. if (p.nodetype=ordconstn) and is_char(p.resulttype.def) then
  2438. get_stringconst:=char(tordconstnode(p).value)
  2439. else
  2440. Message(parser_e_illegal_expression);
  2441. end
  2442. else
  2443. get_stringconst:=strpas(tstringconstnode(p).value_str);
  2444. p.free;
  2445. end;
  2446. end.