pexpr.pas 133 KB

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