pexpr.pas 97 KB

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