pexpr.pas 74 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686
  1. {
  2. $Id$
  3. Copyright (c) 1998 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. interface
  20. uses symtable,tree;
  21. { reads a whole expression }
  22. function expr : ptree;
  23. { reads a single factor }
  24. function factor(getaddr : boolean) : ptree;
  25. { the ID token has to be consumed before calling this function }
  26. procedure do_member_read(const sym : psym;var p1 : ptree;
  27. var pd : pdef;var again : boolean);
  28. function get_intconst:longint;
  29. function get_stringconst:string;
  30. implementation
  31. uses
  32. cobjects,globals,scanner,aasm,pass_1,systems,
  33. hcodegen,types,verbose
  34. { parser specific stuff }
  35. ,pbase,pdecl
  36. { processor specific stuff }
  37. {$ifdef i386}
  38. ,i386
  39. {$endif}
  40. {$ifdef m68k}
  41. ,m68k
  42. {$endif}
  43. ;
  44. function parse_paras(_colon,in_prop_paras : boolean) : ptree;
  45. var
  46. p1,p2 : ptree;
  47. end_of_paras : ttoken;
  48. begin
  49. if in_prop_paras then
  50. end_of_paras:=RECKKLAMMER
  51. else
  52. end_of_paras:=RKLAMMER;
  53. if token=end_of_paras then
  54. begin
  55. parse_paras:=nil;
  56. exit;
  57. end;
  58. p2:=nil;
  59. inc(parsing_para_level);
  60. while true do
  61. begin
  62. p1:=expr;
  63. p2:=gencallparanode(p1,p2);
  64. { it's for the str(l:5,s); }
  65. if _colon and (token=COLON) then
  66. begin
  67. consume(COLON);
  68. p1:=expr;
  69. p2:=gencallparanode(p1,p2);
  70. p2^.is_colon_para:=true;
  71. if token=COLON then
  72. begin
  73. consume(COLON);
  74. p1:=expr;
  75. p2:=gencallparanode(p1,p2);
  76. p2^.is_colon_para:=true;
  77. end
  78. end;
  79. if token=COMMA then
  80. consume(COMMA)
  81. else
  82. break;
  83. end;
  84. dec(parsing_para_level);
  85. parse_paras:=p2;
  86. end;
  87. function statement_syssym(l : longint;var pd : pdef) : ptree;
  88. { const regnames:array[R_EAX..R_EDI] of string[3]=
  89. ('EAX','ECX','EDX','EBX','','','ESI','EDI'); }
  90. var
  91. p1,p2 : ptree;
  92. paras : ptree;
  93. prev_in_args : boolean;
  94. Store_valid : boolean;
  95. begin
  96. prev_in_args:=in_args;
  97. Store_valid:=Must_be_valid;
  98. case l of
  99. in_ord_x :
  100. begin
  101. consume(LKLAMMER);
  102. in_args:=true;
  103. Must_be_valid:=true;
  104. p1:=expr;
  105. consume(RKLAMMER);
  106. do_firstpass(p1);
  107. p1:=geninlinenode(in_ord_x,p1);
  108. do_firstpass(p1);
  109. statement_syssym := p1;
  110. pd:=p1^.resulttype;
  111. end;
  112. in_typeof_x : begin
  113. consume(LKLAMMER);
  114. in_args:=true;
  115. p1:=expr;
  116. consume(RKLAMMER);
  117. pd:=voidpointerdef;
  118. if p1^.treetype=typen then
  119. begin
  120. if (p1^.resulttype=nil) then
  121. begin
  122. Message(sym_e_type_mismatch);
  123. statement_syssym:=genzeronode(errorn);
  124. end
  125. else
  126. if p1^.resulttype^.deftype=objectdef then
  127. statement_syssym:=geninlinenode(in_typeof_x,p1)
  128. else
  129. begin
  130. Message(sym_e_type_mismatch);
  131. statement_syssym:=genzeronode(errorn);
  132. end;
  133. end
  134. else
  135. begin
  136. Must_be_valid:=false;
  137. do_firstpass(p1);
  138. if (p1^.resulttype=nil) then
  139. begin
  140. Message(sym_e_type_mismatch);
  141. statement_syssym:=genzeronode(errorn)
  142. end
  143. else
  144. if p1^.resulttype^.deftype=objectdef then
  145. statement_syssym:=geninlinenode(in_typeof_x,p1)
  146. else
  147. begin
  148. Message(sym_e_type_mismatch);
  149. statement_syssym:=genzeronode(errorn)
  150. end;
  151. end;
  152. end;
  153. in_sizeof_x : begin
  154. consume(LKLAMMER);
  155. in_args:=true;
  156. p1:=expr;
  157. consume(RKLAMMER);
  158. pd:=s32bitdef;
  159. if p1^.treetype=typen then
  160. begin
  161. statement_syssym:=genordinalconstnode(
  162. p1^.resulttype^.size,pd);
  163. { p1 not needed !}
  164. disposetree(p1);
  165. end
  166. else
  167. begin
  168. Must_be_valid:=false;
  169. do_firstpass(p1);
  170. if p1^.resulttype^.deftype<>objectdef then
  171. begin
  172. statement_syssym:=genordinalconstnode(
  173. p1^.resulttype^.size,pd);
  174. { p1 not needed !}
  175. disposetree(p1);
  176. end
  177. else
  178. begin
  179. statement_syssym:=geninlinenode(in_sizeof_x,p1);
  180. end;
  181. end;
  182. end;
  183. in_assigned_x : begin
  184. consume(LKLAMMER);
  185. in_args:=true;
  186. p1:=expr;
  187. Must_be_valid:=true;
  188. do_firstpass(p1);
  189. case p1^.resulttype^.deftype of
  190. pointerdef,procvardef,
  191. classrefdef:
  192. ;
  193. objectdef:
  194. if not(pobjectdef(p1^.resulttype)^.isclass) then
  195. Message(parser_e_illegal_parameter_list);
  196. else Message(parser_e_illegal_parameter_list);
  197. end;
  198. p2:=gencallparanode(p1,nil);
  199. p2:=geninlinenode(in_assigned_x,p2);
  200. consume(RKLAMMER);
  201. pd:=booldef;
  202. statement_syssym:=p2;
  203. end;
  204. in_ofs_x : begin
  205. consume(LKLAMMER);
  206. in_args:=true;
  207. p1:=expr;
  208. p1:=gensinglenode(addrn,p1);
  209. Must_be_valid:=false;
  210. do_firstpass(p1);
  211. { Ofs() returns a longint, not a pointer }
  212. p1^.resulttype:=u32bitdef;
  213. pd:=p1^.resulttype;
  214. consume(RKLAMMER);
  215. statement_syssym:=p1;
  216. end;
  217. in_seg_x : begin
  218. consume(LKLAMMER);
  219. in_args:=true;
  220. p1:=expr;
  221. do_firstpass(p1);
  222. if p1^.location.loc<>LOC_REFERENCE then
  223. Message(cg_e_illegal_expression);
  224. p1:=genordinalconstnode(0,s32bitdef);
  225. Must_be_valid:=false;
  226. pd:=s32bitdef;
  227. consume(RKLAMMER);
  228. statement_syssym:=p1;
  229. end;
  230. in_high_x,
  231. in_low_x : begin
  232. consume(LKLAMMER);
  233. in_args:=true;
  234. p1:=expr;
  235. do_firstpass(p1);
  236. Must_be_valid:=false;
  237. p2:=geninlinenode(l,p1);
  238. consume(RKLAMMER);
  239. pd:=s32bitdef;
  240. statement_syssym:=p2;
  241. end;
  242. in_succ_x,
  243. in_pred_x : begin
  244. consume(LKLAMMER);
  245. in_args:=true;
  246. p1:=expr;
  247. do_firstpass(p1);
  248. Must_be_valid:=false;
  249. p2:=geninlinenode(l,p1);
  250. consume(RKLAMMER);
  251. pd:=p1^.resulttype;
  252. statement_syssym:=p2;
  253. end;
  254. in_inc_x,
  255. in_dec_x : begin
  256. consume(LKLAMMER);
  257. in_args:=true;
  258. p1:=expr;
  259. p2:=gencallparanode(p1,nil);
  260. Must_be_valid:=false;
  261. if token=COMMA then
  262. begin
  263. consume(COMMA);
  264. p1:=expr;
  265. p2:=gencallparanode(p1,p2);
  266. end;
  267. statement_syssym:=geninlinenode(l,p2);
  268. consume(RKLAMMER);
  269. pd:=voiddef;
  270. end;
  271. in_concat_x : begin
  272. consume(LKLAMMER);
  273. in_args:=true;
  274. p2:=nil;
  275. while true do
  276. begin
  277. p1:=expr;
  278. Must_be_valid:=true;
  279. do_firstpass(p1);
  280. if not((p1^.resulttype^.deftype=stringdef) or
  281. ((p1^.resulttype^.deftype=orddef) and
  282. (porddef(p1^.resulttype)^.typ=uchar)
  283. )
  284. ) then Message(parser_e_illegal_parameter_list);
  285. if p2<>nil then
  286. p2:=gennode(addn,p2,p1)
  287. else p2:=p1;
  288. if token=COMMA then
  289. consume(COMMA)
  290. else break;
  291. end;
  292. consume(RKLAMMER);
  293. pd:=cstringdef;
  294. statement_syssym:=p2;
  295. end;
  296. in_read_x,
  297. in_readln_x : begin
  298. if token=LKLAMMER then
  299. begin
  300. consume(LKLAMMER);
  301. in_args:=true;
  302. Must_be_valid:=false;
  303. paras:=parse_paras(false,false);
  304. consume(RKLAMMER);
  305. end
  306. else
  307. paras:=nil;
  308. pd:=voiddef;
  309. p1:=geninlinenode(l,paras);
  310. do_firstpass(p1);
  311. statement_syssym := p1;
  312. end;
  313. in_write_x,
  314. in_writeln_x : begin
  315. if token=LKLAMMER then
  316. begin
  317. consume(LKLAMMER);
  318. in_args:=true;
  319. Must_be_valid:=true;
  320. paras:=parse_paras(true,false);
  321. consume(RKLAMMER);
  322. end
  323. else
  324. paras:=nil;
  325. pd:=voiddef;
  326. p1 := geninlinenode(l,paras);
  327. do_firstpass(p1);
  328. statement_syssym := p1;
  329. end;
  330. in_str_x_string : begin
  331. consume(LKLAMMER);
  332. in_args:=true;
  333. paras:=parse_paras(true,false);
  334. consume(RKLAMMER);
  335. p1 := geninlinenode(l,paras);
  336. do_firstpass(p1);
  337. statement_syssym := p1;
  338. pd:=voiddef;
  339. end;
  340. {in_val_x : begin
  341. consume(LKLAMMER);
  342. paras:=parse_paras(false);
  343. consume(RKLAMMER);
  344. p1 := geninlinenode(l,paras);
  345. do_firstpass(p1);
  346. statement_syssym := p1;
  347. pd:=voiddef;
  348. end; }
  349. else internalerror(15);
  350. end;
  351. in_args:=prev_in_args;
  352. Must_be_valid:=Store_valid;
  353. end;
  354. { reads the parameter for a subroutine call }
  355. procedure do_proc_call(getaddr : boolean;var again : boolean;var p1:Ptree;var pd:Pdef);
  356. var
  357. prev_in_args : boolean;
  358. prevafterassn : boolean;
  359. begin
  360. prev_in_args:=in_args;
  361. prevafterassn:=afterassignment;
  362. afterassignment:=false;
  363. { want we only determine the address of }
  364. { a subroutine }
  365. if not(getaddr) then
  366. begin
  367. if token=LKLAMMER then
  368. begin
  369. consume(LKLAMMER);
  370. in_args:=true;
  371. p1^.left:=parse_paras(false,false);
  372. consume(RKLAMMER);
  373. end
  374. else p1^.left:=nil;
  375. { do firstpass because we need the }
  376. { result type }
  377. do_firstpass(p1);
  378. end
  379. else
  380. begin
  381. { address operator @: }
  382. p1^.left:=nil;
  383. { forget pd }
  384. pd:=nil;
  385. { no postfix operators }
  386. again:=false;
  387. end;
  388. pd:=p1^.resulttype;
  389. in_args:=prev_in_args;
  390. afterassignment:=prevafterassn;
  391. end;
  392. { the ID token has to be consumed before calling this function }
  393. procedure do_member_read(const sym : psym;var p1 : ptree;
  394. var pd : pdef;var again : boolean);
  395. var
  396. static_name : string;
  397. paras : ptree;
  398. oldafterassignment,isclassref : boolean;
  399. p2 : ptree;
  400. begin
  401. if sym=nil then
  402. begin
  403. Message(sym_e_id_no_member);
  404. disposetree(p1);
  405. p1:=genzeronode(errorn);
  406. { try to clean up }
  407. pd:=generrordef;
  408. again:=false;
  409. end
  410. else
  411. begin
  412. isclassref:=pd^.deftype=classrefdef;
  413. { we assume, that only procsyms and varsyms are in an object }
  414. { symbol table, for classes, properties are allowed }
  415. case sym^.typ of
  416. procsym:
  417. begin
  418. p1:=genmethodcallnode(pprocsym(sym),srsymtable,p1);
  419. do_proc_call(false,again,p1,pd);
  420. { now we know the real method e.g. we can check for }
  421. { a class method }
  422. if isclassref and ((p1^.procdefinition^.options and (poclassmethod or poconstructor))=0) then
  423. Message(parser_e_only_class_methods_via_class_ref);
  424. end;
  425. varsym:
  426. begin
  427. if isclassref then
  428. Message(parser_e_only_class_methods_via_class_ref);
  429. if (sym^.properties and sp_static)<>0 then
  430. begin
  431. static_name:=lowercase(srsymtable^.name^)+'_'+sym^.name;
  432. getsym(static_name,true);
  433. disposetree(p1);
  434. p1:=genloadnode(pvarsym(srsym),srsymtable);
  435. end
  436. else
  437. p1:=gensubscriptnode(pvarsym(sym),p1);
  438. pd:=pvarsym(sym)^.definition;
  439. end;
  440. propertysym:
  441. begin
  442. if isclassref then
  443. Message(parser_e_only_class_methods_via_class_ref);
  444. paras:=nil;
  445. { property parameters? }
  446. if token=LECKKLAMMER then
  447. begin
  448. consume(LECKKLAMMER);
  449. paras:=parse_paras(false,true);
  450. consume(RECKKLAMMER);
  451. end;
  452. { indexed property }
  453. if (ppropertysym(sym)^.options and ppo_indexed)<>0 then
  454. begin
  455. p2:=genordinalconstnode(ppropertysym(sym)^.index,s32bitdef);
  456. paras:=gencallparanode(p2,paras);
  457. end;
  458. if not(afterassignment) and not(in_args) then
  459. begin
  460. { write property: }
  461. { no result }
  462. pd:=voiddef;
  463. if assigned(ppropertysym(sym)^.writeaccesssym) then
  464. begin
  465. if ppropertysym(sym)^.writeaccesssym^.typ=procsym then
  466. begin
  467. { generate the method call }
  468. p1:=genmethodcallnode(pprocsym(
  469. ppropertysym(sym)^.writeaccesssym),
  470. ppropertysym(sym)^.writeaccesssym^.owner,p1);
  471. p1^.left:=paras;
  472. { to be on the save side }
  473. oldafterassignment:=afterassignment;
  474. consume(ASSIGNMENT);
  475. { read the expression }
  476. afterassignment:=true;
  477. p2:=expr;
  478. p1^.left:=gencallparanode(p2,p1^.left);
  479. afterassignment:=oldafterassignment;
  480. end
  481. else if ppropertysym(sym)^.writeaccesssym^.typ=varsym then
  482. begin
  483. if assigned(paras) then
  484. message(parser_e_no_paras_allowed);
  485. p1:=gensubscriptnode(pvarsym(
  486. ppropertysym(sym)^.readaccesssym),p1);
  487. { to be on the save side }
  488. oldafterassignment:=afterassignment;
  489. consume(ASSIGNMENT);
  490. { read the expression }
  491. afterassignment:=true;
  492. p2:=expr;
  493. p1:=gennode(assignn,p1,p2);
  494. afterassignment:=oldafterassignment;
  495. end
  496. else
  497. begin
  498. p1:=genzeronode(errorn);
  499. Message(parser_e_no_procedure_to_access_property);
  500. end;
  501. end
  502. else
  503. begin
  504. p1:=genzeronode(errorn);
  505. Message(parser_e_no_procedure_to_access_property);
  506. end;
  507. end
  508. else
  509. begin
  510. { read property: }
  511. pd:=ppropertysym(sym)^.proptype;
  512. if assigned(ppropertysym(sym)^.readaccesssym) then
  513. begin
  514. if ppropertysym(sym)^.readaccesssym^.typ=varsym then
  515. begin
  516. if assigned(paras) then
  517. message(parser_e_no_paras_allowed);
  518. p1:=gensubscriptnode(pvarsym(
  519. ppropertysym(sym)^.readaccesssym),p1);
  520. pd:=pvarsym(sym)^.definition;
  521. end
  522. else if ppropertysym(sym)^.readaccesssym^.typ=procsym then
  523. begin
  524. { generate the method call }
  525. p1:=genmethodcallnode(pprocsym(
  526. ppropertysym(sym)^.readaccesssym),
  527. ppropertysym(sym)^.readaccesssym^.owner,p1);
  528. { insert paras }
  529. p1^.left:=paras;
  530. { if we should be delphi compatible }
  531. { then force type conversion }
  532. if cs_delphi2_compatible in aktswitches then
  533. p1:=gentypeconvnode(p1,pd);
  534. end
  535. else
  536. begin
  537. p1:=genzeronode(errorn);
  538. Message(sym_e_type_mismatch);
  539. end;
  540. end
  541. else
  542. begin
  543. { error, no function to read property }
  544. p1:=genzeronode(errorn);
  545. Message(parser_e_no_procedure_to_access_property);
  546. end;
  547. end;
  548. end;
  549. else internalerror(16);
  550. end;
  551. end;
  552. end;
  553. function factor(getaddr : boolean) : ptree;
  554. var
  555. l : longint;
  556. p1,p2,p3 : ptree;
  557. code : word;
  558. pd,pd2 : pdef;
  559. unit_specific, again : boolean;
  560. static_name : string;
  561. sym : pvarsym;
  562. classh : pobjectdef;
  563. d : bestreal;
  564. constset : pconstset;
  565. { p1 and p2 must contain valid values }
  566. procedure postfixoperators;
  567. begin
  568. while again do
  569. begin
  570. case token of
  571. CARET:
  572. begin
  573. consume(CARET);
  574. if pd^.deftype<>pointerdef then
  575. begin
  576. { ^ as binary operator is a problem!!!! (FK) }
  577. again:=false;
  578. Message(cg_e_invalid_qualifier);
  579. disposetree(p1);
  580. p1:=genzeronode(errorn);
  581. end
  582. else
  583. begin
  584. p1:=gensinglenode(derefn,p1);
  585. pd:=ppointerdef(pd)^.definition;
  586. end;
  587. end;
  588. LECKKLAMMER : begin
  589. consume(LECKKLAMMER);
  590. repeat
  591. if (pd^.deftype<>arraydef) and
  592. (pd^.deftype<>stringdef) and
  593. (pd^.deftype<>pointerdef) then
  594. begin
  595. Message(cg_e_invalid_qualifier);
  596. disposetree(p1);
  597. p1:=genzeronode(errorn);
  598. end
  599. else if (pd^.deftype=pointerdef) then
  600. begin
  601. p2:=expr;
  602. p1:=gennode(vecn,p1,p2);
  603. pd:=ppointerdef(pd)^.definition;
  604. end
  605. else
  606. begin
  607. p2:=expr;
  608. { support SEG:OFS for go32v2 Mem[] }
  609. if (target_info.target=target_GO32V2) and
  610. assigned(p1^.symtableentry) and
  611. assigned(p1^.symtableentry^.owner^.name) and
  612. (p1^.symtableentry^.owner^.name^='SYSTEM') and
  613. ((p1^.symtableentry^.name='MEM') or
  614. (p1^.symtableentry^.name='MEMW') or
  615. (p1^.symtableentry^.name='MEML')) then
  616. begin
  617. if (token=COLON) then
  618. begin
  619. consume(COLON);
  620. p3:=gennode(muln,genordinalconstnode($10,s32bitdef),p2);
  621. p2:=expr;
  622. p2:=gennode(addn,p2,p3);
  623. p1:=gennode(vecn,p1,p2);
  624. p1^.memseg:=true;
  625. p1^.memindex:=true;
  626. end
  627. else
  628. begin
  629. p1:=gennode(vecn,p1,p2);
  630. p1^.memindex:=true;
  631. end;
  632. end
  633. else
  634. p1:=gennode(vecn,p1,p2);
  635. if pd^.deftype=stringdef then
  636. pd:=cchardef
  637. else
  638. pd:=parraydef(pd)^.definition;
  639. end;
  640. if token=COMMA then consume(COMMA)
  641. else break;
  642. until false;
  643. consume(RECKKLAMMER);
  644. end;
  645. POINT : begin
  646. consume(POINT);
  647. case pd^.deftype of
  648. recorddef:
  649. begin
  650. sym:=pvarsym(precdef(pd)^.symtable^.search(pattern));
  651. consume(ID);
  652. if sym=nil then
  653. begin
  654. Message(sym_e_illegal_field);
  655. disposetree(p1);
  656. p1:=genzeronode(errorn);
  657. end
  658. else
  659. begin
  660. p1:=gensubscriptnode(sym,p1);
  661. pd:=sym^.definition;
  662. end;
  663. end;
  664. classrefdef:
  665. begin
  666. classh:=pobjectdef(pclassrefdef(pd)^.definition);
  667. sym:=nil;
  668. while assigned(classh) do
  669. begin
  670. sym:=pvarsym(classh^.publicsyms^.search(pattern));
  671. srsymtable:=classh^.publicsyms;
  672. if assigned(sym) then
  673. break;
  674. classh:=classh^.childof;
  675. end;
  676. consume(ID);
  677. do_member_read(sym,p1,pd,again);
  678. end;
  679. objectdef:
  680. begin
  681. classh:=pobjectdef(pd);
  682. sym:=nil;
  683. while assigned(classh) do
  684. begin
  685. sym:=pvarsym(classh^.publicsyms^.search(pattern));
  686. srsymtable:=classh^.publicsyms;
  687. if assigned(sym) then
  688. break;
  689. classh:=classh^.childof;
  690. end;
  691. consume(ID);
  692. do_member_read(sym,p1,pd,again);
  693. end;
  694. pointerdef:
  695. begin
  696. if ppointerdef(pd)^.definition^.deftype
  697. in [recorddef,objectdef,classrefdef] then
  698. begin
  699. Message(cg_e_invalid_qualifier);
  700. { exterror:=strpnew(' may be pointer deref ^ is missing');
  701. error(invalid_qualifizier); }
  702. Comment(V_hint,' may be pointer deref ^ is missing');
  703. end
  704. else
  705. Message(cg_e_invalid_qualifier);
  706. end
  707. else
  708. begin
  709. Message(cg_e_invalid_qualifier);
  710. disposetree(p1);
  711. p1:=genzeronode(errorn);
  712. end;
  713. end;
  714. end;
  715. else
  716. begin
  717. { is this a procedure variable ? }
  718. if assigned(pd) then
  719. begin
  720. if (pd^.deftype=procvardef) then
  721. begin
  722. if getprocvar then
  723. again:=false
  724. else
  725. if (token=LKLAMMER) or
  726. ((pprocvardef(pd)^.para1=nil) and
  727. (token<>ASSIGNMENT) and (not in_args)) then
  728. begin
  729. { do this in a strange way }
  730. { it's not a clean solution }
  731. p2:=p1;
  732. p1:=gencallnode(nil,
  733. nil);
  734. p1^.right:=p2;
  735. p1^.unit_specific:=unit_specific;
  736. if token=LKLAMMER then
  737. begin
  738. consume(LKLAMMER);
  739. p1^.left:=parse_paras(false,false);
  740. consume(RKLAMMER);
  741. end;
  742. pd:=pprocvardef(pd)^.retdef;
  743. p1^.resulttype:=pd;
  744. end
  745. else again:=false;
  746. p1^.resulttype:=pd;
  747. end
  748. else again:=false;
  749. end
  750. else again:=false;
  751. end;
  752. end;
  753. end;
  754. end;
  755. procedure do_set(p : pconstset;pos : longint);
  756. var
  757. l : longint;
  758. begin
  759. if (pos>255) or
  760. (pos<0) then
  761. Message(parser_e_illegal_set_expr);
  762. l:=pos div 8;
  763. { do we allow the same twice }
  764. if (p^[l] and (1 shl (pos mod 8)))<>0 then
  765. Message(parser_e_illegal_set_expr);
  766. p^[l]:=p^[l] or (1 shl (pos mod 8));
  767. end;
  768. var
  769. possible_error : boolean;
  770. storesymtablestack : psymtable;
  771. actprocsym : pprocsym;
  772. begin
  773. case token of
  774. ID:
  775. begin
  776. { allow post fix operators }
  777. again:=true;
  778. if (cs_delphi2_compatible in aktswitches) and
  779. (pattern='RESULT') and
  780. assigned(aktprocsym) and
  781. (procinfo.retdef<>pdef(voiddef)) then
  782. begin
  783. consume(ID);
  784. p1:=genzeronode(funcretn);
  785. pd:=procinfo.retdef;
  786. {$ifdef TEST_FUNCRET}
  787. p1^.funcretprocinfo:=pointer(@procinfo);
  788. p1^.retdef:=pd;
  789. {$endif TEST_FUNCRET}
  790. end
  791. else
  792. begin
  793. getsym(pattern,true);
  794. consume(ID);
  795. { is this an access to a function result ? }
  796. if assigned(aktprocsym) and
  797. ((srsym^.name=aktprocsym^.name) or
  798. ((pvarsym(srsym)=opsym) and
  799. ((pprocdef(aktprocsym^.definition)^.options and pooperator)<>0))) and
  800. (procinfo.retdef<>pdef(voiddef)) and
  801. (token<>LKLAMMER) and
  802. (not ((cs_tp_compatible in aktswitches) and
  803. (afterassignment or in_args))) then
  804. begin
  805. p1:=genzeronode(funcretn);
  806. pd:=procinfo.retdef;
  807. {$ifdef TEST_FUNCRET}
  808. p1^.funcretprocinfo:=pointer(@procinfo);
  809. p1^.retdef:=pd;
  810. {$endif TEST_FUNCRET}
  811. end
  812. else
  813. { else it's a normal symbol }
  814. begin
  815. if srsym^.typ=unitsym then
  816. begin
  817. consume(POINT);
  818. getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
  819. unit_specific:=true;
  820. consume(ID);
  821. end
  822. else
  823. unit_specific:=false;
  824. case srsym^.typ of
  825. absolutesym:
  826. begin
  827. p1:=genloadnode(pvarsym(srsym),srsymtable);
  828. pd:=pabsolutesym(srsym)^.definition;
  829. end;
  830. varsym:
  831. begin
  832. { are we in a class method ? }
  833. if (srsymtable^.symtabletype=objectsymtable) and
  834. assigned(aktprocsym) and
  835. ((aktprocsym^.definition^.options and poclassmethod)<>0) then
  836. Message(parser_e_only_class_methods);
  837. if (srsym^.properties and sp_static)<>0 then
  838. begin
  839. static_name:=lowercase(srsymtable^.name^)+'_'+srsym^.name;
  840. getsym(static_name,true);
  841. end;
  842. p1:=genloadnode(pvarsym(srsym),srsymtable);
  843. if pvarsym(srsym)^.is_valid=0 then
  844. begin
  845. p1^.is_first := true;
  846. { set special between first loaded
  847. until checked in firstpass }
  848. pvarsym(srsym)^.is_valid:=2;
  849. end;
  850. pd:=pvarsym(srsym)^.definition;
  851. end;
  852. typedconstsym:
  853. begin
  854. p1:=gentypedconstloadnode(ptypedconstsym(srsym),srsymtable);
  855. pd:=ptypedconstsym(srsym)^.definition;
  856. end;
  857. syssym:
  858. p1:=statement_syssym(psyssym(srsym)^.number,pd);
  859. typesym:
  860. begin
  861. pd:=ptypesym(srsym)^.definition;
  862. if token=LKLAMMER then
  863. begin
  864. consume(LKLAMMER);
  865. p1:=expr;
  866. consume(RKLAMMER);
  867. p1:=gentypeconvnode(p1,pd);
  868. p1^.explizit:=true;
  869. end
  870. else if (token=POINT) and
  871. (pd^.deftype=objectdef) and
  872. ((pobjectdef(pd)^.options and oois_class)=0) then
  873. begin
  874. consume(POINT);
  875. if assigned(procinfo._class) then
  876. begin
  877. if procinfo._class^.isrelated(pobjectdef(pd)) then
  878. begin
  879. p1:=genzeronode(typen);
  880. p1^.resulttype:=pd;
  881. srsymtable:=pobjectdef(pd)^.publicsyms;
  882. sym:=pvarsym(srsymtable^.search(pattern));
  883. consume(ID);
  884. do_member_read(sym,p1,pd,again);
  885. end
  886. else
  887. begin
  888. Message(parser_e_no_super_class);
  889. pd:=generrordef;
  890. again:=false;
  891. end;
  892. end
  893. else
  894. begin
  895. { allows @TObject.Load }
  896. { also allows static methods and variables }
  897. p1:=genzeronode(typen);
  898. p1^.resulttype:=pd;
  899. srsymtable:=pobjectdef(pd)^.publicsyms;
  900. sym:=pvarsym(srsymtable^.search(pattern));
  901. if not(getaddr) and
  902. ((sym^.properties and sp_static)=0) then
  903. Message(sym_e_only_static_in_static)
  904. else
  905. begin
  906. consume(ID);
  907. do_member_read(sym,p1,pd,again);
  908. end;
  909. end
  910. end
  911. else
  912. begin
  913. { class reference ? }
  914. if (pd^.deftype=objectdef)
  915. and ((pobjectdef(pd)^.options and oois_class)<>0) then
  916. begin
  917. p1:=genzeronode(typen);
  918. p1^.resulttype:=pd;
  919. pd:=new(pclassrefdef,init(pd));
  920. p1:=gensinglenode(loadvmtn,p1);
  921. p1^.resulttype:=pd;
  922. end
  923. else
  924. begin
  925. { generate a type node }
  926. { (for typeof etc) }
  927. p1:=genzeronode(typen);
  928. p1^.resulttype:=pd;
  929. pd:=voiddef;
  930. end;
  931. end;
  932. end;
  933. enumsym:
  934. begin
  935. p1:=genenumnode(penumsym(srsym));
  936. pd:=p1^.resulttype;
  937. end;
  938. constsym:
  939. begin
  940. case pconstsym(srsym)^.consttype of
  941. constint:
  942. p1:=genordinalconstnode(pconstsym(srsym)^.value,s32bitdef);
  943. conststring:
  944. p1:=genstringconstnode(pstring(pconstsym(srsym)^.value)^);
  945. constchar:
  946. p1:=genordinalconstnode(pconstsym(srsym)^.value,cchardef);
  947. constreal:
  948. p1:=genrealconstnode(pdouble(pconstsym(srsym)^.value)^);
  949. constbool:
  950. p1:=genordinalconstnode(pconstsym(srsym)^.value,booldef);
  951. constseta:
  952. p1:=gensetconstruktnode(pconstset(pconstsym(srsym)^.value),
  953. psetdef(pconstsym(srsym)^.definition));
  954. constord:
  955. p1:=genordinalconstnode(pconstsym(srsym)^.value,
  956. pconstsym(srsym)^.definition);
  957. end;
  958. pd:=p1^.resulttype;
  959. end;
  960. procsym:
  961. begin
  962. { are we in a class method ? }
  963. possible_error:=(srsymtable^.symtabletype=objectsymtable) and
  964. assigned(aktprocsym) and
  965. ((aktprocsym^.definition^.options and poclassmethod)<>0);
  966. p1:=gencallnode(pprocsym(srsym),srsymtable);
  967. p1^.unit_specific:=unit_specific;
  968. do_proc_call(getaddr,again,p1,pd);
  969. if possible_error and
  970. ((p1^.procdefinition^.options and poclassmethod)=0) then
  971. Message(parser_e_only_class_methods);
  972. end;
  973. propertysym:
  974. begin
  975. { access to property in a method }
  976. { are we in a class method ? }
  977. if (srsymtable^.symtabletype=objectsymtable) and
  978. assigned(aktprocsym) and
  979. ((aktprocsym^.definition^.options and poclassmethod)<>0) then
  980. Message(parser_e_only_class_methods);
  981. { !!!!! }
  982. end;
  983. errorsym:
  984. begin
  985. p1:=genzeronode(errorn);
  986. pd:=generrordef;
  987. if token=LKLAMMER then
  988. begin
  989. consume(LKLAMMER);
  990. parse_paras(false,false);
  991. consume(RKLAMMER);
  992. end;
  993. end;
  994. else
  995. begin
  996. p1:=genzeronode(errorn);
  997. pd:=generrordef;
  998. Message(cg_e_illegal_expression);
  999. end;
  1000. end;
  1001. end;
  1002. end;
  1003. { handle post fix operators }
  1004. postfixoperators;
  1005. end;
  1006. _NEW : begin
  1007. consume(_NEW);
  1008. consume(LKLAMMER);
  1009. p1:=factor(false);
  1010. if p1^.treetype<>typen then
  1011. Message(sym_e_type_id_expected);
  1012. pd:=p1^.resulttype;
  1013. pd2:=pd;
  1014. if (pd^.deftype<>pointerdef) or
  1015. (ppointerdef(pd)^.definition^.deftype<>objectdef) then
  1016. begin
  1017. Message(parser_e_pointer_to_class_expected);
  1018. { if an error occurs, read til the end of the new }
  1019. { statement }
  1020. p1:=genzeronode(errorn);
  1021. l:=1;
  1022. while true do
  1023. begin
  1024. case token of
  1025. LKLAMMER : inc(l);
  1026. RKLAMMER : dec(l);
  1027. end;
  1028. consume(token);
  1029. if l=0 then
  1030. break;
  1031. end;
  1032. end
  1033. else
  1034. begin
  1035. disposetree(p1);
  1036. p1:=genzeronode(hnewn);
  1037. p1^.resulttype:=ppointerdef(pd)^.definition;
  1038. consume(COMMA);
  1039. afterassignment:=false;
  1040. { determines the current object defintion }
  1041. classh:=pobjectdef(ppointerdef(pd)^.definition);
  1042. { check for an abstract class }
  1043. if (classh^.options and oois_abstract)<>0 then
  1044. Message(sym_e_no_instance_of_abstract_object);
  1045. { search the constructor also in the symbol tables of }
  1046. { the parents }
  1047. { no constructor found }
  1048. sym:=nil;
  1049. while assigned(classh) do
  1050. begin
  1051. sym:=pvarsym(classh^.publicsyms^.search(pattern));
  1052. srsymtable:=classh^.publicsyms;
  1053. if assigned(sym) then
  1054. break;
  1055. classh:=classh^.childof;
  1056. end;
  1057. consume(ID);
  1058. do_member_read(sym,p1,pd,again);
  1059. if (p1^.treetype<>calln) or
  1060. (assigned(p1^.procdefinition) and
  1061. ((p1^.procdefinition^.options and poconstructor)=0)) then
  1062. Message(parser_e_expr_have_to_be_constructor_call);
  1063. p1:=gensinglenode(newn,p1);
  1064. { set the resulttype }
  1065. p1^.resulttype:=pd2;
  1066. consume(RKLAMMER);
  1067. end;
  1068. end;
  1069. _SELF:
  1070. begin
  1071. again:=true;
  1072. consume(_SELF);
  1073. if not assigned(procinfo._class) then
  1074. begin
  1075. p1:=genzeronode(errorn);
  1076. pd:=generrordef;
  1077. again:=false;
  1078. Message(parser_e_self_not_in_method);
  1079. end
  1080. else
  1081. begin
  1082. if (aktprocsym^.definition^.options and poclassmethod)<>0 then
  1083. begin
  1084. { self in class methods is a class reference type }
  1085. pd:=new(pclassrefdef,init(procinfo._class));
  1086. p1:=genselfnode(pd);
  1087. p1^.resulttype:=pd;
  1088. end
  1089. else
  1090. begin
  1091. p1:=genselfnode(procinfo._class);
  1092. p1^.resulttype:=procinfo._class;
  1093. end;
  1094. pd:=p1^.resulttype;
  1095. postfixoperators;
  1096. end;
  1097. end;
  1098. _INHERITED : begin
  1099. again:=true;
  1100. consume(_INHERITED);
  1101. if assigned(procinfo._class) then
  1102. begin
  1103. classh:=procinfo._class^.childof;
  1104. while assigned(classh) do
  1105. begin
  1106. srsymtable:=pobjectdef(classh)^.publicsyms;
  1107. sym:=pvarsym(srsymtable^.search(pattern));
  1108. if assigned(sym) then
  1109. begin
  1110. p1:=genzeronode(typen);
  1111. p1^.resulttype:=classh;
  1112. pd:=p1^.resulttype;
  1113. consume(ID);
  1114. do_member_read(sym,p1,pd,again);
  1115. break;
  1116. end;
  1117. classh:=classh^.childof;
  1118. end;
  1119. if classh=nil then
  1120. begin
  1121. Message1(sym_e_id_no_member,pattern);
  1122. again:=false;
  1123. pd:=generrordef;
  1124. p1:=genzeronode(errorn);
  1125. end;
  1126. end
  1127. else
  1128. Message(parser_e_generic_methods_only_in_methods);
  1129. postfixoperators;
  1130. end;
  1131. INTCONST : begin
  1132. valint(pattern,l,code);
  1133. if code<>0 then
  1134. begin
  1135. val(pattern,d,code);
  1136. if code<>0 then
  1137. begin
  1138. Message(cg_e_invalid_integer);
  1139. l:=1;
  1140. consume(INTCONST);
  1141. p1:=genordinalconstnode(l,s32bitdef);
  1142. end
  1143. else
  1144. begin
  1145. consume(INTCONST);
  1146. p1:=genrealconstnode(d);
  1147. end;
  1148. end
  1149. else
  1150. begin
  1151. consume(INTCONST);
  1152. p1:=genordinalconstnode(l,s32bitdef);
  1153. end;
  1154. end;
  1155. REALNUMBER : begin
  1156. val(pattern,d,code);
  1157. if code<>0 then
  1158. begin
  1159. Message(parser_e_error_in_real);
  1160. d:=1.0;
  1161. end;
  1162. consume(REALNUMBER);
  1163. p1:=genrealconstnode(d);
  1164. end;
  1165. { FILE and STRING can be also a type cast }
  1166. _STRING:
  1167. begin
  1168. pd:=stringtype;
  1169. consume(LKLAMMER);
  1170. p1:=expr;
  1171. consume(RKLAMMER);
  1172. p1:=gentypeconvnode(p1,pd);
  1173. p1^.explizit:=true;
  1174. { handle postfix operators here e.g. string(a)[10] }
  1175. again:=true;
  1176. postfixoperators;
  1177. end;
  1178. _FILE:
  1179. begin
  1180. pd:=cfiledef;
  1181. consume(_FILE);
  1182. consume(LKLAMMER);
  1183. p1:=expr;
  1184. consume(RKLAMMER);
  1185. p1:=gentypeconvnode(p1,pd);
  1186. p1^.explizit:=true;
  1187. { handle postfix operators here e.g. string(a)[10] }
  1188. again:=true;
  1189. postfixoperators;
  1190. end;
  1191. CSTRING:
  1192. begin
  1193. p1:=genstringconstnode(pattern);
  1194. consume(CSTRING);
  1195. end;
  1196. CCHAR:
  1197. begin
  1198. p1:=genordinalconstnode(ord(pattern[1]),cchardef);
  1199. consume(CCHAR);
  1200. end;
  1201. KLAMMERAFFE : begin
  1202. consume(KLAMMERAFFE);
  1203. p1:=factor(true);
  1204. p1:=gensinglenode(addrn,p1);
  1205. end;
  1206. LKLAMMER : begin
  1207. consume(LKLAMMER);
  1208. p1:=expr;
  1209. consume(RKLAMMER);
  1210. { it's not a good solution }
  1211. { but (a+b)^ makes some problems }
  1212. case token of
  1213. CARET,POINT,LECKKLAMMER:
  1214. begin
  1215. { we need the resulttype }
  1216. { of the expression in pd }
  1217. do_firstpass(p1);
  1218. pd:=p1^.resulttype;
  1219. again:=true;
  1220. postfixoperators;
  1221. end;
  1222. end;
  1223. end;
  1224. LECKKLAMMER : begin
  1225. consume(LECKKLAMMER);
  1226. new(constset);
  1227. for l:=0 to 31 do
  1228. constset^[l]:=0;
  1229. p2:=nil;
  1230. pd:=nil;
  1231. if token<>RECKKLAMMER then
  1232. while true do
  1233. begin
  1234. p1:=expr;
  1235. do_firstpass(p1);
  1236. case p1^.treetype of
  1237. ordconstn : begin
  1238. if pd=nil then
  1239. pd:=p1^.resulttype;
  1240. if not(is_equal(pd,p1^.resulttype)) then
  1241. Message(parser_e_typeconflict_in_set)
  1242. else
  1243. do_set(constset,p1^.value);
  1244. disposetree(p1);
  1245. end;
  1246. rangen : begin
  1247. if pd=nil then
  1248. pd:=p1^.left^.resulttype;
  1249. if not(is_equal(pd,p1^.left^.resulttype)) then
  1250. Message(parser_e_typeconflict_in_set)
  1251. else
  1252. for l:=p1^.left^.value to p1^.right^.value do
  1253. do_set(constset,l);
  1254. disposetree(p1);
  1255. end;
  1256. stringconstn : begin
  1257. if pd=nil then
  1258. pd:=cchardef;
  1259. if not(is_equal(pd,cchardef)) then
  1260. Message(parser_e_typeconflict_in_set)
  1261. else
  1262. for l:=1 to length(pstring(p1^.values)^) do
  1263. do_set(constset,ord(pstring(p1^.values)^[l]));
  1264. disposetree(p1);
  1265. end;
  1266. else
  1267. begin
  1268. if pd=nil then
  1269. pd:=p1^.resulttype;
  1270. if not(is_equal(pd,p1^.resulttype)) then
  1271. Message(parser_e_typeconflict_in_set);
  1272. p2:=gennode(setelen,p1,p2);
  1273. end;
  1274. end;
  1275. if token=COMMA then
  1276. consume(COMMA)
  1277. else break;
  1278. end;
  1279. consume(RECKKLAMMER);
  1280. p1:=gensinglenode(setconstrn,p2);
  1281. p1^.resulttype:=new(psetdef,init(pd,255));
  1282. p1^.constset:=constset;
  1283. end;
  1284. PLUS : begin
  1285. consume(PLUS);
  1286. p1:=factor(false);
  1287. end;
  1288. MINUS : begin
  1289. consume(MINUS);
  1290. p1:=factor(false);
  1291. p1:=gensinglenode(umminusn,p1);
  1292. end;
  1293. _NOT : begin
  1294. consume(_NOT);
  1295. p1:=factor(false);
  1296. p1:=gensinglenode(notn,p1);
  1297. end;
  1298. _TRUE : begin
  1299. consume(_TRUE);
  1300. p1:=genordinalconstnode(1,booldef);
  1301. end;
  1302. _FALSE : begin
  1303. consume(_FALSE);
  1304. p1:=genordinalconstnode(0,booldef);
  1305. end;
  1306. _NIL : begin
  1307. consume(_NIL);
  1308. p1:=genzeronode(niln);
  1309. end;
  1310. else
  1311. begin
  1312. p1:=genzeronode(errorn);
  1313. consume(token);
  1314. Message(cg_e_illegal_expression);
  1315. end;
  1316. end;
  1317. factor:=p1;
  1318. end;
  1319. type Toperator_precedence=(opcompare,opaddition,opmultiply);
  1320. const tok2node:array[PLUS.._XOR] of Ttreetyp=
  1321. (addn,subn,muln,slashn,equaln,gtn,ltn,gten,lten,
  1322. isn,asn,inn,
  1323. nothingn,caretn,nothingn,unequaln,nothingn,
  1324. nothingn,nothingn,nothingn,nothingn,nothingn,
  1325. nothingn,nothingn,nothingn,nothingn,nothingn,
  1326. nothingn,nothingn,nothingn,nothingn,nothingn,
  1327. nothingn,andn,nothingn,nothingn,nothingn,
  1328. nothingn,nothingn,nothingn,nothingn,nothingn,
  1329. nothingn,nothingn,divn,nothingn,nothingn,
  1330. nothingn,nothingn,nothingn,nothingn,nothingn,
  1331. nothingn,nothingn,nothingn,nothingn,nothingn,
  1332. nothingn,nothingn,nothingn,nothingn,nothingn,
  1333. modn,nothingn,nothingn,nothingn,nothingn,
  1334. nothingn,nothingn,orn,
  1335. nothingn,nothingn,nothingn,nothingn,nothingn,
  1336. nothingn,nothingn,shln,shrn,
  1337. nothingn,nothingn,nothingn,nothingn,nothingn,
  1338. nothingn,nothingn,nothingn,nothingn,nothingn,
  1339. nothingn,xorn);
  1340. operator_levels:array[Toperator_precedence] of set of Ttoken=
  1341. ([LT,LTE,GT,GTE,EQUAL,UNEQUAL,_IN,_IS],
  1342. [PLUS,MINUS,_OR,_XOR],
  1343. [CARET,SYMDIF,STAR,SLASH,_DIV,_MOD,_AND,_SHL,_SHR,_AS]);
  1344. function sub_expr(pred_level:Toperator_precedence):Ptree;
  1345. {Reads a subexpression while the operators are of the current precedence
  1346. level, or any higher level. Replaces the old term, simpl_expr and
  1347. simpl2_expr.}
  1348. var p1,p2:Ptree;
  1349. oldt:Ttoken;
  1350. begin
  1351. { if pred_level=high(Toperator_precedence) then }
  1352. if pred_level=opmultiply then
  1353. p1:=factor(getprocvar)
  1354. else
  1355. p1:=sub_expr(succ(pred_level));
  1356. repeat
  1357. if token in operator_levels[pred_level] then
  1358. begin
  1359. oldt:=token;
  1360. consume(token);
  1361. { if pred_level=high(Toperator_precedence) then }
  1362. if pred_level=opmultiply then
  1363. p2:=factor(getprocvar)
  1364. else
  1365. p2:=sub_expr(succ(pred_level));
  1366. p1:=gennode(tok2node[oldt],p1,p2);
  1367. end
  1368. else
  1369. break;
  1370. until false;
  1371. sub_expr:=p1;
  1372. end;
  1373. function expr : ptree;
  1374. var
  1375. p1,p2 : ptree;
  1376. oldafterassignment : boolean;
  1377. begin
  1378. oldafterassignment:=afterassignment;
  1379. p1:=sub_expr(opcompare);
  1380. if token in [ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
  1381. afterassignment:=true;
  1382. case token of
  1383. POINTPOINT : begin
  1384. consume(POINTPOINT);
  1385. p2:=sub_expr(opcompare);
  1386. p1:=gennode(rangen,p1,p2);
  1387. end;
  1388. ASSIGNMENT : begin
  1389. consume(ASSIGNMENT);
  1390. { avoid a firstpass of a procedure if
  1391. it must be assigned to a procvar }
  1392. { should be recursive for a:=b:=c !!! }
  1393. if (p1^.resulttype<>nil) and (p1^.resulttype^.deftype=procvardef) then
  1394. getprocvar:=true;
  1395. {$ifdef tp}
  1396. p2:=expr;
  1397. {$else}
  1398. { FPC needs this to recognizes the call }
  1399. { because the function name can be used like }
  1400. { an simple variable }
  1401. p2:=expr();
  1402. {$endif}
  1403. if getprocvar and (p2^.treetype=calln) then
  1404. begin
  1405. p2^.treetype:=loadn;
  1406. p2^.resulttype:=pprocsym(p2^.symtableprocentry)^.definition;
  1407. p2^.symtableentry:=p2^.symtableprocentry;
  1408. end;
  1409. getprocvar:=false;
  1410. p1:=gennode(assignn,p1,p2);
  1411. end;
  1412. { this is the code for C like assignements }
  1413. { from an improvement of Peter Schaefer }
  1414. _PLUSASN : begin
  1415. consume(_PLUSASN );
  1416. {$ifdef tp}
  1417. p2:=expr;
  1418. {$else}
  1419. p2:=expr();
  1420. {$endif}
  1421. p1:=gennode(assignn,p1,gennode(addn,getcopy(p1),p2));
  1422. { was first
  1423. p1:=gennode(assignn,p1,gennode(addn,p1,p2));
  1424. but disposetree assumes that we have a real
  1425. *** tree *** }
  1426. end;
  1427. _MINUSASN : begin
  1428. consume(_MINUSASN );
  1429. {$ifdef tp}
  1430. p2:=expr;
  1431. {$else}
  1432. p2:=expr();
  1433. {$endif}
  1434. p1:=gennode(assignn,p1,gennode(subn,getcopy(p1),p2));
  1435. end;
  1436. _STARASN : begin
  1437. consume(_STARASN );
  1438. {$ifdef tp}
  1439. p2:=expr;
  1440. {$else}
  1441. p2:=expr();
  1442. {$endif}
  1443. p1:=gennode(assignn,p1,gennode(muln,getcopy(p1),p2));
  1444. end;
  1445. _SLASHASN : begin
  1446. consume(_SLASHASN );
  1447. {$ifdef tp}
  1448. p2:=expr;
  1449. {$else}
  1450. p2:=expr();
  1451. {$endif}
  1452. p1:=gennode(assignn,p1,gennode(slashn,getcopy(p1),p2));
  1453. end;
  1454. end;
  1455. afterassignment:=oldafterassignment;
  1456. expr:=p1;
  1457. end;
  1458. function get_intconst:longint;
  1459. {Reads an expression, tries to evalute it and check if it is an integer
  1460. constant. Then the constant is returned.}
  1461. var p:Ptree;
  1462. begin
  1463. p:=expr;
  1464. do_firstpass(p);
  1465. if (p^.treetype<>ordconstn) and
  1466. (p^.resulttype^.deftype=orddef) and
  1467. not (Porddef(p^.resulttype)^.typ in
  1468. [uvoid,uchar,bool8bit]) then
  1469. Message(cg_e_illegal_expression)
  1470. else
  1471. get_intconst:=p^.value;
  1472. disposetree(p);
  1473. end;
  1474. function get_stringconst:string;
  1475. {Reads an expression, tries to evaluate it and checks if it is a string
  1476. constant. Then the constant is returned.}
  1477. var p:Ptree;
  1478. begin
  1479. get_stringconst:='';
  1480. p:=expr;
  1481. do_firstpass(p);
  1482. if p^.treetype<>stringconstn then
  1483. if (p^.treetype=ordconstn) and
  1484. (p^.resulttype^.deftype=orddef) and
  1485. (Porddef(p^.resulttype)^.typ=uchar) then
  1486. get_stringconst:=char(p^.value)
  1487. else
  1488. Message(cg_e_illegal_expression)
  1489. else
  1490. get_stringconst:=p^.values^;
  1491. disposetree(p);
  1492. end;
  1493. end.
  1494. {
  1495. $Log$
  1496. Revision 1.1 1998-03-25 11:18:14 root
  1497. Initial revision
  1498. Revision 1.26 1998/03/24 21:48:33 florian
  1499. * just a couple of fixes applied:
  1500. - problem with fixed16 solved
  1501. - internalerror 10005 problem fixed
  1502. - patch for assembler reading
  1503. - small optimizer fix
  1504. - mem is now supported
  1505. Revision 1.25 1998/03/21 23:59:39 florian
  1506. * indexed properties fixed
  1507. * ppu i/o of properties fixed
  1508. * field can be also used for write access
  1509. * overriding of properties
  1510. Revision 1.24 1998/03/16 22:42:21 florian
  1511. * some fixes of Peter applied:
  1512. ofs problem, profiler support
  1513. Revision 1.23 1998/03/11 11:23:57 florian
  1514. * bug0081 and bug0109 fixed
  1515. Revision 1.22 1998/03/10 16:27:42 pierre
  1516. * better line info in stabs debug
  1517. * symtabletype and lexlevel separated into two fields of tsymtable
  1518. + ifdef MAKELIB for direct library output, not complete
  1519. + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
  1520. working
  1521. + ifdef TESTFUNCRET for setting func result in underfunction, not
  1522. working
  1523. Revision 1.21 1998/03/10 01:17:24 peter
  1524. * all files have the same header
  1525. * messages are fully implemented, EXTDEBUG uses Comment()
  1526. + AG... files for the Assembler generation
  1527. Revision 1.20 1998/03/06 00:52:44 peter
  1528. * replaced all old messages from errore.msg, only ExtDebug and some
  1529. Comment() calls are left
  1530. * fixed options.pas
  1531. Revision 1.19 1998/03/02 01:49:02 peter
  1532. * renamed target_DOS to target_GO32V1
  1533. + new verbose system, merged old errors and verbose units into one new
  1534. verbose.pas, so errors.pas is obsolete
  1535. Revision 1.18 1998/03/01 22:46:18 florian
  1536. + some win95 linking stuff
  1537. * a couple of bugs fixed:
  1538. bug0055,bug0058,bug0059,bug0064,bug0072,bug0093,bug0095,bug0098
  1539. Revision 1.17 1998/02/27 21:24:06 florian
  1540. * dll support changed (dll name can be also a string contants)
  1541. Revision 1.16 1998/02/24 00:19:17 peter
  1542. * makefile works again (btw. linux does like any char after a \ )
  1543. * removed circular unit with assemble and files
  1544. * fixed a sigsegv in pexpr
  1545. * pmodule init unit/program is the almost the same, merged them
  1546. Revision 1.15 1998/02/13 10:35:24 daniel
  1547. * Made Motorola version compilable.
  1548. * Fixed optimizer
  1549. Revision 1.14 1998/02/12 17:19:20 florian
  1550. * fixed to get remake3 work, but needs additional fixes (output, I don't like
  1551. also that aktswitches isn't a pointer)
  1552. Revision 1.13 1998/02/12 11:50:26 daniel
  1553. Yes! Finally! After three retries, my patch!
  1554. Changes:
  1555. Complete rewrite of psub.pas.
  1556. Added support for DLL's.
  1557. Compiler requires less memory.
  1558. Platform units for each platform.
  1559. Revision 1.12 1998/02/11 21:56:37 florian
  1560. * bugfixes: bug0093, bug0053, bug0088, bug0087, bug0089
  1561. Revision 1.11 1998/02/01 22:41:11 florian
  1562. * clean up
  1563. + system.assigned([class])
  1564. + system.assigned([class of xxxx])
  1565. * first fixes of as and is-operator
  1566. Revision 1.10 1998/02/01 15:04:15 florian
  1567. * better error recovering
  1568. * some clean up
  1569. Revision 1.9 1998/01/30 21:27:05 carl
  1570. * partial bugfix #88, #89 and typeof and other inline functions
  1571. (these bugs have a deeper nesting level, and therefore i only fixed
  1572. the parser crashes - there is also a tree crash).
  1573. Revision 1.8 1998/01/26 17:31:01 florian
  1574. * stupid bug with self in class methods fixed
  1575. Revision 1.7 1998/01/25 22:29:02 florian
  1576. * a lot bug fixes on the DOM
  1577. Revision 1.6 1998/01/23 10:46:41 florian
  1578. * small problems with FCL object model fixed, objpas?.inc is compilable
  1579. Revision 1.5 1998/01/16 22:34:42 michael
  1580. * Changed 'conversation' to 'conversion'. Waayyy too much chatting going on
  1581. in this compiler :)
  1582. Revision 1.4 1998/01/16 18:03:15 florian
  1583. * small bug fixes, some stuff of delphi styled constructores added
  1584. Revision 1.3 1998/01/13 23:11:14 florian
  1585. + class methods
  1586. Revision 1.2 1998/01/09 09:09:59 michael
  1587. + Initial implementation, second try
  1588. }