nflw.pas 33 KB

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