|
@@ -37,23 +37,37 @@ unit temp_gen;
|
|
{$endif m68k}
|
|
{$endif m68k}
|
|
cobjects,globals,tree,hcodegen,verbose,files,aasm;
|
|
cobjects,globals,tree,hcodegen,verbose,files,aasm;
|
|
|
|
|
|
- type
|
|
|
|
-{ this saves some memory }
|
|
|
|
-{$ifdef TEST_MINENUMSIZE}
|
|
|
|
-{$ifdef FPC}
|
|
|
|
-{$minenumsize 1}
|
|
|
|
-{$endif FPC}
|
|
|
|
-{$endif TEST_MINENUMSIZE}
|
|
|
|
- ttemptype = (tt_normal,tt_ansistring,tt_widestring);
|
|
|
|
-{$ifdef TEST_MINENUMSIZE}
|
|
|
|
-{$ifdef FPC}
|
|
|
|
-{$minenumsize default}
|
|
|
|
-{$endif FPC}
|
|
|
|
-{$endif TEST_MINENUMSIZE}
|
|
|
|
|
|
+ type
|
|
|
|
+ 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;
|
|
|
|
+
|
|
|
|
+ var
|
|
|
|
+ { contains all temps }
|
|
|
|
+ templist : ptemprecord;
|
|
|
|
+ { contains all free temps using nextfree links }
|
|
|
|
+ tempfreelist : ptemprecord;
|
|
|
|
+ { Offsets of the first/last temp }
|
|
|
|
+ firsttemp,
|
|
|
|
+ lasttemp : longint;
|
|
|
|
+
|
|
{ generates temporary variables }
|
|
{ generates temporary variables }
|
|
procedure resettempgen;
|
|
procedure resettempgen;
|
|
procedure setfirsttemp(l : longint);
|
|
procedure setfirsttemp(l : longint);
|
|
function gettempsize : longint;
|
|
function gettempsize : longint;
|
|
|
|
+ function newtempofsize(size : longint) : longint;
|
|
function gettempofsize(size : longint) : longint;
|
|
function gettempofsize(size : longint) : longint;
|
|
{ special call for inlined procedures }
|
|
{ special call for inlined procedures }
|
|
function gettempofsizepersistant(size : longint) : longint;
|
|
function gettempofsizepersistant(size : longint) : longint;
|
|
@@ -62,30 +76,11 @@ unit temp_gen;
|
|
{procedure ungettemp(pos : longint;size : longint);}
|
|
{procedure ungettemp(pos : longint;size : longint);}
|
|
procedure ungetpersistanttemp(pos : longint;size : longint);
|
|
procedure ungetpersistanttemp(pos : longint;size : longint);
|
|
procedure gettempofsizereference(l : longint;var ref : treference);
|
|
procedure gettempofsizereference(l : longint;var ref : treference);
|
|
- procedure gettempslotreference(slottype : ttemptype;var ref : treference);
|
|
|
|
function istemp(const ref : treference) : boolean;
|
|
function istemp(const ref : treference) : boolean;
|
|
procedure ungetiftemp(const ref : treference);
|
|
procedure ungetiftemp(const ref : treference);
|
|
function ungetiftempansi(const ref : treference) : boolean;
|
|
function ungetiftempansi(const ref : treference) : boolean;
|
|
procedure gettempansistringreference(var ref : treference);
|
|
procedure gettempansistringreference(var ref : treference);
|
|
|
|
|
|
- type
|
|
|
|
- pfreerecord = ^tfreerecord;
|
|
|
|
-
|
|
|
|
- tfreerecord = record
|
|
|
|
- next : pfreerecord;
|
|
|
|
- pos : longint;
|
|
|
|
- size : longint;
|
|
|
|
- persistant : boolean; { used for inlined procedures }
|
|
|
|
- is_ansistring : boolean;
|
|
|
|
- is_freeansistring : boolean;
|
|
|
|
- temptype : ttemptype;
|
|
|
|
-{$ifdef EXTDEBUG}
|
|
|
|
- posinfo,releaseposinfo : tfileposinfo;
|
|
|
|
-{$endif}
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
- var
|
|
|
|
- tempansilist : pfreerecord;
|
|
|
|
|
|
|
|
implementation
|
|
implementation
|
|
|
|
|
|
@@ -99,73 +94,43 @@ unit temp_gen;
|
|
{$endif m68k}
|
|
{$endif m68k}
|
|
;
|
|
;
|
|
|
|
|
|
- var
|
|
|
|
- { contains all free temps }
|
|
|
|
- tmpfreelist : pfreerecord;
|
|
|
|
- { contains all used temps }
|
|
|
|
- templist : pfreerecord;
|
|
|
|
- { contains the slots for ansi/wide string temps }
|
|
|
|
- reftempslots : pfreerecord;
|
|
|
|
-{$ifdef EXTDEBUG}
|
|
|
|
- tempfreedlist : pfreerecord;
|
|
|
|
-{$endif}
|
|
|
|
- lastoccupied : longint;
|
|
|
|
- firsttemp, maxtemp : longint;
|
|
|
|
|
|
|
|
procedure resettempgen;
|
|
procedure resettempgen;
|
|
-
|
|
|
|
var
|
|
var
|
|
- hp : pfreerecord;
|
|
|
|
-
|
|
|
|
|
|
+ hp : ptemprecord;
|
|
begin
|
|
begin
|
|
- while assigned(tmpfreelist) do
|
|
|
|
- begin
|
|
|
|
- hp:=tmpfreelist;
|
|
|
|
- tmpfreelist:=hp^.next;
|
|
|
|
- dispose(hp);
|
|
|
|
- end;
|
|
|
|
- while assigned(templist) do
|
|
|
|
- begin
|
|
|
|
|
|
+ { Clear the old templist }
|
|
|
|
+ while assigned(templist) do
|
|
|
|
+ begin
|
|
{$ifdef EXTDEBUG}
|
|
{$ifdef EXTDEBUG}
|
|
- 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)+
|
|
|
|
|
|
+ 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');
|
|
' not freed at the end of the procedure');
|
|
-{$endif}
|
|
|
|
- hp:=templist;
|
|
|
|
- templist:=hp^.next;
|
|
|
|
- dispose(hp);
|
|
|
|
- end;
|
|
|
|
-{$ifdef EXTDEBUG}
|
|
|
|
- while assigned(tempfreedlist) do
|
|
|
|
- begin
|
|
|
|
- hp:=tempfreedlist;
|
|
|
|
- tempfreedlist:=hp^.next;
|
|
|
|
- dispose(hp);
|
|
|
|
|
|
+ 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;
|
|
end;
|
|
{$endif}
|
|
{$endif}
|
|
- while assigned(tempansilist) do
|
|
|
|
- begin
|
|
|
|
- hp:=tempansilist;
|
|
|
|
-{$ifdef EXTDEBUG}
|
|
|
|
- if not hp^.is_freeansistring then
|
|
|
|
- Comment(V_Warning,'temporary ANSI assignment of size '
|
|
|
|
- +tostr(hp^.size)+' from pos '+tostr(hp^.posinfo.line)
|
|
|
|
- +':'+tostr(hp^.posinfo.column)
|
|
|
|
- +' at pos '+tostr(hp^.pos)+
|
|
|
|
- ' not freed at the end of the procedure');
|
|
|
|
-{$endif}
|
|
|
|
- tempansilist:=hp^.next;
|
|
|
|
- dispose(hp);
|
|
|
|
- end;
|
|
|
|
- firsttemp:=0;
|
|
|
|
- maxtemp:=0;
|
|
|
|
- lastoccupied:=0;
|
|
|
|
|
|
+ hp:=templist;
|
|
|
|
+ templist:=hp^.next;
|
|
|
|
+ dispose(hp);
|
|
|
|
+ end;
|
|
|
|
+ templist:=nil;
|
|
|
|
+ tempfreelist:=nil;
|
|
|
|
+ firsttemp:=0;
|
|
|
|
+ lasttemp:=0;
|
|
end;
|
|
end;
|
|
|
|
|
|
- procedure setfirsttemp(l : longint);
|
|
|
|
|
|
|
|
|
|
+ procedure setfirsttemp(l : longint);
|
|
begin
|
|
begin
|
|
{ this is a negative value normally }
|
|
{ this is a negative value normally }
|
|
if l < 0 then
|
|
if l < 0 then
|
|
@@ -179,68 +144,108 @@ unit temp_gen;
|
|
Inc(l);
|
|
Inc(l);
|
|
end;
|
|
end;
|
|
firsttemp:=l;
|
|
firsttemp:=l;
|
|
- maxtemp:=l;
|
|
|
|
- lastoccupied:=l;
|
|
|
|
|
|
+ lasttemp:=l;
|
|
end;
|
|
end;
|
|
|
|
|
|
- function gettempofsize(size : longint) : longint;
|
|
|
|
|
|
|
|
|
|
+ function newtempofsize(size : longint) : longint;
|
|
var
|
|
var
|
|
- tl,last,hp : pfreerecord;
|
|
|
|
- ofs : longint;
|
|
|
|
|
|
+ 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 gettempofsize(size : longint) : longint;
|
|
|
|
+ var
|
|
|
|
+ tl,
|
|
|
|
+ bestslot,bestprev,
|
|
|
|
+ hprev,hp : ptemprecord;
|
|
|
|
+ bestsize,ofs : longint;
|
|
begin
|
|
begin
|
|
- { this code comes from the heap management of FPC ... }
|
|
|
|
|
|
+ bestprev:=nil;
|
|
|
|
+ bestslot:=nil;
|
|
|
|
+ bestsize:=0;
|
|
|
|
+ { Align needed size on 4 bytes }
|
|
if (size mod 4)<>0 then
|
|
if (size mod 4)<>0 then
|
|
size:=size+(4-(size mod 4));
|
|
size:=size+(4-(size mod 4));
|
|
- ofs:=0;
|
|
|
|
- if assigned(tmpfreelist) then
|
|
|
|
|
|
+ { 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
|
|
begin
|
|
- last:=nil;
|
|
|
|
- hp:=tmpfreelist;
|
|
|
|
- while assigned(hp) do
|
|
|
|
- begin
|
|
|
|
- { first fit }
|
|
|
|
- if hp^.size>=size then
|
|
|
|
- begin
|
|
|
|
- ofs:=hp^.pos;
|
|
|
|
- { the whole block is needed ? }
|
|
|
|
- if hp^.size>size then
|
|
|
|
- begin
|
|
|
|
- dec(hp^.size,size);
|
|
|
|
- { the value is <0 so we need to add the size
|
|
|
|
- instead of sub (PFV) }
|
|
|
|
- inc(hp^.pos,size);
|
|
|
|
- end
|
|
|
|
- else
|
|
|
|
- begin
|
|
|
|
- if assigned(last) then
|
|
|
|
- last^.next:=hp^.next
|
|
|
|
- else
|
|
|
|
- tmpfreelist:=nil;
|
|
|
|
- dispose(hp);
|
|
|
|
- end;
|
|
|
|
- break;
|
|
|
|
- end;
|
|
|
|
- last:=hp;
|
|
|
|
- hp:=hp^.next;
|
|
|
|
- end;
|
|
|
|
|
|
+{$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:=size;
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+ hprev:=hp;
|
|
|
|
+ hp:=hp^.nextfree;
|
|
end;
|
|
end;
|
|
- { nothing free is big enough : expand temp }
|
|
|
|
- if ofs=0 then
|
|
|
|
- begin
|
|
|
|
- ofs:=lastoccupied-size;
|
|
|
|
- lastoccupied:=lastoccupied-size;
|
|
|
|
- if lastoccupied < maxtemp then
|
|
|
|
- maxtemp := lastoccupied;
|
|
|
|
- end;
|
|
|
|
- new(tl);
|
|
|
|
- tl^.pos:=ofs;
|
|
|
|
- tl^.size:=size;
|
|
|
|
- tl^.next:=templist;
|
|
|
|
- tl^.persistant:=false;
|
|
|
|
- tl^.temptype:=tt_normal;
|
|
|
|
- templist:=tl;
|
|
|
|
|
|
+ end;
|
|
|
|
+ { Reuse an old temp ? }
|
|
|
|
+ if assigned(bestslot) then
|
|
|
|
+ begin
|
|
|
|
+ ofs:=bestslot^.pos;
|
|
|
|
+ if bestsize=size then
|
|
|
|
+ begin
|
|
|
|
+ bestslot^.temptype:=tt_normal;
|
|
|
|
+ { Remove from the tempfreelist }
|
|
|
|
+ if assigned(bestprev) then
|
|
|
|
+ bestprev^.nextfree:=bestslot^.nextfree
|
|
|
|
+ else
|
|
|
|
+ tempfreelist:=nil;
|
|
|
|
+ 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;
|
|
|
|
+ tl^.size:=size;
|
|
|
|
+ tl^.nextfree:=nil;
|
|
|
|
+ { link the new block }
|
|
|
|
+ tl^.next:=bestslot^.next;
|
|
|
|
+ bestslot^.next:=tl;
|
|
|
|
+ end;
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ ofs:=newtempofsize(size);
|
|
{$ifdef EXTDEBUG}
|
|
{$ifdef EXTDEBUG}
|
|
tl^.posinfo:=aktfilepos;
|
|
tl^.posinfo:=aktfilepos;
|
|
{$endif}
|
|
{$endif}
|
|
@@ -248,14 +253,13 @@ unit temp_gen;
|
|
gettempofsize:=ofs;
|
|
gettempofsize:=ofs;
|
|
end;
|
|
end;
|
|
|
|
|
|
- function gettempofsizepersistant(size : longint) : longint;
|
|
|
|
|
|
|
|
|
|
+ function gettempofsizepersistant(size : longint) : longint;
|
|
var
|
|
var
|
|
l : longint;
|
|
l : longint;
|
|
-
|
|
|
|
begin
|
|
begin
|
|
l:=gettempofsize(size);
|
|
l:=gettempofsize(size);
|
|
- templist^.persistant:=true;
|
|
|
|
|
|
+ templist^.temptype:=tt_persistant;
|
|
{$ifdef EXTDEBUG}
|
|
{$ifdef EXTDEBUG}
|
|
Comment(V_Debug,'temp managment : call to gettempofsizepersistant()'+
|
|
Comment(V_Debug,'temp managment : call to gettempofsizepersistant()'+
|
|
' with size '+tostr(size)+' returned '+tostr(l));
|
|
' with size '+tostr(size)+' returned '+tostr(l));
|
|
@@ -263,29 +267,14 @@ unit temp_gen;
|
|
gettempofsizepersistant:=l;
|
|
gettempofsizepersistant:=l;
|
|
end;
|
|
end;
|
|
|
|
|
|
- function gettempsize : longint;
|
|
|
|
|
|
|
|
|
|
+ function gettempsize : longint;
|
|
begin
|
|
begin
|
|
-{$ifdef i386}
|
|
|
|
-
|
|
|
|
- { align local data to dwords }
|
|
|
|
- if (maxtemp mod 4)<>0 then
|
|
|
|
- dec(maxtemp,4+(maxtemp mod 4));
|
|
|
|
-{$endif}
|
|
|
|
-{$ifdef m68k}
|
|
|
|
-
|
|
|
|
- { we only push words and we want to stay on }
|
|
|
|
- { even stack addresses }
|
|
|
|
- { maxtemp is negative }
|
|
|
|
- if (maxtemp mod 2)<>0 then
|
|
|
|
- dec(maxtemp);
|
|
|
|
-{$endif}
|
|
|
|
-
|
|
|
|
- gettempsize:=-maxtemp;
|
|
|
|
|
|
+ gettempsize:=-lasttemp;
|
|
end;
|
|
end;
|
|
|
|
|
|
- procedure gettempofsizereference(l : longint;var ref : treference);
|
|
|
|
|
|
|
|
|
|
+ procedure gettempofsizereference(l : longint;var ref : treference);
|
|
begin
|
|
begin
|
|
{ do a reset, because the reference isn't used }
|
|
{ do a reset, because the reference isn't used }
|
|
reset_reference(ref);
|
|
reset_reference(ref);
|
|
@@ -293,57 +282,40 @@ unit temp_gen;
|
|
ref.base:=procinfo.framepointer;
|
|
ref.base:=procinfo.framepointer;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+
|
|
function gettempansioffset : longint;
|
|
function gettempansioffset : longint;
|
|
var
|
|
var
|
|
- ofs : longint;
|
|
|
|
- tl : pfreerecord;
|
|
|
|
|
|
+ ofs : longint;
|
|
|
|
+ foundslot,tl : ptemprecord;
|
|
begin
|
|
begin
|
|
- tl:=tempansilist;
|
|
|
|
|
|
+ { Reuse old ansi slot ? }
|
|
|
|
+ foundslot:=nil;
|
|
|
|
+ tl:=templist;
|
|
while assigned(tl) do
|
|
while assigned(tl) do
|
|
- begin
|
|
|
|
- if tl^.is_freeansistring then
|
|
|
|
- break;
|
|
|
|
- tl:=tl^.next;
|
|
|
|
- end;
|
|
|
|
- if assigned(tl) then
|
|
|
|
- begin
|
|
|
|
- tl^.is_freeansistring:=false;
|
|
|
|
- ofs:=tl^.pos;
|
|
|
|
- end
|
|
|
|
|
|
+ begin
|
|
|
|
+ if tl^.temptype=tt_freeansistring then
|
|
|
|
+ begin
|
|
|
|
+ foundslot:=tl;
|
|
|
|
+ break;
|
|
|
|
+ end;
|
|
|
|
+ tl:=tl^.next;
|
|
|
|
+ end;
|
|
|
|
+ if assigned(foundslot) then
|
|
|
|
+ begin
|
|
|
|
+ foundslot^.temptype:=tt_ansistring;
|
|
|
|
+ ofs:=foundslot^.pos;
|
|
|
|
+ end
|
|
else
|
|
else
|
|
- begin
|
|
|
|
- if lastoccupied<>maxtemp then
|
|
|
|
- begin
|
|
|
|
- { we cannnot use already used temp
|
|
|
|
- so we need to convert that space into
|
|
|
|
- a tempfreeitem ! }
|
|
|
|
- new(tl);
|
|
|
|
- tl^.pos:=maxtemp;
|
|
|
|
- tl^.size:=lastoccupied-maxtemp;
|
|
|
|
- tl^.next:=tmpfreelist;
|
|
|
|
- lastoccupied:=maxtemp;
|
|
|
|
- tl^.persistant:=false;
|
|
|
|
- tl^.is_ansistring:=false;
|
|
|
|
- tl^.is_freeansistring:=false;
|
|
|
|
- tmpfreelist:=tl;
|
|
|
|
- end;
|
|
|
|
- ofs:=maxtemp-target_os.size_of_pointer;
|
|
|
|
- maxtemp:=maxtemp-target_os.size_of_pointer;
|
|
|
|
- new(tl);
|
|
|
|
- tl^.pos:=ofs;
|
|
|
|
- tl^.size:=target_os.size_of_pointer;
|
|
|
|
- tl^.next:=tempansilist;
|
|
|
|
- tl^.persistant:=false;
|
|
|
|
- tl^.is_ansistring:=true;
|
|
|
|
- tl^.is_freeansistring:=false;
|
|
|
|
- tempansilist:=tl;
|
|
|
|
- end;
|
|
|
|
|
|
+ begin
|
|
|
|
+ ofs:=newtempofsize(target_os.size_of_pointer);
|
|
|
|
+ templist^.temptype:=tt_ansistring;
|
|
|
|
+ end;
|
|
|
|
+ exprasmlist^.concat(new(paitempalloc,alloc(ofs,target_os.size_of_pointer)));
|
|
gettempansioffset:=ofs;
|
|
gettempansioffset:=ofs;
|
|
- exprasmlist^.concat(new(paitempalloc,alloc(tl^.pos,tl^.size)));
|
|
|
|
end;
|
|
end;
|
|
|
|
|
|
- procedure gettempansistringreference(var ref : treference);
|
|
|
|
|
|
|
|
|
|
+ procedure gettempansistringreference(var ref : treference);
|
|
begin
|
|
begin
|
|
{ do a reset, because the reference isn't used }
|
|
{ do a reset, because the reference isn't used }
|
|
reset_reference(ref);
|
|
reset_reference(ref);
|
|
@@ -351,304 +323,180 @@ unit temp_gen;
|
|
ref.base:=procinfo.framepointer;
|
|
ref.base:=procinfo.framepointer;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+
|
|
function ungetiftempansi(const ref : treference) : boolean;
|
|
function ungetiftempansi(const ref : treference) : boolean;
|
|
var
|
|
var
|
|
- tl : pfreerecord;
|
|
|
|
|
|
+ tl : ptemprecord;
|
|
begin
|
|
begin
|
|
- ungetiftempansi:=false;
|
|
|
|
- tl:=tempansilist;
|
|
|
|
- while assigned(tl) do
|
|
|
|
- begin
|
|
|
|
- if tl^.pos=ref.offset then
|
|
|
|
- if tl^.is_ansistring and not tl^.is_freeansistring then
|
|
|
|
- begin
|
|
|
|
- tl^.is_freeansistring:=true;
|
|
|
|
- ungetiftempansi:=true;
|
|
|
|
- exprasmlist^.concat(new(paitempalloc,dealloc(tl^.pos,tl^.size)));
|
|
|
|
- exit;
|
|
|
|
|
|
+ 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}
|
|
{$ifdef EXTDEBUG}
|
|
- end
|
|
|
|
- else
|
|
|
|
- begin
|
|
|
|
- Comment(V_Debug,'temp ansi managment problem : ungetiftempansi()'+
|
|
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ begin
|
|
|
|
+ Comment(V_Debug,'temp ansi managment problem : ungetiftempansi()'+
|
|
' at pos '+tostr(ref.offset)+ ' already free !');
|
|
' at pos '+tostr(ref.offset)+ ' already free !');
|
|
{$endif}
|
|
{$endif}
|
|
- end;
|
|
|
|
- tl:=tl^.next;
|
|
|
|
- end;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
- procedure gettempslotreference(slottype : ttemptype;var ref : treference);
|
|
|
|
- begin
|
|
|
|
- { do a reset, because the reference isn't used }
|
|
|
|
- reset_reference(ref);
|
|
|
|
- { this is not enough in my opinion PM }
|
|
|
|
- { because it still can mix different types !! }
|
|
|
|
- ref.offset:=gettempofsize(4);
|
|
|
|
- ref.base:=procinfo.framepointer;
|
|
|
|
- templist^.temptype:=slottype;
|
|
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+ tl:=tl^.next;
|
|
|
|
+ end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
function istemp(const ref : treference) : boolean;
|
|
function istemp(const ref : treference) : boolean;
|
|
-
|
|
|
|
begin
|
|
begin
|
|
{ ref.index = R_NO was missing
|
|
{ ref.index = R_NO was missing
|
|
led to problems with local arrays
|
|
led to problems with local arrays
|
|
with lower bound > 0 (PM) }
|
|
with lower bound > 0 (PM) }
|
|
istemp:=((ref.base=procinfo.framepointer) and
|
|
istemp:=((ref.base=procinfo.framepointer) and
|
|
- (ref.offset<firsttemp) and (ref.index=R_NO));
|
|
|
|
|
|
+ (ref.index=R_NO) and
|
|
|
|
+ (ref.offset<firsttemp));
|
|
end;
|
|
end;
|
|
|
|
|
|
- procedure persistanttemptonormal(pos : longint);
|
|
|
|
-
|
|
|
|
- var hp : pfreerecord;
|
|
|
|
|
|
|
|
|
|
+ procedure persistanttemptonormal(pos : longint);
|
|
|
|
+ var
|
|
|
|
+ hp : ptemprecord;
|
|
begin
|
|
begin
|
|
hp:=templist;
|
|
hp:=templist;
|
|
while assigned(hp) do
|
|
while assigned(hp) do
|
|
- if (hp^.persistant) and (hp^.pos=pos) then
|
|
|
|
|
|
+ if (hp^.pos=pos) and (hp^.temptype=tt_persistant) then
|
|
begin
|
|
begin
|
|
{$ifdef EXTDEBUG}
|
|
{$ifdef EXTDEBUG}
|
|
- Comment(V_Debug,'temp managment : persistanttemptonormal()'+
|
|
|
|
- ' at pos '+tostr(pos)+ ' found !');
|
|
|
|
|
|
+ Comment(V_Debug,'temp managment : persistanttemptonormal()'+
|
|
|
|
+ ' at pos '+tostr(pos)+ ' found !');
|
|
{$endif}
|
|
{$endif}
|
|
- hp^.persistant:=false;
|
|
|
|
|
|
+ hp^.temptype:=tt_normal;
|
|
exit;
|
|
exit;
|
|
end
|
|
end
|
|
else
|
|
else
|
|
hp:=hp^.next;
|
|
hp:=hp^.next;
|
|
{$ifdef EXTDEBUG}
|
|
{$ifdef EXTDEBUG}
|
|
- Comment(V_Debug,'temp managment problem : persistanttemptonormal()'+
|
|
|
|
- ' at pos '+tostr(pos)+ ' not found !');
|
|
|
|
|
|
+ Comment(V_Debug,'temp managment problem : persistanttemptonormal()'+
|
|
|
|
+ ' at pos '+tostr(pos)+ ' not found !');
|
|
{$endif}
|
|
{$endif}
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
- procedure ungettemp(pos : longint;size : longint);
|
|
|
|
-
|
|
|
|
|
|
+ function ungettemp(pos:longint;allowtype:ttemptype):ttemptype;
|
|
var
|
|
var
|
|
- hp,newhp : pfreerecord;
|
|
|
|
-
|
|
|
|
|
|
+ hp,hnext,hprev,hprevfree : ptemprecord;
|
|
begin
|
|
begin
|
|
- if (size mod 4)<>0 then
|
|
|
|
- size:=size+(4-(size mod 4));
|
|
|
|
- if size = 0 then
|
|
|
|
- exit;
|
|
|
|
- exprasmlist^.concat(new(paitempalloc,dealloc(pos,size)));
|
|
|
|
- if pos<=lastoccupied then
|
|
|
|
- if pos=lastoccupied then
|
|
|
|
- begin
|
|
|
|
- lastoccupied:=pos+size;
|
|
|
|
- hp:=tmpfreelist;
|
|
|
|
- newhp:=nil;
|
|
|
|
- while assigned(hp) do
|
|
|
|
- begin
|
|
|
|
- { conneting a free block }
|
|
|
|
- if hp^.pos=lastoccupied then
|
|
|
|
- begin
|
|
|
|
- if assigned(newhp) then newhp^.next:=nil
|
|
|
|
- else tmpfreelist:=nil;
|
|
|
|
- lastoccupied:=lastoccupied+hp^.size;
|
|
|
|
- dispose(hp);
|
|
|
|
- break;
|
|
|
|
- end;
|
|
|
|
- newhp:=hp;
|
|
|
|
- hp:=hp^.next;
|
|
|
|
- end;
|
|
|
|
- end
|
|
|
|
- else
|
|
|
|
|
|
+ ungettemp:=tt_none;
|
|
|
|
+ hp:=templist;
|
|
|
|
+ hprev:=nil;
|
|
|
|
+ hprevfree:=nil;
|
|
|
|
+ while assigned(hp) do
|
|
|
|
+ begin
|
|
|
|
+ if (hp^.pos=pos) then
|
|
begin
|
|
begin
|
|
-{$ifdef EXTDEBUG}
|
|
|
|
- Comment(V_Warning,'temp managment problem : ungettemp()'+
|
|
|
|
- 'pos '+tostr(pos)+ '< lastoccupied '+tostr(lastoccupied)+' !');
|
|
|
|
-{$endif}
|
|
|
|
- end
|
|
|
|
- else
|
|
|
|
- begin
|
|
|
|
- new(newhp);
|
|
|
|
- { size can be allways set }
|
|
|
|
- newhp^.size:=size;
|
|
|
|
- newhp^.pos := pos;
|
|
|
|
- { if there is no free list }
|
|
|
|
- if not assigned(tmpfreelist) then
|
|
|
|
|
|
+ { check type }
|
|
|
|
+ if hp^.temptype<>allowtype then
|
|
begin
|
|
begin
|
|
- { then generate one }
|
|
|
|
- tmpfreelist:=newhp;
|
|
|
|
- newhp^.next:=nil;
|
|
|
|
- exit;
|
|
|
|
|
|
+ ungettemp:=hp^.temptype;
|
|
|
|
+ exit;
|
|
end;
|
|
end;
|
|
- { search the position to insert }
|
|
|
|
- hp:=tmpfreelist;
|
|
|
|
- while assigned(hp) do
|
|
|
|
|
|
+ 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
|
|
begin
|
|
- { conneting two blocks ? }
|
|
|
|
- if hp^.pos+hp^.size=pos then
|
|
|
|
- begin
|
|
|
|
- inc(hp^.size,size);
|
|
|
|
- dispose(newhp);
|
|
|
|
- break;
|
|
|
|
- end
|
|
|
|
- { if the end is reached, then concat }
|
|
|
|
- else if hp^.next=nil then
|
|
|
|
- begin
|
|
|
|
- hp^.next:=newhp;
|
|
|
|
- newhp^.next:=nil;
|
|
|
|
- break;
|
|
|
|
- end
|
|
|
|
- { falls der n„chste Zeiger gr”áer ist, dann }
|
|
|
|
- { Einh„ngen }
|
|
|
|
- else if hp^.next^.pos<=pos+size then
|
|
|
|
- begin
|
|
|
|
- { concat two blocks ? }
|
|
|
|
- if pos+size=hp^.next^.pos then
|
|
|
|
- begin
|
|
|
|
- newhp^.next:=hp^.next^.next;
|
|
|
|
- inc(newhp^.size,hp^.next^.size);
|
|
|
|
- dispose(hp^.next);
|
|
|
|
- hp^.next:=newhp;
|
|
|
|
- end
|
|
|
|
- else
|
|
|
|
- begin
|
|
|
|
- newhp^.next:=hp^.next;
|
|
|
|
- hp^.next:=newhp;
|
|
|
|
- end;
|
|
|
|
- break;
|
|
|
|
- end;
|
|
|
|
- hp:=hp^.next;
|
|
|
|
|
|
+ { 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;
|
|
end;
|
|
- 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;
|
|
end;
|
|
|
|
|
|
- procedure ungetpersistanttemp(pos : longint;size : longint);
|
|
|
|
- var
|
|
|
|
- prev,hp : pfreerecord;
|
|
|
|
|
|
|
|
|
|
+ procedure ungetpersistanttemp(pos : longint;size : longint);
|
|
begin
|
|
begin
|
|
- ungettemp(pos,size);
|
|
|
|
- prev:=nil;
|
|
|
|
- hp:=templist;
|
|
|
|
- while assigned(hp) do
|
|
|
|
- begin
|
|
|
|
- if (hp^.persistant) and (hp^.pos=pos) and (hp^.size=size) then
|
|
|
|
- begin
|
|
|
|
- if assigned(prev) then
|
|
|
|
- prev^.next:=hp^.next
|
|
|
|
- else
|
|
|
|
- templist:=hp^.next;
|
|
|
|
{$ifdef EXTDEBUG}
|
|
{$ifdef EXTDEBUG}
|
|
- Comment(V_Debug,'temp managment : ungetpersistanttemp()'+
|
|
|
|
- ' at pos '+tostr(pos)+ ' found !');
|
|
|
|
- hp^.next:=tempfreedlist;
|
|
|
|
- tempfreedlist:=hp;
|
|
|
|
- hp^.releaseposinfo:=aktfilepos;
|
|
|
|
|
|
+ if ungettemp(pos,tt_persistant)<>tt_persistant then
|
|
|
|
+ Comment(V_Warning,'temp managment problem : ungetpersistanttemp()'+
|
|
|
|
+ ' at pos '+tostr(pos)+ ' not found !');
|
|
{$else}
|
|
{$else}
|
|
- dispose(hp);
|
|
|
|
-{$endif}
|
|
|
|
- exit;
|
|
|
|
- end;
|
|
|
|
- prev:=hp;
|
|
|
|
- hp:=hp^.next;
|
|
|
|
- end;
|
|
|
|
-{$ifdef EXTDEBUG}
|
|
|
|
- Comment(V_Warning,'temp managment problem : ungetpersistanttemp()'+
|
|
|
|
- ' at pos '+tostr(pos)+ ' not found !');
|
|
|
|
|
|
+ ungettemp(pos,tt_persistant);
|
|
{$endif}
|
|
{$endif}
|
|
end;
|
|
end;
|
|
|
|
|
|
- procedure ungetiftemp(const ref : treference);
|
|
|
|
|
|
|
|
|
|
+ procedure ungetiftemp(const ref : treference);
|
|
var
|
|
var
|
|
- tl,prev : pfreerecord;
|
|
|
|
-
|
|
|
|
|
|
+ tt : ttemptype;
|
|
begin
|
|
begin
|
|
if istemp(ref) then
|
|
if istemp(ref) then
|
|
begin
|
|
begin
|
|
{ first check if ansistring }
|
|
{ first check if ansistring }
|
|
if ungetiftempansi(ref) then
|
|
if ungetiftempansi(ref) then
|
|
exit;
|
|
exit;
|
|
- prev:=nil;
|
|
|
|
- tl:=templist;
|
|
|
|
- while assigned(tl) do
|
|
|
|
- begin
|
|
|
|
- { no release of persistant blocks this way!! }
|
|
|
|
- if (tl^.persistant) or (tl^.temptype<>tt_normal) then
|
|
|
|
- if (ref.offset>=tl^.pos) and
|
|
|
|
- (ref.offset<tl^.pos+tl^.size) then
|
|
|
|
- begin
|
|
|
|
-{$ifdef EXTDEBUG}
|
|
|
|
- Comment(V_Debug,'temp '+
|
|
|
|
- ' at pos '+tostr(ref.offset)+ ' not released because persistant or slot!');
|
|
|
|
-{$endif}
|
|
|
|
- exit;
|
|
|
|
- end;
|
|
|
|
- if (ref.offset=tl^.pos) then
|
|
|
|
- begin
|
|
|
|
- ungettemp(ref.offset,tl^.size);
|
|
|
|
-{$ifdef TEMPDEBUG}
|
|
|
|
- Comment(V_Debug,'temp managment : ungettemp()'+
|
|
|
|
- ' at pos '+tostr(tl^.pos)+ ' found !');
|
|
|
|
-{$endif}
|
|
|
|
- if assigned(prev) then
|
|
|
|
- prev^.next:=tl^.next
|
|
|
|
- else
|
|
|
|
- templist:=tl^.next;
|
|
|
|
|
|
+ tt:=ungettemp(ref.offset,tt_normal);
|
|
{$ifdef EXTDEBUG}
|
|
{$ifdef EXTDEBUG}
|
|
- tl^.next:=tempfreedlist;
|
|
|
|
- tempfreedlist:=tl;
|
|
|
|
- tl^.releaseposinfo:=aktfilepos;
|
|
|
|
-{$else}
|
|
|
|
- dispose(tl);
|
|
|
|
|
|
+ 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}
|
|
{$endif}
|
|
- exit;
|
|
|
|
- end
|
|
|
|
- else
|
|
|
|
- begin
|
|
|
|
- prev:=tl;
|
|
|
|
- tl:=tl^.next;
|
|
|
|
- end;
|
|
|
|
- end;
|
|
|
|
-{$ifdef EXTDEBUG}
|
|
|
|
- Comment(V_Warning,'Internal: temp managment problem : '+
|
|
|
|
- 'temp not found for release at offset '+tostr(ref.offset));
|
|
|
|
- tl:=tempfreedlist;
|
|
|
|
- while assigned(tl) do
|
|
|
|
- begin
|
|
|
|
- if (ref.offset=tl^.pos) then
|
|
|
|
- begin
|
|
|
|
- Comment(V_Warning,'Last temporary assignment of size '
|
|
|
|
- +tostr(tl^.size)+' from pos '+tostr(tl^.posinfo.line)
|
|
|
|
- +':'+tostr(tl^.posinfo.column)
|
|
|
|
- +' at pos '+tostr(tl^.pos)+
|
|
|
|
- ' has been already freed at '
|
|
|
|
- +tostr(tl^.releaseposinfo.line)
|
|
|
|
- +':'+tostr(tl^.releaseposinfo.column)
|
|
|
|
- );
|
|
|
|
- Exit;
|
|
|
|
- end;
|
|
|
|
- tl:=tl^.next;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-{$endIf}
|
|
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
- procedure inittemps;
|
|
|
|
|
|
|
|
|
|
+ procedure inittemps;
|
|
begin
|
|
begin
|
|
- { hp:=temp }
|
|
|
|
|
|
+ tempfreelist:=nil;
|
|
|
|
+ templist:=nil;
|
|
end;
|
|
end;
|
|
|
|
|
|
begin
|
|
begin
|
|
- tmpfreelist:=nil;
|
|
|
|
- templist:=nil;
|
|
|
|
- reftempslots:=nil;
|
|
|
|
- { just to be sure }
|
|
|
|
- tempansilist:=nil;
|
|
|
|
|
|
+ InitTemps;
|
|
end.
|
|
end.
|
|
{
|
|
{
|
|
$Log$
|
|
$Log$
|
|
- Revision 1.21 1999-05-01 13:24:59 peter
|
|
|
|
|
|
+ Revision 1.22 1999-05-15 21:33:21 peter
|
|
|
|
+ * redesigned temp_gen temp allocation so temp allocation for
|
|
|
|
+ ansistring works correct. It also does a best fit instead of first fit
|
|
|
|
+
|
|
|
|
+ Revision 1.21 1999/05/01 13:24:59 peter
|
|
* merged nasm compiler
|
|
* merged nasm compiler
|
|
* old asm moved to oldasm/
|
|
* old asm moved to oldasm/
|
|
|
|
|