pexpr.pas 116 KB

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