paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-10 09:28:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ changed the temp. generator to an object

Browse Source
This commit is contained in:
florian 1999-08-02 17:14:07 +00:00
parent e2302d38bc
commit a1fd4ac628
8 changed files with 819 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
compiler/new/cgobj.pas
View File

@ -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

77
compiler/new/i386/tgcpu.pas Normal file
View File

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

17
compiler/new/nmem.pas
View File

@ -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

11
compiler/new/nstatmnt.pas
View File

@ -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

6
compiler/new/pp.pas
View File

@ -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

7
compiler/new/psub.pas
View File

@ -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

696
compiler/new/tgobj.pas Normal file
View File

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

12
compiler/new/tree.pas
View File

@ -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