pexpr.pas 92 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Florian Klaempfl
  4. Does parsing of expression for Free Pascal
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit pexpr;
  19. {$i defines.inc}
  20. interface
  21. uses
  22. symtype,
  23. node,
  24. cpuinfo;
  25. { reads a whole expression }
  26. function expr : tnode;
  27. { reads an expression without assignements and .. }
  28. function comp_expr(accept_equal : boolean):tnode;
  29. { reads a single factor }
  30. function factor(getaddr : boolean) : tnode;
  31. function string_dec : pdef;
  32. { the ID token has to be consumed before calling this function }
  33. procedure do_member_read(getaddr : boolean;sym : psym;var p1 : tnode;
  34. var pd : pdef;var again : boolean);
  35. {$ifdef int64funcresok}
  36. function get_intconst:TConstExprInt;
  37. {$else int64funcresok}
  38. function get_intconst:longint;
  39. {$endif int64funcresok}
  40. function get_stringconst:string;
  41. implementation
  42. uses
  43. { common }
  44. cutils,cobjects,
  45. { global }
  46. globtype,globals,tokens,verbose,
  47. systems,widestr,
  48. { symtable }
  49. symconst,symbase,symdef,symsym,symtable,types,
  50. { pass 1 }
  51. pass_1,htypechk,
  52. nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
  53. { parser }
  54. scanner,
  55. pbase,
  56. { codegen }
  57. {$ifdef newcg}
  58. cgbase
  59. {$else}
  60. hcodegen
  61. {$endif}
  62. ;
  63. { sub_expr(opmultiply) is need to get -1 ** 4 to be
  64. read as - (1**4) and not (-1)**4 PM }
  65. type
  66. Toperator_precedence=(opcompare,opaddition,opmultiply,oppower);
  67. const
  68. highest_precedence = oppower;
  69. function sub_expr(pred_level:Toperator_precedence;accept_equal : boolean):tnode;forward;
  70. const
  71. allow_type : boolean = true;
  72. got_addrn : boolean = false;
  73. auto_inherited : boolean = false;
  74. function string_dec : pdef;
  75. { reads a string type with optional length }
  76. { and returns a pointer to the string }
  77. { definition }
  78. var
  79. p : tnode;
  80. d : pdef;
  81. begin
  82. consume(_STRING);
  83. if token=_LECKKLAMMER then
  84. begin
  85. consume(_LECKKLAMMER);
  86. p:=comp_expr(true);
  87. do_firstpass(p);
  88. if not is_constintnode(p) then
  89. begin
  90. Message(cg_e_illegal_expression);
  91. { error recovery }
  92. consume(_RECKKLAMMER);
  93. d:=cshortstringdef;
  94. end
  95. else
  96. begin
  97. if (tordconstnode(p).value<=0) then
  98. begin
  99. Message(parser_e_invalid_string_size);
  100. tordconstnode(p).value:=255;
  101. end;
  102. consume(_RECKKLAMMER);
  103. if tordconstnode(p).value>255 then
  104. d:=new(pstringdef,longinit(tordconstnode(p).value))
  105. else
  106. if tordconstnode(p).value<>255 then
  107. d:=new(pstringdef,shortinit(tordconstnode(p).value))
  108. else
  109. d:=cshortstringdef;
  110. end;
  111. p.free;
  112. end
  113. else
  114. begin
  115. if cs_ansistrings in aktlocalswitches then
  116. d:=cansistringdef
  117. else
  118. d:=cshortstringdef;
  119. end;
  120. string_dec:=d;
  121. end;
  122. function parse_paras(__colon,in_prop_paras : boolean) : tnode;
  123. var
  124. p1,p2 : tnode;
  125. end_of_paras : ttoken;
  126. begin
  127. if in_prop_paras then
  128. end_of_paras:=_RECKKLAMMER
  129. else
  130. end_of_paras:=_RKLAMMER;
  131. if token=end_of_paras then
  132. begin
  133. parse_paras:=nil;
  134. exit;
  135. end;
  136. p2:=nil;
  137. inc(parsing_para_level);
  138. while true do
  139. begin
  140. p1:=comp_expr(true);
  141. p2:=gencallparanode(p1,p2);
  142. { it's for the str(l:5,s); }
  143. if __colon and (token=_COLON) then
  144. begin
  145. consume(_COLON);
  146. p1:=comp_expr(true);
  147. p2:=gencallparanode(p1,p2);
  148. include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
  149. if token=_COLON then
  150. begin
  151. consume(_COLON);
  152. p1:=comp_expr(true);
  153. p2:=gencallparanode(p1,p2);
  154. include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
  155. end
  156. end;
  157. if token=_COMMA then
  158. consume(_COMMA)
  159. else
  160. break;
  161. end;
  162. dec(parsing_para_level);
  163. parse_paras:=p2;
  164. end;
  165. procedure check_tp_procvar(var p : tnode);
  166. var
  167. p1 : tnode;
  168. begin
  169. if (m_tp_procvar in aktmodeswitches) and
  170. (not got_addrn) and
  171. (not in_args) and
  172. (p.nodetype=loadn) then
  173. begin
  174. { support if procvar then for tp7 and many other expression like this }
  175. do_firstpass(p);
  176. set_varstate(p,false);
  177. { reset varstateset to maybe set used state later web bug769 PM }
  178. unset_varstate(p);
  179. if not(getprocvar) and (p.resulttype^.deftype=procvardef) then
  180. begin
  181. p1:=gencallnode(nil,nil);
  182. tcallnode(p1).right:=p;
  183. p1.resulttype:=pprocvardef(p.resulttype)^.rettype.def;
  184. firstpass(p1);
  185. p:=p1;
  186. end;
  187. end;
  188. end;
  189. function statement_syssym(l : longint;var pd : pdef) : tnode;
  190. var
  191. p1,p2,paras : tnode;
  192. prev_in_args : boolean;
  193. begin
  194. prev_in_args:=in_args;
  195. case l of
  196. in_ord_x :
  197. begin
  198. consume(_LKLAMMER);
  199. in_args:=true;
  200. p1:=comp_expr(true);
  201. consume(_RKLAMMER);
  202. do_firstpass(p1);
  203. p1:=geninlinenode(in_ord_x,false,p1);
  204. do_firstpass(p1);
  205. statement_syssym := p1;
  206. pd:=p1.resulttype;
  207. end;
  208. in_break :
  209. begin
  210. statement_syssym:=cbreaknode.create;
  211. pd:=voiddef;
  212. end;
  213. in_continue :
  214. begin
  215. statement_syssym:=ccontinuenode.create;
  216. pd:=voiddef;
  217. end;
  218. in_typeof_x :
  219. begin
  220. consume(_LKLAMMER);
  221. in_args:=true;
  222. {allow_type:=true;}
  223. p1:=comp_expr(true);
  224. {allow_type:=false;}
  225. consume(_RKLAMMER);
  226. pd:=voidpointerdef;
  227. if p1.nodetype=typen then
  228. begin
  229. if (ttypenode(p1).typenodetype=nil) then
  230. begin
  231. Message(type_e_mismatch);
  232. statement_syssym:=cerrornode.create;
  233. end
  234. else
  235. if ttypenode(p1).typenodetype^.deftype=objectdef then
  236. begin
  237. { we can use resulttype in pass_2 (PM) }
  238. p1.resulttype:=ttypenode(p1).typenodetype;
  239. statement_syssym:=geninlinenode(in_typeof_x,false,p1);
  240. end
  241. else
  242. begin
  243. Message(type_e_mismatch);
  244. p1.destroy;
  245. statement_syssym:=cerrornode.create;
  246. end;
  247. end
  248. else { not a type node }
  249. begin
  250. do_firstpass(p1);
  251. set_varstate(p1,false);
  252. if (p1.resulttype=nil) then
  253. begin
  254. Message(type_e_mismatch);
  255. p1.destroy;
  256. statement_syssym:=cerrornode.create;
  257. end
  258. else
  259. if p1.resulttype^.deftype=objectdef then
  260. statement_syssym:=geninlinenode(in_typeof_x,false,p1)
  261. else
  262. begin
  263. Message(type_e_mismatch);
  264. statement_syssym:=cerrornode.create;
  265. p1.destroy;
  266. end;
  267. end;
  268. end;
  269. in_sizeof_x :
  270. begin
  271. consume(_LKLAMMER);
  272. in_args:=true;
  273. {allow_type:=true;}
  274. p1:=comp_expr(true);
  275. {allow_type:=false; }
  276. consume(_RKLAMMER);
  277. pd:=s32bitdef;
  278. if p1.nodetype=typen then
  279. begin
  280. statement_syssym:=genordinalconstnode(ttypenode(p1).typenodetype^.size,pd);
  281. { p1 not needed !}
  282. p1.destroy;
  283. end
  284. else
  285. begin
  286. do_firstpass(p1);
  287. if ((p1.resulttype^.deftype=objectdef) and
  288. (oo_has_constructor in pobjectdef(p1.resulttype)^.objectoptions)) or
  289. is_open_array(p1.resulttype) or
  290. is_open_string(p1.resulttype) then
  291. statement_syssym:=geninlinenode(in_sizeof_x,false,p1)
  292. else
  293. begin
  294. statement_syssym:=genordinalconstnode(p1.resulttype^.size,pd);
  295. { p1 not needed !}
  296. p1.destroy;
  297. end;
  298. end;
  299. end;
  300. in_typeinfo_x :
  301. begin
  302. consume(_LKLAMMER);
  303. in_args:=true;
  304. {allow_type:=true;}
  305. p1:=comp_expr(true);
  306. do_firstpass(p1);
  307. {allow_type:=false; }
  308. if p1.nodetype<>typen then
  309. begin
  310. p1.destroy;
  311. p1:=cerrornode.create;
  312. Message(parser_e_illegal_parameter_list);
  313. end;
  314. consume(_RKLAMMER);
  315. p2:=gencallparanode(p1,nil);
  316. p2:=geninlinenode(in_typeinfo_x,false,p2);
  317. pd:=voidpointerdef;
  318. statement_syssym:=p2;
  319. end;
  320. in_assigned_x :
  321. begin
  322. consume(_LKLAMMER);
  323. in_args:=true;
  324. p1:=comp_expr(true);
  325. do_firstpass(p1);
  326. if not codegenerror then
  327. begin
  328. case p1.resulttype^.deftype of
  329. pointerdef,
  330. procvardef,
  331. classrefdef : ;
  332. objectdef :
  333. if not is_class_or_interface(p1.resulttype) then
  334. Message(parser_e_illegal_parameter_list);
  335. else
  336. Message(parser_e_illegal_parameter_list);
  337. end;
  338. end;
  339. p2:=gencallparanode(p1,nil);
  340. p2:=geninlinenode(in_assigned_x,false,p2);
  341. consume(_RKLAMMER);
  342. pd:=booldef;
  343. statement_syssym:=p2;
  344. end;
  345. in_addr_x :
  346. begin
  347. consume(_LKLAMMER);
  348. in_args:=true;
  349. p1:=comp_expr(true);
  350. p1:=caddrnode.create(p1);
  351. do_firstpass(p1);
  352. pd:=p1.resulttype;
  353. consume(_RKLAMMER);
  354. statement_syssym:=p1;
  355. end;
  356. in_ofs_x :
  357. begin
  358. consume(_LKLAMMER);
  359. in_args:=true;
  360. p1:=comp_expr(true);
  361. p1:=caddrnode.create(p1);
  362. do_firstpass(p1);
  363. { Ofs() returns a longint, not a pointer }
  364. p1.resulttype:=u32bitdef;
  365. pd:=p1.resulttype;
  366. consume(_RKLAMMER);
  367. statement_syssym:=p1;
  368. end;
  369. in_seg_x :
  370. begin
  371. consume(_LKLAMMER);
  372. in_args:=true;
  373. { the expression must be allowed to be assigned to }
  374. p1:=comp_expr(true);
  375. p1:=geninlinenode(in_seg_x,false,p1);
  376. do_firstpass(p1);
  377. consume(_RKLAMMER);
  378. statement_syssym:=p1;
  379. end;
  380. in_high_x,
  381. in_low_x :
  382. begin
  383. consume(_LKLAMMER);
  384. in_args:=true;
  385. {allow_type:=true;}
  386. p1:=comp_expr(true);
  387. {allow_type:=false;}
  388. do_firstpass(p1);
  389. if p1.nodetype=typen then
  390. p1.resulttype:=ttypenode(p1).typenodetype;
  391. p2:=geninlinenode(l,false,p1);
  392. consume(_RKLAMMER);
  393. pd:=s32bitdef;
  394. statement_syssym:=p2;
  395. end;
  396. in_succ_x,
  397. in_pred_x :
  398. begin
  399. consume(_LKLAMMER);
  400. in_args:=true;
  401. p1:=comp_expr(true);
  402. do_firstpass(p1);
  403. p2:=geninlinenode(l,false,p1);
  404. consume(_RKLAMMER);
  405. pd:=p1.resulttype;
  406. statement_syssym:=p2;
  407. end;
  408. in_inc_x,
  409. in_dec_x :
  410. begin
  411. consume(_LKLAMMER);
  412. in_args:=true;
  413. p1:=comp_expr(true);
  414. if token=_COMMA then
  415. begin
  416. consume(_COMMA);
  417. p2:=gencallparanode(comp_expr(true),nil);
  418. end
  419. else
  420. p2:=nil;
  421. p2:=gencallparanode(p1,p2);
  422. statement_syssym:=geninlinenode(l,false,p2);
  423. consume(_RKLAMMER);
  424. pd:=voiddef;
  425. end;
  426. in_finalize_x:
  427. begin
  428. consume(_LKLAMMER);
  429. in_args:=true;
  430. p1:=comp_expr(true);
  431. if token=_COMMA then
  432. begin
  433. consume(_COMMA);
  434. p2:=gencallparanode(comp_expr(true),nil);
  435. end
  436. else
  437. p2:=nil;
  438. p2:=gencallparanode(p1,p2);
  439. statement_syssym:=geninlinenode(in_finalize_x,false,p2);
  440. consume(_RKLAMMER);
  441. pd:=voiddef;
  442. end;
  443. in_concat_x :
  444. begin
  445. consume(_LKLAMMER);
  446. in_args:=true;
  447. p2:=nil;
  448. while true do
  449. begin
  450. p1:=comp_expr(true);
  451. do_firstpass(p1);
  452. set_varstate(p1,true);
  453. if not((p1.resulttype^.deftype=stringdef) or
  454. ((p1.resulttype^.deftype=orddef) and
  455. (porddef(p1.resulttype)^.typ=uchar))) then
  456. Message(parser_e_illegal_parameter_list);
  457. if p2<>nil then
  458. p2:=caddnode.create(addn,p2,p1)
  459. else
  460. p2:=p1;
  461. if token=_COMMA then
  462. consume(_COMMA)
  463. else
  464. break;
  465. end;
  466. consume(_RKLAMMER);
  467. pd:=cshortstringdef;
  468. statement_syssym:=p2;
  469. end;
  470. in_read_x,
  471. in_readln_x :
  472. begin
  473. if token=_LKLAMMER then
  474. begin
  475. consume(_LKLAMMER);
  476. in_args:=true;
  477. paras:=parse_paras(false,false);
  478. consume(_RKLAMMER);
  479. end
  480. else
  481. paras:=nil;
  482. pd:=voiddef;
  483. p1:=geninlinenode(l,false,paras);
  484. do_firstpass(p1);
  485. statement_syssym := p1;
  486. end;
  487. in_setlength_x:
  488. begin
  489. if token=_LKLAMMER then
  490. begin
  491. consume(_LKLAMMER);
  492. in_args:=true;
  493. paras:=parse_paras(false,false);
  494. consume(_RKLAMMER);
  495. end
  496. else
  497. paras:=nil;
  498. pd:=voiddef;
  499. p1:=geninlinenode(l,false,paras);
  500. do_firstpass(p1);
  501. statement_syssym := p1;
  502. end;
  503. in_write_x,
  504. in_writeln_x :
  505. begin
  506. if token=_LKLAMMER then
  507. begin
  508. consume(_LKLAMMER);
  509. in_args:=true;
  510. paras:=parse_paras(true,false);
  511. consume(_RKLAMMER);
  512. end
  513. else
  514. paras:=nil;
  515. pd:=voiddef;
  516. p1 := geninlinenode(l,false,paras);
  517. do_firstpass(p1);
  518. statement_syssym := p1;
  519. end;
  520. in_str_x_string :
  521. begin
  522. consume(_LKLAMMER);
  523. in_args:=true;
  524. paras:=parse_paras(true,false);
  525. consume(_RKLAMMER);
  526. p1 := geninlinenode(l,false,paras);
  527. do_firstpass(p1);
  528. statement_syssym := p1;
  529. pd:=voiddef;
  530. end;
  531. in_val_x:
  532. Begin
  533. consume(_LKLAMMER);
  534. in_args := true;
  535. p1:= gencallparanode(comp_expr(true), nil);
  536. consume(_COMMA);
  537. p2 := gencallparanode(comp_expr(true),p1);
  538. if (token = _COMMA) then
  539. Begin
  540. consume(_COMMA);
  541. p2 := gencallparanode(comp_expr(true),p2)
  542. End;
  543. consume(_RKLAMMER);
  544. p2 := geninlinenode(l,false,p2);
  545. do_firstpass(p2);
  546. statement_syssym := p2;
  547. pd := voiddef;
  548. End;
  549. in_include_x_y,
  550. in_exclude_x_y :
  551. begin
  552. consume(_LKLAMMER);
  553. in_args:=true;
  554. p1:=comp_expr(true);
  555. consume(_COMMA);
  556. p2:=comp_expr(true);
  557. statement_syssym:=geninlinenode(l,false,gencallparanode(p1,gencallparanode(p2,nil)));
  558. consume(_RKLAMMER);
  559. pd:=voiddef;
  560. end;
  561. in_assert_x_y :
  562. begin
  563. consume(_LKLAMMER);
  564. in_args:=true;
  565. p1:=comp_expr(true);
  566. if token=_COMMA then
  567. begin
  568. consume(_COMMA);
  569. p2:=comp_expr(true);
  570. end
  571. else
  572. begin
  573. { then insert an empty string }
  574. p2:=genstringconstnode('',st_default);
  575. end;
  576. statement_syssym:=geninlinenode(l,false,gencallparanode(p1,gencallparanode(p2,nil)));
  577. consume(_RKLAMMER);
  578. pd:=voiddef;
  579. end;
  580. else
  581. internalerror(15);
  582. end;
  583. in_args:=prev_in_args;
  584. end;
  585. { reads the parameter for a subroutine call }
  586. procedure do_proc_call(getaddr : boolean;var again : boolean;var p1:tcallnode;var pd:Pdef);
  587. var
  588. prev_in_args : boolean;
  589. prevafterassn : boolean;
  590. hs,hs1 : pvarsym;
  591. st : psymtable;
  592. p2 : tnode;
  593. begin
  594. prev_in_args:=in_args;
  595. prevafterassn:=afterassignment;
  596. afterassignment:=false;
  597. { want we only determine the address of }
  598. { a subroutine ? }
  599. if not(getaddr) then
  600. begin
  601. if auto_inherited then
  602. begin
  603. st:=symtablestack;
  604. while assigned(st) and (st^.symtabletype<>parasymtable) do
  605. st:=st^.next;
  606. p2:=nil;
  607. if assigned(st) then
  608. begin
  609. hs:=pvarsym(st^.symindex^.first);
  610. while assigned(hs) do
  611. begin
  612. if hs^.typ<>varsym then
  613. internalerror(54382953);
  614. { if there is a localcopy then use that }
  615. if assigned(hs^.localvarsym) then
  616. hs1:=hs^.localvarsym
  617. else
  618. hs1:=hs;
  619. p2:=gencallparanode(genloadnode(hs1,hs1^.owner),p2);
  620. hs:=pvarsym(hs^.indexnext);
  621. end;
  622. end
  623. else
  624. internalerror(54382954);
  625. p1.left:=p2;
  626. end
  627. else
  628. begin
  629. if token=_LKLAMMER then
  630. begin
  631. consume(_LKLAMMER);
  632. in_args:=true;
  633. p1.left:=parse_paras(false,false);
  634. consume(_RKLAMMER);
  635. end
  636. else
  637. p1.left:=nil;
  638. end;
  639. { do firstpass because we need the }
  640. { result type }
  641. do_firstpass(p1);
  642. {set_var_state is handled inside firstcalln }
  643. end
  644. else
  645. begin
  646. { address operator @: }
  647. p1.left:=nil;
  648. { forget pd }
  649. pd:=nil;
  650. if (p1.symtableproc^.symtabletype=withsymtable) and
  651. (p1.symtableproc^.defowner^.deftype=objectdef) then
  652. begin
  653. p1.methodpointer:=tnode(pwithsymtable(p1.symtableproc)^.withrefnode).getcopy;
  654. end
  655. else if not(assigned(p1.methodpointer)) then
  656. begin
  657. { we must provide a method pointer, if it isn't given, }
  658. { it is self }
  659. if assigned(procinfo) then
  660. begin
  661. p1.methodpointer:=genselfnode(procinfo^._class);
  662. p1.methodpointer.resulttype:=procinfo^._class;
  663. end
  664. else
  665. begin
  666. p1.methodpointer:=genselfnode(nil);
  667. p1.methodpointer.resulttype:=nil;
  668. end;
  669. end;
  670. { no postfix operators }
  671. again:=false;
  672. end;
  673. pd:=p1.resulttype;
  674. in_args:=prev_in_args;
  675. afterassignment:=prevafterassn;
  676. end;
  677. procedure handle_procvar(pv : pprocvardef;var p2 : tnode);
  678. procedure doconv(procvar : pprocvardef;var t : tnode);
  679. var
  680. hp : tnode;
  681. begin
  682. hp:=nil;
  683. if (proc_to_procvar_equal(pprocsym(tcallnode(t).symtableprocentry)^.definition,procvar)) then
  684. begin
  685. if (po_methodpointer in procvar^.procoptions) then
  686. hp:=genloadmethodcallnode(pprocsym(tcallnode(t).symtableprocentry),tcallnode(t).symtableproc,tnode(tcallnode(t).methodpointer).getcopy)
  687. else
  688. hp:=genloadcallnode(pprocsym(tcallnode(t).symtableprocentry),tcallnode(t).symtableproc);
  689. end;
  690. if assigned(hp) then
  691. begin
  692. t.destroy;
  693. t:=hp;
  694. end;
  695. end;
  696. begin
  697. if (p2.nodetype=calln) then
  698. doconv(pv,tcallnode(p2))
  699. else
  700. if (p2.nodetype=typeconvn) and
  701. (ttypeconvnode(p2).left.nodetype=calln) then
  702. doconv(pv,tcallnode(ttypeconvnode(p2).left));
  703. end;
  704. { the following procedure handles the access to a property symbol }
  705. procedure handle_propertysym(sym : psym;st : psymtable;var p1 : tnode;
  706. var pd : pdef);
  707. var
  708. paras : tnode;
  709. p2 : tnode;
  710. plist : psymlistitem;
  711. begin
  712. paras:=nil;
  713. { property parameters? read them only if the property really }
  714. { has parameters }
  715. if ppo_hasparameters in ppropertysym(sym)^.propoptions then
  716. begin
  717. if token=_LECKKLAMMER then
  718. begin
  719. consume(_LECKKLAMMER);
  720. paras:=parse_paras(false,true);
  721. consume(_RECKKLAMMER);
  722. end;
  723. { indexed property }
  724. if (ppo_indexed in ppropertysym(sym)^.propoptions) then
  725. begin
  726. p2:=genordinalconstnode(ppropertysym(sym)^.index,ppropertysym(sym)^.indextype.def);
  727. paras:=gencallparanode(p2,paras);
  728. end;
  729. end;
  730. { we need only a write property if a := follows }
  731. { if not(afterassignment) and not(in_args) then }
  732. if token=_ASSIGNMENT then
  733. begin
  734. { write property: }
  735. { no result }
  736. pd:=voiddef;
  737. if not ppropertysym(sym)^.writeaccess^.empty then
  738. begin
  739. case ppropertysym(sym)^.writeaccess^.firstsym^.sym^.typ of
  740. procsym :
  741. begin
  742. { generate the method call }
  743. p1:=ccallnode.create(pprocsym(ppropertysym(sym)^.writeaccess^.firstsym^.sym),st,p1);
  744. { we know the procedure to call, so
  745. force the usage of that procedure }
  746. tcallnode(p1).procdefinition:=pprocdef(ppropertysym(sym)^.writeaccess^.def);
  747. tcallnode(p1).left:=paras;
  748. consume(_ASSIGNMENT);
  749. { read the expression }
  750. getprocvar:=ppropertysym(sym)^.proptype.def^.deftype=procvardef;
  751. p2:=comp_expr(true);
  752. if getprocvar then
  753. handle_procvar(pprocvardef(ppropertysym(sym)^.proptype.def),p2);
  754. tcallnode(p1).left:=gencallparanode(p2,tcallnode(p1).left);
  755. include(tcallnode(p1).flags,nf_isproperty);
  756. getprocvar:=false;
  757. end;
  758. varsym :
  759. begin
  760. if assigned(paras) then
  761. message(parser_e_no_paras_allowed);
  762. { subscribed access? }
  763. plist:=ppropertysym(sym)^.writeaccess^.firstsym;
  764. while assigned(plist) do
  765. begin
  766. if p1=nil then
  767. p1:=genloadnode(pvarsym(pList^.sym),st)
  768. else
  769. p1:=gensubscriptnode(pvarsym(pList^.sym),p1);
  770. plist:=pList^.next;
  771. end;
  772. include(tcallnode(p1).flags,nf_isproperty);
  773. consume(_ASSIGNMENT);
  774. { read the expression }
  775. p2:=comp_expr(true);
  776. p1:=cassignmentnode.create(p1,p2);
  777. end
  778. else
  779. begin
  780. p1:=cerrornode.create;
  781. Message(parser_e_no_procedure_to_access_property);
  782. end;
  783. end;
  784. end
  785. else
  786. begin
  787. p1:=cerrornode.create;
  788. Message(parser_e_no_procedure_to_access_property);
  789. end;
  790. end
  791. else
  792. begin
  793. { read property: }
  794. pd:=ppropertysym(sym)^.proptype.def;
  795. if not ppropertysym(sym)^.readaccess^.empty then
  796. begin
  797. case ppropertysym(sym)^.readaccess^.firstsym^.sym^.typ of
  798. varsym :
  799. begin
  800. if assigned(paras) then
  801. message(parser_e_no_paras_allowed);
  802. { subscribed access? }
  803. plist:=ppropertysym(sym)^.readaccess^.firstsym;
  804. while assigned(plist) do
  805. begin
  806. if p1=nil then
  807. p1:=genloadnode(pvarsym(pList^.sym),st)
  808. else
  809. p1:=gensubscriptnode(pvarsym(pList^.sym),p1);
  810. plist:=pList^.next;
  811. end;
  812. include(p1.flags,nf_isproperty);
  813. end;
  814. procsym :
  815. begin
  816. { generate the method call }
  817. p1:=ccallnode.create(pprocsym(ppropertysym(sym)^.readaccess^.firstsym^.sym),st,p1);
  818. { we know the procedure to call, so
  819. force the usage of that procedure }
  820. tcallnode(p1).procdefinition:=pprocdef(ppropertysym(sym)^.readaccess^.def);
  821. { insert paras }
  822. tcallnode(p1).left:=paras;
  823. include(p1.flags,nf_isproperty);
  824. end
  825. else
  826. begin
  827. p1:=cerrornode.create;
  828. Message(type_e_mismatch);
  829. end;
  830. end;
  831. end
  832. else
  833. begin
  834. { error, no function to read property }
  835. p1:=cerrornode.create;
  836. Message(parser_e_no_procedure_to_access_property);
  837. end;
  838. end;
  839. end;
  840. { the ID token has to be consumed before calling this function }
  841. procedure do_member_read(getaddr : boolean;sym : psym;var p1 : tnode;
  842. var pd : pdef;var again : boolean);
  843. var
  844. static_name : string;
  845. isclassref : boolean;
  846. srsymtable : psymtable;
  847. objdef : pobjectdef;
  848. begin
  849. if sym=nil then
  850. begin
  851. { pattern is still valid unless
  852. there is another ID just after the ID of sym }
  853. Message1(sym_e_id_no_member,pattern);
  854. p1.destroy;
  855. p1:=cerrornode.create;
  856. { try to clean up }
  857. pd:=generrordef;
  858. again:=false;
  859. end
  860. else
  861. begin
  862. objdef:=pobjectdef(sym^.owner^.defowner);
  863. isclassref:=(pd^.deftype=classrefdef);
  864. { check protected and private members }
  865. { please leave this code as it is, }
  866. { it has now the same behaviaor as TP/Delphi }
  867. if (sp_private in sym^.symoptions) and
  868. (objdef^.owner^.symtabletype=unitsymtable) then
  869. Message(parser_e_cant_access_private_member);
  870. if (sp_protected in sym^.symoptions) and
  871. (objdef^.owner^.symtabletype=unitsymtable) then
  872. begin
  873. if assigned(aktprocsym^.definition^._class) then
  874. begin
  875. if not aktprocsym^.definition^._class^.is_related(objdef) then
  876. Message(parser_e_cant_access_protected_member);
  877. end
  878. else
  879. Message(parser_e_cant_access_protected_member);
  880. end;
  881. { we assume, that only procsyms and varsyms are in an object }
  882. { symbol table, for classes, properties are allowed }
  883. case sym^.typ of
  884. procsym:
  885. begin
  886. p1:=ccallnode.create(pprocsym(sym),sym^.owner,p1);
  887. do_proc_call(getaddr or
  888. (getprocvar and
  889. ((block_type=bt_const) or
  890. ((m_tp_procvar in aktmodeswitches) and
  891. proc_to_procvar_equal(pprocsym(sym)^.definition,getprocvardef)
  892. )
  893. )
  894. ),again,tcallnode(p1),pd);
  895. if (block_type=bt_const) and
  896. getprocvar then
  897. handle_procvar(getprocvardef,p1);
  898. { now we know the real method e.g. we can check for a class method }
  899. if isclassref and
  900. assigned(tcallnode(p1).procdefinition) and
  901. not(po_classmethod in tcallnode(p1).procdefinition^.procoptions) and
  902. not(tcallnode(p1).procdefinition^.proctypeoption=potype_constructor) then
  903. Message(parser_e_only_class_methods_via_class_ref);
  904. end;
  905. varsym:
  906. begin
  907. if isclassref then
  908. Message(parser_e_only_class_methods_via_class_ref);
  909. if (sp_static in sym^.symoptions) then
  910. begin
  911. static_name:=lower(sym^.owner^.name^)+'_'+sym^.name;
  912. searchsym(static_name,sym,srsymtable);
  913. p1.destroy;
  914. p1:=genloadnode(pvarsym(sym),srsymtable);
  915. end
  916. else
  917. p1:=gensubscriptnode(pvarsym(sym),p1);
  918. pd:=pvarsym(sym)^.vartype.def;
  919. end;
  920. propertysym:
  921. begin
  922. if isclassref then
  923. Message(parser_e_only_class_methods_via_class_ref);
  924. handle_propertysym(sym,sym^.owner,p1,pd);
  925. end;
  926. else internalerror(16);
  927. end;
  928. end;
  929. end;
  930. {****************************************************************************
  931. Factor
  932. ****************************************************************************}
  933. {$ifdef fpc}
  934. {$maxfpuregisters 0}
  935. {$endif fpc}
  936. function factor(getaddr : boolean) : tnode;
  937. var
  938. l : longint;
  939. card : cardinal;
  940. ic : TConstExprInt;
  941. oldp1,
  942. p1,p2,p3 : tnode;
  943. code : integer;
  944. pd,pd2 : pdef;
  945. possible_error,
  946. {$ifdef TEST_PROCSYMS}
  947. unit_specific,
  948. {$endif TEST_PROCSYMS}
  949. again : boolean;
  950. sym : psym;
  951. classh : pobjectdef;
  952. d : bestreal;
  953. hs,
  954. static_name : string;
  955. propsym : ppropertysym;
  956. filepos : tfileposinfo;
  957. {---------------------------------------------
  958. Is_func_ret
  959. ---------------------------------------------}
  960. function is_func_ret(var sym : psym;var srsymtable:psymtable) : boolean;
  961. var
  962. p : pprocinfo;
  963. storesymtablestack : psymtable;
  964. begin
  965. is_func_ret:=false;
  966. if not assigned(procinfo) or
  967. ((sym^.typ<>funcretsym) and ((procinfo^.flags and pi_operator)=0)) then
  968. exit;
  969. p:=procinfo;
  970. while assigned(p) do
  971. begin
  972. { is this an access to a function result? Accessing _RESULT is
  973. always allowed and funcretn is generated }
  974. if assigned(p^.funcretsym) and
  975. ((pfuncretsym(sym)=p^.resultfuncretsym) or
  976. ((pfuncretsym(sym)=p^.funcretsym) or
  977. ((pvarsym(sym)=opsym) and ((p^.flags and pi_operator)<>0))) and
  978. (p^.returntype.def<>pdef(voiddef)) and
  979. (token<>_LKLAMMER) and
  980. (not ((m_tp in aktmodeswitches) and (afterassignment or in_args)))
  981. ) then
  982. begin
  983. if ((pvarsym(sym)=opsym) and
  984. ((p^.flags and pi_operator)<>0)) then
  985. inc(opsym^.refs);
  986. p1:=cfuncretnode.create;
  987. pd:=p^.returntype.def;
  988. tfuncretnode(p1).funcretprocinfo:=p;
  989. tfuncretnode(p1).rettype.def:=pd;
  990. is_func_ret:=true;
  991. if p^.funcret_state=vs_declared then
  992. begin
  993. p^.funcret_state:=vs_declared_and_first_found;
  994. include(p1.flags,nf_is_first_funcret);
  995. end;
  996. exit;
  997. end;
  998. p:=p^.parent;
  999. end;
  1000. { we must use the function call, update the
  1001. sym to be the procsym }
  1002. if (sym^.typ=funcretsym) then
  1003. begin
  1004. storesymtablestack:=symtablestack;
  1005. symtablestack:=sym^.owner^.next;
  1006. searchsym(sym^.name,sym,srsymtable);
  1007. if not assigned(sym) then
  1008. sym:=generrorsym;
  1009. if (sym^.typ<>procsym) then
  1010. Message(cg_e_illegal_expression);
  1011. symtablestack:=storesymtablestack;
  1012. end;
  1013. end;
  1014. {---------------------------------------------
  1015. Factor_read_id
  1016. ---------------------------------------------}
  1017. procedure factor_read_id;
  1018. var
  1019. pc : pchar;
  1020. len : longint;
  1021. srsym : psym;
  1022. srsymtable : psymtable;
  1023. begin
  1024. { allow post fix operators }
  1025. again:=true;
  1026. consume_sym(srsym,srsymtable);
  1027. if not is_func_ret(srsym,srsymtable) then
  1028. begin
  1029. { check semantics of private }
  1030. if (srsym^.typ in [propertysym,procsym,varsym]) and
  1031. (srsym^.owner^.symtabletype=objectsymtable) then
  1032. begin
  1033. if (sp_private in srsym^.symoptions) and
  1034. (pobjectdef(srsym^.owner^.defowner)^.owner^.symtabletype=unitsymtable) then
  1035. Message(parser_e_cant_access_private_member);
  1036. end;
  1037. case srsym^.typ of
  1038. absolutesym :
  1039. begin
  1040. p1:=genloadnode(pvarsym(srsym),srsymtable);
  1041. pd:=pabsolutesym(srsym)^.vartype.def;
  1042. end;
  1043. varsym :
  1044. begin
  1045. { are we in a class method ? }
  1046. if (srsym^.owner^.symtabletype=objectsymtable) and
  1047. assigned(aktprocsym) and
  1048. (po_classmethod in aktprocsym^.definition^.procoptions) then
  1049. Message(parser_e_only_class_methods);
  1050. if (sp_static in srsym^.symoptions) then
  1051. begin
  1052. static_name:=lower(srsym^.owner^.name^)+'_'+srsym^.name;
  1053. searchsym(static_name,srsym,srsymtable);
  1054. end;
  1055. p1:=genloadnode(pvarsym(srsym),srsymtable);
  1056. if pvarsym(srsym)^.varstate=vs_declared then
  1057. begin
  1058. include(p1.flags,nf_first);
  1059. { set special between first loaded until checked in firstpass }
  1060. pvarsym(srsym)^.varstate:=vs_declared_and_first_found;
  1061. end;
  1062. pd:=pvarsym(srsym)^.vartype.def;
  1063. end;
  1064. typedconstsym :
  1065. begin
  1066. p1:=gentypedconstloadnode(ptypedconstsym(srsym),srsymtable);
  1067. pd:=ptypedconstsym(srsym)^.typedconsttype.def;
  1068. end;
  1069. syssym :
  1070. p1:=statement_syssym(psyssym(srsym)^.number,pd);
  1071. typesym :
  1072. begin
  1073. pd:=ptypesym(srsym)^.restype.def;
  1074. if not assigned(pd) then
  1075. begin
  1076. pd:=generrordef;
  1077. again:=false;
  1078. end
  1079. else
  1080. begin
  1081. { if we read a type declaration }
  1082. { we have to return the type and }
  1083. { nothing else }
  1084. if block_type=bt_type then
  1085. begin
  1086. { we don't need sym reference when it's in the
  1087. current unit or system unit, because those
  1088. units are always loaded (PFV) }
  1089. if not(assigned(pd^.owner)) or
  1090. (pd^.owner^.unitid=0) or
  1091. (pd^.owner^.unitid=1) then
  1092. p1:=gentypenode(pd,nil)
  1093. else
  1094. p1:=gentypenode(pd,ptypesym(srsym));
  1095. { here we can also set resulttype !! }
  1096. p1.resulttype:=pd;
  1097. pd:=voiddef;
  1098. end
  1099. else { not type block }
  1100. begin
  1101. if token=_LKLAMMER then
  1102. begin
  1103. consume(_LKLAMMER);
  1104. p1:=comp_expr(true);
  1105. consume(_RKLAMMER);
  1106. p1:=gentypeconvnode(p1,pd);
  1107. include(p1.flags,nf_explizit);
  1108. end
  1109. else { not LKLAMMER }
  1110. if (token=_POINT) and
  1111. is_object(pd) then
  1112. begin
  1113. consume(_POINT);
  1114. if assigned(procinfo) and
  1115. assigned(procinfo^._class) and
  1116. not(getaddr) then
  1117. begin
  1118. if procinfo^._class^.is_related(pobjectdef(pd)) then
  1119. begin
  1120. p1:=gentypenode(pd,ptypesym(srsym));
  1121. p1.resulttype:=pd;
  1122. { search also in inherited methods }
  1123. repeat
  1124. sym:=pvarsym(pobjectdef(pd)^.symtable^.search(pattern));
  1125. if assigned(sym) then
  1126. break;
  1127. pd:=pobjectdef(pd)^.childof;
  1128. until not assigned(pd);
  1129. consume(_ID);
  1130. do_member_read(false,sym,p1,pd,again);
  1131. end
  1132. else
  1133. begin
  1134. Message(parser_e_no_super_class);
  1135. pd:=generrordef;
  1136. again:=false;
  1137. end;
  1138. end
  1139. else
  1140. begin
  1141. { allows @TObject.Load }
  1142. { also allows static methods and variables }
  1143. p1:=ctypenode.create(nil,nil);
  1144. p1.resulttype:=pd;
  1145. { TP allows also @TMenu.Load if Load is only }
  1146. { defined in an anchestor class }
  1147. sym:=pvarsym(search_class_member(pobjectdef(pd),pattern));
  1148. if not assigned(sym) then
  1149. Message1(sym_e_id_no_member,pattern)
  1150. else if not(getaddr) and not(sp_static in sym^.symoptions) then
  1151. Message(sym_e_only_static_in_static)
  1152. else
  1153. begin
  1154. consume(_ID);
  1155. do_member_read(getaddr,sym,p1,pd,again);
  1156. end;
  1157. end;
  1158. end
  1159. else
  1160. begin
  1161. { class reference ? }
  1162. if is_class(pd) then
  1163. begin
  1164. if getaddr and (token=_POINT) then
  1165. begin
  1166. consume(_POINT);
  1167. { allows @Object.Method }
  1168. { also allows static methods and variables }
  1169. p1:=gentypenode(nil,nil);
  1170. p1.resulttype:=pd;
  1171. { TP allows also @TMenu.Load if Load is only }
  1172. { defined in an anchestor class }
  1173. sym:=pvarsym(search_class_member(pobjectdef(pd),pattern));
  1174. if not assigned(sym) then
  1175. Message1(sym_e_id_no_member,pattern)
  1176. else
  1177. begin
  1178. consume(_ID);
  1179. do_member_read(getaddr,sym,p1,pd,again);
  1180. end;
  1181. end
  1182. else
  1183. begin
  1184. p1:=gentypenode(pd,nil);
  1185. p1.resulttype:=pd;
  1186. pd:=new(pclassrefdef,init(pd));
  1187. p1:=cloadvmtnode.create(p1);
  1188. p1.resulttype:=pd;
  1189. end;
  1190. end
  1191. else
  1192. begin
  1193. { generate a type node }
  1194. { (for typeof etc) }
  1195. if allow_type then
  1196. begin
  1197. p1:=gentypenode(pd,nil);
  1198. { here we must use typenodetype explicitly !! PM
  1199. p1.resulttype:=pd; }
  1200. pd:=voiddef;
  1201. end
  1202. else
  1203. Message(parser_e_no_type_not_allowed_here);
  1204. end;
  1205. end;
  1206. end;
  1207. end;
  1208. end;
  1209. enumsym :
  1210. begin
  1211. p1:=genenumnode(penumsym(srsym));
  1212. pd:=p1.resulttype;
  1213. end;
  1214. constsym :
  1215. begin
  1216. case pconstsym(srsym)^.consttyp of
  1217. constint :
  1218. begin
  1219. { do a very dirty trick to bootstrap this code }
  1220. if (pconstsym(srsym)^.value>=-(int64(2147483647)+int64(1))) and (pconstsym(srsym)^.value<=2147483647) then
  1221. p1:=genordinalconstnode(pconstsym(srsym)^.value,s32bitdef)
  1222. else if (pconstsym(srsym)^.value > maxlongint) and (pconstsym(srsym)^.value <= int64(maxlongint)+int64(maxlongint)+1) then
  1223. p1:=genordinalconstnode(pconstsym(srsym)^.value,u32bitdef)
  1224. else
  1225. p1:=genordinalconstnode(pconstsym(srsym)^.value,cs64bitdef);
  1226. end;
  1227. conststring :
  1228. begin
  1229. len:=pconstsym(srsym)^.len;
  1230. if not(cs_ansistrings in aktlocalswitches) and (len>255) then
  1231. len:=255;
  1232. getmem(pc,len+1);
  1233. move(pchar(tpointerord(pconstsym(srsym)^.value))^,pc^,len);
  1234. pc[len]:=#0;
  1235. p1:=genpcharconstnode(pc,len);
  1236. end;
  1237. constchar :
  1238. p1:=genordinalconstnode(pconstsym(srsym)^.value,cchardef);
  1239. constreal :
  1240. p1:=genrealconstnode(pbestreal(tpointerord(pconstsym(srsym)^.value))^,bestrealdef^);
  1241. constbool :
  1242. p1:=genordinalconstnode(pconstsym(srsym)^.value,booldef);
  1243. constset :
  1244. p1:=gensetconstnode(pconstset(tpointerord(pconstsym(srsym)^.value)),
  1245. psetdef(pconstsym(srsym)^.consttype.def));
  1246. constord :
  1247. p1:=genordinalconstnode(pconstsym(srsym)^.value,pconstsym(srsym)^.consttype.def);
  1248. constpointer :
  1249. p1:=genpointerconstnode(pconstsym(srsym)^.value,pconstsym(srsym)^.consttype.def);
  1250. constnil :
  1251. p1:=cnilnode.create;
  1252. constresourcestring:
  1253. begin
  1254. p1:=genloadnode(pvarsym(srsym),srsymtable);
  1255. p1.resulttype:=cansistringdef;
  1256. end;
  1257. end;
  1258. pd:=p1.resulttype;
  1259. end;
  1260. procsym :
  1261. begin
  1262. { are we in a class method ? }
  1263. possible_error:=(srsym^.owner^.symtabletype=objectsymtable) and
  1264. assigned(aktprocsym) and
  1265. (po_classmethod in aktprocsym^.definition^.procoptions);
  1266. p1:=gencallnode(pprocsym(srsym),srsymtable);
  1267. do_proc_call(getaddr or
  1268. (getprocvar and
  1269. ((block_type=bt_const) or
  1270. ((m_tp_procvar in aktmodeswitches) and
  1271. proc_to_procvar_equal(pprocsym(srsym)^.definition,getprocvardef)
  1272. )
  1273. )
  1274. ),again,tcallnode(p1),pd);
  1275. if (block_type=bt_const) and
  1276. getprocvar then
  1277. handle_procvar(getprocvardef,p1);
  1278. if possible_error and
  1279. not(po_classmethod in tcallnode(p1).procdefinition^.procoptions) then
  1280. Message(parser_e_only_class_methods);
  1281. end;
  1282. propertysym :
  1283. begin
  1284. { access to property in a method }
  1285. { are we in a class method ? }
  1286. if (srsym^.owner^.symtabletype=objectsymtable) and
  1287. assigned(aktprocsym) and
  1288. (po_classmethod in aktprocsym^.definition^.procoptions) then
  1289. Message(parser_e_only_class_methods);
  1290. { no method pointer }
  1291. p1:=nil;
  1292. handle_propertysym(srsym,srsymtable,p1,pd);
  1293. end;
  1294. labelsym :
  1295. begin
  1296. consume(_COLON);
  1297. if plabelsym(srsym)^.defined then
  1298. Message(sym_e_label_already_defined);
  1299. plabelsym(srsym)^.defined:=true;
  1300. p1:=clabelnode.create(plabelsym(srsym)^.lab,nil);
  1301. pd:=voiddef;
  1302. end;
  1303. errorsym :
  1304. begin
  1305. p1:=cerrornode.create;
  1306. p1.resulttype:=generrordef;
  1307. pd:=generrordef;
  1308. if token=_LKLAMMER then
  1309. begin
  1310. consume(_LKLAMMER);
  1311. parse_paras(false,false);
  1312. consume(_RKLAMMER);
  1313. end;
  1314. end;
  1315. else
  1316. begin
  1317. p1:=cerrornode.create;
  1318. pd:=generrordef;
  1319. Message(cg_e_illegal_expression);
  1320. end;
  1321. end; { end case }
  1322. end;
  1323. end;
  1324. {---------------------------------------------
  1325. Factor_Read_Set
  1326. ---------------------------------------------}
  1327. { Read a set between [] }
  1328. function factor_read_set:tnode;
  1329. var
  1330. p1 : tnode;
  1331. lastp,
  1332. buildp : tarrayconstructornode;
  1333. begin
  1334. buildp:=nil;
  1335. { be sure that a least one arrayconstructn is used, also for an
  1336. empty [] }
  1337. if token=_RECKKLAMMER then
  1338. buildp:=carrayconstructornode.create(nil,buildp)
  1339. else
  1340. begin
  1341. while true do
  1342. begin
  1343. p1:=comp_expr(true);
  1344. if token=_POINTPOINT then
  1345. begin
  1346. consume(_POINTPOINT);
  1347. p2:=comp_expr(true);
  1348. p1:=carrayconstructorrangenode.create(p1,p2);
  1349. end;
  1350. { insert at the end of the tree, to get the correct order }
  1351. if not assigned(buildp) then
  1352. begin
  1353. buildp:=carrayconstructornode.create(p1,nil);
  1354. lastp:=buildp;
  1355. end
  1356. else
  1357. begin
  1358. lastp.right:=carrayconstructornode.create(p1,nil);
  1359. lastp:=tarrayconstructornode(lastp.right);
  1360. end;
  1361. { there could be more elements }
  1362. if token=_COMMA then
  1363. consume(_COMMA)
  1364. else
  1365. break;
  1366. end;
  1367. end;
  1368. factor_read_set:=buildp;
  1369. end;
  1370. {---------------------------------------------
  1371. Helpers
  1372. ---------------------------------------------}
  1373. procedure check_tokenpos;
  1374. begin
  1375. if (p1<>oldp1) then
  1376. begin
  1377. if assigned(p1) then
  1378. p1.set_tree_filepos(filepos);
  1379. oldp1:=p1;
  1380. filepos:=akttokenpos;
  1381. end;
  1382. end;
  1383. {---------------------------------------------
  1384. PostFixOperators
  1385. ---------------------------------------------}
  1386. procedure postfixoperators;
  1387. { tries to avoid syntax errors after invalid qualifiers }
  1388. procedure recoverconsume_postfixops;
  1389. begin
  1390. while true do
  1391. begin
  1392. case token of
  1393. _CARET:
  1394. consume(_CARET);
  1395. _POINT:
  1396. begin
  1397. consume(_POINT);
  1398. if token=_ID then
  1399. consume(_ID);
  1400. end;
  1401. _LECKKLAMMER:
  1402. begin
  1403. consume(_LECKKLAMMER);
  1404. repeat
  1405. comp_expr(true);
  1406. if token=_COMMA then
  1407. consume(_COMMA)
  1408. else
  1409. break;
  1410. until false;
  1411. consume(_RECKKLAMMER);
  1412. end
  1413. else
  1414. break;
  1415. end;
  1416. end;
  1417. end;
  1418. var
  1419. store_static : boolean;
  1420. { p1 and p2 must contain valid value_str }
  1421. begin
  1422. check_tokenpos;
  1423. while again do
  1424. begin
  1425. { prevent crashes with unknown types }
  1426. if not assigned(pd) then
  1427. begin
  1428. recoverconsume_postfixops;
  1429. exit;
  1430. end;
  1431. { handle token }
  1432. case token of
  1433. _CARET:
  1434. begin
  1435. consume(_CARET);
  1436. if (pd^.deftype<>pointerdef) then
  1437. begin
  1438. { ^ as binary operator is a problem!!!! (FK) }
  1439. again:=false;
  1440. Message(cg_e_invalid_qualifier);
  1441. recoverconsume_postfixops;
  1442. p1.destroy;
  1443. p1:=cerrornode.create;
  1444. end
  1445. else
  1446. begin
  1447. p1:=cderefnode.create(p1);
  1448. pd:=ppointerdef(pd)^.pointertype.def;
  1449. end;
  1450. end;
  1451. _LECKKLAMMER:
  1452. begin
  1453. if is_class_or_interface(pd) then
  1454. begin
  1455. { default property }
  1456. propsym:=search_default_property(pobjectdef(pd));
  1457. if not(assigned(propsym)) then
  1458. begin
  1459. p1.destroy;
  1460. p1:=cerrornode.create;
  1461. again:=false;
  1462. message(parser_e_no_default_property_available);
  1463. end
  1464. else
  1465. handle_propertysym(propsym,propsym^.owner,p1,pd);
  1466. end
  1467. else
  1468. begin
  1469. consume(_LECKKLAMMER);
  1470. repeat
  1471. case pd^.deftype of
  1472. pointerdef:
  1473. begin
  1474. pd:=ppointerdef(pd)^.pointertype.def;
  1475. { support delphi autoderef }
  1476. if (pd^.deftype=arraydef) and
  1477. (m_autoderef in aktmodeswitches) then
  1478. begin
  1479. p1:=cderefnode.create(p1);
  1480. pd:=parraydef(pd)^.elementtype.def;
  1481. end;
  1482. p2:=comp_expr(true);
  1483. p1:=cvecnode.create(p1,p2);
  1484. end;
  1485. stringdef : begin
  1486. p2:=comp_expr(true);
  1487. p1:=cvecnode.create(p1,p2);
  1488. pd:=cchardef
  1489. end;
  1490. arraydef : begin
  1491. p2:=comp_expr(true);
  1492. { support SEG:OFS for go32v2 Mem[] }
  1493. if (target_info.target=target_i386_go32v2) and
  1494. (p1.nodetype=loadn) and
  1495. assigned(tloadnode(p1).symtableentry) and
  1496. assigned(tloadnode(p1).symtableentry^.owner^.name) and
  1497. (tloadnode(p1).symtableentry^.owner^.name^='SYSTEM') and
  1498. ((tloadnode(p1).symtableentry^.name='MEM') or
  1499. (tloadnode(p1).symtableentry^.name='MEMW') or
  1500. (tloadnode(p1).symtableentry^.name='MEML')) then
  1501. begin
  1502. if (token=_COLON) then
  1503. begin
  1504. consume(_COLON);
  1505. p3:=caddnode.create(muln,genordinalconstnode($10,s32bitdef),p2);
  1506. p2:=comp_expr(true);
  1507. p2:=caddnode.create(addn,p2,p3);
  1508. p1:=cvecnode.create(p1,p2);
  1509. include(tvecnode(p1).flags,nf_memseg);
  1510. include(tvecnode(p1).flags,nf_memindex);
  1511. end
  1512. else
  1513. begin
  1514. p1:=cvecnode.create(p1,p2);
  1515. include(tvecnode(p1).flags,nf_memindex);
  1516. end;
  1517. end
  1518. else
  1519. p1:=cvecnode.create(p1,p2);
  1520. pd:=parraydef(pd)^.elementtype.def;
  1521. end;
  1522. else
  1523. begin
  1524. Message(cg_e_invalid_qualifier);
  1525. p1.destroy;
  1526. p1:=cerrornode.create;
  1527. comp_expr(true);
  1528. again:=false;
  1529. end;
  1530. end;
  1531. if token=_COMMA then
  1532. consume(_COMMA)
  1533. else
  1534. break;
  1535. until false;
  1536. consume(_RECKKLAMMER);
  1537. end;
  1538. end;
  1539. _POINT : begin
  1540. consume(_POINT);
  1541. if (pd^.deftype=pointerdef) and
  1542. (m_autoderef in aktmodeswitches) then
  1543. begin
  1544. p1:=cderefnode.create(p1);
  1545. pd:=ppointerdef(pd)^.pointertype.def;
  1546. end;
  1547. case pd^.deftype of
  1548. recorddef:
  1549. begin
  1550. sym:=psym(precorddef(pd)^.symtable^.search(pattern));
  1551. if assigned(sym) and
  1552. (sym^.typ=varsym) then
  1553. begin
  1554. p1:=gensubscriptnode(pvarsym(sym),p1);
  1555. pd:=pvarsym(sym)^.vartype.def;
  1556. end
  1557. else
  1558. begin
  1559. Message1(sym_e_illegal_field,pattern);
  1560. p1.destroy;
  1561. p1:=cerrornode.create;
  1562. end;
  1563. consume(_ID);
  1564. end;
  1565. classrefdef:
  1566. begin
  1567. classh:=pobjectdef(pclassrefdef(pd)^.pointertype.def);
  1568. sym:=nil;
  1569. while assigned(classh) do
  1570. begin
  1571. sym:=psym(classh^.symtable^.search(pattern));
  1572. if assigned(sym) then
  1573. break;
  1574. classh:=classh^.childof;
  1575. end;
  1576. if sym=nil then
  1577. begin
  1578. Message1(sym_e_id_no_member,pattern);
  1579. p1.destroy;
  1580. p1:=cerrornode.create;
  1581. { try to clean up }
  1582. pd:=generrordef;
  1583. consume(_ID);
  1584. end
  1585. else
  1586. begin
  1587. consume(_ID);
  1588. do_member_read(getaddr,sym,p1,pd,again);
  1589. end;
  1590. end;
  1591. objectdef:
  1592. begin
  1593. classh:=pobjectdef(pd);
  1594. sym:=nil;
  1595. store_static:=allow_only_static;
  1596. allow_only_static:=false;
  1597. while assigned(classh) do
  1598. begin
  1599. sym:=psym(classh^.symtable^.search(pattern));
  1600. if assigned(sym) then
  1601. break;
  1602. classh:=classh^.childof;
  1603. end;
  1604. allow_only_static:=store_static;
  1605. if sym=nil then
  1606. begin
  1607. Message1(sym_e_id_no_member,pattern);
  1608. p1.destroy;
  1609. p1:=cerrornode.create;
  1610. { try to clean up }
  1611. pd:=generrordef;
  1612. consume(_ID);
  1613. end
  1614. else
  1615. begin
  1616. consume(_ID);
  1617. do_member_read(getaddr,sym,p1,pd,again);
  1618. end;
  1619. end;
  1620. pointerdef:
  1621. begin
  1622. Message(cg_e_invalid_qualifier);
  1623. if ppointerdef(pd)^.pointertype.def^.deftype in [recorddef,objectdef,classrefdef] then
  1624. Message(parser_h_maybe_deref_caret_missing);
  1625. end;
  1626. else
  1627. begin
  1628. Message(cg_e_invalid_qualifier);
  1629. p1.destroy;
  1630. p1:=cerrornode.create;
  1631. consume(_ID);
  1632. end;
  1633. end;
  1634. end;
  1635. else
  1636. begin
  1637. { is this a procedure variable ? }
  1638. if assigned(pd) then
  1639. begin
  1640. if (pd^.deftype=procvardef) then
  1641. begin
  1642. if getprocvar and is_equal(pd,getprocvardef) then
  1643. again:=false
  1644. else
  1645. if (token=_LKLAMMER) or
  1646. ((pprocvardef(pd)^.para.empty) and
  1647. (not((token in [_ASSIGNMENT,_UNEQUAL,_EQUAL]))) and
  1648. (not afterassignment) and
  1649. (not in_args)) then
  1650. begin
  1651. { do this in a strange way }
  1652. { it's not a clean solution }
  1653. p2:=p1;
  1654. p1:=gencallnode(nil,nil);
  1655. tcallnode(p1).right:=p2;
  1656. {$ifdef TEST_PROCSYMS}
  1657. p1.unit_specific:=unit_specific;
  1658. {$endif TEST_PROCSYMS}
  1659. tcallnode(p1).symtableprocentry:=pprocsym(sym);
  1660. if token=_LKLAMMER then
  1661. begin
  1662. consume(_LKLAMMER);
  1663. tcallnode(p1).left:=parse_paras(false,false);
  1664. consume(_RKLAMMER);
  1665. end;
  1666. pd:=pprocvardef(pd)^.rettype.def;
  1667. { proc():= is never possible }
  1668. if token=_ASSIGNMENT then
  1669. begin
  1670. Message(cg_e_illegal_expression);
  1671. p1:=cerrornode.create;
  1672. again:=false;
  1673. end;
  1674. p1.resulttype:=pd;
  1675. end
  1676. else
  1677. again:=false;
  1678. p1.resulttype:=pd;
  1679. end
  1680. else
  1681. again:=false;
  1682. end
  1683. else
  1684. again:=false;
  1685. end;
  1686. end;
  1687. check_tokenpos;
  1688. end; { while again }
  1689. end;
  1690. {---------------------------------------------
  1691. Factor (Main)
  1692. ---------------------------------------------}
  1693. begin
  1694. oldp1:=nil;
  1695. p1:=nil;
  1696. filepos:=akttokenpos;
  1697. if token=_ID then
  1698. begin
  1699. factor_read_id;
  1700. { handle post fix operators }
  1701. postfixoperators;
  1702. end
  1703. else
  1704. case token of
  1705. _NEW : begin
  1706. consume(_NEW);
  1707. consume(_LKLAMMER);
  1708. {allow_type:=true;}
  1709. p1:=factor(false);
  1710. {allow_type:=false;}
  1711. if p1.nodetype<>typen then
  1712. begin
  1713. Message(type_e_type_id_expected);
  1714. p1.destroy;
  1715. pd:=generrordef;
  1716. end
  1717. else
  1718. pd:=ttypenode(p1).typenodetype;
  1719. pd2:=pd;
  1720. if (pd^.deftype<>pointerdef) then
  1721. Message1(type_e_pointer_type_expected,pd^.typename)
  1722. else
  1723. if token=_RKLAMMER then
  1724. begin
  1725. if (ppointerdef(pd)^.pointertype.def^.deftype=objectdef) and
  1726. (oo_has_vmt in pobjectdef(ppointerdef(pd)^.pointertype.def)^.objectoptions) then
  1727. Message(parser_w_use_extended_syntax_for_objects);
  1728. p1:=cnewnode.create(nil);
  1729. p1.resulttype:=pd2;
  1730. consume(_RKLAMMER);
  1731. end
  1732. else
  1733. begin
  1734. p1.destroy;
  1735. p1:=chnewnode.create;
  1736. p1.resulttype:=ppointerdef(pd)^.pointertype.def;
  1737. consume(_COMMA);
  1738. afterassignment:=false;
  1739. { determines the current object defintion }
  1740. classh:=pobjectdef(ppointerdef(pd)^.pointertype.def);
  1741. if classh^.deftype<>objectdef then
  1742. Message(parser_e_pointer_to_class_expected)
  1743. else
  1744. begin
  1745. { check for an abstract class }
  1746. if (oo_has_abstract in classh^.objectoptions) then
  1747. Message(sym_e_no_instance_of_abstract_object);
  1748. { search the constructor also in the symbol tables of
  1749. the parents }
  1750. sym:=nil;
  1751. while assigned(classh) do
  1752. begin
  1753. sym:=psym(classh^.symtable^.search(pattern));
  1754. if assigned(sym) then
  1755. break;
  1756. classh:=classh^.childof;
  1757. end;
  1758. consume(_ID);
  1759. do_member_read(false,sym,p1,pd,again);
  1760. if (p1.nodetype<>calln) or
  1761. (assigned(tcallnode(p1).procdefinition) and
  1762. (tcallnode(p1).procdefinition^.proctypeoption<>potype_constructor)) then
  1763. Message(parser_e_expr_have_to_be_constructor_call);
  1764. end;
  1765. p1:=cnewnode.create(p1);
  1766. { set the resulttype }
  1767. p1.resulttype:=pd2;
  1768. consume(_RKLAMMER);
  1769. end;
  1770. postfixoperators;
  1771. end;
  1772. _SELF : begin
  1773. again:=true;
  1774. consume(_SELF);
  1775. if not assigned(procinfo^._class) then
  1776. begin
  1777. p1:=cerrornode.create;
  1778. pd:=generrordef;
  1779. again:=false;
  1780. Message(parser_e_self_not_in_method);
  1781. end
  1782. else
  1783. begin
  1784. if (po_classmethod in aktprocsym^.definition^.procoptions) then
  1785. begin
  1786. { self in class methods is a class reference type }
  1787. pd:=new(pclassrefdef,init(procinfo^._class));
  1788. p1:=genselfnode(pd);
  1789. p1.resulttype:=pd;
  1790. end
  1791. else
  1792. begin
  1793. p1:=genselfnode(procinfo^._class);
  1794. p1.resulttype:=procinfo^._class;
  1795. end;
  1796. pd:=p1.resulttype;
  1797. postfixoperators;
  1798. end;
  1799. end;
  1800. _INHERITED : begin
  1801. again:=true;
  1802. consume(_INHERITED);
  1803. if assigned(procinfo^._class) then
  1804. begin
  1805. { if inherited; only then we need the method with
  1806. the same name }
  1807. if token=_SEMICOLON then
  1808. begin
  1809. hs:=aktprocsym^.name;
  1810. auto_inherited:=true
  1811. end
  1812. else
  1813. begin
  1814. hs:=pattern;
  1815. consume(_ID);
  1816. auto_inherited:=false;
  1817. end;
  1818. classh:=procinfo^._class^.childof;
  1819. while assigned(classh) do
  1820. begin
  1821. sym:=psym(pobjectdef(classh)^.symtable^.search(hs));
  1822. if assigned(sym) then
  1823. begin
  1824. { only for procsyms we need to set the type (PFV) }
  1825. case sym^.typ of
  1826. procsym :
  1827. begin
  1828. p1:=ctypenode.create(nil,nil);
  1829. p1.resulttype:=classh;
  1830. pd:=p1.resulttype;
  1831. end;
  1832. varsym :
  1833. begin
  1834. p1:=nil;
  1835. pd:=pvarsym(sym)^.vartype.def;
  1836. end;
  1837. propertysym :
  1838. begin
  1839. p1:=nil;
  1840. pd:=ppropertysym(sym)^.proptype.def;
  1841. end;
  1842. else
  1843. internalerror(83251763);
  1844. end;
  1845. do_member_read(false,sym,p1,pd,again);
  1846. break;
  1847. end;
  1848. classh:=classh^.childof;
  1849. end;
  1850. if classh=nil then
  1851. begin
  1852. Message1(sym_e_id_no_member,hs);
  1853. again:=false;
  1854. pd:=generrordef;
  1855. p1:=cerrornode.create;
  1856. end;
  1857. { turn auto inheriting off }
  1858. auto_inherited:=false;
  1859. end
  1860. else
  1861. begin
  1862. Message(parser_e_generic_methods_only_in_methods);
  1863. again:=false;
  1864. pd:=generrordef;
  1865. p1:=cerrornode.create;
  1866. end;
  1867. postfixoperators;
  1868. end;
  1869. _INTCONST : begin
  1870. { try cardinal first }
  1871. val(pattern,card,code);
  1872. if code<>0 then
  1873. begin
  1874. { then longint }
  1875. valint(pattern,l,code);
  1876. if code <> 0 then
  1877. begin
  1878. { then int64 }
  1879. val(pattern,ic,code);
  1880. if code<>0 then
  1881. begin
  1882. {finally float }
  1883. val(pattern,d,code);
  1884. if code<>0 then
  1885. begin
  1886. Message(cg_e_invalid_integer);
  1887. consume(_INTCONST);
  1888. l:=1;
  1889. p1:=genordinalconstnode(l,s32bitdef);
  1890. end
  1891. else
  1892. begin
  1893. consume(_INTCONST);
  1894. p1:=genrealconstnode(d,bestrealdef^);
  1895. end;
  1896. end
  1897. else
  1898. begin
  1899. consume(_INTCONST);
  1900. p1:=genordinalconstnode(ic,cs64bitdef);
  1901. end
  1902. end
  1903. else
  1904. begin
  1905. consume(_INTCONST);
  1906. p1:=genordinalconstnode(l,s32bitdef)
  1907. end
  1908. end
  1909. else
  1910. begin
  1911. consume(_INTCONST);
  1912. { check whether the value isn't in the longint range as well }
  1913. { (longint is easier to perform calculations with) (JM) }
  1914. if card <= $7fffffff then
  1915. { no sign extension necessary, so not longint typecast (JM) }
  1916. p1:=genordinalconstnode(card,s32bitdef)
  1917. else
  1918. p1:=genordinalconstnode(card,u32bitdef)
  1919. end;
  1920. end;
  1921. _REALNUMBER : begin
  1922. val(pattern,d,code);
  1923. if code<>0 then
  1924. begin
  1925. Message(parser_e_error_in_real);
  1926. d:=1.0;
  1927. end;
  1928. consume(_REALNUMBER);
  1929. p1:=genrealconstnode(d,bestrealdef^);
  1930. end;
  1931. _STRING : begin
  1932. pd:=string_dec;
  1933. { STRING can be also a type cast }
  1934. if token=_LKLAMMER then
  1935. begin
  1936. consume(_LKLAMMER);
  1937. p1:=comp_expr(true);
  1938. consume(_RKLAMMER);
  1939. p1:=gentypeconvnode(p1,pd);
  1940. include(p1.flags,nf_explizit);
  1941. { handle postfix operators here e.g. string(a)[10] }
  1942. again:=true;
  1943. postfixoperators;
  1944. end
  1945. else
  1946. p1:=gentypenode(pd,nil);
  1947. end;
  1948. _FILE : begin
  1949. pd:=cfiledef;
  1950. consume(_FILE);
  1951. { FILE can be also a type cast }
  1952. if token=_LKLAMMER then
  1953. begin
  1954. consume(_LKLAMMER);
  1955. p1:=comp_expr(true);
  1956. consume(_RKLAMMER);
  1957. p1:=gentypeconvnode(p1,pd);
  1958. include(p1.flags,nf_explizit);
  1959. { handle postfix operators here e.g. string(a)[10] }
  1960. again:=true;
  1961. postfixoperators;
  1962. end
  1963. else
  1964. p1:=gentypenode(pd,nil);
  1965. end;
  1966. _CSTRING : begin
  1967. p1:=genstringconstnode(pattern,st_default);
  1968. consume(_CSTRING);
  1969. end;
  1970. _CCHAR : begin
  1971. p1:=genordinalconstnode(ord(pattern[1]),cchardef);
  1972. consume(_CCHAR);
  1973. end;
  1974. _CWSTRING:
  1975. begin
  1976. p1:=genwstringconstnode(patternw);
  1977. consume(_CWSTRING);
  1978. end;
  1979. _CWCHAR:
  1980. begin
  1981. p1:=genordinalconstnode(ord(getcharwidestring(patternw,0)),cwidechardef);
  1982. consume(_CWCHAR);
  1983. end;
  1984. _KLAMMERAFFE : begin
  1985. consume(_KLAMMERAFFE);
  1986. got_addrn:=true;
  1987. { support both @<x> and @(<x>) }
  1988. if token=_LKLAMMER then
  1989. begin
  1990. consume(_LKLAMMER);
  1991. p1:=factor(true);
  1992. consume(_RKLAMMER);
  1993. if token in [_CARET,_POINT,_LECKKLAMMER] then
  1994. begin
  1995. { we need the resulttype }
  1996. { of the expression in pd }
  1997. do_firstpass(p1);
  1998. pd:=p1.resulttype;
  1999. again:=true;
  2000. postfixoperators;
  2001. end;
  2002. end
  2003. else
  2004. p1:=factor(true);
  2005. got_addrn:=false;
  2006. p1:=caddrnode.create(p1);
  2007. end;
  2008. _LKLAMMER : begin
  2009. consume(_LKLAMMER);
  2010. p1:=comp_expr(true);
  2011. consume(_RKLAMMER);
  2012. { it's not a good solution }
  2013. { but (a+b)^ makes some problems }
  2014. if token in [_CARET,_POINT,_LECKKLAMMER] then
  2015. begin
  2016. { we need the resulttype }
  2017. { of the expression in pd }
  2018. do_firstpass(p1);
  2019. pd:=p1.resulttype;
  2020. again:=true;
  2021. postfixoperators;
  2022. end;
  2023. end;
  2024. _LECKKLAMMER : begin
  2025. consume(_LECKKLAMMER);
  2026. p1:=factor_read_set;
  2027. consume(_RECKKLAMMER);
  2028. end;
  2029. _PLUS : begin
  2030. consume(_PLUS);
  2031. p1:=factor(false);
  2032. end;
  2033. _MINUS : begin
  2034. consume(_MINUS);
  2035. p1:=sub_expr(oppower,false);
  2036. p1:=cunaryminusnode.create(p1);
  2037. end;
  2038. _OP_NOT : begin
  2039. consume(_OP_NOT);
  2040. p1:=factor(false);
  2041. p1:=cnotnode.create(p1);
  2042. end;
  2043. _TRUE : begin
  2044. consume(_TRUE);
  2045. p1:=genordinalconstnode(1,booldef);
  2046. end;
  2047. _FALSE : begin
  2048. consume(_FALSE);
  2049. p1:=genordinalconstnode(0,booldef);
  2050. end;
  2051. _NIL : begin
  2052. consume(_NIL);
  2053. p1:=cnilnode.create;
  2054. end;
  2055. else
  2056. begin
  2057. p1:=cerrornode.create;
  2058. consume(token);
  2059. Message(cg_e_illegal_expression);
  2060. end;
  2061. end;
  2062. { generate error node if no node is created }
  2063. if not assigned(p1) then
  2064. p1:=cerrornode.create;
  2065. { tp7 procvar handling, but not if the next token
  2066. will be a := }
  2067. if (m_tp_procvar in aktmodeswitches) and
  2068. (token<>_ASSIGNMENT) then
  2069. check_tp_procvar(p1);
  2070. factor:=p1;
  2071. check_tokenpos;
  2072. end;
  2073. {$ifdef fpc}
  2074. {$maxfpuregisters default}
  2075. {$endif fpc}
  2076. {****************************************************************************
  2077. Sub_Expr
  2078. ****************************************************************************}
  2079. const
  2080. { Warning these stay be ordered !! }
  2081. operator_levels:array[Toperator_precedence] of set of Ttoken=
  2082. ([_LT,_LTE,_GT,_GTE,_EQUAL,_UNEQUAL,_OP_IN,_OP_IS],
  2083. [_PLUS,_MINUS,_OP_OR,_OP_XOR],
  2084. [_CARET,_SYMDIF,_STARSTAR,_STAR,_SLASH,
  2085. _OP_AS,_OP_AND,_OP_DIV,_OP_MOD,_OP_SHL,_OP_SHR],
  2086. [_STARSTAR] );
  2087. function sub_expr(pred_level:Toperator_precedence;accept_equal : boolean):tnode;
  2088. {Reads a subexpression while the operators are of the current precedence
  2089. level, or any higher level. Replaces the old term, simpl_expr and
  2090. simpl2_expr.}
  2091. var
  2092. p1,p2 : tnode;
  2093. oldt : Ttoken;
  2094. filepos : tfileposinfo;
  2095. begin
  2096. if pred_level=highest_precedence then
  2097. p1:=factor(false)
  2098. else
  2099. p1:=sub_expr(succ(pred_level),true);
  2100. repeat
  2101. if (token in operator_levels[pred_level]) and
  2102. ((token<>_EQUAL) or accept_equal) then
  2103. begin
  2104. oldt:=token;
  2105. filepos:=akttokenpos;
  2106. consume(token);
  2107. if pred_level=highest_precedence then
  2108. p2:=factor(false)
  2109. else
  2110. p2:=sub_expr(succ(pred_level),true);
  2111. case oldt of
  2112. _PLUS :
  2113. p1:=caddnode.create(addn,p1,p2);
  2114. _MINUS :
  2115. p1:=caddnode.create(subn,p1,p2);
  2116. _STAR :
  2117. p1:=caddnode.create(muln,p1,p2);
  2118. _SLASH :
  2119. p1:=caddnode.create(slashn,p1,p2);
  2120. _EQUAL :
  2121. p1:=caddnode.create(equaln,p1,p2);
  2122. _GT :
  2123. p1:=caddnode.create(gtn,p1,p2);
  2124. _LT :
  2125. p1:=caddnode.create(ltn,p1,p2);
  2126. _GTE :
  2127. p1:=caddnode.create(gten,p1,p2);
  2128. _LTE :
  2129. p1:=caddnode.create(lten,p1,p2);
  2130. _SYMDIF :
  2131. p1:=caddnode.create(symdifn,p1,p2);
  2132. _STARSTAR :
  2133. p1:=caddnode.create(starstarn,p1,p2);
  2134. _OP_AS :
  2135. p1:=casnode.create(p1,p2);
  2136. _OP_IN :
  2137. p1:=cinnode.create(p1,p2);
  2138. _OP_IS :
  2139. p1:=cisnode.create(p1,p2);
  2140. _OP_OR :
  2141. p1:=caddnode.create(orn,p1,p2);
  2142. _OP_AND :
  2143. p1:=caddnode.create(andn,p1,p2);
  2144. _OP_DIV :
  2145. p1:=cmoddivnode.create(divn,p1,p2);
  2146. _OP_NOT :
  2147. p1:=cnotnode.create(p1);
  2148. _OP_MOD :
  2149. p1:=cmoddivnode.create(modn,p1,p2);
  2150. _OP_SHL :
  2151. p1:=cshlshrnode.create(shln,p1,p2);
  2152. _OP_SHR :
  2153. p1:=cshlshrnode.create(shrn,p1,p2);
  2154. _OP_XOR :
  2155. p1:=caddnode.create(xorn,p1,p2);
  2156. _ASSIGNMENT :
  2157. p1:=cassignmentnode.create(p1,p2);
  2158. _CARET :
  2159. p1:=caddnode.create(caretn,p1,p2);
  2160. _UNEQUAL :
  2161. p1:=caddnode.create(unequaln,p1,p2);
  2162. end;
  2163. p1.set_tree_filepos(filepos);
  2164. end
  2165. else
  2166. break;
  2167. until false;
  2168. sub_expr:=p1;
  2169. end;
  2170. function comp_expr(accept_equal : boolean):tnode;
  2171. var
  2172. oldafterassignment : boolean;
  2173. p1 : tnode;
  2174. begin
  2175. oldafterassignment:=afterassignment;
  2176. afterassignment:=true;
  2177. p1:=sub_expr(opcompare,accept_equal);
  2178. afterassignment:=oldafterassignment;
  2179. comp_expr:=p1;
  2180. end;
  2181. function expr : tnode;
  2182. var
  2183. p1,p2 : tnode;
  2184. oldafterassignment : boolean;
  2185. oldp1 : tnode;
  2186. filepos : tfileposinfo;
  2187. begin
  2188. oldafterassignment:=afterassignment;
  2189. p1:=sub_expr(opcompare,true);
  2190. filepos:=akttokenpos;
  2191. if (m_tp_procvar in aktmodeswitches) and
  2192. (token<>_ASSIGNMENT) then
  2193. check_tp_procvar(p1);
  2194. if token in [_ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
  2195. afterassignment:=true;
  2196. oldp1:=p1;
  2197. case token of
  2198. _POINTPOINT :
  2199. begin
  2200. consume(_POINTPOINT);
  2201. p2:=sub_expr(opcompare,true);
  2202. p1:=crangenode.create(p1,p2);
  2203. end;
  2204. _ASSIGNMENT :
  2205. begin
  2206. consume(_ASSIGNMENT);
  2207. if (p1.resulttype<>nil) and (p1.resulttype^.deftype=procvardef) then
  2208. begin
  2209. getprocvar:=true;
  2210. getprocvardef:=pprocvardef(p1.resulttype);
  2211. end;
  2212. p2:=sub_expr(opcompare,true);
  2213. if getprocvar then
  2214. handle_procvar(getprocvardef,p2);
  2215. getprocvar:=false;
  2216. p1:=cassignmentnode.create(p1,p2);
  2217. end;
  2218. _PLUSASN :
  2219. begin
  2220. consume(_PLUSASN);
  2221. p2:=sub_expr(opcompare,true);
  2222. p1:=cassignmentnode.create(p1,caddnode.create(addn,p1.getcopy,p2));
  2223. end;
  2224. _MINUSASN :
  2225. begin
  2226. consume(_MINUSASN);
  2227. p2:=sub_expr(opcompare,true);
  2228. p1:=cassignmentnode.create(p1,caddnode.create(subn,p1.getcopy,p2));
  2229. end;
  2230. _STARASN :
  2231. begin
  2232. consume(_STARASN );
  2233. p2:=sub_expr(opcompare,true);
  2234. p1:=cassignmentnode.create(p1,caddnode.create(muln,p1.getcopy,p2));
  2235. end;
  2236. _SLASHASN :
  2237. begin
  2238. consume(_SLASHASN );
  2239. p2:=sub_expr(opcompare,true);
  2240. p1:=cassignmentnode.create(p1,caddnode.create(slashn,p1.getcopy,p2));
  2241. end;
  2242. end;
  2243. afterassignment:=oldafterassignment;
  2244. if p1<>oldp1 then
  2245. p1.set_tree_filepos(filepos);
  2246. expr:=p1;
  2247. end;
  2248. {$ifdef int64funcresok}
  2249. function get_intconst:TConstExprInt;
  2250. {$else int64funcresok}
  2251. function get_intconst:longint;
  2252. {$endif int64funcresok}
  2253. {Reads an expression, tries to evalute it and check if it is an integer
  2254. constant. Then the constant is returned.}
  2255. var
  2256. p:tnode;
  2257. begin
  2258. p:=comp_expr(true);
  2259. do_firstpass(p);
  2260. if not codegenerror then
  2261. begin
  2262. if (p.nodetype<>ordconstn) or
  2263. (p.resulttype^.deftype<>orddef) or
  2264. (Porddef(p.resulttype)^.typ in [uvoid,uchar,bool8bit,bool16bit,bool32bit]) then
  2265. Message(cg_e_illegal_expression)
  2266. else
  2267. get_intconst:=tordconstnode(p).value;
  2268. end;
  2269. p.free;
  2270. end;
  2271. function get_stringconst:string;
  2272. {Reads an expression, tries to evaluate it and checks if it is a string
  2273. constant. Then the constant is returned.}
  2274. var
  2275. p:tnode;
  2276. begin
  2277. get_stringconst:='';
  2278. p:=comp_expr(true);
  2279. do_firstpass(p);
  2280. if p.nodetype<>stringconstn then
  2281. begin
  2282. if (p.nodetype=ordconstn) and is_char(p.resulttype) then
  2283. get_stringconst:=char(tordconstnode(p).value)
  2284. else
  2285. Message(cg_e_illegal_expression);
  2286. end
  2287. else
  2288. get_stringconst:=strpas(tstringconstnode(p).value_str);
  2289. p.free;
  2290. end;
  2291. end.
  2292. {
  2293. $Log$
  2294. Revision 1.25 2001-03-11 22:58:50 peter
  2295. * getsym redesign, removed the globals srsym,srsymtable
  2296. Revision 1.24 2000/12/25 00:07:27 peter
  2297. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  2298. tlinkedlist objects)
  2299. Revision 1.23 2000/12/19 20:36:03 peter
  2300. * cardinal const expr fix from jonas
  2301. Revision 1.22 2000/12/17 14:00:18 peter
  2302. * fixed static variables
  2303. Revision 1.21 2000/12/15 13:26:01 jonas
  2304. * only return int64's from functions if it int64funcresok is defined
  2305. + added int64funcresok define to options.pas
  2306. Revision 1.20 2000/12/15 12:13:52 michael
  2307. + Fix from Peter
  2308. Revision 1.19 2000/12/07 17:19:42 jonas
  2309. * new constant handling: from now on, hex constants >$7fffffff are
  2310. parsed as unsigned constants (otherwise, $80000000 got sign extended
  2311. and became $ffffffff80000000), all constants in the longint range
  2312. become longints, all constants >$7fffffff and <=cardinal($ffffffff)
  2313. are cardinals and the rest are int64's.
  2314. * added lots of longint typecast to prevent range check errors in the
  2315. compiler and rtl
  2316. * type casts of symbolic ordinal constants are now preserved
  2317. * fixed bug where the original resulttype wasn't restored correctly
  2318. after doing a 64bit rangecheck
  2319. Revision 1.18 2000/11/29 00:30:36 florian
  2320. * unused units removed from uses clause
  2321. * some changes for widestrings
  2322. Revision 1.17 2000/11/09 17:46:55 florian
  2323. * System.TypeInfo fixed
  2324. + System.Finalize implemented
  2325. + some new keywords for interface support added
  2326. Revision 1.16 2000/11/06 20:30:55 peter
  2327. * more fixes to get make cycle working
  2328. Revision 1.15 2000/11/04 14:25:20 florian
  2329. + merged Attila's changes for interfaces, not tested yet
  2330. Revision 1.14 2000/10/31 22:02:49 peter
  2331. * symtable splitted, no real code changes
  2332. Revision 1.13 2000/10/26 23:40:54 peter
  2333. * fixed crash with call from type decl which is not allowed (merged)
  2334. Revision 1.12 2000/10/21 18:16:12 florian
  2335. * a lot of changes:
  2336. - basic dyn. array support
  2337. - basic C++ support
  2338. - some work for interfaces done
  2339. ....
  2340. Revision 1.11 2000/10/14 10:14:51 peter
  2341. * moehrendorf oct 2000 rewrite
  2342. Revision 1.10 2000/10/01 19:48:25 peter
  2343. * lot of compile updates for cg11
  2344. Revision 1.9 2000/09/24 21:19:50 peter
  2345. * delphi compile fixes
  2346. Revision 1.8 2000/09/24 15:06:22 peter
  2347. * use defines.inc
  2348. Revision 1.7 2000/08/27 16:11:51 peter
  2349. * moved some util functions from globals,cobjects to cutils
  2350. * splitted files into finput,fmodule
  2351. Revision 1.6 2000/08/20 15:12:49 peter
  2352. * auto derefence mode for array pointer (merged)
  2353. Revision 1.5 2000/08/16 18:33:53 peter
  2354. * splitted namedobjectitem.next into indexnext and listnext so it
  2355. can be used in both lists
  2356. * don't allow "word = word" type definitions (merged)
  2357. Revision 1.4 2000/08/16 13:06:06 florian
  2358. + support of 64 bit integer constants
  2359. Revision 1.3 2000/08/04 22:00:52 peter
  2360. * merges from fixes
  2361. Revision 1.2 2000/07/13 11:32:44 michael
  2362. + removed logs
  2363. }