psub.pas 59 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637
  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. usesacc,
  519. usesfpu,
  520. usesacchi : boolean;
  521. begin
  522. { the initialization procedure can be empty, then we
  523. don't need to generate anything. When it was an empty
  524. procedure there would be at least a blocknode }
  525. if not assigned(code) then
  526. exit;
  527. oldprocinfo:=current_procinfo;
  528. oldfilepos:=aktfilepos;
  529. oldaktmaxfpuregisters:=aktmaxfpuregisters;
  530. current_procinfo:=self;
  531. { get new labels }
  532. aktbreaklabel:=nil;
  533. aktcontinuelabel:=nil;
  534. templist:=Taasmoutput.create;
  535. { add parast/localst to symtablestack }
  536. add_to_symtablestack;
  537. { reset the temporary memory }
  538. rg.cleartempgen;
  539. { exclude(rg.unusedregsint,RS_STACK_POINTER_REG);}
  540. rg.used_in_proc_int:=[{RS_STACK_POINTER_REG}];
  541. rg.used_in_proc_other:=[];
  542. { set the start offset to the start of the temp area in the stack }
  543. tg.setfirsttemp(firsttemp_offset);
  544. generatecode(code);
  545. { first generate entry and initialize code with the correct
  546. position and switches }
  547. aktfilepos:=entrypos;
  548. aktlocalswitches:=entryswitches;
  549. gen_initialize_code(templist,false);
  550. aktproccode.insertlistafter(tasmnode(initasmnode).currenttai,templist);
  551. gen_entry_code(templist,false);
  552. aktproccode.insertlist(templist);
  553. { now generate finalize and exit code with the correct position
  554. and switches }
  555. aktfilepos:=exitpos;
  556. aktlocalswitches:=exitswitches;
  557. gen_finalize_code(templist,false);
  558. { the finalcode must be added if the was no position available,
  559. using insertlistafter will result in an insert at the start
  560. when currentai=nil }
  561. if assigned(tasmnode(finalasmnode).currenttai) then
  562. aktproccode.insertlistafter(tasmnode(finalasmnode).currenttai,templist)
  563. else
  564. aktproccode.concatlist(templist);
  565. { handle return value, this is not done for assembler routines when
  566. they didn't reference the result variable }
  567. usesacc:=false;
  568. usesfpu:=false;
  569. usesacchi:=false;
  570. gen_load_return_value(aktproccode,usesacc,usesacchi,usesfpu);
  571. {$ifdef newra}
  572. {$ifdef ra_debug2}
  573. rg.writegraph;
  574. {$endif}
  575. {$endif}
  576. if not(cs_no_regalloc in aktglobalswitches) then
  577. begin
  578. {$ifdef newra}
  579. {Do register allocation.}
  580. repeat
  581. rg.prepare_colouring;
  582. rg.colour_registers;
  583. rg.epilogue_colouring;
  584. until (rg.spillednodes='') or not rg.spill_registers(aktproccode,rg.spillednodes);
  585. aktproccode.translate_registers(rg.colour);
  586. aktproccode.convert_registers;
  587. {$else newra}
  588. aktproccode.convert_registers;
  589. {$ifndef NoOpt}
  590. if (cs_optimize in aktglobalswitches) and
  591. { do not optimize pure assembler procedures }
  592. not(pi_is_assembler in current_procinfo.flags) then
  593. optimize(aktproccode);
  594. {$endif NoOpt}
  595. {$endif newra}
  596. end;
  597. stackalloccode:=Taasmoutput.create;
  598. gen_stackalloc_code(stackalloccode);
  599. stackalloccode.convert_registers;
  600. aktproccode.insertlist(stackalloccode);
  601. stackalloccode.free;
  602. gen_exit_code(templist,false,usesacc,usesacchi,usesfpu);
  603. templist.convert_registers;
  604. aktproccode.concatlist(templist);
  605. { now all the registers used are known }
  606. { Remove all imaginary registers from the used list.}
  607. {$ifdef newra}
  608. procdef.usedintregisters:=rg.used_in_proc_int*VOLATILE_INTREGISTERS-rg.savedintbyproc;
  609. {$else}
  610. procdef.usedintregisters:=rg.used_in_proc_int;
  611. {$endif}
  612. procdef.usedotherregisters:=rg.used_in_proc_other;
  613. { save local data (casetable) also in the same file }
  614. if assigned(aktlocaldata) and
  615. (not aktlocaldata.empty) then
  616. begin
  617. aktproccode.concat(Tai_section.Create(sec_data));
  618. aktproccode.concatlist(aktlocaldata);
  619. aktproccode.concat(Tai_section.Create(sec_code));
  620. end;
  621. { add the procedure to the codesegment }
  622. if (cs_create_smart in aktmoduleswitches) then
  623. codesegment.concat(Tai_cut.Create);
  624. codesegment.concatlist(aktproccode);
  625. { all registers can be used again }
  626. rg.resetusableregisters;
  627. { only now we can remove the temps }
  628. tg.resettempgen;
  629. { restore symtablestack }
  630. remove_from_symtablestack;
  631. { restore }
  632. templist.free;
  633. aktmaxfpuregisters:=oldaktmaxfpuregisters;
  634. aktfilepos:=oldfilepos;
  635. current_procinfo:=oldprocinfo;
  636. end;
  637. procedure tcgprocinfo.add_to_symtablestack;
  638. var
  639. _class,hp : tobjectdef;
  640. begin
  641. { insert symtables for the class, but only if it is no nested function }
  642. if assigned(procdef._class) and
  643. not(assigned(parent) and
  644. assigned(parent.procdef) and
  645. assigned(parent.procdef._class)) then
  646. begin
  647. { insert them in the reverse order }
  648. hp:=nil;
  649. repeat
  650. _class:=procdef._class;
  651. while _class.childof<>hp do
  652. _class:=_class.childof;
  653. hp:=_class;
  654. _class.symtable.next:=symtablestack;
  655. symtablestack:=_class.symtable;
  656. until hp=procdef._class;
  657. end;
  658. { insert parasymtable in symtablestack when parsing
  659. a function }
  660. if procdef.parast.symtablelevel>=normal_function_level then
  661. begin
  662. procdef.parast.next:=symtablestack;
  663. symtablestack:=procdef.parast;
  664. end;
  665. procdef.localst.next:=symtablestack;
  666. symtablestack:=procdef.localst;
  667. end;
  668. procedure tcgprocinfo.remove_from_symtablestack;
  669. begin
  670. { remove localst/parast }
  671. if procdef.parast.symtablelevel>=normal_function_level then
  672. symtablestack:=symtablestack.next.next
  673. else
  674. symtablestack:=symtablestack.next;
  675. { remove class member symbol tables }
  676. while symtablestack.symtabletype=objectsymtable do
  677. symtablestack:=symtablestack.next;
  678. end;
  679. procedure tcgprocinfo.resetprocdef;
  680. begin
  681. { the local symtables can be deleted, but the parast }
  682. { doesn't, (checking definitons when calling a }
  683. { function }
  684. { not for a inline procedure !! (PM) }
  685. { at lexlevel = 1 localst is the staticsymtable itself }
  686. { so no dispose here !! }
  687. if assigned(code) and
  688. not(cs_browser in aktmoduleswitches) and
  689. (procdef.proccalloption<>pocall_inline) then
  690. begin
  691. if procdef.parast.symtablelevel>=normal_function_level then
  692. procdef.localst.free;
  693. procdef.localst:=nil;
  694. end;
  695. { remove code tree, if not inline procedure }
  696. if assigned(code) then
  697. begin
  698. { the inline procedure has already got a copy of the tree
  699. stored in current_procinfo.procdef.code }
  700. code.free;
  701. if (procdef.proccalloption<>pocall_inline) then
  702. procdef.code:=nil;
  703. end;
  704. end;
  705. procedure tcgprocinfo.parse_body;
  706. var
  707. oldprocinfo : tprocinfo;
  708. begin
  709. oldprocinfo:=current_procinfo;
  710. current_procinfo:=self;
  711. { calculate the lexical level }
  712. if procdef.parast.symtablelevel>maxnesting then
  713. Message(parser_e_too_much_lexlevel);
  714. { static is also important for local procedures !! }
  715. if (po_staticmethod in procdef.procoptions) then
  716. allow_only_static:=true
  717. else if (procdef.parast.symtablelevel=normal_function_level) then
  718. allow_only_static:=false;
  719. { reset break and continue labels }
  720. block_type:=bt_general;
  721. {$ifdef state_tracking}
  722. { aktstate:=Tstate_storage.create;}
  723. {$endif state_tracking}
  724. { create a local symbol table for this routine }
  725. if not assigned(procdef.localst) then
  726. procdef.insert_localst;
  727. { add parast/localst to symtablestack }
  728. add_to_symtablestack;
  729. { constant symbols are inserted in this symboltable }
  730. constsymtable:=symtablestack;
  731. { reset the temporary memory }
  732. rg.cleartempgen;
  733. rg.used_in_proc_int:=[];
  734. rg.used_in_proc_other:=[];
  735. { save entry info }
  736. entrypos:=aktfilepos;
  737. entryswitches:=aktlocalswitches;
  738. { parse the code ... }
  739. code:=block(current_module.islibrary);
  740. { save exit info }
  741. exitswitches:=aktlocalswitches;
  742. exitpos:=last_endtoken_filepos;
  743. if assigned(code) then
  744. begin
  745. { get a better entry point }
  746. entrypos:=code.fileinfo;
  747. { the procedure is now defined }
  748. procdef.forwarddef:=false;
  749. { add implicit entry and exit code }
  750. add_entry_exit_code(code,entrypos,exitpos);
  751. if (Errorcount=0) then
  752. begin
  753. { check if forwards are resolved }
  754. tstoredsymtable(procdef.localst).check_forwards;
  755. { check if all labels are used }
  756. tstoredsymtable(procdef.localst).checklabels;
  757. { remove cross unit overloads }
  758. tstoredsymtable(procdef.localst).unchain_overloaded;
  759. end;
  760. { check for unused symbols, but only if there is no asm block }
  761. if not(pi_uses_asm in flags) then
  762. begin
  763. { not for unit init, becuase the var can be used in finalize,
  764. it will be done in proc_unit }
  765. if not(procdef.proctypeoption in [potype_proginit,potype_unitinit,potype_unitfinalize]) then
  766. tstoredsymtable(procdef.localst).allsymbolsused;
  767. tstoredsymtable(procdef.parast).allsymbolsused;
  768. end;
  769. { Finish type checking pass }
  770. do_resulttypepass(code);
  771. { Print the node to tree.log }
  772. if paraprintnodetree=1 then
  773. printnode_procdef(procdef);
  774. end;
  775. { store a copy of the original tree for inline, for
  776. normal procedures only store a reference to the
  777. current tree }
  778. if (procdef.proccalloption=pocall_inline) then
  779. procdef.code:=code.getcopy
  780. else
  781. procdef.code:=code;
  782. { ... remove symbol tables }
  783. remove_from_symtablestack;
  784. {$ifdef state_tracking}
  785. { aktstate.destroy;}
  786. {$endif state_tracking}
  787. { reset to normal non static function }
  788. if (current_procinfo.procdef.parast.symtablelevel=normal_function_level) then
  789. allow_only_static:=false;
  790. current_procinfo:=oldprocinfo;
  791. end;
  792. {****************************************************************************
  793. PROCEDURE/FUNCTION PARSING
  794. ****************************************************************************}
  795. procedure insert_local_value_para(p:tnamedindexitem;arg:pointer);
  796. var
  797. vs : tvarsym;
  798. pd : tprocdef;
  799. begin
  800. if tsym(p).typ<>varsym then
  801. exit;
  802. with tvarsym(p) do
  803. begin
  804. if copy(name,1,3)='val' then
  805. begin
  806. pd:=tprocdef(owner.defowner);
  807. vs:=tvarsym.create(Copy(name,4,255),varspez,vartype);
  808. vs.fileinfo:=fileinfo;
  809. if not assigned(pd.localst) then
  810. pd.insert_localst;
  811. pd.localst.insert(vs);
  812. pd.localst.insertvardata(vs);
  813. include(vs.varoptions,vo_is_local_copy);
  814. vs.varstate:=vs_assigned;
  815. localvarsym:=vs;
  816. inc(refs); { the para was used to set the local copy ! }
  817. { warnings only on local copy ! }
  818. varstate:=vs_used;
  819. end;
  820. if is_shortstring(vartype.def) and
  821. (varspez = vs_value) then
  822. include(current_procinfo.flags,pi_do_call);
  823. end;
  824. end;
  825. procedure check_init_paras(p:tnamedindexitem;arg:pointer);
  826. begin
  827. if tsym(p).typ<>varsym then
  828. exit;
  829. with tvarsym(p) do
  830. if (not is_class(vartype.def) and
  831. vartype.def.needs_inittable and
  832. (varspez in [vs_value,vs_out])) then
  833. include(current_procinfo.flags,pi_do_call);
  834. end;
  835. procedure read_proc;
  836. {
  837. Parses the procedure directives, then parses the procedure body, then
  838. generates the code for it
  839. }
  840. procedure do_generate_code(pi:tcgprocinfo);
  841. var
  842. hpi : tcgprocinfo;
  843. begin
  844. { generate code for this procedure }
  845. pi.generate_code;
  846. { process nested procs }
  847. hpi:=tcgprocinfo(pi.nestedprocs.first);
  848. while assigned(hpi) do
  849. begin
  850. do_generate_code(hpi);
  851. hpi:=tcgprocinfo(hpi.next);
  852. end;
  853. pi.resetprocdef;
  854. end;
  855. var
  856. old_current_procinfo : tprocinfo;
  857. oldconstsymtable : tsymtable;
  858. oldselftokenmode,
  859. oldfailtokenmode : tmodeswitch;
  860. pdflags : tpdflags;
  861. pd : tprocdef;
  862. isnestedproc : boolean;
  863. begin
  864. { save old state }
  865. oldconstsymtable:=constsymtable;
  866. old_current_procinfo:=current_procinfo;
  867. { reset current_procinfo.procdef to nil to be sure that nothing is writing
  868. to an other procdef }
  869. current_procinfo:=nil;
  870. { parse procedure declaration }
  871. if assigned(old_current_procinfo) and
  872. assigned(old_current_procinfo.procdef) then
  873. pd:=parse_proc_dec(old_current_procinfo.procdef._class)
  874. else
  875. pd:=parse_proc_dec(nil);
  876. { set the default function options }
  877. if parse_only then
  878. begin
  879. pd.forwarddef:=true;
  880. { set also the interface flag, for better error message when the
  881. implementation doesn't much this header }
  882. pd.interfacedef:=true;
  883. include(pd.procoptions,po_public);
  884. pdflags:=[pd_interface];
  885. end
  886. else
  887. begin
  888. pdflags:=[pd_body];
  889. if (not current_module.in_interface) then
  890. include(pdflags,pd_implemen);
  891. if (not current_module.is_unit) or
  892. (cs_create_smart in aktmoduleswitches) then
  893. include(pd.procoptions,po_public);
  894. pd.forwarddef:=false;
  895. end;
  896. { parse the directives that may follow }
  897. parse_proc_directives(pd,pdflags);
  898. { hint directives, these can be separated by semicolons here,
  899. that needs to be handled here with a loop (PFV) }
  900. while try_consume_hintdirective(pd.symoptions) do
  901. Consume(_SEMICOLON);
  902. { everything of the proc definition is known, we can now
  903. calculate the parameters }
  904. calc_parast(pd);
  905. { search for forward declarations }
  906. if not proc_add_definition(pd) then
  907. begin
  908. { A method must be forward defined (in the object declaration) }
  909. if assigned(pd._class) and
  910. (not assigned(old_current_procinfo.procdef._class)) then
  911. begin
  912. Message1(parser_e_header_dont_match_any_member,pd.fullprocname(false));
  913. tprocsym(pd.procsym).write_parameter_lists(pd);
  914. end
  915. else
  916. begin
  917. { Give a better error if there is a forward def in the interface and only
  918. a single implementation }
  919. if (not pd.forwarddef) and
  920. (not pd.interfacedef) and
  921. (tprocsym(pd.procsym).procdef_count>1) and
  922. tprocsym(pd.procsym).first_procdef.forwarddef and
  923. tprocsym(pd.procsym).first_procdef.interfacedef and
  924. not(tprocsym(pd.procsym).procdef_count>2) then
  925. begin
  926. Message1(parser_e_header_dont_match_forward,pd.fullprocname(false));
  927. tprocsym(pd.procsym).write_parameter_lists(pd);
  928. end
  929. else
  930. begin
  931. { check the global flag, for delphi this is not
  932. required }
  933. {if not(m_delphi in aktmodeswitches) and
  934. not(pd.procsym.owner.symtabletype=globalsymtable) then
  935. Message(parser_e_overloaded_must_be_all_global);}
  936. end;
  937. end;
  938. end;
  939. { compile procedure when a body is needed }
  940. if (pd_body in pdflags) then
  941. begin
  942. Message1(parser_d_procedure_start,pd.fullprocname(false));
  943. { create a new procedure }
  944. current_procinfo:=cprocinfo.create(old_current_procinfo);
  945. current_module.procinfo:=current_procinfo;
  946. current_procinfo.procdef:=pd;
  947. isnestedproc:=(current_procinfo.procdef.parast.symtablelevel>normal_function_level);
  948. { Insert mangledname }
  949. pd.aliasnames.insert(pd.mangledname);
  950. { Insert result variables in the localst }
  951. insert_funcret_local(pd);
  952. { Insert local copies for value para }
  953. pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}insert_local_value_para,nil);
  954. { check if there are para's which require initing -> set }
  955. { pi_do_call (if not yet set) }
  956. if not(pi_do_call in current_procinfo.flags) then
  957. pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_init_paras,nil);
  958. { Update parameter information }
  959. if (current_procinfo.procdef.parast.symtablelevel>normal_function_level) then
  960. current_procinfo.allocate_parent_framepointer_parameter;
  961. { add implicit pushes for interrupt routines }
  962. if (po_interrupt in pd.procoptions) then
  963. current_procinfo.allocate_interrupt_parameter;
  964. { set _FAIL as keyword if constructor }
  965. if (pd.proctypeoption=potype_constructor) then
  966. begin
  967. oldfailtokenmode:=tokeninfo^[_FAIL].keyword;
  968. tokeninfo^[_FAIL].keyword:=m_all;
  969. end;
  970. { set _SELF as keyword if methods }
  971. if assigned(pd._class) then
  972. begin
  973. oldselftokenmode:=tokeninfo^[_SELF].keyword;
  974. tokeninfo^[_SELF].keyword:=m_all;
  975. end;
  976. tcgprocinfo(current_procinfo).parse_body;
  977. { When it's a nested procedure then defer the code generation,
  978. when back at normal function level then generate the code
  979. for all defered nested procedures and the current procedure }
  980. if isnestedproc then
  981. tcgprocinfo(current_procinfo.parent).nestedprocs.insert(current_procinfo)
  982. else
  983. begin
  984. if status.errorcount=0 then
  985. do_generate_code(tcgprocinfo(current_procinfo));
  986. end;
  987. { reset _FAIL as _SELF normal }
  988. if (pd.proctypeoption=potype_constructor) then
  989. tokeninfo^[_FAIL].keyword:=oldfailtokenmode;
  990. if assigned(pd._class) then
  991. tokeninfo^[_SELF].keyword:=oldselftokenmode;
  992. consume(_SEMICOLON);
  993. { release procinfo }
  994. if tprocinfo(current_module.procinfo)<>current_procinfo then
  995. internalerror(200304274);
  996. current_module.procinfo:=current_procinfo.parent;
  997. if not isnestedproc then
  998. current_procinfo.free;
  999. end;
  1000. { Restore old state }
  1001. constsymtable:=oldconstsymtable;
  1002. current_procinfo:=old_current_procinfo;
  1003. end;
  1004. {****************************************************************************
  1005. DECLARATION PARSING
  1006. ****************************************************************************}
  1007. { search in symtablestack for not complete classes }
  1008. procedure check_forward_class(p : tnamedindexitem;arg:pointer);
  1009. begin
  1010. if (tsym(p).typ=typesym) and
  1011. (ttypesym(p).restype.def.deftype=objectdef) and
  1012. (oo_is_forward in tobjectdef(ttypesym(p).restype.def).objectoptions) then
  1013. MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
  1014. end;
  1015. procedure read_declarations(islibrary : boolean);
  1016. procedure Not_supported_for_inline(t : ttoken);
  1017. begin
  1018. if (current_procinfo.procdef.proccalloption=pocall_inline) then
  1019. Begin
  1020. Message1(parser_w_not_supported_for_inline,tokenstring(t));
  1021. Message(parser_w_inlining_disabled);
  1022. current_procinfo.procdef.proccalloption:=pocall_fpccall;
  1023. End;
  1024. end;
  1025. begin
  1026. repeat
  1027. if not assigned(current_procinfo) then
  1028. internalerror(200304251);
  1029. case token of
  1030. _LABEL:
  1031. begin
  1032. Not_supported_for_inline(token);
  1033. label_dec;
  1034. end;
  1035. _CONST:
  1036. begin
  1037. Not_supported_for_inline(token);
  1038. const_dec;
  1039. end;
  1040. _TYPE:
  1041. begin
  1042. Not_supported_for_inline(token);
  1043. type_dec;
  1044. end;
  1045. _VAR:
  1046. var_dec;
  1047. _THREADVAR:
  1048. threadvar_dec;
  1049. _CONSTRUCTOR,_DESTRUCTOR,
  1050. _FUNCTION,_PROCEDURE,_OPERATOR,_CLASS:
  1051. begin
  1052. Not_supported_for_inline(token);
  1053. read_proc;
  1054. end;
  1055. _RESOURCESTRING:
  1056. resourcestring_dec;
  1057. _EXPORTS:
  1058. begin
  1059. Not_supported_for_inline(token);
  1060. if not(assigned(current_procinfo.procdef.localst)) or
  1061. (current_procinfo.procdef.localst.symtablelevel>main_program_level) or
  1062. (current_module.is_unit) then
  1063. begin
  1064. Message(parser_e_syntax_error);
  1065. consume_all_until(_SEMICOLON);
  1066. end
  1067. else if islibrary or
  1068. (target_info.system in [system_i386_WIN32,system_i386_wdosx,system_i386_Netware]) then
  1069. read_exports
  1070. else
  1071. begin
  1072. Message(parser_w_unsupported_feature);
  1073. consume(_BEGIN);
  1074. end;
  1075. end
  1076. else break;
  1077. end;
  1078. until false;
  1079. { check for incomplete class definitions, this is only required
  1080. for fpc modes }
  1081. if (m_fpc in aktmodeswitches) then
  1082. symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_forward_class,nil);
  1083. end;
  1084. procedure read_interface_declarations;
  1085. begin
  1086. repeat
  1087. case token of
  1088. _CONST :
  1089. const_dec;
  1090. _TYPE :
  1091. type_dec;
  1092. _VAR :
  1093. var_dec;
  1094. _THREADVAR :
  1095. threadvar_dec;
  1096. _RESOURCESTRING:
  1097. resourcestring_dec;
  1098. _FUNCTION,
  1099. _PROCEDURE,
  1100. _OPERATOR :
  1101. read_proc;
  1102. else
  1103. break;
  1104. end;
  1105. until false;
  1106. { check for incomplete class definitions, this is only required
  1107. for fpc modes }
  1108. if (m_fpc in aktmodeswitches) then
  1109. symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_forward_class,nil);
  1110. end;
  1111. begin
  1112. cprocinfo:=tcgprocinfo;
  1113. end.
  1114. {
  1115. $Log$
  1116. Revision 1.133 2003-07-23 11:04:15 jonas
  1117. * split en_exit_code into a part that may allocate a register and a part
  1118. that doesn't, so the former can be done before the register colouring
  1119. has been performed
  1120. Revision 1.132 2003/07/06 17:58:22 peter
  1121. * framepointer fixes for sparc
  1122. * parent framepointer code more generic
  1123. Revision 1.131 2003/07/06 15:31:21 daniel
  1124. * Fixed register allocator. *Lots* of fixes.
  1125. Revision 1.130 2003/07/05 20:15:24 jonas
  1126. * set pi_do_call if range/overflow checking is on
  1127. Revision 1.129 2003/06/17 16:34:44 jonas
  1128. * lots of newra fixes (need getfuncretparaloc implementation for i386)!
  1129. * renamed all_intregisters to volatile_intregisters and made it
  1130. processor dependent
  1131. Revision 1.128 2003/06/14 14:53:50 jonas
  1132. * fixed newra cycle for x86
  1133. * added constants for indicating source and destination operands of the
  1134. "move reg,reg" instruction to aasmcpu (and use those in rgobj)
  1135. Revision 1.127 2003/06/13 21:19:31 peter
  1136. * current_procdef removed, use current_procinfo.procdef instead
  1137. Revision 1.126 2003/06/12 16:43:07 peter
  1138. * newra compiles for sparc
  1139. Revision 1.125 2003/06/09 12:23:30 peter
  1140. * init/final of procedure data splitted from genentrycode
  1141. * use asmnode getposition to insert final at the correct position
  1142. als for the implicit try...finally
  1143. Revision 1.124 2003/06/07 19:37:43 jonas
  1144. * pi_do_call must always be set for the main program, since it always
  1145. ends with a call to FPC_DO_EXIT
  1146. Revision 1.123 2003/06/07 18:57:04 jonas
  1147. + added freeintparaloc
  1148. * ppc get/freeintparaloc now check whether the parameter regs are
  1149. properly allocated/deallocated (and get an extra list para)
  1150. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  1151. * fixed lot of missing pi_do_call's
  1152. Revision 1.122 2003/06/03 13:01:59 daniel
  1153. * Register allocator finished
  1154. Revision 1.121 2003/05/31 20:23:39 jonas
  1155. * added pi_do_call if a procedure has a value shortstring parameter
  1156. (it's copied to the local stackframe with a helper)
  1157. Revision 1.120 2003/05/30 23:57:08 peter
  1158. * more sparc cleanup
  1159. * accumulator removed, splitted in function_return_reg (called) and
  1160. function_result_reg (caller)
  1161. Revision 1.119 2003/05/28 23:58:18 jonas
  1162. * added missing initialization of rg.usedintin,byproc
  1163. * ppc now also saves/restores used fpu registers
  1164. * ncgcal doesn't add used registers to usedby/inproc anymore, except for
  1165. i386
  1166. Revision 1.118 2003/05/26 21:17:18 peter
  1167. * procinlinenode removed
  1168. * aktexit2label removed, fast exit removed
  1169. + tcallnode.inlined_pass_2 added
  1170. Revision 1.117 2003/05/25 08:59:47 peter
  1171. * do not generate code when there was an error
  1172. Revision 1.116 2003/05/23 18:49:55 jonas
  1173. * generate code for parent procedure before that of nested procedures as
  1174. well (I only need pass_1 to be done for the ppc, but pass_1 and pass_2
  1175. are grouped and it doesn't hurt that pass_2 is done as well)
  1176. Revision 1.115 2003/05/22 21:31:35 peter
  1177. * defer codegeneration for nested procedures
  1178. Revision 1.114 2003/05/16 20:00:39 jonas
  1179. * powerpc nested procedure fixes, should work completely now if all
  1180. local variables of the parent procedure are declared before the
  1181. nested procedures are declared
  1182. Revision 1.113 2003/05/16 14:33:31 peter
  1183. * regvar fixes
  1184. Revision 1.112 2003/05/13 21:26:38 peter
  1185. * only call destructor in except block when there is a destructor
  1186. available
  1187. Revision 1.111 2003/05/13 19:14:41 peter
  1188. * failn removed
  1189. * inherited result code check moven to pexpr
  1190. Revision 1.110 2003/05/13 15:18:49 peter
  1191. * fixed various crashes
  1192. Revision 1.109 2003/05/11 21:37:03 peter
  1193. * moved implicit exception frame from ncgutil to psub
  1194. * constructor/destructor helpers moved from cobj/ncgutil to psub
  1195. Revision 1.108 2003/05/09 17:47:03 peter
  1196. * self moved to hidden parameter
  1197. * removed hdisposen,hnewn,selfn
  1198. Revision 1.107 2003/04/27 11:21:34 peter
  1199. * aktprocdef renamed to current_procinfo.procdef
  1200. * procinfo renamed to current_procinfo
  1201. * procinfo will now be stored in current_module so it can be
  1202. cleaned up properly
  1203. * gen_main_procsym changed to create_main_proc and release_main_proc
  1204. to also generate a tprocinfo structure
  1205. * fixed unit implicit initfinal
  1206. Revision 1.106 2003/04/27 07:29:50 peter
  1207. * current_procinfo.procdef cleanup, current_procdef is now always nil when parsing
  1208. a new procdef declaration
  1209. * aktprocsym removed
  1210. * lexlevel removed, use symtable.symtablelevel instead
  1211. * implicit init/final code uses the normal genentry/genexit
  1212. * funcret state checking updated for new funcret handling
  1213. Revision 1.105 2003/04/26 00:31:42 peter
  1214. * set return_offset moved to after_header
  1215. Revision 1.104 2003/04/25 20:59:34 peter
  1216. * removed funcretn,funcretsym, function result is now in varsym
  1217. and aliases for result and function name are added using absolutesym
  1218. * vs_hidden parameter for funcret passed in parameter
  1219. * vs_hidden fixes
  1220. * writenode changed to printnode and released from extdebug
  1221. * -vp option added to generate a tree.log with the nodetree
  1222. * nicer printnode for statements, callnode
  1223. Revision 1.103 2003/04/24 13:03:01 florian
  1224. * comp is now written with its bit pattern to the ppu instead as an extended
  1225. Revision 1.102 2003/04/23 12:35:34 florian
  1226. * fixed several issues with powerpc
  1227. + applied a patch from Jonas for nested function calls (PowerPC only)
  1228. * ...
  1229. Revision 1.101 2003/04/22 14:33:38 peter
  1230. * removed some notes/hints
  1231. Revision 1.100 2003/04/22 13:47:08 peter
  1232. * fixed C style array of const
  1233. * fixed C array passing
  1234. * fixed left to right with high parameters
  1235. Revision 1.99 2003/04/22 10:09:35 daniel
  1236. + Implemented the actual register allocator
  1237. + Scratch registers unavailable when new register allocator used
  1238. + maybe_save/maybe_restore unavailable when new register allocator used
  1239. Revision 1.98 2003/04/17 07:50:24 daniel
  1240. * Some work on interference graph construction
  1241. Revision 1.97 2003/04/16 09:26:55 jonas
  1242. * assembler procedures now again get a stackframe if they have local
  1243. variables. No space is reserved for a function result however.
  1244. Also, the register parameters aren't automatically saved on the stack
  1245. anymore in assembler procedures.
  1246. Revision 1.96 2003/04/05 21:09:31 jonas
  1247. * several ppc/generic result offset related fixes. The "normal" result
  1248. offset seems now to be calculated correctly and a lot of duplicate
  1249. calculations have been removed. Nested functions accessing the parent's
  1250. function result don't work at all though :(
  1251. Revision 1.95 2003/04/02 16:11:34 peter
  1252. * give error when exports is not supported
  1253. Revision 1.94 2003/03/12 22:43:38 jonas
  1254. * more powerpc and generic fixes related to the new register allocator
  1255. Revision 1.93 2003/03/08 08:59:07 daniel
  1256. + $define newra will enable new register allocator
  1257. + getregisterint will return imaginary registers with $newra
  1258. + -sr switch added, will skip register allocation so you can see
  1259. the direct output of the code generator before register allocation
  1260. Revision 1.92 2003/02/19 22:00:14 daniel
  1261. * Code generator converted to new register notation
  1262. - Horribily outdated todo.txt removed
  1263. Revision 1.91 2003/01/09 21:52:37 peter
  1264. * merged some verbosity options.
  1265. * V_LineInfo is a verbosity flag to include line info
  1266. Revision 1.90 2003/01/09 20:40:59 daniel
  1267. * Converted some code in cgx86.pas to new register numbering
  1268. Revision 1.89 2003/01/09 15:49:56 daniel
  1269. * Added register conversion
  1270. Revision 1.88 2003/01/08 18:43:56 daniel
  1271. * Tregister changed into a record
  1272. Revision 1.87 2003/01/03 20:35:08 peter
  1273. * check also interfacedef when checking for matching forwarddef
  1274. Revision 1.86 2003/01/02 11:14:02 michael
  1275. + Patch from peter to support initial values for local variables
  1276. Revision 1.85 2002/12/29 18:59:34 peter
  1277. * fixed parsing of declarations before asm statement
  1278. Revision 1.84 2002/12/29 18:25:18 peter
  1279. * parse declarations before check _ASM token
  1280. Revision 1.83 2002/12/29 14:57:50 peter
  1281. * unit loading changed to first register units and load them
  1282. afterwards. This is needed to support uses xxx in yyy correctly
  1283. * unit dependency check fixed
  1284. Revision 1.82 2002/12/25 01:26:56 peter
  1285. * duplicate procsym-unitsym fix
  1286. Revision 1.81 2002/12/15 13:37:15 peter
  1287. * don't include uf_init for library. The code is already called and
  1288. does not need to be in the initfinal table
  1289. Revision 1.80 2002/12/07 14:27:09 carl
  1290. * 3% memory optimization
  1291. * changed some types
  1292. + added type checking with different size for call node and for
  1293. parameters
  1294. Revision 1.79 2002/11/25 18:43:32 carl
  1295. - removed the invalid if <> checking (Delphi is strange on this)
  1296. + implemented abstract warning on instance creation of class with
  1297. abstract methods.
  1298. * some error message cleanups
  1299. Revision 1.78 2002/11/25 17:43:23 peter
  1300. * splitted defbase in defutil,symutil,defcmp
  1301. * merged isconvertable and is_equal into compare_defs(_ext)
  1302. * made operator search faster by walking the list only once
  1303. Revision 1.77 2002/11/23 22:50:06 carl
  1304. * some small speed optimizations
  1305. + added several new warnings/hints
  1306. Revision 1.76 2002/11/18 17:31:58 peter
  1307. * pass proccalloption to ret_in_xxx and push_xxx functions
  1308. Revision 1.75 2002/11/17 16:31:57 carl
  1309. * memory optimization (3-4%) : cleanup of tai fields,
  1310. cleanup of tdef and tsym fields.
  1311. * make it work for m68k
  1312. Revision 1.74 2002/11/15 01:58:53 peter
  1313. * merged changes from 1.0.7 up to 04-11
  1314. - -V option for generating bug report tracing
  1315. - more tracing for option parsing
  1316. - errors for cdecl and high()
  1317. - win32 import stabs
  1318. - win32 records<=8 are returned in eax:edx (turned off by default)
  1319. - heaptrc update
  1320. - more info for temp management in .s file with EXTDEBUG
  1321. Revision 1.73 2002/11/09 15:32:30 carl
  1322. * noopt for non-i386 targets
  1323. Revision 1.72 2002/09/10 20:31:48 florian
  1324. * call to current_procinfo.after_header added
  1325. Revision 1.71 2002/09/07 15:25:07 peter
  1326. * old logs removed and tabs fixed
  1327. Revision 1.70 2002/09/03 16:26:27 daniel
  1328. * Make Tprocdef.defs protected
  1329. Revision 1.69 2002/08/25 19:25:20 peter
  1330. * sym.insert_in_data removed
  1331. * symtable.insertvardata/insertconstdata added
  1332. * removed insert_in_data call from symtable.insert, it needs to be
  1333. called separatly. This allows to deref the address calculation
  1334. * procedures now calculate the parast addresses after the procedure
  1335. directives are parsed. This fixes the cdecl parast problem
  1336. * push_addr_param has an extra argument that specifies if cdecl is used
  1337. or not
  1338. Revision 1.68 2002/08/17 09:23:41 florian
  1339. * first part of procinfo rewrite
  1340. Revision 1.67 2002/08/16 14:24:59 carl
  1341. * issameref() to test if two references are the same (then emit no opcodes)
  1342. + ret_in_reg to replace ret_in_acc
  1343. (fix some register allocation bugs at the same time)
  1344. + save_std_register now has an extra parameter which is the
  1345. usedinproc registers
  1346. Revision 1.66 2002/08/11 14:32:27 peter
  1347. * renamed current_library to objectlibrary
  1348. Revision 1.65 2002/08/11 13:24:13 peter
  1349. * saving of asmsymbols in ppu supported
  1350. * asmsymbollist global is removed and moved into a new class
  1351. tasmlibrarydata that will hold the info of a .a file which
  1352. corresponds with a single module. Added librarydata to tmodule
  1353. to keep the library info stored for the module. In the future the
  1354. objectfiles will also be stored to the tasmlibrarydata class
  1355. * all getlabel/newasmsymbol and friends are moved to the new class
  1356. Revision 1.64 2002/08/09 19:14:28 carl
  1357. * fixed stackframe parameter (should only contain local size),
  1358. set to zero currently
  1359. Revision 1.63 2002/08/06 20:55:22 florian
  1360. * first part of ppc calling conventions fix
  1361. Revision 1.62 2002/07/26 21:15:41 florian
  1362. * rewrote the system handling
  1363. Revision 1.61 2002/07/20 11:57:56 florian
  1364. * types.pas renamed to defbase.pas because D6 contains a types
  1365. unit so this would conflicts if D6 programms are compiled
  1366. + Willamette/SSE2 instructions to assembler added
  1367. Revision 1.60 2002/07/19 11:41:36 daniel
  1368. * State tracker work
  1369. * The whilen and repeatn are now completely unified into whilerepeatn. This
  1370. allows the state tracker to change while nodes automatically into
  1371. repeat nodes.
  1372. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  1373. 'not(a>b)' is optimized into 'a<=b'.
  1374. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  1375. by removing the notn and later switchting the true and falselabels. The
  1376. same is done with 'repeat until not a'.
  1377. Revision 1.59 2002/07/15 18:03:15 florian
  1378. * readded removed changes
  1379. Revision 1.57 2002/07/11 14:41:28 florian
  1380. * start of the new generic parameter handling
  1381. Revision 1.58 2002/07/14 18:00:44 daniel
  1382. + Added the beginning of a state tracker. This will track the values of
  1383. variables through procedures and optimize things away.
  1384. Revision 1.56 2002/07/07 09:52:32 florian
  1385. * powerpc target fixed, very simple units can be compiled
  1386. * some basic stuff for better callparanode handling, far from being finished
  1387. Revision 1.55 2002/07/04 20:43:01 florian
  1388. * first x86-64 patches
  1389. Revision 1.54 2002/07/01 18:46:25 peter
  1390. * internal linker
  1391. * reorganized aasm layer
  1392. Revision 1.53 2002/05/18 13:34:14 peter
  1393. * readded missing revisions
  1394. Revision 1.52 2002/05/16 19:46:44 carl
  1395. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1396. + try to fix temp allocation (still in ifdef)
  1397. + generic constructor calls
  1398. + start of tassembler / tmodulebase class cleanup
  1399. Revision 1.51 2002/05/14 19:34:49 peter
  1400. * removed old logs and updated copyright year
  1401. }