pexpr.pas 136 KB

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