+ changed the temp. generator to an object

compiler/new/cgobj.pas

@@ -110,10 +110,7 @@ unit cgobj;
 
     uses
        globals,globtype,options,files,gdb,systems,
-       ppu,cgbase,temp_gen,verbose,types
+       ppu,cgbase,verbose,types,tgobj,tgcpu
-{$ifdef i386}
-       ,tgeni386
-{$endif i386}
        ;
 
     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

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
+
+}

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

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

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

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

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^.size<bestsize) then
+                      begin
+                        bestprev:=hprev;
+                        bestslot:=hp;
+                        bestsize:=hp^.size;
+                      end;
+                   end;
+                end;
+               hprev:=hp;
+               hp:=hp^.nextfree;
+             end;
+          end;
+         { Reuse an old temp ? }
+         if assigned(bestslot) then
+          begin
+            if bestsize=size then
+             begin
+               bestslot^.temptype:=tt_normal;
+               ofs:=bestslot^.pos;
+               tl:=bestslot;
+               { Remove from the tempfreelist }
+               if assigned(bestprev) then
+                 bestprev^.nextfree:=bestslot^.nextfree
+               else
+                 tempfreelist:=bestslot^.nextfree;
+             end
+            else
+             begin
+               { Resize the old block }
+               dec(bestslot^.size,size);
+               { Create new block and link after bestslot }
+               new(tl);
+               tl^.temptype:=tt_normal;
+               tl^.pos:=bestslot^.pos+bestslot^.size;
+               ofs:=tl^.pos;
+               tl^.size:=size;
+               tl^.nextfree:=nil;
+               { link the new block }
+               tl^.next:=bestslot^.next;
+               bestslot^.next:=tl;
+             end;
+          end
+         else
+          begin
+             ofs:=newtempofsize(size);
+{$ifdef EXTDEBUG}
+             tl:=templist;
+{$endif}
+          end;
+{$ifdef EXTDEBUG}
+         tl^.posinfo:=aktfilepos;
+{$endif}
+         exprasmlist^.concat(new(paitempalloc,alloc(ofs,size)));
+         gettempofsize:=ofs;
+      end;
+
+
+    function ttgobj.gettempofsizepersistant(size : longint) : longint;
+      var
+         l : longint;
+      begin
+         l:=gettempofsize(size);
+         templist^.temptype:=tt_persistant;
+{$ifdef EXTDEBUG}
+         Comment(V_Debug,'temp managment  : call to gettempofsizepersistant()'+
+                     ' with size '+tostr(size)+' returned '+tostr(l));
+{$endif}
+         gettempofsizepersistant:=l;
+      end;
+
+
+    function ttgobj.gettempsize : longint;
+      begin
+        gettempsize:=Align(-lasttemp,target_os.stackalignment);
+      end;
+
+
+    procedure ttgobj.gettempofsizereference(l : longint;var ref : treference);
+      begin
+         { do a reset, because the reference isn't used }
+         reset_reference(ref);
+         ref.offset:=gettempofsize(l);
+         ref.base:=procinfo.framepointer;
+      end;
+
+
+    function ttgobj.gettempansistringreference(var ref : treference):boolean;
+      var
+         foundslot,tl : ptemprecord;
+      begin
+         { do a reset, because the reference isn't used }
+         reset_reference(ref);
+         ref.base:=procinfo.framepointer;
+         { Reuse old ansi slot ? }
+         foundslot:=nil;
+         tl:=templist;
+         while assigned(tl) do
+          begin
+            if tl^.temptype=tt_freeansistring then
+             begin
+               foundslot:=tl;
+{$ifdef EXTDEBUG}
+               tl^.posinfo:=aktfilepos;
+{$endif}
+               break;
+             end;
+            tl:=tl^.next;
+          end;
+         if assigned(foundslot) then
+          begin
+            foundslot^.temptype:=tt_ansistring;
+            ref.offset:=foundslot^.pos;
+            { we're reusing an old slot then set the function result to true
+              so that we can call a decr_ansistr }
+            gettempansistringreference:=true;
+          end
+         else
+          begin
+            ref.offset:=newtempofsize(target_os.size_of_pointer);
+{$ifdef EXTDEBUG}
+            templist^.posinfo:=aktfilepos;
+{$endif}
+            templist^.temptype:=tt_ansistring;
+            { set result to false, we don't need an decr_ansistr }
+            gettempansistringreference:=true;
+          end;
+         exprasmlist^.concat(new(paitempalloc,alloc(ref.offset,target_os.size_of_pointer)));
+      end;
+
+
+    function ttgobj.ungetiftempansi(const ref : treference) : boolean;
+      var
+         tl : ptemprecord;
+      begin
+        ungetiftempansi:=false;
+        tl:=templist;
+        while assigned(tl) do
+         begin
+           if tl^.pos=ref.offset then
+            begin
+              if tl^.temptype=tt_ansistring then
+               begin
+                 tl^.temptype:=tt_freeansistring;
+                 ungetiftempansi:=true;
+                 exprasmlist^.concat(new(paitempalloc,dealloc(tl^.pos,tl^.size)));
+                 exit;
+{$ifdef EXTDEBUG}
+               end
+              else if (tl^.temptype=tt_freeansistring) then
+               begin
+                 Comment(V_Debug,'temp ansi managment problem : ungetiftempansi()'+
+                     ' at pos '+tostr(ref.offset)+ ' already free !');
+{$endif}
+               end;
+            end;
+           tl:=tl^.next;
+         end;
+      end;
+
+    function ttgobj.istemp(const ref : treference) : boolean;
+
+      begin
+         istemp:=((ref.base=procinfo.framepointer) and
+                  (ref.offset<firsttemp));
+      end;
+
+
+    procedure ttgobj.persistanttemptonormal(pos : longint);
+      var
+        hp : ptemprecord;
+      begin
+         hp:=templist;
+         while assigned(hp) do
+           if (hp^.pos=pos) and (hp^.temptype=tt_persistant) then
+             begin
+{$ifdef EXTDEBUG}
+               Comment(V_Debug,'temp managment : persistanttemptonormal()'+
+                  ' at pos '+tostr(pos)+ ' found !');
+{$endif}
+                hp^.temptype:=tt_normal;
+                exit;
+             end
+           else
+             hp:=hp^.next;
+{$ifdef EXTDEBUG}
+         Comment(V_Debug,'temp managment problem : persistanttemptonormal()'+
+            ' at pos '+tostr(pos)+ ' not found !');
+{$endif}
+      end;
+
+
+    procedure ttgobj.normaltemptopersistant(pos : longint);
+      var
+        hp : ptemprecord;
+      begin
+         hp:=templist;
+         while assigned(hp) do
+           if (hp^.pos=pos) and (hp^.temptype=tt_normal) then
+             begin
+{$ifdef EXTDEBUG}
+               Comment(V_Debug,'temp managment : normaltemptopersistant()'+
+                  ' at pos '+tostr(pos)+ ' found !');
+{$endif}
+                hp^.temptype:=tt_persistant;
+                exit;
+             end
+           else
+             hp:=hp^.next;
+{$ifdef EXTDEBUG}
+         Comment(V_Debug,'temp managment problem : normaltemptopersistant()'+
+            ' at pos '+tostr(pos)+ ' not found !');
+{$endif}
+      end;
+
+
+    function ttgobj.ungettemp(pos:longint;allowtype:ttemptype):ttemptype;
+      var
+         hp,hnext,hprev,hprevfree : ptemprecord;
+      begin
+         ungettemp:=tt_none;
+         hp:=templist;
+         hprev:=nil;
+         hprevfree:=nil;
+         while assigned(hp) do
+          begin
+            if (hp^.pos=pos) then
+             begin
+               { check type }
+               ungettemp:=hp^.temptype;
+               if hp^.temptype<>allowtype 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
+
+}

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