pexpr.pas 201 KB

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