pexpr.pas 120 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055
  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. implementation
  37. uses
  38. { common }
  39. cutils,
  40. { global }
  41. verbose,
  42. systems,widestr,
  43. { symtable }
  44. symconst,symtable,symsym,defutil,defcmp,
  45. { module }
  46. fmodule,ppu,
  47. { pass 1 }
  48. pass_1,htypechk,
  49. nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
  50. { parser }
  51. scanner,
  52. pbase,pinline,ptype,
  53. { codegen }
  54. cgbase,procinfo,cpuinfo
  55. ;
  56. { sub_expr(opmultiply) is need to get -1 ** 4 to be
  57. read as - (1**4) and not (-1)**4 PM }
  58. type
  59. Toperator_precedence=(opcompare,opaddition,opmultiply,oppower);
  60. const
  61. highest_precedence = oppower;
  62. function sub_expr(pred_level:Toperator_precedence;accept_equal,typeonly:boolean):tnode;forward;
  63. const
  64. { true, if the inherited call is anonymous }
  65. anon_inherited : boolean = false;
  66. { last def found, only used by anon. inherited calls to insert proper type casts }
  67. srdef : tdef = nil;
  68. procedure string_dec(var def:tdef; allowtypedef: boolean);
  69. { reads a string type with optional length }
  70. { and returns a pointer to the string }
  71. { definition }
  72. var
  73. p : tnode;
  74. begin
  75. def:=cshortstringtype;
  76. consume(_STRING);
  77. if (token=_LECKKLAMMER) then
  78. begin
  79. if not(allowtypedef) then
  80. Message(parser_e_no_local_para_def);
  81. consume(_LECKKLAMMER);
  82. p:=comp_expr(true,false);
  83. if not is_constintnode(p) then
  84. begin
  85. Message(parser_e_illegal_expression);
  86. { error recovery }
  87. consume(_RECKKLAMMER);
  88. end
  89. else
  90. begin
  91. if (tordconstnode(p).value<=0) then
  92. begin
  93. Message(parser_e_invalid_string_size);
  94. tordconstnode(p).value:=255;
  95. end;
  96. consume(_RECKKLAMMER);
  97. if tordconstnode(p).value>255 then
  98. begin
  99. { longstring is currently unsupported (CEC)! }
  100. { t:=tstringdef.createlong(tordconstnode(p).value))}
  101. Message(parser_e_invalid_string_size);
  102. tordconstnode(p).value:=255;
  103. def:=tstringdef.createshort(int64(tordconstnode(p).value));
  104. end
  105. else
  106. if tordconstnode(p).value<>255 then
  107. def:=tstringdef.createshort(int64(tordconstnode(p).value));
  108. end;
  109. p.free;
  110. end
  111. else
  112. begin
  113. if cs_unicodestrings in current_settings.localswitches then
  114. def:=cunicodestringtype
  115. else if cs_ansistrings in current_settings.localswitches then
  116. def:=cansistringtype
  117. else
  118. def:=cshortstringtype;
  119. end;
  120. end;
  121. function parse_paras(__colon,__namedpara : boolean;end_of_paras : ttoken) : tnode;
  122. var
  123. p1,p2,argname : tnode;
  124. prev_in_args,
  125. old_named_args_allowed,
  126. old_allow_array_constructor : boolean;
  127. begin
  128. if token=end_of_paras then
  129. begin
  130. parse_paras:=nil;
  131. exit;
  132. end;
  133. { save old values }
  134. prev_in_args:=in_args;
  135. old_allow_array_constructor:=allow_array_constructor;
  136. old_named_args_allowed:=named_args_allowed;
  137. { set para parsing values }
  138. in_args:=true;
  139. named_args_allowed:=false;
  140. allow_array_constructor:=true;
  141. p2:=nil;
  142. repeat
  143. if __namedpara then
  144. begin
  145. if token=_COMMA then
  146. begin
  147. { empty parameter }
  148. p2:=ccallparanode.create(cnothingnode.create,p2);
  149. end
  150. else
  151. begin
  152. named_args_allowed:=true;
  153. p1:=comp_expr(true,false);
  154. named_args_allowed:=false;
  155. if found_arg_name then
  156. begin
  157. argname:=p1;
  158. p1:=comp_expr(true,false);
  159. p2:=ccallparanode.create(p1,p2);
  160. tcallparanode(p2).parametername:=argname;
  161. end
  162. else
  163. p2:=ccallparanode.create(p1,p2);
  164. found_arg_name:=false;
  165. end;
  166. end
  167. else
  168. begin
  169. p1:=comp_expr(true,false);
  170. p2:=ccallparanode.create(p1,p2);
  171. end;
  172. { it's for the str(l:5,s); }
  173. if __colon and (token=_COLON) then
  174. begin
  175. consume(_COLON);
  176. p1:=comp_expr(true,false);
  177. p2:=ccallparanode.create(p1,p2);
  178. include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
  179. if try_to_consume(_COLON) then
  180. begin
  181. p1:=comp_expr(true,false);
  182. p2:=ccallparanode.create(p1,p2);
  183. include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
  184. end
  185. end;
  186. until not try_to_consume(_COMMA);
  187. allow_array_constructor:=old_allow_array_constructor;
  188. in_args:=prev_in_args;
  189. named_args_allowed:=old_named_args_allowed;
  190. parse_paras:=p2;
  191. end;
  192. function gen_c_style_operator(ntyp:tnodetype;p1,p2:tnode) : tnode;
  193. var
  194. hp : tnode;
  195. hdef : tdef;
  196. temp : ttempcreatenode;
  197. newstatement : tstatementnode;
  198. begin
  199. { Properties are not allowed, because the write can
  200. be different from the read }
  201. if (nf_isproperty in p1.flags) then
  202. begin
  203. Message(type_e_variable_id_expected);
  204. { We can continue with the loading,
  205. it'll not create errors. Only the expected
  206. result can be wrong }
  207. end;
  208. hp:=p1;
  209. while assigned(hp) and
  210. (hp.nodetype in [derefn,subscriptn,vecn,typeconvn]) do
  211. hp:=tunarynode(hp).left;
  212. if not assigned(hp) then
  213. internalerror(200410121);
  214. if (hp.nodetype=calln) then
  215. begin
  216. typecheckpass(p1);
  217. result:=internalstatements(newstatement);
  218. hdef:=getpointerdef(p1.resultdef);
  219. temp:=ctempcreatenode.create(hdef,sizeof(pint),tt_persistent,false);
  220. addstatement(newstatement,temp);
  221. addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(temp),caddrnode.create_internal(p1)));
  222. addstatement(newstatement,cassignmentnode.create(
  223. cderefnode.create(ctemprefnode.create(temp)),
  224. caddnode.create(ntyp,
  225. cderefnode.create(ctemprefnode.create(temp)),
  226. p2)));
  227. addstatement(newstatement,ctempdeletenode.create(temp));
  228. end
  229. else
  230. result:=cassignmentnode.create(p1,caddnode.create(ntyp,p1.getcopy,p2));
  231. end;
  232. function statement_syssym(l : byte) : tnode;
  233. var
  234. p1,p2,paras : tnode;
  235. err,
  236. prev_in_args : boolean;
  237. begin
  238. prev_in_args:=in_args;
  239. case l of
  240. in_new_x :
  241. begin
  242. if afterassignment or in_args then
  243. statement_syssym:=new_function
  244. else
  245. statement_syssym:=new_dispose_statement(true);
  246. end;
  247. in_dispose_x :
  248. begin
  249. statement_syssym:=new_dispose_statement(false);
  250. end;
  251. in_ord_x :
  252. begin
  253. consume(_LKLAMMER);
  254. in_args:=true;
  255. p1:=comp_expr(true,false);
  256. consume(_RKLAMMER);
  257. p1:=geninlinenode(in_ord_x,false,p1);
  258. statement_syssym := p1;
  259. end;
  260. in_exit :
  261. begin
  262. if try_to_consume(_LKLAMMER) then
  263. begin
  264. if not (m_mac in current_settings.modeswitches) then
  265. begin
  266. if not(try_to_consume(_RKLAMMER)) then
  267. begin
  268. p1:=comp_expr(true,false);
  269. consume(_RKLAMMER);
  270. if (not assigned(current_procinfo) or
  271. is_void(current_procinfo.procdef.returndef)) then
  272. begin
  273. Message(parser_e_void_function);
  274. { recovery }
  275. p1.free;
  276. p1:=nil;
  277. end;
  278. end
  279. else
  280. p1:=nil;
  281. end
  282. else
  283. begin
  284. if not (current_procinfo.procdef.procsym.name = pattern) then
  285. Message(parser_e_macpas_exit_wrong_param);
  286. consume(_ID);
  287. consume(_RKLAMMER);
  288. p1:=nil;
  289. end
  290. end
  291. else
  292. p1:=nil;
  293. statement_syssym:=cexitnode.create(p1);
  294. end;
  295. in_break :
  296. begin
  297. statement_syssym:=cbreaknode.create
  298. end;
  299. in_continue :
  300. begin
  301. statement_syssym:=ccontinuenode.create
  302. end;
  303. in_leave :
  304. begin
  305. if m_mac in current_settings.modeswitches then
  306. statement_syssym:=cbreaknode.create
  307. else
  308. begin
  309. Message1(sym_e_id_not_found, orgpattern);
  310. statement_syssym:=cerrornode.create;
  311. end;
  312. end;
  313. in_cycle :
  314. begin
  315. if m_mac in current_settings.modeswitches then
  316. statement_syssym:=ccontinuenode.create
  317. else
  318. begin
  319. Message1(sym_e_id_not_found, orgpattern);
  320. statement_syssym:=cerrornode.create;
  321. end;
  322. end;
  323. in_typeof_x :
  324. begin
  325. consume(_LKLAMMER);
  326. in_args:=true;
  327. p1:=comp_expr(true,false);
  328. consume(_RKLAMMER);
  329. if p1.nodetype=typen then
  330. ttypenode(p1).allowed:=true;
  331. { Allow classrefdef, which is required for
  332. Typeof(self) in static class methods }
  333. if not(is_objc_class_or_protocol(p1.resultdef)) and
  334. not(is_java_class_or_interface(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. ) then
  363. begin
  364. statement_syssym:=geninlinenode(in_sizeof_x,false,p1);
  365. { no packed bit support for these things }
  366. if (l = in_bitsizeof_x) then
  367. statement_syssym:=caddnode.create(muln,statement_syssym,cordconstnode.create(8,sinttype,true));
  368. end
  369. else
  370. begin
  371. { allow helpers for SizeOf and BitSizeOf }
  372. if p1.nodetype=typen then
  373. ttypenode(p1).helperallowed:=true;
  374. if (p1.resultdef.typ=forwarddef) then
  375. Message1(type_e_type_is_not_completly_defined,tforwarddef(p1.resultdef).tosymname^);
  376. if (l = in_sizeof_x) or
  377. (not((p1.nodetype = vecn) and
  378. is_packed_array(tvecnode(p1).left.resultdef)) and
  379. not((p1.nodetype = subscriptn) and
  380. is_packed_record_or_object(tsubscriptnode(p1).left.resultdef))) then
  381. begin
  382. statement_syssym:=cordconstnode.create(p1.resultdef.size,sinttype,true);
  383. if (l = in_bitsizeof_x) then
  384. statement_syssym:=caddnode.create(muln,statement_syssym,cordconstnode.create(8,sinttype,true));
  385. end
  386. else
  387. statement_syssym:=cordconstnode.create(p1.resultdef.packedbitsize,sinttype,true);
  388. { p1 not needed !}
  389. p1.destroy;
  390. end;
  391. end;
  392. in_typeinfo_x,
  393. in_objc_encode_x :
  394. begin
  395. if (l=in_typeinfo_x) or
  396. (m_objectivec1 in current_settings.modeswitches) then
  397. begin
  398. consume(_LKLAMMER);
  399. in_args:=true;
  400. p1:=comp_expr(true,false);
  401. { When reading a class type it is parsed as loadvmtaddrn,
  402. typeinfo only needs the type so we remove the loadvmtaddrn }
  403. if p1.nodetype=loadvmtaddrn then
  404. begin
  405. p2:=tloadvmtaddrnode(p1).left;
  406. tloadvmtaddrnode(p1).left:=nil;
  407. p1.free;
  408. p1:=p2;
  409. end;
  410. if p1.nodetype=typen then
  411. begin
  412. ttypenode(p1).allowed:=true;
  413. { allow helpers for TypeInfo }
  414. if l=in_typeinfo_x then
  415. ttypenode(p1).helperallowed:=true;
  416. end;
  417. { else
  418. begin
  419. p1.destroy;
  420. p1:=cerrornode.create;
  421. Message(parser_e_illegal_parameter_list);
  422. end;}
  423. consume(_RKLAMMER);
  424. p2:=geninlinenode(l,false,p1);
  425. statement_syssym:=p2;
  426. end
  427. else
  428. begin
  429. Message1(sym_e_id_not_found, orgpattern);
  430. statement_syssym:=cerrornode.create;
  431. end;
  432. end;
  433. in_unaligned_x :
  434. begin
  435. err:=false;
  436. consume(_LKLAMMER);
  437. in_args:=true;
  438. p1:=comp_expr(true,false);
  439. p2:=ccallparanode.create(p1,nil);
  440. p2:=geninlinenode(in_unaligned_x,false,p2);
  441. consume(_RKLAMMER);
  442. statement_syssym:=p2;
  443. end;
  444. in_assigned_x :
  445. begin
  446. err:=false;
  447. consume(_LKLAMMER);
  448. in_args:=true;
  449. p1:=comp_expr(true,false);
  450. { When reading a class type it is parsed as loadvmtaddrn,
  451. typeinfo only needs the type so we remove the loadvmtaddrn }
  452. if p1.nodetype=loadvmtaddrn then
  453. begin
  454. p2:=tloadvmtaddrnode(p1).left;
  455. tloadvmtaddrnode(p1).left:=nil;
  456. p1.free;
  457. p1:=p2;
  458. end;
  459. if not codegenerror then
  460. begin
  461. case p1.resultdef.typ of
  462. procdef, { procvar }
  463. pointerdef,
  464. procvardef,
  465. classrefdef : ;
  466. objectdef :
  467. if not is_implicit_pointer_object_type(p1.resultdef) then
  468. begin
  469. Message(parser_e_illegal_parameter_list);
  470. err:=true;
  471. end;
  472. arraydef :
  473. if not is_dynamic_array(p1.resultdef) then
  474. begin
  475. Message(parser_e_illegal_parameter_list);
  476. err:=true;
  477. end;
  478. else
  479. if p1.resultdef.typ<>undefineddef then
  480. begin
  481. Message(parser_e_illegal_parameter_list);
  482. err:=true;
  483. end;
  484. end;
  485. end
  486. else
  487. err:=true;
  488. if not err then
  489. begin
  490. p2:=ccallparanode.create(p1,nil);
  491. p2:=geninlinenode(in_assigned_x,false,p2);
  492. end
  493. else
  494. begin
  495. p1.free;
  496. p2:=cerrornode.create;
  497. end;
  498. consume(_RKLAMMER);
  499. statement_syssym:=p2;
  500. end;
  501. in_addr_x :
  502. begin
  503. consume(_LKLAMMER);
  504. in_args:=true;
  505. p1:=comp_expr(true,false);
  506. p1:=caddrnode.create(p1);
  507. consume(_RKLAMMER);
  508. statement_syssym:=p1;
  509. end;
  510. in_ofs_x :
  511. begin
  512. if target_info.system in systems_managed_vm then
  513. message(parser_e_feature_unsupported_for_vm);
  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) then
  833. begin
  834. aprocdef:=Tprocsym(sym).Find_procdef_byprocvardef(getprocvardef);
  835. if assigned(aprocdef) then
  836. getaddr:=true;
  837. end;
  838. end;
  839. { only need to get the address of the procedure? }
  840. if getaddr then
  841. begin
  842. { Retrieve info which procvar to call. For tp_procvar the
  843. aprocdef is already loaded above so we can reuse it }
  844. if not assigned(aprocdef) and
  845. assigned(getprocvardef) then
  846. aprocdef:=Tprocsym(sym).Find_procdef_byprocvardef(getprocvardef);
  847. { generate a methodcallnode or proccallnode }
  848. { we shouldn't convert things like @tcollection.load }
  849. p2:=cloadnode.create_procvar(sym,aprocdef,st);
  850. if assigned(p1) then
  851. begin
  852. { for loading methodpointer of an inherited function
  853. we use self as instance and load the address of
  854. the function directly and not through the vmt (PFV) }
  855. if (cnf_inherited in callflags) then
  856. begin
  857. include(p2.flags,nf_inherited);
  858. p1.free;
  859. p1:=load_self_node;
  860. end;
  861. if (p1.nodetype<>typen) then
  862. tloadnode(p2).set_mp(p1)
  863. else
  864. p1.free;
  865. end;
  866. p1:=p2;
  867. { no postfix operators }
  868. again:=false;
  869. end
  870. else
  871. begin
  872. para:=nil;
  873. if anon_inherited then
  874. begin
  875. if not assigned(current_procinfo) then
  876. internalerror(200305054);
  877. for i:=0 to current_procinfo.procdef.paras.count-1 do
  878. begin
  879. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  880. if not(vo_is_hidden_para in currpara.varoptions) then
  881. begin
  882. { inheritance by msgint? }
  883. if assigned(srdef) then
  884. { anonymous inherited via msgid calls only require a var parameter for
  885. both methods, so we need some type casting here }
  886. para:=ccallparanode.create(ctypeconvnode.create_internal(ctypeconvnode.create_internal(
  887. cloadnode.create(currpara,currpara.owner),cformaltype),tparavarsym(tprocdef(srdef).paras[i]).vardef),
  888. para)
  889. else
  890. para:=ccallparanode.create(cloadnode.create(currpara,currpara.owner),para);
  891. end;
  892. end;
  893. end
  894. else
  895. begin
  896. if try_to_consume(_LKLAMMER) then
  897. begin
  898. para:=parse_paras(false,false,_RKLAMMER);
  899. consume(_RKLAMMER);
  900. end;
  901. end;
  902. { indicate if this call was generated by a member and
  903. no explicit self is used, this is needed to determine
  904. how to handle a destructor call (PFV) }
  905. if membercall then
  906. include(callflags,cnf_member_call);
  907. if assigned(obj) then
  908. begin
  909. if not (st.symtabletype in [ObjectSymtable,recordsymtable]) then
  910. internalerror(200310031);
  911. p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1,callflags);
  912. end
  913. else
  914. p1:=ccallnode.create(para,tprocsym(sym),st,p1,callflags);
  915. end;
  916. afterassignment:=prevafterassn;
  917. end;
  918. procedure handle_procvar(pv : tprocvardef;var p2 : tnode);
  919. var
  920. hp,hp2 : tnode;
  921. hpp : ^tnode;
  922. currprocdef : tprocdef;
  923. begin
  924. if not assigned(pv) then
  925. internalerror(200301121);
  926. if (m_tp_procvar in current_settings.modeswitches) or
  927. (m_mac_procvar in current_settings.modeswitches) then
  928. begin
  929. hp:=p2;
  930. hpp:=@p2;
  931. while assigned(hp) and
  932. (hp.nodetype=typeconvn) do
  933. begin
  934. hp:=ttypeconvnode(hp).left;
  935. { save orignal address of the old tree so we can replace the node }
  936. hpp:=@hp;
  937. end;
  938. if (hp.nodetype=calln) and
  939. { a procvar can't have parameters! }
  940. not assigned(tcallnode(hp).left) then
  941. begin
  942. currprocdef:=tcallnode(hp).symtableprocentry.Find_procdef_byprocvardef(pv);
  943. if assigned(currprocdef) then
  944. begin
  945. hp2:=cloadnode.create_procvar(tprocsym(tcallnode(hp).symtableprocentry),currprocdef,tcallnode(hp).symtableproc);
  946. if (po_methodpointer in pv.procoptions) then
  947. tloadnode(hp2).set_mp(tcallnode(hp).methodpointer.getcopy);
  948. hp.destroy;
  949. { replace the old callnode with the new loadnode }
  950. hpp^:=hp2;
  951. end;
  952. end;
  953. end;
  954. end;
  955. { the following procedure handles the access to a property symbol }
  956. procedure handle_propertysym(propsym : tpropertysym;st : TSymtable;var p1 : tnode);
  957. var
  958. paras : tnode;
  959. p2 : tnode;
  960. membercall : boolean;
  961. callflags : tcallnodeflags;
  962. propaccesslist : tpropaccesslist;
  963. sym: tsym;
  964. begin
  965. { property parameters? read them only if the property really }
  966. { has parameters }
  967. paras:=nil;
  968. if (ppo_hasparameters in propsym.propoptions) then
  969. begin
  970. if try_to_consume(_LECKKLAMMER) then
  971. begin
  972. paras:=parse_paras(false,false,_RECKKLAMMER);
  973. consume(_RECKKLAMMER);
  974. end;
  975. end;
  976. { indexed property }
  977. if (ppo_indexed in propsym.propoptions) then
  978. begin
  979. p2:=cordconstnode.create(propsym.index,propsym.indexdef,true);
  980. paras:=ccallparanode.create(p2,paras);
  981. end;
  982. { we need only a write property if a := follows }
  983. { if not(afterassignment) and not(in_args) then }
  984. if token=_ASSIGNMENT then
  985. begin
  986. if getpropaccesslist(propsym,palt_write,propaccesslist) then
  987. begin
  988. sym:=propaccesslist.firstsym^.sym;
  989. case sym.typ of
  990. procsym :
  991. begin
  992. callflags:=[];
  993. { generate the method call }
  994. membercall:=maybe_load_methodpointer(st,p1);
  995. if membercall then
  996. include(callflags,cnf_member_call);
  997. p1:=ccallnode.create(paras,tprocsym(sym),st,p1,callflags);
  998. addsymref(sym);
  999. paras:=nil;
  1000. consume(_ASSIGNMENT);
  1001. { read the expression }
  1002. if propsym.propdef.typ=procvardef then
  1003. getprocvardef:=tprocvardef(propsym.propdef);
  1004. p2:=comp_expr(true,false);
  1005. if assigned(getprocvardef) then
  1006. handle_procvar(getprocvardef,p2);
  1007. tcallnode(p1).left:=ccallparanode.create(p2,tcallnode(p1).left);
  1008. { mark as property, both the tcallnode and the real call block }
  1009. include(p1.flags,nf_isproperty);
  1010. getprocvardef:=nil;
  1011. end;
  1012. fieldvarsym :
  1013. begin
  1014. { generate access code }
  1015. if not handle_staticfield_access(sym,false,p1) then
  1016. propaccesslist_to_node(p1,st,propaccesslist);
  1017. include(p1.flags,nf_isproperty);
  1018. consume(_ASSIGNMENT);
  1019. { read the expression }
  1020. p2:=comp_expr(true,false);
  1021. p1:=cassignmentnode.create(p1,p2);
  1022. end
  1023. else
  1024. begin
  1025. p1:=cerrornode.create;
  1026. Message(parser_e_no_procedure_to_access_property);
  1027. end;
  1028. end;
  1029. end
  1030. else
  1031. begin
  1032. p1:=cerrornode.create;
  1033. Message(parser_e_no_procedure_to_access_property);
  1034. end;
  1035. end
  1036. else
  1037. begin
  1038. if getpropaccesslist(propsym,palt_read,propaccesslist) then
  1039. begin
  1040. sym := propaccesslist.firstsym^.sym;
  1041. case sym.typ of
  1042. fieldvarsym :
  1043. begin
  1044. { generate access code }
  1045. if not handle_staticfield_access(sym,false,p1) then
  1046. propaccesslist_to_node(p1,st,propaccesslist);
  1047. include(p1.flags,nf_isproperty);
  1048. end;
  1049. procsym :
  1050. begin
  1051. callflags:=[];
  1052. { generate the method call }
  1053. membercall:=maybe_load_methodpointer(st,p1);
  1054. if membercall then
  1055. include(callflags,cnf_member_call);
  1056. p1:=ccallnode.create(paras,tprocsym(sym),st,p1,callflags);
  1057. paras:=nil;
  1058. include(p1.flags,nf_isproperty);
  1059. end
  1060. else
  1061. begin
  1062. p1:=cerrornode.create;
  1063. Message(type_e_mismatch);
  1064. end;
  1065. end;
  1066. end
  1067. else
  1068. begin
  1069. { error, no function to read property }
  1070. p1:=cerrornode.create;
  1071. Message(parser_e_no_procedure_to_access_property);
  1072. end;
  1073. end;
  1074. { release paras if not used }
  1075. if assigned(paras) then
  1076. paras.free;
  1077. end;
  1078. { the ID token has to be consumed before calling this function }
  1079. procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags);
  1080. var
  1081. isclassref : boolean;
  1082. begin
  1083. if sym=nil then
  1084. begin
  1085. { pattern is still valid unless
  1086. there is another ID just after the ID of sym }
  1087. Message1(sym_e_id_no_member,orgpattern);
  1088. p1.free;
  1089. p1:=cerrornode.create;
  1090. { try to clean up }
  1091. again:=false;
  1092. end
  1093. else
  1094. begin
  1095. if assigned(p1) then
  1096. begin
  1097. if not assigned(p1.resultdef) then
  1098. do_typecheckpass(p1);
  1099. isclassref:=(p1.resultdef.typ=classrefdef);
  1100. end
  1101. else
  1102. isclassref:=false;
  1103. { we assume, that only procsyms and varsyms are in an object }
  1104. { symbol table, for classes, properties are allowed }
  1105. case sym.typ of
  1106. procsym:
  1107. begin
  1108. do_proc_call(sym,sym.owner,structh,
  1109. (getaddr and not(token in [_CARET,_POINT])),
  1110. again,p1,callflags);
  1111. { we need to know which procedure is called }
  1112. do_typecheckpass(p1);
  1113. { calling using classref? }
  1114. if isclassref and
  1115. (p1.nodetype=calln) and
  1116. assigned(tcallnode(p1).procdefinition) then
  1117. begin
  1118. if not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
  1119. not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
  1120. Message(parser_e_only_class_members_via_class_ref);
  1121. { in Java, constructors are not automatically inherited
  1122. -> calling a constructor from a parent type will create
  1123. an instance of that parent type! }
  1124. if is_javaclass(structh) and
  1125. (tcallnode(p1).procdefinition.proctypeoption=potype_constructor) and
  1126. (tcallnode(p1).procdefinition.owner.defowner<>find_real_class_definition(tobjectdef(structh),false)) then
  1127. Message(parser_e_java_no_inherited_constructor);
  1128. end;
  1129. end;
  1130. fieldvarsym:
  1131. begin
  1132. if not handle_staticfield_access(sym,true,p1) then
  1133. begin
  1134. if isclassref then
  1135. if assigned(p1) and
  1136. (
  1137. is_self_node(p1) or
  1138. (assigned(current_procinfo) and (current_procinfo.procdef.no_self_node) and
  1139. (current_procinfo.procdef.struct=structh))) then
  1140. Message(parser_e_only_class_members)
  1141. else
  1142. Message(parser_e_only_class_members_via_class_ref);
  1143. p1:=csubscriptnode.create(sym,p1);
  1144. end;
  1145. end;
  1146. propertysym:
  1147. begin
  1148. if isclassref and not (sp_static in sym.symoptions) then
  1149. Message(parser_e_only_class_members_via_class_ref);
  1150. handle_propertysym(tpropertysym(sym),sym.owner,p1);
  1151. end;
  1152. typesym:
  1153. begin
  1154. p1.free;
  1155. if try_to_consume(_LKLAMMER) then
  1156. begin
  1157. p1:=comp_expr(true,false);
  1158. consume(_RKLAMMER);
  1159. p1:=ctypeconvnode.create_explicit(p1,ttypesym(sym).typedef);
  1160. end
  1161. else
  1162. begin
  1163. p1:=ctypenode.create(ttypesym(sym).typedef);
  1164. if (is_class(ttypesym(sym).typedef) or
  1165. is_objcclass(ttypesym(sym).typedef) or
  1166. is_javaclass(ttypesym(sym).typedef)) and
  1167. not(block_type in [bt_type,bt_const_type,bt_var_type]) then
  1168. p1:=cloadvmtaddrnode.create(p1);
  1169. end;
  1170. end;
  1171. constsym:
  1172. begin
  1173. p1.free;
  1174. p1:=genconstsymtree(tconstsym(sym));
  1175. end;
  1176. staticvarsym:
  1177. begin
  1178. { typed constant is a staticvarsym
  1179. now they are absolutevarsym }
  1180. p1.free;
  1181. p1:=cloadnode.create(sym,sym.Owner);
  1182. end;
  1183. absolutevarsym:
  1184. begin
  1185. p1.free;
  1186. p1:=nil;
  1187. { typed constants are absolutebarsyms now to handle storage properly }
  1188. propaccesslist_to_node(p1,nil,tabsolutevarsym(sym).ref);
  1189. end
  1190. else
  1191. internalerror(16);
  1192. end;
  1193. end;
  1194. end;
  1195. {****************************************************************************
  1196. Factor
  1197. ****************************************************************************}
  1198. function is_member_read(sym: tsym; st: tsymtable; var p1: tnode;
  1199. out memberparentdef: tdef): boolean;
  1200. var
  1201. hdef : tdef;
  1202. begin
  1203. result:=true;
  1204. memberparentdef:=nil;
  1205. case st.symtabletype of
  1206. ObjectSymtable,
  1207. recordsymtable:
  1208. begin
  1209. memberparentdef:=tdef(st.defowner);
  1210. exit;
  1211. end;
  1212. WithSymtable:
  1213. begin
  1214. if assigned(p1) then
  1215. internalerror(2007012002);
  1216. hdef:=tnode(twithsymtable(st).withrefnode).resultdef;
  1217. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  1218. if not(hdef.typ in [objectdef,classrefdef]) then
  1219. exit;
  1220. if (hdef.typ=classrefdef) then
  1221. hdef:=tclassrefdef(hdef).pointeddef;
  1222. memberparentdef:=hdef;
  1223. end;
  1224. else
  1225. result:=false;
  1226. end;
  1227. end;
  1228. {$maxfpuregisters 0}
  1229. function factor(getaddr,typeonly:boolean) : tnode;
  1230. {---------------------------------------------
  1231. Factor_read_id
  1232. ---------------------------------------------}
  1233. procedure factor_read_id(out p1:tnode;var again:boolean);
  1234. var
  1235. srsym : tsym;
  1236. srsymtable : TSymtable;
  1237. hdef : tdef;
  1238. orgstoredpattern,
  1239. storedpattern : string;
  1240. callflags: tcallnodeflags;
  1241. t : ttoken;
  1242. unit_found : boolean;
  1243. begin
  1244. { allow post fix operators }
  1245. again:=true;
  1246. { first check for identifier }
  1247. if token<>_ID then
  1248. begin
  1249. srsym:=generrorsym;
  1250. srsymtable:=nil;
  1251. consume(_ID);
  1252. end
  1253. else
  1254. begin
  1255. if typeonly then
  1256. searchsym_type(pattern,srsym,srsymtable)
  1257. else
  1258. searchsym(pattern,srsym,srsymtable);
  1259. { handle unit specification like System.Writeln }
  1260. unit_found:=try_consume_unitsym(srsym,srsymtable,t);
  1261. storedpattern:=pattern;
  1262. orgstoredpattern:=orgpattern;
  1263. consume(t);
  1264. { named parameter support }
  1265. found_arg_name:=false;
  1266. if not(unit_found) and
  1267. named_args_allowed and
  1268. (token=_ASSIGNMENT) then
  1269. begin
  1270. found_arg_name:=true;
  1271. p1:=cstringconstnode.createstr(storedpattern);
  1272. consume(_ASSIGNMENT);
  1273. exit;
  1274. end;
  1275. { if nothing found give error and return errorsym }
  1276. if assigned(srsym) then
  1277. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg)
  1278. else
  1279. begin
  1280. identifier_not_found(orgstoredpattern);
  1281. srsym:=generrorsym;
  1282. srsymtable:=nil;
  1283. end;
  1284. end;
  1285. { Access to funcret or need to call the function? }
  1286. if (srsym.typ in [absolutevarsym,localvarsym,paravarsym]) and
  1287. (vo_is_funcret in tabstractvarsym(srsym).varoptions) and
  1288. { result(x) is not allowed }
  1289. not(vo_is_result in tabstractvarsym(srsym).varoptions) and
  1290. (
  1291. (token=_LKLAMMER) or
  1292. (
  1293. (
  1294. (m_tp7 in current_settings.modeswitches) or
  1295. (m_delphi in current_settings.modeswitches)
  1296. ) and
  1297. (afterassignment or in_args)
  1298. )
  1299. ) then
  1300. begin
  1301. hdef:=tdef(srsym.owner.defowner);
  1302. if assigned(hdef) and
  1303. (hdef.typ=procdef) then
  1304. srsym:=tprocdef(hdef).procsym
  1305. else
  1306. begin
  1307. Message(parser_e_illegal_expression);
  1308. srsym:=generrorsym;
  1309. end;
  1310. srsymtable:=srsym.owner;
  1311. end;
  1312. begin
  1313. case srsym.typ of
  1314. absolutevarsym :
  1315. begin
  1316. if (tabsolutevarsym(srsym).abstyp=tovar) then
  1317. begin
  1318. p1:=nil;
  1319. propaccesslist_to_node(p1,nil,tabsolutevarsym(srsym).ref);
  1320. p1:=ctypeconvnode.create(p1,tabsolutevarsym(srsym).vardef);
  1321. include(p1.flags,nf_absolute);
  1322. end
  1323. else
  1324. p1:=cloadnode.create(srsym,srsymtable);
  1325. end;
  1326. staticvarsym,
  1327. localvarsym,
  1328. paravarsym,
  1329. fieldvarsym :
  1330. begin
  1331. { check if we are reading a field of an object/class/ }
  1332. { record. is_member_read() will deal with withsymtables }
  1333. { if needed. }
  1334. p1:=nil;
  1335. if is_member_read(srsym,srsymtable,p1,hdef) then
  1336. begin
  1337. { if the field was originally found in an }
  1338. { objectsymtable, it means it's part of self
  1339. if only method from which it was called is
  1340. not class static }
  1341. if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
  1342. if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
  1343. p1:=cloadvmtaddrnode.create(ctypenode.create(current_procinfo.procdef.struct))
  1344. else
  1345. p1:=load_self_node;
  1346. { now, if the field itself is part of an objectsymtab }
  1347. { (it can be even if it was found in a withsymtable, }
  1348. { e.g., "with classinstance do field := 5"), then }
  1349. { let do_member_read handle it }
  1350. if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  1351. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[])
  1352. else
  1353. { otherwise it's a regular record subscript }
  1354. p1:=csubscriptnode.create(srsym,p1);
  1355. end
  1356. else
  1357. { regular non-field load }
  1358. p1:=cloadnode.create(srsym,srsymtable);
  1359. end;
  1360. syssym :
  1361. begin
  1362. p1:=statement_syssym(tsyssym(srsym).number);
  1363. end;
  1364. typesym :
  1365. begin
  1366. hdef:=ttypesym(srsym).typedef;
  1367. if not assigned(hdef) then
  1368. begin
  1369. again:=false;
  1370. end
  1371. else
  1372. begin
  1373. { We need to know if this unit uses Variants }
  1374. if (hdef=cvarianttype) and
  1375. not(cs_compilesystem in current_settings.moduleswitches) then
  1376. current_module.flags:=current_module.flags or uf_uses_variants;
  1377. { if we get a generic then check that it is not an inline specialization }
  1378. if (df_generic in hdef.defoptions) and
  1379. (token=_LT) and
  1380. (m_delphi in current_settings.modeswitches) then
  1381. generate_specialization(hdef,false,'');
  1382. if try_to_consume(_LKLAMMER) then
  1383. begin
  1384. p1:=comp_expr(true,false);
  1385. consume(_RKLAMMER);
  1386. { type casts to class helpers aren't allowed }
  1387. if is_objectpascal_helper(hdef) then
  1388. Message(parser_e_no_category_as_types)
  1389. { recovery by not creating a conversion node }
  1390. else
  1391. p1:=ctypeconvnode.create_explicit(p1,hdef);
  1392. end
  1393. else { not LKLAMMER }
  1394. if (token=_POINT) and
  1395. (is_object(hdef) or is_record(hdef)) then
  1396. begin
  1397. consume(_POINT);
  1398. { handles calling methods declared in parent objects
  1399. using "parentobject.methodname()" }
  1400. if assigned(current_structdef) and
  1401. not(getaddr) and
  1402. current_structdef.is_related(hdef) then
  1403. begin
  1404. p1:=ctypenode.create(hdef);
  1405. { search also in inherited methods }
  1406. searchsym_in_class(tobjectdef(hdef),tobjectdef(current_structdef),pattern,srsym,srsymtable,true);
  1407. if assigned(srsym) then
  1408. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1409. consume(_ID);
  1410. do_member_read(tabstractrecorddef(hdef),false,srsym,p1,again,[]);
  1411. end
  1412. else
  1413. begin
  1414. { handles:
  1415. * @TObject.Load
  1416. * static methods and variables }
  1417. p1:=ctypenode.create(hdef);
  1418. { TP allows also @TMenu.Load if Load is only }
  1419. { defined in an anchestor class }
  1420. srsym:=search_struct_member(tabstractrecorddef(hdef),pattern);
  1421. if assigned(srsym) then
  1422. begin
  1423. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1424. consume(_ID);
  1425. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[]);
  1426. end
  1427. else
  1428. Message1(sym_e_id_no_member,orgpattern);
  1429. end;
  1430. end
  1431. else
  1432. begin
  1433. { Normally here would be the check against the usage
  1434. of "TClassHelper.Something", but as that might be
  1435. used inside of system symbols like sizeof and
  1436. typeinfo this check is put into ttypenode.pass_1
  1437. (for "TClassHelper" alone) and tcallnode.pass_1
  1438. (for "TClassHelper.Something") }
  1439. { class reference ? }
  1440. if is_class(hdef) or
  1441. is_objcclass(hdef) or
  1442. is_javaclass(hdef) then
  1443. begin
  1444. if getaddr and (token=_POINT) then
  1445. begin
  1446. consume(_POINT);
  1447. { allows @Object.Method }
  1448. { also allows static methods and variables }
  1449. p1:=ctypenode.create(hdef);
  1450. { TP allows also @TMenu.Load if Load is only }
  1451. { defined in an anchestor class }
  1452. srsym:=search_struct_member(tobjectdef(hdef),pattern);
  1453. if assigned(srsym) then
  1454. begin
  1455. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1456. consume(_ID);
  1457. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[]);
  1458. end
  1459. else
  1460. begin
  1461. Message1(sym_e_id_no_member,orgpattern);
  1462. consume(_ID);
  1463. end;
  1464. end
  1465. else
  1466. begin
  1467. p1:=ctypenode.create(hdef);
  1468. { For a type block we simply return only
  1469. the type. For all other blocks we return
  1470. a loadvmt node }
  1471. if not(block_type in [bt_type,bt_const_type,bt_var_type]) then
  1472. p1:=cloadvmtaddrnode.create(p1);
  1473. end;
  1474. end
  1475. else
  1476. p1:=ctypenode.create(hdef);
  1477. end;
  1478. end;
  1479. end;
  1480. enumsym :
  1481. begin
  1482. p1:=genenumnode(tenumsym(srsym));
  1483. end;
  1484. constsym :
  1485. begin
  1486. if tconstsym(srsym).consttyp=constresourcestring then
  1487. begin
  1488. p1:=cloadnode.create(srsym,srsymtable);
  1489. do_typecheckpass(p1);
  1490. p1.resultdef:=cansistringtype;
  1491. end
  1492. else
  1493. p1:=genconstsymtree(tconstsym(srsym));
  1494. end;
  1495. procsym :
  1496. begin
  1497. p1:=nil;
  1498. { check if it's a method/class method }
  1499. if is_member_read(srsym,srsymtable,p1,hdef) then
  1500. begin
  1501. { not srsymtable.symtabletype since that can be }
  1502. { withsymtable as well }
  1503. if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  1504. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[])
  1505. else
  1506. { no procsyms in records (yet) }
  1507. internalerror(2007012006);
  1508. end
  1509. else
  1510. begin
  1511. { regular procedure/function call }
  1512. if not unit_found then
  1513. callflags:=[]
  1514. else
  1515. callflags:=[cnf_unit_specified];
  1516. do_proc_call(srsym,srsymtable,nil,
  1517. (getaddr and not(token in [_CARET,_POINT,_LECKKLAMMER])),
  1518. again,p1,callflags);
  1519. end;
  1520. end;
  1521. propertysym :
  1522. begin
  1523. p1:=nil;
  1524. { property of a class/object? }
  1525. if is_member_read(srsym,srsymtable,p1,hdef) then
  1526. begin
  1527. if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
  1528. if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
  1529. { no self node in static class methods }
  1530. p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))
  1531. else
  1532. p1:=load_self_node;
  1533. { not srsymtable.symtabletype since that can be }
  1534. { withsymtable as well }
  1535. if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  1536. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[])
  1537. else
  1538. { no propertysyms in records (yet) }
  1539. internalerror(2009111510);
  1540. end
  1541. else
  1542. { no method pointer }
  1543. begin
  1544. handle_propertysym(tpropertysym(srsym),srsymtable,p1);
  1545. end;
  1546. end;
  1547. labelsym :
  1548. begin
  1549. { Support @label }
  1550. if getaddr then
  1551. begin
  1552. if srsym.owner<>current_procinfo.procdef.localst then
  1553. CGMessage(parser_e_label_outside_proc);
  1554. p1:=cloadnode.create(srsym,srsym.owner)
  1555. end
  1556. else
  1557. begin
  1558. consume(_COLON);
  1559. if tlabelsym(srsym).defined then
  1560. Message(sym_e_label_already_defined);
  1561. if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
  1562. begin
  1563. tlabelsym(srsym).nonlocal:=true;
  1564. exclude(current_procinfo.procdef.procoptions,po_inline);
  1565. end;
  1566. if tlabelsym(srsym).nonlocal and
  1567. (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
  1568. Message(sym_e_interprocgoto_into_init_final_code_not_allowed);
  1569. tlabelsym(srsym).defined:=true;
  1570. p1:=clabelnode.create(nil,tlabelsym(srsym));
  1571. tlabelsym(srsym).code:=p1;
  1572. end;
  1573. end;
  1574. errorsym :
  1575. begin
  1576. p1:=cerrornode.create;
  1577. if try_to_consume(_LKLAMMER) then
  1578. begin
  1579. parse_paras(false,false,_RKLAMMER);
  1580. consume(_RKLAMMER);
  1581. end;
  1582. end;
  1583. else
  1584. begin
  1585. p1:=cerrornode.create;
  1586. Message(parser_e_illegal_expression);
  1587. end;
  1588. end; { end case }
  1589. end;
  1590. end;
  1591. {---------------------------------------------
  1592. Factor_Read_Set
  1593. ---------------------------------------------}
  1594. { Read a set between [] }
  1595. function factor_read_set:tnode;
  1596. var
  1597. p1,p2 : tnode;
  1598. lastp,
  1599. buildp : tarrayconstructornode;
  1600. old_allow_array_constructor : boolean;
  1601. begin
  1602. buildp:=nil;
  1603. { be sure that a least one arrayconstructn is used, also for an
  1604. empty [] }
  1605. if token=_RECKKLAMMER then
  1606. buildp:=carrayconstructornode.create(nil,buildp)
  1607. else
  1608. repeat
  1609. { nested array constructors are not allowed, see also tests/webtbs/tw17213.pp }
  1610. old_allow_array_constructor:=allow_array_constructor;
  1611. allow_array_constructor:=false;
  1612. p1:=comp_expr(true,false);
  1613. if try_to_consume(_POINTPOINT) then
  1614. begin
  1615. p2:=comp_expr(true,false);
  1616. p1:=carrayconstructorrangenode.create(p1,p2);
  1617. end;
  1618. { insert at the end of the tree, to get the correct order }
  1619. if not assigned(buildp) then
  1620. begin
  1621. buildp:=carrayconstructornode.create(p1,nil);
  1622. lastp:=buildp;
  1623. end
  1624. else
  1625. begin
  1626. lastp.right:=carrayconstructornode.create(p1,nil);
  1627. lastp:=tarrayconstructornode(lastp.right);
  1628. end;
  1629. allow_array_constructor:=old_allow_array_constructor;
  1630. { there could be more elements }
  1631. until not try_to_consume(_COMMA);
  1632. factor_read_set:=buildp;
  1633. end;
  1634. {---------------------------------------------
  1635. PostFixOperators
  1636. ---------------------------------------------}
  1637. { returns whether or not p1 has been changed }
  1638. function postfixoperators(var p1:tnode;var again:boolean): boolean;
  1639. { tries to avoid syntax errors after invalid qualifiers }
  1640. procedure recoverconsume_postfixops;
  1641. begin
  1642. repeat
  1643. if not try_to_consume(_CARET) then
  1644. if try_to_consume(_POINT) then
  1645. try_to_consume(_ID)
  1646. else if try_to_consume(_LECKKLAMMER) then
  1647. begin
  1648. repeat
  1649. comp_expr(true,false);
  1650. until not try_to_consume(_COMMA);
  1651. consume(_RECKKLAMMER);
  1652. end
  1653. else if try_to_consume(_LKLAMMER) then
  1654. begin
  1655. repeat
  1656. comp_expr(true,false);
  1657. until not try_to_consume(_COMMA);
  1658. consume(_RKLAMMER);
  1659. end
  1660. else
  1661. break;
  1662. until false;
  1663. end;
  1664. procedure handle_variantarray;
  1665. var
  1666. p4 : tnode;
  1667. newstatement : tstatementnode;
  1668. tempresultvariant,
  1669. temp : ttempcreatenode;
  1670. paras : tcallparanode;
  1671. newblock : tnode;
  1672. countindices : aint;
  1673. begin
  1674. { create statements with call initialize the arguments and
  1675. call fpc_dynarr_setlength }
  1676. newblock:=internalstatements(newstatement);
  1677. { get temp for array of indicies,
  1678. we set the real size later }
  1679. temp:=ctempcreatenode.create(s32inttype,4,tt_persistent,false);
  1680. addstatement(newstatement,temp);
  1681. countindices:=0;
  1682. repeat
  1683. p4:=comp_expr(true,false);
  1684. addstatement(newstatement,cassignmentnode.create(
  1685. ctemprefnode.create_offset(temp,countindices*s32inttype.size),p4));
  1686. inc(countindices);
  1687. until not try_to_consume(_COMMA);
  1688. { set real size }
  1689. temp.size:=countindices*s32inttype.size;
  1690. consume(_RECKKLAMMER);
  1691. { we need only a write access if a := follows }
  1692. if token=_ASSIGNMENT then
  1693. begin
  1694. consume(_ASSIGNMENT);
  1695. p4:=comp_expr(true,false);
  1696. { create call to fpc_vararray_put }
  1697. paras:=ccallparanode.create(cordconstnode.create
  1698. (countindices,s32inttype,true),
  1699. ccallparanode.create(caddrnode.create_internal
  1700. (ctemprefnode.create(temp)),
  1701. ccallparanode.create(ctypeconvnode.create_internal(p4,cvarianttype),
  1702. ccallparanode.create(ctypeconvnode.create_internal(p1,cvarianttype)
  1703. ,nil))));
  1704. addstatement(newstatement,ccallnode.createintern('fpc_vararray_put',paras));
  1705. addstatement(newstatement,ctempdeletenode.create(temp));
  1706. end
  1707. else
  1708. begin
  1709. { create temp for result }
  1710. tempresultvariant:=ctempcreatenode.create(cvarianttype,cvarianttype.size,tt_persistent,true);
  1711. addstatement(newstatement,tempresultvariant);
  1712. { create call to fpc_vararray_get }
  1713. paras:=ccallparanode.create(cordconstnode.create
  1714. (countindices,s32inttype,true),
  1715. ccallparanode.create(caddrnode.create_internal
  1716. (ctemprefnode.create(temp)),
  1717. ccallparanode.create(p1,
  1718. ccallparanode.create(
  1719. ctemprefnode.create(tempresultvariant)
  1720. ,nil))));
  1721. addstatement(newstatement,ccallnode.createintern('fpc_vararray_get',paras));
  1722. addstatement(newstatement,ctempdeletenode.create(temp));
  1723. { the last statement should return the value as
  1724. location and type, this is done be referencing the
  1725. temp and converting it first from a persistent temp to
  1726. normal temp }
  1727. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempresultvariant));
  1728. addstatement(newstatement,ctemprefnode.create(tempresultvariant));
  1729. end;
  1730. p1:=newblock;
  1731. end;
  1732. var
  1733. protsym : tpropertysym;
  1734. p2,p3 : tnode;
  1735. srsym : tsym;
  1736. srsymtable : TSymtable;
  1737. structh : tabstractrecorddef;
  1738. { shouldn't be used that often, so the extra overhead is ok to save
  1739. stack space }
  1740. dispatchstring : ansistring;
  1741. nodechanged : boolean;
  1742. calltype: tdispcalltype;
  1743. label
  1744. skipreckklammercheck;
  1745. begin
  1746. result:=false;
  1747. again:=true;
  1748. while again do
  1749. begin
  1750. { we need the resultdef }
  1751. do_typecheckpass_changed(p1,nodechanged);
  1752. result:=result or nodechanged;
  1753. if codegenerror then
  1754. begin
  1755. recoverconsume_postfixops;
  1756. exit;
  1757. end;
  1758. { handle token }
  1759. case token of
  1760. _CARET:
  1761. begin
  1762. consume(_CARET);
  1763. { support tp/mac procvar^ if the procvar returns a
  1764. pointer type }
  1765. if ((m_tp_procvar in current_settings.modeswitches) or
  1766. (m_mac_procvar in current_settings.modeswitches)) and
  1767. (p1.resultdef.typ=procvardef) and
  1768. (tprocvardef(p1.resultdef).returndef.typ=pointerdef) then
  1769. begin
  1770. p1:=ccallnode.create_procvar(nil,p1);
  1771. typecheckpass(p1);
  1772. end;
  1773. if (p1.resultdef.typ<>pointerdef) then
  1774. begin
  1775. { ^ as binary operator is a problem!!!! (FK) }
  1776. again:=false;
  1777. Message(parser_e_invalid_qualifier);
  1778. recoverconsume_postfixops;
  1779. p1.destroy;
  1780. p1:=cerrornode.create;
  1781. end
  1782. else
  1783. p1:=cderefnode.create(p1);
  1784. end;
  1785. _LECKKLAMMER:
  1786. begin
  1787. if is_class_or_interface_or_object(p1.resultdef) or
  1788. is_dispinterface(p1.resultdef) or
  1789. is_record(p1.resultdef) or
  1790. is_javaclass(p1.resultdef) then
  1791. begin
  1792. { default property }
  1793. protsym:=search_default_property(tabstractrecorddef(p1.resultdef));
  1794. if not(assigned(protsym)) then
  1795. begin
  1796. p1.destroy;
  1797. p1:=cerrornode.create;
  1798. again:=false;
  1799. message(parser_e_no_default_property_available);
  1800. end
  1801. else
  1802. begin
  1803. { The property symbol is referenced indirect }
  1804. protsym.IncRefCount;
  1805. handle_propertysym(protsym,protsym.owner,p1);
  1806. end;
  1807. end
  1808. else
  1809. begin
  1810. consume(_LECKKLAMMER);
  1811. repeat
  1812. { in all of the cases below, p1 is changed }
  1813. case p1.resultdef.typ of
  1814. pointerdef:
  1815. begin
  1816. { support delphi autoderef }
  1817. if (tpointerdef(p1.resultdef).pointeddef.typ=arraydef) and
  1818. (m_autoderef in current_settings.modeswitches) then
  1819. p1:=cderefnode.create(p1);
  1820. p2:=comp_expr(true,false);
  1821. { Support Pbytevar[0..9] which returns array [0..9].}
  1822. if try_to_consume(_POINTPOINT) then
  1823. p2:=crangenode.create(p2,comp_expr(true,false));
  1824. p1:=cvecnode.create(p1,p2);
  1825. end;
  1826. variantdef:
  1827. begin
  1828. handle_variantarray;
  1829. { the RECKKLAMMER is already read }
  1830. goto skipreckklammercheck;
  1831. end;
  1832. stringdef :
  1833. begin
  1834. p2:=comp_expr(true,false);
  1835. { Support string[0..9] which returns array [0..9] of char.}
  1836. if try_to_consume(_POINTPOINT) then
  1837. p2:=crangenode.create(p2,comp_expr(true,false));
  1838. p1:=cvecnode.create(p1,p2);
  1839. end;
  1840. arraydef:
  1841. begin
  1842. p2:=comp_expr(true,false);
  1843. { support SEG:OFS for go32v2 Mem[] }
  1844. if (target_info.system in [system_i386_go32v2,system_i386_watcom]) and
  1845. (p1.nodetype=loadn) and
  1846. assigned(tloadnode(p1).symtableentry) and
  1847. assigned(tloadnode(p1).symtableentry.owner.name) and
  1848. (tloadnode(p1).symtableentry.owner.name^='SYSTEM') and
  1849. ((tloadnode(p1).symtableentry.name='MEM') or
  1850. (tloadnode(p1).symtableentry.name='MEMW') or
  1851. (tloadnode(p1).symtableentry.name='MEML')) then
  1852. begin
  1853. if try_to_consume(_COLON) then
  1854. begin
  1855. p3:=caddnode.create(muln,cordconstnode.create($10,s32inttype,false),p2);
  1856. p2:=comp_expr(true,false);
  1857. p2:=caddnode.create(addn,p2,p3);
  1858. if try_to_consume(_POINTPOINT) then
  1859. { Support mem[$a000:$0000..$07ff] which returns array [0..$7ff] of memtype.}
  1860. p2:=crangenode.create(p2,caddnode.create(addn,comp_expr(true,false),p3.getcopy));
  1861. p1:=cvecnode.create(p1,p2);
  1862. include(tvecnode(p1).flags,nf_memseg);
  1863. include(tvecnode(p1).flags,nf_memindex);
  1864. end
  1865. else
  1866. begin
  1867. if try_to_consume(_POINTPOINT) then
  1868. { Support mem[$80000000..$80000002] which returns array [0..2] of memtype.}
  1869. p2:=crangenode.create(p2,comp_expr(true,false));
  1870. p1:=cvecnode.create(p1,p2);
  1871. include(tvecnode(p1).flags,nf_memindex);
  1872. end;
  1873. end
  1874. else
  1875. begin
  1876. if try_to_consume(_POINTPOINT) then
  1877. { Support arrayvar[0..9] which returns array [0..9] of arraytype.}
  1878. p2:=crangenode.create(p2,comp_expr(true,false));
  1879. p1:=cvecnode.create(p1,p2);
  1880. end;
  1881. end;
  1882. else
  1883. begin
  1884. if p1.resultdef.typ<>undefineddef then
  1885. Message(parser_e_invalid_qualifier);
  1886. p1.destroy;
  1887. p1:=cerrornode.create;
  1888. comp_expr(true,false);
  1889. again:=false;
  1890. end;
  1891. end;
  1892. do_typecheckpass(p1);
  1893. until not try_to_consume(_COMMA);
  1894. consume(_RECKKLAMMER);
  1895. { handle_variantarray eats the RECKKLAMMER and jumps here }
  1896. skipreckklammercheck:
  1897. end;
  1898. end;
  1899. _POINT :
  1900. begin
  1901. consume(_POINT);
  1902. if (p1.resultdef.typ=pointerdef) and
  1903. (m_autoderef in current_settings.modeswitches) and
  1904. { don't auto-deref objc.id, because then the code
  1905. below for supporting id.anyobjcmethod isn't triggered }
  1906. (p1.resultdef<>objc_idtype) then
  1907. begin
  1908. p1:=cderefnode.create(p1);
  1909. do_typecheckpass(p1);
  1910. end;
  1911. { procvar.<something> can never mean anything so always
  1912. try to call it in case it returns a record/object/... }
  1913. maybe_call_procvar(p1,false);
  1914. case p1.resultdef.typ of
  1915. recorddef:
  1916. begin
  1917. if token=_ID then
  1918. begin
  1919. structh:=tabstractrecorddef(p1.resultdef);
  1920. searchsym_in_record(structh,pattern,srsym,srsymtable);
  1921. if assigned(srsym) then
  1922. begin
  1923. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1924. consume(_ID);
  1925. do_member_read(structh,getaddr,srsym,p1,again,[]);
  1926. end
  1927. else
  1928. begin
  1929. Message1(sym_e_id_no_member,orgpattern);
  1930. p1.destroy;
  1931. p1:=cerrornode.create;
  1932. { try to clean up }
  1933. consume(_ID);
  1934. end;
  1935. end
  1936. else
  1937. consume(_ID);
  1938. end;
  1939. enumdef:
  1940. begin
  1941. if token=_ID then
  1942. begin
  1943. srsym:=tsym(tenumdef(p1.resultdef).symtable.Find(pattern));
  1944. p1.destroy;
  1945. if assigned(srsym) and (srsym.typ=enumsym) then
  1946. begin
  1947. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1948. p1:=genenumnode(tenumsym(srsym));
  1949. end
  1950. else
  1951. begin
  1952. Message1(sym_e_id_no_member,orgpattern);
  1953. p1:=cerrornode.create;
  1954. end;
  1955. end;
  1956. consume(_ID);
  1957. end;
  1958. variantdef:
  1959. begin
  1960. { dispatch call? }
  1961. { lhs := v.ident[parameters] -> property get
  1962. lhs := v.ident(parameters) -> method call
  1963. v.ident[parameters] := rhs -> property put
  1964. v.ident(parameters) := rhs -> also property put }
  1965. if token=_ID then
  1966. begin
  1967. dispatchstring:=orgpattern;
  1968. consume(_ID);
  1969. calltype:=dct_method;
  1970. if try_to_consume(_LKLAMMER) then
  1971. begin
  1972. p2:=parse_paras(false,true,_RKLAMMER);
  1973. consume(_RKLAMMER);
  1974. end
  1975. else if try_to_consume(_LECKKLAMMER) then
  1976. begin
  1977. p2:=parse_paras(false,true,_RECKKLAMMER);
  1978. consume(_RECKKLAMMER);
  1979. calltype:=dct_propget;
  1980. end
  1981. else
  1982. p2:=nil;
  1983. { property setter? }
  1984. if (token=_ASSIGNMENT) and not(afterassignment) then
  1985. begin
  1986. consume(_ASSIGNMENT);
  1987. { read the expression }
  1988. p3:=comp_expr(true,false);
  1989. { concat value parameter too }
  1990. p2:=ccallparanode.create(p3,p2);
  1991. p1:=translate_disp_call(p1,p2,dct_propput,dispatchstring,0,voidtype);
  1992. end
  1993. else
  1994. { this is only an approximation
  1995. setting useresult if not necessary is only a waste of time, no more, no less (FK) }
  1996. if afterassignment or in_args or (token<>_SEMICOLON) then
  1997. p1:=translate_disp_call(p1,p2,calltype,dispatchstring,0,cvarianttype)
  1998. else
  1999. p1:=translate_disp_call(p1,p2,calltype,dispatchstring,0,voidtype);
  2000. end
  2001. else { Error }
  2002. Consume(_ID);
  2003. end;
  2004. classrefdef:
  2005. begin
  2006. if token=_ID then
  2007. begin
  2008. structh:=tobjectdef(tclassrefdef(p1.resultdef).pointeddef);
  2009. searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,true);
  2010. if assigned(srsym) then
  2011. begin
  2012. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  2013. consume(_ID);
  2014. do_member_read(structh,getaddr,srsym,p1,again,[]);
  2015. end
  2016. else
  2017. begin
  2018. Message1(sym_e_id_no_member,orgpattern);
  2019. p1.destroy;
  2020. p1:=cerrornode.create;
  2021. { try to clean up }
  2022. consume(_ID);
  2023. end;
  2024. end
  2025. else { Error }
  2026. Consume(_ID);
  2027. end;
  2028. objectdef:
  2029. begin
  2030. if token=_ID then
  2031. begin
  2032. structh:=tobjectdef(p1.resultdef);
  2033. searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,true);
  2034. if assigned(srsym) then
  2035. begin
  2036. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  2037. consume(_ID);
  2038. do_member_read(structh,getaddr,srsym,p1,again,[]);
  2039. end
  2040. else
  2041. begin
  2042. Message1(sym_e_id_no_member,orgpattern);
  2043. p1.destroy;
  2044. p1:=cerrornode.create;
  2045. { try to clean up }
  2046. consume(_ID);
  2047. end;
  2048. end
  2049. else { Error }
  2050. Consume(_ID);
  2051. end;
  2052. pointerdef:
  2053. begin
  2054. if (p1.resultdef=objc_idtype) then
  2055. begin
  2056. { objc's id type can be used to call any
  2057. Objective-C method of any Objective-C class
  2058. type that's currently in scope }
  2059. if search_objc_method(pattern,srsym,srsymtable) then
  2060. begin
  2061. consume(_ID);
  2062. do_proc_call(srsym,srsymtable,nil,
  2063. (getaddr and not(token in [_CARET,_POINT])),
  2064. again,p1,[cnf_objc_id_call]);
  2065. { we need to know which procedure is called }
  2066. do_typecheckpass(p1);
  2067. end
  2068. else
  2069. begin
  2070. consume(_ID);
  2071. Message(parser_e_methode_id_expected);
  2072. end;
  2073. end
  2074. else
  2075. begin
  2076. Message(parser_e_invalid_qualifier);
  2077. if tpointerdef(p1.resultdef).pointeddef.typ in [recorddef,objectdef,classrefdef] then
  2078. Message(parser_h_maybe_deref_caret_missing);
  2079. end
  2080. end;
  2081. else
  2082. begin
  2083. if p1.resultdef.typ<>undefineddef then
  2084. Message(parser_e_invalid_qualifier);
  2085. p1.destroy;
  2086. p1:=cerrornode.create;
  2087. { Error }
  2088. consume(_ID);
  2089. end;
  2090. end;
  2091. end;
  2092. else
  2093. begin
  2094. { is this a procedure variable ? }
  2095. if assigned(p1.resultdef) and
  2096. (p1.resultdef.typ=procvardef) then
  2097. begin
  2098. { Typenode for typecasting or expecting a procvar }
  2099. if (p1.nodetype=typen) or
  2100. (
  2101. assigned(getprocvardef) and
  2102. equal_defs(p1.resultdef,getprocvardef)
  2103. ) then
  2104. begin
  2105. if try_to_consume(_LKLAMMER) then
  2106. begin
  2107. p1:=comp_expr(true,false);
  2108. consume(_RKLAMMER);
  2109. p1:=ctypeconvnode.create_explicit(p1,p1.resultdef);
  2110. end
  2111. else
  2112. again:=false
  2113. end
  2114. else
  2115. begin
  2116. if try_to_consume(_LKLAMMER) then
  2117. begin
  2118. p2:=parse_paras(false,false,_RKLAMMER);
  2119. consume(_RKLAMMER);
  2120. p1:=ccallnode.create_procvar(p2,p1);
  2121. { proc():= is never possible }
  2122. if token=_ASSIGNMENT then
  2123. begin
  2124. Message(parser_e_illegal_expression);
  2125. p1.free;
  2126. p1:=cerrornode.create;
  2127. again:=false;
  2128. end;
  2129. end
  2130. else
  2131. again:=false;
  2132. end;
  2133. end
  2134. else
  2135. again:=false;
  2136. end;
  2137. end;
  2138. { we only try again if p1 was changed }
  2139. if again or
  2140. (p1.nodetype=errorn) then
  2141. result:=true;
  2142. end; { while again }
  2143. end;
  2144. {---------------------------------------------
  2145. Factor (Main)
  2146. ---------------------------------------------}
  2147. var
  2148. l : longint;
  2149. ic : int64;
  2150. qc : qword;
  2151. p1 : tnode;
  2152. code : integer;
  2153. srsym : tsym;
  2154. srsymtable : TSymtable;
  2155. pd : tprocdef;
  2156. hclassdef : tobjectdef;
  2157. d : bestreal;
  2158. cur : currency;
  2159. hs,hsorg : string;
  2160. hdef : tdef;
  2161. filepos : tfileposinfo;
  2162. callflags : tcallnodeflags;
  2163. again,
  2164. updatefpos,
  2165. nodechanged : boolean;
  2166. begin
  2167. { can't keep a copy of p1 and compare pointers afterwards, because
  2168. p1 may be freed and reallocated in the same place! }
  2169. updatefpos:=false;
  2170. p1:=nil;
  2171. filepos:=current_tokenpos;
  2172. again:=false;
  2173. if token=_ID then
  2174. begin
  2175. again:=true;
  2176. { Handle references to self }
  2177. if (idtoken=_SELF) and
  2178. not(block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) and
  2179. assigned(current_structdef) then
  2180. begin
  2181. p1:=load_self_node;
  2182. consume(_ID);
  2183. again:=true;
  2184. end
  2185. else
  2186. factor_read_id(p1,again);
  2187. if assigned(p1) then
  2188. begin
  2189. { factor_read_id will set the filepos to after the id,
  2190. and in case of _SELF the filepos will already be the
  2191. same as filepos (so setting it again doesn't hurt). }
  2192. p1.fileinfo:=filepos;
  2193. filepos:=current_tokenpos;
  2194. end;
  2195. { handle post fix operators }
  2196. updatefpos:=postfixoperators(p1,again);
  2197. end
  2198. else
  2199. begin
  2200. updatefpos:=true;
  2201. case token of
  2202. _RETURN :
  2203. begin
  2204. consume(_RETURN);
  2205. if not(token in [_SEMICOLON,_ELSE,_END]) then
  2206. p1 := cexitnode.create(comp_expr(true,false))
  2207. else
  2208. p1 := cexitnode.create(nil);
  2209. end;
  2210. _INHERITED :
  2211. begin
  2212. again:=true;
  2213. consume(_INHERITED);
  2214. if assigned(current_procinfo) and
  2215. assigned(current_structdef) and
  2216. ((current_structdef.typ=objectdef) or
  2217. ((target_info.system=system_jvm_java32) and
  2218. (current_structdef.typ=recorddef)))then
  2219. begin
  2220. { for record helpers in mode Delphi "inherited" is not
  2221. allowed }
  2222. if is_objectpascal_helper(current_structdef) and
  2223. (m_delphi in current_settings.modeswitches) and
  2224. is_record(tobjectdef(current_structdef).extendeddef) then
  2225. Message(parser_e_inherited_not_in_record);
  2226. if (current_structdef.typ=objectdef) then
  2227. begin
  2228. hclassdef:=tobjectdef(current_structdef).childof;
  2229. { Objective-C categories *replace* methods in the class
  2230. they extend, or add methods to it. So calling an
  2231. inherited method always calls the method inherited from
  2232. the parent of the extended class }
  2233. if is_objccategory(current_structdef) then
  2234. hclassdef:=hclassdef.childof;
  2235. end
  2236. else
  2237. hclassdef:=java_fpcbaserecordtype;
  2238. { if inherited; only then we need the method with
  2239. the same name }
  2240. if token <> _ID then
  2241. begin
  2242. hs:=current_procinfo.procdef.procsym.name;
  2243. hsorg:=current_procinfo.procdef.procsym.realname;
  2244. anon_inherited:=true;
  2245. { For message methods we need to search using the message
  2246. number or string }
  2247. pd:=tprocdef(tprocsym(current_procinfo.procdef.procsym).ProcdefList[0]);
  2248. srdef:=nil;
  2249. if (po_msgint in pd.procoptions) then
  2250. searchsym_in_class_by_msgint(hclassdef,pd.messageinf.i,srdef,srsym,srsymtable)
  2251. else
  2252. if (po_msgstr in pd.procoptions) then
  2253. searchsym_in_class_by_msgstr(hclassdef,pd.messageinf.str^,srsym,srsymtable)
  2254. else
  2255. { helpers have their own ways of dealing with inherited }
  2256. if is_objectpascal_helper(current_structdef) then
  2257. searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,true)
  2258. else
  2259. searchsym_in_class(hclassdef,current_structdef,hs,srsym,srsymtable,true);
  2260. end
  2261. else
  2262. begin
  2263. hs:=pattern;
  2264. hsorg:=orgpattern;
  2265. consume(_ID);
  2266. anon_inherited:=false;
  2267. { helpers have their own ways of dealing with inherited }
  2268. if is_objectpascal_helper(current_structdef) then
  2269. searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,true)
  2270. else
  2271. searchsym_in_class(hclassdef,current_structdef,hs,srsym,srsymtable,true);
  2272. end;
  2273. if assigned(srsym) then
  2274. begin
  2275. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  2276. { load the procdef from the inherited class and
  2277. not from self }
  2278. case srsym.typ of
  2279. procsym:
  2280. begin
  2281. if is_objectpascal_helper(current_structdef) then
  2282. begin
  2283. { for a helper load the procdef either from the
  2284. extended type, from the parent helper or from
  2285. the extended type of the parent helper
  2286. depending on the def the found symbol belongs
  2287. to }
  2288. if (srsym.Owner.defowner.typ=objectdef) and
  2289. is_objectpascal_helper(tobjectdef(srsym.Owner.defowner)) then
  2290. if current_structdef.is_related(tdef(srsym.Owner.defowner)) and
  2291. assigned(tobjectdef(current_structdef).childof) then
  2292. hdef:=tobjectdef(current_structdef).childof
  2293. else
  2294. hdef:=tobjectdef(srsym.Owner.defowner).extendeddef
  2295. else
  2296. hdef:=tdef(srsym.Owner.defowner);
  2297. end
  2298. else
  2299. hdef:=hclassdef;
  2300. if (po_classmethod in current_procinfo.procdef.procoptions) or
  2301. (po_staticmethod in current_procinfo.procdef.procoptions) then
  2302. hdef:=tclassrefdef.create(hdef);
  2303. p1:=ctypenode.create(hdef);
  2304. { we need to allow helpers here }
  2305. ttypenode(p1).helperallowed:=true;
  2306. end;
  2307. propertysym:
  2308. ;
  2309. else
  2310. begin
  2311. Message(parser_e_methode_id_expected);
  2312. p1:=cerrornode.create;
  2313. end;
  2314. end;
  2315. callflags:=[cnf_inherited];
  2316. if anon_inherited then
  2317. include(callflags,cnf_anon_inherited);
  2318. do_member_read(hclassdef,getaddr,srsym,p1,again,callflags);
  2319. end
  2320. else
  2321. begin
  2322. if anon_inherited then
  2323. begin
  2324. { For message methods we need to call DefaultHandler }
  2325. if (po_msgint in pd.procoptions) or
  2326. (po_msgstr in pd.procoptions) then
  2327. begin
  2328. searchsym_in_class(hclassdef,hclassdef,'DEFAULTHANDLER',srsym,srsymtable,true);
  2329. if not assigned(srsym) or
  2330. (srsym.typ<>procsym) then
  2331. internalerror(200303171);
  2332. p1:=nil;
  2333. do_proc_call(srsym,srsym.owner,hclassdef,false,again,p1,[]);
  2334. end
  2335. else
  2336. begin
  2337. { we need to ignore the inherited; }
  2338. p1:=cnothingnode.create;
  2339. end;
  2340. end
  2341. else
  2342. begin
  2343. Message1(sym_e_id_no_member,hsorg);
  2344. p1:=cerrornode.create;
  2345. end;
  2346. again:=false;
  2347. end;
  2348. { turn auto inheriting off }
  2349. anon_inherited:=false;
  2350. end
  2351. else
  2352. begin
  2353. { in case of records we use a more clear error message }
  2354. if assigned(current_structdef) and
  2355. (current_structdef.typ=recorddef) then
  2356. Message(parser_e_inherited_not_in_record)
  2357. else
  2358. Message(parser_e_generic_methods_only_in_methods);
  2359. again:=false;
  2360. p1:=cerrornode.create;
  2361. end;
  2362. postfixoperators(p1,again);
  2363. end;
  2364. _INTCONST :
  2365. begin
  2366. {Try first wether the value fits in an int64.}
  2367. val(pattern,ic,code);
  2368. if code=0 then
  2369. begin
  2370. consume(_INTCONST);
  2371. int_to_type(ic,hdef);
  2372. p1:=cordconstnode.create(ic,hdef,true);
  2373. end
  2374. else
  2375. begin
  2376. { try qword next }
  2377. val(pattern,qc,code);
  2378. if code=0 then
  2379. begin
  2380. consume(_INTCONST);
  2381. int_to_type(qc,hdef);
  2382. p1:=cordconstnode.create(qc,hdef,true);
  2383. end;
  2384. end;
  2385. if code<>0 then
  2386. begin
  2387. { finally float }
  2388. val(pattern,d,code);
  2389. if code<>0 then
  2390. begin
  2391. Message(parser_e_invalid_integer);
  2392. consume(_INTCONST);
  2393. l:=1;
  2394. p1:=cordconstnode.create(l,sinttype,true);
  2395. end
  2396. else
  2397. begin
  2398. consume(_INTCONST);
  2399. p1:=crealconstnode.create(d,pbestrealtype^);
  2400. end;
  2401. end
  2402. else
  2403. { the necessary range checking has already been done by val }
  2404. tordconstnode(p1).rangecheck:=false;
  2405. end;
  2406. _REALNUMBER :
  2407. begin
  2408. val(pattern,d,code);
  2409. if code<>0 then
  2410. begin
  2411. Message(parser_e_error_in_real);
  2412. d:=1.0;
  2413. end;
  2414. consume(_REALNUMBER);
  2415. {$ifdef FPC_REAL2REAL_FIXED}
  2416. if current_settings.fputype=fpu_none then
  2417. Message(parser_e_unsupported_real);
  2418. if (current_settings.minfpconstprec=s32real) and
  2419. (d = single(d)) then
  2420. p1:=crealconstnode.create(d,s32floattype)
  2421. else if (current_settings.minfpconstprec=s64real) and
  2422. (d = double(d)) then
  2423. p1:=crealconstnode.create(d,s64floattype)
  2424. else
  2425. {$endif FPC_REAL2REAL_FIXED}
  2426. p1:=crealconstnode.create(d,pbestrealtype^);
  2427. {$ifdef FPC_HAS_STR_CURRENCY}
  2428. val(pattern,cur,code);
  2429. if code=0 then
  2430. trealconstnode(p1).value_currency:=cur;
  2431. {$endif FPC_HAS_STR_CURRENCY}
  2432. end;
  2433. _STRING :
  2434. begin
  2435. string_dec(hdef,true);
  2436. { STRING can be also a type cast }
  2437. if try_to_consume(_LKLAMMER) then
  2438. begin
  2439. p1:=comp_expr(true,false);
  2440. consume(_RKLAMMER);
  2441. p1:=ctypeconvnode.create_explicit(p1,hdef);
  2442. { handle postfix operators here e.g. string(a)[10] }
  2443. again:=true;
  2444. postfixoperators(p1,again);
  2445. end
  2446. else
  2447. p1:=ctypenode.create(hdef);
  2448. end;
  2449. _FILE :
  2450. begin
  2451. hdef:=cfiletype;
  2452. consume(_FILE);
  2453. { FILE can be also a type cast }
  2454. if try_to_consume(_LKLAMMER) then
  2455. begin
  2456. p1:=comp_expr(true,false);
  2457. consume(_RKLAMMER);
  2458. p1:=ctypeconvnode.create_explicit(p1,hdef);
  2459. { handle postfix operators here e.g. string(a)[10] }
  2460. again:=true;
  2461. postfixoperators(p1,again);
  2462. end
  2463. else
  2464. begin
  2465. p1:=ctypenode.create(hdef);
  2466. end;
  2467. end;
  2468. _CSTRING :
  2469. begin
  2470. p1:=cstringconstnode.createpchar(ansistring2pchar(cstringpattern),length(cstringpattern));
  2471. consume(_CSTRING);
  2472. end;
  2473. _CCHAR :
  2474. begin
  2475. p1:=cordconstnode.create(ord(pattern[1]),cchartype,true);
  2476. consume(_CCHAR);
  2477. end;
  2478. _CWSTRING:
  2479. begin
  2480. p1:=cstringconstnode.createwstr(patternw);
  2481. consume(_CWSTRING);
  2482. end;
  2483. _CWCHAR:
  2484. begin
  2485. p1:=cordconstnode.create(ord(getcharwidestring(patternw,0)),cwidechartype,true);
  2486. consume(_CWCHAR);
  2487. end;
  2488. _KLAMMERAFFE :
  2489. begin
  2490. consume(_KLAMMERAFFE);
  2491. got_addrn:=true;
  2492. { support both @<x> and @(<x>) }
  2493. if try_to_consume(_LKLAMMER) then
  2494. begin
  2495. p1:=factor(true,false);
  2496. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2497. begin
  2498. again:=true;
  2499. postfixoperators(p1,again);
  2500. end
  2501. else
  2502. consume(_RKLAMMER);
  2503. end
  2504. else
  2505. p1:=factor(true,false);
  2506. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2507. begin
  2508. again:=true;
  2509. postfixoperators(p1,again);
  2510. end;
  2511. got_addrn:=false;
  2512. p1:=caddrnode.create(p1);
  2513. p1.fileinfo:=filepos;
  2514. if cs_typed_addresses in current_settings.localswitches then
  2515. include(p1.flags,nf_typedaddr);
  2516. { Store the procvar that we are expecting, the
  2517. addrn will use the information to find the correct
  2518. procdef or it will return an error }
  2519. if assigned(getprocvardef) and
  2520. (taddrnode(p1).left.nodetype = loadn) then
  2521. taddrnode(p1).getprocvardef:=getprocvardef;
  2522. end;
  2523. _LKLAMMER :
  2524. begin
  2525. consume(_LKLAMMER);
  2526. p1:=comp_expr(true,false);
  2527. consume(_RKLAMMER);
  2528. { it's not a good solution }
  2529. { but (a+b)^ makes some problems }
  2530. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2531. begin
  2532. again:=true;
  2533. postfixoperators(p1,again);
  2534. end;
  2535. end;
  2536. _LECKKLAMMER :
  2537. begin
  2538. consume(_LECKKLAMMER);
  2539. p1:=factor_read_set;
  2540. consume(_RECKKLAMMER);
  2541. end;
  2542. _PLUS :
  2543. begin
  2544. consume(_PLUS);
  2545. p1:=factor(false,false);
  2546. p1:=cunaryplusnode.create(p1);
  2547. end;
  2548. _MINUS :
  2549. begin
  2550. consume(_MINUS);
  2551. if (token = _INTCONST) and not(m_isolike_unary_minus in current_settings.modeswitches) then
  2552. begin
  2553. { ugly hack, but necessary to be able to parse }
  2554. { -9223372036854775808 as int64 (JM) }
  2555. pattern := '-'+pattern;
  2556. p1:=sub_expr(oppower,false,false);
  2557. { -1 ** 4 should be - (1 ** 4) and not
  2558. (-1) ** 4
  2559. This was the reason of tw0869.pp test failure PM }
  2560. if p1.nodetype=starstarn then
  2561. begin
  2562. if tbinarynode(p1).left.nodetype=ordconstn then
  2563. begin
  2564. tordconstnode(tbinarynode(p1).left).value:=-tordconstnode(tbinarynode(p1).left).value;
  2565. p1:=cunaryminusnode.create(p1);
  2566. end
  2567. else if tbinarynode(p1).left.nodetype=realconstn then
  2568. begin
  2569. trealconstnode(tbinarynode(p1).left).value_real:=-trealconstnode(tbinarynode(p1).left).value_real;
  2570. trealconstnode(tbinarynode(p1).left).value_currency:=-trealconstnode(tbinarynode(p1).left).value_currency;
  2571. p1:=cunaryminusnode.create(p1);
  2572. end
  2573. else
  2574. internalerror(20021029);
  2575. end;
  2576. end
  2577. else
  2578. begin
  2579. if m_isolike_unary_minus in current_settings.modeswitches then
  2580. p1:=sub_expr(opmultiply,false,false)
  2581. else
  2582. p1:=sub_expr(oppower,false,false);
  2583. p1:=cunaryminusnode.create(p1);
  2584. end;
  2585. end;
  2586. _OP_NOT :
  2587. begin
  2588. consume(_OP_NOT);
  2589. p1:=factor(false,false);
  2590. p1:=cnotnode.create(p1);
  2591. end;
  2592. _TRUE :
  2593. begin
  2594. consume(_TRUE);
  2595. p1:=cordconstnode.create(1,pasbool8type,false);
  2596. end;
  2597. _FALSE :
  2598. begin
  2599. consume(_FALSE);
  2600. p1:=cordconstnode.create(0,pasbool8type,false);
  2601. end;
  2602. _NIL :
  2603. begin
  2604. consume(_NIL);
  2605. p1:=cnilnode.create;
  2606. { It's really ugly code nil^, but delphi allows it }
  2607. if token in [_CARET] then
  2608. begin
  2609. again:=true;
  2610. postfixoperators(p1,again);
  2611. end;
  2612. end;
  2613. _OBJCPROTOCOL:
  2614. begin
  2615. { The @protocol keyword is used in two ways in Objective-C:
  2616. 1) to declare protocols (~ Object Pascal interfaces)
  2617. 2) to obtain the metaclass (~ Object Pascal) "class of")
  2618. of a declared protocol
  2619. This code is for handling the second case. Because of 1),
  2620. we cannot simply use a system unit symbol.
  2621. }
  2622. consume(_OBJCPROTOCOL);
  2623. consume(_LKLAMMER);
  2624. p1:=factor(false,false);
  2625. consume(_RKLAMMER);
  2626. p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
  2627. end;
  2628. else
  2629. begin
  2630. Message(parser_e_illegal_expression);
  2631. p1:=cerrornode.create;
  2632. { recover }
  2633. consume(token);
  2634. end;
  2635. end;
  2636. end;
  2637. { generate error node if no node is created }
  2638. if not assigned(p1) then
  2639. begin
  2640. {$ifdef EXTDEBUG}
  2641. Comment(V_Warning,'factor: p1=nil');
  2642. {$endif}
  2643. p1:=cerrornode.create;
  2644. updatefpos:=true;
  2645. end;
  2646. { get the resultdef for the node }
  2647. if (not assigned(p1.resultdef)) then
  2648. begin
  2649. do_typecheckpass_changed(p1,nodechanged);
  2650. updatefpos:=updatefpos or nodechanged;
  2651. end;
  2652. if assigned(p1) and
  2653. updatefpos then
  2654. p1.fileinfo:=filepos;
  2655. factor:=p1;
  2656. end;
  2657. {$maxfpuregisters default}
  2658. {****************************************************************************
  2659. Sub_Expr
  2660. ****************************************************************************}
  2661. const
  2662. { Warning these stay be ordered !! }
  2663. operator_levels:array[Toperator_precedence] of set of NOTOKEN..last_operator=
  2664. ([_LT,_LTE,_GT,_GTE,_EQ,_NE,_OP_IN],
  2665. [_PLUS,_MINUS,_OP_OR,_PIPE,_OP_XOR],
  2666. [_CARET,_SYMDIF,_STARSTAR,_STAR,_SLASH,
  2667. _OP_AS,_OP_IS,_OP_AND,_AMPERSAND,_OP_DIV,_OP_MOD,_OP_SHL,_OP_SHR],
  2668. [_STARSTAR] );
  2669. function sub_expr(pred_level:Toperator_precedence;accept_equal,typeonly:boolean):tnode;
  2670. {Reads a subexpression while the operators are of the current precedence
  2671. level, or any higher level. Replaces the old term, simpl_expr and
  2672. simpl2_expr.}
  2673. var
  2674. p1,p2 : tnode;
  2675. oldt : Ttoken;
  2676. filepos : tfileposinfo;
  2677. begin
  2678. if pred_level=highest_precedence then
  2679. p1:=factor(false,typeonly)
  2680. else
  2681. p1:=sub_expr(succ(pred_level),true,typeonly);
  2682. repeat
  2683. if (token in [NOTOKEN..last_operator]) and
  2684. (token in operator_levels[pred_level]) and
  2685. ((token<>_EQ) or accept_equal) then
  2686. begin
  2687. oldt:=token;
  2688. filepos:=current_tokenpos;
  2689. consume(token);
  2690. if pred_level=highest_precedence then
  2691. p2:=factor(false,false)
  2692. else
  2693. p2:=sub_expr(succ(pred_level),true,typeonly);
  2694. case oldt of
  2695. _PLUS :
  2696. p1:=caddnode.create(addn,p1,p2);
  2697. _MINUS :
  2698. p1:=caddnode.create(subn,p1,p2);
  2699. _STAR :
  2700. p1:=caddnode.create(muln,p1,p2);
  2701. _SLASH :
  2702. p1:=caddnode.create(slashn,p1,p2);
  2703. _EQ:
  2704. p1:=caddnode.create(equaln,p1,p2);
  2705. _GT :
  2706. p1:=caddnode.create(gtn,p1,p2);
  2707. _LT :
  2708. p1:=caddnode.create(ltn,p1,p2);
  2709. _GTE :
  2710. p1:=caddnode.create(gten,p1,p2);
  2711. _LTE :
  2712. p1:=caddnode.create(lten,p1,p2);
  2713. _SYMDIF :
  2714. p1:=caddnode.create(symdifn,p1,p2);
  2715. _STARSTAR :
  2716. p1:=caddnode.create(starstarn,p1,p2);
  2717. _OP_AS :
  2718. p1:=casnode.create(p1,p2);
  2719. _OP_IN :
  2720. p1:=cinnode.create(p1,p2);
  2721. _OP_IS :
  2722. p1:=cisnode.create(p1,p2);
  2723. _OP_OR,
  2724. _PIPE {macpas only} :
  2725. begin
  2726. p1:=caddnode.create(orn,p1,p2);
  2727. if (oldt = _PIPE) then
  2728. include(p1.flags,nf_short_bool);
  2729. end;
  2730. _OP_AND,
  2731. _AMPERSAND {macpas only} :
  2732. begin
  2733. p1:=caddnode.create(andn,p1,p2);
  2734. if (oldt = _AMPERSAND) then
  2735. include(p1.flags,nf_short_bool);
  2736. end;
  2737. _OP_DIV :
  2738. p1:=cmoddivnode.create(divn,p1,p2);
  2739. _OP_NOT :
  2740. p1:=cnotnode.create(p1);
  2741. _OP_MOD :
  2742. p1:=cmoddivnode.create(modn,p1,p2);
  2743. _OP_SHL :
  2744. p1:=cshlshrnode.create(shln,p1,p2);
  2745. _OP_SHR :
  2746. p1:=cshlshrnode.create(shrn,p1,p2);
  2747. _OP_XOR :
  2748. p1:=caddnode.create(xorn,p1,p2);
  2749. _ASSIGNMENT :
  2750. p1:=cassignmentnode.create(p1,p2);
  2751. _NE :
  2752. p1:=caddnode.create(unequaln,p1,p2);
  2753. end;
  2754. p1.fileinfo:=filepos;
  2755. end
  2756. else
  2757. break;
  2758. until false;
  2759. sub_expr:=p1;
  2760. end;
  2761. function comp_expr(accept_equal,typeonly:boolean):tnode;
  2762. var
  2763. oldafterassignment : boolean;
  2764. p1 : tnode;
  2765. begin
  2766. oldafterassignment:=afterassignment;
  2767. afterassignment:=true;
  2768. p1:=sub_expr(opcompare,accept_equal,typeonly);
  2769. { get the resultdef for this expression }
  2770. if not assigned(p1.resultdef) then
  2771. do_typecheckpass(p1);
  2772. afterassignment:=oldafterassignment;
  2773. comp_expr:=p1;
  2774. end;
  2775. function expr(dotypecheck : boolean) : tnode;
  2776. var
  2777. p1,p2 : tnode;
  2778. filepos : tfileposinfo;
  2779. oldafterassignment,
  2780. updatefpos : boolean;
  2781. begin
  2782. oldafterassignment:=afterassignment;
  2783. p1:=sub_expr(opcompare,true,false);
  2784. { get the resultdef for this expression }
  2785. if not assigned(p1.resultdef) and
  2786. dotypecheck then
  2787. do_typecheckpass(p1);
  2788. filepos:=current_tokenpos;
  2789. if token in [_ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
  2790. afterassignment:=true;
  2791. updatefpos:=true;
  2792. case token of
  2793. _POINTPOINT :
  2794. begin
  2795. consume(_POINTPOINT);
  2796. p2:=sub_expr(opcompare,true,false);
  2797. p1:=crangenode.create(p1,p2);
  2798. end;
  2799. _ASSIGNMENT :
  2800. begin
  2801. consume(_ASSIGNMENT);
  2802. if (p1.resultdef.typ=procvardef) then
  2803. getprocvardef:=tprocvardef(p1.resultdef);
  2804. p2:=sub_expr(opcompare,true,false);
  2805. if assigned(getprocvardef) then
  2806. handle_procvar(getprocvardef,p2);
  2807. getprocvardef:=nil;
  2808. p1:=cassignmentnode.create(p1,p2);
  2809. end;
  2810. _PLUSASN :
  2811. begin
  2812. consume(_PLUSASN);
  2813. p2:=sub_expr(opcompare,true,false);
  2814. p1:=gen_c_style_operator(addn,p1,p2);
  2815. end;
  2816. _MINUSASN :
  2817. begin
  2818. consume(_MINUSASN);
  2819. p2:=sub_expr(opcompare,true,false);
  2820. p1:=gen_c_style_operator(subn,p1,p2);
  2821. end;
  2822. _STARASN :
  2823. begin
  2824. consume(_STARASN );
  2825. p2:=sub_expr(opcompare,true,false);
  2826. p1:=gen_c_style_operator(muln,p1,p2);
  2827. end;
  2828. _SLASHASN :
  2829. begin
  2830. consume(_SLASHASN );
  2831. p2:=sub_expr(opcompare,true,false);
  2832. p1:=gen_c_style_operator(slashn,p1,p2);
  2833. end;
  2834. else
  2835. updatefpos:=false;
  2836. end;
  2837. { get the resultdef for this expression }
  2838. if not assigned(p1.resultdef) and
  2839. dotypecheck then
  2840. do_typecheckpass(p1);
  2841. afterassignment:=oldafterassignment;
  2842. if updatefpos then
  2843. p1.fileinfo:=filepos;
  2844. expr:=p1;
  2845. end;
  2846. function get_intconst:TConstExprInt;
  2847. {Reads an expression, tries to evalute it and check if it is an integer
  2848. constant. Then the constant is returned.}
  2849. var
  2850. p:tnode;
  2851. begin
  2852. result:=0;
  2853. p:=comp_expr(true,false);
  2854. if not codegenerror then
  2855. begin
  2856. if (p.nodetype<>ordconstn) or
  2857. not(is_integer(p.resultdef)) then
  2858. Message(parser_e_illegal_expression)
  2859. else
  2860. result:=tordconstnode(p).value;
  2861. end;
  2862. p.free;
  2863. end;
  2864. function get_stringconst:string;
  2865. {Reads an expression, tries to evaluate it and checks if it is a string
  2866. constant. Then the constant is returned.}
  2867. var
  2868. p:tnode;
  2869. begin
  2870. get_stringconst:='';
  2871. p:=comp_expr(true,false);
  2872. if p.nodetype<>stringconstn then
  2873. begin
  2874. if (p.nodetype=ordconstn) and is_char(p.resultdef) then
  2875. get_stringconst:=char(int64(tordconstnode(p).value))
  2876. else
  2877. Message(parser_e_illegal_expression);
  2878. end
  2879. else
  2880. get_stringconst:=strpas(tstringconstnode(p).value_str);
  2881. p.free;
  2882. end;
  2883. end.