pexpr.pas 96 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659
  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_slice_x:
  599. begin
  600. if not(in_args) then
  601. begin
  602. message(parser_e_illegal_slice);
  603. consume(_LKLAMMER);
  604. in_args:=true;
  605. comp_expr(true).free;
  606. if try_to_consume(_COMMA) then
  607. comp_expr(true).free;
  608. statement_syssym:=cerrornode.create;
  609. consume(_RKLAMMER);
  610. end
  611. else
  612. begin
  613. consume(_LKLAMMER);
  614. in_args:=true;
  615. p1:=comp_expr(true);
  616. if try_to_consume(_COMMA) then
  617. p2:=ccallparanode.create(comp_expr(true),nil)
  618. else
  619. p2:=nil;
  620. p2:=ccallparanode.create(p1,p2);
  621. statement_syssym:=geninlinenode(l,false,p2);
  622. consume(_RKLAMMER);
  623. end;
  624. end;
  625. in_initialize_x:
  626. begin
  627. statement_syssym:=inline_initialize;
  628. end;
  629. in_finalize_x:
  630. begin
  631. statement_syssym:=inline_finalize;
  632. end;
  633. in_copy_x:
  634. begin
  635. statement_syssym:=inline_copy;
  636. end;
  637. in_concat_x :
  638. begin
  639. consume(_LKLAMMER);
  640. in_args:=true;
  641. { Translate to x:=x+y[+z]. The addnode will do the
  642. type checking }
  643. p2:=nil;
  644. repeat
  645. p1:=comp_expr(true);
  646. if p2<>nil then
  647. p2:=caddnode.create(addn,p2,p1)
  648. else
  649. begin
  650. { Force string type if it isn't yet }
  651. if not(
  652. (p1.resulttype.def.deftype=stringdef) or
  653. is_chararray(p1.resulttype.def) or
  654. is_char(p1.resulttype.def)
  655. ) then
  656. inserttypeconv(p1,cshortstringtype);
  657. p2:=p1;
  658. end;
  659. until not try_to_consume(_COMMA);
  660. consume(_RKLAMMER);
  661. statement_syssym:=p2;
  662. end;
  663. in_read_x,
  664. in_readln_x :
  665. begin
  666. if try_to_consume(_LKLAMMER) then
  667. begin
  668. paras:=parse_paras(false,_RKLAMMER);
  669. consume(_RKLAMMER);
  670. end
  671. else
  672. paras:=nil;
  673. p1:=geninlinenode(l,false,paras);
  674. statement_syssym := p1;
  675. end;
  676. in_setlength_x:
  677. begin
  678. statement_syssym := inline_setlength;
  679. end;
  680. in_length_x:
  681. begin
  682. consume(_LKLAMMER);
  683. in_args:=true;
  684. p1:=comp_expr(true);
  685. p2:=geninlinenode(l,false,p1);
  686. consume(_RKLAMMER);
  687. statement_syssym:=p2;
  688. end;
  689. in_write_x,
  690. in_writeln_x :
  691. begin
  692. if try_to_consume(_LKLAMMER) then
  693. begin
  694. paras:=parse_paras(true,_RKLAMMER);
  695. consume(_RKLAMMER);
  696. end
  697. else
  698. paras:=nil;
  699. p1 := geninlinenode(l,false,paras);
  700. statement_syssym := p1;
  701. end;
  702. in_str_x_string :
  703. begin
  704. consume(_LKLAMMER);
  705. paras:=parse_paras(true,_RKLAMMER);
  706. consume(_RKLAMMER);
  707. p1 := geninlinenode(l,false,paras);
  708. statement_syssym := p1;
  709. end;
  710. in_val_x:
  711. Begin
  712. consume(_LKLAMMER);
  713. in_args := true;
  714. p1:= ccallparanode.create(comp_expr(true), nil);
  715. consume(_COMMA);
  716. p2 := ccallparanode.create(comp_expr(true),p1);
  717. if try_to_consume(_COMMA) then
  718. p2 := ccallparanode.create(comp_expr(true),p2);
  719. consume(_RKLAMMER);
  720. p2 := geninlinenode(l,false,p2);
  721. statement_syssym := p2;
  722. End;
  723. in_include_x_y,
  724. in_exclude_x_y :
  725. begin
  726. consume(_LKLAMMER);
  727. in_args:=true;
  728. p1:=comp_expr(true);
  729. consume(_COMMA);
  730. p2:=comp_expr(true);
  731. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
  732. consume(_RKLAMMER);
  733. end;
  734. in_assert_x_y :
  735. begin
  736. consume(_LKLAMMER);
  737. in_args:=true;
  738. p1:=comp_expr(true);
  739. if try_to_consume(_COMMA) then
  740. p2:=comp_expr(true)
  741. else
  742. begin
  743. { then insert an empty string }
  744. p2:=cstringconstnode.createstr('',st_default);
  745. end;
  746. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
  747. consume(_RKLAMMER);
  748. end;
  749. else
  750. internalerror(15);
  751. end;
  752. in_args:=prev_in_args;
  753. end;
  754. function maybe_load_methodpointer(st:tsymtable;var p1:tnode):boolean;
  755. begin
  756. maybe_load_methodpointer:=false;
  757. if not assigned(p1) then
  758. begin
  759. case st.symtabletype of
  760. withsymtable :
  761. begin
  762. if (st.defowner.deftype=objectdef) then
  763. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  764. end;
  765. objectsymtable :
  766. begin
  767. p1:=load_self_node;
  768. { We are calling a member }
  769. maybe_load_methodpointer:=true;
  770. end;
  771. end;
  772. end;
  773. end;
  774. { reads the parameter for a subroutine call }
  775. procedure do_proc_call(sym:tsym;st:tsymtable;obj:tobjectdef;getaddr:boolean;var again : boolean;var p1:tnode;callflags:tcallnodeflags);
  776. var
  777. membercall,
  778. prevafterassn : boolean;
  779. i : integer;
  780. para,p2 : tnode;
  781. currpara : tparavarsym;
  782. aprocdef : tprocdef;
  783. begin
  784. prevafterassn:=afterassignment;
  785. afterassignment:=false;
  786. membercall:=false;
  787. aprocdef:=nil;
  788. { when it is a call to a member we need to load the
  789. methodpointer first }
  790. membercall:=maybe_load_methodpointer(st,p1);
  791. { When we are expecting a procvar we also need
  792. to get the address in some cases }
  793. if assigned(getprocvardef) then
  794. begin
  795. if (block_type=bt_const) or
  796. getaddr then
  797. begin
  798. aprocdef:=Tprocsym(sym).search_procdef_byprocvardef(getprocvardef);
  799. getaddr:=true;
  800. end
  801. else
  802. if (m_tp_procvar in aktmodeswitches) or
  803. (m_mac_procvar in aktmodeswitches) then
  804. begin
  805. aprocdef:=Tprocsym(sym).search_procdef_byprocvardef(getprocvardef);
  806. if assigned(aprocdef) then
  807. getaddr:=true;
  808. end;
  809. end;
  810. { only need to get the address of the procedure? }
  811. if getaddr then
  812. begin
  813. { Retrieve info which procvar to call. For tp_procvar the
  814. aprocdef is already loaded above so we can reuse it }
  815. if not assigned(aprocdef) and
  816. assigned(getprocvardef) then
  817. aprocdef:=Tprocsym(sym).search_procdef_byprocvardef(getprocvardef);
  818. { generate a methodcallnode or proccallnode }
  819. { we shouldn't convert things like @tcollection.load }
  820. p2:=cloadnode.create_procvar(sym,aprocdef,st);
  821. if assigned(p1) then
  822. begin
  823. if (p1.nodetype<>typen) then
  824. tloadnode(p2).set_mp(p1)
  825. else
  826. p1.free;
  827. end;
  828. p1:=p2;
  829. { no postfix operators }
  830. again:=false;
  831. end
  832. else
  833. begin
  834. para:=nil;
  835. if anon_inherited then
  836. begin
  837. if not assigned(current_procinfo) then
  838. internalerror(200305054);
  839. for i:=0 to current_procinfo.procdef.paras.count-1 do
  840. begin
  841. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  842. if not(vo_is_hidden_para in currpara.varoptions) then
  843. para:=ccallparanode.create(cloadnode.create(currpara,currpara.owner),para);
  844. end;
  845. end
  846. else
  847. begin
  848. if try_to_consume(_LKLAMMER) then
  849. begin
  850. para:=parse_paras(false,_RKLAMMER);
  851. consume(_RKLAMMER);
  852. end;
  853. end;
  854. { indicate if this call was generated by a member and
  855. no explicit self is used, this is needed to determine
  856. how to handle a destructor call (PFV) }
  857. if membercall then
  858. include(callflags,cnf_member_call);
  859. if assigned(obj) then
  860. begin
  861. if (st.symtabletype<>objectsymtable) then
  862. internalerror(200310031);
  863. p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1,callflags);
  864. end
  865. else
  866. p1:=ccallnode.create(para,tprocsym(sym),st,p1,callflags);
  867. end;
  868. afterassignment:=prevafterassn;
  869. end;
  870. procedure handle_procvar(pv : tprocvardef;var p2 : tnode);
  871. var
  872. hp,hp2 : tnode;
  873. hpp : ^tnode;
  874. currprocdef : tprocdef;
  875. begin
  876. if not assigned(pv) then
  877. internalerror(200301121);
  878. if (m_tp_procvar in aktmodeswitches) or
  879. (m_mac_procvar in aktmodeswitches) then
  880. begin
  881. hp:=p2;
  882. hpp:=@p2;
  883. while assigned(hp) and
  884. (hp.nodetype=typeconvn) do
  885. begin
  886. hp:=ttypeconvnode(hp).left;
  887. { save orignal address of the old tree so we can replace the node }
  888. hpp:=@hp;
  889. end;
  890. if (hp.nodetype=calln) and
  891. { a procvar can't have parameters! }
  892. not assigned(tcallnode(hp).left) then
  893. begin
  894. currprocdef:=tcallnode(hp).symtableprocentry.search_procdef_byprocvardef(pv);
  895. if assigned(currprocdef) then
  896. begin
  897. hp2:=cloadnode.create_procvar(tprocsym(tcallnode(hp).symtableprocentry),currprocdef,tcallnode(hp).symtableproc);
  898. if (po_methodpointer in pv.procoptions) then
  899. tloadnode(hp2).set_mp(tcallnode(hp).get_load_methodpointer);
  900. hp.destroy;
  901. { replace the old callnode with the new loadnode }
  902. hpp^:=hp2;
  903. end;
  904. end;
  905. end;
  906. end;
  907. { the following procedure handles the access to a property symbol }
  908. procedure handle_propertysym(sym : tsym;st : tsymtable;var p1 : tnode);
  909. var
  910. paras : tnode;
  911. p2 : tnode;
  912. membercall : boolean;
  913. callflags : tcallnodeflags;
  914. begin
  915. paras:=nil;
  916. { property parameters? read them only if the property really }
  917. { has parameters }
  918. if (ppo_hasparameters in tpropertysym(sym).propoptions) then
  919. begin
  920. if try_to_consume(_LECKKLAMMER) then
  921. begin
  922. paras:=parse_paras(false,_RECKKLAMMER);
  923. consume(_RECKKLAMMER);
  924. end;
  925. end;
  926. { indexed property }
  927. if (ppo_indexed in tpropertysym(sym).propoptions) then
  928. begin
  929. p2:=cordconstnode.create(tpropertysym(sym).index,tpropertysym(sym).indextype,true);
  930. paras:=ccallparanode.create(p2,paras);
  931. end;
  932. { we need only a write property if a := follows }
  933. { if not(afterassignment) and not(in_args) then }
  934. if token=_ASSIGNMENT then
  935. begin
  936. { write property: }
  937. if not tpropertysym(sym).writeaccess.empty then
  938. begin
  939. case tpropertysym(sym).writeaccess.firstsym^.sym.typ of
  940. procsym :
  941. begin
  942. callflags:=[];
  943. { generate the method call }
  944. membercall:=maybe_load_methodpointer(st,p1);
  945. if membercall then
  946. include(callflags,cnf_member_call);
  947. p1:=ccallnode.create(paras,tprocsym(tpropertysym(sym).writeaccess.firstsym^.sym),st,p1,callflags);
  948. paras:=nil;
  949. consume(_ASSIGNMENT);
  950. { read the expression }
  951. if tpropertysym(sym).proptype.def.deftype=procvardef then
  952. getprocvardef:=tprocvardef(tpropertysym(sym).proptype.def);
  953. p2:=comp_expr(true);
  954. if assigned(getprocvardef) then
  955. handle_procvar(getprocvardef,p2);
  956. tcallnode(p1).left:=ccallparanode.create(p2,tcallnode(p1).left);
  957. { mark as property, both the tcallnode and the real call block }
  958. include(p1.flags,nf_isproperty);
  959. getprocvardef:=nil;
  960. end;
  961. fieldvarsym :
  962. begin
  963. { generate access code }
  964. symlist_to_node(p1,st,tpropertysym(sym).writeaccess);
  965. include(p1.flags,nf_isproperty);
  966. consume(_ASSIGNMENT);
  967. { read the expression }
  968. p2:=comp_expr(true);
  969. p1:=cassignmentnode.create(p1,p2);
  970. end
  971. else
  972. begin
  973. p1:=cerrornode.create;
  974. Message(parser_e_no_procedure_to_access_property);
  975. end;
  976. end;
  977. end
  978. else
  979. begin
  980. p1:=cerrornode.create;
  981. Message(parser_e_no_procedure_to_access_property);
  982. end;
  983. end
  984. else
  985. begin
  986. { read property: }
  987. if not tpropertysym(sym).readaccess.empty then
  988. begin
  989. case tpropertysym(sym).readaccess.firstsym^.sym.typ of
  990. fieldvarsym :
  991. begin
  992. { generate access code }
  993. symlist_to_node(p1,st,tpropertysym(sym).readaccess);
  994. include(p1.flags,nf_isproperty);
  995. end;
  996. procsym :
  997. begin
  998. callflags:=[];
  999. { generate the method call }
  1000. membercall:=maybe_load_methodpointer(st,p1);
  1001. if membercall then
  1002. include(callflags,cnf_member_call);
  1003. p1:=ccallnode.create(paras,tprocsym(tpropertysym(sym).readaccess.firstsym^.sym),st,p1,callflags);
  1004. paras:=nil;
  1005. include(p1.flags,nf_isproperty);
  1006. end
  1007. else
  1008. begin
  1009. p1:=cerrornode.create;
  1010. Message(type_e_mismatch);
  1011. end;
  1012. end;
  1013. end
  1014. else
  1015. begin
  1016. { error, no function to read property }
  1017. p1:=cerrornode.create;
  1018. Message(parser_e_no_procedure_to_access_property);
  1019. end;
  1020. end;
  1021. { release paras if not used }
  1022. if assigned(paras) then
  1023. paras.free;
  1024. end;
  1025. { the ID token has to be consumed before calling this function }
  1026. procedure do_member_read(classh:tobjectdef;getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callflags:tcallnodeflags);
  1027. var
  1028. static_name : string;
  1029. isclassref : boolean;
  1030. srsymtable : tsymtable;
  1031. begin
  1032. if sym=nil then
  1033. begin
  1034. { pattern is still valid unless
  1035. there is another ID just after the ID of sym }
  1036. Message1(sym_e_id_no_member,orgpattern);
  1037. p1.free;
  1038. p1:=cerrornode.create;
  1039. { try to clean up }
  1040. again:=false;
  1041. end
  1042. else
  1043. begin
  1044. if assigned(p1) then
  1045. begin
  1046. if not assigned(p1.resulttype.def) then
  1047. do_resulttypepass(p1);
  1048. isclassref:=(p1.resulttype.def.deftype=classrefdef);
  1049. end
  1050. else
  1051. isclassref:=false;
  1052. { we assume, that only procsyms and varsyms are in an object }
  1053. { symbol table, for classes, properties are allowed }
  1054. case sym.typ of
  1055. procsym:
  1056. begin
  1057. do_proc_call(sym,sym.owner,classh,
  1058. (getaddr and not(token in [_CARET,_POINT])),
  1059. again,p1,callflags);
  1060. { we need to know which procedure is called }
  1061. do_resulttypepass(p1);
  1062. { calling using classref? }
  1063. if isclassref and
  1064. (p1.nodetype=calln) and
  1065. assigned(tcallnode(p1).procdefinition) and
  1066. not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
  1067. not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
  1068. Message(parser_e_only_class_methods_via_class_ref);
  1069. end;
  1070. fieldvarsym:
  1071. begin
  1072. if (sp_static in sym.symoptions) then
  1073. begin
  1074. static_name:=lower(sym.owner.name^)+'_'+sym.name;
  1075. searchsym(static_name,sym,srsymtable);
  1076. check_hints(sym);
  1077. p1.free;
  1078. p1:=cloadnode.create(sym,srsymtable);
  1079. end
  1080. else
  1081. begin
  1082. if isclassref then
  1083. Message(parser_e_only_class_methods_via_class_ref);
  1084. p1:=csubscriptnode.create(sym,p1);
  1085. end;
  1086. end;
  1087. propertysym:
  1088. begin
  1089. if isclassref then
  1090. Message(parser_e_only_class_methods_via_class_ref);
  1091. handle_propertysym(sym,sym.owner,p1);
  1092. end;
  1093. else internalerror(16);
  1094. end;
  1095. end;
  1096. end;
  1097. {****************************************************************************
  1098. Factor
  1099. ****************************************************************************}
  1100. {$ifdef fpc}
  1101. {$maxfpuregisters 0}
  1102. {$endif fpc}
  1103. function factor(getaddr : boolean) : tnode;
  1104. {---------------------------------------------
  1105. Factor_read_id
  1106. ---------------------------------------------}
  1107. procedure factor_read_id(var p1:tnode;var again:boolean);
  1108. var
  1109. pc : pchar;
  1110. len : longint;
  1111. srsym : tsym;
  1112. possible_error : boolean;
  1113. srsymtable : tsymtable;
  1114. storesymtablestack : tsymtable;
  1115. htype : ttype;
  1116. static_name : string;
  1117. begin
  1118. { allow post fix operators }
  1119. again:=true;
  1120. consume_sym(srsym,srsymtable);
  1121. { Access to funcret or need to call the function? }
  1122. if (srsym.typ in [absolutevarsym,localvarsym,paravarsym]) and
  1123. (vo_is_funcret in tabstractvarsym(srsym).varoptions) and
  1124. (
  1125. (token=_LKLAMMER) or
  1126. (not(m_fpc in aktmodeswitches) and
  1127. (afterassignment or in_args) and
  1128. not(vo_is_result in tabstractvarsym(srsym).varoptions))
  1129. ) then
  1130. begin
  1131. storesymtablestack:=symtablestack;
  1132. symtablestack:=srsym.owner.next;
  1133. searchsym(srsym.name,srsym,srsymtable);
  1134. if not assigned(srsym) then
  1135. srsym:=generrorsym;
  1136. if (srsym.typ<>procsym) then
  1137. Message(parser_e_illegal_expression);
  1138. symtablestack:=storesymtablestack;
  1139. end;
  1140. begin
  1141. case srsym.typ of
  1142. absolutevarsym :
  1143. begin
  1144. if (tabsolutevarsym(srsym).abstyp=tovar) then
  1145. begin
  1146. p1:=nil;
  1147. symlist_to_node(p1,nil,tabsolutevarsym(srsym).ref);
  1148. p1:=ctypeconvnode.create(p1,tabsolutevarsym(srsym).vartype);
  1149. include(p1.flags,nf_absolute);
  1150. end
  1151. else
  1152. p1:=cloadnode.create(srsym,srsymtable);
  1153. end;
  1154. globalvarsym,
  1155. localvarsym,
  1156. paravarsym,
  1157. fieldvarsym :
  1158. begin
  1159. if (sp_static in srsym.symoptions) then
  1160. begin
  1161. static_name:=lower(srsym.owner.name^)+'_'+srsym.name;
  1162. searchsym(static_name,srsym,srsymtable);
  1163. check_hints(srsym);
  1164. end
  1165. else
  1166. begin
  1167. { are we in a class method, we check here the
  1168. srsymtable, because a field in another object
  1169. also has objectsymtable. And withsymtable is
  1170. not possible for self in class methods (PFV) }
  1171. if (srsymtable.symtabletype=objectsymtable) and
  1172. assigned(current_procinfo) and
  1173. (po_classmethod in current_procinfo.procdef.procoptions) then
  1174. Message(parser_e_only_class_methods);
  1175. end;
  1176. case srsymtable.symtabletype of
  1177. objectsymtable :
  1178. begin
  1179. p1:=csubscriptnode.create(srsym,load_self_node);
  1180. node_tree_set_filepos(p1,aktfilepos);
  1181. end;
  1182. withsymtable :
  1183. begin
  1184. p1:=csubscriptnode.create(srsym,tnode(twithsymtable(srsymtable).withrefnode).getcopy);
  1185. node_tree_set_filepos(p1,aktfilepos);
  1186. end;
  1187. else
  1188. p1:=cloadnode.create(srsym,srsymtable);
  1189. end;
  1190. end;
  1191. typedconstsym :
  1192. begin
  1193. p1:=cloadnode.create(srsym,srsymtable);
  1194. end;
  1195. syssym :
  1196. begin
  1197. p1:=statement_syssym(tsyssym(srsym).number);
  1198. end;
  1199. typesym :
  1200. begin
  1201. htype.setsym(srsym);
  1202. if not assigned(htype.def) then
  1203. begin
  1204. again:=false;
  1205. end
  1206. else
  1207. begin
  1208. { We need to know if this unit uses Variants }
  1209. if (htype.def=cvarianttype.def) and
  1210. not(cs_compilesystem in aktmoduleswitches) then
  1211. current_module.flags:=current_module.flags or uf_uses_variants;
  1212. if try_to_consume(_LKLAMMER) then
  1213. begin
  1214. p1:=comp_expr(true);
  1215. consume(_RKLAMMER);
  1216. p1:=ctypeconvnode.create_explicit(p1,htype);
  1217. end
  1218. else { not LKLAMMER }
  1219. if (token=_POINT) and
  1220. is_object(htype.def) then
  1221. begin
  1222. consume(_POINT);
  1223. if assigned(current_procinfo) and
  1224. assigned(current_procinfo.procdef._class) and
  1225. not(getaddr) then
  1226. begin
  1227. if current_procinfo.procdef._class.is_related(tobjectdef(htype.def)) then
  1228. begin
  1229. p1:=ctypenode.create(htype);
  1230. { search also in inherited methods }
  1231. srsym:=searchsym_in_class(tobjectdef(htype.def),pattern);
  1232. check_hints(srsym);
  1233. consume(_ID);
  1234. do_member_read(tobjectdef(htype.def),false,srsym,p1,again,[]);
  1235. end
  1236. else
  1237. begin
  1238. Message(parser_e_no_super_class);
  1239. again:=false;
  1240. end;
  1241. end
  1242. else
  1243. begin
  1244. { allows @TObject.Load }
  1245. { also allows static methods and variables }
  1246. p1:=ctypenode.create(htype);
  1247. { TP allows also @TMenu.Load if Load is only }
  1248. { defined in an anchestor class }
  1249. srsym:=search_class_member(tobjectdef(htype.def),pattern);
  1250. check_hints(srsym);
  1251. if not assigned(srsym) then
  1252. Message1(sym_e_id_no_member,orgpattern)
  1253. else if not(getaddr) and not(sp_static in srsym.symoptions) then
  1254. Message(sym_e_only_static_in_static)
  1255. else
  1256. begin
  1257. consume(_ID);
  1258. do_member_read(tobjectdef(htype.def),getaddr,srsym,p1,again,[]);
  1259. end;
  1260. end;
  1261. end
  1262. else
  1263. begin
  1264. { class reference ? }
  1265. if is_class(htype.def) then
  1266. begin
  1267. if getaddr and (token=_POINT) then
  1268. begin
  1269. consume(_POINT);
  1270. { allows @Object.Method }
  1271. { also allows static methods and variables }
  1272. p1:=ctypenode.create(htype);
  1273. { TP allows also @TMenu.Load if Load is only }
  1274. { defined in an anchestor class }
  1275. srsym:=search_class_member(tobjectdef(htype.def),pattern);
  1276. check_hints(srsym);
  1277. if not assigned(srsym) then
  1278. Message1(sym_e_id_no_member,orgpattern)
  1279. else
  1280. begin
  1281. consume(_ID);
  1282. do_member_read(tobjectdef(htype.def),getaddr,srsym,p1,again,[]);
  1283. end;
  1284. end
  1285. else
  1286. begin
  1287. p1:=ctypenode.create(htype);
  1288. { For a type block we simply return only
  1289. the type. For all other blocks we return
  1290. a loadvmt node }
  1291. if (block_type<>bt_type) then
  1292. p1:=cloadvmtaddrnode.create(p1);
  1293. end;
  1294. end
  1295. else
  1296. p1:=ctypenode.create(htype);
  1297. end;
  1298. end;
  1299. end;
  1300. enumsym :
  1301. begin
  1302. p1:=genenumnode(tenumsym(srsym));
  1303. end;
  1304. constsym :
  1305. begin
  1306. case tconstsym(srsym).consttyp of
  1307. constord :
  1308. begin
  1309. if tconstsym(srsym).consttype.def=nil then
  1310. internalerror(200403232);
  1311. p1:=cordconstnode.create(tconstsym(srsym).value.valueord,tconstsym(srsym).consttype,true);
  1312. end;
  1313. conststring :
  1314. begin
  1315. len:=tconstsym(srsym).value.len;
  1316. if not(cs_ansistrings in aktlocalswitches) and (len>255) then
  1317. len:=255;
  1318. getmem(pc,len+1);
  1319. move(pchar(tconstsym(srsym).value.valueptr)^,pc^,len);
  1320. pc[len]:=#0;
  1321. p1:=cstringconstnode.createpchar(pc,len);
  1322. end;
  1323. constwstring :
  1324. p1:=cstringconstnode.createwstr(pcompilerwidestring(tconstsym(srsym).value.valueptr));
  1325. constreal :
  1326. p1:=crealconstnode.create(pbestreal(tconstsym(srsym).value.valueptr)^,pbestrealtype^);
  1327. constset :
  1328. p1:=csetconstnode.create(pconstset(tconstsym(srsym).value.valueptr),tconstsym(srsym).consttype);
  1329. constpointer :
  1330. p1:=cpointerconstnode.create(tconstsym(srsym).value.valueordptr,tconstsym(srsym).consttype);
  1331. constnil :
  1332. p1:=cnilnode.create;
  1333. constresourcestring:
  1334. begin
  1335. p1:=cloadnode.create(srsym,srsymtable);
  1336. do_resulttypepass(p1);
  1337. {$ifdef ansistring_bits}
  1338. case aktansistring_bits of
  1339. sb_16:
  1340. p1.resulttype:=cansistringtype16;
  1341. sb_32:
  1342. p1.resulttype:=cansistringtype32;
  1343. sb_64:
  1344. p1.resulttype:=cansistringtype64;
  1345. end;
  1346. {$else}
  1347. p1.resulttype:=cansistringtype;
  1348. {$endif}
  1349. end;
  1350. constguid :
  1351. p1:=cguidconstnode.create(pguid(tconstsym(srsym).value.valueptr)^);
  1352. else
  1353. internalerror(200507181);
  1354. end;
  1355. end;
  1356. procsym :
  1357. begin
  1358. { are we in a class method ? }
  1359. possible_error:=(srsymtable.symtabletype<>withsymtable) and
  1360. (srsym.owner.symtabletype=objectsymtable) and
  1361. not(is_interface(tdef(srsym.owner.defowner))) and
  1362. assigned(current_procinfo) and
  1363. (po_classmethod in current_procinfo.procdef.procoptions);
  1364. do_proc_call(srsym,srsymtable,nil,
  1365. (getaddr and not(token in [_CARET,_POINT])),
  1366. again,p1,[]);
  1367. { we need to know which procedure is called }
  1368. if possible_error then
  1369. begin
  1370. do_resulttypepass(p1);
  1371. if (p1.nodetype=calln) and
  1372. assigned(tcallnode(p1).procdefinition) and
  1373. not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) and
  1374. not(po_classmethod in tcallnode(p1).procdefinition.procoptions) then
  1375. Message(parser_e_only_class_methods);
  1376. end;
  1377. end;
  1378. propertysym :
  1379. begin
  1380. { access to property in a method }
  1381. { are we in a class method ? }
  1382. if (srsymtable.symtabletype=objectsymtable) and
  1383. assigned(current_procinfo) and
  1384. (po_classmethod in current_procinfo.procdef.procoptions) then
  1385. Message(parser_e_only_class_methods);
  1386. { no method pointer }
  1387. p1:=nil;
  1388. handle_propertysym(srsym,srsymtable,p1);
  1389. end;
  1390. labelsym :
  1391. begin
  1392. { Support @label }
  1393. if getaddr then
  1394. p1:=cloadnode.create(srsym,srsym.owner)
  1395. else
  1396. begin
  1397. consume(_COLON);
  1398. if tlabelsym(srsym).defined then
  1399. Message(sym_e_label_already_defined);
  1400. tlabelsym(srsym).defined:=true;
  1401. p1:=clabelnode.create(nil);
  1402. tlabelsym(srsym).code:=p1;
  1403. end;
  1404. end;
  1405. errorsym :
  1406. begin
  1407. p1:=cerrornode.create;
  1408. if try_to_consume(_LKLAMMER) then
  1409. begin
  1410. parse_paras(false,_RKLAMMER);
  1411. consume(_RKLAMMER);
  1412. end;
  1413. end;
  1414. else
  1415. begin
  1416. p1:=cerrornode.create;
  1417. Message(parser_e_illegal_expression);
  1418. end;
  1419. end; { end case }
  1420. end;
  1421. end;
  1422. {---------------------------------------------
  1423. Factor_Read_Set
  1424. ---------------------------------------------}
  1425. { Read a set between [] }
  1426. function factor_read_set:tnode;
  1427. var
  1428. p1,p2 : tnode;
  1429. lastp,
  1430. buildp : tarrayconstructornode;
  1431. begin
  1432. buildp:=nil;
  1433. { be sure that a least one arrayconstructn is used, also for an
  1434. empty [] }
  1435. if token=_RECKKLAMMER then
  1436. buildp:=carrayconstructornode.create(nil,buildp)
  1437. else
  1438. repeat
  1439. p1:=comp_expr(true);
  1440. if try_to_consume(_POINTPOINT) then
  1441. begin
  1442. p2:=comp_expr(true);
  1443. p1:=carrayconstructorrangenode.create(p1,p2);
  1444. end;
  1445. { insert at the end of the tree, to get the correct order }
  1446. if not assigned(buildp) then
  1447. begin
  1448. buildp:=carrayconstructornode.create(p1,nil);
  1449. lastp:=buildp;
  1450. end
  1451. else
  1452. begin
  1453. lastp.right:=carrayconstructornode.create(p1,nil);
  1454. lastp:=tarrayconstructornode(lastp.right);
  1455. end;
  1456. { there could be more elements }
  1457. until not try_to_consume(_COMMA);
  1458. factor_read_set:=buildp;
  1459. end;
  1460. {---------------------------------------------
  1461. PostFixOperators
  1462. ---------------------------------------------}
  1463. procedure postfixoperators(var p1:tnode;var again:boolean);
  1464. { tries to avoid syntax errors after invalid qualifiers }
  1465. procedure recoverconsume_postfixops;
  1466. begin
  1467. repeat
  1468. if not try_to_consume(_CARET) then
  1469. if try_to_consume(_POINT) then
  1470. try_to_consume(_ID)
  1471. else if try_to_consume(_LECKKLAMMER) then
  1472. begin
  1473. repeat
  1474. comp_expr(true);
  1475. until not try_to_consume(_COMMA);
  1476. consume(_RECKKLAMMER);
  1477. end
  1478. else
  1479. break;
  1480. until false;
  1481. end;
  1482. procedure handle_variantarray;
  1483. var
  1484. p4 : tnode;
  1485. newstatement : tstatementnode;
  1486. tempresultvariant,
  1487. temp : ttempcreatenode;
  1488. paras : tcallparanode;
  1489. newblock : tnode;
  1490. countindices : aint;
  1491. begin
  1492. { create statements with call initialize the arguments and
  1493. call fpc_dynarr_setlength }
  1494. newblock:=internalstatements(newstatement);
  1495. { get temp for array of indicies,
  1496. we set the real size later }
  1497. temp:=ctempcreatenode.create(sinttype,4,tt_persistent,false);
  1498. addstatement(newstatement,temp);
  1499. countindices:=0;
  1500. repeat
  1501. p4:=comp_expr(true);
  1502. addstatement(newstatement,cassignmentnode.create(
  1503. ctemprefnode.create_offset(temp,countindices*sinttype.def.size),p4));
  1504. inc(countindices);
  1505. until not try_to_consume(_COMMA);
  1506. { set real size }
  1507. temp.size:=countindices*sinttype.def.size;
  1508. consume(_RECKKLAMMER);
  1509. { we need only a write access if a := follows }
  1510. if token=_ASSIGNMENT then
  1511. begin
  1512. consume(_ASSIGNMENT);
  1513. p4:=comp_expr(true);
  1514. { create call to fpc_vararray_put }
  1515. paras:=ccallparanode.create(cordconstnode.create
  1516. (countindices,sinttype,true),
  1517. ccallparanode.create(caddrnode.create_internal
  1518. (ctemprefnode.create(temp)),
  1519. ccallparanode.create(ctypeconvnode.create_internal(p4,cvarianttype),
  1520. ccallparanode.create(p1
  1521. ,nil))));
  1522. addstatement(newstatement,ccallnode.createintern('fpc_vararray_put',paras));
  1523. addstatement(newstatement,ctempdeletenode.create(temp));
  1524. end
  1525. else
  1526. begin
  1527. { create temp for result }
  1528. tempresultvariant:=ctempcreatenode.create(cvarianttype,cvarianttype.def.size,tt_persistent,true);
  1529. addstatement(newstatement,tempresultvariant);
  1530. { create call to fpc_vararray_get }
  1531. paras:=ccallparanode.create(cordconstnode.create
  1532. (countindices,sinttype,true),
  1533. ccallparanode.create(caddrnode.create_internal
  1534. (ctemprefnode.create(temp)),
  1535. ccallparanode.create(p1,
  1536. ccallparanode.create(
  1537. ctemprefnode.create(tempresultvariant)
  1538. ,nil))));
  1539. addstatement(newstatement,ccallnode.createintern('fpc_vararray_get',paras));
  1540. addstatement(newstatement,ctempdeletenode.create(temp));
  1541. { the last statement should return the value as
  1542. location and type, this is done be referencing the
  1543. temp and converting it first from a persistent temp to
  1544. normal temp }
  1545. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempresultvariant));
  1546. addstatement(newstatement,ctemprefnode.create(tempresultvariant));
  1547. end;
  1548. p1:=newblock;
  1549. end;
  1550. var
  1551. store_static : boolean;
  1552. protsym : tpropertysym;
  1553. p2,p3 : tnode;
  1554. hsym : tsym;
  1555. classh : tobjectdef;
  1556. label
  1557. skipreckklammercheck;
  1558. begin
  1559. again:=true;
  1560. while again do
  1561. begin
  1562. { we need the resulttype }
  1563. do_resulttypepass(p1);
  1564. if codegenerror then
  1565. begin
  1566. recoverconsume_postfixops;
  1567. exit;
  1568. end;
  1569. { handle token }
  1570. case token of
  1571. _CARET:
  1572. begin
  1573. consume(_CARET);
  1574. if (p1.resulttype.def.deftype<>pointerdef) then
  1575. begin
  1576. { ^ as binary operator is a problem!!!! (FK) }
  1577. again:=false;
  1578. Message(parser_e_invalid_qualifier);
  1579. recoverconsume_postfixops;
  1580. p1.destroy;
  1581. p1:=cerrornode.create;
  1582. end
  1583. else
  1584. begin
  1585. p1:=cderefnode.create(p1);
  1586. end;
  1587. end;
  1588. _LECKKLAMMER:
  1589. begin
  1590. if is_class_or_interface(p1.resulttype.def) then
  1591. begin
  1592. { default property }
  1593. protsym:=search_default_property(tobjectdef(p1.resulttype.def));
  1594. if not(assigned(protsym)) then
  1595. begin
  1596. p1.destroy;
  1597. p1:=cerrornode.create;
  1598. again:=false;
  1599. message(parser_e_no_default_property_available);
  1600. end
  1601. else
  1602. begin
  1603. { The property symbol is referenced indirect }
  1604. inc(protsym.refs);
  1605. handle_propertysym(protsym,protsym.owner,p1);
  1606. end;
  1607. end
  1608. else
  1609. begin
  1610. consume(_LECKKLAMMER);
  1611. repeat
  1612. case p1.resulttype.def.deftype of
  1613. pointerdef:
  1614. begin
  1615. { support delphi autoderef }
  1616. if (tpointerdef(p1.resulttype.def).pointertype.def.deftype=arraydef) and
  1617. (m_autoderef in aktmodeswitches) then
  1618. begin
  1619. p1:=cderefnode.create(p1);
  1620. end;
  1621. p2:=comp_expr(true);
  1622. p1:=cvecnode.create(p1,p2);
  1623. end;
  1624. variantdef:
  1625. begin
  1626. handle_variantarray;
  1627. { the RECKKLAMMER is already read }
  1628. goto skipreckklammercheck;
  1629. end;
  1630. stringdef :
  1631. begin
  1632. p2:=comp_expr(true);
  1633. p1:=cvecnode.create(p1,p2);
  1634. end;
  1635. arraydef :
  1636. begin
  1637. p2:=comp_expr(true);
  1638. { support SEG:OFS for go32v2 Mem[] }
  1639. if (target_info.system in [system_i386_go32v2,system_i386_watcom]) and
  1640. (p1.nodetype=loadn) and
  1641. assigned(tloadnode(p1).symtableentry) and
  1642. assigned(tloadnode(p1).symtableentry.owner.name) and
  1643. (tloadnode(p1).symtableentry.owner.name^='SYSTEM') and
  1644. ((tloadnode(p1).symtableentry.name='MEM') or
  1645. (tloadnode(p1).symtableentry.name='MEMW') or
  1646. (tloadnode(p1).symtableentry.name='MEML')) then
  1647. begin
  1648. if try_to_consume(_COLON) then
  1649. begin
  1650. p3:=caddnode.create(muln,cordconstnode.create($10,s32inttype,false),p2);
  1651. p2:=comp_expr(true);
  1652. p2:=caddnode.create(addn,p2,p3);
  1653. p1:=cvecnode.create(p1,p2);
  1654. include(tvecnode(p1).flags,nf_memseg);
  1655. include(tvecnode(p1).flags,nf_memindex);
  1656. end
  1657. else
  1658. begin
  1659. p1:=cvecnode.create(p1,p2);
  1660. include(tvecnode(p1).flags,nf_memindex);
  1661. end;
  1662. end
  1663. else
  1664. p1:=cvecnode.create(p1,p2);
  1665. end;
  1666. else
  1667. begin
  1668. Message(parser_e_invalid_qualifier);
  1669. p1.destroy;
  1670. p1:=cerrornode.create;
  1671. comp_expr(true);
  1672. again:=false;
  1673. end;
  1674. end;
  1675. do_resulttypepass(p1);
  1676. until not try_to_consume(_COMMA);
  1677. consume(_RECKKLAMMER);
  1678. { handle_variantarray eats the RECKKLAMMER and jumps here }
  1679. skipreckklammercheck:
  1680. end;
  1681. end;
  1682. _POINT :
  1683. begin
  1684. consume(_POINT);
  1685. if (p1.resulttype.def.deftype=pointerdef) and
  1686. (m_autoderef in aktmodeswitches) then
  1687. begin
  1688. p1:=cderefnode.create(p1);
  1689. do_resulttypepass(p1);
  1690. end;
  1691. case p1.resulttype.def.deftype of
  1692. recorddef:
  1693. begin
  1694. if token=_ID then
  1695. begin
  1696. hsym:=tsym(trecorddef(p1.resulttype.def).symtable.search(pattern));
  1697. check_hints(hsym);
  1698. if assigned(hsym) and
  1699. (hsym.typ=fieldvarsym) then
  1700. p1:=csubscriptnode.create(hsym,p1)
  1701. else
  1702. begin
  1703. Message1(sym_e_illegal_field,pattern);
  1704. p1.destroy;
  1705. p1:=cerrornode.create;
  1706. end;
  1707. end;
  1708. consume(_ID);
  1709. end;
  1710. variantdef:
  1711. begin
  1712. end;
  1713. classrefdef:
  1714. begin
  1715. if token=_ID then
  1716. begin
  1717. classh:=tobjectdef(tclassrefdef(p1.resulttype.def).pointertype.def);
  1718. hsym:=searchsym_in_class(classh,pattern);
  1719. check_hints(hsym);
  1720. if hsym=nil then
  1721. begin
  1722. Message1(sym_e_id_no_member,orgpattern);
  1723. p1.destroy;
  1724. p1:=cerrornode.create;
  1725. { try to clean up }
  1726. consume(_ID);
  1727. end
  1728. else
  1729. begin
  1730. consume(_ID);
  1731. do_member_read(classh,getaddr,hsym,p1,again,[]);
  1732. end;
  1733. end
  1734. else { Error }
  1735. Consume(_ID);
  1736. end;
  1737. objectdef:
  1738. begin
  1739. if token=_ID then
  1740. begin
  1741. store_static:=allow_only_static;
  1742. allow_only_static:=false;
  1743. classh:=tobjectdef(p1.resulttype.def);
  1744. hsym:=searchsym_in_class(classh,pattern);
  1745. check_hints(hsym);
  1746. allow_only_static:=store_static;
  1747. if hsym=nil then
  1748. begin
  1749. Message1(sym_e_id_no_member,orgpattern);
  1750. p1.destroy;
  1751. p1:=cerrornode.create;
  1752. { try to clean up }
  1753. consume(_ID);
  1754. end
  1755. else
  1756. begin
  1757. consume(_ID);
  1758. do_member_read(classh,getaddr,hsym,p1,again,[]);
  1759. end;
  1760. end
  1761. else { Error }
  1762. Consume(_ID);
  1763. end;
  1764. pointerdef:
  1765. begin
  1766. Message(parser_e_invalid_qualifier);
  1767. if tpointerdef(p1.resulttype.def).pointertype.def.deftype in [recorddef,objectdef,classrefdef] then
  1768. Message(parser_h_maybe_deref_caret_missing);
  1769. end;
  1770. else
  1771. begin
  1772. Message(parser_e_invalid_qualifier);
  1773. p1.destroy;
  1774. p1:=cerrornode.create;
  1775. { Error }
  1776. consume(_ID);
  1777. end;
  1778. end;
  1779. end;
  1780. else
  1781. begin
  1782. { is this a procedure variable ? }
  1783. if assigned(p1.resulttype.def) and
  1784. (p1.resulttype.def.deftype=procvardef) then
  1785. begin
  1786. if assigned(getprocvardef) and
  1787. equal_defs(p1.resulttype.def,getprocvardef) then
  1788. again:=false
  1789. else
  1790. begin
  1791. if try_to_consume(_LKLAMMER) then
  1792. begin
  1793. p2:=parse_paras(false,_RKLAMMER);
  1794. consume(_RKLAMMER);
  1795. p1:=ccallnode.create_procvar(p2,p1);
  1796. { proc():= is never possible }
  1797. if token=_ASSIGNMENT then
  1798. begin
  1799. Message(parser_e_illegal_expression);
  1800. p1.free;
  1801. p1:=cerrornode.create;
  1802. again:=false;
  1803. end;
  1804. end
  1805. else
  1806. again:=false;
  1807. end;
  1808. end
  1809. else
  1810. again:=false;
  1811. end;
  1812. end;
  1813. end; { while again }
  1814. end;
  1815. {---------------------------------------------
  1816. Factor (Main)
  1817. ---------------------------------------------}
  1818. var
  1819. l : longint;
  1820. ic : int64;
  1821. qc : qword;
  1822. {$ifndef cpu64}
  1823. card : cardinal;
  1824. {$endif cpu64}
  1825. oldp1,
  1826. p1 : tnode;
  1827. code : integer;
  1828. again : boolean;
  1829. sym : tsym;
  1830. pd : tprocdef;
  1831. classh : tobjectdef;
  1832. d : bestreal;
  1833. hs,hsorg : string;
  1834. htype : ttype;
  1835. filepos : tfileposinfo;
  1836. {---------------------------------------------
  1837. Helpers
  1838. ---------------------------------------------}
  1839. procedure check_tokenpos;
  1840. begin
  1841. if (p1<>oldp1) then
  1842. begin
  1843. if assigned(p1) then
  1844. p1.fileinfo:=filepos;
  1845. oldp1:=p1;
  1846. filepos:=akttokenpos;
  1847. end;
  1848. end;
  1849. begin
  1850. oldp1:=nil;
  1851. p1:=nil;
  1852. filepos:=akttokenpos;
  1853. again:=false;
  1854. if token=_ID then
  1855. begin
  1856. again:=true;
  1857. { Handle references to self }
  1858. if (idtoken=_SELF) and
  1859. not(block_type in [bt_const,bt_type]) and
  1860. assigned(current_procinfo) and
  1861. assigned(current_procinfo.procdef._class) then
  1862. begin
  1863. p1:=load_self_node;
  1864. consume(_ID);
  1865. again:=true;
  1866. end
  1867. else
  1868. factor_read_id(p1,again);
  1869. if again then
  1870. begin
  1871. check_tokenpos;
  1872. { handle post fix operators }
  1873. postfixoperators(p1,again);
  1874. end;
  1875. end
  1876. else
  1877. case token of
  1878. _INHERITED :
  1879. begin
  1880. again:=true;
  1881. consume(_INHERITED);
  1882. if assigned(current_procinfo) and
  1883. assigned(current_procinfo.procdef._class) then
  1884. begin
  1885. classh:=current_procinfo.procdef._class.childof;
  1886. { if inherited; only then we need the method with
  1887. the same name }
  1888. if token in endtokens then
  1889. begin
  1890. hs:=current_procinfo.procdef.procsym.name;
  1891. hsorg:=current_procinfo.procdef.procsym.realname;
  1892. anon_inherited:=true;
  1893. { For message methods we need to search using the message
  1894. number or string }
  1895. pd:=tprocsym(current_procinfo.procdef.procsym).first_procdef;
  1896. if (po_msgint in pd.procoptions) then
  1897. sym:=searchsym_in_class_by_msgint(classh,pd.messageinf.i)
  1898. else
  1899. if (po_msgstr in pd.procoptions) then
  1900. sym:=searchsym_in_class_by_msgstr(classh,pd.messageinf.str)
  1901. else
  1902. sym:=searchsym_in_class(classh,hs);
  1903. end
  1904. else
  1905. begin
  1906. hs:=pattern;
  1907. hsorg:=orgpattern;
  1908. consume(_ID);
  1909. anon_inherited:=false;
  1910. sym:=searchsym_in_class(classh,hs);
  1911. end;
  1912. if assigned(sym) then
  1913. begin
  1914. check_hints(sym);
  1915. { load the procdef from the inherited class and
  1916. not from self }
  1917. if sym.typ in [procsym,propertysym] then
  1918. begin
  1919. if (sym.typ = procsym) then
  1920. begin
  1921. htype.setdef(classh);
  1922. if (po_classmethod in current_procinfo.procdef.procoptions) or
  1923. (po_staticmethod in current_procinfo.procdef.procoptions) then
  1924. htype.setdef(tclassrefdef.create(htype));
  1925. p1:=ctypenode.create(htype);
  1926. end;
  1927. end
  1928. else
  1929. begin
  1930. Message(parser_e_methode_id_expected);
  1931. p1:=cerrornode.create;
  1932. end;
  1933. do_member_read(classh,false,sym,p1,again,[cnf_inherited,cnf_anon_inherited]);
  1934. end
  1935. else
  1936. begin
  1937. if anon_inherited then
  1938. begin
  1939. { For message methods we need to call DefaultHandler }
  1940. if (po_msgint in pd.procoptions) or
  1941. (po_msgstr in pd.procoptions) then
  1942. begin
  1943. sym:=searchsym_in_class(classh,'DEFAULTHANDLER');
  1944. if not assigned(sym) or
  1945. (sym.typ<>procsym) then
  1946. internalerror(200303171);
  1947. p1:=nil;
  1948. do_proc_call(sym,sym.owner,classh,false,again,p1,[]);
  1949. end
  1950. else
  1951. begin
  1952. { we need to ignore the inherited; }
  1953. p1:=cnothingnode.create;
  1954. end;
  1955. end
  1956. else
  1957. begin
  1958. Message1(sym_e_id_no_member,hsorg);
  1959. p1:=cerrornode.create;
  1960. end;
  1961. again:=false;
  1962. end;
  1963. { turn auto inheriting off }
  1964. anon_inherited:=false;
  1965. end
  1966. else
  1967. begin
  1968. Message(parser_e_generic_methods_only_in_methods);
  1969. again:=false;
  1970. p1:=cerrornode.create;
  1971. end;
  1972. postfixoperators(p1,again);
  1973. end;
  1974. _INTCONST :
  1975. begin
  1976. {$ifdef cpu64}
  1977. { when already running under 64bit must read int64 constant, because reading
  1978. cardinal first will also succeed (code=0) for values > maxcardinal, because
  1979. range checking is off by default (PFV) }
  1980. val(pattern,ic,code);
  1981. if code=0 then
  1982. begin
  1983. consume(_INTCONST);
  1984. int_to_type(ic,htype);
  1985. p1:=cordconstnode.create(ic,htype,true);
  1986. end
  1987. else
  1988. begin
  1989. { try qword next }
  1990. val(pattern,qc,code);
  1991. if code=0 then
  1992. begin
  1993. consume(_INTCONST);
  1994. htype:=u64inttype;
  1995. p1:=cordconstnode.create(qc,htype,true);
  1996. end;
  1997. end;
  1998. {$else}
  1999. { try cardinal first }
  2000. val(pattern,card,code);
  2001. if code=0 then
  2002. begin
  2003. consume(_INTCONST);
  2004. int_to_type(card,htype);
  2005. p1:=cordconstnode.create(card,htype,true);
  2006. end
  2007. else
  2008. begin
  2009. { then longint }
  2010. val(pattern,l,code);
  2011. if code = 0 then
  2012. begin
  2013. consume(_INTCONST);
  2014. int_to_type(l,htype);
  2015. p1:=cordconstnode.create(l,htype,true);
  2016. end
  2017. else
  2018. begin
  2019. { then int64 }
  2020. val(pattern,ic,code);
  2021. if code=0 then
  2022. begin
  2023. consume(_INTCONST);
  2024. int_to_type(ic,htype);
  2025. p1:=cordconstnode.create(ic,htype,true);
  2026. end
  2027. else
  2028. begin
  2029. { try qword next }
  2030. val(pattern,qc,code);
  2031. if code=0 then
  2032. begin
  2033. consume(_INTCONST);
  2034. htype:=u64inttype;
  2035. p1:=cordconstnode.create(tconstexprint(qc),htype,true);
  2036. end;
  2037. end;
  2038. end;
  2039. end;
  2040. {$endif}
  2041. if code<>0 then
  2042. begin
  2043. { finally float }
  2044. val(pattern,d,code);
  2045. if code<>0 then
  2046. begin
  2047. Message(parser_e_invalid_integer);
  2048. consume(_INTCONST);
  2049. l:=1;
  2050. p1:=cordconstnode.create(l,sinttype,true);
  2051. end
  2052. else
  2053. begin
  2054. consume(_INTCONST);
  2055. p1:=crealconstnode.create(d,pbestrealtype^);
  2056. end;
  2057. end;
  2058. end;
  2059. _REALNUMBER :
  2060. begin
  2061. val(pattern,d,code);
  2062. if code<>0 then
  2063. begin
  2064. Message(parser_e_error_in_real);
  2065. d:=1.0;
  2066. end;
  2067. consume(_REALNUMBER);
  2068. p1:=crealconstnode.create(d,pbestrealtype^);
  2069. end;
  2070. _STRING :
  2071. begin
  2072. string_dec(htype);
  2073. { STRING can be also a type cast }
  2074. if try_to_consume(_LKLAMMER) then
  2075. begin
  2076. p1:=comp_expr(true);
  2077. consume(_RKLAMMER);
  2078. p1:=ctypeconvnode.create_explicit(p1,htype);
  2079. { handle postfix operators here e.g. string(a)[10] }
  2080. again:=true;
  2081. postfixoperators(p1,again);
  2082. end
  2083. else
  2084. p1:=ctypenode.create(htype);
  2085. end;
  2086. _FILE :
  2087. begin
  2088. htype:=cfiletype;
  2089. consume(_FILE);
  2090. { FILE can be also a type cast }
  2091. if try_to_consume(_LKLAMMER) then
  2092. begin
  2093. p1:=comp_expr(true);
  2094. consume(_RKLAMMER);
  2095. p1:=ctypeconvnode.create_explicit(p1,htype);
  2096. { handle postfix operators here e.g. string(a)[10] }
  2097. again:=true;
  2098. postfixoperators(p1,again);
  2099. end
  2100. else
  2101. begin
  2102. p1:=ctypenode.create(htype);
  2103. end;
  2104. end;
  2105. _CSTRING :
  2106. begin
  2107. p1:=cstringconstnode.createstr(pattern,st_default);
  2108. consume(_CSTRING);
  2109. end;
  2110. _CCHAR :
  2111. begin
  2112. p1:=cordconstnode.create(ord(pattern[1]),cchartype,true);
  2113. consume(_CCHAR);
  2114. end;
  2115. _CWSTRING:
  2116. begin
  2117. p1:=cstringconstnode.createwstr(patternw);
  2118. consume(_CWSTRING);
  2119. end;
  2120. _CWCHAR:
  2121. begin
  2122. p1:=cordconstnode.create(ord(getcharwidestring(patternw,0)),cwidechartype,true);
  2123. consume(_CWCHAR);
  2124. end;
  2125. _KLAMMERAFFE :
  2126. begin
  2127. consume(_KLAMMERAFFE);
  2128. got_addrn:=true;
  2129. { support both @<x> and @(<x>) }
  2130. if try_to_consume(_LKLAMMER) then
  2131. begin
  2132. p1:=factor(true);
  2133. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2134. begin
  2135. again:=true;
  2136. postfixoperators(p1,again);
  2137. end;
  2138. consume(_RKLAMMER);
  2139. end
  2140. else
  2141. p1:=factor(true);
  2142. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2143. begin
  2144. again:=true;
  2145. postfixoperators(p1,again);
  2146. end;
  2147. got_addrn:=false;
  2148. p1:=caddrnode.create(p1);
  2149. if cs_typed_addresses in aktlocalswitches then
  2150. include(p1.flags,nf_typedaddr);
  2151. { Store the procvar that we are expecting, the
  2152. addrn will use the information to find the correct
  2153. procdef or it will return an error }
  2154. if assigned(getprocvardef) and
  2155. (taddrnode(p1).left.nodetype = loadn) then
  2156. taddrnode(p1).getprocvardef:=getprocvardef;
  2157. end;
  2158. _LKLAMMER :
  2159. begin
  2160. consume(_LKLAMMER);
  2161. p1:=comp_expr(true);
  2162. consume(_RKLAMMER);
  2163. { it's not a good solution }
  2164. { but (a+b)^ makes some problems }
  2165. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2166. begin
  2167. again:=true;
  2168. postfixoperators(p1,again);
  2169. end;
  2170. end;
  2171. _LECKKLAMMER :
  2172. begin
  2173. consume(_LECKKLAMMER);
  2174. p1:=factor_read_set;
  2175. consume(_RECKKLAMMER);
  2176. end;
  2177. _PLUS :
  2178. begin
  2179. consume(_PLUS);
  2180. p1:=factor(false);
  2181. end;
  2182. _MINUS :
  2183. begin
  2184. consume(_MINUS);
  2185. if (token = _INTCONST) then
  2186. begin
  2187. { ugly hack, but necessary to be able to parse }
  2188. { -9223372036854775808 as int64 (JM) }
  2189. pattern := '-'+pattern;
  2190. p1:=sub_expr(oppower,false);
  2191. { -1 ** 4 should be - (1 ** 4) and not
  2192. (-1) ** 4
  2193. This was the reason of tw0869.pp test failure PM }
  2194. if p1.nodetype=starstarn then
  2195. begin
  2196. if tbinarynode(p1).left.nodetype=ordconstn then
  2197. begin
  2198. tordconstnode(tbinarynode(p1).left).value:=-tordconstnode(tbinarynode(p1).left).value;
  2199. p1:=cunaryminusnode.create(p1);
  2200. end
  2201. else if tbinarynode(p1).left.nodetype=realconstn then
  2202. begin
  2203. trealconstnode(tbinarynode(p1).left).value_real:=-trealconstnode(tbinarynode(p1).left).value_real;
  2204. p1:=cunaryminusnode.create(p1);
  2205. end
  2206. else
  2207. internalerror(20021029);
  2208. end;
  2209. end
  2210. else
  2211. begin
  2212. p1:=sub_expr(oppower,false);
  2213. p1:=cunaryminusnode.create(p1);
  2214. end;
  2215. end;
  2216. _OP_NOT :
  2217. begin
  2218. consume(_OP_NOT);
  2219. p1:=factor(false);
  2220. p1:=cnotnode.create(p1);
  2221. end;
  2222. _TRUE :
  2223. begin
  2224. consume(_TRUE);
  2225. p1:=cordconstnode.create(1,booltype,false);
  2226. end;
  2227. _FALSE :
  2228. begin
  2229. consume(_FALSE);
  2230. p1:=cordconstnode.create(0,booltype,false);
  2231. end;
  2232. _NIL :
  2233. begin
  2234. consume(_NIL);
  2235. p1:=cnilnode.create;
  2236. { It's really ugly code nil^, but delphi allows it }
  2237. if token in [_CARET] then
  2238. begin
  2239. again:=true;
  2240. postfixoperators(p1,again);
  2241. end;
  2242. end;
  2243. else
  2244. begin
  2245. p1:=cerrornode.create;
  2246. consume(token);
  2247. Message(parser_e_illegal_expression);
  2248. end;
  2249. end;
  2250. { generate error node if no node is created }
  2251. if not assigned(p1) then
  2252. begin
  2253. {$ifdef EXTDEBUG}
  2254. Comment(V_Warning,'factor: p1=nil');
  2255. {$endif}
  2256. p1:=cerrornode.create;
  2257. end;
  2258. { get the resulttype for the node }
  2259. if (not assigned(p1.resulttype.def)) then
  2260. do_resulttypepass(p1);
  2261. factor:=p1;
  2262. check_tokenpos;
  2263. end;
  2264. {$ifdef fpc}
  2265. {$maxfpuregisters default}
  2266. {$endif fpc}
  2267. {****************************************************************************
  2268. Sub_Expr
  2269. ****************************************************************************}
  2270. const
  2271. { Warning these stay be ordered !! }
  2272. operator_levels:array[Toperator_precedence] of set of Ttoken=
  2273. ([_LT,_LTE,_GT,_GTE,_EQUAL,_UNEQUAL,_OP_IN],
  2274. [_PLUS,_MINUS,_OP_OR,_PIPE,_OP_XOR],
  2275. [_CARET,_SYMDIF,_STARSTAR,_STAR,_SLASH,
  2276. _OP_AS,_OP_IS,_OP_AND,_AMPERSAND,_OP_DIV,_OP_MOD,_OP_SHL,_OP_SHR],
  2277. [_STARSTAR] );
  2278. function sub_expr(pred_level:Toperator_precedence;accept_equal : boolean):tnode;
  2279. {Reads a subexpression while the operators are of the current precedence
  2280. level, or any higher level. Replaces the old term, simpl_expr and
  2281. simpl2_expr.}
  2282. var
  2283. p1,p2 : tnode;
  2284. oldt : Ttoken;
  2285. filepos : tfileposinfo;
  2286. begin
  2287. if pred_level=highest_precedence then
  2288. p1:=factor(false)
  2289. else
  2290. p1:=sub_expr(succ(pred_level),true);
  2291. repeat
  2292. if (token in operator_levels[pred_level]) and
  2293. ((token<>_EQUAL) or accept_equal) then
  2294. begin
  2295. oldt:=token;
  2296. filepos:=akttokenpos;
  2297. consume(token);
  2298. if pred_level=highest_precedence then
  2299. p2:=factor(false)
  2300. else
  2301. p2:=sub_expr(succ(pred_level),true);
  2302. case oldt of
  2303. _PLUS :
  2304. p1:=caddnode.create(addn,p1,p2);
  2305. _MINUS :
  2306. p1:=caddnode.create(subn,p1,p2);
  2307. _STAR :
  2308. p1:=caddnode.create(muln,p1,p2);
  2309. _SLASH :
  2310. p1:=caddnode.create(slashn,p1,p2);
  2311. _EQUAL :
  2312. p1:=caddnode.create(equaln,p1,p2);
  2313. _GT :
  2314. p1:=caddnode.create(gtn,p1,p2);
  2315. _LT :
  2316. p1:=caddnode.create(ltn,p1,p2);
  2317. _GTE :
  2318. p1:=caddnode.create(gten,p1,p2);
  2319. _LTE :
  2320. p1:=caddnode.create(lten,p1,p2);
  2321. _SYMDIF :
  2322. p1:=caddnode.create(symdifn,p1,p2);
  2323. _STARSTAR :
  2324. p1:=caddnode.create(starstarn,p1,p2);
  2325. _OP_AS :
  2326. p1:=casnode.create(p1,p2);
  2327. _OP_IN :
  2328. p1:=cinnode.create(p1,p2);
  2329. _OP_IS :
  2330. p1:=cisnode.create(p1,p2);
  2331. _OP_OR,
  2332. _PIPE {macpas only} :
  2333. p1:=caddnode.create(orn,p1,p2);
  2334. _OP_AND,
  2335. _AMPERSAND {macpas only} :
  2336. p1:=caddnode.create(andn,p1,p2);
  2337. _OP_DIV :
  2338. p1:=cmoddivnode.create(divn,p1,p2);
  2339. _OP_NOT :
  2340. p1:=cnotnode.create(p1);
  2341. _OP_MOD :
  2342. p1:=cmoddivnode.create(modn,p1,p2);
  2343. _OP_SHL :
  2344. p1:=cshlshrnode.create(shln,p1,p2);
  2345. _OP_SHR :
  2346. p1:=cshlshrnode.create(shrn,p1,p2);
  2347. _OP_XOR :
  2348. p1:=caddnode.create(xorn,p1,p2);
  2349. _ASSIGNMENT :
  2350. p1:=cassignmentnode.create(p1,p2);
  2351. _CARET :
  2352. p1:=caddnode.create(caretn,p1,p2);
  2353. _UNEQUAL :
  2354. p1:=caddnode.create(unequaln,p1,p2);
  2355. end;
  2356. p1.fileinfo:=filepos;
  2357. end
  2358. else
  2359. break;
  2360. until false;
  2361. sub_expr:=p1;
  2362. end;
  2363. function comp_expr(accept_equal : boolean):tnode;
  2364. var
  2365. oldafterassignment : boolean;
  2366. p1 : tnode;
  2367. begin
  2368. oldafterassignment:=afterassignment;
  2369. afterassignment:=true;
  2370. p1:=sub_expr(opcompare,accept_equal);
  2371. { get the resulttype for this expression }
  2372. if not assigned(p1.resulttype.def) then
  2373. do_resulttypepass(p1);
  2374. afterassignment:=oldafterassignment;
  2375. comp_expr:=p1;
  2376. end;
  2377. function expr : tnode;
  2378. var
  2379. p1,p2 : tnode;
  2380. oldafterassignment : boolean;
  2381. oldp1 : tnode;
  2382. filepos : tfileposinfo;
  2383. begin
  2384. oldafterassignment:=afterassignment;
  2385. p1:=sub_expr(opcompare,true);
  2386. { get the resulttype for this expression }
  2387. if not assigned(p1.resulttype.def) then
  2388. do_resulttypepass(p1);
  2389. filepos:=akttokenpos;
  2390. if token in [_ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
  2391. afterassignment:=true;
  2392. oldp1:=p1;
  2393. case token of
  2394. _POINTPOINT :
  2395. begin
  2396. consume(_POINTPOINT);
  2397. p2:=sub_expr(opcompare,true);
  2398. p1:=crangenode.create(p1,p2);
  2399. end;
  2400. _ASSIGNMENT :
  2401. begin
  2402. consume(_ASSIGNMENT);
  2403. if (p1.resulttype.def.deftype=procvardef) then
  2404. getprocvardef:=tprocvardef(p1.resulttype.def);
  2405. p2:=sub_expr(opcompare,true);
  2406. if assigned(getprocvardef) then
  2407. handle_procvar(getprocvardef,p2);
  2408. getprocvardef:=nil;
  2409. p1:=cassignmentnode.create(p1,p2);
  2410. end;
  2411. _PLUSASN :
  2412. begin
  2413. consume(_PLUSASN);
  2414. p2:=sub_expr(opcompare,true);
  2415. p1:=gen_c_style_operator(addn,p1,p2);
  2416. end;
  2417. _MINUSASN :
  2418. begin
  2419. consume(_MINUSASN);
  2420. p2:=sub_expr(opcompare,true);
  2421. p1:=gen_c_style_operator(subn,p1,p2);
  2422. end;
  2423. _STARASN :
  2424. begin
  2425. consume(_STARASN );
  2426. p2:=sub_expr(opcompare,true);
  2427. p1:=gen_c_style_operator(muln,p1,p2);
  2428. end;
  2429. _SLASHASN :
  2430. begin
  2431. consume(_SLASHASN );
  2432. p2:=sub_expr(opcompare,true);
  2433. p1:=gen_c_style_operator(slashn,p1,p2);
  2434. end;
  2435. end;
  2436. { get the resulttype for this expression }
  2437. if not assigned(p1.resulttype.def) then
  2438. do_resulttypepass(p1);
  2439. afterassignment:=oldafterassignment;
  2440. if p1<>oldp1 then
  2441. p1.fileinfo:=filepos;
  2442. expr:=p1;
  2443. end;
  2444. {$ifdef int64funcresok}
  2445. function get_intconst:TConstExprInt;
  2446. {$else int64funcresok}
  2447. function get_intconst:longint;
  2448. {$endif int64funcresok}
  2449. {Reads an expression, tries to evalute it and check if it is an integer
  2450. constant. Then the constant is returned.}
  2451. var
  2452. p:tnode;
  2453. begin
  2454. result:=0;
  2455. p:=comp_expr(true);
  2456. if not codegenerror then
  2457. begin
  2458. if (p.nodetype<>ordconstn) or
  2459. not(is_integer(p.resulttype.def)) then
  2460. Message(parser_e_illegal_expression)
  2461. else
  2462. result:=tordconstnode(p).value;
  2463. end;
  2464. p.free;
  2465. end;
  2466. function get_stringconst:string;
  2467. {Reads an expression, tries to evaluate it and checks if it is a string
  2468. constant. Then the constant is returned.}
  2469. var
  2470. p:tnode;
  2471. begin
  2472. get_stringconst:='';
  2473. p:=comp_expr(true);
  2474. if p.nodetype<>stringconstn then
  2475. begin
  2476. if (p.nodetype=ordconstn) and is_char(p.resulttype.def) then
  2477. get_stringconst:=char(tordconstnode(p).value)
  2478. else
  2479. Message(parser_e_illegal_expression);
  2480. end
  2481. else
  2482. get_stringconst:=strpas(tstringconstnode(p).value_str);
  2483. p.free;
  2484. end;
  2485. end.