pexpr.pas 200 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956
  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,compinnr,
  23. tokens,globtype,globals,constexp,
  24. pgentype;
  25. type
  26. texprflag = (
  27. ef_accept_equal,
  28. ef_type_only,
  29. ef_had_specialize,
  30. ef_check_attr_suffix
  31. );
  32. texprflags = set of texprflag;
  33. { reads a whole expression }
  34. function expr(dotypecheck:boolean) : tnode;
  35. { reads an expression without assignements and .. }
  36. function comp_expr(flags:texprflags):tnode;
  37. { reads a single factor }
  38. function factor(getaddr:boolean;flags:texprflags) : tnode;
  39. procedure string_dec(var def: tdef; allowtypedef: boolean);
  40. function parse_paras(__colon,__namedpara : boolean;end_of_paras : ttoken) : tnode;
  41. { the ID token has to be consumed before calling this function }
  42. procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
  43. function get_intconst:TConstExprInt;
  44. function get_stringconst:string;
  45. { Does some postprocessing for a generic type (especially when nested types
  46. of the specialization are used) }
  47. procedure post_comp_expr_gendef(var def: tdef);
  48. implementation
  49. uses
  50. { common }
  51. cutils,cclasses,
  52. { global }
  53. verbose,
  54. systems,widestr,
  55. { symtable }
  56. symconst,symtable,symsym,symcpu,defutil,defcmp,
  57. { module }
  58. fmodule,ppu,
  59. { pass 1 }
  60. pass_1,
  61. nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
  62. { parser }
  63. scanner,
  64. pbase,pinline,ptype,pgenutil,psub,procinfo,cpuinfo
  65. ;
  66. function sub_expr(pred_level:Toperator_precedence;flags:texprflags;factornode:tnode):tnode;forward;
  67. const
  68. { true, if the inherited call is anonymous }
  69. anon_inherited : boolean = false;
  70. { last def found, only used by anon. inherited calls to insert proper type casts }
  71. srdef : tdef = nil;
  72. procedure string_dec(var def:tdef; allowtypedef: boolean);
  73. { reads a string type with optional length }
  74. { and returns a pointer to the string }
  75. { definition }
  76. var
  77. p : tnode;
  78. begin
  79. def:=cshortstringtype;
  80. consume(_STRING);
  81. if token=_LECKKLAMMER then
  82. begin
  83. if not(allowtypedef) then
  84. Message(parser_e_no_local_para_def);
  85. consume(_LECKKLAMMER);
  86. p:=comp_expr([ef_accept_equal]);
  87. if not is_constintnode(p) then
  88. begin
  89. Message(parser_e_illegal_expression);
  90. { error recovery }
  91. consume(_RECKKLAMMER);
  92. end
  93. else
  94. begin
  95. { the node is a generic param while parsing a generic def
  96. so disable the range checking for the string }
  97. if parse_generic and
  98. (nf_generic_para in p.flags) then
  99. tordconstnode(p).value:=255;
  100. if tordconstnode(p).value<=0 then
  101. begin
  102. Message(parser_e_invalid_string_size);
  103. tordconstnode(p).value:=255;
  104. end;
  105. if tordconstnode(p).value>255 then
  106. begin
  107. { longstring is currently unsupported (CEC)! }
  108. { t:=cstringdef.createlong(tordconstnode(p).value))}
  109. Message(parser_e_invalid_string_size);
  110. tordconstnode(p).value:=255;
  111. def:=cstringdef.createshort(int64(tordconstnode(p).value),true);
  112. end
  113. else
  114. if tordconstnode(p).value<>255 then
  115. def:=cstringdef.createshort(int64(tordconstnode(p).value),true);
  116. consume(_RECKKLAMMER);
  117. end;
  118. p.free;
  119. end
  120. else
  121. begin
  122. if cs_refcountedstrings in current_settings.localswitches then
  123. begin
  124. if m_default_unicodestring in current_settings.modeswitches then
  125. def:=cunicodestringtype
  126. else
  127. def:=cansistringtype
  128. end
  129. else
  130. def:=cshortstringtype;
  131. end;
  132. end;
  133. function parse_paras(__colon,__namedpara : boolean;end_of_paras : ttoken) : tnode;
  134. var
  135. p1,p2,argname : tnode;
  136. prev_in_args,
  137. old_named_args_allowed : boolean;
  138. begin
  139. if token=end_of_paras then
  140. begin
  141. parse_paras:=nil;
  142. exit;
  143. end;
  144. { save old values }
  145. prev_in_args:=in_args;
  146. old_named_args_allowed:=named_args_allowed;
  147. { set para parsing values }
  148. in_args:=true;
  149. named_args_allowed:=false;
  150. p2:=nil;
  151. repeat
  152. if __namedpara then
  153. begin
  154. if token=_COMMA then
  155. begin
  156. { empty parameter }
  157. p2:=ccallparanode.create(cnothingnode.create,p2);
  158. end
  159. else
  160. begin
  161. named_args_allowed:=true;
  162. p1:=comp_expr([ef_accept_equal]);
  163. named_args_allowed:=false;
  164. if found_arg_name then
  165. begin
  166. argname:=p1;
  167. p1:=comp_expr([ef_accept_equal]);
  168. p2:=ccallparanode.create(p1,p2);
  169. tcallparanode(p2).parametername:=argname;
  170. end
  171. else
  172. p2:=ccallparanode.create(p1,p2);
  173. found_arg_name:=false;
  174. end;
  175. end
  176. else
  177. begin
  178. p1:=comp_expr([ef_accept_equal]);
  179. p2:=ccallparanode.create(p1,p2);
  180. end;
  181. { it's for the str(l:5,s); }
  182. if __colon and (token=_COLON) then
  183. begin
  184. consume(_COLON);
  185. p1:=comp_expr([ef_accept_equal]);
  186. p2:=ccallparanode.create(p1,p2);
  187. include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
  188. if try_to_consume(_COLON) then
  189. begin
  190. p1:=comp_expr([ef_accept_equal]);
  191. p2:=ccallparanode.create(p1,p2);
  192. include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
  193. end
  194. end;
  195. until not try_to_consume(_COMMA);
  196. in_args:=prev_in_args;
  197. named_args_allowed:=old_named_args_allowed;
  198. parse_paras:=p2;
  199. end;
  200. function gen_c_style_operator(ntyp:tnodetype;p1,p2:tnode) : tnode;
  201. var
  202. hdef : tdef;
  203. temp : ttempcreatenode;
  204. newstatement : tstatementnode;
  205. begin
  206. { Properties are not allowed, because the write can
  207. be different from the read }
  208. if (nf_isproperty in p1.flags) then
  209. begin
  210. Message(type_e_variable_id_expected);
  211. { We can continue with the loading,
  212. it'll not create errors. Only the expected
  213. result can be wrong }
  214. end;
  215. if might_have_sideeffects(p1,[]) then
  216. begin
  217. typecheckpass(p1);
  218. result:=internalstatements(newstatement);
  219. hdef:=cpointerdef.getreusable(p1.resultdef);
  220. temp:=ctempcreatenode.create(hdef,sizeof(pint),tt_persistent,false);
  221. addstatement(newstatement,temp);
  222. addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(temp),caddrnode.create_internal(p1)));
  223. addstatement(newstatement,cassignmentnode.create(
  224. cderefnode.create(ctemprefnode.create(temp)),
  225. caddnode.create(ntyp,
  226. cderefnode.create(ctemprefnode.create(temp)),
  227. p2)));
  228. addstatement(newstatement,ctempdeletenode.create(temp));
  229. end
  230. else
  231. result:=cassignmentnode.create(p1,caddnode.create(ntyp,p1.getcopy,p2));
  232. end;
  233. function statement_syssym(l : tinlinenumber) : tnode;
  234. var
  235. p1,p2,paras : tnode;
  236. err,
  237. prev_in_args : boolean;
  238. def : tdef;
  239. exit_procinfo: tprocinfo;
  240. begin
  241. prev_in_args:=in_args;
  242. case l of
  243. in_new_x :
  244. begin
  245. if afterassignment or in_args then
  246. statement_syssym:=new_function
  247. else
  248. statement_syssym:=new_dispose_statement(true);
  249. end;
  250. in_dispose_x :
  251. begin
  252. statement_syssym:=new_dispose_statement(false);
  253. end;
  254. in_ord_x,
  255. in_chr_byte:
  256. begin
  257. consume(_LKLAMMER);
  258. in_args:=true;
  259. p1:=comp_expr([ef_accept_equal]);
  260. consume(_RKLAMMER);
  261. p1:=geninlinenode(l,false,p1);
  262. statement_syssym := p1;
  263. end;
  264. in_exit :
  265. begin
  266. statement_syssym:=nil;
  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([ef_accept_equal]);
  274. consume(_RKLAMMER);
  275. if not assigned(current_procinfo) or
  276. (current_procinfo.procdef.proctypeoption in [potype_constructor,potype_destructor]) or
  277. is_void(current_procinfo.procdef.returndef) then
  278. begin
  279. Message(parser_e_void_function);
  280. { recovery }
  281. p1.free;
  282. p1:=nil;
  283. end;
  284. end
  285. else
  286. p1:=nil;
  287. end
  288. else
  289. begin
  290. { non local exit ? }
  291. if current_procinfo.procdef.procsym.name<>pattern then
  292. begin
  293. exit_procinfo:=current_procinfo.parent;
  294. while assigned(exit_procinfo) do
  295. begin
  296. if exit_procinfo.procdef.procsym.name=pattern then
  297. break;
  298. exit_procinfo:=exit_procinfo.parent;
  299. end;
  300. if assigned(exit_procinfo) then
  301. begin
  302. if not(assigned(exit_procinfo.nestedexitlabel)) then
  303. begin
  304. include(current_procinfo.flags,pi_has_nested_exit);
  305. exclude(current_procinfo.procdef.procoptions,po_inline);
  306. if is_nested_pd(current_procinfo.procdef) then
  307. current_procinfo.set_needs_parentfp(exit_procinfo.procdef.parast.symtablelevel);
  308. exit_procinfo.nestedexitlabel:=clabelsym.create('$nestedexit');
  309. { the compiler is responsible to define this label }
  310. exit_procinfo.nestedexitlabel.defined:=true;
  311. exit_procinfo.nestedexitlabel.used:=true;
  312. exit_procinfo.nestedexitlabel.jumpbuf:=clocalvarsym.create('LABEL$_'+exit_procinfo.nestedexitlabel.name,vs_value,rec_jmp_buf,[]);
  313. exit_procinfo.procdef.localst.insertsym(exit_procinfo.nestedexitlabel);
  314. exit_procinfo.procdef.localst.insertsym(exit_procinfo.nestedexitlabel.jumpbuf);
  315. end;
  316. statement_syssym:=cgotonode.create(exit_procinfo.nestedexitlabel);
  317. tgotonode(statement_syssym).labelsym:=exit_procinfo.nestedexitlabel;
  318. end
  319. else
  320. Message(parser_e_macpas_exit_wrong_param);
  321. end;
  322. consume(_ID);
  323. consume(_RKLAMMER);
  324. p1:=nil;
  325. end
  326. end
  327. else
  328. p1:=nil;
  329. if not assigned(statement_syssym) then
  330. statement_syssym:=cexitnode.create(p1);
  331. end;
  332. in_break :
  333. begin
  334. statement_syssym:=cbreaknode.create
  335. end;
  336. in_continue :
  337. begin
  338. statement_syssym:=ccontinuenode.create
  339. end;
  340. in_leave :
  341. begin
  342. if m_mac in current_settings.modeswitches then
  343. statement_syssym:=cbreaknode.create
  344. else
  345. begin
  346. Message1(sym_e_id_not_found, orgpattern);
  347. statement_syssym:=cerrornode.create;
  348. end;
  349. end;
  350. in_cycle :
  351. begin
  352. if m_mac in current_settings.modeswitches then
  353. statement_syssym:=ccontinuenode.create
  354. else
  355. begin
  356. Message1(sym_e_id_not_found, orgpattern);
  357. statement_syssym:=cerrornode.create;
  358. end;
  359. end;
  360. in_typeof_x :
  361. begin
  362. consume(_LKLAMMER);
  363. in_args:=true;
  364. p1:=comp_expr([ef_accept_equal]);
  365. consume(_RKLAMMER);
  366. if p1.nodetype=typen then
  367. ttypenode(p1).allowed:=true;
  368. { Allow classrefdef, which is required for
  369. Typeof(self) in static class methods }
  370. if not(is_objc_class_or_protocol(p1.resultdef)) and
  371. not(is_java_class_or_interface(p1.resultdef)) and
  372. ((p1.resultdef.typ = objectdef) or
  373. (assigned(current_procinfo) and
  374. ((po_classmethod in current_procinfo.procdef.procoptions) or
  375. (po_staticmethod in current_procinfo.procdef.procoptions)) and
  376. (p1.resultdef.typ=classrefdef))) then
  377. statement_syssym:=geninlinenode(in_typeof_x,false,p1)
  378. else
  379. begin
  380. Message(parser_e_class_id_expected);
  381. p1.destroy;
  382. statement_syssym:=cerrornode.create;
  383. end;
  384. end;
  385. in_sizeof_x,
  386. in_bitsizeof_x :
  387. begin
  388. consume(_LKLAMMER);
  389. in_args:=true;
  390. p1:=comp_expr([ef_accept_equal]);
  391. consume(_RKLAMMER);
  392. if ((p1.nodetype<>typen) and
  393. (
  394. (is_object(p1.resultdef) and
  395. (oo_has_constructor in tobjectdef(p1.resultdef).objectoptions)) or
  396. is_open_array(p1.resultdef) or
  397. is_array_of_const(p1.resultdef) or
  398. is_open_string(p1.resultdef)
  399. )) or
  400. { keep the function call if it is a type parameter to avoid arithmetic errors due to constant folding }
  401. is_typeparam(p1.resultdef) then
  402. begin
  403. statement_syssym:=geninlinenode(in_sizeof_x,false,p1);
  404. { no packed bit support for these things }
  405. if l=in_bitsizeof_x then
  406. statement_syssym:=caddnode.create(muln,statement_syssym,cordconstnode.create(8,sizesinttype,true));
  407. { type sym is a generic parameter }
  408. if assigned(p1.resultdef.typesym) and (sp_generic_para in p1.resultdef.typesym.symoptions) then
  409. include(statement_syssym.flags,nf_generic_para);
  410. end
  411. else
  412. begin
  413. { allow helpers for SizeOf and BitSizeOf }
  414. if p1.nodetype=typen then
  415. ttypenode(p1).helperallowed:=true;
  416. if (p1.resultdef.typ=forwarddef) then
  417. Message1(type_e_type_is_not_completly_defined,tforwarddef(p1.resultdef).tosymname^);
  418. if (l = in_sizeof_x) or
  419. (not((p1.nodetype = vecn) and
  420. is_packed_array(tvecnode(p1).left.resultdef)) and
  421. not((p1.nodetype = subscriptn) and
  422. is_packed_record_or_object(tsubscriptnode(p1).left.resultdef))) then
  423. begin
  424. statement_syssym:=genintconstnode(p1.resultdef.size,sizesinttype);
  425. if (l = in_bitsizeof_x) then
  426. statement_syssym:=caddnode.create(muln,statement_syssym,cordconstnode.create(8,sizesinttype,true));
  427. end
  428. else
  429. statement_syssym:=genintconstnode(p1.resultdef.packedbitsize,sizesinttype);
  430. { type def is a struct with generic fields }
  431. if df_has_generic_fields in p1.resultdef.defoptions then
  432. include(statement_syssym.flags,nf_generic_para);
  433. { p1 not needed !}
  434. p1.destroy;
  435. end;
  436. end;
  437. in_typeinfo_x,
  438. in_objc_encode_x,
  439. in_gettypekind_x,
  440. in_ismanagedtype_x:
  441. begin
  442. if (l in [in_typeinfo_x,in_gettypekind_x,in_ismanagedtype_x]) or
  443. (m_objectivec1 in current_settings.modeswitches) then
  444. begin
  445. consume(_LKLAMMER);
  446. in_args:=true;
  447. p1:=comp_expr([ef_accept_equal]);
  448. { When reading a class type it is parsed as loadvmtaddrn,
  449. typeinfo only needs the type so we remove the loadvmtaddrn }
  450. if p1.nodetype=loadvmtaddrn then
  451. begin
  452. p2:=tloadvmtaddrnode(p1).left;
  453. tloadvmtaddrnode(p1).left:=nil;
  454. p1.free;
  455. p1:=p2;
  456. end;
  457. if p1.nodetype=typen then
  458. begin
  459. ttypenode(p1).allowed:=true;
  460. { allow helpers for TypeInfo }
  461. if l in [in_typeinfo_x,in_gettypekind_x,in_ismanagedtype_x] then
  462. ttypenode(p1).helperallowed:=true;
  463. end;
  464. { else
  465. begin
  466. p1.destroy;
  467. p1:=cerrornode.create;
  468. Message(parser_e_illegal_parameter_list);
  469. end;}
  470. consume(_RKLAMMER);
  471. p2:=geninlinenode(l,false,p1);
  472. statement_syssym:=p2;
  473. end
  474. else
  475. begin
  476. Message1(sym_e_id_not_found, orgpattern);
  477. statement_syssym:=cerrornode.create;
  478. end;
  479. end;
  480. in_isconstvalue_x:
  481. begin
  482. consume(_LKLAMMER);
  483. in_args:=true;
  484. p1:=comp_expr([ef_accept_equal]);
  485. consume(_RKLAMMER);
  486. p2:=geninlinenode(l,false,p1);
  487. statement_syssym:=p2;
  488. end;
  489. in_aligned_x,
  490. in_unaligned_x,
  491. in_volatile_x:
  492. begin
  493. err:=false;
  494. consume(_LKLAMMER);
  495. in_args:=true;
  496. p1:=comp_expr([ef_accept_equal]);
  497. p2:=ccallparanode.create(p1,nil);
  498. p2:=geninlinenode(l,false,p2);
  499. consume(_RKLAMMER);
  500. statement_syssym:=p2;
  501. end;
  502. in_assigned_x :
  503. begin
  504. err:=false;
  505. consume(_LKLAMMER);
  506. in_args:=true;
  507. p1:=comp_expr([ef_accept_equal]);
  508. { When reading a class type it is parsed as loadvmtaddrn,
  509. typeinfo only needs the type so we remove the loadvmtaddrn }
  510. if p1.nodetype=loadvmtaddrn then
  511. begin
  512. p2:=tloadvmtaddrnode(p1).left;
  513. tloadvmtaddrnode(p1).left:=nil;
  514. p1.free;
  515. p1:=p2;
  516. end;
  517. if not codegenerror then
  518. begin
  519. case p1.resultdef.typ of
  520. procdef, { procvar }
  521. pointerdef,
  522. procvardef,
  523. classrefdef : ;
  524. objectdef :
  525. if not is_implicit_pointer_object_type(p1.resultdef) then
  526. begin
  527. Message(parser_e_illegal_parameter_list);
  528. err:=true;
  529. end;
  530. arraydef :
  531. if not is_dynamic_array(p1.resultdef) then
  532. begin
  533. Message(parser_e_illegal_parameter_list);
  534. err:=true;
  535. end;
  536. else
  537. if p1.resultdef.typ<>undefineddef then
  538. begin
  539. Message(parser_e_illegal_parameter_list);
  540. err:=true;
  541. end;
  542. end;
  543. end
  544. else
  545. err:=true;
  546. if not err then
  547. begin
  548. p2:=ccallparanode.create(p1,nil);
  549. p2:=geninlinenode(in_assigned_x,false,p2);
  550. end
  551. else
  552. begin
  553. p1.free;
  554. p2:=cerrornode.create;
  555. end;
  556. consume(_RKLAMMER);
  557. statement_syssym:=p2;
  558. end;
  559. in_addr_x :
  560. begin
  561. consume(_LKLAMMER);
  562. got_addrn:=true;
  563. p1:=factor(true,[]);
  564. { inside parentheses a full expression is allowed, see also tests\webtbs\tb27517.pp }
  565. if token<>_RKLAMMER then
  566. p1:=sub_expr(opcompare,[ef_accept_equal],p1);
  567. p1:=caddrnode.create(p1);
  568. got_addrn:=false;
  569. consume(_RKLAMMER);
  570. statement_syssym:=p1;
  571. end;
  572. {$ifdef i8086}
  573. in_faraddr_x :
  574. begin
  575. consume(_LKLAMMER);
  576. got_addrn:=true;
  577. p1:=factor(true,[]);
  578. { inside parentheses a full expression is allowed, see also tests\webtbs\tb27517.pp }
  579. if token<>_RKLAMMER then
  580. p1:=sub_expr(opcompare,[ef_accept_equal],p1);
  581. p1:=geninlinenode(in_faraddr_x,false,p1);
  582. got_addrn:=false;
  583. consume(_RKLAMMER);
  584. statement_syssym:=p1;
  585. end;
  586. {$endif i8086}
  587. in_ofs_x :
  588. begin
  589. if target_info.system in systems_managed_vm then
  590. message(parser_e_feature_unsupported_for_vm);
  591. consume(_LKLAMMER);
  592. got_addrn:=true;
  593. p1:=factor(true,[]);
  594. { inside parentheses a full expression is allowed, see also tests\webtbs\tb27517.pp }
  595. if token<>_RKLAMMER then
  596. p1:=sub_expr(opcompare,[ef_accept_equal],p1);
  597. p1:=caddrnode.create(p1);
  598. include(taddrnode(p1).addrnodeflags,anf_ofs);
  599. got_addrn:=false;
  600. { Ofs() returns a cardinal/qword, not a pointer }
  601. inserttypeconv_internal(p1,uinttype);
  602. consume(_RKLAMMER);
  603. statement_syssym:=p1;
  604. end;
  605. in_seg_x :
  606. begin
  607. consume(_LKLAMMER);
  608. got_addrn:=true;
  609. p1:=factor(true,[]);
  610. { inside parentheses a full expression is allowed, see also tests\webtbs\tb27517.pp }
  611. if token<>_RKLAMMER then
  612. p1:=sub_expr(opcompare,[ef_accept_equal],p1);
  613. p1:=geninlinenode(in_seg_x,false,p1);
  614. got_addrn:=false;
  615. consume(_RKLAMMER);
  616. statement_syssym:=p1;
  617. end;
  618. in_high_x,
  619. in_low_x :
  620. begin
  621. consume(_LKLAMMER);
  622. in_args:=true;
  623. p1:=comp_expr([ef_accept_equal]);
  624. p2:=geninlinenode(l,false,p1);
  625. consume(_RKLAMMER);
  626. statement_syssym:=p2;
  627. end;
  628. in_succ_x,
  629. in_pred_x :
  630. begin
  631. consume(_LKLAMMER);
  632. in_args:=true;
  633. p1:=comp_expr([ef_accept_equal]);
  634. p2:=geninlinenode(l,false,p1);
  635. consume(_RKLAMMER);
  636. statement_syssym:=p2;
  637. end;
  638. in_inc_x,
  639. in_dec_x :
  640. begin
  641. consume(_LKLAMMER);
  642. in_args:=true;
  643. p1:=comp_expr([ef_accept_equal]);
  644. if try_to_consume(_COMMA) then
  645. p2:=ccallparanode.create(comp_expr([ef_accept_equal]),nil)
  646. else
  647. p2:=nil;
  648. p2:=ccallparanode.create(p1,p2);
  649. statement_syssym:=geninlinenode(l,false,p2);
  650. consume(_RKLAMMER);
  651. end;
  652. in_slice_x:
  653. begin
  654. if not(in_args) then
  655. begin
  656. message(parser_e_illegal_slice);
  657. consume(_LKLAMMER);
  658. in_args:=true;
  659. comp_expr([ef_accept_equal]).free;
  660. if try_to_consume(_COMMA) then
  661. comp_expr([ef_accept_equal]).free;
  662. statement_syssym:=cerrornode.create;
  663. consume(_RKLAMMER);
  664. end
  665. else
  666. begin
  667. consume(_LKLAMMER);
  668. in_args:=true;
  669. p1:=comp_expr([ef_accept_equal]);
  670. Consume(_COMMA);
  671. if not(codegenerror) then
  672. p2:=ccallparanode.create(comp_expr([ef_accept_equal]),nil)
  673. else
  674. p2:=cerrornode.create;
  675. p2:=ccallparanode.create(p1,p2);
  676. statement_syssym:=geninlinenode(l,false,p2);
  677. consume(_RKLAMMER);
  678. end;
  679. end;
  680. in_initialize_x:
  681. begin
  682. statement_syssym:=inline_initialize;
  683. end;
  684. in_finalize_x:
  685. begin
  686. statement_syssym:=inline_finalize;
  687. end;
  688. in_copy_x:
  689. begin
  690. statement_syssym:=inline_copy;
  691. end;
  692. in_concat_x :
  693. begin
  694. statement_syssym:=inline_concat;
  695. end;
  696. in_read_x,
  697. in_readln_x,
  698. in_readstr_x:
  699. begin
  700. if try_to_consume(_LKLAMMER) then
  701. begin
  702. paras:=parse_paras(false,false,_RKLAMMER);
  703. consume(_RKLAMMER);
  704. end
  705. else
  706. paras:=nil;
  707. p1:=geninlinenode(l,false,paras);
  708. statement_syssym := p1;
  709. end;
  710. in_setlength_x:
  711. begin
  712. statement_syssym := inline_setlength;
  713. end;
  714. in_objc_selector_x:
  715. begin
  716. if (m_objectivec1 in current_settings.modeswitches) then
  717. begin
  718. consume(_LKLAMMER);
  719. in_args:=true;
  720. { don't turn procsyms into calls (getaddr = true) }
  721. p1:=factor(true,[]);
  722. p2:=geninlinenode(l,false,p1);
  723. consume(_RKLAMMER);
  724. statement_syssym:=p2;
  725. end
  726. else
  727. begin
  728. Message1(sym_e_id_not_found, orgpattern);
  729. statement_syssym:=cerrornode.create;
  730. end;
  731. end;
  732. in_length_x:
  733. begin
  734. consume(_LKLAMMER);
  735. in_args:=true;
  736. p1:=comp_expr([ef_accept_equal]);
  737. p2:=geninlinenode(l,false,p1);
  738. consume(_RKLAMMER);
  739. statement_syssym:=p2;
  740. end;
  741. in_write_x,
  742. in_writeln_x,
  743. in_writestr_x :
  744. begin
  745. if try_to_consume(_LKLAMMER) then
  746. begin
  747. paras:=parse_paras(true,false,_RKLAMMER);
  748. consume(_RKLAMMER);
  749. end
  750. else
  751. paras:=nil;
  752. p1 := geninlinenode(l,false,paras);
  753. statement_syssym := p1;
  754. end;
  755. in_str_x_string :
  756. begin
  757. consume(_LKLAMMER);
  758. paras:=parse_paras(true,false,_RKLAMMER);
  759. consume(_RKLAMMER);
  760. p1 := geninlinenode(l,false,paras);
  761. statement_syssym := p1;
  762. end;
  763. in_val_x:
  764. Begin
  765. consume(_LKLAMMER);
  766. in_args := true;
  767. p1:= ccallparanode.create(comp_expr([ef_accept_equal]), nil);
  768. consume(_COMMA);
  769. p2 := ccallparanode.create(comp_expr([ef_accept_equal]),p1);
  770. if try_to_consume(_COMMA) then
  771. p2 := ccallparanode.create(comp_expr([ef_accept_equal]),p2);
  772. consume(_RKLAMMER);
  773. p2 := geninlinenode(l,false,p2);
  774. statement_syssym := p2;
  775. End;
  776. in_include_x_y,
  777. in_exclude_x_y :
  778. begin
  779. consume(_LKLAMMER);
  780. in_args:=true;
  781. p1:=comp_expr([ef_accept_equal]);
  782. consume(_COMMA);
  783. p2:=comp_expr([ef_accept_equal]);
  784. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
  785. consume(_RKLAMMER);
  786. end;
  787. in_pack_x_y_z,
  788. in_unpack_x_y_z :
  789. begin
  790. consume(_LKLAMMER);
  791. in_args:=true;
  792. p1:=comp_expr([ef_accept_equal]);
  793. consume(_COMMA);
  794. p2:=comp_expr([ef_accept_equal]);
  795. consume(_COMMA);
  796. paras:=comp_expr([ef_accept_equal]);
  797. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,ccallparanode.create(paras,nil))));
  798. consume(_RKLAMMER);
  799. end;
  800. in_assert_x_y :
  801. begin
  802. consume(_LKLAMMER);
  803. in_args:=true;
  804. p1:=comp_expr([ef_accept_equal]);
  805. if try_to_consume(_COMMA) then
  806. p2:=comp_expr([ef_accept_equal])
  807. else
  808. begin
  809. { then insert an empty string }
  810. p2:=cstringconstnode.createstr('');
  811. end;
  812. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
  813. consume(_RKLAMMER);
  814. end;
  815. in_get_frame:
  816. begin
  817. statement_syssym:=geninlinenode(l,false,nil);
  818. end;
  819. (*
  820. in_get_caller_frame:
  821. begin
  822. if try_to_consume(_LKLAMMER) then
  823. begin
  824. {You used to call get_caller_frame as get_caller_frame(get_frame),
  825. however, as a stack frame may not exist, it does more harm than
  826. good, so ignore it.}
  827. in_args:=true;
  828. p1:=comp_expr([ef_accept_equal]);
  829. p1.destroy;
  830. consume(_RKLAMMER);
  831. end;
  832. statement_syssym:=geninlinenode(l,false,nil);
  833. end;
  834. *)
  835. in_default_x:
  836. begin
  837. consume(_LKLAMMER);
  838. in_args:=true;
  839. def:=nil;
  840. single_type(def,[stoAllowSpecialization]);
  841. statement_syssym:=cerrornode.create;
  842. if def<>generrordef then
  843. { "type expected" error is already done by single_type }
  844. if def.typ=forwarddef then
  845. Message1(type_e_type_is_not_completly_defined,tforwarddef(def).tosymname^)
  846. else
  847. begin
  848. statement_syssym.free;
  849. statement_syssym:=geninlinenode(in_default_x,false,ctypenode.create(def));
  850. end;
  851. { consume the right bracket here for a nicer error position }
  852. consume(_RKLAMMER);
  853. end;
  854. in_setstring_x_y_z:
  855. begin
  856. statement_syssym := inline_setstring;
  857. end;
  858. in_delete_x_y_z:
  859. begin
  860. statement_syssym:=inline_delete;
  861. end;
  862. in_insert_x_y_z:
  863. begin
  864. statement_syssym:=inline_insert;
  865. end;
  866. in_const_eh_return_data_regno:
  867. begin
  868. consume(_LKLAMMER);
  869. in_args:=true;
  870. p1:=comp_expr([ef_accept_equal]);
  871. p2:=geninlinenode(l,true,p1);
  872. consume(_RKLAMMER);
  873. statement_syssym:=p2;
  874. end;
  875. else
  876. internalerror(15);
  877. end;
  878. in_args:=prev_in_args;
  879. end;
  880. function maybe_load_methodpointer(st:TSymtable;var p1:tnode):boolean;
  881. var
  882. pd: tprocdef;
  883. begin
  884. maybe_load_methodpointer:=false;
  885. if not assigned(p1) then
  886. begin
  887. case st.symtabletype of
  888. withsymtable :
  889. begin
  890. if (st.defowner.typ=objectdef) then
  891. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  892. end;
  893. ObjectSymtable,
  894. recordsymtable:
  895. begin
  896. { Escape nested procedures }
  897. if assigned(current_procinfo) then
  898. begin
  899. pd:=current_procinfo.get_normal_proc.procdef;
  900. { We are calling from the static class method which has no self node }
  901. if assigned(pd) and pd.no_self_node then
  902. if st.symtabletype=recordsymtable then
  903. p1:=ctypenode.create(pd.struct)
  904. else
  905. p1:=cloadvmtaddrnode.create(ctypenode.create(pd.struct))
  906. else
  907. p1:=load_self_node;
  908. end
  909. else
  910. p1:=load_self_node;
  911. { don't try to call the invokable again }
  912. if is_invokable(tdef(st.defowner)) then
  913. include(p1.flags,nf_load_procvar);
  914. { We are calling a member }
  915. maybe_load_methodpointer:=true;
  916. end;
  917. else
  918. ;
  919. end;
  920. end;
  921. end;
  922. { reads the parameter for a subroutine call }
  923. procedure do_proc_call(sym:tsym;st:TSymtable;obj:tabstractrecorddef;getaddr:boolean;var again : boolean;var p1:tnode;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
  924. var
  925. membercall,
  926. prevafterassn : boolean;
  927. i : integer;
  928. para,p2 : tnode;
  929. currpara : tparavarsym;
  930. aprocdef : tprocdef;
  931. begin
  932. prevafterassn:=afterassignment;
  933. afterassignment:=false;
  934. membercall:=false;
  935. aprocdef:=nil;
  936. { when it is a call to a member we need to load the
  937. methodpointer first
  938. }
  939. membercall:=maybe_load_methodpointer(st,p1);
  940. { When we are expecting a procvar we also need
  941. to get the address in some cases }
  942. if assigned(getprocvardef) or assigned(getfuncrefdef) then
  943. begin
  944. if (block_type=bt_const) or
  945. getaddr then
  946. begin
  947. if assigned(getfuncrefdef) then
  948. aprocdef:=Tprocsym(sym).Find_procdef_byfuncrefdef(getfuncrefdef)
  949. else
  950. aprocdef:=Tprocsym(sym).Find_procdef_byprocvardef(getprocvardef);
  951. getaddr:=true;
  952. end
  953. else
  954. if ((m_tp_procvar in current_settings.modeswitches) or
  955. (m_mac_procvar in current_settings.modeswitches)) and
  956. not(token in [_CARET,_POINT,_LKLAMMER]) then
  957. begin
  958. if assigned(getfuncrefdef) then
  959. aprocdef:=Tprocsym(sym).Find_procdef_byfuncrefdef(getfuncrefdef)
  960. else
  961. aprocdef:=Tprocsym(sym).Find_procdef_byprocvardef(getprocvardef);
  962. if assigned(aprocdef) then
  963. getaddr:=true;
  964. end;
  965. end;
  966. { only need to get the address of the procedure? Check token because
  967. in the case of opening parenthesis is possible to get pointer to
  968. function result (lack of checking for token was the reason of
  969. tw10933.pp test failure) }
  970. if getaddr and (token<>_LKLAMMER) then
  971. begin
  972. { for now we don't support pointers to generic functions, but since
  973. this is only temporary we use a non translated message }
  974. if assigned(spezcontext) then
  975. begin
  976. comment(v_error, 'Pointers to generics functions not implemented');
  977. p1:=cerrornode.create;
  978. spezcontext.free;
  979. exit;
  980. end;
  981. { Retrieve info which procvar to call. For tp_procvar the
  982. aprocdef is already loaded above so we can reuse it }
  983. if not assigned(aprocdef) and
  984. assigned(getprocvardef) then
  985. aprocdef:=Tprocsym(sym).Find_procdef_byprocvardef(getprocvardef);
  986. if not assigned(aprocdef) and
  987. assigned(getfuncrefdef) then
  988. aprocdef:=Tprocsym(sym).Find_procdef_byfuncrefdef(getfuncrefdef);
  989. { generate a methodcallnode or proccallnode }
  990. { we shouldn't convert things like @tcollection.load }
  991. p2:=cloadnode.create_procvar(sym,aprocdef,st);
  992. if assigned(p1) then
  993. begin
  994. { for loading methodpointer of an inherited function
  995. we use self as instance and load the address of
  996. the function directly and not through the vmt (PFV) }
  997. if (cnf_inherited in callflags) then
  998. begin
  999. include(tloadnode(p2).loadnodeflags,loadnf_inherited);
  1000. p1.free;
  1001. p1:=load_self_node;
  1002. end;
  1003. if (p1.nodetype<>typen) then
  1004. tloadnode(p2).set_mp(p1)
  1005. else
  1006. begin
  1007. typecheckpass(p1);
  1008. if (p1.resultdef.typ=classrefdef) and
  1009. (
  1010. assigned(getprocvardef) or
  1011. assigned(getfuncrefdef)
  1012. ) then
  1013. begin
  1014. p1:=cloadvmtaddrnode.create(p1);
  1015. tloadnode(p2).set_mp(p1);
  1016. end
  1017. else if (p1.resultdef.typ=objectdef) then
  1018. { so we can create the correct method pointer again in case
  1019. this is a "objectprocvar:[email protected]" expression }
  1020. tloadnode(p2).symtable:=tobjectdef(p1.resultdef).symtable
  1021. else
  1022. p1.free;
  1023. end;
  1024. end;
  1025. p1:=p2;
  1026. { no postfix operators }
  1027. again:=false;
  1028. end
  1029. else
  1030. begin
  1031. para:=nil;
  1032. if anon_inherited then
  1033. begin
  1034. if not assigned(current_procinfo) then
  1035. internalerror(200305054);
  1036. for i:=0 to current_procinfo.procdef.paras.count-1 do
  1037. begin
  1038. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  1039. if not(vo_is_hidden_para in currpara.varoptions) then
  1040. begin
  1041. { inheritance by msgint? }
  1042. if assigned(srdef) then
  1043. { anonymous inherited via msgid calls only require a var parameter for
  1044. both methods, so we need some type casting here }
  1045. para:=ccallparanode.create(ctypeconvnode.create_internal(ctypeconvnode.create_internal(
  1046. cloadnode.create(currpara,currpara.owner),cformaltype),tparavarsym(tprocdef(srdef).paras[i]).vardef),
  1047. para)
  1048. else
  1049. para:=ccallparanode.create(cloadnode.create(currpara,currpara.owner),para);
  1050. end;
  1051. end;
  1052. end
  1053. else
  1054. begin
  1055. if try_to_consume(_LKLAMMER) then
  1056. begin
  1057. para:=parse_paras(false,false,_RKLAMMER);
  1058. consume(_RKLAMMER);
  1059. end;
  1060. end;
  1061. { indicate if this call was generated by a member and
  1062. no explicit self is used, this is needed to determine
  1063. how to handle a destructor call (PFV) }
  1064. if membercall then
  1065. include(callflags,cnf_member_call);
  1066. if assigned(obj) then
  1067. begin
  1068. if not (st.symtabletype in [ObjectSymtable,recordsymtable]) then
  1069. internalerror(200310031);
  1070. p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1,callflags,spezcontext);
  1071. end
  1072. else
  1073. p1:=ccallnode.create(para,tprocsym(sym),st,p1,callflags,spezcontext);
  1074. end;
  1075. afterassignment:=prevafterassn;
  1076. end;
  1077. procedure handle_procvar(pv : tprocvardef;var p2 : tnode);
  1078. var
  1079. hp,hp2 : tnode;
  1080. hpp : ^tnode;
  1081. currprocdef : tprocdef;
  1082. begin
  1083. if not assigned(pv) then
  1084. internalerror(200301121);
  1085. if (m_tp_procvar in current_settings.modeswitches) or
  1086. (m_mac_procvar in current_settings.modeswitches) then
  1087. begin
  1088. hp:=p2;
  1089. hpp:=@p2;
  1090. while assigned(hp) and
  1091. (hp.nodetype=typeconvn) do
  1092. begin
  1093. hp:=ttypeconvnode(hp).left;
  1094. { save orignal address of the old tree so we can replace the node }
  1095. hpp:=@hp;
  1096. end;
  1097. if (hp.nodetype=calln) and
  1098. { a procvar can't have parameters! }
  1099. not assigned(tcallnode(hp).left) then
  1100. begin
  1101. currprocdef:=tcallnode(hp).symtableprocentry.Find_procdef_byprocvardef(pv);
  1102. if assigned(currprocdef) then
  1103. begin
  1104. hp2:=cloadnode.create_procvar(tprocsym(tcallnode(hp).symtableprocentry),currprocdef,tcallnode(hp).symtableproc);
  1105. if (po_methodpointer in pv.procoptions) then
  1106. tloadnode(hp2).set_mp(tcallnode(hp).methodpointer.getcopy);
  1107. hp.free;
  1108. { replace the old callnode with the new loadnode }
  1109. hpp^:=hp2;
  1110. end;
  1111. end;
  1112. end;
  1113. end;
  1114. procedure handle_funcref(fr:tobjectdef;var p2:tnode);
  1115. var
  1116. hp,hp2 : tnode;
  1117. hpp : ^tnode;
  1118. currprocdef : tprocdef;
  1119. begin
  1120. if not assigned(fr) then
  1121. internalerror(2022032401);
  1122. if not is_invokable(fr) then
  1123. internalerror(2022032402);
  1124. if (m_tp_procvar in current_settings.modeswitches) or
  1125. (m_mac_procvar in current_settings.modeswitches) then
  1126. begin
  1127. hp:=p2;
  1128. hpp:=@p2;
  1129. while assigned(hp) and
  1130. (hp.nodetype=typeconvn) do
  1131. begin
  1132. hp:=ttypeconvnode(hp).left;
  1133. { save orignal address of the old tree so we can replace the node }
  1134. hpp:=@hp;
  1135. end;
  1136. if (hp.nodetype=calln) and
  1137. { a procvar can't have parameters! }
  1138. not assigned(tcallnode(hp).left) then
  1139. begin
  1140. currprocdef:=tcallnode(hp).symtableprocentry.Find_procdef_byfuncrefdef(fr);
  1141. if assigned(currprocdef) then
  1142. begin
  1143. hp2:=cloadnode.create_procvar(tprocsym(tcallnode(hp).symtableprocentry),currprocdef,tcallnode(hp).symtableproc);
  1144. hp.free;
  1145. { replace the old callnode with the new loadnode }
  1146. hpp^:=hp2;
  1147. end;
  1148. end;
  1149. end;
  1150. end;
  1151. { the following procedure handles the access to a property symbol }
  1152. procedure handle_propertysym(propsym : tpropertysym;st : TSymtable;var p1 : tnode);
  1153. var
  1154. paras : tnode;
  1155. p2 : tnode;
  1156. membercall : boolean;
  1157. callflags : tcallnodeflags;
  1158. propaccesslist : tpropaccesslist;
  1159. sym: tsym;
  1160. begin
  1161. { property parameters? read them only if the property really }
  1162. { has parameters }
  1163. paras:=nil;
  1164. if (ppo_hasparameters in propsym.propoptions) then
  1165. begin
  1166. if try_to_consume(_LECKKLAMMER) then
  1167. begin
  1168. paras:=parse_paras(false,false,_RECKKLAMMER);
  1169. consume(_RECKKLAMMER);
  1170. end;
  1171. end;
  1172. { indexed property }
  1173. if (ppo_indexed in propsym.propoptions) then
  1174. begin
  1175. p2:=cordconstnode.create(propsym.index,propsym.indexdef,true);
  1176. paras:=ccallparanode.create(p2,paras);
  1177. end;
  1178. { we need only a write property if a := follows }
  1179. { if not(afterassignment) and not(in_args) then }
  1180. if token=_ASSIGNMENT then
  1181. begin
  1182. if propsym.getpropaccesslist(palt_write,propaccesslist) then
  1183. begin
  1184. sym:=propaccesslist.firstsym^.sym;
  1185. case sym.typ of
  1186. procsym :
  1187. begin
  1188. callflags:=[];
  1189. { generate the method call }
  1190. membercall:=maybe_load_methodpointer(st,p1);
  1191. if membercall then
  1192. include(callflags,cnf_member_call);
  1193. p1:=ccallnode.create(paras,tprocsym(sym),st,p1,callflags,nil);
  1194. addsymref(sym);
  1195. paras:=nil;
  1196. consume(_ASSIGNMENT);
  1197. { read the expression }
  1198. if propsym.propdef.typ=procvardef then
  1199. getprocvardef:=tprocvardef(propsym.propdef)
  1200. else if is_invokable(propsym.propdef) then
  1201. getfuncrefdef:=tobjectdef(propsym.propdef);
  1202. p2:=comp_expr([ef_accept_equal]);
  1203. if assigned(getprocvardef) then
  1204. handle_procvar(getprocvardef,p2)
  1205. else if assigned(getfuncrefdef) then
  1206. handle_funcref(getfuncrefdef,p2);
  1207. tcallnode(p1).left:=ccallparanode.create(p2,tcallnode(p1).left);
  1208. { mark as property, both the tcallnode and the real call block }
  1209. include(p1.flags,nf_isproperty);
  1210. getprocvardef:=nil;
  1211. getfuncrefdef:=nil;
  1212. end;
  1213. fieldvarsym :
  1214. begin
  1215. { generate access code }
  1216. if not handle_staticfield_access(sym,p1) then
  1217. propaccesslist_to_node(p1,st,propaccesslist);
  1218. include(p1.flags,nf_isproperty);
  1219. consume(_ASSIGNMENT);
  1220. { read the expression }
  1221. p2:=comp_expr([ef_accept_equal]);
  1222. p1:=cassignmentnode.create(p1,p2);
  1223. end
  1224. else
  1225. begin
  1226. p1:=cerrornode.create;
  1227. Message(parser_e_no_procedure_to_access_property);
  1228. end;
  1229. end;
  1230. end
  1231. else
  1232. begin
  1233. p1:=cerrornode.create;
  1234. Message(parser_e_no_procedure_to_access_property);
  1235. end;
  1236. end
  1237. else
  1238. begin
  1239. if propsym.getpropaccesslist(palt_read,propaccesslist) then
  1240. begin
  1241. sym := propaccesslist.firstsym^.sym;
  1242. case sym.typ of
  1243. fieldvarsym :
  1244. begin
  1245. { generate access code }
  1246. if not handle_staticfield_access(sym,p1) then
  1247. propaccesslist_to_node(p1,st,propaccesslist);
  1248. include(p1.flags,nf_isproperty);
  1249. { catch expressions like "(propx):=1;" }
  1250. include(p1.flags,nf_no_lvalue);
  1251. end;
  1252. procsym :
  1253. begin
  1254. callflags:=[];
  1255. { generate the method call }
  1256. membercall:=maybe_load_methodpointer(st,p1);
  1257. if membercall then
  1258. include(callflags,cnf_member_call);
  1259. p1:=ccallnode.create(paras,tprocsym(sym),st,p1,callflags,nil);
  1260. paras:=nil;
  1261. include(p1.flags,nf_isproperty);
  1262. include(p1.flags,nf_no_lvalue);
  1263. end
  1264. else
  1265. begin
  1266. p1:=cerrornode.create;
  1267. Message(type_e_mismatch);
  1268. end;
  1269. end;
  1270. end
  1271. else
  1272. begin
  1273. { error, no function to read property }
  1274. p1:=cerrornode.create;
  1275. Message(parser_e_no_procedure_to_access_property);
  1276. end;
  1277. end;
  1278. { release paras if not used }
  1279. if assigned(paras) then
  1280. paras.free;
  1281. end;
  1282. { the ID token has to be consumed before calling this function }
  1283. procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
  1284. var
  1285. isclassref:boolean;
  1286. isrecordtype:boolean;
  1287. isobjecttype:boolean;
  1288. ishelpertype:boolean;
  1289. begin
  1290. if sym=nil then
  1291. begin
  1292. { pattern is still valid unless
  1293. there is another ID just after the ID of sym }
  1294. Message1(sym_e_id_no_member,orgpattern);
  1295. p1.free;
  1296. p1:=cerrornode.create;
  1297. { try to clean up }
  1298. spezcontext.free;
  1299. again:=false;
  1300. end
  1301. else
  1302. begin
  1303. if assigned(p1) then
  1304. begin
  1305. if not assigned(p1.resultdef) then
  1306. do_typecheckpass(p1);
  1307. isclassref:=(p1.resultdef.typ=classrefdef);
  1308. isrecordtype:=(p1.nodetype=typen) and (p1.resultdef.typ=recorddef);
  1309. isobjecttype:=(p1.nodetype=typen) and is_object(p1.resultdef);
  1310. ishelpertype:=is_objectpascal_helper(tdef(sym.owner.defowner)) and
  1311. (p1.nodetype=typen) and
  1312. not is_objectpascal_helper(p1.resultdef)
  1313. {and
  1314. not (cnf_inherited in callflags)};
  1315. end
  1316. else
  1317. begin
  1318. isclassref:=false;
  1319. isrecordtype:=false;
  1320. isobjecttype:=false;
  1321. ishelpertype:=false;
  1322. end;
  1323. if assigned(spezcontext) and not (sym.typ=procsym) then
  1324. internalerror(2015091801);
  1325. { we assume, that only procsyms and varsyms are in an object }
  1326. { symbol table, for classes, properties are allowed }
  1327. case sym.typ of
  1328. procsym:
  1329. begin
  1330. do_proc_call(sym,sym.owner,structh,
  1331. (getaddr and not(token in [_CARET,_POINT])),
  1332. again,p1,callflags,spezcontext);
  1333. { we need to know which procedure is called }
  1334. do_typecheckpass(p1);
  1335. { We are loading... }
  1336. if p1.nodetype=loadn then
  1337. begin
  1338. { an instance method }
  1339. if not (po_classmethod in tloadnode(p1).procdef.procoptions) and
  1340. { into a method pointer (not just taking a code address) }
  1341. not getaddr and
  1342. { and the selfarg is... }
  1343. (
  1344. { either a record/object/helper type, }
  1345. not assigned(tloadnode(p1).left) or
  1346. { or a class/metaclass type, or a class reference }
  1347. (tloadnode(p1).left.resultdef.typ=classrefdef)
  1348. ) then
  1349. Message(parser_e_only_class_members_via_class_ref);
  1350. end
  1351. { calling using classref? }
  1352. else if (
  1353. isclassref or
  1354. (
  1355. (isobjecttype or
  1356. isrecordtype or
  1357. ishelpertype) and
  1358. not (cnf_inherited in callflags)
  1359. )
  1360. ) and
  1361. (p1.nodetype=calln) and
  1362. assigned(tcallnode(p1).procdefinition) then
  1363. begin
  1364. if not isobjecttype then
  1365. begin
  1366. if not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
  1367. not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
  1368. Message(parser_e_only_class_members_via_class_ref);
  1369. end
  1370. else
  1371. begin
  1372. { with objects, you can also do this:
  1373. type
  1374. tparent = object
  1375. procedure test;
  1376. end;
  1377. tchild = object(tchild)
  1378. procedure test;
  1379. end;
  1380. procedure tparent.test;
  1381. begin
  1382. end;
  1383. procedure tchild.test;
  1384. begin
  1385. tparent.test;
  1386. end;
  1387. }
  1388. if (tcallnode(p1).procdefinition.proctypeoption<>potype_constructor) and
  1389. not(po_staticmethod in tcallnode(p1).procdefinition.procoptions) and
  1390. (not assigned(current_structdef) or
  1391. not def_is_related(current_structdef,structh)) then
  1392. begin
  1393. p1.free;
  1394. p1:=cerrornode.create;
  1395. Message(parser_e_only_static_members_via_object_type);
  1396. exit;
  1397. end;
  1398. end;
  1399. { in Java, constructors are not automatically inherited
  1400. -> calling a constructor from a parent type will create
  1401. an instance of that parent type! }
  1402. if is_javaclass(structh) and
  1403. (tcallnode(p1).procdefinition.proctypeoption=potype_constructor) and
  1404. (tcallnode(p1).procdefinition.owner.defowner<>find_real_class_definition(tobjectdef(structh),false)) then
  1405. Message(parser_e_java_no_inherited_constructor);
  1406. { Provide a warning if we try to create an instance of a
  1407. abstract class using the type name of that class. We
  1408. must not provide a warning if we use a "class of"
  1409. variable of that type though as we don't know the
  1410. type of the class
  1411. Note: structh might be Nil in case of a type helper }
  1412. if assigned(structh) and
  1413. (tcallnode(p1).procdefinition.proctypeoption=potype_constructor) and
  1414. (oo_is_abstract in structh.objectoptions) and
  1415. assigned(tcallnode(p1).methodpointer) and
  1416. (tcallnode(p1).methodpointer.nodetype=loadvmtaddrn) then
  1417. Message1(type_w_instance_abstract_class,structh.RttiName);
  1418. end
  1419. end;
  1420. fieldvarsym:
  1421. begin
  1422. if not handle_staticfield_access(sym,p1) then
  1423. begin
  1424. if isclassref then
  1425. if assigned(p1) and
  1426. (
  1427. is_self_node(p1) or
  1428. (assigned(current_procinfo) and (current_procinfo.get_normal_proc.procdef.no_self_node) and
  1429. (current_procinfo.procdef.struct=structh))) then
  1430. Message(parser_e_only_class_members)
  1431. else
  1432. Message(parser_e_only_class_members_via_class_ref);
  1433. p1:=csubscriptnode.create(sym,p1);
  1434. end;
  1435. end;
  1436. propertysym:
  1437. begin
  1438. if isclassref and not (sp_static in sym.symoptions) then
  1439. Message(parser_e_only_class_members_via_class_ref);
  1440. handle_propertysym(tpropertysym(sym),sym.owner,p1);
  1441. end;
  1442. typesym:
  1443. begin
  1444. p1.free;
  1445. if try_to_consume(_LKLAMMER) then
  1446. begin
  1447. p1:=comp_expr([ef_accept_equal]);
  1448. consume(_RKLAMMER);
  1449. p1:=ctypeconvnode.create_explicit(p1,ttypesym(sym).typedef);
  1450. end
  1451. else
  1452. begin
  1453. p1:=ctypenode.create(ttypesym(sym).typedef);
  1454. if (is_class(ttypesym(sym).typedef) or
  1455. is_objcclass(ttypesym(sym).typedef) or
  1456. is_javaclass(ttypesym(sym).typedef)) and
  1457. not(block_type in [bt_type,bt_const_type,bt_var_type]) then
  1458. p1:=cloadvmtaddrnode.create(p1);
  1459. end;
  1460. end;
  1461. constsym:
  1462. begin
  1463. p1.free;
  1464. p1:=genconstsymtree(tconstsym(sym));
  1465. end;
  1466. staticvarsym:
  1467. begin
  1468. { typed constant is a staticvarsym
  1469. now they are absolutevarsym }
  1470. p1.free;
  1471. p1:=cloadnode.create(sym,sym.Owner);
  1472. end;
  1473. absolutevarsym:
  1474. begin
  1475. p1.free;
  1476. p1:=nil;
  1477. { typed constants are absolutebarsyms now to handle storage properly }
  1478. propaccesslist_to_node(p1,nil,tabsolutevarsym(sym).ref);
  1479. end
  1480. else
  1481. internalerror(16);
  1482. end;
  1483. end;
  1484. end;
  1485. function handle_specialize_inline_specialization(var srsym:tsym;out srsymtable:tsymtable;out spezcontext:tspecializationcontext):boolean;
  1486. var
  1487. spezdef : tdef;
  1488. symname : tsymstr;
  1489. begin
  1490. result:=false;
  1491. spezcontext:=nil;
  1492. srsymtable:=nil;
  1493. if not assigned(srsym) then
  1494. message1(sym_e_id_no_member,orgpattern)
  1495. else
  1496. if not (srsym.typ in [typesym,procsym]) then
  1497. message(type_e_type_id_expected)
  1498. else
  1499. begin
  1500. if srsym.typ=typesym then
  1501. spezdef:=ttypesym(srsym).typedef
  1502. else if tprocsym(srsym).procdeflist.count>0 then
  1503. spezdef:=tdef(tprocsym(srsym).procdeflist[0])
  1504. else
  1505. spezdef:=nil;
  1506. if (not assigned(spezdef) or (spezdef.typ=errordef)) and (sp_generic_dummy in srsym.symoptions) then
  1507. symname:=srsym.RealName
  1508. else
  1509. symname:='';
  1510. spezdef:=generate_specialization_phase1(spezcontext,spezdef,symname,srsym.owner);
  1511. case spezdef.typ of
  1512. errordef:
  1513. begin
  1514. spezcontext.free;
  1515. spezcontext:=nil;
  1516. srsym:=generrorsym;
  1517. end;
  1518. procdef:
  1519. begin
  1520. if block_type<>bt_body then
  1521. begin
  1522. message(parser_e_illegal_expression);
  1523. spezcontext.free;
  1524. spezcontext:=nil;
  1525. srsym:=generrorsym;
  1526. end
  1527. else
  1528. begin
  1529. srsym:=tprocdef(spezdef).procsym;
  1530. srsymtable:=srsym.owner;
  1531. result:=true;
  1532. end;
  1533. end;
  1534. objectdef,
  1535. recorddef,
  1536. arraydef,
  1537. procvardef:
  1538. begin
  1539. spezdef:=generate_specialization_phase2(spezcontext,tstoreddef(spezdef),false,'');
  1540. spezcontext.free;
  1541. spezcontext:=nil;
  1542. if spezdef<>generrordef then
  1543. begin
  1544. srsym:=spezdef.typesym;
  1545. srsymtable:=srsym.owner;
  1546. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1547. result:=true;
  1548. end;
  1549. end;
  1550. else
  1551. internalerror(2015070302);
  1552. end;
  1553. end;
  1554. end;
  1555. function handle_factor_typenode(hdef:tdef;getaddr:boolean;var again:boolean;sym:tsym;typeonly:boolean):tnode;
  1556. var
  1557. srsym : tsym;
  1558. srsymtable : tsymtable;
  1559. erroroutresult,
  1560. isspecialize : boolean;
  1561. spezcontext : tspecializationcontext;
  1562. savedfilepos : tfileposinfo;
  1563. begin
  1564. spezcontext:=nil;
  1565. if sym=nil then
  1566. sym:=hdef.typesym;
  1567. { allow Ordinal(Value) for type declarations since it
  1568. can be an enummeration declaration or a set lke:
  1569. (OrdinalType(const1)..OrdinalType(const2) }
  1570. if (not typeonly or is_ordinal(hdef)) and
  1571. try_to_consume(_LKLAMMER) then
  1572. begin
  1573. result:=comp_expr([ef_accept_equal]);
  1574. consume(_RKLAMMER);
  1575. { type casts to class helpers aren't allowed }
  1576. if is_objectpascal_helper(hdef) then
  1577. Message(parser_e_no_category_as_types)
  1578. { recovery by not creating a conversion node }
  1579. else
  1580. result:=ctypeconvnode.create_explicit(result,hdef);
  1581. end
  1582. { not LKLAMMER }
  1583. else if (token=_POINT) and
  1584. (is_object(hdef) or is_record(hdef)) then
  1585. begin
  1586. consume(_POINT);
  1587. { handles calling methods declared in parent objects
  1588. using "parentobject.methodname()" }
  1589. if assigned(current_structdef) and
  1590. not(getaddr) and
  1591. def_is_related(current_structdef,hdef) then
  1592. begin
  1593. result:=ctypenode.create(hdef);
  1594. ttypenode(result).typesym:=sym;
  1595. if not (m_delphi in current_settings.modeswitches) and
  1596. (block_type in inline_specialization_block_types) and
  1597. (token=_ID) and
  1598. (idtoken=_SPECIALIZE) then
  1599. begin
  1600. consume(_ID);
  1601. if token<>_ID then
  1602. message(type_e_type_id_expected);
  1603. isspecialize:=true;
  1604. end
  1605. else
  1606. isspecialize:=false;
  1607. { search also in inherited methods }
  1608. searchsym_in_class(tobjectdef(hdef),tobjectdef(current_structdef),pattern,srsym,srsymtable,[ssf_search_helper]);
  1609. if isspecialize then
  1610. begin
  1611. consume(_ID);
  1612. if not handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
  1613. begin
  1614. result.free;
  1615. result:=cerrornode.create;
  1616. end;
  1617. end
  1618. else
  1619. begin
  1620. if assigned(srsym) then
  1621. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1622. consume(_ID);
  1623. end;
  1624. if result.nodetype<>errorn then
  1625. do_member_read(tabstractrecorddef(hdef),false,srsym,result,again,[],spezcontext)
  1626. else
  1627. spezcontext.free;
  1628. end
  1629. else
  1630. begin
  1631. { handles:
  1632. * @TObject.Load
  1633. * static methods and variables }
  1634. result:=ctypenode.create(hdef);
  1635. ttypenode(result).typesym:=sym;
  1636. if not (m_delphi in current_settings.modeswitches) and
  1637. (block_type in inline_specialization_block_types) and
  1638. (token=_ID) and
  1639. (idtoken=_SPECIALIZE) then
  1640. begin
  1641. consume(_ID);
  1642. if token<>_ID then
  1643. message(type_e_type_id_expected);
  1644. isspecialize:=true;
  1645. end
  1646. else
  1647. isspecialize:=false;
  1648. erroroutresult:=true;
  1649. { TP allows also @TMenu.Load if Load is only }
  1650. { defined in an anchestor class }
  1651. srsym:=search_struct_member(tabstractrecorddef(hdef),pattern);
  1652. if isspecialize and assigned(srsym) then
  1653. begin
  1654. consume(_ID);
  1655. if handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
  1656. erroroutresult:=false;
  1657. end
  1658. else
  1659. begin
  1660. if assigned(srsym) then
  1661. begin
  1662. savedfilepos:=current_filepos;
  1663. consume(_ID);
  1664. if not (sp_generic_dummy in srsym.symoptions) or
  1665. not (token in [_LT,_LSHARPBRACKET]) then
  1666. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg,savedfilepos)
  1667. else
  1668. result:=cspecializenode.create(result,getaddr,srsym);
  1669. erroroutresult:=false;
  1670. end
  1671. else
  1672. Message1(sym_e_id_no_member,orgpattern);
  1673. end;
  1674. if erroroutresult then
  1675. begin
  1676. result.free;
  1677. result:=cerrornode.create;
  1678. end
  1679. else
  1680. if result.nodetype<>specializen then
  1681. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],spezcontext);
  1682. end;
  1683. end
  1684. else
  1685. begin
  1686. { Normally here would be the check against the usage
  1687. of "TClassHelper.Something", but as that might be
  1688. used inside of system symbols like sizeof and
  1689. typeinfo this check is put into ttypenode.pass_1
  1690. (for "TClassHelper" alone) and tcallnode.pass_1
  1691. (for "TClassHelper.Something") }
  1692. { class reference ? }
  1693. if is_class(hdef) or
  1694. is_objcclass(hdef) or
  1695. { Java interfaces also can have loadvmtaddrnodes,
  1696. e.g. for expressions such as JLClass(intftype) }
  1697. is_java_class_or_interface(hdef) then
  1698. begin
  1699. if getaddr and (token=_POINT) and
  1700. not is_javainterface(hdef) then
  1701. begin
  1702. consume(_POINT);
  1703. { allows @Object.Method }
  1704. { also allows static methods and variables }
  1705. result:=ctypenode.create(hdef);
  1706. ttypenode(result).typesym:=sym;
  1707. { TP allows also @TMenu.Load if Load is only }
  1708. { defined in an anchestor class }
  1709. srsym:=search_struct_member(tobjectdef(hdef),pattern);
  1710. if assigned(srsym) then
  1711. begin
  1712. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1713. consume(_ID);
  1714. { in case of @Object.Method1.Method2, we have to call
  1715. Method1 -> create a loadvmtaddr node as self instead of
  1716. a typen (the typenode would be changed to self of the
  1717. current method in case Method1 is a constructor, see
  1718. mantis #24844) }
  1719. if not(block_type in [bt_type,bt_const_type,bt_var_type]) and
  1720. (srsym.typ=procsym) and
  1721. (token in [_CARET,_POINT]) then
  1722. result:=cloadvmtaddrnode.create(result);
  1723. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],nil);
  1724. end
  1725. else
  1726. begin
  1727. Message1(sym_e_id_no_member,orgpattern);
  1728. consume(_ID);
  1729. end;
  1730. end
  1731. else
  1732. begin
  1733. result:=ctypenode.create(hdef);
  1734. ttypenode(result).typesym:=sym;
  1735. { For a type block we simply return only
  1736. the type. For all other blocks we return
  1737. a loadvmt node }
  1738. if not(block_type in [bt_type,bt_const_type,bt_var_type]) then
  1739. result:=cloadvmtaddrnode.create(result);
  1740. end;
  1741. end
  1742. else
  1743. begin
  1744. result:=ctypenode.create(hdef);
  1745. ttypenode(result).typesym:=sym;
  1746. end;
  1747. end;
  1748. end;
  1749. {****************************************************************************
  1750. Factor
  1751. ****************************************************************************}
  1752. function real_const_node_from_pattern(const s:string):tnode;
  1753. var
  1754. d : bestreal;
  1755. code : integer;
  1756. cur : currency;
  1757. begin
  1758. val(s,d,code);
  1759. if code<>0 then
  1760. begin
  1761. Message(parser_e_error_in_real);
  1762. d:=1.0;
  1763. end;
  1764. if current_settings.fputype=fpu_none then
  1765. begin
  1766. Message(parser_e_unsupported_real);
  1767. result:=cerrornode.create;
  1768. exit;
  1769. end;
  1770. if (current_settings.minfpconstprec=s32real) and
  1771. (d = single(d)) then
  1772. result:=crealconstnode.create(d,s32floattype)
  1773. else if (current_settings.minfpconstprec=s64real) and
  1774. (d = double(d)) then
  1775. result:=crealconstnode.create(d,s64floattype)
  1776. else
  1777. result:=crealconstnode.create(d,pbestrealtype^);
  1778. val(pattern,cur,code);
  1779. if code=0 then
  1780. trealconstnode(result).value_currency:=cur;
  1781. end;
  1782. {---------------------------------------------
  1783. PostFixOperators
  1784. ---------------------------------------------}
  1785. { returns whether or not p1 has been changed }
  1786. function postfixoperators(var p1:tnode;var again:boolean;getaddr:boolean): boolean;
  1787. { tries to avoid syntax errors after invalid qualifiers }
  1788. procedure recoverconsume_postfixops;
  1789. begin
  1790. repeat
  1791. if not try_to_consume(_CARET) then
  1792. if try_to_consume(_POINT) then
  1793. try_to_consume(_ID)
  1794. else if try_to_consume(_LECKKLAMMER) then
  1795. begin
  1796. repeat
  1797. comp_expr([ef_accept_equal]);
  1798. until not try_to_consume(_COMMA);
  1799. consume(_RECKKLAMMER);
  1800. end
  1801. else if try_to_consume(_LKLAMMER) then
  1802. begin
  1803. repeat
  1804. comp_expr([ef_accept_equal]);
  1805. until not try_to_consume(_COMMA);
  1806. consume(_RKLAMMER);
  1807. end
  1808. else
  1809. break;
  1810. until false;
  1811. end;
  1812. procedure handle_variantarray;
  1813. var
  1814. p4 : tnode;
  1815. newstatement : tstatementnode;
  1816. tempresultvariant,
  1817. temp : ttempcreatenode;
  1818. paras : tcallparanode;
  1819. newblock : tnode;
  1820. countindices : longint;
  1821. elements: tfplist;
  1822. arraydef: tdef;
  1823. begin
  1824. { create statements with call initialize the arguments and
  1825. call fpc_dynarr_setlength }
  1826. newblock:=internalstatements(newstatement);
  1827. { store all indices in a temporary array }
  1828. countindices:=0;
  1829. elements:=tfplist.Create;
  1830. repeat
  1831. p4:=comp_expr([ef_accept_equal]);
  1832. elements.add(p4);
  1833. until not try_to_consume(_COMMA);
  1834. arraydef:=carraydef.getreusable(s32inttype,elements.count);
  1835. temp:=ctempcreatenode.create(arraydef,arraydef.size,tt_persistent,false);
  1836. addstatement(newstatement,temp);
  1837. for countindices:=0 to elements.count-1 do
  1838. begin
  1839. addstatement(newstatement,
  1840. cassignmentnode.create(
  1841. cvecnode.create(
  1842. ctemprefnode.create(temp),
  1843. genintconstnode(countindices)
  1844. ),
  1845. tnode(elements[countindices])
  1846. )
  1847. );
  1848. end;
  1849. countindices:=elements.count;
  1850. elements.free;
  1851. consume(_RECKKLAMMER);
  1852. { we need only a write access if a := follows }
  1853. if token=_ASSIGNMENT then
  1854. begin
  1855. consume(_ASSIGNMENT);
  1856. p4:=comp_expr([ef_accept_equal]);
  1857. { create call to fpc_vararray_put }
  1858. paras:=ccallparanode.create(cordconstnode.create
  1859. (countindices,s32inttype,true),
  1860. ccallparanode.create(caddrnode.create_internal
  1861. (cvecnode.create(ctemprefnode.create(temp),genintconstnode(0))),
  1862. ccallparanode.create(ctypeconvnode.create_internal(p4,cvarianttype),
  1863. ccallparanode.create(ctypeconvnode.create_internal(p1,cvarianttype)
  1864. ,nil))));
  1865. addstatement(newstatement,ccallnode.createintern('fpc_vararray_put',paras));
  1866. addstatement(newstatement,ctempdeletenode.create(temp));
  1867. end
  1868. else
  1869. begin
  1870. { create temp for result }
  1871. tempresultvariant:=ctempcreatenode.create(cvarianttype,cvarianttype.size,tt_persistent,true);
  1872. addstatement(newstatement,tempresultvariant);
  1873. { create call to fpc_vararray_get }
  1874. paras:=ccallparanode.create(cordconstnode.create
  1875. (countindices,s32inttype,true),
  1876. ccallparanode.create(caddrnode.create_internal
  1877. (ctemprefnode.create(temp)),
  1878. ccallparanode.create(p1,
  1879. ccallparanode.create(
  1880. ctemprefnode.create(tempresultvariant)
  1881. ,nil))));
  1882. addstatement(newstatement,ccallnode.createintern('fpc_vararray_get',paras));
  1883. addstatement(newstatement,ctempdeletenode.create(temp));
  1884. { the last statement should return the value as
  1885. location and type, this is done be referencing the
  1886. temp and converting it first from a persistent temp to
  1887. normal temp }
  1888. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempresultvariant));
  1889. addstatement(newstatement,ctemprefnode.create(tempresultvariant));
  1890. end;
  1891. p1:=newblock;
  1892. end;
  1893. function parse_array_constructor(arrdef:tarraydef): tnode;
  1894. var
  1895. newstatement,assstatement:tstatementnode;
  1896. arrnode:ttempcreatenode;
  1897. temp2:ttempcreatenode;
  1898. assnode:tnode;
  1899. paracount:integer;
  1900. begin
  1901. result:=internalstatements(newstatement);
  1902. { create temp for result }
  1903. arrnode:=ctempcreatenode.create(arrdef,arrdef.size,tt_persistent,true);
  1904. addstatement(newstatement,arrnode);
  1905. paracount:=0;
  1906. { check arguments and create an assignment calls }
  1907. if try_to_consume(_LKLAMMER) then
  1908. begin
  1909. assnode:=internalstatements(assstatement);
  1910. repeat
  1911. { arr[i] := param_i }
  1912. addstatement(assstatement,
  1913. cassignmentnode.create(
  1914. cvecnode.create(
  1915. ctemprefnode.create(arrnode),
  1916. cordconstnode.create(paracount,arrdef.rangedef,false)),
  1917. comp_expr([ef_accept_equal])));
  1918. inc(paracount);
  1919. until not try_to_consume(_COMMA);
  1920. consume(_RKLAMMER);
  1921. end
  1922. else
  1923. assnode:=nil;
  1924. { get temp for array of lengths }
  1925. temp2:=ctempcreatenode.create(sinttype,sinttype.size,tt_persistent,false);
  1926. addstatement(newstatement,temp2);
  1927. { one dimensional }
  1928. addstatement(newstatement,cassignmentnode.create(
  1929. ctemprefnode.create(temp2),
  1930. cordconstnode.create
  1931. (paracount,s32inttype,true)));
  1932. { create call to fpc_dynarr_setlength }
  1933. addstatement(newstatement,ccallnode.createintern('fpc_dynarray_setlength',
  1934. ccallparanode.create(caddrnode.create_internal
  1935. (ctemprefnode.create(temp2)),
  1936. ccallparanode.create(cordconstnode.create
  1937. (1,s32inttype,true),
  1938. ccallparanode.create(caddrnode.create_internal
  1939. (crttinode.create(tstoreddef(arrdef),initrtti,rdt_normal)),
  1940. ccallparanode.create(
  1941. ctypeconvnode.create_internal(
  1942. ctemprefnode.create(arrnode),voidpointertype),
  1943. nil))))
  1944. ));
  1945. { add assignment statememnts }
  1946. addstatement(newstatement,ctempdeletenode.create(temp2));
  1947. if assigned(assnode) then
  1948. addstatement(newstatement,assnode);
  1949. { the last statement should return the value as
  1950. location and type, this is done be referencing the
  1951. temp and converting it first from a persistent temp to
  1952. normal temp }
  1953. addstatement(newstatement,ctempdeletenode.create_normal_temp(arrnode));
  1954. addstatement(newstatement,ctemprefnode.create(arrnode));
  1955. end;
  1956. function try_type_helper(var node:tnode;def:tdef):boolean;
  1957. var
  1958. srsym : tsym;
  1959. srsymtable : tsymtable;
  1960. n : tnode;
  1961. newstatement : tstatementnode;
  1962. temp : ttempcreatenode;
  1963. extdef : tdef;
  1964. begin
  1965. result:=false;
  1966. if (token=_ID) and (block_type in [bt_body,bt_general,bt_except,bt_const]) then
  1967. begin
  1968. if not assigned(def) then
  1969. if node.nodetype=addrn then
  1970. { always use the pointer type for addr nodes as otherwise
  1971. we'll have an anonymous pointertype with no name }
  1972. def:=voidpointertype
  1973. else
  1974. def:=node.resultdef;
  1975. result:=search_objectpascal_helper(def,nil,pattern,srsym,srsymtable);
  1976. if result then
  1977. begin
  1978. if not (srsymtable.symtabletype=objectsymtable) or
  1979. not is_objectpascal_helper(tdef(srsymtable.defowner)) then
  1980. internalerror(2013011401);
  1981. { convert const node to temp node of the extended type }
  1982. if node.nodetype in (nodetype_const+[addrn]) then
  1983. begin
  1984. extdef:=tobjectdef(srsymtable.defowner).extendeddef;
  1985. newstatement:=nil;
  1986. n:=internalstatements(newstatement);
  1987. temp:=ctempcreatenode.create(extdef,extdef.size,tt_persistent,false);
  1988. addstatement(newstatement,temp);
  1989. addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(temp),node));
  1990. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  1991. addstatement(newstatement,ctemprefnode.create(temp));
  1992. node:=n;
  1993. do_typecheckpass(node)
  1994. end;
  1995. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1996. consume(_ID);
  1997. do_member_read(nil,getaddr,srsym,node,again,[],nil);
  1998. end;
  1999. end;
  2000. end;
  2001. var
  2002. protsym : tpropertysym;
  2003. p2,p3 : tnode;
  2004. srsym : tsym;
  2005. srsymtable : TSymtable;
  2006. structh : tabstractrecorddef;
  2007. { shouldn't be used that often, so the extra overhead is ok to save
  2008. stack space }
  2009. dispatchstring : ansistring;
  2010. autoderef,
  2011. erroroutp1,
  2012. allowspecialize,
  2013. isspecialize,
  2014. found,
  2015. haderror,
  2016. nodechanged : boolean;
  2017. calltype: tdispcalltype;
  2018. valstr,expstr : string;
  2019. intval : qword;
  2020. code : integer;
  2021. strdef : tdef;
  2022. spezcontext : tspecializationcontext;
  2023. old_current_filepos : tfileposinfo;
  2024. label
  2025. skipreckklammercheck,
  2026. skippointdefcheck;
  2027. begin
  2028. result:=false;
  2029. again:=true;
  2030. while again do
  2031. begin
  2032. spezcontext:=nil;
  2033. { we need the resultdef }
  2034. do_typecheckpass_changed(p1,nodechanged);
  2035. result:=result or nodechanged;
  2036. if codegenerror then
  2037. begin
  2038. recoverconsume_postfixops;
  2039. exit;
  2040. end;
  2041. { handle token }
  2042. case token of
  2043. _CARET:
  2044. begin
  2045. consume(_CARET);
  2046. { support tp/mac procvar^ if the procvar returns a
  2047. pointer type }
  2048. if ((m_tp_procvar in current_settings.modeswitches) or
  2049. (m_mac_procvar in current_settings.modeswitches)) and
  2050. (p1.resultdef.typ=procvardef) and
  2051. (tprocvardef(p1.resultdef).returndef.typ=pointerdef) then
  2052. begin
  2053. p1:=ccallnode.create_procvar(nil,p1);
  2054. typecheckpass(p1);
  2055. end;
  2056. { iso file buf access? }
  2057. if (m_isolike_io in current_settings.modeswitches) and
  2058. (p1.resultdef.typ=filedef) then
  2059. begin
  2060. case tfiledef(p1.resultdef).filetyp of
  2061. ft_text:
  2062. begin
  2063. p1:=cderefnode.create(ccallnode.createintern('fpc_getbuf_text',ccallparanode.create(p1,nil)));
  2064. typecheckpass(p1);
  2065. end;
  2066. ft_typed:
  2067. begin
  2068. p1:=cderefnode.create(ctypeconvnode.create_internal(ccallnode.createintern('fpc_getbuf_typedfile',ccallparanode.create(p1,nil)),
  2069. cpointerdef.getreusable(tfiledef(p1.resultdef).typedfiledef)));
  2070. typecheckpass(p1);
  2071. end;
  2072. else
  2073. internalerror(2019050530);
  2074. end;
  2075. end
  2076. else if not(p1.resultdef.typ in [pointerdef,undefineddef]) then
  2077. begin
  2078. { ^ as binary operator is a problem!!!! (FK) }
  2079. again:=false;
  2080. Message(parser_e_invalid_qualifier);
  2081. recoverconsume_postfixops;
  2082. p1.destroy;
  2083. p1:=cerrornode.create;
  2084. end
  2085. else
  2086. p1:=cderefnode.create(p1);
  2087. end;
  2088. _LECKKLAMMER:
  2089. begin
  2090. if is_class_or_interface_or_object(p1.resultdef) or
  2091. is_dispinterface(p1.resultdef) or
  2092. is_record(p1.resultdef) or
  2093. is_javaclass(p1.resultdef) then
  2094. begin
  2095. { default property }
  2096. protsym:=search_default_property(tabstractrecorddef(p1.resultdef));
  2097. if not(assigned(protsym)) then
  2098. begin
  2099. p1.destroy;
  2100. p1:=cerrornode.create;
  2101. again:=false;
  2102. message(parser_e_no_default_property_available);
  2103. end
  2104. else
  2105. begin
  2106. { The property symbol is referenced indirect }
  2107. protsym.IncRefCount;
  2108. handle_propertysym(protsym,protsym.owner,p1);
  2109. end;
  2110. end
  2111. else
  2112. begin
  2113. consume(_LECKKLAMMER);
  2114. repeat
  2115. { in all of the cases below, p1 is changed }
  2116. case p1.resultdef.typ of
  2117. pointerdef:
  2118. begin
  2119. { support delphi autoderef }
  2120. if (tpointerdef(p1.resultdef).pointeddef.typ=arraydef) and
  2121. (m_autoderef in current_settings.modeswitches) then
  2122. p1:=cderefnode.create(p1);
  2123. p2:=comp_expr([ef_accept_equal]);
  2124. { Support Pbytevar[0..9] which returns array [0..9].}
  2125. if try_to_consume(_POINTPOINT) then
  2126. p2:=crangenode.create(p2,comp_expr([ef_accept_equal]));
  2127. p1:=cvecnode.create(p1,p2);
  2128. end;
  2129. variantdef:
  2130. begin
  2131. handle_variantarray;
  2132. { the RECKKLAMMER is already read }
  2133. goto skipreckklammercheck;
  2134. end;
  2135. stringdef :
  2136. begin
  2137. p2:=comp_expr([ef_accept_equal]);
  2138. { Support string[0..9] which returns array [0..9] of char.}
  2139. if try_to_consume(_POINTPOINT) then
  2140. p2:=crangenode.create(p2,comp_expr([ef_accept_equal]));
  2141. p1:=cvecnode.create(p1,p2);
  2142. end;
  2143. arraydef:
  2144. begin
  2145. p2:=comp_expr([ef_accept_equal]);
  2146. { support SEG:OFS for go32v2/msdos Mem[] }
  2147. if (target_info.system in [system_i386_go32v2,system_i386_watcom,system_i8086_msdos,system_i8086_win16,system_i8086_embedded]) and
  2148. (p1.nodetype=loadn) and
  2149. assigned(tloadnode(p1).symtableentry) and
  2150. assigned(tloadnode(p1).symtableentry.owner.name) and
  2151. (tloadnode(p1).symtableentry.owner.name^='SYSTEM') and
  2152. ((tloadnode(p1).symtableentry.name='MEM') or
  2153. (tloadnode(p1).symtableentry.name='MEMW') or
  2154. (tloadnode(p1).symtableentry.name='MEML')) then
  2155. begin
  2156. {$if defined(i8086)}
  2157. consume(_COLON);
  2158. inserttypeconv(p2,u16inttype);
  2159. inserttypeconv_internal(p2,u32inttype);
  2160. p3:=cshlshrnode.create(shln,p2,cordconstnode.create($10,s16inttype,false));
  2161. p2:=comp_expr([ef_accept_equal]);
  2162. inserttypeconv(p2,u16inttype);
  2163. inserttypeconv_internal(p2,u32inttype);
  2164. p2:=caddnode.create(addn,p2,p3);
  2165. case tloadnode(p1).symtableentry.name of
  2166. 'MEM': p2:=ctypeconvnode.create_internal(p2,bytefarpointertype);
  2167. 'MEMW': p2:=ctypeconvnode.create_internal(p2,wordfarpointertype);
  2168. 'MEML': p2:=ctypeconvnode.create_internal(p2,longintfarpointertype);
  2169. else
  2170. internalerror(2013053102);
  2171. end;
  2172. p1:=cderefnode.create(p2);
  2173. {$elseif defined(i386)}
  2174. if try_to_consume(_COLON) then
  2175. begin
  2176. p3:=caddnode.create(muln,cordconstnode.create($10,s32inttype,false),p2);
  2177. p2:=comp_expr([ef_accept_equal]);
  2178. p2:=caddnode.create(addn,p2,p3);
  2179. if try_to_consume(_POINTPOINT) then
  2180. { Support mem[$a000:$0000..$07ff] which returns array [0..$7ff] of memtype.}
  2181. p2:=crangenode.create(p2,caddnode.create(addn,comp_expr([ef_accept_equal]),p3.getcopy));
  2182. p1:=cvecnode.create(p1,p2);
  2183. include(tvecnode(p1).flags,nf_memseg);
  2184. include(tvecnode(p1).flags,nf_memindex);
  2185. end
  2186. else
  2187. begin
  2188. if try_to_consume(_POINTPOINT) then
  2189. { Support mem[$80000000..$80000002] which returns array [0..2] of memtype.}
  2190. p2:=crangenode.create(p2,comp_expr([ef_accept_equal]));
  2191. p1:=cvecnode.create(p1,p2);
  2192. include(tvecnode(p1).flags,nf_memindex);
  2193. end;
  2194. {$else}
  2195. internalerror(2013053105);
  2196. {$endif}
  2197. end
  2198. else
  2199. begin
  2200. if try_to_consume(_POINTPOINT) then
  2201. { Support arrayvar[0..9] which returns array [0..9] of arraytype.}
  2202. p2:=crangenode.create(p2,comp_expr([ef_accept_equal]));
  2203. p1:=cvecnode.create(p1,p2);
  2204. end;
  2205. end;
  2206. else
  2207. begin
  2208. if p1.resultdef.typ<>undefineddef then
  2209. Message(parser_e_invalid_qualifier);
  2210. p1.destroy;
  2211. p1:=cerrornode.create;
  2212. comp_expr([ef_accept_equal]);
  2213. again:=false;
  2214. end;
  2215. end;
  2216. do_typecheckpass(p1);
  2217. until not try_to_consume(_COMMA);
  2218. consume(_RECKKLAMMER);
  2219. { handle_variantarray eats the RECKKLAMMER and jumps here }
  2220. skipreckklammercheck:
  2221. end;
  2222. end;
  2223. _POINT :
  2224. begin
  2225. consume(_POINT);
  2226. allowspecialize:=not (m_delphi in current_settings.modeswitches) and (block_type in inline_specialization_block_types);
  2227. if allowspecialize and (token=_ID) and (idtoken=_SPECIALIZE) then
  2228. begin
  2229. //consume(_ID);
  2230. isspecialize:=true;
  2231. end
  2232. else
  2233. isspecialize:=false;
  2234. autoderef:=false;
  2235. if (p1.resultdef.typ=pointerdef) and
  2236. (m_autoderef in current_settings.modeswitches) and
  2237. { don't auto-deref objc.id, because then the code
  2238. below for supporting id.anyobjcmethod isn't triggered }
  2239. (p1.resultdef<>objc_idtype) then
  2240. begin
  2241. p1:=cderefnode.create(p1);
  2242. do_typecheckpass(p1);
  2243. autoderef:=true;
  2244. end;
  2245. { procvar.<something> can never mean anything so always
  2246. try to call it in case it returns a record/object/... }
  2247. maybe_call_procvar(p1,is_invokable(p1.resultdef) and not is_funcref(p1.resultdef));
  2248. if (p1.nodetype=ordconstn) and
  2249. not is_boolean(p1.resultdef) and
  2250. not is_enum(p1.resultdef) then
  2251. begin
  2252. { type helpers are checked first }
  2253. if (token=_ID) and try_type_helper(p1,nil) then
  2254. goto skippointdefcheck;
  2255. { only an "e" or "E" can follow an intconst with a ".", the
  2256. other case (another intconst) is handled by the scanner }
  2257. if (token=_ID) and (pattern[1]='E') then
  2258. begin
  2259. haderror:=false;
  2260. if length(pattern)>1 then
  2261. begin
  2262. expstr:=copy(pattern,2,length(pattern)-1);
  2263. val(expstr,intval,code);
  2264. if code<>0 then
  2265. begin
  2266. haderror:=true;
  2267. intval:=intval; // Hackfix the "var assigned but never used" note.
  2268. end;
  2269. end
  2270. else
  2271. expstr:='';
  2272. consume(token);
  2273. if tordconstnode(p1).value.signed then
  2274. str(tordconstnode(p1).value.svalue,valstr)
  2275. else
  2276. str(tordconstnode(p1).value.uvalue,valstr);
  2277. valstr:=valstr+'.0E';
  2278. if expstr='' then
  2279. case token of
  2280. _MINUS:
  2281. begin
  2282. consume(token);
  2283. if token=_INTCONST then
  2284. begin
  2285. valstr:=valstr+'-'+pattern;
  2286. consume(token);
  2287. end
  2288. else
  2289. haderror:=true;
  2290. end;
  2291. _PLUS:
  2292. begin
  2293. consume(token);
  2294. if token=_INTCONST then
  2295. begin
  2296. valstr:=valstr+pattern;
  2297. consume(token);
  2298. end
  2299. else
  2300. haderror:=true;
  2301. end;
  2302. _INTCONST:
  2303. begin
  2304. valstr:=valstr+pattern;
  2305. consume(_INTCONST);
  2306. end;
  2307. else
  2308. haderror:=true;
  2309. end
  2310. else
  2311. valstr:=valstr+expstr;
  2312. if haderror then
  2313. begin
  2314. Message(parser_e_error_in_real);
  2315. p2:=cerrornode.create;
  2316. end
  2317. else
  2318. p2:=real_const_node_from_pattern(valstr);
  2319. p1.free;
  2320. p1:=p2;
  2321. again:=false;
  2322. goto skippointdefcheck;
  2323. end
  2324. else
  2325. begin
  2326. { just convert the ordconst to a realconst }
  2327. p2:=crealconstnode.create(tordconstnode(p1).value,pbestrealtype^);
  2328. p1.free;
  2329. p1:=p2;
  2330. again:=false;
  2331. goto skippointdefcheck;
  2332. end;
  2333. end;
  2334. if (p1.nodetype=stringconstn) and (token=_ID) then
  2335. begin
  2336. strdef:=nil;
  2337. { the def of a string const is an array }
  2338. case tstringconstnode(p1).cst_type of
  2339. cst_conststring:
  2340. if cs_refcountedstrings in current_settings.localswitches then
  2341. if m_default_unicodestring in current_settings.modeswitches then
  2342. strdef:=cunicodestringtype
  2343. else
  2344. strdef:=cansistringtype
  2345. else
  2346. strdef:=cshortstringtype;
  2347. cst_shortstring:
  2348. strdef:=cshortstringtype;
  2349. cst_ansistring:
  2350. { use getansistringdef? }
  2351. strdef:=cansistringtype;
  2352. cst_widestring:
  2353. strdef:=cwidestringtype;
  2354. cst_unicodestring:
  2355. strdef:=cunicodestringtype;
  2356. cst_longstring:
  2357. { let's see when someone stumbles upon this...}
  2358. internalerror(201301111);
  2359. end;
  2360. if try_type_helper(p1,strdef) then
  2361. goto skippointdefcheck;
  2362. end;
  2363. { this is skipped if label skippointdefcheck is used }
  2364. case p1.resultdef.typ of
  2365. recorddef:
  2366. begin
  2367. if isspecialize or (token=_ID) then
  2368. begin
  2369. erroroutp1:=true;
  2370. srsym:=nil;
  2371. structh:=tabstractrecorddef(p1.resultdef);
  2372. if isspecialize then
  2373. begin
  2374. { consume the specialize }
  2375. consume(_ID);
  2376. if token<>_ID then
  2377. consume(_ID)
  2378. else
  2379. begin
  2380. searchsym_in_record(structh,pattern,srsym,srsymtable);
  2381. consume(_ID);
  2382. if handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
  2383. erroroutp1:=false;
  2384. end;
  2385. end
  2386. else
  2387. begin
  2388. searchsym_in_record(structh,pattern,srsym,srsymtable);
  2389. if assigned(srsym) then
  2390. begin
  2391. old_current_filepos:=current_filepos;
  2392. consume(_ID);
  2393. if not (sp_generic_dummy in srsym.symoptions) or
  2394. not (token in [_LT,_LSHARPBRACKET]) then
  2395. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg,old_current_filepos)
  2396. else
  2397. p1:=cspecializenode.create(p1,getaddr,srsym);
  2398. erroroutp1:=false;
  2399. end
  2400. else
  2401. begin
  2402. Message1(sym_e_id_no_member,orgpattern);
  2403. { try to clean up }
  2404. consume(_ID);
  2405. end;
  2406. end;
  2407. if erroroutp1 then
  2408. begin
  2409. p1.free;
  2410. p1:=cerrornode.create;
  2411. end
  2412. else
  2413. if p1.nodetype<>specializen then
  2414. do_member_read(structh,getaddr,srsym,p1,again,[],spezcontext);
  2415. end
  2416. else
  2417. consume(_ID);
  2418. end;
  2419. enumdef:
  2420. begin
  2421. if token=_ID then
  2422. begin
  2423. srsym:=tsym(tenumdef(p1.resultdef).symtable.Find(pattern));
  2424. if assigned(srsym) and (srsym.typ=enumsym) and (p1.nodetype=typen) then
  2425. begin
  2426. p1.destroy;
  2427. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  2428. p1:=genenumnode(tenumsym(srsym));
  2429. consume(_ID);
  2430. end
  2431. else
  2432. if not try_type_helper(p1,nil) then
  2433. begin
  2434. p1.destroy;
  2435. Message1(sym_e_id_no_member,orgpattern);
  2436. p1:=cerrornode.create;
  2437. consume(_ID);
  2438. end;
  2439. end;
  2440. end;
  2441. arraydef:
  2442. begin
  2443. if is_dynamic_array(p1.resultdef) then
  2444. begin
  2445. if token=_ID then
  2446. begin
  2447. if not try_type_helper(p1,nil) then
  2448. begin
  2449. if p1.nodetype=typen then
  2450. begin
  2451. if pattern='CREATE' then
  2452. begin
  2453. consume(_ID);
  2454. p2:=parse_array_constructor(tarraydef(p1.resultdef));
  2455. p1.destroy;
  2456. p1:=p2;
  2457. end
  2458. else
  2459. begin
  2460. Message2(scan_f_syn_expected,'CREATE',pattern);
  2461. p1.destroy;
  2462. p1:=cerrornode.create;
  2463. consume(_ID);
  2464. end;
  2465. end
  2466. else
  2467. begin
  2468. Message(parser_e_invalid_qualifier);
  2469. p1.destroy;
  2470. p1:=cerrornode.create;
  2471. consume(_ID);
  2472. end;
  2473. end;
  2474. end
  2475. else
  2476. begin
  2477. Message(parser_e_invalid_qualifier);
  2478. p1.destroy;
  2479. p1:=cerrornode.create;
  2480. consume(_ID);
  2481. end;
  2482. end
  2483. else
  2484. if (token<>_ID) or not try_type_helper(p1,nil) then
  2485. begin
  2486. Message(parser_e_invalid_qualifier);
  2487. p1.destroy;
  2488. p1:=cerrornode.create;
  2489. consume(_ID);
  2490. end;
  2491. end;
  2492. variantdef:
  2493. begin
  2494. { dispatch call? }
  2495. { lhs := v.ident[parameters] -> property get
  2496. lhs := v.ident(parameters) -> method call
  2497. v.ident[parameters] := rhs -> property put
  2498. v.ident(parameters) := rhs -> also property put }
  2499. if token=_ID then
  2500. begin
  2501. if not try_type_helper(p1,nil) then
  2502. begin
  2503. dispatchstring:=orgpattern;
  2504. consume(_ID);
  2505. calltype:=dct_method;
  2506. if try_to_consume(_LKLAMMER) then
  2507. begin
  2508. p2:=parse_paras(false,true,_RKLAMMER);
  2509. consume(_RKLAMMER);
  2510. end
  2511. else if try_to_consume(_LECKKLAMMER) then
  2512. begin
  2513. p2:=parse_paras(false,true,_RECKKLAMMER);
  2514. consume(_RECKKLAMMER);
  2515. calltype:=dct_propget;
  2516. end
  2517. else
  2518. p2:=nil;
  2519. { property setter? }
  2520. if (token=_ASSIGNMENT) and not(afterassignment) then
  2521. begin
  2522. consume(_ASSIGNMENT);
  2523. { read the expression }
  2524. p3:=comp_expr([ef_accept_equal]);
  2525. { concat value parameter too }
  2526. p2:=ccallparanode.create(p3,p2);
  2527. p1:=translate_disp_call(p1,p2,dct_propput,dispatchstring,0,voidtype);
  2528. end
  2529. else
  2530. { this is only an approximation
  2531. setting useresult if not necessary is only a waste of time, no more, no less (FK) }
  2532. if afterassignment or in_args or (token<>_SEMICOLON) then
  2533. p1:=translate_disp_call(p1,p2,calltype,dispatchstring,0,cvarianttype)
  2534. else
  2535. p1:=translate_disp_call(p1,p2,calltype,dispatchstring,0,voidtype);
  2536. end;
  2537. end
  2538. else { Error }
  2539. Consume(_ID);
  2540. end;
  2541. classrefdef:
  2542. begin
  2543. erroroutp1:=true;
  2544. if token=_ID then
  2545. begin
  2546. srsym:=nil;
  2547. structh:=tobjectdef(tclassrefdef(p1.resultdef).pointeddef);
  2548. if isspecialize then
  2549. begin
  2550. { consume the specialize }
  2551. consume(_ID);
  2552. if token<>_ID then
  2553. consume(_ID)
  2554. else
  2555. begin
  2556. searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]);
  2557. consume(_ID);
  2558. if handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
  2559. erroroutp1:=false;
  2560. end;
  2561. end
  2562. else
  2563. begin
  2564. searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]);
  2565. if assigned(srsym) then
  2566. begin
  2567. old_current_filepos:=current_filepos;
  2568. consume(_ID);
  2569. if not (sp_generic_dummy in srsym.symoptions) or
  2570. not (token in [_LT,_LSHARPBRACKET]) then
  2571. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg,old_current_filepos)
  2572. else
  2573. p1:=cspecializenode.create(p1,getaddr,srsym);
  2574. erroroutp1:=false;
  2575. end
  2576. else
  2577. begin
  2578. Message1(sym_e_id_no_member,orgpattern);
  2579. { try to clean up }
  2580. consume(_ID);
  2581. end;
  2582. end;
  2583. if erroroutp1 then
  2584. begin
  2585. p1.free;
  2586. p1:=cerrornode.create;
  2587. end
  2588. else
  2589. if p1.nodetype<>specializen then
  2590. do_member_read(structh,getaddr,srsym,p1,again,[],spezcontext);
  2591. end
  2592. else { Error }
  2593. Consume(_ID);
  2594. end;
  2595. objectdef:
  2596. begin
  2597. if isspecialize or (token=_ID) then
  2598. begin
  2599. erroroutp1:=true;
  2600. srsym:=nil;
  2601. structh:=tobjectdef(p1.resultdef);
  2602. if isspecialize then
  2603. begin
  2604. { consume the "specialize" }
  2605. consume(_ID);
  2606. if token<>_ID then
  2607. consume(_ID)
  2608. else
  2609. begin
  2610. searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]);
  2611. consume(_ID);
  2612. if handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
  2613. erroroutp1:=false;
  2614. end;
  2615. end
  2616. else
  2617. begin
  2618. searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]);
  2619. if assigned(srsym) then
  2620. begin
  2621. old_current_filepos:=current_filepos;
  2622. consume(_ID);
  2623. if not (sp_generic_dummy in srsym.symoptions) or
  2624. not (token in [_LT,_LSHARPBRACKET]) then
  2625. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg,old_current_filepos)
  2626. else
  2627. p1:=cspecializenode.create(p1,getaddr,srsym);
  2628. erroroutp1:=false;
  2629. end
  2630. else
  2631. begin
  2632. Message1(sym_e_id_no_member,orgpattern);
  2633. { try to clean up }
  2634. consume(_ID);
  2635. end;
  2636. end;
  2637. if erroroutp1 then
  2638. begin
  2639. p1.free;
  2640. p1:=cerrornode.create;
  2641. end
  2642. else
  2643. if p1.nodetype<>specializen then
  2644. do_member_read(structh,getaddr,srsym,p1,again,[],spezcontext);
  2645. end
  2646. else { Error }
  2647. Consume(_ID);
  2648. end;
  2649. pointerdef:
  2650. begin
  2651. if (p1.resultdef=objc_idtype) then
  2652. begin
  2653. { objc's id type can be used to call any
  2654. Objective-C method of any Objective-C class
  2655. type that's currently in scope }
  2656. if search_objc_method(pattern,srsym,srsymtable) then
  2657. begin
  2658. consume(_ID);
  2659. do_proc_call(srsym,srsymtable,nil,
  2660. (getaddr and not(token in [_CARET,_POINT])),
  2661. again,p1,[cnf_objc_id_call],nil);
  2662. { we need to know which procedure is called }
  2663. do_typecheckpass(p1);
  2664. end
  2665. else
  2666. begin
  2667. consume(_ID);
  2668. Message(parser_e_methode_id_expected);
  2669. end;
  2670. end
  2671. else
  2672. begin
  2673. if not try_type_helper(p1,nil) then
  2674. begin
  2675. Message(parser_e_invalid_qualifier);
  2676. if tpointerdef(p1.resultdef).pointeddef.typ in [recorddef,objectdef,classrefdef] then
  2677. Message(parser_h_maybe_deref_caret_missing);
  2678. end;
  2679. end
  2680. end;
  2681. else
  2682. begin
  2683. if autoderef then
  2684. begin
  2685. { always try with the not dereferenced node }
  2686. p2:=tderefnode(p1).left;
  2687. found:=try_type_helper(p2,nil);
  2688. if found then
  2689. begin
  2690. tderefnode(p1).left:=nil;
  2691. p1.destroy;
  2692. p1:=p2;
  2693. end;
  2694. end
  2695. else
  2696. found:=try_type_helper(p1,nil);
  2697. if not found then
  2698. begin
  2699. if p1.resultdef.typ<>undefineddef then
  2700. Message(parser_e_invalid_qualifier);
  2701. p1.destroy;
  2702. p1:=cerrornode.create;
  2703. { Error }
  2704. consume(_ID);
  2705. end;
  2706. end;
  2707. end;
  2708. { processing an ordconstnode avoids the resultdef check }
  2709. skippointdefcheck:
  2710. end;
  2711. else
  2712. begin
  2713. { is this a procedure variable ? }
  2714. if is_invokable(p1.resultdef) and
  2715. (token=_LKLAMMER) then
  2716. begin
  2717. if not searchsym_in_class(tobjectdef(p1.resultdef),tobjectdef(p1.resultdef),method_name_funcref_invoke_find,srsym,srsymtable,[]) then
  2718. internalerror(2021040202);
  2719. include(p1.flags,nf_load_procvar);
  2720. do_proc_call(srsym,srsymtable,tabstractrecorddef(p1.resultdef),false,again,p1,[],nil);
  2721. end
  2722. else if assigned(p1.resultdef) and
  2723. (p1.resultdef.typ=procvardef) then
  2724. begin
  2725. { Typenode for typecasting or expecting a procvar }
  2726. if (p1.nodetype=typen) or
  2727. (
  2728. assigned(getprocvardef) and
  2729. equal_defs(p1.resultdef,getprocvardef)
  2730. ) or
  2731. (
  2732. assigned(getfuncrefdef) and
  2733. equal_defs(p1.resultdef,getfuncrefdef)
  2734. ) then
  2735. begin
  2736. if try_to_consume(_LKLAMMER) then
  2737. begin
  2738. p1:=comp_expr([ef_accept_equal]);
  2739. consume(_RKLAMMER);
  2740. p1:=ctypeconvnode.create_explicit(p1,p1.resultdef);
  2741. end
  2742. else
  2743. again:=false
  2744. end
  2745. else
  2746. begin
  2747. if try_to_consume(_LKLAMMER) then
  2748. begin
  2749. p2:=parse_paras(false,false,_RKLAMMER);
  2750. consume(_RKLAMMER);
  2751. p1:=ccallnode.create_procvar(p2,p1);
  2752. { proc():= is never possible }
  2753. if token=_ASSIGNMENT then
  2754. begin
  2755. Message(parser_e_illegal_expression);
  2756. p1.free;
  2757. p1:=cerrornode.create;
  2758. again:=false;
  2759. end;
  2760. end
  2761. else
  2762. again:=false;
  2763. end;
  2764. end
  2765. else
  2766. again:=false;
  2767. end;
  2768. end;
  2769. { we only try again if p1 was changed }
  2770. if again or
  2771. (p1.nodetype=errorn) then
  2772. result:=true;
  2773. end; { while again }
  2774. end;
  2775. function is_member_read(sym: tsym; st: tsymtable; var p1: tnode;
  2776. out memberparentdef: tdef): boolean;
  2777. var
  2778. hdef : tdef;
  2779. begin
  2780. result:=true;
  2781. memberparentdef:=nil;
  2782. case st.symtabletype of
  2783. ObjectSymtable,
  2784. recordsymtable:
  2785. begin
  2786. memberparentdef:=tdef(st.defowner);
  2787. exit;
  2788. end;
  2789. WithSymtable:
  2790. begin
  2791. if assigned(p1) then
  2792. internalerror(2007012002);
  2793. hdef:=tnode(twithsymtable(st).withrefnode).resultdef;
  2794. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  2795. if not(hdef.typ in [objectdef,classrefdef]) then
  2796. exit;
  2797. if (hdef.typ=classrefdef) then
  2798. hdef:=tclassrefdef(hdef).pointeddef;
  2799. memberparentdef:=hdef;
  2800. end;
  2801. else
  2802. result:=false;
  2803. end;
  2804. end;
  2805. {$maxfpuregisters 0}
  2806. function factor_handle_sym(srsym:tsym;srsymtable:tsymtable;var again:boolean;getaddr:boolean;unit_found:boolean;flags:texprflags;var spezcontext:tspecializationcontext):tnode;
  2807. var
  2808. hdef : tdef;
  2809. pd : tprocdef;
  2810. callflags : tcallnodeflags;
  2811. tmpgetaddr : boolean;
  2812. begin
  2813. hdef:=nil;
  2814. result:=nil;
  2815. case srsym.typ of
  2816. absolutevarsym :
  2817. begin
  2818. if (tabsolutevarsym(srsym).abstyp=tovar) then
  2819. begin
  2820. result:=nil;
  2821. propaccesslist_to_node(result,nil,tabsolutevarsym(srsym).ref);
  2822. result:=ctypeconvnode.create(result,tabsolutevarsym(srsym).vardef);
  2823. include(result.flags,nf_absolute);
  2824. end
  2825. else
  2826. result:=cloadnode.create(srsym,srsymtable);
  2827. end;
  2828. staticvarsym,
  2829. localvarsym,
  2830. paravarsym,
  2831. fieldvarsym :
  2832. begin
  2833. { check if we are reading a field of an object/class/ }
  2834. { record. is_member_read() will deal with withsymtables }
  2835. { if needed. }
  2836. result:=nil;
  2837. if is_member_read(srsym,srsymtable,result,hdef) then
  2838. begin
  2839. { if the field was originally found in an }
  2840. { objectsymtable, it means it's part of self }
  2841. { if only method from which it was called is }
  2842. { not class static }
  2843. if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
  2844. { if we are accessing a owner procsym from the nested }
  2845. { class we need to call it as a class member }
  2846. if assigned(current_structdef) and
  2847. (((current_structdef<>hdef) and is_owned_by(current_structdef,hdef)) or
  2848. (sp_static in srsym.symoptions)) then
  2849. if srsymtable.symtabletype=recordsymtable then
  2850. result:=ctypenode.create(hdef)
  2851. else
  2852. result:=cloadvmtaddrnode.create(ctypenode.create(hdef))
  2853. else
  2854. begin
  2855. if assigned(current_procinfo) then
  2856. begin
  2857. pd:=current_procinfo.get_normal_proc.procdef;
  2858. if assigned(pd) and pd.no_self_node then
  2859. result:=cloadvmtaddrnode.create(ctypenode.create(pd.struct))
  2860. else
  2861. result:=load_self_node;
  2862. end
  2863. else
  2864. result:=load_self_node;
  2865. end;
  2866. { now, if the field itself is part of an objectsymtab }
  2867. { (it can be even if it was found in a withsymtable, }
  2868. { e.g., "with classinstance do field := 5"), then }
  2869. { let do_member_read handle it }
  2870. if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  2871. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],nil)
  2872. else
  2873. { otherwise it's a regular record subscript }
  2874. result:=csubscriptnode.create(srsym,result);
  2875. end
  2876. else
  2877. { regular non-field load }
  2878. result:=cloadnode.create(srsym,srsymtable);
  2879. end;
  2880. syssym :
  2881. begin
  2882. result:=statement_syssym(tsyssym(srsym).number);
  2883. end;
  2884. typesym :
  2885. begin
  2886. hdef:=ttypesym(srsym).typedef;
  2887. if not assigned(hdef) then
  2888. begin
  2889. again:=false;
  2890. end
  2891. else
  2892. begin
  2893. if (m_delphi in current_settings.modeswitches) and
  2894. (sp_generic_dummy in srsym.symoptions) and
  2895. (token in [_LT,_LSHARPBRACKET]) then
  2896. begin
  2897. if block_type in [bt_type,bt_const_type,bt_var_type] then
  2898. begin
  2899. if not handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) or (srsym.typ=procsym) then
  2900. begin
  2901. spezcontext.free;
  2902. result:=cerrornode.create;
  2903. if try_to_consume(_LKLAMMER) then
  2904. begin
  2905. parse_paras(false,false,_RKLAMMER);
  2906. consume(_RKLAMMER);
  2907. end;
  2908. end
  2909. else
  2910. begin
  2911. if srsym.typ<>typesym then
  2912. internalerror(2015071705);
  2913. hdef:=ttypesym(srsym).typedef;
  2914. result:=handle_factor_typenode(hdef,getaddr,again,srsym,ef_type_only in flags);
  2915. end;
  2916. end
  2917. else
  2918. result:=cspecializenode.create(nil,getaddr,srsym)
  2919. end
  2920. else
  2921. begin
  2922. { We need to know if this unit uses Variants }
  2923. if ((hdef=cvarianttype) or (hdef=colevarianttype)) and
  2924. not(cs_compilesystem in current_settings.moduleswitches) then
  2925. include(current_module.moduleflags,mf_uses_variants);
  2926. result:=handle_factor_typenode(hdef,getaddr,again,srsym,ef_type_only in flags);
  2927. end;
  2928. end;
  2929. end;
  2930. enumsym :
  2931. begin
  2932. result:=genenumnode(tenumsym(srsym));
  2933. end;
  2934. constsym :
  2935. begin
  2936. if tconstsym(srsym).consttyp=constresourcestring then
  2937. begin
  2938. result:=cloadnode.create(srsym,srsymtable);
  2939. do_typecheckpass(result);
  2940. result.resultdef:=getansistringdef;
  2941. end
  2942. else
  2943. result:=genconstsymtree(tconstsym(srsym));
  2944. end;
  2945. procsym :
  2946. begin
  2947. result:=nil;
  2948. if (m_delphi in current_settings.modeswitches) and
  2949. (sp_generic_dummy in srsym.symoptions) and
  2950. (token in [_LT,_LSHARPBRACKET]) then
  2951. begin
  2952. result:=cspecializenode.create(nil,getaddr,srsym)
  2953. end
  2954. { check if it's a method/class method }
  2955. else if is_member_read(srsym,srsymtable,result,hdef) then
  2956. begin
  2957. { if we are accessing a owner procsym from the nested }
  2958. { class we need to call it as a class member }
  2959. if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) and
  2960. assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then
  2961. result:=cloadvmtaddrnode.create(ctypenode.create(hdef));
  2962. { not srsymtable.symtabletype since that can be }
  2963. { withsymtable as well }
  2964. if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  2965. begin
  2966. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],spezcontext);
  2967. spezcontext:=nil;
  2968. end
  2969. else
  2970. { no procsyms in records (yet) }
  2971. internalerror(2007012006);
  2972. end
  2973. else
  2974. begin
  2975. { regular procedure/function call }
  2976. if not unit_found then
  2977. callflags:=[]
  2978. else
  2979. callflags:=[cnf_unit_specified];
  2980. { TP7 uglyness: @proc^ is parsed as (@proc)^,
  2981. but @notproc^ is parsed as @(notproc^) }
  2982. if m_tp_procvar in current_settings.modeswitches then
  2983. tmpgetaddr:=getaddr and not(token in [_POINT,_LECKKLAMMER])
  2984. else
  2985. tmpgetaddr:=getaddr and not(token in [_CARET,_POINT,_LECKKLAMMER]);
  2986. do_proc_call(srsym,srsymtable,nil,tmpgetaddr,
  2987. again,result,callflags,spezcontext);
  2988. spezcontext:=nil;
  2989. end;
  2990. end;
  2991. propertysym :
  2992. begin
  2993. result:=nil;
  2994. { property of a class/object? }
  2995. if is_member_read(srsym,srsymtable,result,hdef) then
  2996. begin
  2997. if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
  2998. { if we are accessing a owner procsym from the nested }
  2999. { class or from a static class method we need to call }
  3000. { it as a class member }
  3001. if (assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef)) or
  3002. (assigned(current_procinfo) and current_procinfo.get_normal_proc.procdef.no_self_node) then
  3003. begin
  3004. result:=ctypenode.create(hdef);
  3005. if not is_record(hdef) then
  3006. result:=cloadvmtaddrnode.create(result);
  3007. end
  3008. else
  3009. result:=load_self_node;
  3010. { not srsymtable.symtabletype since that can be }
  3011. { withsymtable as well }
  3012. if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  3013. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],nil)
  3014. else
  3015. { no propertysyms in records (yet) }
  3016. internalerror(2009111510);
  3017. end
  3018. else
  3019. { no method pointer }
  3020. begin
  3021. handle_propertysym(tpropertysym(srsym),srsymtable,result);
  3022. end;
  3023. end;
  3024. labelsym :
  3025. begin
  3026. { Support @label }
  3027. if getaddr then
  3028. begin
  3029. if srsym.owner<>current_procinfo.procdef.localst then
  3030. CGMessage(parser_e_label_outside_proc);
  3031. result:=cloadnode.create(srsym,srsym.owner)
  3032. end
  3033. else
  3034. begin
  3035. consume(_COLON);
  3036. if tlabelsym(srsym).defined then
  3037. Message(sym_e_label_already_defined);
  3038. if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
  3039. begin
  3040. include(current_procinfo.flags,pi_has_interproclabel);
  3041. if (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
  3042. Message(sym_e_interprocgoto_into_init_final_code_not_allowed);
  3043. end;
  3044. tlabelsym(srsym).defined:=true;
  3045. result:=clabelnode.create(nil,tlabelsym(srsym));
  3046. tlabelsym(srsym).code:=result;
  3047. end;
  3048. end;
  3049. undefinedsym :
  3050. begin
  3051. result:=cnothingnode.Create;
  3052. result.resultdef:=cundefineddef.create(true);
  3053. { clean up previously created dummy symbol }
  3054. srsym.free;
  3055. end;
  3056. errorsym :
  3057. begin
  3058. result:=cerrornode.create;
  3059. if try_to_consume(_LKLAMMER) then
  3060. begin
  3061. parse_paras(false,false,_RKLAMMER);
  3062. consume(_RKLAMMER);
  3063. end;
  3064. end;
  3065. else
  3066. begin
  3067. result:=cerrornode.create;
  3068. Message(parser_e_illegal_expression);
  3069. end;
  3070. end; { end case }
  3071. end;
  3072. function factor(getaddr:boolean;flags:texprflags) : tnode;
  3073. {---------------------------------------------
  3074. Factor_read_id
  3075. ---------------------------------------------}
  3076. procedure factor_read_id(out p1:tnode;out again:boolean);
  3077. function findwithsymtable : boolean;
  3078. var
  3079. hp : psymtablestackitem;
  3080. begin
  3081. result:=true;
  3082. hp:=symtablestack.stack;
  3083. while assigned(hp) do
  3084. begin
  3085. if hp^.symtable.symtabletype=withsymtable then
  3086. exit;
  3087. hp:=hp^.next;
  3088. end;
  3089. result:=false;
  3090. end;
  3091. var
  3092. srsym: tsym;
  3093. srsymtable: TSymtable;
  3094. hdef: tdef;
  3095. orgstoredpattern,
  3096. storedpattern: string;
  3097. t : ttoken;
  3098. consumeid,
  3099. wasgenericdummy,
  3100. allowspecialize,
  3101. isspecialize,
  3102. unit_found : boolean;
  3103. dummypos,
  3104. tokenpos: tfileposinfo;
  3105. spezcontext : tspecializationcontext;
  3106. cufflags : tconsume_unitsym_flags;
  3107. begin
  3108. { allow post fix operators }
  3109. again:=true;
  3110. { preinitalize tokenpos }
  3111. tokenpos:=current_filepos;
  3112. p1:=nil;
  3113. spezcontext:=nil;
  3114. { avoid warning }
  3115. fillchar(dummypos,sizeof(dummypos),0);
  3116. allowspecialize:=not (m_delphi in current_settings.modeswitches) and
  3117. not (ef_had_specialize in flags) and
  3118. (block_type in inline_specialization_block_types);
  3119. if allowspecialize and (token=_ID) and (idtoken=_SPECIALIZE) then
  3120. begin
  3121. consume(_ID);
  3122. isspecialize:=true;
  3123. end
  3124. else
  3125. isspecialize:=ef_had_specialize in flags;
  3126. { first check for identifier }
  3127. if token<>_ID then
  3128. begin
  3129. srsym:=generrorsym;
  3130. srsymtable:=nil;
  3131. consume(_ID);
  3132. unit_found:=false;
  3133. end
  3134. else
  3135. begin
  3136. storedpattern:=pattern;
  3137. orgstoredpattern:=orgpattern;
  3138. { store the position of the token before consuming it }
  3139. tokenpos:=current_filepos;
  3140. consumeid:=true;
  3141. srsym:=nil;
  3142. if ef_check_attr_suffix in flags then
  3143. begin
  3144. if not (ef_type_only in flags) then
  3145. internalerror(2019063001);
  3146. consume(_ID);
  3147. consumeid:=false;
  3148. if token<>_POINT then
  3149. searchsym_type(storedpattern+custom_attribute_suffix,srsym,srsymtable);
  3150. end;
  3151. if not assigned(srsym) then
  3152. begin
  3153. if ef_type_only in flags then
  3154. searchsym_type(storedpattern,srsym,srsymtable)
  3155. else
  3156. searchsym(storedpattern,srsym,srsymtable);
  3157. end;
  3158. { handle unit specification like System.Writeln }
  3159. if not isspecialize then
  3160. begin
  3161. cufflags:=[];
  3162. if consumeid then
  3163. include(cufflags,cuf_consume_id);
  3164. if allowspecialize then
  3165. include(cufflags,cuf_allow_specialize);
  3166. if ef_check_attr_suffix in flags then
  3167. include(cufflags,cuf_check_attr_suffix);
  3168. unit_found:=try_consume_unitsym(srsym,srsymtable,t,cufflags,isspecialize,pattern);
  3169. if unit_found then
  3170. consumeid:=true;
  3171. end
  3172. else
  3173. begin
  3174. unit_found:=false;
  3175. t:=_ID;
  3176. end;
  3177. if consumeid then
  3178. begin
  3179. storedpattern:=pattern;
  3180. orgstoredpattern:=orgpattern;
  3181. { store the position of the token before consuming it }
  3182. tokenpos:=current_filepos;
  3183. consume(t);
  3184. end;
  3185. { named parameter support }
  3186. found_arg_name:=false;
  3187. if not(unit_found) and
  3188. not isspecialize and
  3189. named_args_allowed and
  3190. (token=_ASSIGNMENT) then
  3191. begin
  3192. found_arg_name:=true;
  3193. p1:=cstringconstnode.createstr(orgstoredpattern);
  3194. consume(_ASSIGNMENT);
  3195. exit;
  3196. end;
  3197. if isspecialize then
  3198. begin
  3199. if not assigned(srsym) then
  3200. begin
  3201. identifier_not_found(orgstoredpattern,tokenpos);
  3202. srsym:=generrorsym;
  3203. srsymtable:=nil;
  3204. end
  3205. else
  3206. begin
  3207. {$push}
  3208. {$warn 5036 off}
  3209. hdef:=generate_specialization_phase1(spezcontext,nil,nil,orgstoredpattern,nil,dummypos);
  3210. {$pop}
  3211. if hdef=generrordef then
  3212. begin
  3213. spezcontext.free;
  3214. spezcontext:=nil;
  3215. srsym:=generrorsym;
  3216. srsymtable:=nil;
  3217. end
  3218. else
  3219. begin
  3220. if hdef.typ in [objectdef,recorddef,procvardef,arraydef] then
  3221. begin
  3222. hdef:=generate_specialization_phase2(spezcontext,tstoreddef(hdef),false,'');
  3223. spezcontext.free;
  3224. spezcontext:=nil;
  3225. if hdef<>generrordef then
  3226. begin
  3227. srsym:=hdef.typesym;
  3228. srsymtable:=srsym.owner;
  3229. end
  3230. else
  3231. begin
  3232. srsym:=generrorsym;
  3233. srsymtable:=nil;
  3234. end;
  3235. end
  3236. else
  3237. if hdef.typ=procdef then
  3238. begin
  3239. if block_type<>bt_body then
  3240. begin
  3241. message(parser_e_illegal_expression);
  3242. srsym:=generrorsym;
  3243. srsymtable:=nil;
  3244. end
  3245. else
  3246. begin
  3247. srsym:=tprocdef(hdef).procsym;
  3248. if assigned(spezcontext.symtable) then
  3249. srsymtable:=spezcontext.symtable
  3250. else
  3251. srsymtable:=srsym.owner;
  3252. end;
  3253. end
  3254. else
  3255. internalerror(2015061204);
  3256. end;
  3257. end;
  3258. end;
  3259. wasgenericdummy:=false;
  3260. if assigned(srsym) and
  3261. (sp_generic_dummy in srsym.symoptions) and
  3262. (srsym.typ in [procsym,typesym]) and
  3263. (
  3264. (
  3265. (m_delphi in current_settings.modeswitches) and
  3266. not (token in [_LT, _LSHARPBRACKET]) and
  3267. (
  3268. (
  3269. (srsym.typ=typesym) and
  3270. (ttypesym(srsym).typedef.typ=undefineddef)
  3271. ) or (
  3272. (srsym.typ=procsym) and
  3273. (tprocsym(srsym).procdeflist.count=0)
  3274. )
  3275. )
  3276. )
  3277. or
  3278. (
  3279. not (m_delphi in current_settings.modeswitches) and
  3280. not isspecialize and
  3281. (
  3282. not parse_generic or
  3283. not (
  3284. assigned(current_structdef) and
  3285. assigned(get_generic_in_hierarchy_by_name(srsym,current_structdef))
  3286. )
  3287. )
  3288. )
  3289. ) then
  3290. begin
  3291. srsym:=resolve_generic_dummysym(srsym.name);
  3292. if assigned(srsym) then
  3293. srsymtable:=srsym.owner
  3294. else
  3295. begin
  3296. srsymtable:=nil;
  3297. wasgenericdummy:=true;
  3298. end;
  3299. end;
  3300. { check hints, but only if it isn't a potential generic symbol;
  3301. that is checked in sub_expr if it isn't a generic }
  3302. if assigned(srsym) and
  3303. not (
  3304. (srsym.typ=typesym) and
  3305. (
  3306. (ttypesym(srsym).typedef.typ in [recorddef,objectdef,arraydef,procvardef,undefineddef]) or
  3307. (
  3308. (ttypesym(srsym).typedef.typ=errordef) and
  3309. (sp_generic_dummy in srsym.symoptions)
  3310. )
  3311. ) and
  3312. not (sp_generic_para in srsym.symoptions) and
  3313. (token in [_LT, _LSHARPBRACKET])
  3314. ) then
  3315. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  3316. { if nothing found give error and return errorsym }
  3317. if not assigned(srsym) or
  3318. { is this a generic dummy symbol? }
  3319. ((srsym.typ=typesym) and
  3320. assigned(ttypesym(srsym).typedef) and
  3321. (ttypesym(srsym).typedef.typ=undefineddef) and
  3322. not (sp_generic_para in srsym.symoptions) and
  3323. not (token in [_LT, _LSHARPBRACKET]) and
  3324. not (
  3325. { in non-Delphi modes the generic class' name without a
  3326. "specialization" or "<T>" may be used to identify the
  3327. current class }
  3328. (sp_generic_dummy in srsym.symoptions) and
  3329. assigned(current_structdef) and
  3330. (df_generic in current_structdef.defoptions) and
  3331. not (m_delphi in current_settings.modeswitches) and
  3332. assigned(get_generic_in_hierarchy_by_name(srsym,current_structdef))
  3333. )) and
  3334. { it could be a rename of a generic para }
  3335. { Note: if this generates false positives we'll need to
  3336. include a "basesym" to tsym to track the original
  3337. symbol }
  3338. not (sp_explicitrename in srsym.symoptions) then
  3339. begin
  3340. { if a generic is parsed and when we are inside an with block,
  3341. a symbol might not be defined }
  3342. if assigned(current_procinfo) and (df_generic in current_procinfo.procdef.defoptions) and
  3343. findwithsymtable then
  3344. begin
  3345. { create dummy symbol, it will be freed later on }
  3346. srsym:=tstoredsym.create(undefinedsym,'$undefinedsym');
  3347. srsymtable:=nil;
  3348. end
  3349. else
  3350. begin
  3351. if wasgenericdummy then
  3352. messagepos(tokenpos,parser_e_no_generics_as_types)
  3353. else
  3354. identifier_not_found(orgstoredpattern,tokenpos);
  3355. srsym:=generrorsym;
  3356. srsymtable:=nil;
  3357. end;
  3358. end;
  3359. end;
  3360. { Access to funcret or need to call the function? }
  3361. if (srsym.typ in [absolutevarsym,localvarsym,paravarsym]) and
  3362. (vo_is_funcret in tabstractvarsym(srsym).varoptions) and
  3363. { result(x) is not allowed }
  3364. not(vo_is_result in tabstractvarsym(srsym).varoptions) and
  3365. (
  3366. (token=_LKLAMMER) or
  3367. (
  3368. (([m_tp7,m_delphi,m_mac,m_iso,m_extpas] * current_settings.modeswitches) <> []) and
  3369. (afterassignment or in_args)
  3370. )
  3371. ) then
  3372. begin
  3373. hdef:=tdef(srsym.owner.defowner);
  3374. if assigned(hdef) and
  3375. (hdef.typ=procdef) then
  3376. srsym:=tprocdef(hdef).procsym
  3377. else
  3378. begin
  3379. Message(parser_e_illegal_expression);
  3380. srsym:=generrorsym;
  3381. end;
  3382. srsymtable:=srsym.owner;
  3383. end;
  3384. begin
  3385. p1:=factor_handle_sym(srsym,srsymtable,again,getaddr,unit_found,flags,spezcontext);
  3386. if assigned(spezcontext) then
  3387. internalerror(2015061207);
  3388. if assigned(p1) and (p1.nodetype<>errorn) then
  3389. p1.fileinfo:=tokenpos;
  3390. end;
  3391. end;
  3392. {---------------------------------------------
  3393. Factor_Read_Set
  3394. ---------------------------------------------}
  3395. { Read a set between [] }
  3396. function factor_read_set:tnode;
  3397. var
  3398. p1,p2 : tnode;
  3399. lastp,
  3400. buildp : tarrayconstructornode;
  3401. begin
  3402. buildp:=nil;
  3403. lastp:=nil;
  3404. { be sure that a least one arrayconstructn is used, also for an
  3405. empty [] }
  3406. if token=_RECKKLAMMER then
  3407. buildp:=carrayconstructornode.create(nil,buildp)
  3408. else
  3409. repeat
  3410. p1:=comp_expr([ef_accept_equal]);
  3411. if try_to_consume(_POINTPOINT) then
  3412. begin
  3413. p2:=comp_expr([ef_accept_equal]);
  3414. p1:=carrayconstructorrangenode.create(p1,p2);
  3415. end;
  3416. { insert at the end of the tree, to get the correct order }
  3417. if not assigned(buildp) then
  3418. begin
  3419. buildp:=carrayconstructornode.create(p1,nil);
  3420. lastp:=buildp;
  3421. end
  3422. else
  3423. begin
  3424. lastp.right:=carrayconstructornode.create(p1,nil);
  3425. lastp:=tarrayconstructornode(lastp.right);
  3426. end;
  3427. { there could be more elements }
  3428. until not try_to_consume(_COMMA);
  3429. buildp.allow_array_constructor:=block_type in [bt_body,bt_except];
  3430. factor_read_set:=buildp;
  3431. end;
  3432. function can_load_self_node: boolean;
  3433. begin
  3434. result:=false;
  3435. if (block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) or
  3436. not assigned(current_structdef) or
  3437. not assigned(current_procinfo) then
  3438. exit;
  3439. result:=not current_procinfo.get_normal_proc.procdef.no_self_node;
  3440. end;
  3441. {---------------------------------------------
  3442. Factor (Main)
  3443. ---------------------------------------------}
  3444. var
  3445. l : longint;
  3446. ic : int64;
  3447. qc : qword;
  3448. p1 : tnode;
  3449. code : integer;
  3450. srsym : tsym;
  3451. srsymtable : TSymtable;
  3452. pd : tprocdef;
  3453. hclassdef : tobjectdef;
  3454. d : bestreal;
  3455. hs,hsorg : string;
  3456. hdef : tdef;
  3457. filepos : tfileposinfo;
  3458. callflags : tcallnodeflags;
  3459. idstr : tidstring;
  3460. spezcontext : tspecializationcontext;
  3461. isspecialize,
  3462. mightbegeneric,
  3463. useself,
  3464. dopostfix,
  3465. again,
  3466. updatefpos,
  3467. nodechanged : boolean;
  3468. oldprocvardef : tprocvardef;
  3469. oldfuncrefdef : tobjectdef;
  3470. begin
  3471. { can't keep a copy of p1 and compare pointers afterwards, because
  3472. p1 may be freed and reallocated in the same place! }
  3473. dopostfix:=true;
  3474. updatefpos:=false;
  3475. p1:=nil;
  3476. filepos:=current_tokenpos;
  3477. again:=false;
  3478. pd:=nil;
  3479. isspecialize:=false;
  3480. if token=_ID then
  3481. begin
  3482. again:=true;
  3483. { Handle references to self }
  3484. if (idtoken=_SELF) and can_load_self_node then
  3485. begin
  3486. p1:=load_self_node;
  3487. consume(_ID);
  3488. again:=true;
  3489. end
  3490. else
  3491. factor_read_id(p1,again);
  3492. if assigned(p1) then
  3493. begin
  3494. { factor_read_id will set the filepos to after the id,
  3495. and in case of _SELF the filepos will already be the
  3496. same as filepos (so setting it again doesn't hurt). }
  3497. p1.fileinfo:=filepos;
  3498. filepos:=current_tokenpos;
  3499. end;
  3500. { handle post fix operators }
  3501. if (p1.nodetype=specializen) then
  3502. { post fix operators are handled after specialization }
  3503. dopostfix:=false
  3504. else
  3505. if (m_delphi in current_settings.modeswitches) and
  3506. (block_type=bt_body) and
  3507. (token in [_LT,_LSHARPBRACKET]) then
  3508. begin
  3509. idstr:='';
  3510. case p1.nodetype of
  3511. typen:
  3512. idstr:=ttypenode(p1).typesym.name;
  3513. loadvmtaddrn:
  3514. if tloadvmtaddrnode(p1).left.nodetype=typen then
  3515. idstr:=ttypenode(tloadvmtaddrnode(p1).left).typesym.name;
  3516. loadn:
  3517. idstr:=tloadnode(p1).symtableentry.name;
  3518. calln:
  3519. idstr:=tcallnode(p1).symtableprocentry.name;
  3520. else
  3521. ;
  3522. end;
  3523. { if this is the case then the postfix handling is done in
  3524. sub_expr if necessary }
  3525. dopostfix:=not could_be_generic(idstr);
  3526. end;
  3527. { TP7 uglyness: @proc^ is parsed as (@proc)^, but @notproc^ is parsed
  3528. as @(notproc^) }
  3529. if (m_tp_procvar in current_settings.modeswitches) and (token=_CARET) and
  3530. getaddr and (p1.nodetype=loadn) and (tloadnode(p1).symtableentry.typ=procsym) then
  3531. dopostfix:=false;
  3532. { maybe an additional parameter instead of misusing hadspezialize? }
  3533. if dopostfix and not (ef_had_specialize in flags) then
  3534. updatefpos:=postfixoperators(p1,again,getaddr);
  3535. end
  3536. else
  3537. begin
  3538. updatefpos:=true;
  3539. case token of
  3540. _RETURN :
  3541. begin
  3542. consume(_RETURN);
  3543. p1:=nil;
  3544. if not(token in [_SEMICOLON,_ELSE,_END]) then
  3545. begin
  3546. p1:=comp_expr([ef_accept_equal]);
  3547. if not assigned(current_procinfo) or
  3548. (current_procinfo.procdef.proctypeoption in [potype_constructor,potype_destructor]) or
  3549. is_void(current_procinfo.procdef.returndef) then
  3550. begin
  3551. Message(parser_e_void_function);
  3552. { recovery }
  3553. p1.free;
  3554. p1:=nil;
  3555. end;
  3556. end;
  3557. p1 := cexitnode.create(p1);
  3558. end;
  3559. _INHERITED :
  3560. begin
  3561. again:=true;
  3562. consume(_INHERITED);
  3563. if assigned(current_procinfo) and
  3564. assigned(current_structdef) and
  3565. ((current_structdef.typ=objectdef) or
  3566. ((target_info.system in systems_jvm) and
  3567. (current_structdef.typ=recorddef)))then
  3568. begin
  3569. { for record helpers in mode Delphi "inherited" is not
  3570. allowed }
  3571. if is_objectpascal_helper(current_structdef) and
  3572. (m_delphi in current_settings.modeswitches) and
  3573. (tobjectdef(current_structdef).helpertype=ht_record) then
  3574. Message(parser_e_inherited_not_in_record);
  3575. if (current_structdef.typ=objectdef) then
  3576. begin
  3577. hclassdef:=tobjectdef(current_structdef).childof;
  3578. { Objective-C categories *replace* methods in the class
  3579. they extend, or add methods to it. So calling an
  3580. inherited method always calls the method inherited from
  3581. the parent of the extended class }
  3582. if is_objccategory(current_structdef) then
  3583. hclassdef:=hclassdef.childof;
  3584. end
  3585. else if target_info.system in systems_jvm then
  3586. hclassdef:=java_fpcbaserecordtype
  3587. else
  3588. internalerror(2012012401);
  3589. spezcontext:=nil;
  3590. { if inherited; only then we need the method with
  3591. the same name }
  3592. if token <> _ID then
  3593. begin
  3594. hs:=current_procinfo.procdef.procsym.name;
  3595. hsorg:=current_procinfo.procdef.procsym.realname;
  3596. anon_inherited:=true;
  3597. { For message methods we need to search using the message
  3598. number or string }
  3599. pd:=tprocdef(tprocsym(current_procinfo.procdef.procsym).ProcdefList[0]);
  3600. srdef:=nil;
  3601. if (po_msgint in pd.procoptions) then
  3602. searchsym_in_class_by_msgint(hclassdef,pd.messageinf.i,srdef,srsym,srsymtable)
  3603. else
  3604. if (po_msgstr in pd.procoptions) then
  3605. searchsym_in_class_by_msgstr(hclassdef,pd.messageinf.str^,srsym,srsymtable)
  3606. else
  3607. { helpers have their own ways of dealing with inherited }
  3608. if is_objectpascal_helper(current_structdef) then
  3609. searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,[ssf_has_inherited])
  3610. else
  3611. searchsym_in_class(hclassdef,current_structdef,hs,srsym,srsymtable,[ssf_search_helper]);
  3612. end
  3613. else
  3614. begin
  3615. if not (m_delphi in current_settings.modeswitches) and
  3616. (block_type in inline_specialization_block_types) and
  3617. (token=_ID) and
  3618. (idtoken=_SPECIALIZE) then
  3619. begin
  3620. consume(_ID);
  3621. if token<>_ID then
  3622. message(parser_e_methode_id_expected);
  3623. isspecialize:=true;
  3624. end
  3625. else
  3626. isspecialize:=false;
  3627. hs:=pattern;
  3628. hsorg:=orgpattern;
  3629. consume(_ID);
  3630. anon_inherited:=false;
  3631. { helpers have their own ways of dealing with inherited }
  3632. if is_objectpascal_helper(current_structdef) then
  3633. searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,[ssf_has_inherited])
  3634. else
  3635. searchsym_in_class(hclassdef,current_structdef,hs,srsym,srsymtable,[ssf_search_helper]);
  3636. if isspecialize and assigned(srsym) then
  3637. begin
  3638. if not handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
  3639. srsym:=nil;
  3640. end;
  3641. end;
  3642. if assigned(srsym) then
  3643. begin
  3644. mightbegeneric:=(m_delphi in current_settings.modeswitches) and
  3645. (token in [_LT,_LSHARPBRACKET]) and
  3646. (sp_generic_dummy in srsym.symoptions);
  3647. { load the procdef from the inherited class and
  3648. not from self }
  3649. case srsym.typ of
  3650. typesym,
  3651. procsym:
  3652. begin
  3653. { typesym is only a valid choice if we're dealing
  3654. with a potential generic }
  3655. if (srsym.typ=typesym) and not mightbegeneric then
  3656. begin
  3657. Message(parser_e_methode_id_expected);
  3658. p1:=cerrornode.create;
  3659. end
  3660. else
  3661. begin
  3662. useself:=false;
  3663. if is_objectpascal_helper(current_structdef) then
  3664. begin
  3665. { for a helper load the procdef either from the
  3666. extended type, from the parent helper or from
  3667. the extended type of the parent helper
  3668. depending on the def the found symbol belongs
  3669. to }
  3670. if (srsym.Owner.defowner.typ=objectdef) and
  3671. is_objectpascal_helper(tobjectdef(srsym.Owner.defowner)) then
  3672. if def_is_related(current_structdef,tdef(srsym.Owner.defowner)) and
  3673. assigned(tobjectdef(current_structdef).childof) then
  3674. hdef:=tobjectdef(current_structdef).childof
  3675. else
  3676. begin
  3677. hdef:=tobjectdef(srsym.Owner.defowner).extendeddef;
  3678. useself:=true;
  3679. end
  3680. else
  3681. begin
  3682. hdef:=tdef(srsym.Owner.defowner);
  3683. useself:=true;
  3684. end;
  3685. end
  3686. else
  3687. hdef:=hclassdef;
  3688. if (po_classmethod in current_procinfo.procdef.procoptions) or
  3689. (po_staticmethod in current_procinfo.procdef.procoptions) then
  3690. hdef:=cclassrefdef.create(hdef);
  3691. if useself then
  3692. begin
  3693. p1:=ctypeconvnode.create_internal(load_self_node,hdef);
  3694. end
  3695. else
  3696. begin
  3697. p1:=ctypenode.create(hdef);
  3698. { we need to allow helpers here }
  3699. ttypenode(p1).helperallowed:=true;
  3700. end;
  3701. end;
  3702. end;
  3703. propertysym:
  3704. ;
  3705. else
  3706. begin
  3707. Message(parser_e_methode_id_expected);
  3708. p1:=cerrornode.create;
  3709. end;
  3710. end;
  3711. if mightbegeneric then
  3712. begin
  3713. p1:=cspecializenode.create_inherited(p1,getaddr,srsym,hclassdef);
  3714. end
  3715. else
  3716. begin
  3717. if not isspecialize then
  3718. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  3719. callflags:=[cnf_inherited];
  3720. include(current_procinfo.flags,pi_has_inherited);
  3721. if anon_inherited then
  3722. include(callflags,cnf_anon_inherited);
  3723. do_member_read(hclassdef,getaddr,srsym,p1,again,callflags,spezcontext);
  3724. end;
  3725. if p1.nodetype=errorn then
  3726. spezcontext.free;
  3727. end
  3728. else
  3729. begin
  3730. if anon_inherited then
  3731. begin
  3732. { For message methods we need to call DefaultHandler }
  3733. if (po_msgint in pd.procoptions) or
  3734. (po_msgstr in pd.procoptions) then
  3735. begin
  3736. searchsym_in_class(hclassdef,hclassdef,'DEFAULTHANDLER',srsym,srsymtable,[ssf_search_helper]);
  3737. if not assigned(srsym) or
  3738. (srsym.typ<>procsym) then
  3739. internalerror(200303171);
  3740. p1:=nil;
  3741. do_proc_call(srsym,srsym.owner,hclassdef,false,again,p1,[],nil);
  3742. end
  3743. else
  3744. begin
  3745. { we need to ignore the inherited; }
  3746. p1:=cnothingnode.create;
  3747. end;
  3748. end
  3749. else
  3750. begin
  3751. Message1(sym_e_id_no_member,hsorg);
  3752. p1:=cerrornode.create;
  3753. end;
  3754. again:=false;
  3755. end;
  3756. { turn auto inheriting off }
  3757. anon_inherited:=false;
  3758. end
  3759. else
  3760. begin
  3761. { in case of records we use a more clear error message }
  3762. if assigned(current_structdef) and
  3763. (current_structdef.typ=recorddef) then
  3764. Message(parser_e_inherited_not_in_record)
  3765. else
  3766. Message(parser_e_generic_methods_only_in_methods);
  3767. again:=false;
  3768. p1:=cerrornode.create;
  3769. end;
  3770. if p1.nodetype<>specializen then
  3771. postfixoperators(p1,again,getaddr);
  3772. end;
  3773. _INTCONST :
  3774. begin
  3775. {Try first wether the value fits in an int64.}
  3776. val(pattern,ic,code);
  3777. if code=0 then
  3778. begin
  3779. consume(_INTCONST);
  3780. int_to_type(ic,hdef);
  3781. p1:=cordconstnode.create(ic,hdef,true);
  3782. end
  3783. else
  3784. begin
  3785. { try qword next }
  3786. val(pattern,qc,code);
  3787. if code=0 then
  3788. begin
  3789. consume(_INTCONST);
  3790. int_to_type(qc,hdef);
  3791. p1:=cordconstnode.create(qc,hdef,true);
  3792. end;
  3793. end;
  3794. if code<>0 then
  3795. begin
  3796. { finally float }
  3797. val(pattern,d,code);
  3798. if code<>0 then
  3799. begin
  3800. Message(parser_e_invalid_integer);
  3801. consume(_INTCONST);
  3802. l:=1;
  3803. p1:=cordconstnode.create(l,sinttype,true);
  3804. end
  3805. else
  3806. begin
  3807. consume(_INTCONST);
  3808. p1:=crealconstnode.create(d,pbestrealtype^);
  3809. end;
  3810. end
  3811. else
  3812. { the necessary range checking has already been done by val }
  3813. tordconstnode(p1).rangecheck:=false;
  3814. if token=_POINT then
  3815. begin
  3816. again:=true;
  3817. postfixoperators(p1,again,getaddr);
  3818. end;
  3819. end;
  3820. _REALNUMBER :
  3821. begin
  3822. p1:=real_const_node_from_pattern(pattern);
  3823. consume(_REALNUMBER);
  3824. if token=_POINT then
  3825. begin
  3826. again:=true;
  3827. postfixoperators(p1,again,getaddr);
  3828. end;
  3829. end;
  3830. _STRING :
  3831. begin
  3832. string_dec(hdef,true);
  3833. { STRING can be also a type cast }
  3834. if try_to_consume(_LKLAMMER) then
  3835. begin
  3836. p1:=comp_expr([ef_accept_equal]);
  3837. consume(_RKLAMMER);
  3838. p1:=ctypeconvnode.create_explicit(p1,hdef);
  3839. { handle postfix operators here e.g. string(a)[10] }
  3840. again:=true;
  3841. postfixoperators(p1,again,getaddr);
  3842. end
  3843. else
  3844. begin
  3845. p1:=ctypenode.create(hdef);
  3846. if token=_POINT then
  3847. begin
  3848. again:=true;
  3849. { handle type helpers here }
  3850. postfixoperators(p1,again,getaddr);
  3851. end;
  3852. end;
  3853. end;
  3854. _FILE :
  3855. begin
  3856. hdef:=cfiletype;
  3857. consume(_FILE);
  3858. { FILE can be also a type cast }
  3859. if try_to_consume(_LKLAMMER) then
  3860. begin
  3861. p1:=comp_expr([ef_accept_equal]);
  3862. consume(_RKLAMMER);
  3863. p1:=ctypeconvnode.create_explicit(p1,hdef);
  3864. { handle postfix operators here e.g. string(a)[10] }
  3865. again:=true;
  3866. postfixoperators(p1,again,getaddr);
  3867. end
  3868. else
  3869. begin
  3870. p1:=ctypenode.create(hdef);
  3871. end;
  3872. end;
  3873. _CSTRING :
  3874. begin
  3875. p1:=cstringconstnode.createpchar(ansistring2pchar(cstringpattern),length(cstringpattern),nil);
  3876. consume(_CSTRING);
  3877. if token in postfixoperator_tokens then
  3878. begin
  3879. again:=true;
  3880. postfixoperators(p1,again,getaddr);
  3881. end;
  3882. end;
  3883. _CCHAR :
  3884. begin
  3885. p1:=cordconstnode.create(ord(pattern[1]),cansichartype,true);
  3886. consume(_CCHAR);
  3887. if token=_POINT then
  3888. begin
  3889. again:=true;
  3890. postfixoperators(p1,again,getaddr);
  3891. end;
  3892. end;
  3893. _CWSTRING:
  3894. begin
  3895. if getlengthwidestring(patternw)=1 then
  3896. p1:=cordconstnode.create(ord(getcharwidestring(patternw,0)),cwidechartype,true)
  3897. else
  3898. p1:=cstringconstnode.createunistr(patternw);
  3899. consume(_CWSTRING);
  3900. if token in postfixoperator_tokens then
  3901. begin
  3902. again:=true;
  3903. postfixoperators(p1,again,getaddr);
  3904. end;
  3905. end;
  3906. _CWCHAR:
  3907. begin
  3908. p1:=cordconstnode.create(ord(getcharwidestring(patternw,0)),cwidechartype,true);
  3909. consume(_CWCHAR);
  3910. if token=_POINT then
  3911. begin
  3912. again:=true;
  3913. postfixoperators(p1,again,getaddr);
  3914. end;
  3915. end;
  3916. _KLAMMERAFFE :
  3917. begin
  3918. consume(_KLAMMERAFFE);
  3919. got_addrn:=true;
  3920. { support both @<x> and @(<x>) }
  3921. if try_to_consume(_LKLAMMER) then
  3922. begin
  3923. p1:=factor(true,[]);
  3924. { inside parentheses a full expression is allowed, see also tests\webtbs\tb27517.pp }
  3925. if token<>_RKLAMMER then
  3926. p1:=sub_expr(opcompare,[ef_accept_equal],p1);
  3927. consume(_RKLAMMER);
  3928. end
  3929. else
  3930. p1:=factor(true,[]);
  3931. if (token in postfixoperator_tokens) and
  3932. { TP7 uglyness: @proc^ is parsed as (@proc)^, but @notproc^
  3933. is parsed as @(notproc^) }
  3934. not
  3935. (
  3936. (m_tp_procvar in current_settings.modeswitches) and
  3937. (token=_CARET) and (p1.nodetype=loadn) and (tloadnode(p1).symtableentry.typ=procsym)
  3938. )
  3939. then
  3940. begin
  3941. again:=true;
  3942. postfixoperators(p1,again,getaddr);
  3943. end;
  3944. got_addrn:=false;
  3945. p1:=caddrnode.create(p1);
  3946. p1.fileinfo:=filepos;
  3947. if cs_typed_addresses in current_settings.localswitches then
  3948. include(taddrnode(p1).addrnodeflags,anf_typedaddr);
  3949. { Store the procvar that we are expecting, the
  3950. addrn will use the information to find the correct
  3951. procdef or it will return an error }
  3952. if assigned(getprocvardef) and
  3953. (taddrnode(p1).left.nodetype = loadn) then
  3954. taddrnode(p1).getprocvardef:=getprocvardef;
  3955. if (token in postfixoperator_tokens) then
  3956. begin
  3957. again:=true;
  3958. postfixoperators(p1,again,getaddr);
  3959. end;
  3960. end;
  3961. _LKLAMMER :
  3962. begin
  3963. consume(_LKLAMMER);
  3964. p1:=comp_expr([ef_accept_equal]);
  3965. consume(_RKLAMMER);
  3966. { it's not a good solution
  3967. but (a+b)^ makes some problems }
  3968. if token in postfixoperator_tokens then
  3969. begin
  3970. again:=true;
  3971. postfixoperators(p1,again,getaddr);
  3972. end;
  3973. end;
  3974. _LECKKLAMMER :
  3975. begin
  3976. consume(_LECKKLAMMER);
  3977. p1:=factor_read_set;
  3978. consume(_RECKKLAMMER);
  3979. end;
  3980. _PLUS :
  3981. begin
  3982. consume(_PLUS);
  3983. p1:=factor(false,[]);
  3984. p1:=cunaryplusnode.create(p1);
  3985. end;
  3986. _MINUS :
  3987. begin
  3988. consume(_MINUS);
  3989. if (token = _INTCONST) and not(m_isolike_unary_minus in current_settings.modeswitches) then
  3990. begin
  3991. { ugly hack, but necessary to be able to parse }
  3992. { -9223372036854775808 as int64 (JM) }
  3993. pattern := '-'+pattern;
  3994. p1:=sub_expr(oppower,[],nil);
  3995. { -1 ** 4 should be - (1 ** 4) and not
  3996. (-1) ** 4
  3997. This was the reason of tw0869.pp test failure PM }
  3998. if p1.nodetype=starstarn then
  3999. begin
  4000. if tbinarynode(p1).left.nodetype=ordconstn then
  4001. begin
  4002. tordconstnode(tbinarynode(p1).left).value:=-tordconstnode(tbinarynode(p1).left).value;
  4003. p1:=cunaryminusnode.create(p1);
  4004. end
  4005. else if tbinarynode(p1).left.nodetype=realconstn then
  4006. begin
  4007. trealconstnode(tbinarynode(p1).left).value_real:=-trealconstnode(tbinarynode(p1).left).value_real;
  4008. trealconstnode(tbinarynode(p1).left).value_currency:=-trealconstnode(tbinarynode(p1).left).value_currency;
  4009. p1:=cunaryminusnode.create(p1);
  4010. end
  4011. else
  4012. internalerror(20021029);
  4013. end;
  4014. end
  4015. else
  4016. begin
  4017. if m_isolike_unary_minus in current_settings.modeswitches then
  4018. p1:=sub_expr(opmultiply,[],nil)
  4019. else
  4020. p1:=sub_expr(oppower,[],nil);
  4021. p1:=cunaryminusnode.create(p1);
  4022. end;
  4023. end;
  4024. _OP_NOT :
  4025. begin
  4026. consume(_OP_NOT);
  4027. p1:=factor(false,[]);
  4028. p1:=cnotnode.create(p1);
  4029. end;
  4030. _NIL :
  4031. begin
  4032. consume(_NIL);
  4033. p1:=cnilnode.create;
  4034. { It's really ugly code nil^, but delphi allows it }
  4035. if token in [_CARET,_POINT] then
  4036. begin
  4037. again:=true;
  4038. postfixoperators(p1,again,getaddr);
  4039. end;
  4040. end;
  4041. _OBJCPROTOCOL:
  4042. begin
  4043. { The @protocol keyword is used in two ways in Objective-C:
  4044. 1) to declare protocols (~ Object Pascal interfaces)
  4045. 2) to obtain the metaclass (~ Object Pascal) "class of")
  4046. of a declared protocol
  4047. This code is for handling the second case. Because of 1),
  4048. we cannot simply use a system unit symbol.
  4049. }
  4050. consume(_OBJCPROTOCOL);
  4051. consume(_LKLAMMER);
  4052. p1:=factor(false,[]);
  4053. consume(_RKLAMMER);
  4054. p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
  4055. end;
  4056. _PROCEDURE,
  4057. _FUNCTION:
  4058. begin
  4059. if (block_type=bt_body) and
  4060. (m_anonymous_functions in current_settings.modeswitches) then
  4061. begin
  4062. oldprocvardef:=getprocvardef;
  4063. oldfuncrefdef:=getfuncrefdef;
  4064. getprocvardef:=nil;
  4065. getfuncrefdef:=nil;
  4066. pd:=read_proc([rpf_anonymous],nil);
  4067. getprocvardef:=oldprocvardef;
  4068. getfuncrefdef:=oldfuncrefdef;
  4069. { assume that we try to get the address except if certain
  4070. tokens follow that indicate a call }
  4071. do_proc_call(pd.procsym,pd.owner,nil,not (token in [_POINT,_CARET,_LECKKLAMMER]),
  4072. again,p1,[],nil);
  4073. end
  4074. else
  4075. begin
  4076. Message(parser_e_illegal_expression);
  4077. p1:=cerrornode.create;
  4078. { recover }
  4079. consume(token);
  4080. end;
  4081. end
  4082. else
  4083. begin
  4084. Message(parser_e_illegal_expression);
  4085. p1:=cerrornode.create;
  4086. { recover }
  4087. consume(token);
  4088. end;
  4089. end;
  4090. end;
  4091. { generate error node if no node is created }
  4092. if not assigned(p1) then
  4093. begin
  4094. {$ifdef EXTDEBUG}
  4095. Comment(V_Warning,'factor: p1=nil');
  4096. {$endif}
  4097. p1:=cerrornode.create;
  4098. updatefpos:=true;
  4099. end;
  4100. { get the resultdef for the node if nothing stops us }
  4101. if (not assigned(p1.resultdef)) and dopostfix then
  4102. begin
  4103. do_typecheckpass_changed(p1,nodechanged);
  4104. updatefpos:=updatefpos or nodechanged;
  4105. end;
  4106. if assigned(p1) and
  4107. updatefpos then
  4108. p1.fileinfo:=filepos;
  4109. factor:=p1;
  4110. end;
  4111. {$maxfpuregisters default}
  4112. procedure post_comp_expr_gendef(var def: tdef);
  4113. var
  4114. p1 : tnode;
  4115. again : boolean;
  4116. begin
  4117. if not assigned(def) then
  4118. internalerror(2011053001);
  4119. again:=false;
  4120. { handle potential typecasts, etc }
  4121. p1:=handle_factor_typenode(def,false,again,nil,false);
  4122. { parse postfix operators }
  4123. postfixoperators(p1,again,false);
  4124. if assigned(p1) and (p1.nodetype=typen) then
  4125. def:=ttypenode(p1).typedef
  4126. else
  4127. def:=generrordef;
  4128. end;
  4129. {****************************************************************************
  4130. Sub_Expr
  4131. ****************************************************************************}
  4132. function sub_expr(pred_level:Toperator_precedence;flags:texprflags;factornode:tnode):tnode;
  4133. {Reads a subexpression while the operators are of the current precedence
  4134. level, or any higher level. Replaces the old term, simpl_expr and
  4135. simpl2_expr.}
  4136. function istypenode(n:tnode):boolean;inline;
  4137. { Checks whether the given node is a type node or a VMT node containing a
  4138. typenode. This is used in the code for inline specializations in the
  4139. _LT branch below }
  4140. begin
  4141. result:=assigned(n) and
  4142. (
  4143. (n.nodetype=typen) or
  4144. (
  4145. (n.nodetype=loadvmtaddrn) and
  4146. (tloadvmtaddrnode(n).left.nodetype=typen)
  4147. )
  4148. );
  4149. end;
  4150. function gettypedef(n:tnode):tdef;inline;
  4151. { This returns the typedef that belongs to the given typenode or
  4152. loadvmtaddrnode. n must not be Nil! }
  4153. begin
  4154. if n.nodetype=typen then
  4155. result:=ttypenode(n).typedef
  4156. else
  4157. result:=ttypenode(tloadvmtaddrnode(n).left).typedef;
  4158. end;
  4159. function gettypedef(sym:tsym):tdef;inline;
  4160. begin
  4161. result:=nil;
  4162. case sym.typ of
  4163. typesym:
  4164. result:=ttypesym(sym).typedef;
  4165. procsym:
  4166. if not (sp_generic_dummy in sym.symoptions) or (tprocsym(sym).procdeflist.count>0) then
  4167. result:=tdef(tprocsym(sym).procdeflist[0]);
  4168. else
  4169. internalerror(2015092701);
  4170. end;
  4171. end;
  4172. function getgenericsym(n:tnode;out srsym:tsym):boolean;
  4173. var
  4174. srsymtable : tsymtable;
  4175. begin
  4176. srsym:=nil;
  4177. case n.nodetype of
  4178. typen:
  4179. srsym:=ttypenode(n).typedef.typesym;
  4180. loadvmtaddrn:
  4181. srsym:=ttypenode(tloadvmtaddrnode(n).left).typedef.typesym;
  4182. loadn:
  4183. if not searchsym_with_symoption(tloadnode(n).symtableentry.Name,srsym,srsymtable,sp_generic_dummy) then
  4184. srsym:=nil;
  4185. calln:
  4186. srsym:=tcallnode(n).symtableprocentry;
  4187. specializen:
  4188. srsym:=tspecializenode(n).sym;
  4189. { TODO : handle const nodes }
  4190. else
  4191. ;
  4192. end;
  4193. result:=assigned(srsym);
  4194. end;
  4195. function generate_inline_specialization(gendef:tdef;n:tnode;filepos:tfileposinfo;parseddef:tdef;gensym:tsym;p2:tnode):tnode;
  4196. var
  4197. again,
  4198. getaddr : boolean;
  4199. pload : tnode;
  4200. spezcontext : tspecializationcontext;
  4201. structdef,
  4202. inheriteddef : tabstractrecorddef;
  4203. callflags : tcallnodeflags;
  4204. begin
  4205. if n.nodetype=specializen then
  4206. begin
  4207. getaddr:=tspecializenode(n).getaddr;
  4208. pload:=tspecializenode(n).left;
  4209. inheriteddef:=tabstractrecorddef(tspecializenode(n).inheriteddef);
  4210. tspecializenode(n).left:=nil;
  4211. end
  4212. else
  4213. begin
  4214. getaddr:=false;
  4215. pload:=nil;
  4216. inheriteddef:=nil;
  4217. end;
  4218. if assigned(parseddef) and assigned(gensym) and assigned(p2) then
  4219. gendef:=generate_specialization_phase1(spezcontext,gendef,parseddef,gensym.realname,gensym.owner,p2.fileinfo)
  4220. else
  4221. gendef:=generate_specialization_phase1(spezcontext,gendef);
  4222. case gendef.typ of
  4223. errordef:
  4224. begin
  4225. spezcontext.free;
  4226. spezcontext:=nil;
  4227. gensym:=generrorsym;
  4228. end;
  4229. objectdef,
  4230. recorddef,
  4231. procvardef,
  4232. arraydef:
  4233. begin
  4234. gendef:=generate_specialization_phase2(spezcontext,tstoreddef(gendef),false,'');
  4235. spezcontext.free;
  4236. spezcontext:=nil;
  4237. if gendef.typ=errordef then
  4238. gensym:=generrorsym
  4239. else
  4240. gensym:=gendef.typesym;
  4241. end;
  4242. procdef:
  4243. begin
  4244. if block_type<>bt_body then
  4245. begin
  4246. message(parser_e_illegal_expression);
  4247. gensym:=generrorsym;
  4248. end
  4249. else
  4250. begin
  4251. gensym:=tprocdef(gendef).procsym;
  4252. end;
  4253. end;
  4254. else
  4255. internalerror(2015092702);
  4256. end;
  4257. { in case of a class or a record the specialized generic
  4258. is always a classrefdef }
  4259. again:=false;
  4260. if assigned(pload) then
  4261. begin
  4262. result:=pload;
  4263. typecheckpass(result);
  4264. structdef:=inheriteddef;
  4265. if not assigned(structdef) then
  4266. case result.resultdef.typ of
  4267. objectdef,
  4268. recorddef:
  4269. begin
  4270. structdef:=tabstractrecorddef(result.resultdef);
  4271. end;
  4272. classrefdef:
  4273. begin
  4274. structdef:=tabstractrecorddef(tclassrefdef(result.resultdef).pointeddef);
  4275. end;
  4276. else
  4277. internalerror(2015092703);
  4278. end;
  4279. if not (structdef.typ in [recorddef,objectdef]) then
  4280. internalerror(2018092101);
  4281. if assigned(inheriteddef) then
  4282. begin
  4283. callflags:=[cnf_inherited];
  4284. include(current_procinfo.flags,pi_has_inherited);
  4285. end
  4286. else
  4287. callflags:=[];
  4288. do_member_read(structdef,getaddr,gensym,result,again,callflags,spezcontext);
  4289. spezcontext:=nil;
  4290. end
  4291. else
  4292. begin
  4293. if gensym.typ=procsym then
  4294. begin
  4295. result:=nil;
  4296. { check if it's a method/class method }
  4297. if is_member_read(gensym,gensym.owner,result,parseddef) then
  4298. begin
  4299. { if we are accessing a owner procsym from the nested }
  4300. { class we need to call it as a class member }
  4301. if (gensym.owner.symtabletype in [ObjectSymtable,recordsymtable]) and
  4302. assigned(current_structdef) and (current_structdef<>parseddef) and is_owned_by(current_structdef,parseddef) then
  4303. result:=cloadvmtaddrnode.create(ctypenode.create(parseddef));
  4304. { not srsymtable.symtabletype since that can be }
  4305. { withsymtable as well }
  4306. if (gensym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  4307. begin
  4308. do_member_read(tabstractrecorddef(parseddef),getaddr,gensym,result,again,[],spezcontext);
  4309. spezcontext:=nil;
  4310. end
  4311. else
  4312. { no procsyms in records (yet) }
  4313. internalerror(2015092704);
  4314. end
  4315. else
  4316. begin
  4317. { regular procedure/function call }
  4318. do_proc_call(gensym,gensym.owner,nil,
  4319. (getaddr and not(token in [_CARET,_POINT,_LECKKLAMMER])),
  4320. again,result,[],spezcontext);
  4321. spezcontext:=nil;
  4322. end;
  4323. end
  4324. else
  4325. { handle potential typecasts, etc }
  4326. result:=handle_factor_typenode(gendef,false,again,nil,false);
  4327. end;
  4328. { parse postfix operators }
  4329. if postfixoperators(result,again,false) then
  4330. if assigned(result) then
  4331. result.fileinfo:=filepos
  4332. else
  4333. result:=cerrornode.create;
  4334. spezcontext.free;
  4335. end;
  4336. label
  4337. SubExprStart;
  4338. var
  4339. p1,p2,ptmp : tnode;
  4340. oldt : Ttoken;
  4341. filepos : tfileposinfo;
  4342. gendef,parseddef : tdef;
  4343. gensym : tsym;
  4344. genlist : tfpobjectlist;
  4345. dummyagain : boolean;
  4346. dummyspezctxt : tspecializationcontext;
  4347. begin
  4348. SubExprStart:
  4349. if pred_level=highest_precedence then
  4350. begin
  4351. if factornode=nil then
  4352. p1:=factor(false,flags)
  4353. else
  4354. p1:=factornode;
  4355. end
  4356. else
  4357. p1:=sub_expr(succ(pred_level),flags+[ef_accept_equal],factornode);
  4358. repeat
  4359. if (token in [NOTOKEN..last_operator]) and
  4360. (token in operator_levels[pred_level]) and
  4361. ((token<>_EQ) or (ef_accept_equal in flags)) then
  4362. begin
  4363. oldt:=token;
  4364. filepos:=current_tokenpos;
  4365. consume(token);
  4366. if pred_level=highest_precedence then
  4367. p2:=factor(false,[])
  4368. else
  4369. p2:=sub_expr(succ(pred_level),flags+[ef_accept_equal],nil);
  4370. case oldt of
  4371. _PLUS :
  4372. p1:=caddnode.create(addn,p1,p2);
  4373. _MINUS :
  4374. p1:=caddnode.create(subn,p1,p2);
  4375. _STAR :
  4376. p1:=caddnode.create(muln,p1,p2);
  4377. _SLASH :
  4378. p1:=caddnode.create(slashn,p1,p2);
  4379. _EQ:
  4380. p1:=caddnode.create(equaln,p1,p2);
  4381. _GT :
  4382. p1:=caddnode.create(gtn,p1,p2);
  4383. _LT :
  4384. begin
  4385. { we need to decice whether we have an inline specialization
  4386. (type nodes to the left and right of "<", mode Delphi and
  4387. ">" or "," following) or a normal "<" comparison }
  4388. { TODO : p1 could be a non type if e.g. a variable with the
  4389. same name is defined in the same unit where the
  4390. generic is defined (though "same unit" is not
  4391. necessarily needed) }
  4392. if getgenericsym(p1,gensym) and
  4393. { Attention: when nested specializations are supported
  4394. p2 could be a loadn if a "<" follows }
  4395. istypenode(p2) and
  4396. (m_delphi in current_settings.modeswitches) and
  4397. { TODO : add _LT, _LSHARPBRACKET for nested specializations }
  4398. (token in [_GT,_RSHARPBRACKET,_COMMA]) then
  4399. begin
  4400. { this is an inline specialization }
  4401. { retrieve the defs of two nodes }
  4402. if p1.nodetype=specializen then
  4403. gendef:=gettypedef(tspecializenode(p1).sym)
  4404. else
  4405. gendef:=nil;
  4406. parseddef:=gettypedef(p2);
  4407. { check the hints for parseddef }
  4408. check_hints(parseddef.typesym,parseddef.typesym.symoptions,parseddef.typesym.deprecatedmsg,p1.fileinfo);
  4409. ptmp:=generate_inline_specialization(gendef,p1,filepos,parseddef,gensym,p2);
  4410. { we don't need these nodes anymore }
  4411. p1.free;
  4412. p2.free;
  4413. p1:=ptmp;
  4414. { with p1 now set we are in reality directly behind the
  4415. call to "factor" thus we need to call down to that
  4416. again }
  4417. { This is disabled until specializations on the right
  4418. hand side work as well, because
  4419. "not working expressions" is better than "half working
  4420. expressions" }
  4421. {factornode:=p1;
  4422. goto SubExprStart;}
  4423. end
  4424. else
  4425. begin
  4426. { this is a normal "<" comparison }
  4427. { potential generic types that are followed by a "<": }
  4428. if p1.nodetype=specializen then
  4429. begin
  4430. genlist:=tfpobjectlist(current_module.genericdummysyms.find(tspecializenode(p1).sym.name));
  4431. if assigned(genlist) and (genlist.count>0) then
  4432. begin
  4433. gensym:=tgenericdummyentry(genlist.last).resolvedsym;
  4434. check_hints(gensym,gensym.symoptions,gensym.deprecatedmsg,p1.fileinfo);
  4435. dummyagain:=false;
  4436. dummyspezctxt:=nil;
  4437. ptmp:=factor_handle_sym(gensym,
  4438. gensym.owner,
  4439. dummyagain,
  4440. tspecializenode(p1).getaddr,
  4441. false,
  4442. flags,
  4443. dummyspezctxt);
  4444. if dummyagain then
  4445. internalerror(2022012201);
  4446. p1.free;
  4447. p1:=ptmp;
  4448. end
  4449. else
  4450. begin
  4451. identifier_not_found(tspecializenode(p1).sym.realname);
  4452. p1.free;
  4453. p1:=cerrornode.create;
  4454. end;
  4455. end;
  4456. { a) might not have their resultdef set }
  4457. if not assigned(p1.resultdef) then
  4458. do_typecheckpass(p1);
  4459. { b) are not checked whether they are an undefined def,
  4460. but not a generic parameter }
  4461. if (p1.nodetype=typen) and
  4462. (ttypenode(p1).typedef.typ=undefineddef) and
  4463. assigned(ttypenode(p1).typedef.typesym) and
  4464. not (sp_generic_para in ttypenode(p1).typedef.typesym.symoptions) then
  4465. begin
  4466. identifier_not_found(ttypenode(p1).typedef.typesym.RealName);
  4467. p1.Free;
  4468. p1:=cerrornode.create;
  4469. end;
  4470. { c) don't have their hints checked }
  4471. if istypenode(p1) then
  4472. begin
  4473. gendef:=gettypedef(p1);
  4474. if gendef.typ in [objectdef,recorddef,arraydef,procvardef] then
  4475. check_hints(gendef.typesym,gendef.typesym.symoptions,gendef.typesym.deprecatedmsg);
  4476. end;
  4477. { Note: the second part of the expression will be needed
  4478. for nested specializations }
  4479. if istypenode(p2) {and
  4480. not (token in [_LT, _LSHARPBRACKET])} then
  4481. begin
  4482. gendef:=gettypedef(p2);
  4483. if gendef.typ in [objectdef,recorddef,arraydef,procvardef] then
  4484. check_hints(gendef.typesym,gendef.typesym.symoptions,gendef.typesym.deprecatedmsg);
  4485. end;
  4486. { create the comparison node for "<" }
  4487. p1:=caddnode.create(ltn,p1,p2)
  4488. end;
  4489. end;
  4490. _GTE :
  4491. p1:=caddnode.create(gten,p1,p2);
  4492. _LTE :
  4493. p1:=caddnode.create(lten,p1,p2);
  4494. _SYMDIF :
  4495. p1:=caddnode.create(symdifn,p1,p2);
  4496. _STARSTAR :
  4497. p1:=caddnode.create(starstarn,p1,p2);
  4498. _OP_AS,
  4499. _OP_IS :
  4500. begin
  4501. if (m_delphi in current_settings.modeswitches) and
  4502. (token in [_LT, _LSHARPBRACKET]) and
  4503. getgenericsym(p2,gensym) then
  4504. begin
  4505. { for now we're handling this as a generic declaration;
  4506. there could be cases though (because of operator
  4507. overloading) where this is the wrong decision... }
  4508. if gensym.typ=typesym then
  4509. gendef:=ttypesym(gensym).typedef
  4510. else
  4511. if gensym.typ=procsym then
  4512. gendef:=tdef(tprocsym(gensym).procdeflist[0])
  4513. else
  4514. internalerror(2015072401);
  4515. ptmp:=generate_inline_specialization(gendef,p2,filepos,nil,nil,nil);
  4516. { we don't need the old p2 anymore }
  4517. p2.Free;
  4518. p2:=ptmp;
  4519. { here we don't need to call back down to "factor", thus
  4520. no "goto" }
  4521. end;
  4522. { now generate the "is" or "as" node }
  4523. case oldt of
  4524. _OP_AS:
  4525. p1:=casnode.create(p1,p2);
  4526. _OP_IS:
  4527. p1:=cisnode.create(p1,p2);
  4528. else
  4529. internalerror(2019050528);
  4530. end;
  4531. end;
  4532. _OP_IN :
  4533. p1:=cinnode.create(p1,p2);
  4534. _OP_OR,
  4535. _PIPE {macpas only} :
  4536. begin
  4537. p1:=caddnode.create(orn,p1,p2);
  4538. if (oldt = _PIPE) then
  4539. include(p1.flags,nf_short_bool);
  4540. end;
  4541. _OP_AND,
  4542. _AMPERSAND {macpas only} :
  4543. begin
  4544. p1:=caddnode.create(andn,p1,p2);
  4545. if (oldt = _AMPERSAND) then
  4546. include(p1.flags,nf_short_bool);
  4547. end;
  4548. _OP_DIV :
  4549. p1:=cmoddivnode.create(divn,p1,p2);
  4550. _OP_NOT :
  4551. p1:=cnotnode.create(p1);
  4552. _OP_MOD :
  4553. begin
  4554. p1:=cmoddivnode.create(modn,p1,p2);
  4555. if m_isolike_mod in current_settings.modeswitches then
  4556. include(p1.flags,nf_isomod);
  4557. end;
  4558. _OP_SHL :
  4559. p1:=cshlshrnode.create(shln,p1,p2);
  4560. _OP_SHR :
  4561. p1:=cshlshrnode.create(shrn,p1,p2);
  4562. _OP_XOR :
  4563. p1:=caddnode.create(xorn,p1,p2);
  4564. _ASSIGNMENT :
  4565. p1:=cassignmentnode.create(p1,p2);
  4566. _NE :
  4567. p1:=caddnode.create(unequaln,p1,p2);
  4568. else
  4569. internalerror(2019050529);
  4570. end;
  4571. p1.fileinfo:=filepos;
  4572. end
  4573. else
  4574. break;
  4575. until false;
  4576. sub_expr:=p1;
  4577. end;
  4578. function comp_expr(flags:texprflags):tnode;
  4579. var
  4580. oldafterassignment : boolean;
  4581. p1 : tnode;
  4582. begin
  4583. oldafterassignment:=afterassignment;
  4584. afterassignment:=true;
  4585. p1:=sub_expr(opcompare,flags,nil);
  4586. { get the resultdef for this expression }
  4587. if not assigned(p1.resultdef) then
  4588. do_typecheckpass(p1);
  4589. afterassignment:=oldafterassignment;
  4590. comp_expr:=p1;
  4591. end;
  4592. function expr(dotypecheck : boolean) : tnode;
  4593. var
  4594. p1,p2 : tnode;
  4595. filepos : tfileposinfo;
  4596. oldafterassignment,
  4597. updatefpos : boolean;
  4598. oldflags : tnodeflags;
  4599. begin
  4600. oldafterassignment:=afterassignment;
  4601. p1:=sub_expr(opcompare,[ef_accept_equal],nil);
  4602. { get the resultdef for this expression }
  4603. if not assigned(p1.resultdef) and
  4604. dotypecheck then
  4605. do_typecheckpass(p1);
  4606. filepos:=current_tokenpos;
  4607. if token in [_ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
  4608. afterassignment:=true;
  4609. updatefpos:=true;
  4610. case token of
  4611. _POINTPOINT :
  4612. begin
  4613. consume(_POINTPOINT);
  4614. p2:=sub_expr(opcompare,[ef_accept_equal],nil);
  4615. p1:=crangenode.create(p1,p2);
  4616. end;
  4617. _ASSIGNMENT :
  4618. begin
  4619. consume(_ASSIGNMENT);
  4620. if assigned(p1.resultdef) then
  4621. if (p1.resultdef.typ=procvardef) then
  4622. getprocvardef:=tprocvardef(p1.resultdef)
  4623. else if is_invokable(p1.resultdef) then
  4624. getfuncrefdef:=tobjectdef(p1.resultdef);
  4625. p2:=sub_expr(opcompare,[ef_accept_equal],nil);
  4626. if assigned(getprocvardef) then
  4627. handle_procvar(getprocvardef,p2)
  4628. else if assigned(getfuncrefdef) then
  4629. handle_funcref(getfuncrefdef,p2);
  4630. getprocvardef:=nil;
  4631. getfuncrefdef:=nil;
  4632. p1:=cassignmentnode.create(p1,p2);
  4633. end;
  4634. _PLUSASN :
  4635. begin
  4636. consume(_PLUSASN);
  4637. p2:=sub_expr(opcompare,[ef_accept_equal],nil);
  4638. p1:=gen_c_style_operator(addn,p1,p2);
  4639. end;
  4640. _MINUSASN :
  4641. begin
  4642. consume(_MINUSASN);
  4643. p2:=sub_expr(opcompare,[ef_accept_equal],nil);
  4644. p1:=gen_c_style_operator(subn,p1,p2);
  4645. end;
  4646. _STARASN :
  4647. begin
  4648. consume(_STARASN );
  4649. p2:=sub_expr(opcompare,[ef_accept_equal],nil);
  4650. p1:=gen_c_style_operator(muln,p1,p2);
  4651. end;
  4652. _SLASHASN :
  4653. begin
  4654. consume(_SLASHASN );
  4655. p2:=sub_expr(opcompare,[ef_accept_equal],nil);
  4656. p1:=gen_c_style_operator(slashn,p1,p2);
  4657. end;
  4658. else
  4659. updatefpos:=false;
  4660. end;
  4661. oldflags:=p1.flags;
  4662. { get the resultdef for this expression }
  4663. if not assigned(p1.resultdef) and
  4664. dotypecheck then
  4665. do_typecheckpass(p1);
  4666. { transfer generic paramter flag }
  4667. if nf_generic_para in oldflags then
  4668. include(p1.flags,nf_generic_para);
  4669. afterassignment:=oldafterassignment;
  4670. if updatefpos then
  4671. p1.fileinfo:=filepos;
  4672. expr:=p1;
  4673. end;
  4674. function get_intconst:TConstExprInt;
  4675. {Reads an expression, tries to evalute it and check if it is an integer
  4676. constant. Then the constant is returned.}
  4677. var
  4678. p:tnode;
  4679. begin
  4680. result:=0;
  4681. p:=comp_expr([ef_accept_equal]);
  4682. if not codegenerror then
  4683. begin
  4684. if (p.nodetype<>ordconstn) or
  4685. not(is_integer(p.resultdef)) then
  4686. Message(parser_e_illegal_expression)
  4687. else
  4688. result:=tordconstnode(p).value;
  4689. end;
  4690. p.free;
  4691. end;
  4692. function get_stringconst:string;
  4693. {Reads an expression, tries to evaluate it and checks if it is a string
  4694. constant. Then the constant is returned.}
  4695. var
  4696. p:tnode;
  4697. begin
  4698. get_stringconst:='';
  4699. p:=comp_expr([ef_accept_equal]);
  4700. if p.nodetype<>stringconstn then
  4701. begin
  4702. if (p.nodetype=ordconstn) and is_char(p.resultdef) then
  4703. get_stringconst:=char(int64(tordconstnode(p).value))
  4704. else
  4705. Message(parser_e_illegal_expression);
  4706. end
  4707. else
  4708. get_stringconst:=strpas(tstringconstnode(p).value_str);
  4709. p.free;
  4710. end;
  4711. end.