psub.pas 58 KB

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