From a1fd4ac62857dc1ca7b597dfb3bb31efcb93cdaf Mon Sep 17 00:00:00 2001 From: florian Date: Mon, 2 Aug 1999 17:14:07 +0000 Subject: [PATCH] + changed the temp. generator to an object --- compiler/new/cgobj.pas | 18 +- compiler/new/i386/tgcpu.pas | 77 ++++ compiler/new/nmem.pas | 17 +- compiler/new/nstatmnt.pas | 11 +- compiler/new/pp.pas | 6 +- compiler/new/psub.pas | 7 +- compiler/new/tgobj.pas | 696 ++++++++++++++++++++++++++++++++++++ compiler/new/tree.pas | 12 +- 8 files changed, 819 insertions(+), 25 deletions(-) create mode 100644 compiler/new/i386/tgcpu.pas create mode 100644 compiler/new/tgobj.pas diff --git a/compiler/new/cgobj.pas b/compiler/new/cgobj.pas index 2cc083dd56..d6e683bfeb 100644 --- a/compiler/new/cgobj.pas +++ b/compiler/new/cgobj.pas @@ -110,10 +110,7 @@ unit cgobj; uses globals,globtype,options,files,gdb,systems, - ppu,cgbase,temp_gen,verbose,types -{$ifdef i386} - ,tgeni386 -{$endif i386} + ppu,cgbase,verbose,types,tgobj,tgcpu ; constructor tcg.init; @@ -204,17 +201,17 @@ unit cgobj; hp:=ptemptodestroy(p^.first); if not(assigned(hp)) then exit; - pushusedregisters(pushedregs,$ff); + tg.pushusedregisters(pushedregs,$ff); while assigned(hp) do begin if is_ansistring(hp^.typ) then begin g_decransiref(hp^.address); - ungetiftemp(hp^.address); + tg.ungetiftemp(hp^.address); end; hp:=ptemptodestroy(hp^.next); end; - popusedregisters(pushedregs); + tg.popusedregisters(pushedregs); end; procedure tcg.g_decransiref(const ref : treference); @@ -573,7 +570,7 @@ unit cgobj; if (r in registers_saved_on_cdecl) then if (r in general_registers) then begin - if not(r in unused) then + if not(r in tg.unusedregsint) then a_push_reg(list,r) end else @@ -931,7 +928,10 @@ unit cgobj; end. { $Log$ - Revision 1.7 1999-08-01 23:05:55 florian + Revision 1.8 1999-08-02 17:14:07 florian + + changed the temp. generator to an object + + Revision 1.7 1999/08/01 23:05:55 florian * changes to compile with FPC Revision 1.6 1999/08/01 18:22:33 florian diff --git a/compiler/new/i386/tgcpu.pas b/compiler/new/i386/tgcpu.pas new file mode 100644 index 0000000000..efae63404a --- /dev/null +++ b/compiler/new/i386/tgcpu.pas @@ -0,0 +1,77 @@ +{ + $Id$ + Copyright (C) 1993-99 by Florian Klaempfl + + This unit handles the temporary variables stuff for i386 + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit tgcpu; + + interface + + uses + cobjects,globals,tree,hcodegen,verbose,files,aasm + ,i386base,i386asm,tgobj +{$ifdef dummy} + end +{$endif} + ; + + const + countusablereg : byte = 4; + + { this value is used in tsaved, if the register isn't saved } + reg_not_saved = $7fffffff; + usableregmmx : byte = 8; + + type + ttgobji386 = object(ttgobj) + procedure ungetregister(r : tregister);virtual; + function istemp(const ref : treference) : boolean;virtual; + procedure del_reference(const ref : treference);virtual; + end; + + var + tg : ttgobji386; + reg_pushes : array[R_EAX..R_MM6] of longint; + is_reg_var : array[R_EAX..R_MM6] of boolean; + + implementation + + procedure ttgobji386.ungetregister(r : tregister); + + begin + end; + + function ttgobji386.istemp(const ref : treference) : boolean; + + begin + end; + + procedure ttgobji386.del_reference(const ref : treference); + + begin + end; + +end. +{ + $Log$ + Revision 1.1 1999-08-02 17:14:14 florian + + changed the temp. generator to an object + +} \ No newline at end of file diff --git a/compiler/new/nmem.pas b/compiler/new/nmem.pas index 7ff04850e1..7c1beabe72 100644 --- a/compiler/new/nmem.pas +++ b/compiler/new/nmem.pas @@ -46,7 +46,7 @@ unit nmem; implementation uses - cobjects,aasm,cgbase,cgobj,types,verbose + cobjects,aasm,cgbase,cgobj,types,verbose,tgobj,tgcpu {$I cpuunit.inc} {$I tempgen.inc} ; @@ -122,7 +122,7 @@ unit nmem; { maybe we've to add this later for the alpha WinNT } else if (pvarsym(symtableentry)^.var_options and vo_is_dll_var)<>0 then begin - hregister:=getregister32; + hregister:=tg.getregisterint; location.reference.symbol:=newasmsymbol(symtableentry^.mangledname); exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(location.reference),hregister))); location.reference.symbol:=nil; @@ -137,7 +137,7 @@ unit nmem; begin location.loc:=LOC_CREGISTER; location.register:=pvarsym(symtableentry)^.reg; - unused:=unused-[pvarsym(symtableentry)^.reg]; + tg.unusedregsint:=tg.unusedregsint-[pvarsym(symtableentry)^.reg]; end else begin @@ -151,7 +151,7 @@ unit nmem; location.reference.offset:=-location.reference.offset; if (lexlevel>(symtable^.symtablelevel)) then begin - hregister:=getregister32; + hregister:=tg.getregisterint; { make a reference } hp:=new_reference(procinfo.framepointer, @@ -197,7 +197,7 @@ unit nmem; end; withsymtable: begin - hregister:=getregister32; + hregister:=tg.getregisterint; location.reference.base:=hregister; { make a reference } { symtable datasize field @@ -222,7 +222,7 @@ unit nmem; begin simple_loadn:=false; if hregister=R_NO then - hregister:=getregister32; + hregister:=tg.getregisterint; if is_open_array(pvarsym(symtableentry)^.definition) or is_open_string(pvarsym(symtableentry)^.definition) then begin @@ -271,7 +271,10 @@ unit nmem; end. { $Log$ - Revision 1.2 1999-08-01 18:22:35 florian + Revision 1.3 1999-08-02 17:14:08 florian + + changed the temp. generator to an object + + Revision 1.2 1999/08/01 18:22:35 florian * made it again compilable Revision 1.1 1999/01/24 22:32:36 florian diff --git a/compiler/new/nstatmnt.pas b/compiler/new/nstatmnt.pas index 1dc379b3e8..5c53ff964e 100644 --- a/compiler/new/nstatmnt.pas +++ b/compiler/new/nstatmnt.pas @@ -44,7 +44,7 @@ unit nstatmnt; implementation uses - temp_gen,tgeni386,globtype,globals,symtable,verbose,cgbase; + tgobj,globtype,globals,symtable,verbose,cgbase,tgcpu; {**************************************************************************** TSTAMENTNODE @@ -79,7 +79,7 @@ unit nstatmnt; begin if assigned(pstatementnode(hp)^.right) then begin - cleartempgen; + tg.cleartempgen; hp^.right^.det_resulttype; if (not (cs_extsyntax in aktmoduleswitches)) and assigned(hp^.right^.resulttype) and @@ -103,7 +103,7 @@ unit nstatmnt; begin if assigned(hp^.right) then begin - cleartempgen; + tg.cleartempgen; hp^.right^.det_temp; if (not (cs_extsyntax in aktmoduleswitches)) and assigned(hp^.right^.resulttype) and @@ -146,7 +146,10 @@ unit nstatmnt; end. { $Log$ - Revision 1.2 1999-08-01 23:36:43 florian + Revision 1.3 1999-08-02 17:14:09 florian + + changed the temp. generator to an object + + Revision 1.2 1999/08/01 23:36:43 florian * some changes to compile the new code generator Revision 1.1 1999/01/23 23:35:02 florian diff --git a/compiler/new/pp.pas b/compiler/new/pp.pas index 21bd4d0a9d..2ea3e06b55 100644 --- a/compiler/new/pp.pas +++ b/compiler/new/pp.pas @@ -143,7 +143,6 @@ uses {$O ptconst} {$O script} {$O switches} - {$O temp_gen} {$O comphook} {$O dos} {$O scanner} @@ -255,7 +254,10 @@ begin end. { $Log$ - Revision 1.2 1999-08-01 18:22:37 florian + Revision 1.3 1999-08-02 17:14:10 florian + + changed the temp. generator to an object + + Revision 1.2 1999/08/01 18:22:37 florian * made it again compilable Revision 1.1 1998/12/26 15:20:31 florian diff --git a/compiler/new/psub.pas b/compiler/new/psub.pas index e213e7a1cb..cf78cf618c 100644 --- a/compiler/new/psub.pas +++ b/compiler/new/psub.pas @@ -49,7 +49,7 @@ uses scanner,aasm,tree,types, import,gendef, convtree, - hcodegen,temp_gen,pass_1,pass_2,cgobj + hcodegen,tgobj,pass_1,pass_2,cgobj {$ifdef GDB} ,gdb {$endif GDB} @@ -1426,7 +1426,10 @@ end. { $Log$ - Revision 1.3 1999-08-01 18:22:38 florian + Revision 1.4 1999-08-02 17:14:11 florian + + changed the temp. generator to an object + + Revision 1.3 1999/08/01 18:22:38 florian * made it again compilable Revision 1.2 1999/01/13 22:52:39 florian diff --git a/compiler/new/tgobj.pas b/compiler/new/tgobj.pas new file mode 100644 index 0000000000..a240d16b3d --- /dev/null +++ b/compiler/new/tgobj.pas @@ -0,0 +1,696 @@ +{ + $Id$ + Copyright (c) 1993-99 by Florian Klaempfl + + This unit implements the base object for temp. generator + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} + +unit tgobj; + + interface + + uses +{$ifdef i386} + i386base,i386asm, +{$else i386} + cpubase, + cpuinfo, +{$endif i386} + cobjects,globals,tree,hcodegen,verbose,files,aasm; + + type + tregisterset = set of tregister; + + tpushed = array[firstreg..lastreg] of boolean; + tsaved = array[firstreg..lastreg] of longint; + + ttemptype = (tt_none,tt_free,tt_normal,tt_persistant,tt_ansistring,tt_freeansistring,tt_widestring,tt_freewidestring); + ttemptypeset = set of ttemptype; + + ptemprecord = ^ttemprecord; + ttemprecord = record + temptype : ttemptype; + pos : longint; + size : longint; + next : ptemprecord; + nextfree : ptemprecord; { for faster freeblock checking } +{$ifdef EXTDEBUG} + posinfo, + releaseposinfo : tfileposinfo; +{$endif} + end; + + ttgobj = object + unusedregsint,availabletempregsint : tregisterset; + countusableregsint, + countusableregsfpu, + countusableregsmm : byte; + c_countusableregsint, + c_countusableregsfpu, + c_countusableregsmm : byte; + + usedinproc : tregisterset; + + { contains all temps } + templist : ptemprecord; + { contains all free temps using nextfree links } + tempfreelist : ptemprecord; + { Offsets of the first/last temp } + firsttemp, + lasttemp : longint; + constructor init; + { generates temporary variables } + procedure resettempgen; + procedure setfirsttemp(l : longint); + function gettempsize : longint; + function newtempofsize(size : longint) : longint; + function gettempofsize(size : longint) : longint; + { special call for inlined procedures } + function gettempofsizepersistant(size : longint) : longint; + { for parameter func returns } + procedure normaltemptopersistant(pos : longint); + procedure persistanttemptonormal(pos : longint); + procedure ungetpersistanttemp(pos : longint); + procedure gettempofsizereference(l : longint;var ref : treference); + function istemp(const ref : treference) : boolean;virtual; + procedure ungetiftemp(const ref : treference); + function ungetiftempansi(const ref : treference) : boolean; + function gettempansistringreference(var ref : treference):boolean; + + { the following methods must be overriden } + function getregisterint : tregister;virtual; + procedure ungetregisterint(r : tregister);virtual; + { tries to allocate the passed register, if possible } + function getexplicitregisterint(r : tregister) : tregister;virtual; + + procedure ungetregister(r : tregister);virtual; + + procedure cleartempgen;virtual; + procedure del_reference(const ref : treference);virtual; + procedure del_locref(const location : tlocation);virtual; + procedure del_location(const l : tlocation);virtual; + + { pushs and restores registers } + procedure pushusedregisters(var pushed : tpushed;b : byte);virtual; + procedure popusedregisters(const pushed : tpushed);virtual; + + { saves and restores used registers to temp. values } + procedure saveusedregisters(var saved : tsaved;b : byte);virtual; + procedure restoreusedregisters(const saved : tsaved);virtual; + + procedure clearregistercount;virtual; + procedure resetusableregisters;virtual; + private + function ungettemp(pos:longint;allowtype:ttemptype):ttemptype; + end; + + implementation + + uses + scanner,systems; + + constructor ttgobj.init; + + begin + tempfreelist:=nil; + templist:=nil; + end; + + procedure ttgobj.resettempgen; + var + hp : ptemprecord; + begin + { Clear the old templist } + while assigned(templist) do + begin +{$ifdef EXTDEBUG} + case templist^.temptype of + tt_normal, + tt_persistant : + Comment(V_Warning,'temporary assignment of size '+ + tostr(templist^.size)+' from pos '+tostr(templist^.posinfo.line)+ + ':'+tostr(templist^.posinfo.column)+ + ' at pos '+tostr(templist^.pos)+ + ' not freed at the end of the procedure'); + tt_ansistring : + Comment(V_Warning,'temporary ANSI assignment of size '+ + tostr(templist^.size)+' from pos '+tostr(templist^.posinfo.line)+ + ':'+tostr(templist^.posinfo.column)+ + ' at pos '+tostr(templist^.pos)+ + ' not freed at the end of the procedure'); + end; +{$endif} + hp:=templist; + templist:=hp^.next; + dispose(hp); + end; + templist:=nil; + tempfreelist:=nil; + firsttemp:=0; + lasttemp:=0; + end; + + + procedure ttgobj.setfirsttemp(l : longint); + begin + { this is a negative value normally } + if l < 0 then + Begin + if odd(l) then + Dec(l); + end + else + Begin + if odd(l) then + Inc(l); + end; + firsttemp:=l; + lasttemp:=l; + end; + + + function ttgobj.newtempofsize(size : longint) : longint; + var + tl : ptemprecord; + begin + { Just extend the temp, everything below has been use + already } + dec(lasttemp,size); + { now we can create the templist entry } + new(tl); + tl^.temptype:=tt_normal; + tl^.pos:=lasttemp; + tl^.size:=size; + tl^.next:=templist; + tl^.nextfree:=nil; + templist:=tl; + newtempofsize:=tl^.pos; + end; + + + function ttgobj.gettempofsize(size : longint) : longint; + var + tl, + bestslot,bestprev, + hprev,hp : ptemprecord; + bestsize,ofs : longint; + begin + bestprev:=nil; + bestslot:=nil; + tl:=nil; + bestsize:=0; + { Align needed size on 4 bytes } + if (size mod 4)<>0 then + size:=size+(4-(size mod 4)); + { First check the tmpfreelist } + if assigned(tempfreelist) then + begin + { Check for a slot with the same size first } + hprev:=nil; + hp:=tempfreelist; + while assigned(hp) do + begin +{$ifdef EXTDEBUG} + if hp^.temptype<>tt_free then + Comment(V_Warning,'Temp in freelist is not set to tt_free'); +{$endif} + if hp^.size>=size then + begin + { Slot is the same size, then leave immediatly } + if hp^.size=size then + begin + bestprev:=hprev; + bestslot:=hp; + bestsize:=size; + break; + end + else + begin + if (bestsize=0) or (hp^.sizeallowtype then + begin + exit; + end; + exprasmlist^.concat(new(paitempalloc,dealloc(hp^.pos,hp^.size))); + { set this block to free } + hp^.temptype:=tt_free; + { Update tempfreelist } + if assigned(hprevfree) then + begin + { Connect with previous? } + if assigned(hprev) and (hprev^.temptype=tt_free) then + begin + inc(hprev^.size,hp^.size); + hprev^.next:=hp^.next; + dispose(hp); + hp:=hprev; + end + else + hprevfree^.nextfree:=hp; + end + else + begin + hp^.nextfree:=tempfreelist; + tempfreelist:=hp; + end; + { Next block free ? Yes, then concat } + hnext:=hp^.next; + if assigned(hnext) and (hnext^.temptype=tt_free) then + begin + inc(hp^.size,hnext^.size); + hp^.nextfree:=hnext^.nextfree; + hp^.next:=hnext^.next; + dispose(hnext); + end; + exit; + end; + if (hp^.temptype=tt_free) then + hprevfree:=hp; + hprev:=hp; + hp:=hp^.next; + end; + ungettemp:=tt_none; + end; + + + procedure ttgobj.ungetpersistanttemp(pos : longint); + begin +{$ifdef EXTDEBUG} + if ungettemp(pos,tt_persistant)<>tt_persistant then + Comment(V_Warning,'temp managment problem : ungetpersistanttemp()'+ + ' at pos '+tostr(pos)+ ' not found !'); +{$else} + ungettemp(pos,tt_persistant); +{$endif} + end; + + + procedure ttgobj.ungetiftemp(const ref : treference); + var + tt : ttemptype; + begin + if istemp(ref) then + begin + { first check if ansistring } + if ungetiftempansi(ref) then + exit; + tt:=ungettemp(ref.offset,tt_normal); +{$ifdef EXTDEBUG} + if tt=tt_persistant then + Comment(V_Debug,'temp at pos '+tostr(ref.offset)+ ' not released because persistant!'); + if tt=tt_none then + Comment(V_Warning,'temp not found for release at offset '+tostr(ref.offset)); +{$endif} + end; + end; + + function ttgobj.getregisterint : tregister; + + var + i : tregister; + + begin + if countusableregsint=0 then + internalerror(10); + for i:=firstreg to lastreg do + begin + if i in unusedregsint then + begin + exclude(unusedregsint,i); + include(usedinproc,i); + dec(countusableregsint); + exprasmlist^.concat(new(pairegalloc,alloc(i))); + exit; + end; + end; + internalerror(28991); + end; + + procedure ttgobj.ungetregisterint(r : tregister); + + begin + { takes much time } + if not(r in availabletempregsint) then + exit; + include(unusedregsint,r); + inc(countusableregsint); + exprasmlist^.concat(new(pairegalloc,dealloc(r))); + end; + + { tries to allocate the passed register, if possible } + function ttgobj.getexplicitregisterint(r : tregister) : tregister; + + begin + if r in unusedregsint then + begin + dec(countusableregsint); + exclude(unusedregsint,r); + include(usedinproc,r); + exprasmlist^.concat(new(pairegalloc,alloc(r))); + getexplicitregisterint:=r; + end + else + getexplicitregisterint:=getregisterint; + end; + + procedure ttgobj.ungetregister(r : tregister); + + begin + if r in intregs then + ungetregisterint(r) + {!!!!!!!! + else if r in fpuregs then + ungetregisterfpu(r) + else if r in mmregs then + ungetregistermm(r) + } + else internalerror(18); + end; + + procedure ttgobj.cleartempgen; + + begin + countusableregsint:=c_countusableregsint; + countusableregsfpu:=c_countusableregsfpu; + countusableregsmm:=c_countusableregsmm; + unusedregsint:=availabletempregsint; + {!!!!!!!! + unusedregsfpu:=availabletempregsfpu; + unusedregsmm:=availabletempregsmm; + } + end; + + procedure ttgobj.del_reference(const ref : treference); + + begin + ungetregister(ref.base); + end; + + procedure ttgobj.del_locref(const location : tlocation); + + begin + if (location.loc<>LOC_MEM) and (location.loc<>LOC_REFERENCE) then + exit; + del_reference(location.reference); + end; + + procedure ttgobj.del_location(const l : tlocation); + + begin + case l.loc of + LOC_REGISTER : + ungetregister(l.register); + LOC_MEM,LOC_REFERENCE : + del_reference(l.reference); + end; + end; + + { pushs and restores registers } + procedure ttgobj.pushusedregisters(var pushed : tpushed;b : byte); + + begin + runerror(255); + end; + + procedure ttgobj.popusedregisters(const pushed : tpushed); + + begin + runerror(255); + end; + + { saves and restores used registers to temp. values } + procedure ttgobj.saveusedregisters(var saved : tsaved;b : byte); + + begin + runerror(255); + end; + + procedure ttgobj.restoreusedregisters(const saved : tsaved); + + begin + runerror(255); + end; + + procedure ttgobj.clearregistercount; + + begin + runerror(255); + end; + + procedure ttgobj.resetusableregisters; + + begin + runerror(255); + end; + +end. +{ + $Log$ + Revision 1.1 1999-08-02 17:14:12 florian + + changed the temp. generator to an object + +} \ No newline at end of file diff --git a/compiler/new/tree.pas b/compiler/new/tree.pas index 5652df582a..5f2fa78146 100644 --- a/compiler/new/tree.pas +++ b/compiler/new/tree.pas @@ -369,6 +369,7 @@ unit tree; function getnode : ptree; procedure set_file_line(from,_to : ptree); procedure set_tree_filepos(p : ptree;const filepos : tfileposinfo); + procedure set_location(var destloc,sourceloc : tlocation); {$ifdef EXTDEBUG} procedure compare_trees(oldp,p : ptree); const @@ -1511,6 +1512,12 @@ unit tree; gensetconstnode:=p; end; + procedure set_location(var destloc,sourceloc : tlocation); + + begin + destloc:= sourceloc; + end; + {$ifdef extdebug} procedure compare_trees(oldp,p : ptree); @@ -1895,7 +1902,10 @@ unit tree; end. { $Log$ - Revision 1.9 1999-08-01 23:19:58 florian + Revision 1.10 1999-08-02 17:14:12 florian + + changed the temp. generator to an object + + Revision 1.9 1999/08/01 23:19:58 florian + make a new makefile using the old compiler makefile Revision 1.8 1999/08/01 23:04:52 michael