nflw.pas 34 KB

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