pexpr.pas 204 KB

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