cgbase.pas 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Florian Klaempfl
  4. This unit exports some help routines for the code generation
  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 cgbase;
  19. {$i defines.inc}
  20. interface
  21. uses
  22. { common }
  23. cclasses,
  24. { global }
  25. globals,verbose,
  26. { symtable }
  27. symconst,symtype,symdef,symsym,
  28. { aasm }
  29. aasm,cpubase,cpuinfo,cginfo
  30. ;
  31. const
  32. tcgsize2size: Array[tcgsize] of longint = (0,
  33. 8,16,32,64,8,16,32,64,
  34. 32,64,80,64,
  35. 8,16,32,64,128,8,16,32,64,128);
  36. tfloat2tcgsize: array[tfloattype] of tcgsize =
  37. (OS_F32,OS_F64,OS_F80,OS_C64);
  38. tcgsize2tfloat: array[OS_F32..OS_C64] of tfloattype =
  39. (s32real,s64real,s80real,s64comp);
  40. const
  41. {# bitmask indicating if the procedure uses asm }
  42. pi_uses_asm = $1;
  43. {# bitmask indicating if the procedure is exported by an unit }
  44. pi_is_global = $2;
  45. {# bitmask indicating if the procedure does a call }
  46. pi_do_call = $4;
  47. {# bitmask indicating if the procedure is an operator }
  48. pi_operator = $8;
  49. {# bitmask indicating if the procedure is an external C function }
  50. pi_c_import = $10;
  51. {# bitmask indicating if the procedure has a try statement = no register optimization }
  52. pi_uses_exceptions = $20;
  53. {# bitmask indicating if the procedure is declared as @var(assembler), don't optimize}
  54. pi_is_assembler = $40;
  55. {# bitmask indicating if the procedure contains data which needs to be finalized }
  56. pi_needs_implicit_finally = $80;
  57. type
  58. pprocinfo = ^tprocinfo;
  59. tprocinfo = object
  60. {# pointer to parent in nested procedures }
  61. parent : pprocinfo;
  62. {# current class, if we are in a method }
  63. _class : tobjectdef;
  64. {# the definition of the routine itself }
  65. procdef : tprocdef;
  66. {# frame pointer offset??? }
  67. framepointer_offset : longint;
  68. { self pointer offset???? }
  69. selfpointer_offset : longint;
  70. {# result value offset in stack (functions only) }
  71. return_offset : longint;
  72. {# firsttemp position }
  73. firsttemp_offset : longint;
  74. {# parameter offset in stack }
  75. para_offset : longint;
  76. {# some collected informations about the procedure
  77. see pi_xxxx above }
  78. flags : longint;
  79. {# register used as frame pointer }
  80. framepointer : tregister;
  81. {# true, if the procedure is exported by a unit }
  82. globalsymbol : boolean;
  83. {# true, if the procedure should be exported (only OS/2) }
  84. exported : boolean;
  85. {# true, if we can not use fast exit code }
  86. no_fast_exit : boolean;
  87. aktproccode,aktentrycode,
  88. aktexitcode,aktlocaldata : taasmoutput;
  89. constructor init;
  90. destructor done;
  91. end;
  92. pregvarinfo = ^tregvarinfo;
  93. tregvarinfo = record
  94. regvars : array[1..maxvarregs] of tvarsym;
  95. regvars_para : array[1..maxvarregs] of boolean;
  96. regvars_refs : array[1..maxvarregs] of longint;
  97. fpuregvars : array[1..maxfpuvarregs] of tvarsym;
  98. fpuregvars_para : array[1..maxfpuvarregs] of boolean;
  99. fpuregvars_refs : array[1..maxfpuvarregs] of longint;
  100. end;
  101. var
  102. {# information about the current sub routine being parsed (@var(pprocinfo))}
  103. procinfo : pprocinfo;
  104. { labels for BREAK and CONTINUE }
  105. aktbreaklabel,aktcontinuelabel : tasmlabel;
  106. { label when the result is true or false }
  107. truelabel,falselabel : tasmlabel;
  108. { label to leave the sub routine }
  109. aktexitlabel : tasmlabel;
  110. { also an exit label, only used we need to clear only the stack }
  111. aktexit2label : tasmlabel;
  112. { only used in constructor for fail or if getmem fails }
  113. faillabel,quickexitlabel : tasmlabel;
  114. {# true, if there was an error while code generation occurs }
  115. codegenerror : boolean;
  116. { save the size of pushed parameter, needed for aligning }
  117. pushedparasize : longint;
  118. { message calls with codegenerror support }
  119. procedure cgmessage(t : longint);
  120. procedure cgmessage1(t : longint;const s : string);
  121. procedure cgmessage2(t : longint;const s1,s2 : string);
  122. procedure cgmessage3(t : longint;const s1,s2,s3 : string);
  123. procedure CGMessagePos(const pos:tfileposinfo;t:longint);
  124. procedure CGMessagePos1(const pos:tfileposinfo;t:longint;const s1:string);
  125. procedure CGMessagePos2(const pos:tfileposinfo;t:longint;const s1,s2:string);
  126. procedure CGMessagePos3(const pos:tfileposinfo;t:longint;const s1,s2,s3:string);
  127. { initialize respectively terminates the code generator }
  128. { for a new module or procedure }
  129. procedure codegen_doneprocedure;
  130. procedure codegen_donemodule;
  131. procedure codegen_newmodule;
  132. procedure codegen_newprocedure;
  133. {# From a definition return the abstract code generator size (@var(tcgsize) enum). It is
  134. to note that the value returned can be @var(OS_NO) }
  135. function def_cgsize(def: tdef): tcgsize;
  136. function int_cgsize(const l: aword): tcgsize;
  137. {# return the inverse condition of opcmp }
  138. function inverse_opcmp(opcmp: topcmp): topcmp;
  139. {# return whether op is commutative }
  140. function commutativeop(op: topcg): boolean;
  141. implementation
  142. uses
  143. systems,
  144. cresstr,
  145. types
  146. {$ifdef fixLeaksOnError}
  147. ,comphook
  148. {$endif fixLeaksOnError}
  149. ;
  150. {$ifdef fixLeaksOnError}
  151. var procinfoStack: TStack;
  152. hcodegen_old_do_stop: tstopprocedure;
  153. {$endif fixLeaksOnError}
  154. {*****************************************************************************
  155. override the message calls to set codegenerror
  156. *****************************************************************************}
  157. procedure cgmessage(t : longint);
  158. var
  159. olderrorcount : longint;
  160. begin
  161. if not(codegenerror) then
  162. begin
  163. olderrorcount:=Errorcount;
  164. verbose.Message(t);
  165. codegenerror:=olderrorcount<>Errorcount;
  166. end;
  167. end;
  168. procedure cgmessage1(t : longint;const s : string);
  169. var
  170. olderrorcount : longint;
  171. begin
  172. if not(codegenerror) then
  173. begin
  174. olderrorcount:=Errorcount;
  175. verbose.Message1(t,s);
  176. codegenerror:=olderrorcount<>Errorcount;
  177. end;
  178. end;
  179. procedure cgmessage2(t : longint;const s1,s2 : string);
  180. var
  181. olderrorcount : longint;
  182. begin
  183. if not(codegenerror) then
  184. begin
  185. olderrorcount:=Errorcount;
  186. verbose.Message2(t,s1,s2);
  187. codegenerror:=olderrorcount<>Errorcount;
  188. end;
  189. end;
  190. procedure cgmessage3(t : longint;const s1,s2,s3 : string);
  191. var
  192. olderrorcount : longint;
  193. begin
  194. if not(codegenerror) then
  195. begin
  196. olderrorcount:=Errorcount;
  197. verbose.Message3(t,s1,s2,s3);
  198. codegenerror:=olderrorcount<>Errorcount;
  199. end;
  200. end;
  201. procedure cgmessagepos(const pos:tfileposinfo;t : longint);
  202. var
  203. olderrorcount : longint;
  204. begin
  205. if not(codegenerror) then
  206. begin
  207. olderrorcount:=Errorcount;
  208. verbose.MessagePos(pos,t);
  209. codegenerror:=olderrorcount<>Errorcount;
  210. end;
  211. end;
  212. procedure cgmessagepos1(const pos:tfileposinfo;t : longint;const s1 : string);
  213. var
  214. olderrorcount : longint;
  215. begin
  216. if not(codegenerror) then
  217. begin
  218. olderrorcount:=Errorcount;
  219. verbose.MessagePos1(pos,t,s1);
  220. codegenerror:=olderrorcount<>Errorcount;
  221. end;
  222. end;
  223. procedure cgmessagepos2(const pos:tfileposinfo;t : longint;const s1,s2 : string);
  224. var
  225. olderrorcount : longint;
  226. begin
  227. if not(codegenerror) then
  228. begin
  229. olderrorcount:=Errorcount;
  230. verbose.MessagePos2(pos,t,s1,s2);
  231. codegenerror:=olderrorcount<>Errorcount;
  232. end;
  233. end;
  234. procedure cgmessagepos3(const pos:tfileposinfo;t : longint;const s1,s2,s3 : string);
  235. var
  236. olderrorcount : longint;
  237. begin
  238. if not(codegenerror) then
  239. begin
  240. olderrorcount:=Errorcount;
  241. verbose.MessagePos3(pos,t,s1,s2,s3);
  242. codegenerror:=olderrorcount<>Errorcount;
  243. end;
  244. end;
  245. {****************************************************************************
  246. TProcInfo
  247. ****************************************************************************}
  248. constructor tprocinfo.init;
  249. begin
  250. parent:=nil;
  251. _class:=nil;
  252. procdef:=nil;
  253. framepointer_offset:=0;
  254. selfpointer_offset:=0;
  255. return_offset:=0;
  256. firsttemp_offset:=0;
  257. para_offset:=0;
  258. flags:=0;
  259. framepointer:=R_NO;
  260. globalsymbol:=false;
  261. exported:=false;
  262. no_fast_exit:=false;
  263. aktentrycode:=Taasmoutput.Create;
  264. aktexitcode:=Taasmoutput.Create;
  265. aktproccode:=Taasmoutput.Create;
  266. aktlocaldata:=Taasmoutput.Create;
  267. end;
  268. destructor tprocinfo.done;
  269. begin
  270. aktentrycode.free;
  271. aktexitcode.free;
  272. aktproccode.free;
  273. aktlocaldata.free;
  274. end;
  275. {*****************************************************************************
  276. initialize/terminate the codegen for procedure and modules
  277. *****************************************************************************}
  278. procedure codegen_newprocedure;
  279. begin
  280. aktbreaklabel:=nil;
  281. aktcontinuelabel:=nil;
  282. { aktexitlabel:=0; is store in oldaktexitlabel
  283. so it must not be reset to zero before this storage !}
  284. { new procinfo }
  285. new(procinfo,init);
  286. {$ifdef fixLeaksOnError}
  287. procinfoStack.push(procinfo);
  288. {$endif fixLeaksOnError}
  289. end;
  290. procedure codegen_doneprocedure;
  291. begin
  292. {$ifdef fixLeaksOnError}
  293. if procinfo <> procinfoStack.pop then
  294. writeln('problem with procinfoStack!');
  295. {$endif fixLeaksOnError}
  296. dispose(procinfo,done);
  297. procinfo:=nil;
  298. end;
  299. procedure codegen_newmodule;
  300. begin
  301. exprasmlist:=taasmoutput.create;
  302. datasegment:=taasmoutput.create;
  303. codesegment:=taasmoutput.create;
  304. bsssegment:=taasmoutput.create;
  305. debuglist:=taasmoutput.create;
  306. withdebuglist:=taasmoutput.create;
  307. consts:=taasmoutput.create;
  308. rttilist:=taasmoutput.create;
  309. ResourceStringList:=Nil;
  310. importssection:=nil;
  311. exportssection:=nil;
  312. resourcesection:=nil;
  313. { assembler symbols }
  314. asmsymbollist:=tdictionary.create;
  315. asmsymbollist.usehash;
  316. { resourcestrings }
  317. ResourceStrings:=TResourceStrings.Create;
  318. end;
  319. procedure codegen_donemodule;
  320. {$ifdef MEMDEBUG}
  321. var
  322. d : tmemdebug;
  323. {$endif}
  324. begin
  325. {$ifdef MEMDEBUG}
  326. d:=tmemdebug.create('asmlist');
  327. {$endif}
  328. exprasmlist.free;
  329. codesegment.free;
  330. bsssegment.free;
  331. datasegment.free;
  332. debuglist.free;
  333. withdebuglist.free;
  334. consts.free;
  335. rttilist.free;
  336. if assigned(ResourceStringList) then
  337. ResourceStringList.free;
  338. if assigned(importssection) then
  339. importssection.free;
  340. if assigned(exportssection) then
  341. exportssection.free;
  342. if assigned(resourcesection) then
  343. resourcesection.free;
  344. {$ifdef MEMDEBUG}
  345. d.free;
  346. {$endif}
  347. { assembler symbols }
  348. {$ifdef MEMDEBUG}
  349. d:=tmemdebug.create('asmsymbol');
  350. {$endif}
  351. asmsymbollist.free;
  352. {$ifdef MEMDEBUG}
  353. d.free;
  354. {$endif}
  355. { resource strings }
  356. ResourceStrings.free;
  357. end;
  358. function def_cgsize(def: tdef): tcgsize;
  359. begin
  360. case def.deftype of
  361. orddef,
  362. enumdef,
  363. setdef:
  364. begin
  365. result := int_cgsize(def.size);
  366. if is_signed(def) then
  367. result := tcgsize(ord(result)+(ord(OS_S8)-ord(OS_8)));
  368. end;
  369. classrefdef,
  370. pointerdef,
  371. procvardef:
  372. result := OS_ADDR;
  373. stringdef :
  374. begin
  375. if is_ansistring(def) or is_widestring(def) then
  376. result := OS_ADDR
  377. else
  378. result := OS_NO;
  379. end;
  380. objectdef :
  381. begin
  382. if is_class_or_interface(def) then
  383. result := OS_ADDR
  384. else
  385. result := OS_NO;
  386. end;
  387. floatdef:
  388. result := tfloat2tcgsize[tfloatdef(def).typ];
  389. recorddef :
  390. result:=int_cgsize(def.size);
  391. else
  392. begin
  393. { undefined size }
  394. result:=OS_NO;
  395. end;
  396. end;
  397. end;
  398. function int_cgsize(const l: aword): tcgsize;
  399. begin
  400. case l of
  401. 1 :
  402. result := OS_8;
  403. 2 :
  404. result := OS_16;
  405. 4 :
  406. result := OS_32;
  407. 8 :
  408. result := OS_64;
  409. else
  410. result:=OS_NO;
  411. end;
  412. end;
  413. function inverse_opcmp(opcmp: topcmp): topcmp;
  414. const
  415. list: array[TOpCmp] of TOpCmp =
  416. (OC_NONE,OC_NE,OC_LTE,OC_GTE,OC_LT,OC_GT,OC_EQ,OC_A,OC_AE,
  417. OC_B,OC_BE);
  418. begin
  419. inverse_opcmp := list[opcmp];
  420. end;
  421. function commutativeop(op: topcg): boolean;
  422. const
  423. list: array[topcg] of boolean =
  424. (true,true,true,false,false,true,true,false,false,
  425. true,false,false,false,false,true);
  426. begin
  427. commutativeop := list[op];
  428. end;
  429. {$ifdef fixLeaksOnError}
  430. procedure hcodegen_do_stop;
  431. var p: pprocinfo;
  432. begin
  433. p := pprocinfo(procinfoStack.pop);
  434. while p <> nil Do
  435. begin
  436. dispose(p,done);
  437. p := pprocinfo(procinfoStack.pop);
  438. end;
  439. procinfoStack.done;
  440. do_stop := hcodegen_old_do_stop;
  441. do_stop{$ifdef FPCPROCVAR}(){$endif};
  442. end;
  443. begin
  444. hcodegen_old_do_stop := do_stop;
  445. do_stop := {$ifdef FPCPROCVAR}@{$endif}hcodegen_do_stop;
  446. procinfoStack.init;
  447. {$endif fixLeaksOnError}
  448. end.
  449. {
  450. $Log$
  451. Revision 1.10 2002-04-07 09:13:39 carl
  452. + documentation
  453. - remove unused variables
  454. Revision 1.9 2002/04/04 19:05:54 peter
  455. * removed unused units
  456. * use tlocation.size in cg.a_*loc*() routines
  457. Revision 1.8 2002/04/02 17:11:27 peter
  458. * tlocation,treference update
  459. * LOC_CONSTANT added for better constant handling
  460. * secondadd splitted in multiple routines
  461. * location_force_reg added for loading a location to a register
  462. of a specified size
  463. * secondassignment parses now first the right and then the left node
  464. (this is compatible with Kylix). This saves a lot of push/pop especially
  465. with string operations
  466. * adapted some routines to use the new cg methods
  467. Revision 1.7 2002/03/31 20:26:33 jonas
  468. + a_loadfpu_* and a_loadmm_* methods in tcg
  469. * register allocation is now handled by a class and is mostly processor
  470. independent (+rgobj.pas and i386/rgcpu.pas)
  471. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  472. * some small improvements and fixes to the optimizer
  473. * some register allocation fixes
  474. * some fpuvaroffset fixes in the unary minus node
  475. * push/popusedregisters is now called rg.save/restoreusedregisters and
  476. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  477. also better optimizable)
  478. * fixed and optimized register saving/restoring for new/dispose nodes
  479. * LOC_FPU locations now also require their "register" field to be set to
  480. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  481. - list field removed of the tnode class because it's not used currently
  482. and can cause hard-to-find bugs
  483. Revision 1.6 2002/03/04 19:10:11 peter
  484. * removed compiler warnings
  485. Revision 1.5 2001/12/30 17:24:48 jonas
  486. * range checking is now processor independent (part in cgobj,
  487. part in cg64f32) and should work correctly again (it needed
  488. some changes after the changes of the low and high of
  489. tordef's to int64)
  490. * maketojumpbool() is now processor independent (in ncgutil)
  491. * getregister32 is now called getregisterint
  492. Revision 1.4 2001/11/06 14:53:48 jonas
  493. * compiles again with -dmemdebug
  494. Revision 1.3 2001/09/29 21:33:47 jonas
  495. * support 64bit operands in def_cgsize()
  496. Revision 1.2 2001/09/28 20:39:33 jonas
  497. * changed all flow control structures (except for exception handling
  498. related things) to processor independent code (in new ncgflw unit)
  499. + generic cgobj unit which contains lots of code generator helpers with
  500. global "cg" class instance variable
  501. + cgcpu unit for i386 (implements processor specific routines of the above
  502. unit)
  503. * updated cgbase and cpubase for the new code generator units
  504. * include ncgflw unit in cpunode unit
  505. Revision 1.1 2001/08/26 13:36:36 florian
  506. * some cg reorganisation
  507. * some PPC updates
  508. Revision 1.11 2001/08/06 21:40:46 peter
  509. * funcret moved from tprocinfo to tprocdef
  510. Revision 1.10 2001/04/13 01:22:07 peter
  511. * symtable change to classes
  512. * range check generation and errors fixed, make cycle DEBUG=1 works
  513. * memory leaks fixed
  514. Revision 1.9 2000/12/25 00:07:26 peter
  515. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  516. tlinkedlist objects)
  517. Revision 1.8 2000/11/30 22:16:49 florian
  518. * moved to i386
  519. Revision 1.7 2000/10/31 22:02:47 peter
  520. * symtable splitted, no real code changes
  521. Revision 1.6 2000/09/24 15:06:17 peter
  522. * use defines.inc
  523. Revision 1.5 2000/08/27 16:11:51 peter
  524. * moved some util functions from globals,cobjects to cutils
  525. * splitted files into finput,fmodule
  526. Revision 1.4 2000/08/12 15:34:22 peter
  527. + usedasmsymbollist to check and reset only the used symbols (merged)
  528. Revision 1.3 2000/08/03 13:17:26 jonas
  529. + allow regvars to be used inside inlined procs, which required the
  530. following changes:
  531. + load regvars in genentrycode/free them in genexitcode (cgai386)
  532. * moved all regvar related code to new regvars unit
  533. + added pregvarinfo type to hcodegen
  534. + added regvarinfo field to tprocinfo (symdef/symdefh)
  535. * deallocate the regvars of the caller in secondprocinline before
  536. inlining the called procedure and reallocate them afterwards
  537. Revision 1.2 2000/07/13 11:32:41 michael
  538. + removed logs
  539. }