mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-06 01:06:13 +02:00
* fixed crashes on direction=1 systems (mainly by Peter)
This commit is contained in:
parent
8b4751debf
commit
600f863e37
@ -103,8 +103,8 @@ unit tgobj;
|
|||||||
procedure ungetiftemp(list: taasmoutput; const ref : treference);
|
procedure ungetiftemp(list: taasmoutput; const ref : treference);
|
||||||
|
|
||||||
{ Allocate space for a local }
|
{ Allocate space for a local }
|
||||||
procedure getlocal(list: taasmoutput; size : longint;def:tdef;var ref : tparareference);
|
procedure getlocal(list: taasmoutput; size : longint;def:tdef;var ref : treference);
|
||||||
procedure UnGetLocal(list: taasmoutput; const ref : tparareference);
|
procedure UnGetLocal(list: taasmoutput; const ref : treference);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -159,19 +159,41 @@ unit tgobj;
|
|||||||
procedure ttgobj.resettempgen;
|
procedure ttgobj.resettempgen;
|
||||||
var
|
var
|
||||||
hp : ptemprecord;
|
hp : ptemprecord;
|
||||||
|
{$ifdef EXTDEBUG}
|
||||||
|
currpos,
|
||||||
|
lastpos : longint;
|
||||||
|
{$endif EXTDEBUG}
|
||||||
begin
|
begin
|
||||||
|
{$ifdef EXTDEBUG}
|
||||||
|
lastpos:=lasttemp;
|
||||||
|
{$endif EXTDEBUG}
|
||||||
{ Clear the old templist }
|
{ Clear the old templist }
|
||||||
while assigned(templist) do
|
while assigned(templist) do
|
||||||
begin
|
begin
|
||||||
{$ifdef EXTDEBUG}
|
{$ifdef EXTDEBUG}
|
||||||
if not(templist^.temptype in FreeTempTypes) then
|
if not(templist^.temptype in FreeTempTypes) then
|
||||||
begin
|
begin
|
||||||
Comment(V_Warning,'tgobj: (ResetTempgen) temp at pos '+tostr(templist^.pos)+
|
Comment(V_Warning,'tgobj: (ResetTempgen) temp at pos '+tostr(templist^.pos)+
|
||||||
' with size '+tostr(templist^.size)+' and type '+TempTypeStr[templist^.temptype]+
|
' with size '+tostr(templist^.size)+' and type '+TempTypeStr[templist^.temptype]+
|
||||||
' from pos '+tostr(templist^.posinfo.line)+':'+tostr(templist^.posinfo.column)+
|
' from pos '+tostr(templist^.posinfo.line)+':'+tostr(templist^.posinfo.column)+
|
||||||
' not freed at the end of the procedure');
|
' not freed at the end of the procedure');
|
||||||
end;
|
end;
|
||||||
{$endif}
|
if direction=1 then
|
||||||
|
currpos:=templist^.pos+templist^.size
|
||||||
|
else
|
||||||
|
currpos:=templist^.pos;
|
||||||
|
if currpos<>lastpos then
|
||||||
|
begin
|
||||||
|
Comment(V_Warning,'tgobj: (ResetTempgen) temp at pos '+tostr(templist^.pos)+
|
||||||
|
' with size '+tostr(templist^.size)+' and type '+TempTypeStr[templist^.temptype]+
|
||||||
|
' from pos '+tostr(templist^.posinfo.line)+':'+tostr(templist^.posinfo.column)+
|
||||||
|
' was expected at position '+tostr(lastpos));
|
||||||
|
end;
|
||||||
|
if direction=1 then
|
||||||
|
lastpos:=templist^.pos
|
||||||
|
else
|
||||||
|
lastpos:=templist^.pos+templist^.size;
|
||||||
|
{$endif EXTDEBUG}
|
||||||
hp:=templist;
|
hp:=templist;
|
||||||
templist:=hp^.next;
|
templist:=hp^.next;
|
||||||
dispose(hp);
|
dispose(hp);
|
||||||
@ -200,7 +222,7 @@ unit tgobj;
|
|||||||
|
|
||||||
function ttgobj.AllocTemp(list: taasmoutput; size,alignment : longint; temptype : ttemptype;def : tdef) : longint;
|
function ttgobj.AllocTemp(list: taasmoutput; size,alignment : longint; temptype : ttemptype;def : tdef) : longint;
|
||||||
var
|
var
|
||||||
tl,
|
tl,htl,
|
||||||
bestslot,bestprev,
|
bestslot,bestprev,
|
||||||
hprev,hp : ptemprecord;
|
hprev,hp : ptemprecord;
|
||||||
bestsize : longint;
|
bestsize : longint;
|
||||||
@ -275,36 +297,45 @@ unit tgobj;
|
|||||||
if bestsize=size then
|
if bestsize=size then
|
||||||
begin
|
begin
|
||||||
tl:=bestslot;
|
tl:=bestslot;
|
||||||
tl^.temptype:=temptype;
|
|
||||||
tl^.def:=def;
|
|
||||||
{ Remove from the tempfreelist }
|
{ Remove from the tempfreelist }
|
||||||
if assigned(bestprev) then
|
if assigned(bestprev) then
|
||||||
bestprev^.nextfree:=tl^.nextfree
|
bestprev^.nextfree:=tl^.nextfree
|
||||||
else
|
else
|
||||||
tempfreelist:=tl^.nextfree;
|
tempfreelist:=tl^.nextfree;
|
||||||
tl^.nextfree:=nil;
|
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
{ Resize the old block }
|
{ Duplicate bestlost and the block in the list }
|
||||||
dec(bestslot^.size,size);
|
|
||||||
{ Create new block and link after bestslot }
|
|
||||||
new(tl);
|
new(tl);
|
||||||
tl^.temptype:=temptype;
|
move(bestslot^,tl^,sizeof(ttemprecord));
|
||||||
tl^.def:=def;
|
|
||||||
if direction=1 then
|
|
||||||
begin
|
|
||||||
tl^.pos:=bestslot^.pos;
|
|
||||||
inc(bestslot^.pos,size);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
tl^.pos:=bestslot^.pos+bestslot^.size;
|
|
||||||
tl^.size:=size;
|
|
||||||
tl^.nextfree:=nil;
|
|
||||||
{ link the new block }
|
|
||||||
tl^.next:=bestslot^.next;
|
tl^.next:=bestslot^.next;
|
||||||
bestslot^.next:=tl;
|
bestslot^.next:=tl;
|
||||||
|
{ Now we split the block in 2 parts. Depending on the direction
|
||||||
|
we need to resize the newly inserted block or the old reused block.
|
||||||
|
For direction=1 we can use tl for the new block. For direction=-1 we
|
||||||
|
will be reusing bestslot and resize the new block, that means we need
|
||||||
|
to swap the pointers }
|
||||||
|
if direction=-1 then
|
||||||
|
begin
|
||||||
|
htl:=tl;
|
||||||
|
tl:=bestslot;
|
||||||
|
bestslot:=htl;
|
||||||
|
{ Update the tempfreelist to point to the new block }
|
||||||
|
if assigned(bestprev) then
|
||||||
|
bestprev^.nextfree:=bestslot
|
||||||
|
else
|
||||||
|
tempfreelist:=bestslot;
|
||||||
|
end;
|
||||||
|
{ Create new block and resize the old block }
|
||||||
|
tl^.size:=size;
|
||||||
|
tl^.nextfree:=nil;
|
||||||
|
{ Resize the old block }
|
||||||
|
dec(bestslot^.size,size);
|
||||||
|
inc(bestslot^.pos,size);
|
||||||
end;
|
end;
|
||||||
|
tl^.temptype:=temptype;
|
||||||
|
tl^.def:=def;
|
||||||
|
tl^.nextfree:=nil;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
@ -404,7 +435,6 @@ unit tgobj;
|
|||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
hp^.nextfree:=tempfreelist;
|
hp^.nextfree:=tempfreelist;
|
||||||
|
|
||||||
tempfreelist:=hp;
|
tempfreelist:=hp;
|
||||||
end;
|
end;
|
||||||
{ Concat blocks when the next block is free and
|
{ Concat blocks when the next block is free and
|
||||||
@ -558,18 +588,21 @@ unit tgobj;
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure ttgobj.getlocal(list: taasmoutput; size : longint;def:tdef;var ref : tparareference);
|
procedure ttgobj.getlocal(list: taasmoutput; size : longint;def:tdef;var ref : treference);
|
||||||
var
|
var
|
||||||
varalign : longint;
|
varalign : longint;
|
||||||
begin
|
begin
|
||||||
varalign:=def.alignment;
|
varalign:=def.alignment;
|
||||||
varalign:=used_align(varalign,aktalignment.localalignmin,aktalignment.localalignmax);
|
varalign:=used_align(varalign,aktalignment.localalignmin,aktalignment.localalignmax);
|
||||||
ref.index:=current_procinfo.framepointer;
|
{ can't use reference_reset_base, because that will let tgobj depend
|
||||||
|
on cgobj (PFV) }
|
||||||
|
fillchar(ref,sizeof(ref),0);
|
||||||
|
ref.base:=current_procinfo.framepointer;
|
||||||
ref.offset:=alloctemp(list,size,varalign,tt_persistent,nil);
|
ref.offset:=alloctemp(list,size,varalign,tt_persistent,nil);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure ttgobj.UnGetLocal(list: taasmoutput; const ref : tparareference);
|
procedure ttgobj.UnGetLocal(list: taasmoutput; const ref : treference);
|
||||||
begin
|
begin
|
||||||
FreeTemp(list,ref.offset,[tt_persistent]);
|
FreeTemp(list,ref.offset,[tt_persistent]);
|
||||||
end;
|
end;
|
||||||
@ -578,7 +611,17 @@ unit tgobj;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.45 2004-06-20 08:55:30 florian
|
Revision 1.46 2004-09-20 07:32:02 jonas
|
||||||
|
* fixed crashes on direction=1 systems (mainly by Peter)
|
||||||
|
|
||||||
|
Revision 1.45.4.2 2004/09/07 20:52:10 peter
|
||||||
|
* fix resizing of bestslot to preserve alignment for the returned
|
||||||
|
block
|
||||||
|
|
||||||
|
Revision 1.45.4.1 2004/08/31 20:43:06 peter
|
||||||
|
* paraloc patch
|
||||||
|
|
||||||
|
Revision 1.45 2004/06/20 08:55:30 florian
|
||||||
* logs truncated
|
* logs truncated
|
||||||
|
|
||||||
Revision 1.44 2004/06/16 20:07:10 florian
|
Revision 1.44 2004/06/16 20:07:10 florian
|
||||||
|
Loading…
Reference in New Issue
Block a user