psub.pas 58 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl, Daniel Mantione
  4. Does the parsing and codegeneration at subroutine level
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit psub;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. cclasses,
  23. node,
  24. symdef,cgbase;
  25. type
  26. tcgprocinfo=class(tprocinfo)
  27. { code for the subroutine as tree }
  28. code : tnode;
  29. { positions in the tree for init/final }
  30. initasmnode,
  31. finalasmnode : tnode;
  32. { list to store the procinfo's of the nested procedures }
  33. nestedprocs : tlinkedlist;
  34. constructor create(aparent:tprocinfo);override;
  35. destructor destroy;override;
  36. procedure generate_code;
  37. procedure resetprocdef;
  38. procedure add_to_symtablestack;
  39. procedure remove_from_symtablestack;
  40. procedure parse_body;
  41. end;
  42. procedure printnode_reset;
  43. { reads the declaration blocks }
  44. procedure read_declarations(islibrary : boolean);
  45. { reads declarations in the interface part of a unit }
  46. procedure read_interface_declarations;
  47. implementation
  48. uses
  49. { common }
  50. cutils,
  51. { global }
  52. globtype,globals,tokens,verbose,comphook,
  53. systems,
  54. { aasm }
  55. cpubase,cpuinfo,aasmbase,aasmtai,
  56. { symtable }
  57. symconst,symbase,symsym,symtype,symtable,defutil,
  58. paramgr,
  59. ppu,fmodule,
  60. { pass 1 }
  61. nutils,nbas,nld,ncal,ncon,nflw,nadd,ncnv,nmem,
  62. pass_1,
  63. {$ifdef state_tracking}
  64. nstate,
  65. {$endif state_tracking}
  66. { pass 2 }
  67. {$ifndef NOPASS2}
  68. pass_2,
  69. {$endif}
  70. { parser }
  71. scanner,
  72. pbase,pstatmnt,pdecl,pdecsub,pexports,
  73. { codegen }
  74. tgobj,rgobj,
  75. ncgutil
  76. {$ifndef NOOPT}
  77. {$ifdef i386}
  78. ,aopt386
  79. {$else i386}
  80. ,aoptcpu
  81. {$endif i386}
  82. {$endif}
  83. ;
  84. {****************************************************************************
  85. PROCEDURE/FUNCTION BODY PARSING
  86. ****************************************************************************}
  87. procedure initializevars(p:tnamedindexitem;arg:pointer);
  88. var
  89. b : tblocknode;
  90. begin
  91. if tsym(p).typ<>varsym then
  92. exit;
  93. with tvarsym(p) do
  94. begin
  95. if assigned(defaultconstsym) then
  96. begin
  97. b:=tblocknode(arg);
  98. b.left:=cstatementnode.create(
  99. cassignmentnode.create(
  100. cloadnode.create(tsym(p),tsym(p).owner),
  101. cloadnode.create(defaultconstsym,defaultconstsym.owner)),
  102. b.left);
  103. end;
  104. end;
  105. end;
  106. function block(islibrary : boolean) : tnode;
  107. begin
  108. { parse const,types and vars }
  109. read_declarations(islibrary);
  110. current_procinfo.handle_body_start;
  111. { do we have an assembler block without the po_assembler?
  112. we should allow this for Delphi compatibility (PFV) }
  113. if (token=_ASM) and (m_delphi in aktmodeswitches) then
  114. include(current_procinfo.procdef.procoptions,po_assembler);
  115. { Handle assembler block different }
  116. if (po_assembler in current_procinfo.procdef.procoptions) then
  117. begin
  118. block:=assembler_block;
  119. exit;
  120. end;
  121. {Unit initialization?.}
  122. if (
  123. assigned(current_procinfo.procdef.localst) and
  124. (current_procinfo.procdef.localst.symtablelevel=main_program_level) and
  125. (current_module.is_unit)
  126. ) or
  127. islibrary then
  128. begin
  129. if (token=_END) then
  130. begin
  131. consume(_END);
  132. { We need at least a node, else the entry/exit code is not
  133. generated and thus no PASCALMAIN symbol which we need (PFV) }
  134. if islibrary then
  135. block:=cnothingnode.create
  136. else
  137. block:=nil;
  138. end
  139. else
  140. begin
  141. if token=_INITIALIZATION then
  142. begin
  143. { The library init code is already called and does not
  144. need to be in the initfinal table (PFV) }
  145. if not islibrary then
  146. current_module.flags:=current_module.flags or uf_init;
  147. block:=statement_block(_INITIALIZATION);
  148. end
  149. else if (token=_FINALIZATION) then
  150. begin
  151. if (current_module.flags and uf_finalize)<>0 then
  152. block:=statement_block(_FINALIZATION)
  153. else
  154. begin
  155. { can we allow no INITIALIZATION for DLL ??
  156. I think it should work PM }
  157. block:=nil;
  158. exit;
  159. end;
  160. end
  161. else
  162. begin
  163. { The library init code is already called and does not
  164. need to be in the initfinal table (PFV) }
  165. if not islibrary then
  166. current_module.flags:=current_module.flags or uf_init;
  167. block:=statement_block(_BEGIN);
  168. end;
  169. end;
  170. end
  171. else
  172. begin
  173. block:=statement_block(_BEGIN);
  174. if symtablestack.symtabletype=localsymtable then
  175. symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}initializevars,block);
  176. end;
  177. if (current_procinfo.procdef.localst.symtablelevel=main_program_level) and
  178. (not current_module.is_unit) then
  179. begin
  180. { there's always a call to FPC_DO_EXIT in the main program }
  181. include(current_procinfo.flags,pi_do_call);
  182. end;
  183. if ([cs_check_range,cs_check_overflow] * aktlocalswitches <> []) then
  184. include(current_procinfo.flags,pi_do_call);
  185. end;
  186. {****************************************************************************
  187. PROCEDURE/FUNCTION COMPILING
  188. ****************************************************************************}
  189. procedure printnode_reset;
  190. begin
  191. assign(printnodefile,treelogfilename);
  192. {$I-}
  193. rewrite(printnodefile);
  194. {$I+}
  195. if ioresult<>0 then
  196. begin
  197. Comment(V_Error,'Error creating '+treelogfilename);
  198. exit;
  199. end;
  200. close(printnodefile);
  201. end;
  202. procedure printnode_procdef(pd:tprocdef);
  203. begin
  204. assign(printnodefile,treelogfilename);
  205. {$I-}
  206. append(printnodefile);
  207. if ioresult<>0 then
  208. rewrite(printnodefile);
  209. {$I+}
  210. if ioresult<>0 then
  211. begin
  212. Comment(V_Error,'Error creating '+treelogfilename);
  213. exit;
  214. end;
  215. writeln(printnodefile);
  216. writeln(printnodefile,'*******************************************************************************');
  217. writeln(printnodefile,current_procinfo.procdef.fullprocname(false));
  218. writeln(printnodefile,'*******************************************************************************');
  219. printnode(printnodefile,pd.code);
  220. close(printnodefile);
  221. end;
  222. function generate_initialize_block:tnode;
  223. var
  224. srsym : tsym;
  225. para : tcallparanode;
  226. newstatement : tstatementnode;
  227. htype : ttype;
  228. begin
  229. result:=internalstatements(newstatement,true);
  230. { temp/para/locals initialize code will be inserted here }
  231. tcgprocinfo(current_procinfo).initasmnode:=casmnode.create_get_position;
  232. addstatement(newstatement,tcgprocinfo(current_procinfo).initasmnode);
  233. if assigned(current_procinfo.procdef._class) then
  234. begin
  235. { a constructor needs a help procedure }
  236. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  237. begin
  238. if is_class(current_procinfo.procdef._class) then
  239. begin
  240. if (cs_implicit_exceptions in aktmoduleswitches) then
  241. include(current_procinfo.flags,pi_needs_implicit_finally);
  242. srsym:=search_class_member(current_procinfo.procdef._class,'NEWINSTANCE');
  243. if assigned(srsym) and
  244. (srsym.typ=procsym) then
  245. begin
  246. { if vmt<>0 then newinstance }
  247. addstatement(newstatement,cifnode.create(
  248. caddnode.create(unequaln,
  249. load_vmt_pointer_node,
  250. cnilnode.create),
  251. cassignmentnode.create(
  252. ctypeconvnode.create_explicit(
  253. load_self_pointer_node,
  254. voidpointertype),
  255. ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_vmt_pointer_node)),
  256. nil));
  257. end
  258. else
  259. internalerror(200305108);
  260. end
  261. else
  262. if is_object(current_procinfo.procdef._class) then
  263. begin
  264. htype.setdef(current_procinfo.procdef._class);
  265. htype.setdef(tpointerdef.create(htype));
  266. { parameter 3 : vmt_offset }
  267. { parameter 2 : address of pointer to vmt,
  268. this is required to allow setting the vmt to -1 to indicate
  269. that memory was allocated }
  270. { parameter 1 : self pointer }
  271. para:=ccallparanode.create(
  272. cordconstnode.create(current_procinfo.procdef._class.vmt_offset,s32bittype,false),
  273. ccallparanode.create(
  274. ctypeconvnode.create_explicit(
  275. load_vmt_pointer_node,
  276. voidpointertype),
  277. ccallparanode.create(
  278. ctypeconvnode.create_explicit(
  279. load_self_pointer_node,
  280. voidpointertype),
  281. nil)));
  282. addstatement(newstatement,cassignmentnode.create(
  283. ctypeconvnode.create_explicit(
  284. load_self_pointer_node,
  285. voidpointertype),
  286. ccallnode.createintern('fpc_help_constructor',para)));
  287. end
  288. else
  289. internalerror(200305103);
  290. { if self=nil then exit
  291. calling fail instead of exit is useless because
  292. there is nothing to dispose (PFV) }
  293. addstatement(newstatement,cifnode.create(
  294. caddnode.create(equaln,
  295. load_self_pointer_node,
  296. cnilnode.create),
  297. cexitnode.create(nil),
  298. nil));
  299. end;
  300. { maybe call BeforeDestruction for classes }
  301. if (current_procinfo.procdef.proctypeoption=potype_destructor) and
  302. is_class(current_procinfo.procdef._class) then
  303. begin
  304. srsym:=search_class_member(current_procinfo.procdef._class,'BEFOREDESTRUCTION');
  305. if assigned(srsym) and
  306. (srsym.typ=procsym) then
  307. begin
  308. { if vmt<>0 then beforedestruction }
  309. addstatement(newstatement,cifnode.create(
  310. caddnode.create(unequaln,
  311. load_vmt_pointer_node,
  312. cnilnode.create),
  313. ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
  314. nil));
  315. end
  316. else
  317. internalerror(200305104);
  318. end;
  319. end;
  320. end;
  321. function generate_finalize_block:tnode;
  322. begin
  323. { temp/para/locals finalize code will be inserted here }
  324. tcgprocinfo(current_procinfo).finalasmnode:=casmnode.create_get_position;
  325. result:=tcgprocinfo(current_procinfo).finalasmnode;
  326. end;
  327. function generate_entry_block:tnode;
  328. begin
  329. result:=cnothingnode.create;
  330. end;
  331. function generate_exit_block:tnode;
  332. var
  333. srsym : tsym;
  334. para : tcallparanode;
  335. newstatement : tstatementnode;
  336. begin
  337. generate_exit_block:=internalstatements(newstatement,true);
  338. if assigned(current_procinfo.procdef._class) then
  339. begin
  340. { maybe call AfterConstruction for classes }
  341. if (current_procinfo.procdef.proctypeoption=potype_constructor) and
  342. is_class(current_procinfo.procdef._class) then
  343. begin
  344. srsym:=search_class_member(current_procinfo.procdef._class,'AFTERCONSTRUCTION');
  345. if assigned(srsym) and
  346. (srsym.typ=procsym) then
  347. begin
  348. { if vmt<>0 then afterconstruction }
  349. addstatement(newstatement,cifnode.create(
  350. caddnode.create(unequaln,
  351. load_vmt_pointer_node,
  352. cnilnode.create),
  353. ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
  354. nil));
  355. end
  356. else
  357. internalerror(200305106);
  358. end;
  359. { a destructor needs a help procedure }
  360. if (current_procinfo.procdef.proctypeoption=potype_destructor) then
  361. begin
  362. if is_class(current_procinfo.procdef._class) then
  363. begin
  364. srsym:=search_class_member(current_procinfo.procdef._class,'FREEINSTANCE');
  365. if assigned(srsym) and
  366. (srsym.typ=procsym) then
  367. begin
  368. { if self<>0 and vmt=1 then freeinstance }
  369. addstatement(newstatement,cifnode.create(
  370. caddnode.create(andn,
  371. caddnode.create(unequaln,
  372. load_self_pointer_node,
  373. cnilnode.create),
  374. caddnode.create(equaln,
  375. ctypeconvnode.create(
  376. load_vmt_pointer_node,
  377. voidpointertype),
  378. cpointerconstnode.create(1,voidpointertype))),
  379. ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
  380. nil));
  381. end
  382. else
  383. internalerror(200305108);
  384. end
  385. else
  386. if is_object(current_procinfo.procdef._class) then
  387. begin
  388. { finalize object data }
  389. if current_procinfo.procdef._class.needs_inittable then
  390. addstatement(newstatement,finalize_data_node(load_self_node));
  391. { parameter 3 : vmt_offset }
  392. { parameter 2 : pointer to vmt }
  393. { parameter 1 : self pointer }
  394. para:=ccallparanode.create(
  395. cordconstnode.create(current_procinfo.procdef._class.vmt_offset,s32bittype,false),
  396. ccallparanode.create(
  397. ctypeconvnode.create_explicit(
  398. load_vmt_pointer_node,
  399. voidpointertype),
  400. ccallparanode.create(
  401. ctypeconvnode.create_explicit(
  402. load_self_pointer_node,
  403. voidpointertype),
  404. nil)));
  405. addstatement(newstatement,
  406. ccallnode.createintern('fpc_help_destructor',para));
  407. end
  408. else
  409. internalerror(200305105);
  410. end;
  411. end;
  412. end;
  413. function generate_except_block:tnode;
  414. var
  415. pd : tprocdef;
  416. newstatement : tstatementnode;
  417. begin
  418. generate_except_block:=internalstatements(newstatement,true);
  419. { a constructor needs call destructor (if available) when it
  420. is not inherited }
  421. if assigned(current_procinfo.procdef._class) and
  422. (current_procinfo.procdef.proctypeoption=potype_constructor) then
  423. begin
  424. pd:=current_procinfo.procdef._class.searchdestructor;
  425. if assigned(pd) then
  426. begin
  427. { if vmt<>0 then call destructor }
  428. addstatement(newstatement,cifnode.create(
  429. caddnode.create(unequaln,
  430. load_vmt_pointer_node,
  431. cnilnode.create),
  432. ccallnode.create(nil,tprocsym(pd.procsym),pd.procsym.owner,load_self_node),
  433. nil));
  434. end;
  435. end
  436. else
  437. begin
  438. { no constructor }
  439. { must be the return value finalized before reraising the exception? }
  440. if (not is_void(current_procinfo.procdef.rettype.def)) and
  441. (current_procinfo.procdef.rettype.def.needs_inittable) and
  442. (not is_class(current_procinfo.procdef.rettype.def)) then
  443. finalize_data_node(load_result_node);
  444. end;
  445. end;
  446. procedure add_entry_exit_code(var code:tnode;const entrypos,exitpos:tfileposinfo);
  447. var
  448. initializecode,
  449. finalizecode,
  450. entrycode,
  451. exitcode,
  452. exceptcode : tnode;
  453. codeblock,
  454. newblock : tblocknode;
  455. codestatement,
  456. newstatement : tstatementnode;
  457. oldfilepos : tfileposinfo;
  458. begin
  459. oldfilepos:=aktfilepos;
  460. { Generate entry,exit and init,final blocks }
  461. aktfilepos:=entrypos;
  462. initializecode:=generate_initialize_block;
  463. entrycode:=generate_entry_block;
  464. aktfilepos:=exitpos;
  465. exitcode:=generate_exit_block;
  466. finalizecode:=generate_finalize_block;
  467. exceptcode:=generate_except_block;
  468. { Generate body of the procedure by combining entry+body+exit }
  469. codeblock:=internalstatements(codestatement,true);
  470. addstatement(codestatement,entrycode);
  471. addstatement(codestatement,code);
  472. addstatement(codestatement,exitcode);
  473. { Generate procedure by combining init+body+final,
  474. depending on the implicit finally we need to add
  475. an try...finally...end wrapper }
  476. newblock:=internalstatements(newstatement,true);
  477. if (pi_needs_implicit_finally in current_procinfo.flags) and
  478. { but it's useless in init/final code of units }
  479. not(current_procinfo.procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
  480. begin
  481. addstatement(newstatement,initializecode);
  482. aktfilepos:=entrypos;
  483. addstatement(newstatement,ctryfinallynode.create_implicit(
  484. codeblock,
  485. finalizecode,
  486. exceptcode));
  487. end
  488. else
  489. begin
  490. addstatement(newstatement,initializecode);
  491. addstatement(newstatement,codeblock);
  492. addstatement(newstatement,finalizecode);
  493. end;
  494. resulttypepass(newblock);
  495. code:=newblock;
  496. aktfilepos:=oldfilepos;
  497. end;
  498. {****************************************************************************
  499. TCGProcInfo
  500. ****************************************************************************}
  501. constructor tcgprocinfo.create(aparent:tprocinfo);
  502. begin
  503. inherited Create(aparent);
  504. nestedprocs:=tlinkedlist.create;
  505. end;
  506. destructor tcgprocinfo.destroy;
  507. begin
  508. nestedprocs.free;
  509. inherited destroy;
  510. end;
  511. procedure tcgprocinfo.generate_code;
  512. var
  513. oldprocinfo : tprocinfo;
  514. oldaktmaxfpuregisters : longint;
  515. oldfilepos : tfileposinfo;
  516. templist,
  517. stackalloccode : Taasmoutput;
  518. begin
  519. { the initialization procedure can be empty, then we
  520. don't need to generate anything. When it was an empty
  521. procedure there would be at least a blocknode }
  522. if not assigned(code) then
  523. exit;
  524. oldprocinfo:=current_procinfo;
  525. oldfilepos:=aktfilepos;
  526. oldaktmaxfpuregisters:=aktmaxfpuregisters;
  527. current_procinfo:=self;
  528. { get new labels }
  529. aktbreaklabel:=nil;
  530. aktcontinuelabel:=nil;
  531. templist:=Taasmoutput.create;
  532. { add parast/localst to symtablestack }
  533. add_to_symtablestack;
  534. { reset the temporary memory }
  535. rg.cleartempgen;
  536. rg.used_in_proc_int:=[];
  537. rg.used_in_proc_other:=[];
  538. { set the start offset to the start of the temp area in the stack }
  539. tg.setfirsttemp(firsttemp_offset);
  540. generatecode(code);
  541. { first generate entry and initialize code with the correct
  542. position and switches }
  543. aktfilepos:=entrypos;
  544. aktlocalswitches:=entryswitches;
  545. gen_initialize_code(templist,false);
  546. aktproccode.insertlistafter(tasmnode(initasmnode).currenttai,templist);
  547. gen_entry_code(templist,false);
  548. aktproccode.insertlist(templist);
  549. { now generate finalize and exit code with the correct position
  550. and switches }
  551. aktfilepos:=exitpos;
  552. aktlocalswitches:=exitswitches;
  553. gen_finalize_code(templist,false);
  554. { the finalcode must be added if the was no position available,
  555. using insertlistafter will result in an insert at the start
  556. when currentai=nil }
  557. if assigned(tasmnode(finalasmnode).currenttai) then
  558. aktproccode.insertlistafter(tasmnode(finalasmnode).currenttai,templist)
  559. else
  560. aktproccode.concatlist(templist);
  561. gen_exit_code(templist,false);
  562. aktproccode.concatlist(templist);
  563. {$ifdef newra}
  564. { rg.writegraph;}
  565. {$endif}
  566. if not(cs_no_regalloc in aktglobalswitches) then
  567. begin
  568. {$ifdef newra}
  569. {Do register allocation.}
  570. repeat
  571. rg.prepare_colouring;
  572. rg.colour_registers;
  573. rg.epilogue_colouring;
  574. until (rg.spillednodes='') or not rg.spill_registers(aktproccode,rg.spillednodes);
  575. aktproccode.translate_registers(rg.colour);
  576. aktproccode.convert_registers;
  577. {$else newra}
  578. aktproccode.convert_registers;
  579. {$ifndef NoOpt}
  580. if (cs_optimize in aktglobalswitches) and
  581. { do not optimize pure assembler procedures }
  582. not(pi_is_assembler in current_procinfo.flags) then
  583. optimize(aktproccode);
  584. {$endif NoOpt}
  585. {$endif newra}
  586. end;
  587. stackalloccode:=Taasmoutput.create;
  588. gen_stackalloc_code(stackalloccode,0);
  589. stackalloccode.convert_registers;
  590. aktproccode.insertlist(stackalloccode);
  591. stackalloccode.destroy;
  592. { now all the registers used are known }
  593. { Remove all imaginary registers from the used list.}
  594. {$ifdef newra}
  595. procdef.usedintregisters:=rg.used_in_proc_int*VOLATILE_INTREGISTERS-rg.savedintbyproc;
  596. {$else}
  597. procdef.usedintregisters:=rg.used_in_proc_int;
  598. {$endif}
  599. procdef.usedotherregisters:=rg.used_in_proc_other;
  600. { save local data (casetable) also in the same file }
  601. if assigned(aktlocaldata) and
  602. (not aktlocaldata.empty) then
  603. begin
  604. aktproccode.concat(Tai_section.Create(sec_data));
  605. aktproccode.concatlist(aktlocaldata);
  606. aktproccode.concat(Tai_section.Create(sec_code));
  607. end;
  608. { add the procedure to the codesegment }
  609. if (cs_create_smart in aktmoduleswitches) then
  610. codesegment.concat(Tai_cut.Create);
  611. codesegment.concatlist(aktproccode);
  612. { all registers can be used again }
  613. rg.resetusableregisters;
  614. { only now we can remove the temps }
  615. tg.resettempgen;
  616. { restore symtablestack }
  617. remove_from_symtablestack;
  618. { restore }
  619. templist.free;
  620. aktmaxfpuregisters:=oldaktmaxfpuregisters;
  621. aktfilepos:=oldfilepos;
  622. current_procinfo:=oldprocinfo;
  623. end;
  624. procedure tcgprocinfo.add_to_symtablestack;
  625. var
  626. _class,hp : tobjectdef;
  627. begin
  628. { insert symtables for the class, but only if it is no nested function }
  629. if assigned(procdef._class) and
  630. not(assigned(parent) and
  631. assigned(parent.procdef) and
  632. assigned(parent.procdef._class)) then
  633. begin
  634. { insert them in the reverse order }
  635. hp:=nil;
  636. repeat
  637. _class:=procdef._class;
  638. while _class.childof<>hp do
  639. _class:=_class.childof;
  640. hp:=_class;
  641. _class.symtable.next:=symtablestack;
  642. symtablestack:=_class.symtable;
  643. until hp=procdef._class;
  644. end;
  645. { insert parasymtable in symtablestack when parsing
  646. a function }
  647. if procdef.parast.symtablelevel>=normal_function_level then
  648. begin
  649. procdef.parast.next:=symtablestack;
  650. symtablestack:=procdef.parast;
  651. end;
  652. procdef.localst.next:=symtablestack;
  653. symtablestack:=procdef.localst;
  654. end;
  655. procedure tcgprocinfo.remove_from_symtablestack;
  656. begin
  657. { remove localst/parast }
  658. if procdef.parast.symtablelevel>=normal_function_level then
  659. symtablestack:=symtablestack.next.next
  660. else
  661. symtablestack:=symtablestack.next;
  662. { remove class member symbol tables }
  663. while symtablestack.symtabletype=objectsymtable do
  664. symtablestack:=symtablestack.next;
  665. end;
  666. procedure tcgprocinfo.resetprocdef;
  667. begin
  668. { the local symtables can be deleted, but the parast }
  669. { doesn't, (checking definitons when calling a }
  670. { function }
  671. { not for a inline procedure !! (PM) }
  672. { at lexlevel = 1 localst is the staticsymtable itself }
  673. { so no dispose here !! }
  674. if assigned(code) and
  675. not(cs_browser in aktmoduleswitches) and
  676. (procdef.proccalloption<>pocall_inline) then
  677. begin
  678. if procdef.parast.symtablelevel>=normal_function_level then
  679. procdef.localst.free;
  680. procdef.localst:=nil;
  681. end;
  682. { remove code tree, if not inline procedure }
  683. if assigned(code) then
  684. begin
  685. { the inline procedure has already got a copy of the tree
  686. stored in current_procinfo.procdef.code }
  687. code.free;
  688. if (procdef.proccalloption<>pocall_inline) then
  689. procdef.code:=nil;
  690. end;
  691. end;
  692. procedure tcgprocinfo.parse_body;
  693. var
  694. oldprocinfo : tprocinfo;
  695. begin
  696. oldprocinfo:=current_procinfo;
  697. current_procinfo:=self;
  698. { calculate the lexical level }
  699. if procdef.parast.symtablelevel>maxnesting then
  700. Message(parser_e_too_much_lexlevel);
  701. { static is also important for local procedures !! }
  702. if (po_staticmethod in procdef.procoptions) then
  703. allow_only_static:=true
  704. else if (procdef.parast.symtablelevel=normal_function_level) then
  705. allow_only_static:=false;
  706. { reset break and continue labels }
  707. block_type:=bt_general;
  708. {$ifdef state_tracking}
  709. { aktstate:=Tstate_storage.create;}
  710. {$endif state_tracking}
  711. { create a local symbol table for this routine }
  712. if not assigned(procdef.localst) then
  713. procdef.insert_localst;
  714. { add parast/localst to symtablestack }
  715. add_to_symtablestack;
  716. { constant symbols are inserted in this symboltable }
  717. constsymtable:=symtablestack;
  718. { reset the temporary memory }
  719. rg.cleartempgen;
  720. rg.used_in_proc_int:=[];
  721. rg.used_in_proc_other:=[];
  722. { save entry info }
  723. entrypos:=aktfilepos;
  724. entryswitches:=aktlocalswitches;
  725. { parse the code ... }
  726. code:=block(current_module.islibrary);
  727. { save exit info }
  728. exitswitches:=aktlocalswitches;
  729. exitpos:=last_endtoken_filepos;
  730. if assigned(code) then
  731. begin
  732. { get a better entry point }
  733. entrypos:=code.fileinfo;
  734. { the procedure is now defined }
  735. procdef.forwarddef:=false;
  736. { add implicit entry and exit code }
  737. add_entry_exit_code(code,entrypos,exitpos);
  738. if (Errorcount=0) then
  739. begin
  740. { check if forwards are resolved }
  741. tstoredsymtable(procdef.localst).check_forwards;
  742. { check if all labels are used }
  743. tstoredsymtable(procdef.localst).checklabels;
  744. { remove cross unit overloads }
  745. tstoredsymtable(procdef.localst).unchain_overloaded;
  746. end;
  747. { check for unused symbols, but only if there is no asm block }
  748. if not(pi_uses_asm in flags) then
  749. begin
  750. { not for unit init, becuase the var can be used in finalize,
  751. it will be done in proc_unit }
  752. if not(procdef.proctypeoption in [potype_proginit,potype_unitinit,potype_unitfinalize]) then
  753. tstoredsymtable(procdef.localst).allsymbolsused;
  754. tstoredsymtable(procdef.parast).allsymbolsused;
  755. end;
  756. { Finish type checking pass }
  757. do_resulttypepass(code);
  758. { Print the node to tree.log }
  759. if paraprintnodetree=1 then
  760. printnode_procdef(procdef);
  761. end;
  762. { store a copy of the original tree for inline, for
  763. normal procedures only store a reference to the
  764. current tree }
  765. if (procdef.proccalloption=pocall_inline) then
  766. procdef.code:=code.getcopy
  767. else
  768. procdef.code:=code;
  769. { ... remove symbol tables }
  770. remove_from_symtablestack;
  771. {$ifdef state_tracking}
  772. { aktstate.destroy;}
  773. {$endif state_tracking}
  774. { reset to normal non static function }
  775. if (current_procinfo.procdef.parast.symtablelevel=normal_function_level) then
  776. allow_only_static:=false;
  777. current_procinfo:=oldprocinfo;
  778. end;
  779. {****************************************************************************
  780. PROCEDURE/FUNCTION PARSING
  781. ****************************************************************************}
  782. procedure insert_local_value_para(p:tnamedindexitem;arg:pointer);
  783. var
  784. vs : tvarsym;
  785. pd : tprocdef;
  786. begin
  787. if tsym(p).typ<>varsym then
  788. exit;
  789. with tvarsym(p) do
  790. begin
  791. if copy(name,1,3)='val' then
  792. begin
  793. pd:=tprocdef(owner.defowner);
  794. vs:=tvarsym.create(Copy(name,4,255),varspez,vartype);
  795. vs.fileinfo:=fileinfo;
  796. if not assigned(pd.localst) then
  797. pd.insert_localst;
  798. pd.localst.insert(vs);
  799. pd.localst.insertvardata(vs);
  800. include(vs.varoptions,vo_is_local_copy);
  801. vs.varstate:=vs_assigned;
  802. localvarsym:=vs;
  803. inc(refs); { the para was used to set the local copy ! }
  804. { warnings only on local copy ! }
  805. varstate:=vs_used;
  806. end;
  807. if is_shortstring(vartype.def) and
  808. (varspez = vs_value) then
  809. include(current_procinfo.flags,pi_do_call);
  810. end;
  811. end;
  812. procedure check_init_paras(p:tnamedindexitem;arg:pointer);
  813. begin
  814. if tsym(p).typ<>varsym then
  815. exit;
  816. with tvarsym(p) do
  817. if (not is_class(vartype.def) and
  818. vartype.def.needs_inittable and
  819. (varspez in [vs_value,vs_out])) then
  820. include(current_procinfo.flags,pi_do_call);
  821. end;
  822. procedure read_proc;
  823. {
  824. Parses the procedure directives, then parses the procedure body, then
  825. generates the code for it
  826. }
  827. procedure do_generate_code(pi:tcgprocinfo);
  828. var
  829. hpi : tcgprocinfo;
  830. begin
  831. { generate code for this procedure }
  832. pi.generate_code;
  833. { process nested procs }
  834. hpi:=tcgprocinfo(pi.nestedprocs.first);
  835. while assigned(hpi) do
  836. begin
  837. do_generate_code(hpi);
  838. hpi:=tcgprocinfo(hpi.next);
  839. end;
  840. pi.resetprocdef;
  841. end;
  842. var
  843. old_current_procinfo : tprocinfo;
  844. oldconstsymtable : tsymtable;
  845. oldselftokenmode,
  846. oldfailtokenmode : tmodeswitch;
  847. pdflags : tpdflags;
  848. pd : tprocdef;
  849. isnestedproc : boolean;
  850. begin
  851. { save old state }
  852. oldconstsymtable:=constsymtable;
  853. old_current_procinfo:=current_procinfo;
  854. { reset current_procinfo.procdef to nil to be sure that nothing is writing
  855. to an other procdef }
  856. current_procinfo:=nil;
  857. { parse procedure declaration }
  858. if assigned(old_current_procinfo) and
  859. assigned(old_current_procinfo.procdef) then
  860. pd:=parse_proc_dec(old_current_procinfo.procdef._class)
  861. else
  862. pd:=parse_proc_dec(nil);
  863. { set the default function options }
  864. if parse_only then
  865. begin
  866. pd.forwarddef:=true;
  867. { set also the interface flag, for better error message when the
  868. implementation doesn't much this header }
  869. pd.interfacedef:=true;
  870. include(pd.procoptions,po_public);
  871. pdflags:=[pd_interface];
  872. end
  873. else
  874. begin
  875. pdflags:=[pd_body];
  876. if (not current_module.in_interface) then
  877. include(pdflags,pd_implemen);
  878. if (not current_module.is_unit) or
  879. (cs_create_smart in aktmoduleswitches) then
  880. include(pd.procoptions,po_public);
  881. pd.forwarddef:=false;
  882. end;
  883. { parse the directives that may follow }
  884. parse_proc_directives(pd,pdflags);
  885. { hint directives, these can be separated by semicolons here,
  886. that needs to be handled here with a loop (PFV) }
  887. while try_consume_hintdirective(pd.symoptions) do
  888. Consume(_SEMICOLON);
  889. { everything of the proc definition is known, we can now
  890. calculate the parameters }
  891. calc_parast(pd);
  892. { search for forward declarations }
  893. if not proc_add_definition(pd) then
  894. begin
  895. { A method must be forward defined (in the object declaration) }
  896. if assigned(pd._class) and
  897. (not assigned(old_current_procinfo.procdef._class)) then
  898. begin
  899. Message1(parser_e_header_dont_match_any_member,pd.fullprocname(false));
  900. tprocsym(pd.procsym).write_parameter_lists(pd);
  901. end
  902. else
  903. begin
  904. { Give a better error if there is a forward def in the interface and only
  905. a single implementation }
  906. if (not pd.forwarddef) and
  907. (not pd.interfacedef) and
  908. (tprocsym(pd.procsym).procdef_count>1) and
  909. tprocsym(pd.procsym).first_procdef.forwarddef and
  910. tprocsym(pd.procsym).first_procdef.interfacedef and
  911. not(tprocsym(pd.procsym).procdef_count>2) then
  912. begin
  913. Message1(parser_e_header_dont_match_forward,pd.fullprocname(false));
  914. tprocsym(pd.procsym).write_parameter_lists(pd);
  915. end
  916. else
  917. begin
  918. { check the global flag, for delphi this is not
  919. required }
  920. {if not(m_delphi in aktmodeswitches) and
  921. not(pd.procsym.owner.symtabletype=globalsymtable) then
  922. Message(parser_e_overloaded_must_be_all_global);}
  923. end;
  924. end;
  925. end;
  926. { compile procedure when a body is needed }
  927. if (pd_body in pdflags) then
  928. begin
  929. Message1(parser_d_procedure_start,pd.fullprocname(false));
  930. { create a new procedure }
  931. current_procinfo:=cprocinfo.create(old_current_procinfo);
  932. current_module.procinfo:=current_procinfo;
  933. current_procinfo.procdef:=pd;
  934. isnestedproc:=(current_procinfo.procdef.parast.symtablelevel>normal_function_level);
  935. { Insert mangledname }
  936. pd.aliasnames.insert(pd.mangledname);
  937. { Insert result variables in the localst }
  938. insert_funcret_local(pd);
  939. { Insert local copies for value para }
  940. pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}insert_local_value_para,nil);
  941. { check if there are para's which require initing -> set }
  942. { pi_do_call (if not yet set) }
  943. if not(pi_do_call in current_procinfo.flags) then
  944. pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_init_paras,nil);
  945. { Update parameter information }
  946. current_procinfo.allocate_implicit_parameter;
  947. { add implicit pushes for interrupt routines }
  948. if (po_interrupt in pd.procoptions) then
  949. current_procinfo.allocate_interrupt_parameter;
  950. { Calculate offsets }
  951. current_procinfo.after_header;
  952. { set _FAIL as keyword if constructor }
  953. if (pd.proctypeoption=potype_constructor) then
  954. begin
  955. oldfailtokenmode:=tokeninfo^[_FAIL].keyword;
  956. tokeninfo^[_FAIL].keyword:=m_all;
  957. end;
  958. { set _SELF as keyword if methods }
  959. if assigned(pd._class) then
  960. begin
  961. oldselftokenmode:=tokeninfo^[_SELF].keyword;
  962. tokeninfo^[_SELF].keyword:=m_all;
  963. end;
  964. tcgprocinfo(current_procinfo).parse_body;
  965. { When it's a nested procedure then defer the code generation,
  966. when back at normal function level then generate the code
  967. for all defered nested procedures and the current procedure }
  968. if isnestedproc then
  969. tcgprocinfo(current_procinfo.parent).nestedprocs.insert(current_procinfo)
  970. else
  971. begin
  972. if status.errorcount=0 then
  973. do_generate_code(tcgprocinfo(current_procinfo));
  974. end;
  975. { reset _FAIL as _SELF normal }
  976. if (pd.proctypeoption=potype_constructor) then
  977. tokeninfo^[_FAIL].keyword:=oldfailtokenmode;
  978. if assigned(pd._class) then
  979. tokeninfo^[_SELF].keyword:=oldselftokenmode;
  980. consume(_SEMICOLON);
  981. { release procinfo }
  982. if tprocinfo(current_module.procinfo)<>current_procinfo then
  983. internalerror(200304274);
  984. current_module.procinfo:=current_procinfo.parent;
  985. if not isnestedproc then
  986. current_procinfo.free;
  987. end;
  988. { Restore old state }
  989. constsymtable:=oldconstsymtable;
  990. current_procinfo:=old_current_procinfo;
  991. end;
  992. {****************************************************************************
  993. DECLARATION PARSING
  994. ****************************************************************************}
  995. { search in symtablestack for not complete classes }
  996. procedure check_forward_class(p : tnamedindexitem;arg:pointer);
  997. begin
  998. if (tsym(p).typ=typesym) and
  999. (ttypesym(p).restype.def.deftype=objectdef) and
  1000. (oo_is_forward in tobjectdef(ttypesym(p).restype.def).objectoptions) then
  1001. MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
  1002. end;
  1003. procedure read_declarations(islibrary : boolean);
  1004. procedure Not_supported_for_inline(t : ttoken);
  1005. begin
  1006. if (current_procinfo.procdef.proccalloption=pocall_inline) then
  1007. Begin
  1008. Message1(parser_w_not_supported_for_inline,tokenstring(t));
  1009. Message(parser_w_inlining_disabled);
  1010. current_procinfo.procdef.proccalloption:=pocall_fpccall;
  1011. End;
  1012. end;
  1013. begin
  1014. repeat
  1015. if not assigned(current_procinfo) then
  1016. internalerror(200304251);
  1017. case token of
  1018. _LABEL:
  1019. begin
  1020. Not_supported_for_inline(token);
  1021. label_dec;
  1022. end;
  1023. _CONST:
  1024. begin
  1025. Not_supported_for_inline(token);
  1026. const_dec;
  1027. end;
  1028. _TYPE:
  1029. begin
  1030. Not_supported_for_inline(token);
  1031. type_dec;
  1032. end;
  1033. _VAR:
  1034. var_dec;
  1035. _THREADVAR:
  1036. threadvar_dec;
  1037. _CONSTRUCTOR,_DESTRUCTOR,
  1038. _FUNCTION,_PROCEDURE,_OPERATOR,_CLASS:
  1039. begin
  1040. Not_supported_for_inline(token);
  1041. read_proc;
  1042. end;
  1043. _RESOURCESTRING:
  1044. resourcestring_dec;
  1045. _EXPORTS:
  1046. begin
  1047. Not_supported_for_inline(token);
  1048. if not(assigned(current_procinfo.procdef.localst)) or
  1049. (current_procinfo.procdef.localst.symtablelevel>main_program_level) or
  1050. (current_module.is_unit) then
  1051. begin
  1052. Message(parser_e_syntax_error);
  1053. consume_all_until(_SEMICOLON);
  1054. end
  1055. else if islibrary or
  1056. (target_info.system in [system_i386_WIN32,system_i386_wdosx,system_i386_Netware]) then
  1057. read_exports
  1058. else
  1059. begin
  1060. Message(parser_w_unsupported_feature);
  1061. consume(_BEGIN);
  1062. end;
  1063. end
  1064. else break;
  1065. end;
  1066. until false;
  1067. { check for incomplete class definitions, this is only required
  1068. for fpc modes }
  1069. if (m_fpc in aktmodeswitches) then
  1070. symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_forward_class,nil);
  1071. end;
  1072. procedure read_interface_declarations;
  1073. begin
  1074. repeat
  1075. case token of
  1076. _CONST :
  1077. const_dec;
  1078. _TYPE :
  1079. type_dec;
  1080. _VAR :
  1081. var_dec;
  1082. _THREADVAR :
  1083. threadvar_dec;
  1084. _RESOURCESTRING:
  1085. resourcestring_dec;
  1086. _FUNCTION,
  1087. _PROCEDURE,
  1088. _OPERATOR :
  1089. read_proc;
  1090. else
  1091. break;
  1092. end;
  1093. until false;
  1094. { check for incomplete class definitions, this is only required
  1095. for fpc modes }
  1096. if (m_fpc in aktmodeswitches) then
  1097. symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_forward_class,nil);
  1098. end;
  1099. begin
  1100. cprocinfo:=tcgprocinfo;
  1101. end.
  1102. {
  1103. $Log$
  1104. Revision 1.130 2003-07-05 20:15:24 jonas
  1105. * set pi_do_call if range/overflow checking is on
  1106. Revision 1.129 2003/06/17 16:34:44 jonas
  1107. * lots of newra fixes (need getfuncretparaloc implementation for i386)!
  1108. * renamed all_intregisters to volatile_intregisters and made it
  1109. processor dependent
  1110. Revision 1.128 2003/06/14 14:53:50 jonas
  1111. * fixed newra cycle for x86
  1112. * added constants for indicating source and destination operands of the
  1113. "move reg,reg" instruction to aasmcpu (and use those in rgobj)
  1114. Revision 1.127 2003/06/13 21:19:31 peter
  1115. * current_procdef removed, use current_procinfo.procdef instead
  1116. Revision 1.126 2003/06/12 16:43:07 peter
  1117. * newra compiles for sparc
  1118. Revision 1.125 2003/06/09 12:23:30 peter
  1119. * init/final of procedure data splitted from genentrycode
  1120. * use asmnode getposition to insert final at the correct position
  1121. als for the implicit try...finally
  1122. Revision 1.124 2003/06/07 19:37:43 jonas
  1123. * pi_do_call must always be set for the main program, since it always
  1124. ends with a call to FPC_DO_EXIT
  1125. Revision 1.123 2003/06/07 18:57:04 jonas
  1126. + added freeintparaloc
  1127. * ppc get/freeintparaloc now check whether the parameter regs are
  1128. properly allocated/deallocated (and get an extra list para)
  1129. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  1130. * fixed lot of missing pi_do_call's
  1131. Revision 1.122 2003/06/03 13:01:59 daniel
  1132. * Register allocator finished
  1133. Revision 1.121 2003/05/31 20:23:39 jonas
  1134. * added pi_do_call if a procedure has a value shortstring parameter
  1135. (it's copied to the local stackframe with a helper)
  1136. Revision 1.120 2003/05/30 23:57:08 peter
  1137. * more sparc cleanup
  1138. * accumulator removed, splitted in function_return_reg (called) and
  1139. function_result_reg (caller)
  1140. Revision 1.119 2003/05/28 23:58:18 jonas
  1141. * added missing initialization of rg.usedintin,byproc
  1142. * ppc now also saves/restores used fpu registers
  1143. * ncgcal doesn't add used registers to usedby/inproc anymore, except for
  1144. i386
  1145. Revision 1.118 2003/05/26 21:17:18 peter
  1146. * procinlinenode removed
  1147. * aktexit2label removed, fast exit removed
  1148. + tcallnode.inlined_pass_2 added
  1149. Revision 1.117 2003/05/25 08:59:47 peter
  1150. * do not generate code when there was an error
  1151. Revision 1.116 2003/05/23 18:49:55 jonas
  1152. * generate code for parent procedure before that of nested procedures as
  1153. well (I only need pass_1 to be done for the ppc, but pass_1 and pass_2
  1154. are grouped and it doesn't hurt that pass_2 is done as well)
  1155. Revision 1.115 2003/05/22 21:31:35 peter
  1156. * defer codegeneration for nested procedures
  1157. Revision 1.114 2003/05/16 20:00:39 jonas
  1158. * powerpc nested procedure fixes, should work completely now if all
  1159. local variables of the parent procedure are declared before the
  1160. nested procedures are declared
  1161. Revision 1.113 2003/05/16 14:33:31 peter
  1162. * regvar fixes
  1163. Revision 1.112 2003/05/13 21:26:38 peter
  1164. * only call destructor in except block when there is a destructor
  1165. available
  1166. Revision 1.111 2003/05/13 19:14:41 peter
  1167. * failn removed
  1168. * inherited result code check moven to pexpr
  1169. Revision 1.110 2003/05/13 15:18:49 peter
  1170. * fixed various crashes
  1171. Revision 1.109 2003/05/11 21:37:03 peter
  1172. * moved implicit exception frame from ncgutil to psub
  1173. * constructor/destructor helpers moved from cobj/ncgutil to psub
  1174. Revision 1.108 2003/05/09 17:47:03 peter
  1175. * self moved to hidden parameter
  1176. * removed hdisposen,hnewn,selfn
  1177. Revision 1.107 2003/04/27 11:21:34 peter
  1178. * aktprocdef renamed to current_procinfo.procdef
  1179. * procinfo renamed to current_procinfo
  1180. * procinfo will now be stored in current_module so it can be
  1181. cleaned up properly
  1182. * gen_main_procsym changed to create_main_proc and release_main_proc
  1183. to also generate a tprocinfo structure
  1184. * fixed unit implicit initfinal
  1185. Revision 1.106 2003/04/27 07:29:50 peter
  1186. * current_procinfo.procdef cleanup, current_procdef is now always nil when parsing
  1187. a new procdef declaration
  1188. * aktprocsym removed
  1189. * lexlevel removed, use symtable.symtablelevel instead
  1190. * implicit init/final code uses the normal genentry/genexit
  1191. * funcret state checking updated for new funcret handling
  1192. Revision 1.105 2003/04/26 00:31:42 peter
  1193. * set return_offset moved to after_header
  1194. Revision 1.104 2003/04/25 20:59:34 peter
  1195. * removed funcretn,funcretsym, function result is now in varsym
  1196. and aliases for result and function name are added using absolutesym
  1197. * vs_hidden parameter for funcret passed in parameter
  1198. * vs_hidden fixes
  1199. * writenode changed to printnode and released from extdebug
  1200. * -vp option added to generate a tree.log with the nodetree
  1201. * nicer printnode for statements, callnode
  1202. Revision 1.103 2003/04/24 13:03:01 florian
  1203. * comp is now written with its bit pattern to the ppu instead as an extended
  1204. Revision 1.102 2003/04/23 12:35:34 florian
  1205. * fixed several issues with powerpc
  1206. + applied a patch from Jonas for nested function calls (PowerPC only)
  1207. * ...
  1208. Revision 1.101 2003/04/22 14:33:38 peter
  1209. * removed some notes/hints
  1210. Revision 1.100 2003/04/22 13:47:08 peter
  1211. * fixed C style array of const
  1212. * fixed C array passing
  1213. * fixed left to right with high parameters
  1214. Revision 1.99 2003/04/22 10:09:35 daniel
  1215. + Implemented the actual register allocator
  1216. + Scratch registers unavailable when new register allocator used
  1217. + maybe_save/maybe_restore unavailable when new register allocator used
  1218. Revision 1.98 2003/04/17 07:50:24 daniel
  1219. * Some work on interference graph construction
  1220. Revision 1.97 2003/04/16 09:26:55 jonas
  1221. * assembler procedures now again get a stackframe if they have local
  1222. variables. No space is reserved for a function result however.
  1223. Also, the register parameters aren't automatically saved on the stack
  1224. anymore in assembler procedures.
  1225. Revision 1.96 2003/04/05 21:09:31 jonas
  1226. * several ppc/generic result offset related fixes. The "normal" result
  1227. offset seems now to be calculated correctly and a lot of duplicate
  1228. calculations have been removed. Nested functions accessing the parent's
  1229. function result don't work at all though :(
  1230. Revision 1.95 2003/04/02 16:11:34 peter
  1231. * give error when exports is not supported
  1232. Revision 1.94 2003/03/12 22:43:38 jonas
  1233. * more powerpc and generic fixes related to the new register allocator
  1234. Revision 1.93 2003/03/08 08:59:07 daniel
  1235. + $define newra will enable new register allocator
  1236. + getregisterint will return imaginary registers with $newra
  1237. + -sr switch added, will skip register allocation so you can see
  1238. the direct output of the code generator before register allocation
  1239. Revision 1.92 2003/02/19 22:00:14 daniel
  1240. * Code generator converted to new register notation
  1241. - Horribily outdated todo.txt removed
  1242. Revision 1.91 2003/01/09 21:52:37 peter
  1243. * merged some verbosity options.
  1244. * V_LineInfo is a verbosity flag to include line info
  1245. Revision 1.90 2003/01/09 20:40:59 daniel
  1246. * Converted some code in cgx86.pas to new register numbering
  1247. Revision 1.89 2003/01/09 15:49:56 daniel
  1248. * Added register conversion
  1249. Revision 1.88 2003/01/08 18:43:56 daniel
  1250. * Tregister changed into a record
  1251. Revision 1.87 2003/01/03 20:35:08 peter
  1252. * check also interfacedef when checking for matching forwarddef
  1253. Revision 1.86 2003/01/02 11:14:02 michael
  1254. + Patch from peter to support initial values for local variables
  1255. Revision 1.85 2002/12/29 18:59:34 peter
  1256. * fixed parsing of declarations before asm statement
  1257. Revision 1.84 2002/12/29 18:25:18 peter
  1258. * parse declarations before check _ASM token
  1259. Revision 1.83 2002/12/29 14:57:50 peter
  1260. * unit loading changed to first register units and load them
  1261. afterwards. This is needed to support uses xxx in yyy correctly
  1262. * unit dependency check fixed
  1263. Revision 1.82 2002/12/25 01:26:56 peter
  1264. * duplicate procsym-unitsym fix
  1265. Revision 1.81 2002/12/15 13:37:15 peter
  1266. * don't include uf_init for library. The code is already called and
  1267. does not need to be in the initfinal table
  1268. Revision 1.80 2002/12/07 14:27:09 carl
  1269. * 3% memory optimization
  1270. * changed some types
  1271. + added type checking with different size for call node and for
  1272. parameters
  1273. Revision 1.79 2002/11/25 18:43:32 carl
  1274. - removed the invalid if <> checking (Delphi is strange on this)
  1275. + implemented abstract warning on instance creation of class with
  1276. abstract methods.
  1277. * some error message cleanups
  1278. Revision 1.78 2002/11/25 17:43:23 peter
  1279. * splitted defbase in defutil,symutil,defcmp
  1280. * merged isconvertable and is_equal into compare_defs(_ext)
  1281. * made operator search faster by walking the list only once
  1282. Revision 1.77 2002/11/23 22:50:06 carl
  1283. * some small speed optimizations
  1284. + added several new warnings/hints
  1285. Revision 1.76 2002/11/18 17:31:58 peter
  1286. * pass proccalloption to ret_in_xxx and push_xxx functions
  1287. Revision 1.75 2002/11/17 16:31:57 carl
  1288. * memory optimization (3-4%) : cleanup of tai fields,
  1289. cleanup of tdef and tsym fields.
  1290. * make it work for m68k
  1291. Revision 1.74 2002/11/15 01:58:53 peter
  1292. * merged changes from 1.0.7 up to 04-11
  1293. - -V option for generating bug report tracing
  1294. - more tracing for option parsing
  1295. - errors for cdecl and high()
  1296. - win32 import stabs
  1297. - win32 records<=8 are returned in eax:edx (turned off by default)
  1298. - heaptrc update
  1299. - more info for temp management in .s file with EXTDEBUG
  1300. Revision 1.73 2002/11/09 15:32:30 carl
  1301. * noopt for non-i386 targets
  1302. Revision 1.72 2002/09/10 20:31:48 florian
  1303. * call to current_procinfo.after_header added
  1304. Revision 1.71 2002/09/07 15:25:07 peter
  1305. * old logs removed and tabs fixed
  1306. Revision 1.70 2002/09/03 16:26:27 daniel
  1307. * Make Tprocdef.defs protected
  1308. Revision 1.69 2002/08/25 19:25:20 peter
  1309. * sym.insert_in_data removed
  1310. * symtable.insertvardata/insertconstdata added
  1311. * removed insert_in_data call from symtable.insert, it needs to be
  1312. called separatly. This allows to deref the address calculation
  1313. * procedures now calculate the parast addresses after the procedure
  1314. directives are parsed. This fixes the cdecl parast problem
  1315. * push_addr_param has an extra argument that specifies if cdecl is used
  1316. or not
  1317. Revision 1.68 2002/08/17 09:23:41 florian
  1318. * first part of procinfo rewrite
  1319. Revision 1.67 2002/08/16 14:24:59 carl
  1320. * issameref() to test if two references are the same (then emit no opcodes)
  1321. + ret_in_reg to replace ret_in_acc
  1322. (fix some register allocation bugs at the same time)
  1323. + save_std_register now has an extra parameter which is the
  1324. usedinproc registers
  1325. Revision 1.66 2002/08/11 14:32:27 peter
  1326. * renamed current_library to objectlibrary
  1327. Revision 1.65 2002/08/11 13:24:13 peter
  1328. * saving of asmsymbols in ppu supported
  1329. * asmsymbollist global is removed and moved into a new class
  1330. tasmlibrarydata that will hold the info of a .a file which
  1331. corresponds with a single module. Added librarydata to tmodule
  1332. to keep the library info stored for the module. In the future the
  1333. objectfiles will also be stored to the tasmlibrarydata class
  1334. * all getlabel/newasmsymbol and friends are moved to the new class
  1335. Revision 1.64 2002/08/09 19:14:28 carl
  1336. * fixed stackframe parameter (should only contain local size),
  1337. set to zero currently
  1338. Revision 1.63 2002/08/06 20:55:22 florian
  1339. * first part of ppc calling conventions fix
  1340. Revision 1.62 2002/07/26 21:15:41 florian
  1341. * rewrote the system handling
  1342. Revision 1.61 2002/07/20 11:57:56 florian
  1343. * types.pas renamed to defbase.pas because D6 contains a types
  1344. unit so this would conflicts if D6 programms are compiled
  1345. + Willamette/SSE2 instructions to assembler added
  1346. Revision 1.60 2002/07/19 11:41:36 daniel
  1347. * State tracker work
  1348. * The whilen and repeatn are now completely unified into whilerepeatn. This
  1349. allows the state tracker to change while nodes automatically into
  1350. repeat nodes.
  1351. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  1352. 'not(a>b)' is optimized into 'a<=b'.
  1353. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  1354. by removing the notn and later switchting the true and falselabels. The
  1355. same is done with 'repeat until not a'.
  1356. Revision 1.59 2002/07/15 18:03:15 florian
  1357. * readded removed changes
  1358. Revision 1.57 2002/07/11 14:41:28 florian
  1359. * start of the new generic parameter handling
  1360. Revision 1.58 2002/07/14 18:00:44 daniel
  1361. + Added the beginning of a state tracker. This will track the values of
  1362. variables through procedures and optimize things away.
  1363. Revision 1.56 2002/07/07 09:52:32 florian
  1364. * powerpc target fixed, very simple units can be compiled
  1365. * some basic stuff for better callparanode handling, far from being finished
  1366. Revision 1.55 2002/07/04 20:43:01 florian
  1367. * first x86-64 patches
  1368. Revision 1.54 2002/07/01 18:46:25 peter
  1369. * internal linker
  1370. * reorganized aasm layer
  1371. Revision 1.53 2002/05/18 13:34:14 peter
  1372. * readded missing revisions
  1373. Revision 1.52 2002/05/16 19:46:44 carl
  1374. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1375. + try to fix temp allocation (still in ifdef)
  1376. + generic constructor calls
  1377. + start of tassembler / tmodulebase class cleanup
  1378. Revision 1.51 2002/05/14 19:34:49 peter
  1379. * removed old logs and updated copyright year
  1380. }