nflw.pas 33 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243
  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 (hp.nodetype=loadn) and
  443. (tloadnode(hp).symtableentry.typ=varsym) then
  444. tvarsym(tloadnode(hp).symtableentry).varstate:=vs_used;
  445. if (not(is_ordinal(t2.resulttype.def)) or is_64bitint(t2.resulttype.def)) then
  446. CGMessagePos(hp.fileinfo,type_e_ordinal_expr_expected);
  447. end
  448. else
  449. CGMessagePos(hp.fileinfo,cg_e_illegal_count_var);
  450. resulttypepass(right);
  451. set_varstate(right,true);
  452. if right.nodetype<>ordconstn then
  453. inserttypeconv(right,t2.resulttype);
  454. end;
  455. function tfornode.pass_1 : tnode;
  456. var
  457. old_t_times : longint;
  458. begin
  459. result:=nil;
  460. { Calc register weight }
  461. old_t_times:=t_times;
  462. if not(cs_littlesize in aktglobalswitches) then
  463. t_times:=t_times*8;
  464. {$ifdef newcg}
  465. tg.cleartempgen;
  466. {$else newcg}
  467. cleartempgen;
  468. {$endif newcg}
  469. firstpass(left);
  470. {$ifdef newcg}
  471. tg.cleartempgen;
  472. {$else newcg}
  473. cleartempgen;
  474. {$endif newcg}
  475. if assigned(t1) then
  476. begin
  477. firstpass(t1);
  478. if codegenerror then
  479. exit;
  480. end;
  481. registers32:=t1.registers32;
  482. registersfpu:=t1.registersfpu;
  483. {$ifdef SUPPORT_MMX}
  484. registersmmx:=left.registersmmx;
  485. {$endif SUPPORT_MMX}
  486. if left.registers32>registers32 then
  487. registers32:=left.registers32;
  488. if left.registersfpu>registersfpu then
  489. registersfpu:=left.registersfpu;
  490. {$ifdef SUPPORT_MMX}
  491. if left.registersmmx>registersmmx then
  492. registersmmx:=left.registersmmx;
  493. {$endif SUPPORT_MMX}
  494. { process count var }
  495. {$ifdef newcg}
  496. tg.cleartempgen;
  497. {$else newcg}
  498. cleartempgen;
  499. {$endif newcg}
  500. firstpass(t2);
  501. if codegenerror then
  502. exit;
  503. if t2.registers32>registers32 then
  504. registers32:=t2.registers32;
  505. if t2.registersfpu>registersfpu then
  506. registersfpu:=t2.registersfpu;
  507. {$ifdef SUPPORT_MMX}
  508. if t2.registersmmx>registersmmx then
  509. registersmmx:=t2.registersmmx;
  510. {$endif SUPPORT_MMX}
  511. {$ifdef newcg}
  512. tg.cleartempgen;
  513. {$else newcg}
  514. cleartempgen;
  515. {$endif newcg}
  516. firstpass(right);
  517. if right.registers32>registers32 then
  518. registers32:=right.registers32;
  519. if right.registersfpu>registersfpu then
  520. registersfpu:=right.registersfpu;
  521. {$ifdef SUPPORT_MMX}
  522. if right.registersmmx>registersmmx then
  523. registersmmx:=right.registersmmx;
  524. {$endif SUPPORT_MMX}
  525. { we need at least one register for comparisons PM }
  526. if registers32=0 then
  527. inc(registers32);
  528. t_times:=old_t_times;
  529. end;
  530. {*****************************************************************************
  531. TEXITNODE
  532. *****************************************************************************}
  533. constructor texitnode.create(l:tnode);
  534. begin
  535. inherited create(exitn,l);
  536. end;
  537. function texitnode.det_resulttype:tnode;
  538. var
  539. pt : tnode;
  540. begin
  541. result:=nil;
  542. { Check the 2 types }
  543. if assigned(left) then
  544. begin
  545. inserttypeconv(left,procinfo^.returntype);
  546. if ret_in_param(procinfo^.returntype.def) or procinfo^.no_fast_exit then
  547. begin
  548. pt:=cfuncretnode.create(procinfo);
  549. left:=cassignmentnode.create(pt,left);
  550. end;
  551. end;
  552. if assigned(left) then
  553. begin
  554. resulttypepass(left);
  555. set_varstate(left,true);
  556. procinfo^.funcret_state:=vs_assigned;
  557. end;
  558. resulttype:=voidtype;
  559. end;
  560. function texitnode.pass_1 : tnode;
  561. begin
  562. result:=nil;
  563. if assigned(left) then
  564. begin
  565. firstpass(left);
  566. if codegenerror then
  567. exit;
  568. registers32:=left.registers32;
  569. registersfpu:=left.registersfpu;
  570. {$ifdef SUPPORT_MMX}
  571. registersmmx:=left.registersmmx;
  572. {$endif SUPPORT_MMX}
  573. end;
  574. end;
  575. {*****************************************************************************
  576. TBREAKNODE
  577. *****************************************************************************}
  578. constructor tbreaknode.create;
  579. begin
  580. inherited create(breakn);
  581. end;
  582. function tbreaknode.det_resulttype:tnode;
  583. begin
  584. result:=nil;
  585. resulttype:=voidtype;
  586. end;
  587. function tbreaknode.pass_1 : tnode;
  588. begin
  589. result:=nil;
  590. end;
  591. {*****************************************************************************
  592. TCONTINUENODE
  593. *****************************************************************************}
  594. constructor tcontinuenode.create;
  595. begin
  596. inherited create(continuen);
  597. end;
  598. function tcontinuenode.det_resulttype:tnode;
  599. begin
  600. result:=nil;
  601. resulttype:=voidtype;
  602. end;
  603. function tcontinuenode.pass_1 : tnode;
  604. begin
  605. result:=nil;
  606. end;
  607. {*****************************************************************************
  608. TGOTONODE
  609. *****************************************************************************}
  610. constructor tgotonode.create(p : tlabelsym);
  611. begin
  612. inherited create(goton);
  613. if statement_level>1 then
  614. exceptionblock:=aktexceptblock
  615. else
  616. exceptionblock:=0;
  617. labsym:=p;
  618. labelnr:=p.lab;
  619. end;
  620. function tgotonode.det_resulttype:tnode;
  621. begin
  622. result:=nil;
  623. resulttype:=voidtype;
  624. end;
  625. function tgotonode.pass_1 : tnode;
  626. begin
  627. result:=nil;
  628. { check if }
  629. if assigned(labsym) and
  630. assigned(labsym.code) and
  631. (exceptionblock<>tlabelnode(labsym.code).exceptionblock) then
  632. CGMessage(cg_e_goto_inout_of_exception_block);
  633. end;
  634. function tgotonode.getcopy : tnode;
  635. var
  636. p : tgotonode;
  637. begin
  638. p:=tgotonode(inherited getcopy);
  639. p.labelnr:=labelnr;
  640. p.labsym:=labsym;
  641. p.exceptionblock:=exceptionblock;
  642. result:=p;
  643. end;
  644. function tgotonode.docompare(p: tnode): boolean;
  645. begin
  646. docompare := false;
  647. end;
  648. {*****************************************************************************
  649. TLABELNODE
  650. *****************************************************************************}
  651. constructor tlabelnode.createcase(p : tasmlabel;l:tnode);
  652. begin
  653. inherited create(labeln,l);
  654. { it shouldn't be possible to jump to case labels using goto }
  655. exceptionblock:=-1;
  656. labsym:=nil;
  657. labelnr:=p;
  658. end;
  659. constructor tlabelnode.create(p : tlabelsym;l:tnode);
  660. begin
  661. inherited create(labeln,l);
  662. if statement_level>1 then
  663. exceptionblock:=aktexceptblock
  664. else
  665. exceptionblock:=0;
  666. labsym:=p;
  667. labelnr:=p.lab;
  668. { save the current labelnode in the labelsym }
  669. p.code:=self;
  670. end;
  671. function tlabelnode.det_resulttype:tnode;
  672. begin
  673. result:=nil;
  674. { left could still be unassigned }
  675. if assigned(left) then
  676. resulttypepass(left);
  677. resulttype:=voidtype;
  678. end;
  679. function tlabelnode.pass_1 : tnode;
  680. begin
  681. result:=nil;
  682. if assigned(left) then
  683. begin
  684. {$ifdef newcg}
  685. tg.cleartempgen;
  686. {$else newcg}
  687. cleartempgen;
  688. {$endif newcg}
  689. firstpass(left);
  690. registers32:=left.registers32;
  691. registersfpu:=left.registersfpu;
  692. {$ifdef SUPPORT_MMX}
  693. registersmmx:=left.registersmmx;
  694. {$endif SUPPORT_MMX}
  695. end;
  696. end;
  697. function tlabelnode.getcopy : tnode;
  698. var
  699. p : tlabelnode;
  700. begin
  701. p:=tlabelnode(inherited getcopy);
  702. p.labelnr:=labelnr;
  703. p.exceptionblock:=exceptionblock;
  704. p.labsym:=labsym;
  705. result:=p;
  706. end;
  707. function tlabelnode.docompare(p: tnode): boolean;
  708. begin
  709. docompare := false;
  710. end;
  711. {*****************************************************************************
  712. TRAISENODE
  713. *****************************************************************************}
  714. constructor traisenode.create(l,taddr,tframe:tnode);
  715. begin
  716. inherited create(raisen,l,taddr);
  717. frametree:=tframe;
  718. end;
  719. function traisenode.getcopy : tnode;
  720. var
  721. n : traisenode;
  722. begin
  723. n:=traisenode(inherited getcopy);
  724. if assigned(frametree) then
  725. n.frametree:=frametree.getcopy
  726. else
  727. n.frametree:=nil;
  728. getcopy:=n;
  729. end;
  730. procedure traisenode.insertintolist(l : tnodelist);
  731. begin
  732. end;
  733. function traisenode.det_resulttype:tnode;
  734. begin
  735. result:=nil;
  736. resulttype:=voidtype;
  737. if assigned(left) then
  738. begin
  739. { first para must be a _class_ }
  740. resulttypepass(left);
  741. set_varstate(left,true);
  742. if codegenerror then
  743. exit;
  744. if not(is_class(left.resulttype.def)) then
  745. CGMessage(type_e_mismatch);
  746. { insert needed typeconvs for addr,frame }
  747. if assigned(right) then
  748. begin
  749. { addr }
  750. resulttypepass(right);
  751. inserttypeconv(right,s32bittype);
  752. { frame }
  753. if assigned(frametree) then
  754. begin
  755. resulttypepass(frametree);
  756. inserttypeconv(frametree,s32bittype);
  757. end;
  758. end;
  759. end;
  760. end;
  761. function traisenode.pass_1 : tnode;
  762. begin
  763. result:=nil;
  764. if assigned(left) then
  765. begin
  766. { first para must be a _class_ }
  767. firstpass(left);
  768. { insert needed typeconvs for addr,frame }
  769. if assigned(right) then
  770. begin
  771. { addr }
  772. firstpass(right);
  773. { frame }
  774. if assigned(frametree) then
  775. firstpass(frametree);
  776. end;
  777. left_right_max;
  778. end;
  779. end;
  780. function traisenode.docompare(p: tnode): boolean;
  781. begin
  782. docompare := false;
  783. end;
  784. {*****************************************************************************
  785. TTRYEXCEPTNODE
  786. *****************************************************************************}
  787. constructor ttryexceptnode.create(l,r,_t1 : tnode);
  788. begin
  789. inherited create(tryexceptn,l,r,_t1,nil);
  790. end;
  791. function ttryexceptnode.det_resulttype:tnode;
  792. begin
  793. result:=nil;
  794. resulttypepass(left);
  795. { on statements }
  796. if assigned(right) then
  797. resulttypepass(right);
  798. { else block }
  799. if assigned(t1) then
  800. resulttypepass(t1);
  801. resulttype:=voidtype;
  802. end;
  803. function ttryexceptnode.pass_1 : tnode;
  804. begin
  805. result:=nil;
  806. {$ifdef newcg}
  807. tg.cleartempgen;
  808. {$else newcg}
  809. cleartempgen;
  810. {$endif newcg}
  811. firstpass(left);
  812. { on statements }
  813. if assigned(right) then
  814. begin
  815. {$ifdef newcg}
  816. tg.cleartempgen;
  817. {$else newcg}
  818. cleartempgen;
  819. {$endif newcg}
  820. firstpass(right);
  821. registers32:=max(registers32,right.registers32);
  822. registersfpu:=max(registersfpu,right.registersfpu);
  823. {$ifdef SUPPORT_MMX}
  824. registersmmx:=max(registersmmx,right.registersmmx);
  825. {$endif SUPPORT_MMX}
  826. end;
  827. { else block }
  828. if assigned(t1) then
  829. begin
  830. firstpass(t1);
  831. registers32:=max(registers32,t1.registers32);
  832. registersfpu:=max(registersfpu,t1.registersfpu);
  833. {$ifdef SUPPORT_MMX}
  834. registersmmx:=max(registersmmx,t1.registersmmx);
  835. {$endif SUPPORT_MMX}
  836. end;
  837. end;
  838. {*****************************************************************************
  839. TTRYFINALLYNODE
  840. *****************************************************************************}
  841. constructor ttryfinallynode.create(l,r:tnode);
  842. begin
  843. inherited create(tryfinallyn,l,r);
  844. end;
  845. function ttryfinallynode.det_resulttype:tnode;
  846. begin
  847. result:=nil;
  848. resulttype:=voidtype;
  849. resulttypepass(left);
  850. set_varstate(left,true);
  851. resulttypepass(right);
  852. set_varstate(right,true);
  853. end;
  854. function ttryfinallynode.pass_1 : tnode;
  855. begin
  856. result:=nil;
  857. {$ifdef newcg}
  858. tg.cleartempgen;
  859. {$else newcg}
  860. cleartempgen;
  861. {$endif newcg}
  862. firstpass(left);
  863. {$ifdef newcg}
  864. tg.cleartempgen;
  865. {$else newcg}
  866. cleartempgen;
  867. {$endif newcg}
  868. firstpass(right);
  869. left_right_max;
  870. end;
  871. {*****************************************************************************
  872. TONNODE
  873. *****************************************************************************}
  874. constructor tonnode.create(l,r:tnode);
  875. begin
  876. inherited create(onn,l,r);
  877. exceptsymtable:=nil;
  878. excepttype:=nil;
  879. end;
  880. destructor tonnode.destroy;
  881. begin
  882. if assigned(exceptsymtable) then
  883. exceptsymtable.free;
  884. inherited destroy;
  885. end;
  886. function tonnode.getcopy : tnode;
  887. var
  888. n : tonnode;
  889. begin
  890. n:=tonnode(inherited getcopy);
  891. n.exceptsymtable:=exceptsymtable;
  892. n.excepttype:=excepttype;
  893. result:=n;
  894. end;
  895. function tonnode.det_resulttype:tnode;
  896. begin
  897. result:=nil;
  898. resulttype:=voidtype;
  899. if not(is_class(excepttype)) then
  900. CGMessage(type_e_mismatch);
  901. if assigned(left) then
  902. resulttypepass(left);
  903. if assigned(right) then
  904. resulttypepass(right);
  905. end;
  906. function tonnode.pass_1 : tnode;
  907. begin
  908. result:=nil;
  909. {$ifdef newcg}
  910. tg.cleartempgen;
  911. {$else newcg}
  912. cleartempgen;
  913. {$endif newcg}
  914. registers32:=0;
  915. registersfpu:=0;
  916. {$ifdef SUPPORT_MMX}
  917. registersmmx:=0;
  918. {$endif SUPPORT_MMX}
  919. if assigned(left) then
  920. begin
  921. firstpass(left);
  922. registers32:=left.registers32;
  923. registersfpu:=left.registersfpu;
  924. {$ifdef SUPPORT_MMX}
  925. registersmmx:=left.registersmmx;
  926. {$endif SUPPORT_MMX}
  927. end;
  928. {$ifdef newcg}
  929. tg.cleartempgen;
  930. {$else newcg}
  931. cleartempgen;
  932. {$endif newcg}
  933. if assigned(right) then
  934. begin
  935. firstpass(right);
  936. registers32:=max(registers32,right.registers32);
  937. registersfpu:=max(registersfpu,right.registersfpu);
  938. {$ifdef SUPPORT_MMX}
  939. registersmmx:=max(registersmmx,right.registersmmx);
  940. {$endif SUPPORT_MMX}
  941. end;
  942. end;
  943. function tonnode.docompare(p: tnode): boolean;
  944. begin
  945. docompare := false;
  946. end;
  947. {*****************************************************************************
  948. TFAILNODE
  949. *****************************************************************************}
  950. constructor tfailnode.create;
  951. begin
  952. inherited create(failn);
  953. end;
  954. function tfailnode.det_resulttype:tnode;
  955. begin
  956. result:=nil;
  957. resulttype:=voidtype;
  958. end;
  959. function tfailnode.pass_1 : tnode;
  960. begin
  961. result:=nil;
  962. end;
  963. function tfailnode.docompare(p: tnode): boolean;
  964. begin
  965. docompare := false;
  966. end;
  967. begin
  968. cwhilerepeatnode:=twhilerepeatnode;
  969. cifnode:=tifnode;
  970. cfornode:=tfornode;
  971. cexitnode:=texitnode;
  972. cgotonode:=tgotonode;
  973. clabelnode:=tlabelnode;
  974. craisenode:=traisenode;
  975. ctryexceptnode:=ttryexceptnode;
  976. ctryfinallynode:=ttryfinallynode;
  977. connode:=tonnode;
  978. cfailnode:=tfailnode;
  979. end.
  980. {
  981. $Log$
  982. Revision 1.20 2001-04-26 21:56:08 peter
  983. * moved some code from exitnode.create to det_resulttype
  984. Revision 1.19 2001/04/21 15:36:29 peter
  985. * fixed crash with for counter
  986. Revision 1.18 2001/04/15 09:48:30 peter
  987. * fixed crash in labelnode
  988. * easier detection of goto and label in try blocks
  989. Revision 1.17 2001/04/14 14:07:10 peter
  990. * moved more code from pass_1 to det_resulttype
  991. Revision 1.16 2001/04/13 01:22:09 peter
  992. * symtable change to classes
  993. * range check generation and errors fixed, make cycle DEBUG=1 works
  994. * memory leaks fixed
  995. Revision 1.15 2001/04/02 21:20:30 peter
  996. * resulttype rewrite
  997. Revision 1.14 2001/03/25 12:27:59 peter
  998. * set funcret to assigned (merged)
  999. Revision 1.13 2001/02/26 19:44:53 peter
  1000. * merged generic m68k updates from fixes branch
  1001. Revision 1.12 2000/12/31 11:14:10 jonas
  1002. + implemented/fixed docompare() mathods for all nodes (not tested)
  1003. + nopt.pas, nadd.pas, i386/n386opt.pas: optimized nodes for adding strings
  1004. and constant strings/chars together
  1005. * n386add.pas: don't copy temp strings (of size 256) to another temp string
  1006. when adding
  1007. Revision 1.11 2000/11/29 00:30:33 florian
  1008. * unused units removed from uses clause
  1009. * some changes for widestrings
  1010. Revision 1.10 2000/11/04 14:25:20 florian
  1011. + merged Attila's changes for interfaces, not tested yet
  1012. Revision 1.9 2000/10/31 22:02:48 peter
  1013. * symtable splitted, no real code changes
  1014. Revision 1.8 2000/10/21 18:16:11 florian
  1015. * a lot of changes:
  1016. - basic dyn. array support
  1017. - basic C++ support
  1018. - some work for interfaces done
  1019. ....
  1020. Revision 1.7 2000/10/14 21:52:55 peter
  1021. * fixed memory leaks
  1022. Revision 1.6 2000/10/14 10:14:50 peter
  1023. * moehrendorf oct 2000 rewrite
  1024. Revision 1.5 2000/10/01 19:48:24 peter
  1025. * lot of compile updates for cg11
  1026. Revision 1.4 2000/09/28 19:49:52 florian
  1027. *** empty log message ***
  1028. Revision 1.3 2000/09/24 21:15:34 florian
  1029. * some errors fix to get more stuff compilable
  1030. Revision 1.2 2000/09/24 15:06:19 peter
  1031. * use defines.inc
  1032. Revision 1.1 2000/09/22 22:46:03 florian
  1033. + initial revision
  1034. }