pexpr.pas 97 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669
  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. { support tp/mac procvar^ if the procvar returns a
  1575. pointer type }
  1576. if ((m_tp_procvar in aktmodeswitches) or
  1577. (m_mac_procvar in aktmodeswitches)) and
  1578. (p1.resulttype.def.deftype=procvardef) and
  1579. (tprocvardef(p1.resulttype.def).rettype.def.deftype=pointerdef) then
  1580. begin
  1581. p1:=ccallnode.create_procvar(nil,p1);
  1582. resulttypepass(p1);
  1583. end;
  1584. if (p1.resulttype.def.deftype<>pointerdef) then
  1585. begin
  1586. { ^ as binary operator is a problem!!!! (FK) }
  1587. again:=false;
  1588. Message(parser_e_invalid_qualifier);
  1589. recoverconsume_postfixops;
  1590. p1.destroy;
  1591. p1:=cerrornode.create;
  1592. end
  1593. else
  1594. p1:=cderefnode.create(p1);
  1595. end;
  1596. _LECKKLAMMER:
  1597. begin
  1598. if is_class_or_interface(p1.resulttype.def) then
  1599. begin
  1600. { default property }
  1601. protsym:=search_default_property(tobjectdef(p1.resulttype.def));
  1602. if not(assigned(protsym)) then
  1603. begin
  1604. p1.destroy;
  1605. p1:=cerrornode.create;
  1606. again:=false;
  1607. message(parser_e_no_default_property_available);
  1608. end
  1609. else
  1610. begin
  1611. { The property symbol is referenced indirect }
  1612. inc(protsym.refs);
  1613. handle_propertysym(protsym,protsym.owner,p1);
  1614. end;
  1615. end
  1616. else
  1617. begin
  1618. consume(_LECKKLAMMER);
  1619. repeat
  1620. case p1.resulttype.def.deftype of
  1621. pointerdef:
  1622. begin
  1623. { support delphi autoderef }
  1624. if (tpointerdef(p1.resulttype.def).pointertype.def.deftype=arraydef) and
  1625. (m_autoderef in aktmodeswitches) then
  1626. begin
  1627. p1:=cderefnode.create(p1);
  1628. end;
  1629. p2:=comp_expr(true);
  1630. p1:=cvecnode.create(p1,p2);
  1631. end;
  1632. variantdef:
  1633. begin
  1634. handle_variantarray;
  1635. { the RECKKLAMMER is already read }
  1636. goto skipreckklammercheck;
  1637. end;
  1638. stringdef :
  1639. begin
  1640. p2:=comp_expr(true);
  1641. p1:=cvecnode.create(p1,p2);
  1642. end;
  1643. arraydef :
  1644. begin
  1645. p2:=comp_expr(true);
  1646. { support SEG:OFS for go32v2 Mem[] }
  1647. if (target_info.system in [system_i386_go32v2,system_i386_watcom]) and
  1648. (p1.nodetype=loadn) and
  1649. assigned(tloadnode(p1).symtableentry) and
  1650. assigned(tloadnode(p1).symtableentry.owner.name) and
  1651. (tloadnode(p1).symtableentry.owner.name^='SYSTEM') and
  1652. ((tloadnode(p1).symtableentry.name='MEM') or
  1653. (tloadnode(p1).symtableentry.name='MEMW') or
  1654. (tloadnode(p1).symtableentry.name='MEML')) then
  1655. begin
  1656. if try_to_consume(_COLON) then
  1657. begin
  1658. p3:=caddnode.create(muln,cordconstnode.create($10,s32inttype,false),p2);
  1659. p2:=comp_expr(true);
  1660. p2:=caddnode.create(addn,p2,p3);
  1661. p1:=cvecnode.create(p1,p2);
  1662. include(tvecnode(p1).flags,nf_memseg);
  1663. include(tvecnode(p1).flags,nf_memindex);
  1664. end
  1665. else
  1666. begin
  1667. p1:=cvecnode.create(p1,p2);
  1668. include(tvecnode(p1).flags,nf_memindex);
  1669. end;
  1670. end
  1671. else
  1672. p1:=cvecnode.create(p1,p2);
  1673. end;
  1674. else
  1675. begin
  1676. Message(parser_e_invalid_qualifier);
  1677. p1.destroy;
  1678. p1:=cerrornode.create;
  1679. comp_expr(true);
  1680. again:=false;
  1681. end;
  1682. end;
  1683. do_resulttypepass(p1);
  1684. until not try_to_consume(_COMMA);
  1685. consume(_RECKKLAMMER);
  1686. { handle_variantarray eats the RECKKLAMMER and jumps here }
  1687. skipreckklammercheck:
  1688. end;
  1689. end;
  1690. _POINT :
  1691. begin
  1692. consume(_POINT);
  1693. if (p1.resulttype.def.deftype=pointerdef) and
  1694. (m_autoderef in aktmodeswitches) then
  1695. begin
  1696. p1:=cderefnode.create(p1);
  1697. do_resulttypepass(p1);
  1698. end;
  1699. case p1.resulttype.def.deftype of
  1700. recorddef:
  1701. begin
  1702. if token=_ID then
  1703. begin
  1704. hsym:=tsym(trecorddef(p1.resulttype.def).symtable.search(pattern));
  1705. check_hints(hsym);
  1706. if assigned(hsym) and
  1707. (hsym.typ=fieldvarsym) then
  1708. p1:=csubscriptnode.create(hsym,p1)
  1709. else
  1710. begin
  1711. Message1(sym_e_illegal_field,pattern);
  1712. p1.destroy;
  1713. p1:=cerrornode.create;
  1714. end;
  1715. end;
  1716. consume(_ID);
  1717. end;
  1718. variantdef:
  1719. begin
  1720. end;
  1721. classrefdef:
  1722. begin
  1723. if token=_ID then
  1724. begin
  1725. classh:=tobjectdef(tclassrefdef(p1.resulttype.def).pointertype.def);
  1726. hsym:=searchsym_in_class(classh,pattern);
  1727. check_hints(hsym);
  1728. if hsym=nil then
  1729. begin
  1730. Message1(sym_e_id_no_member,orgpattern);
  1731. p1.destroy;
  1732. p1:=cerrornode.create;
  1733. { try to clean up }
  1734. consume(_ID);
  1735. end
  1736. else
  1737. begin
  1738. consume(_ID);
  1739. do_member_read(classh,getaddr,hsym,p1,again,[]);
  1740. end;
  1741. end
  1742. else { Error }
  1743. Consume(_ID);
  1744. end;
  1745. objectdef:
  1746. begin
  1747. if token=_ID then
  1748. begin
  1749. store_static:=allow_only_static;
  1750. allow_only_static:=false;
  1751. classh:=tobjectdef(p1.resulttype.def);
  1752. hsym:=searchsym_in_class(classh,pattern);
  1753. check_hints(hsym);
  1754. allow_only_static:=store_static;
  1755. if hsym=nil then
  1756. begin
  1757. Message1(sym_e_id_no_member,orgpattern);
  1758. p1.destroy;
  1759. p1:=cerrornode.create;
  1760. { try to clean up }
  1761. consume(_ID);
  1762. end
  1763. else
  1764. begin
  1765. consume(_ID);
  1766. do_member_read(classh,getaddr,hsym,p1,again,[]);
  1767. end;
  1768. end
  1769. else { Error }
  1770. Consume(_ID);
  1771. end;
  1772. pointerdef:
  1773. begin
  1774. Message(parser_e_invalid_qualifier);
  1775. if tpointerdef(p1.resulttype.def).pointertype.def.deftype in [recorddef,objectdef,classrefdef] then
  1776. Message(parser_h_maybe_deref_caret_missing);
  1777. end;
  1778. else
  1779. begin
  1780. Message(parser_e_invalid_qualifier);
  1781. p1.destroy;
  1782. p1:=cerrornode.create;
  1783. { Error }
  1784. consume(_ID);
  1785. end;
  1786. end;
  1787. end;
  1788. else
  1789. begin
  1790. { is this a procedure variable ? }
  1791. if assigned(p1.resulttype.def) and
  1792. (p1.resulttype.def.deftype=procvardef) then
  1793. begin
  1794. if assigned(getprocvardef) and
  1795. equal_defs(p1.resulttype.def,getprocvardef) then
  1796. again:=false
  1797. else
  1798. begin
  1799. if try_to_consume(_LKLAMMER) then
  1800. begin
  1801. p2:=parse_paras(false,_RKLAMMER);
  1802. consume(_RKLAMMER);
  1803. p1:=ccallnode.create_procvar(p2,p1);
  1804. { proc():= is never possible }
  1805. if token=_ASSIGNMENT then
  1806. begin
  1807. Message(parser_e_illegal_expression);
  1808. p1.free;
  1809. p1:=cerrornode.create;
  1810. again:=false;
  1811. end;
  1812. end
  1813. else
  1814. again:=false;
  1815. end;
  1816. end
  1817. else
  1818. again:=false;
  1819. end;
  1820. end;
  1821. end; { while again }
  1822. end;
  1823. {---------------------------------------------
  1824. Factor (Main)
  1825. ---------------------------------------------}
  1826. var
  1827. l : longint;
  1828. ic : int64;
  1829. qc : qword;
  1830. {$ifndef cpu64}
  1831. card : cardinal;
  1832. {$endif cpu64}
  1833. oldp1,
  1834. p1 : tnode;
  1835. code : integer;
  1836. again : boolean;
  1837. sym : tsym;
  1838. pd : tprocdef;
  1839. classh : tobjectdef;
  1840. d : bestreal;
  1841. hs,hsorg : string;
  1842. htype : ttype;
  1843. filepos : tfileposinfo;
  1844. {---------------------------------------------
  1845. Helpers
  1846. ---------------------------------------------}
  1847. procedure check_tokenpos;
  1848. begin
  1849. if (p1<>oldp1) then
  1850. begin
  1851. if assigned(p1) then
  1852. p1.fileinfo:=filepos;
  1853. oldp1:=p1;
  1854. filepos:=akttokenpos;
  1855. end;
  1856. end;
  1857. begin
  1858. oldp1:=nil;
  1859. p1:=nil;
  1860. filepos:=akttokenpos;
  1861. again:=false;
  1862. if token=_ID then
  1863. begin
  1864. again:=true;
  1865. { Handle references to self }
  1866. if (idtoken=_SELF) and
  1867. not(block_type in [bt_const,bt_type]) and
  1868. assigned(current_procinfo) and
  1869. assigned(current_procinfo.procdef._class) then
  1870. begin
  1871. p1:=load_self_node;
  1872. consume(_ID);
  1873. again:=true;
  1874. end
  1875. else
  1876. factor_read_id(p1,again);
  1877. if again then
  1878. begin
  1879. check_tokenpos;
  1880. { handle post fix operators }
  1881. postfixoperators(p1,again);
  1882. end;
  1883. end
  1884. else
  1885. case token of
  1886. _INHERITED :
  1887. begin
  1888. again:=true;
  1889. consume(_INHERITED);
  1890. if assigned(current_procinfo) and
  1891. assigned(current_procinfo.procdef._class) then
  1892. begin
  1893. classh:=current_procinfo.procdef._class.childof;
  1894. { if inherited; only then we need the method with
  1895. the same name }
  1896. if token in endtokens then
  1897. begin
  1898. hs:=current_procinfo.procdef.procsym.name;
  1899. hsorg:=current_procinfo.procdef.procsym.realname;
  1900. anon_inherited:=true;
  1901. { For message methods we need to search using the message
  1902. number or string }
  1903. pd:=tprocsym(current_procinfo.procdef.procsym).first_procdef;
  1904. if (po_msgint in pd.procoptions) then
  1905. sym:=searchsym_in_class_by_msgint(classh,pd.messageinf.i)
  1906. else
  1907. if (po_msgstr in pd.procoptions) then
  1908. sym:=searchsym_in_class_by_msgstr(classh,pd.messageinf.str)
  1909. else
  1910. sym:=searchsym_in_class(classh,hs);
  1911. end
  1912. else
  1913. begin
  1914. hs:=pattern;
  1915. hsorg:=orgpattern;
  1916. consume(_ID);
  1917. anon_inherited:=false;
  1918. sym:=searchsym_in_class(classh,hs);
  1919. end;
  1920. if assigned(sym) then
  1921. begin
  1922. check_hints(sym);
  1923. { load the procdef from the inherited class and
  1924. not from self }
  1925. if sym.typ in [procsym,propertysym] then
  1926. begin
  1927. if (sym.typ = procsym) then
  1928. begin
  1929. htype.setdef(classh);
  1930. if (po_classmethod in current_procinfo.procdef.procoptions) or
  1931. (po_staticmethod in current_procinfo.procdef.procoptions) then
  1932. htype.setdef(tclassrefdef.create(htype));
  1933. p1:=ctypenode.create(htype);
  1934. end;
  1935. end
  1936. else
  1937. begin
  1938. Message(parser_e_methode_id_expected);
  1939. p1:=cerrornode.create;
  1940. end;
  1941. do_member_read(classh,false,sym,p1,again,[cnf_inherited,cnf_anon_inherited]);
  1942. end
  1943. else
  1944. begin
  1945. if anon_inherited then
  1946. begin
  1947. { For message methods we need to call DefaultHandler }
  1948. if (po_msgint in pd.procoptions) or
  1949. (po_msgstr in pd.procoptions) then
  1950. begin
  1951. sym:=searchsym_in_class(classh,'DEFAULTHANDLER');
  1952. if not assigned(sym) or
  1953. (sym.typ<>procsym) then
  1954. internalerror(200303171);
  1955. p1:=nil;
  1956. do_proc_call(sym,sym.owner,classh,false,again,p1,[]);
  1957. end
  1958. else
  1959. begin
  1960. { we need to ignore the inherited; }
  1961. p1:=cnothingnode.create;
  1962. end;
  1963. end
  1964. else
  1965. begin
  1966. Message1(sym_e_id_no_member,hsorg);
  1967. p1:=cerrornode.create;
  1968. end;
  1969. again:=false;
  1970. end;
  1971. { turn auto inheriting off }
  1972. anon_inherited:=false;
  1973. end
  1974. else
  1975. begin
  1976. Message(parser_e_generic_methods_only_in_methods);
  1977. again:=false;
  1978. p1:=cerrornode.create;
  1979. end;
  1980. postfixoperators(p1,again);
  1981. end;
  1982. _INTCONST :
  1983. begin
  1984. {$ifdef cpu64}
  1985. { when already running under 64bit must read int64 constant, because reading
  1986. cardinal first will also succeed (code=0) for values > maxcardinal, because
  1987. range checking is off by default (PFV) }
  1988. val(pattern,ic,code);
  1989. if code=0 then
  1990. begin
  1991. consume(_INTCONST);
  1992. int_to_type(ic,htype);
  1993. p1:=cordconstnode.create(ic,htype,true);
  1994. end
  1995. else
  1996. begin
  1997. { try qword next }
  1998. val(pattern,qc,code);
  1999. if code=0 then
  2000. begin
  2001. consume(_INTCONST);
  2002. htype:=u64inttype;
  2003. p1:=cordconstnode.create(qc,htype,true);
  2004. end;
  2005. end;
  2006. {$else}
  2007. { try cardinal first }
  2008. val(pattern,card,code);
  2009. if code=0 then
  2010. begin
  2011. consume(_INTCONST);
  2012. int_to_type(card,htype);
  2013. p1:=cordconstnode.create(card,htype,true);
  2014. end
  2015. else
  2016. begin
  2017. { then longint }
  2018. val(pattern,l,code);
  2019. if code = 0 then
  2020. begin
  2021. consume(_INTCONST);
  2022. int_to_type(l,htype);
  2023. p1:=cordconstnode.create(l,htype,true);
  2024. end
  2025. else
  2026. begin
  2027. { then int64 }
  2028. val(pattern,ic,code);
  2029. if code=0 then
  2030. begin
  2031. consume(_INTCONST);
  2032. int_to_type(ic,htype);
  2033. p1:=cordconstnode.create(ic,htype,true);
  2034. end
  2035. else
  2036. begin
  2037. { try qword next }
  2038. val(pattern,qc,code);
  2039. if code=0 then
  2040. begin
  2041. consume(_INTCONST);
  2042. htype:=u64inttype;
  2043. p1:=cordconstnode.create(tconstexprint(qc),htype,true);
  2044. end;
  2045. end;
  2046. end;
  2047. end;
  2048. {$endif}
  2049. if code<>0 then
  2050. begin
  2051. { finally float }
  2052. val(pattern,d,code);
  2053. if code<>0 then
  2054. begin
  2055. Message(parser_e_invalid_integer);
  2056. consume(_INTCONST);
  2057. l:=1;
  2058. p1:=cordconstnode.create(l,sinttype,true);
  2059. end
  2060. else
  2061. begin
  2062. consume(_INTCONST);
  2063. p1:=crealconstnode.create(d,pbestrealtype^);
  2064. end;
  2065. end;
  2066. end;
  2067. _REALNUMBER :
  2068. begin
  2069. val(pattern,d,code);
  2070. if code<>0 then
  2071. begin
  2072. Message(parser_e_error_in_real);
  2073. d:=1.0;
  2074. end;
  2075. consume(_REALNUMBER);
  2076. p1:=crealconstnode.create(d,pbestrealtype^);
  2077. end;
  2078. _STRING :
  2079. begin
  2080. string_dec(htype);
  2081. { STRING can be also a type cast }
  2082. if try_to_consume(_LKLAMMER) then
  2083. begin
  2084. p1:=comp_expr(true);
  2085. consume(_RKLAMMER);
  2086. p1:=ctypeconvnode.create_explicit(p1,htype);
  2087. { handle postfix operators here e.g. string(a)[10] }
  2088. again:=true;
  2089. postfixoperators(p1,again);
  2090. end
  2091. else
  2092. p1:=ctypenode.create(htype);
  2093. end;
  2094. _FILE :
  2095. begin
  2096. htype:=cfiletype;
  2097. consume(_FILE);
  2098. { FILE can be also a type cast }
  2099. if try_to_consume(_LKLAMMER) then
  2100. begin
  2101. p1:=comp_expr(true);
  2102. consume(_RKLAMMER);
  2103. p1:=ctypeconvnode.create_explicit(p1,htype);
  2104. { handle postfix operators here e.g. string(a)[10] }
  2105. again:=true;
  2106. postfixoperators(p1,again);
  2107. end
  2108. else
  2109. begin
  2110. p1:=ctypenode.create(htype);
  2111. end;
  2112. end;
  2113. _CSTRING :
  2114. begin
  2115. p1:=cstringconstnode.createstr(pattern,st_default);
  2116. consume(_CSTRING);
  2117. end;
  2118. _CCHAR :
  2119. begin
  2120. p1:=cordconstnode.create(ord(pattern[1]),cchartype,true);
  2121. consume(_CCHAR);
  2122. end;
  2123. _CWSTRING:
  2124. begin
  2125. p1:=cstringconstnode.createwstr(patternw);
  2126. consume(_CWSTRING);
  2127. end;
  2128. _CWCHAR:
  2129. begin
  2130. p1:=cordconstnode.create(ord(getcharwidestring(patternw,0)),cwidechartype,true);
  2131. consume(_CWCHAR);
  2132. end;
  2133. _KLAMMERAFFE :
  2134. begin
  2135. consume(_KLAMMERAFFE);
  2136. got_addrn:=true;
  2137. { support both @<x> and @(<x>) }
  2138. if try_to_consume(_LKLAMMER) then
  2139. begin
  2140. p1:=factor(true);
  2141. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2142. begin
  2143. again:=true;
  2144. postfixoperators(p1,again);
  2145. end;
  2146. consume(_RKLAMMER);
  2147. end
  2148. else
  2149. p1:=factor(true);
  2150. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2151. begin
  2152. again:=true;
  2153. postfixoperators(p1,again);
  2154. end;
  2155. got_addrn:=false;
  2156. p1:=caddrnode.create(p1);
  2157. if cs_typed_addresses in aktlocalswitches then
  2158. include(p1.flags,nf_typedaddr);
  2159. { Store the procvar that we are expecting, the
  2160. addrn will use the information to find the correct
  2161. procdef or it will return an error }
  2162. if assigned(getprocvardef) and
  2163. (taddrnode(p1).left.nodetype = loadn) then
  2164. taddrnode(p1).getprocvardef:=getprocvardef;
  2165. end;
  2166. _LKLAMMER :
  2167. begin
  2168. consume(_LKLAMMER);
  2169. p1:=comp_expr(true);
  2170. consume(_RKLAMMER);
  2171. { it's not a good solution }
  2172. { but (a+b)^ makes some problems }
  2173. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2174. begin
  2175. again:=true;
  2176. postfixoperators(p1,again);
  2177. end;
  2178. end;
  2179. _LECKKLAMMER :
  2180. begin
  2181. consume(_LECKKLAMMER);
  2182. p1:=factor_read_set;
  2183. consume(_RECKKLAMMER);
  2184. end;
  2185. _PLUS :
  2186. begin
  2187. consume(_PLUS);
  2188. p1:=factor(false);
  2189. end;
  2190. _MINUS :
  2191. begin
  2192. consume(_MINUS);
  2193. if (token = _INTCONST) then
  2194. begin
  2195. { ugly hack, but necessary to be able to parse }
  2196. { -9223372036854775808 as int64 (JM) }
  2197. pattern := '-'+pattern;
  2198. p1:=sub_expr(oppower,false);
  2199. { -1 ** 4 should be - (1 ** 4) and not
  2200. (-1) ** 4
  2201. This was the reason of tw0869.pp test failure PM }
  2202. if p1.nodetype=starstarn then
  2203. begin
  2204. if tbinarynode(p1).left.nodetype=ordconstn then
  2205. begin
  2206. tordconstnode(tbinarynode(p1).left).value:=-tordconstnode(tbinarynode(p1).left).value;
  2207. p1:=cunaryminusnode.create(p1);
  2208. end
  2209. else if tbinarynode(p1).left.nodetype=realconstn then
  2210. begin
  2211. trealconstnode(tbinarynode(p1).left).value_real:=-trealconstnode(tbinarynode(p1).left).value_real;
  2212. p1:=cunaryminusnode.create(p1);
  2213. end
  2214. else
  2215. internalerror(20021029);
  2216. end;
  2217. end
  2218. else
  2219. begin
  2220. p1:=sub_expr(oppower,false);
  2221. p1:=cunaryminusnode.create(p1);
  2222. end;
  2223. end;
  2224. _OP_NOT :
  2225. begin
  2226. consume(_OP_NOT);
  2227. p1:=factor(false);
  2228. p1:=cnotnode.create(p1);
  2229. end;
  2230. _TRUE :
  2231. begin
  2232. consume(_TRUE);
  2233. p1:=cordconstnode.create(1,booltype,false);
  2234. end;
  2235. _FALSE :
  2236. begin
  2237. consume(_FALSE);
  2238. p1:=cordconstnode.create(0,booltype,false);
  2239. end;
  2240. _NIL :
  2241. begin
  2242. consume(_NIL);
  2243. p1:=cnilnode.create;
  2244. { It's really ugly code nil^, but delphi allows it }
  2245. if token in [_CARET] then
  2246. begin
  2247. again:=true;
  2248. postfixoperators(p1,again);
  2249. end;
  2250. end;
  2251. else
  2252. begin
  2253. p1:=cerrornode.create;
  2254. consume(token);
  2255. Message(parser_e_illegal_expression);
  2256. end;
  2257. end;
  2258. { generate error node if no node is created }
  2259. if not assigned(p1) then
  2260. begin
  2261. {$ifdef EXTDEBUG}
  2262. Comment(V_Warning,'factor: p1=nil');
  2263. {$endif}
  2264. p1:=cerrornode.create;
  2265. end;
  2266. { get the resulttype for the node }
  2267. if (not assigned(p1.resulttype.def)) then
  2268. do_resulttypepass(p1);
  2269. factor:=p1;
  2270. check_tokenpos;
  2271. end;
  2272. {$ifdef fpc}
  2273. {$maxfpuregisters default}
  2274. {$endif fpc}
  2275. {****************************************************************************
  2276. Sub_Expr
  2277. ****************************************************************************}
  2278. const
  2279. { Warning these stay be ordered !! }
  2280. operator_levels:array[Toperator_precedence] of set of Ttoken=
  2281. ([_LT,_LTE,_GT,_GTE,_EQUAL,_UNEQUAL,_OP_IN],
  2282. [_PLUS,_MINUS,_OP_OR,_PIPE,_OP_XOR],
  2283. [_CARET,_SYMDIF,_STARSTAR,_STAR,_SLASH,
  2284. _OP_AS,_OP_IS,_OP_AND,_AMPERSAND,_OP_DIV,_OP_MOD,_OP_SHL,_OP_SHR],
  2285. [_STARSTAR] );
  2286. function sub_expr(pred_level:Toperator_precedence;accept_equal : boolean):tnode;
  2287. {Reads a subexpression while the operators are of the current precedence
  2288. level, or any higher level. Replaces the old term, simpl_expr and
  2289. simpl2_expr.}
  2290. var
  2291. p1,p2 : tnode;
  2292. oldt : Ttoken;
  2293. filepos : tfileposinfo;
  2294. begin
  2295. if pred_level=highest_precedence then
  2296. p1:=factor(false)
  2297. else
  2298. p1:=sub_expr(succ(pred_level),true);
  2299. repeat
  2300. if (token in operator_levels[pred_level]) and
  2301. ((token<>_EQUAL) or accept_equal) then
  2302. begin
  2303. oldt:=token;
  2304. filepos:=akttokenpos;
  2305. consume(token);
  2306. if pred_level=highest_precedence then
  2307. p2:=factor(false)
  2308. else
  2309. p2:=sub_expr(succ(pred_level),true);
  2310. case oldt of
  2311. _PLUS :
  2312. p1:=caddnode.create(addn,p1,p2);
  2313. _MINUS :
  2314. p1:=caddnode.create(subn,p1,p2);
  2315. _STAR :
  2316. p1:=caddnode.create(muln,p1,p2);
  2317. _SLASH :
  2318. p1:=caddnode.create(slashn,p1,p2);
  2319. _EQUAL :
  2320. p1:=caddnode.create(equaln,p1,p2);
  2321. _GT :
  2322. p1:=caddnode.create(gtn,p1,p2);
  2323. _LT :
  2324. p1:=caddnode.create(ltn,p1,p2);
  2325. _GTE :
  2326. p1:=caddnode.create(gten,p1,p2);
  2327. _LTE :
  2328. p1:=caddnode.create(lten,p1,p2);
  2329. _SYMDIF :
  2330. p1:=caddnode.create(symdifn,p1,p2);
  2331. _STARSTAR :
  2332. p1:=caddnode.create(starstarn,p1,p2);
  2333. _OP_AS :
  2334. p1:=casnode.create(p1,p2);
  2335. _OP_IN :
  2336. p1:=cinnode.create(p1,p2);
  2337. _OP_IS :
  2338. p1:=cisnode.create(p1,p2);
  2339. _OP_OR,
  2340. _PIPE {macpas only} :
  2341. p1:=caddnode.create(orn,p1,p2);
  2342. _OP_AND,
  2343. _AMPERSAND {macpas only} :
  2344. p1:=caddnode.create(andn,p1,p2);
  2345. _OP_DIV :
  2346. p1:=cmoddivnode.create(divn,p1,p2);
  2347. _OP_NOT :
  2348. p1:=cnotnode.create(p1);
  2349. _OP_MOD :
  2350. p1:=cmoddivnode.create(modn,p1,p2);
  2351. _OP_SHL :
  2352. p1:=cshlshrnode.create(shln,p1,p2);
  2353. _OP_SHR :
  2354. p1:=cshlshrnode.create(shrn,p1,p2);
  2355. _OP_XOR :
  2356. p1:=caddnode.create(xorn,p1,p2);
  2357. _ASSIGNMENT :
  2358. p1:=cassignmentnode.create(p1,p2);
  2359. _CARET :
  2360. p1:=caddnode.create(caretn,p1,p2);
  2361. _UNEQUAL :
  2362. p1:=caddnode.create(unequaln,p1,p2);
  2363. end;
  2364. p1.fileinfo:=filepos;
  2365. end
  2366. else
  2367. break;
  2368. until false;
  2369. sub_expr:=p1;
  2370. end;
  2371. function comp_expr(accept_equal : boolean):tnode;
  2372. var
  2373. oldafterassignment : boolean;
  2374. p1 : tnode;
  2375. begin
  2376. oldafterassignment:=afterassignment;
  2377. afterassignment:=true;
  2378. p1:=sub_expr(opcompare,accept_equal);
  2379. { get the resulttype for this expression }
  2380. if not assigned(p1.resulttype.def) then
  2381. do_resulttypepass(p1);
  2382. afterassignment:=oldafterassignment;
  2383. comp_expr:=p1;
  2384. end;
  2385. function expr : tnode;
  2386. var
  2387. p1,p2 : tnode;
  2388. oldafterassignment : boolean;
  2389. oldp1 : tnode;
  2390. filepos : tfileposinfo;
  2391. begin
  2392. oldafterassignment:=afterassignment;
  2393. p1:=sub_expr(opcompare,true);
  2394. { get the resulttype for this expression }
  2395. if not assigned(p1.resulttype.def) then
  2396. do_resulttypepass(p1);
  2397. filepos:=akttokenpos;
  2398. if token in [_ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
  2399. afterassignment:=true;
  2400. oldp1:=p1;
  2401. case token of
  2402. _POINTPOINT :
  2403. begin
  2404. consume(_POINTPOINT);
  2405. p2:=sub_expr(opcompare,true);
  2406. p1:=crangenode.create(p1,p2);
  2407. end;
  2408. _ASSIGNMENT :
  2409. begin
  2410. consume(_ASSIGNMENT);
  2411. if (p1.resulttype.def.deftype=procvardef) then
  2412. getprocvardef:=tprocvardef(p1.resulttype.def);
  2413. p2:=sub_expr(opcompare,true);
  2414. if assigned(getprocvardef) then
  2415. handle_procvar(getprocvardef,p2);
  2416. getprocvardef:=nil;
  2417. p1:=cassignmentnode.create(p1,p2);
  2418. end;
  2419. _PLUSASN :
  2420. begin
  2421. consume(_PLUSASN);
  2422. p2:=sub_expr(opcompare,true);
  2423. p1:=gen_c_style_operator(addn,p1,p2);
  2424. end;
  2425. _MINUSASN :
  2426. begin
  2427. consume(_MINUSASN);
  2428. p2:=sub_expr(opcompare,true);
  2429. p1:=gen_c_style_operator(subn,p1,p2);
  2430. end;
  2431. _STARASN :
  2432. begin
  2433. consume(_STARASN );
  2434. p2:=sub_expr(opcompare,true);
  2435. p1:=gen_c_style_operator(muln,p1,p2);
  2436. end;
  2437. _SLASHASN :
  2438. begin
  2439. consume(_SLASHASN );
  2440. p2:=sub_expr(opcompare,true);
  2441. p1:=gen_c_style_operator(slashn,p1,p2);
  2442. end;
  2443. end;
  2444. { get the resulttype for this expression }
  2445. if not assigned(p1.resulttype.def) then
  2446. do_resulttypepass(p1);
  2447. afterassignment:=oldafterassignment;
  2448. if p1<>oldp1 then
  2449. p1.fileinfo:=filepos;
  2450. expr:=p1;
  2451. end;
  2452. {$ifdef int64funcresok}
  2453. function get_intconst:TConstExprInt;
  2454. {$else int64funcresok}
  2455. function get_intconst:longint;
  2456. {$endif int64funcresok}
  2457. {Reads an expression, tries to evalute it and check if it is an integer
  2458. constant. Then the constant is returned.}
  2459. var
  2460. p:tnode;
  2461. begin
  2462. result:=0;
  2463. p:=comp_expr(true);
  2464. if not codegenerror then
  2465. begin
  2466. if (p.nodetype<>ordconstn) or
  2467. not(is_integer(p.resulttype.def)) then
  2468. Message(parser_e_illegal_expression)
  2469. else
  2470. result:=tordconstnode(p).value;
  2471. end;
  2472. p.free;
  2473. end;
  2474. function get_stringconst:string;
  2475. {Reads an expression, tries to evaluate it and checks if it is a string
  2476. constant. Then the constant is returned.}
  2477. var
  2478. p:tnode;
  2479. begin
  2480. get_stringconst:='';
  2481. p:=comp_expr(true);
  2482. if p.nodetype<>stringconstn then
  2483. begin
  2484. if (p.nodetype=ordconstn) and is_char(p.resulttype.def) then
  2485. get_stringconst:=char(tordconstnode(p).value)
  2486. else
  2487. Message(parser_e_illegal_expression);
  2488. end
  2489. else
  2490. get_stringconst:=strpas(tstringconstnode(p).value_str);
  2491. p.free;
  2492. end;
  2493. end.