nflw.pas 34 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Florian Klaempfl
  4. Type checking and register allocation for nodes that influence
  5. the flow
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ****************************************************************************
  18. }
  19. unit nflw;
  20. {$i defines.inc}
  21. interface
  22. uses
  23. node,aasm,cpubase,
  24. symbase,symdef,symsym;
  25. type
  26. tloopnode = class(tbinarynode)
  27. t1,t2 : tnode;
  28. constructor create(tt : tnodetype;l,r,_t1,_t2 : tnode);virtual;
  29. destructor destroy;override;
  30. function getcopy : tnode;override;
  31. procedure insertintolist(l : tnodelist);override;
  32. {$ifdef extdebug}
  33. procedure dowrite;override;
  34. {$endif extdebug}
  35. function docompare(p: tnode): boolean; override;
  36. end;
  37. twhilerepeatnode = class(tloopnode)
  38. function det_resulttype:tnode;override;
  39. function pass_1 : tnode;override;
  40. end;
  41. twhilerepeatnodeclass = class of twhilerepeatnode;
  42. tifnode = class(tloopnode)
  43. constructor create(l,r,_t1 : tnode);virtual;
  44. function det_resulttype:tnode;override;
  45. function pass_1 : tnode;override;
  46. end;
  47. tifnodeclass = class of tifnode;
  48. tfornode = class(tloopnode)
  49. constructor create(l,r,_t1,_t2 : tnode;back : boolean);virtual;
  50. function det_resulttype:tnode;override;
  51. function pass_1 : tnode;override;
  52. end;
  53. tfornodeclass = class of tfornode;
  54. texitnode = class(tunarynode)
  55. constructor create(l:tnode);virtual;
  56. function det_resulttype:tnode;override;
  57. function pass_1 : tnode;override;
  58. end;
  59. texitnodeclass = class of texitnode;
  60. tbreaknode = class(tnode)
  61. constructor create;virtual;
  62. function det_resulttype:tnode;override;
  63. function pass_1 : tnode;override;
  64. end;
  65. tbreaknodeclass = class of tbreaknode;
  66. tcontinuenode = class(tnode)
  67. constructor create;virtual;
  68. function det_resulttype:tnode;override;
  69. function pass_1 : tnode;override;
  70. end;
  71. tcontinuenodeclass = class of tcontinuenode;
  72. tgotonode = class(tnode)
  73. labelnr : tasmlabel;
  74. labsym : tlabelsym;
  75. exceptionblock : integer;
  76. constructor create(p : tlabelsym);virtual;
  77. function getcopy : tnode;override;
  78. function det_resulttype:tnode;override;
  79. function pass_1 : tnode;override;
  80. function docompare(p: tnode): boolean; override;
  81. end;
  82. tgotonodeclass = class of tgotonode;
  83. tlabelnode = class(tunarynode)
  84. labelnr : tasmlabel;
  85. labsym : tlabelsym;
  86. exceptionblock : integer;
  87. constructor createcase(p : tasmlabel;l:tnode);virtual;
  88. constructor create(p : tlabelsym;l:tnode);virtual;
  89. function getcopy : tnode;override;
  90. function det_resulttype:tnode;override;
  91. function pass_1 : tnode;override;
  92. function docompare(p: tnode): boolean; override;
  93. end;
  94. tlabelnodeclass = class of tlabelnode;
  95. traisenode = class(tbinarynode)
  96. frametree : tnode;
  97. constructor create(l,taddr,tframe:tnode);virtual;
  98. function getcopy : tnode;override;
  99. procedure insertintolist(l : tnodelist);override;
  100. function det_resulttype:tnode;override;
  101. function pass_1 : tnode;override;
  102. function docompare(p: tnode): boolean; override;
  103. end;
  104. traisenodeclass = class of traisenode;
  105. ttryexceptnode = class(tloopnode)
  106. constructor create(l,r,_t1 : tnode);virtual;
  107. function det_resulttype:tnode;override;
  108. function pass_1 : tnode;override;
  109. end;
  110. ttryexceptnodeclass = class of ttryexceptnode;
  111. ttryfinallynode = class(tbinarynode)
  112. constructor create(l,r:tnode);virtual;
  113. function det_resulttype:tnode;override;
  114. function pass_1 : tnode;override;
  115. end;
  116. ttryfinallynodeclass = class of ttryfinallynode;
  117. tonnode = class(tbinarynode)
  118. exceptsymtable : tsymtable;
  119. excepttype : tobjectdef;
  120. constructor create(l,r:tnode);virtual;
  121. destructor destroy;override;
  122. function det_resulttype:tnode;override;
  123. function pass_1 : tnode;override;
  124. function getcopy : tnode;override;
  125. function docompare(p: tnode): boolean; override;
  126. end;
  127. tonnodeclass = class of tonnode;
  128. tfailnode = class(tnode)
  129. constructor create;virtual;
  130. function det_resulttype:tnode;override;
  131. function pass_1: tnode;override;
  132. function docompare(p: tnode): boolean; override;
  133. end;
  134. tfailnodeclass = class of tfailnode;
  135. { for compatibilty }
  136. function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
  137. var
  138. cwhilerepeatnode : twhilerepeatnodeclass;
  139. cifnode : tifnodeclass;
  140. cfornode : tfornodeclass;
  141. cexitnode : texitnodeclass;
  142. cbreaknode : tbreaknodeclass;
  143. ccontinuenode : tcontinuenodeclass;
  144. cgotonode : tgotonodeclass;
  145. clabelnode : tlabelnodeclass;
  146. craisenode : traisenodeclass;
  147. ctryexceptnode : ttryexceptnodeclass;
  148. ctryfinallynode : ttryfinallynodeclass;
  149. connode : tonnodeclass;
  150. cfailnode : tfailnodeclass;
  151. implementation
  152. uses
  153. globtype,systems,
  154. cutils,verbose,globals,
  155. symconst,symtable,types,htypechk,pass_1,
  156. ncon,nmem,nld,ncnv,nbas,tgcpu,
  157. cgbase,temp_gen
  158. ;
  159. function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
  160. var
  161. p : tnode;
  162. begin
  163. case t of
  164. ifn:
  165. p:=cifnode.create(l,r,n1);
  166. repeatn:
  167. p:=cwhilerepeatnode.create(repeatn,l,r,n1,nil);
  168. whilen:
  169. p:=cwhilerepeatnode.create(whilen,l,r,n1,nil);
  170. forn:
  171. p:=cfornode.create(l,r,n1,nil,back);
  172. end;
  173. genloopnode:=p;
  174. end;
  175. {****************************************************************************
  176. TLOOPNODE
  177. *****************************************************************************}
  178. constructor tloopnode.create(tt : tnodetype;l,r,_t1,_t2 : tnode);
  179. begin
  180. inherited create(tt,l,r);
  181. t1:=_t1;
  182. t2:=_t2;
  183. set_file_line(l);
  184. end;
  185. destructor tloopnode.destroy;
  186. begin
  187. t1.free;
  188. t2.free;
  189. inherited destroy;
  190. end;
  191. function tloopnode.getcopy : tnode;
  192. var
  193. p : tloopnode;
  194. begin
  195. p:=tloopnode(inherited getcopy);
  196. if assigned(t1) then
  197. p.t1:=t1.getcopy
  198. else
  199. p.t1:=nil;
  200. if assigned(t2) then
  201. p.t2:=t2.getcopy
  202. else
  203. p.t2:=nil;
  204. getcopy:=p;
  205. end;
  206. procedure tloopnode.insertintolist(l : tnodelist);
  207. begin
  208. end;
  209. {$ifdef extdebug}
  210. procedure tloopnode.dowrite;
  211. begin
  212. inherited dowrite;
  213. writenodeindention:=writenodeindention+' ';
  214. writenode(t1);
  215. writenode(t2);
  216. delete(writenodeindention,1,4);
  217. end;
  218. {$endif extdebug}
  219. function tloopnode.docompare(p: tnode): boolean;
  220. begin
  221. docompare :=
  222. inherited docompare(p) and
  223. t1.isequal(tloopnode(p).t1) and
  224. t2.isequal(tloopnode(p).t2);
  225. end;
  226. {****************************************************************************
  227. TWHILEREPEATNODE
  228. *****************************************************************************}
  229. function twhilerepeatnode.det_resulttype:tnode;
  230. begin
  231. result:=nil;
  232. resulttype:=voidtype;
  233. resulttypepass(left);
  234. { loop instruction }
  235. if assigned(right) then
  236. resulttypepass(right);
  237. set_varstate(left,true);
  238. if codegenerror then
  239. exit;
  240. if not is_boolean(left.resulttype.def) then
  241. begin
  242. CGMessage(type_e_mismatch);
  243. exit;
  244. end;
  245. end;
  246. function twhilerepeatnode.pass_1 : tnode;
  247. var
  248. old_t_times : longint;
  249. begin
  250. result:=nil;
  251. old_t_times:=t_times;
  252. { calc register weight }
  253. if not(cs_littlesize in aktglobalswitches ) then
  254. t_times:=t_times*8;
  255. {$ifdef newcg}
  256. tg.cleartempgen;
  257. {$else newcg}
  258. cleartempgen;
  259. {$endif newcg}
  260. firstpass(left);
  261. if codegenerror then
  262. exit;
  263. registers32:=left.registers32;
  264. registersfpu:=left.registersfpu;
  265. {$ifdef SUPPORT_MMX}
  266. registersmmx:=left.registersmmx;
  267. {$endif SUPPORT_MMX}
  268. { loop instruction }
  269. if assigned(right) then
  270. begin
  271. {$ifdef newcg}
  272. tg.cleartempgen;
  273. {$else newcg}
  274. cleartempgen;
  275. {$endif newcg}
  276. firstpass(right);
  277. if codegenerror then
  278. exit;
  279. if registers32<right.registers32 then
  280. registers32:=right.registers32;
  281. if registersfpu<right.registersfpu then
  282. registersfpu:=right.registersfpu;
  283. {$ifdef SUPPORT_MMX}
  284. if registersmmx<right.registersmmx then
  285. registersmmx:=right.registersmmx;
  286. {$endif SUPPORT_MMX}
  287. end;
  288. t_times:=old_t_times;
  289. end;
  290. {*****************************************************************************
  291. TIFNODE
  292. *****************************************************************************}
  293. constructor tifnode.create(l,r,_t1 : tnode);
  294. begin
  295. inherited create(ifn,l,r,_t1,nil);
  296. end;
  297. function tifnode.det_resulttype:tnode;
  298. begin
  299. result:=nil;
  300. resulttype:=voidtype;
  301. resulttypepass(left);
  302. { if path }
  303. if assigned(right) then
  304. resulttypepass(right);
  305. { else path }
  306. if assigned(t1) then
  307. resulttypepass(t1);
  308. set_varstate(left,true);
  309. if codegenerror then
  310. exit;
  311. if not is_boolean(left.resulttype.def) then
  312. Message1(type_e_boolean_expr_expected,left.resulttype.def.typename);
  313. end;
  314. function tifnode.pass_1 : tnode;
  315. var
  316. old_t_times : longint;
  317. hp : tnode;
  318. begin
  319. result:=nil;
  320. old_t_times:=t_times;
  321. {$ifdef newcg}
  322. tg.cleartempgen;
  323. {$else newcg}
  324. cleartempgen;
  325. {$endif newcg}
  326. firstpass(left);
  327. registers32:=left.registers32;
  328. registersfpu:=left.registersfpu;
  329. {$ifdef SUPPORT_MMX}
  330. registersmmx:=left.registersmmx;
  331. {$endif SUPPORT_MMX}
  332. { determines registers weigths }
  333. if not(cs_littlesize in aktglobalswitches) then
  334. t_times:=t_times div 2;
  335. if t_times=0 then
  336. t_times:=1;
  337. { if path }
  338. if assigned(right) then
  339. begin
  340. {$ifdef newcg}
  341. tg.cleartempgen;
  342. {$else newcg}
  343. cleartempgen;
  344. {$endif newcg}
  345. firstpass(right);
  346. if registers32<right.registers32 then
  347. registers32:=right.registers32;
  348. if registersfpu<right.registersfpu then
  349. registersfpu:=right.registersfpu;
  350. {$ifdef SUPPORT_MMX}
  351. if registersmmx<right.registersmmx then
  352. registersmmx:=right.registersmmx;
  353. {$endif SUPPORT_MMX}
  354. end;
  355. { else path }
  356. if assigned(t1) then
  357. begin
  358. {$ifdef newcg}
  359. tg.cleartempgen;
  360. {$else newcg}
  361. cleartempgen;
  362. {$endif newcg}
  363. firstpass(t1);
  364. if registers32<t1.registers32 then
  365. registers32:=t1.registers32;
  366. if registersfpu<t1.registersfpu then
  367. registersfpu:=t1.registersfpu;
  368. {$ifdef SUPPORT_MMX}
  369. if registersmmx<t1.registersmmx then
  370. registersmmx:=t1.registersmmx;
  371. {$endif SUPPORT_MMX}
  372. end;
  373. { leave if we've got an error in one of the paths }
  374. if codegenerror then
  375. exit;
  376. if left.nodetype=ordconstn then
  377. begin
  378. { optimize }
  379. if tordconstnode(left).value=1 then
  380. begin
  381. hp:=right;
  382. right:=nil;
  383. { we cannot set p to nil !!! }
  384. if assigned(hp) then
  385. result:=hp
  386. else
  387. result:=cnothingnode.create;
  388. end
  389. else
  390. begin
  391. hp:=t1;
  392. t1:=nil;
  393. { we cannot set p to nil !!! }
  394. if assigned(hp) then
  395. result:=hp
  396. else
  397. result:=cnothingnode.create;
  398. end;
  399. end;
  400. t_times:=old_t_times;
  401. end;
  402. {*****************************************************************************
  403. TFORNODE
  404. *****************************************************************************}
  405. constructor tfornode.create(l,r,_t1,_t2 : tnode;back : boolean);
  406. begin
  407. inherited create(forn,l,r,_t1,_t2);
  408. if back then
  409. include(flags,nf_backward);
  410. end;
  411. function tfornode.det_resulttype:tnode;
  412. var
  413. hp : tnode;
  414. begin
  415. result:=nil;
  416. resulttype:=voidtype;
  417. if left.nodetype<>assignn then
  418. begin
  419. CGMessage(cg_e_illegal_expression);
  420. exit;
  421. end;
  422. { save counter var }
  423. t2:=tassignmentnode(left).left.getcopy;
  424. resulttypepass(left);
  425. set_varstate(left,false);
  426. if assigned(t1) then
  427. begin
  428. resulttypepass(t1);
  429. if codegenerror then
  430. exit;
  431. end;
  432. { process count var }
  433. resulttypepass(t2);
  434. set_varstate(t2,true);
  435. if codegenerror then
  436. exit;
  437. { Check count var, record fields are also allowed in tp7 }
  438. hp:=t2;
  439. while (hp.nodetype=subscriptn) or
  440. ((hp.nodetype=vecn) and
  441. is_constintnode(tvecnode(hp).right)) do
  442. hp:=tsubscriptnode(hp).left;
  443. { we need a simple loadn, but the load must be in a global symtable or
  444. in the same lexlevel }
  445. if (hp.nodetype=funcretn) or
  446. ((hp.nodetype=loadn) and
  447. ((tloadnode(hp).symtable.symtablelevel<=1) or
  448. (tloadnode(hp).symtable.symtablelevel=lexlevel))) then
  449. begin
  450. if (hp.nodetype=loadn) and
  451. (tloadnode(hp).symtableentry.typ=varsym) then
  452. tvarsym(tloadnode(hp).symtableentry).varstate:=vs_used;
  453. if (not(is_ordinal(t2.resulttype.def)) or is_64bitint(t2.resulttype.def)) then
  454. CGMessagePos(hp.fileinfo,type_e_ordinal_expr_expected);
  455. end
  456. else
  457. CGMessagePos(hp.fileinfo,cg_e_illegal_count_var);
  458. resulttypepass(right);
  459. set_varstate(right,true);
  460. if right.nodetype<>ordconstn then
  461. inserttypeconv(right,t2.resulttype);
  462. end;
  463. function tfornode.pass_1 : tnode;
  464. var
  465. old_t_times : longint;
  466. begin
  467. result:=nil;
  468. { Calc register weight }
  469. old_t_times:=t_times;
  470. if not(cs_littlesize in aktglobalswitches) then
  471. t_times:=t_times*8;
  472. {$ifdef newcg}
  473. tg.cleartempgen;
  474. {$else newcg}
  475. cleartempgen;
  476. {$endif newcg}
  477. firstpass(left);
  478. {$ifdef newcg}
  479. tg.cleartempgen;
  480. {$else newcg}
  481. cleartempgen;
  482. {$endif newcg}
  483. if assigned(t1) then
  484. begin
  485. firstpass(t1);
  486. if codegenerror then
  487. exit;
  488. end;
  489. registers32:=t1.registers32;
  490. registersfpu:=t1.registersfpu;
  491. {$ifdef SUPPORT_MMX}
  492. registersmmx:=left.registersmmx;
  493. {$endif SUPPORT_MMX}
  494. if left.registers32>registers32 then
  495. registers32:=left.registers32;
  496. if left.registersfpu>registersfpu then
  497. registersfpu:=left.registersfpu;
  498. {$ifdef SUPPORT_MMX}
  499. if left.registersmmx>registersmmx then
  500. registersmmx:=left.registersmmx;
  501. {$endif SUPPORT_MMX}
  502. { process count var }
  503. {$ifdef newcg}
  504. tg.cleartempgen;
  505. {$else newcg}
  506. cleartempgen;
  507. {$endif newcg}
  508. firstpass(t2);
  509. if codegenerror then
  510. exit;
  511. if t2.registers32>registers32 then
  512. registers32:=t2.registers32;
  513. if t2.registersfpu>registersfpu then
  514. registersfpu:=t2.registersfpu;
  515. {$ifdef SUPPORT_MMX}
  516. if t2.registersmmx>registersmmx then
  517. registersmmx:=t2.registersmmx;
  518. {$endif SUPPORT_MMX}
  519. {$ifdef newcg}
  520. tg.cleartempgen;
  521. {$else newcg}
  522. cleartempgen;
  523. {$endif newcg}
  524. firstpass(right);
  525. if right.registers32>registers32 then
  526. registers32:=right.registers32;
  527. if right.registersfpu>registersfpu then
  528. registersfpu:=right.registersfpu;
  529. {$ifdef SUPPORT_MMX}
  530. if right.registersmmx>registersmmx then
  531. registersmmx:=right.registersmmx;
  532. {$endif SUPPORT_MMX}
  533. { we need at least one register for comparisons PM }
  534. if registers32=0 then
  535. inc(registers32);
  536. t_times:=old_t_times;
  537. end;
  538. {*****************************************************************************
  539. TEXITNODE
  540. *****************************************************************************}
  541. constructor texitnode.create(l:tnode);
  542. begin
  543. inherited create(exitn,l);
  544. end;
  545. function texitnode.det_resulttype:tnode;
  546. var
  547. pt : tnode;
  548. begin
  549. result:=nil;
  550. { Check the 2 types }
  551. if not inlining_procedure then
  552. begin
  553. if assigned(left) then
  554. begin
  555. inserttypeconv(left,aktprocsym.definition.rettype);
  556. if ret_in_param(aktprocsym.definition.rettype.def) or
  557. (procinfo^.no_fast_exit) or
  558. ((procinfo^.flags and pi_uses_exceptions)<>0) then
  559. begin
  560. pt:=cfuncretnode.create(aktprocsym.definition.funcretsym);
  561. left:=cassignmentnode.create(pt,left);
  562. end;
  563. end;
  564. end;
  565. if assigned(left) then
  566. begin
  567. resulttypepass(left);
  568. set_varstate(left,true);
  569. end;
  570. resulttype:=voidtype;
  571. end;
  572. function texitnode.pass_1 : tnode;
  573. begin
  574. result:=nil;
  575. if assigned(left) then
  576. begin
  577. firstpass(left);
  578. if codegenerror then
  579. exit;
  580. registers32:=left.registers32;
  581. registersfpu:=left.registersfpu;
  582. {$ifdef SUPPORT_MMX}
  583. registersmmx:=left.registersmmx;
  584. {$endif SUPPORT_MMX}
  585. end;
  586. end;
  587. {*****************************************************************************
  588. TBREAKNODE
  589. *****************************************************************************}
  590. constructor tbreaknode.create;
  591. begin
  592. inherited create(breakn);
  593. end;
  594. function tbreaknode.det_resulttype:tnode;
  595. begin
  596. result:=nil;
  597. resulttype:=voidtype;
  598. end;
  599. function tbreaknode.pass_1 : tnode;
  600. begin
  601. result:=nil;
  602. end;
  603. {*****************************************************************************
  604. TCONTINUENODE
  605. *****************************************************************************}
  606. constructor tcontinuenode.create;
  607. begin
  608. inherited create(continuen);
  609. end;
  610. function tcontinuenode.det_resulttype:tnode;
  611. begin
  612. result:=nil;
  613. resulttype:=voidtype;
  614. end;
  615. function tcontinuenode.pass_1 : tnode;
  616. begin
  617. result:=nil;
  618. end;
  619. {*****************************************************************************
  620. TGOTONODE
  621. *****************************************************************************}
  622. constructor tgotonode.create(p : tlabelsym);
  623. begin
  624. inherited create(goton);
  625. exceptionblock:=aktexceptblock;
  626. labsym:=p;
  627. labelnr:=p.lab;
  628. end;
  629. function tgotonode.det_resulttype:tnode;
  630. begin
  631. result:=nil;
  632. resulttype:=voidtype;
  633. end;
  634. function tgotonode.pass_1 : tnode;
  635. begin
  636. result:=nil;
  637. { check if }
  638. if assigned(labsym) and
  639. assigned(labsym.code) and
  640. (exceptionblock<>tlabelnode(labsym.code).exceptionblock) then
  641. begin
  642. writeln('goto exceptblock: ',exceptionblock);
  643. writeln('label exceptblock: ',tlabelnode(labsym.code).exceptionblock);
  644. CGMessage(cg_e_goto_inout_of_exception_block);
  645. end;
  646. end;
  647. function tgotonode.getcopy : tnode;
  648. var
  649. p : tgotonode;
  650. begin
  651. p:=tgotonode(inherited getcopy);
  652. p.labelnr:=labelnr;
  653. p.labsym:=labsym;
  654. p.exceptionblock:=exceptionblock;
  655. result:=p;
  656. end;
  657. function tgotonode.docompare(p: tnode): boolean;
  658. begin
  659. docompare := false;
  660. end;
  661. {*****************************************************************************
  662. TLABELNODE
  663. *****************************************************************************}
  664. constructor tlabelnode.createcase(p : tasmlabel;l:tnode);
  665. begin
  666. inherited create(labeln,l);
  667. { it shouldn't be possible to jump to case labels using goto }
  668. exceptionblock:=-1;
  669. labsym:=nil;
  670. labelnr:=p;
  671. end;
  672. constructor tlabelnode.create(p : tlabelsym;l:tnode);
  673. begin
  674. inherited create(labeln,l);
  675. exceptionblock:=aktexceptblock;
  676. labsym:=p;
  677. labelnr:=p.lab;
  678. { save the current labelnode in the labelsym }
  679. p.code:=self;
  680. end;
  681. function tlabelnode.det_resulttype:tnode;
  682. begin
  683. result:=nil;
  684. { left could still be unassigned }
  685. if assigned(left) then
  686. resulttypepass(left);
  687. resulttype:=voidtype;
  688. end;
  689. function tlabelnode.pass_1 : tnode;
  690. begin
  691. result:=nil;
  692. if assigned(left) then
  693. begin
  694. {$ifdef newcg}
  695. tg.cleartempgen;
  696. {$else newcg}
  697. cleartempgen;
  698. {$endif newcg}
  699. firstpass(left);
  700. registers32:=left.registers32;
  701. registersfpu:=left.registersfpu;
  702. {$ifdef SUPPORT_MMX}
  703. registersmmx:=left.registersmmx;
  704. {$endif SUPPORT_MMX}
  705. end;
  706. end;
  707. function tlabelnode.getcopy : tnode;
  708. var
  709. p : tlabelnode;
  710. begin
  711. p:=tlabelnode(inherited getcopy);
  712. p.labelnr:=labelnr;
  713. p.exceptionblock:=exceptionblock;
  714. p.labsym:=labsym;
  715. result:=p;
  716. end;
  717. function tlabelnode.docompare(p: tnode): boolean;
  718. begin
  719. docompare := false;
  720. end;
  721. {*****************************************************************************
  722. TRAISENODE
  723. *****************************************************************************}
  724. constructor traisenode.create(l,taddr,tframe:tnode);
  725. begin
  726. inherited create(raisen,l,taddr);
  727. frametree:=tframe;
  728. end;
  729. function traisenode.getcopy : tnode;
  730. var
  731. n : traisenode;
  732. begin
  733. n:=traisenode(inherited getcopy);
  734. if assigned(frametree) then
  735. n.frametree:=frametree.getcopy
  736. else
  737. n.frametree:=nil;
  738. getcopy:=n;
  739. end;
  740. procedure traisenode.insertintolist(l : tnodelist);
  741. begin
  742. end;
  743. function traisenode.det_resulttype:tnode;
  744. begin
  745. result:=nil;
  746. resulttype:=voidtype;
  747. if assigned(left) then
  748. begin
  749. { first para must be a _class_ }
  750. resulttypepass(left);
  751. set_varstate(left,true);
  752. if codegenerror then
  753. exit;
  754. if not(is_class(left.resulttype.def)) then
  755. CGMessage(type_e_mismatch);
  756. { insert needed typeconvs for addr,frame }
  757. if assigned(right) then
  758. begin
  759. { addr }
  760. resulttypepass(right);
  761. inserttypeconv(right,s32bittype);
  762. { frame }
  763. if assigned(frametree) then
  764. begin
  765. resulttypepass(frametree);
  766. inserttypeconv(frametree,s32bittype);
  767. end;
  768. end;
  769. end;
  770. end;
  771. function traisenode.pass_1 : tnode;
  772. begin
  773. result:=nil;
  774. if assigned(left) then
  775. begin
  776. { first para must be a _class_ }
  777. firstpass(left);
  778. { insert needed typeconvs for addr,frame }
  779. if assigned(right) then
  780. begin
  781. { addr }
  782. firstpass(right);
  783. { frame }
  784. if assigned(frametree) then
  785. firstpass(frametree);
  786. end;
  787. left_right_max;
  788. end;
  789. end;
  790. function traisenode.docompare(p: tnode): boolean;
  791. begin
  792. docompare := false;
  793. end;
  794. {*****************************************************************************
  795. TTRYEXCEPTNODE
  796. *****************************************************************************}
  797. constructor ttryexceptnode.create(l,r,_t1 : tnode);
  798. begin
  799. inherited create(tryexceptn,l,r,_t1,nil);
  800. end;
  801. function ttryexceptnode.det_resulttype:tnode;
  802. begin
  803. result:=nil;
  804. resulttypepass(left);
  805. { on statements }
  806. if assigned(right) then
  807. resulttypepass(right);
  808. { else block }
  809. if assigned(t1) then
  810. resulttypepass(t1);
  811. resulttype:=voidtype;
  812. end;
  813. function ttryexceptnode.pass_1 : tnode;
  814. begin
  815. result:=nil;
  816. {$ifdef newcg}
  817. tg.cleartempgen;
  818. {$else newcg}
  819. cleartempgen;
  820. {$endif newcg}
  821. firstpass(left);
  822. { on statements }
  823. if assigned(right) then
  824. begin
  825. {$ifdef newcg}
  826. tg.cleartempgen;
  827. {$else newcg}
  828. cleartempgen;
  829. {$endif newcg}
  830. firstpass(right);
  831. registers32:=max(registers32,right.registers32);
  832. registersfpu:=max(registersfpu,right.registersfpu);
  833. {$ifdef SUPPORT_MMX}
  834. registersmmx:=max(registersmmx,right.registersmmx);
  835. {$endif SUPPORT_MMX}
  836. end;
  837. { else block }
  838. if assigned(t1) then
  839. begin
  840. firstpass(t1);
  841. registers32:=max(registers32,t1.registers32);
  842. registersfpu:=max(registersfpu,t1.registersfpu);
  843. {$ifdef SUPPORT_MMX}
  844. registersmmx:=max(registersmmx,t1.registersmmx);
  845. {$endif SUPPORT_MMX}
  846. end;
  847. end;
  848. {*****************************************************************************
  849. TTRYFINALLYNODE
  850. *****************************************************************************}
  851. constructor ttryfinallynode.create(l,r:tnode);
  852. begin
  853. inherited create(tryfinallyn,l,r);
  854. end;
  855. function ttryfinallynode.det_resulttype:tnode;
  856. begin
  857. result:=nil;
  858. resulttype:=voidtype;
  859. resulttypepass(left);
  860. set_varstate(left,true);
  861. resulttypepass(right);
  862. set_varstate(right,true);
  863. end;
  864. function ttryfinallynode.pass_1 : tnode;
  865. begin
  866. result:=nil;
  867. {$ifdef newcg}
  868. tg.cleartempgen;
  869. {$else newcg}
  870. cleartempgen;
  871. {$endif newcg}
  872. firstpass(left);
  873. {$ifdef newcg}
  874. tg.cleartempgen;
  875. {$else newcg}
  876. cleartempgen;
  877. {$endif newcg}
  878. firstpass(right);
  879. left_right_max;
  880. end;
  881. {*****************************************************************************
  882. TONNODE
  883. *****************************************************************************}
  884. constructor tonnode.create(l,r:tnode);
  885. begin
  886. inherited create(onn,l,r);
  887. exceptsymtable:=nil;
  888. excepttype:=nil;
  889. end;
  890. destructor tonnode.destroy;
  891. begin
  892. if assigned(exceptsymtable) then
  893. exceptsymtable.free;
  894. inherited destroy;
  895. end;
  896. function tonnode.getcopy : tnode;
  897. var
  898. n : tonnode;
  899. begin
  900. n:=tonnode(inherited getcopy);
  901. n.exceptsymtable:=exceptsymtable;
  902. n.excepttype:=excepttype;
  903. result:=n;
  904. end;
  905. function tonnode.det_resulttype:tnode;
  906. begin
  907. result:=nil;
  908. resulttype:=voidtype;
  909. if not(is_class(excepttype)) then
  910. CGMessage(type_e_mismatch);
  911. if assigned(left) then
  912. resulttypepass(left);
  913. if assigned(right) then
  914. resulttypepass(right);
  915. end;
  916. function tonnode.pass_1 : tnode;
  917. begin
  918. result:=nil;
  919. {$ifdef newcg}
  920. tg.cleartempgen;
  921. {$else newcg}
  922. cleartempgen;
  923. {$endif newcg}
  924. registers32:=0;
  925. registersfpu:=0;
  926. {$ifdef SUPPORT_MMX}
  927. registersmmx:=0;
  928. {$endif SUPPORT_MMX}
  929. if assigned(left) then
  930. begin
  931. firstpass(left);
  932. registers32:=left.registers32;
  933. registersfpu:=left.registersfpu;
  934. {$ifdef SUPPORT_MMX}
  935. registersmmx:=left.registersmmx;
  936. {$endif SUPPORT_MMX}
  937. end;
  938. {$ifdef newcg}
  939. tg.cleartempgen;
  940. {$else newcg}
  941. cleartempgen;
  942. {$endif newcg}
  943. if assigned(right) then
  944. begin
  945. firstpass(right);
  946. registers32:=max(registers32,right.registers32);
  947. registersfpu:=max(registersfpu,right.registersfpu);
  948. {$ifdef SUPPORT_MMX}
  949. registersmmx:=max(registersmmx,right.registersmmx);
  950. {$endif SUPPORT_MMX}
  951. end;
  952. end;
  953. function tonnode.docompare(p: tnode): boolean;
  954. begin
  955. docompare := false;
  956. end;
  957. {*****************************************************************************
  958. TFAILNODE
  959. *****************************************************************************}
  960. constructor tfailnode.create;
  961. begin
  962. inherited create(failn);
  963. end;
  964. function tfailnode.det_resulttype:tnode;
  965. begin
  966. result:=nil;
  967. resulttype:=voidtype;
  968. end;
  969. function tfailnode.pass_1 : tnode;
  970. begin
  971. result:=nil;
  972. end;
  973. function tfailnode.docompare(p: tnode): boolean;
  974. begin
  975. docompare := false;
  976. end;
  977. begin
  978. cwhilerepeatnode:=twhilerepeatnode;
  979. cifnode:=tifnode;
  980. cfornode:=tfornode;
  981. cexitnode:=texitnode;
  982. cgotonode:=tgotonode;
  983. clabelnode:=tlabelnode;
  984. craisenode:=traisenode;
  985. ctryexceptnode:=ttryexceptnode;
  986. ctryfinallynode:=ttryfinallynode;
  987. connode:=tonnode;
  988. cfailnode:=tfailnode;
  989. end.
  990. {
  991. $Log$
  992. Revision 1.25 2001-10-16 15:10:35 jonas
  993. * fixed goto/label/try bugs
  994. Revision 1.24 2001/09/02 21:12:07 peter
  995. * move class of definitions into type section for delphi
  996. Revision 1.23 2001/08/30 20:56:38 peter
  997. * exit() with exceptions fix
  998. Revision 1.22 2001/08/26 13:36:40 florian
  999. * some cg reorganisation
  1000. * some PPC updates
  1001. Revision 1.21 2001/08/06 21:40:47 peter
  1002. * funcret moved from tprocinfo to tprocdef
  1003. Revision 1.20 2001/04/26 21:56:08 peter
  1004. * moved some code from exitnode.create to det_resulttype
  1005. Revision 1.19 2001/04/21 15:36:29 peter
  1006. * fixed crash with for counter
  1007. Revision 1.18 2001/04/15 09:48:30 peter
  1008. * fixed crash in labelnode
  1009. * easier detection of goto and label in try blocks
  1010. Revision 1.17 2001/04/14 14:07:10 peter
  1011. * moved more code from pass_1 to det_resulttype
  1012. Revision 1.16 2001/04/13 01:22:09 peter
  1013. * symtable change to classes
  1014. * range check generation and errors fixed, make cycle DEBUG=1 works
  1015. * memory leaks fixed
  1016. Revision 1.15 2001/04/02 21:20:30 peter
  1017. * resulttype rewrite
  1018. Revision 1.14 2001/03/25 12:27:59 peter
  1019. * set funcret to assigned (merged)
  1020. Revision 1.13 2001/02/26 19:44:53 peter
  1021. * merged generic m68k updates from fixes branch
  1022. Revision 1.12 2000/12/31 11:14:10 jonas
  1023. + implemented/fixed docompare() mathods for all nodes (not tested)
  1024. + nopt.pas, nadd.pas, i386/n386opt.pas: optimized nodes for adding strings
  1025. and constant strings/chars together
  1026. * n386add.pas: don't copy temp strings (of size 256) to another temp string
  1027. when adding
  1028. Revision 1.11 2000/11/29 00:30:33 florian
  1029. * unused units removed from uses clause
  1030. * some changes for widestrings
  1031. Revision 1.10 2000/11/04 14:25:20 florian
  1032. + merged Attila's changes for interfaces, not tested yet
  1033. Revision 1.9 2000/10/31 22:02:48 peter
  1034. * symtable splitted, no real code changes
  1035. Revision 1.8 2000/10/21 18:16:11 florian
  1036. * a lot of changes:
  1037. - basic dyn. array support
  1038. - basic C++ support
  1039. - some work for interfaces done
  1040. ....
  1041. Revision 1.7 2000/10/14 21:52:55 peter
  1042. * fixed memory leaks
  1043. Revision 1.6 2000/10/14 10:14:50 peter
  1044. * moehrendorf oct 2000 rewrite
  1045. Revision 1.5 2000/10/01 19:48:24 peter
  1046. * lot of compile updates for cg11
  1047. Revision 1.4 2000/09/28 19:49:52 florian
  1048. *** empty log message ***
  1049. Revision 1.3 2000/09/24 21:15:34 florian
  1050. * some errors fix to get more stuff compilable
  1051. Revision 1.2 2000/09/24 15:06:19 peter
  1052. * use defines.inc
  1053. Revision 1.1 2000/09/22 22:46:03 florian
  1054. + initial revision
  1055. }