paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-07-13 23:46:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

* enable specifying the alignment mismatch of the frame/stack pointer

Browse Source 
relative to the normal stack alignment of the target (e.g., when using
    ebp as framepointer, all addresses are offset 8 to the stack pointer) in
    the temp generator. This enables allocating temps/locals with the correct
    alignment as long as the required alignment is not bigger than the
    guaranteed stack pointer alignment (fixes mantis #15582 on systems where
    the stack pointer is at least aligned to 16 bytes; e.g., not yet on
    i386-platforms other than darwin)

git-svn-id: trunk@22277 -
This commit is contained in:
Jonas Maebe 2012-09-02 14:32:05 +00:00
parent 4cae00f97a
commit a5cb157091
5 changed files with 157 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -12426,6 +12426,7 @@ tests/webtbs/tw15500.pp svneol=native#text/plain
tests/webtbs/tw15504.pp svneol=native#text/plain
tests/webtbs/tw15530.pp svneol=native#text/pascal
tests/webtbs/tw15571.pp svneol=native#text/pascal
tests/webtbs/tw15582.pp svneol=native#text/plain
tests/webtbs/tw15591.pp svneol=native#text/pascal
tests/webtbs/tw15592.pp svneol=native#text/plain
tests/webtbs/tw15599.pp svneol=native#text/plain
@ -13587,6 +13588,7 @@ tests/webtbs/uw13345y.pp svneol=native#text/plain
tests/webtbs/uw13583.pp svneol=native#text/plain
tests/webtbs/uw14124.pp svneol=native#text/plain
tests/webtbs/uw14958.pp svneol=native#text/plain
tests/webtbs/uw15582.pp svneol=native#text/plain
tests/webtbs/uw15591.pp svneol=native#text/pascal
tests/webtbs/uw15909.pp svneol=native#text/plain
tests/webtbs/uw15966.pp svneol=native#text/plain

4
compiler/i386/cpupi.pas
View File

@ -64,6 +64,10 @@ unit cpupi;
if not(po_assembler in procdef.procoptions) and
(tg.direction > 0) then
tg.setfirsttemp(tg.direction*maxpushedparasize);
if (tg.direction < 0) and
not(po_nostackframe in procdef.procoptions) then
{ compensate for the return address and the "pushl %ebp" }
tg.setalignmentmismatch(sizeof(pint)*2);
end;
end;

40
compiler/tgobj.pas
View File

@ -67,7 +67,11 @@ unit tgobj;
templist : ptemprecord;
{ Offsets of the first/last temp }
firsttemp,
lasttemp : longint;
lasttemp,
{ Offset of temp base register relative to guaranteed stack alignment
(note: currently only behaves as expected if it's a power of 2,
and if all requested alignments are also a power of 2) }
alignmismatch: longint;
direction : shortint;
constructor create;virtual;reintroduce;
{# Clear and free the complete linked list of temporary memory
@ -80,6 +84,7 @@ unit tgobj;
@param(l start offset where temps will start in stack)
}
procedure setfirsttemp(l : longint); virtual;
procedure setalignmentmismatch(l : longint); virtual;
{ version of gettemp that is compatible with hlcg-based targets;
always use in common code, only use gettemp in cgobj and
@ -206,6 +211,7 @@ implementation
tempfreelist:=nil;
firsttemp:=0;
lasttemp:=0;
alignmismatch:=0;
end;
@ -224,12 +230,19 @@ implementation
end;
procedure ttgobj.setalignmentmismatch(l: longint);
begin
alignmismatch:=l*direction;
end;
function ttgobj.AllocTemp(list: TAsmList; size,alignment : longint; temptype : ttemptype;def : tdef) : longint;
var
tl,htl,
bestslot,bestprev,
hprev,hp : ptemprecord;
freetype : ttemptype;
adjustedpos : longint;
bestatend,
fitatbegin,
fitatend : boolean;
@ -270,11 +283,12 @@ implementation
- share the same type
- contain enough space
- has a correct alignment }
adjustedpos:=hp^.pos+alignmismatch;
if (hp^.temptype=freetype) and
(hp^.def=def) and
(hp^.size>=size) and
((hp^.pos=align(hp^.pos,alignment)) or
(hp^.pos+hp^.size-size = align(hp^.pos+hp^.size-size,alignment))) then
((adjustedpos=align(adjustedpos,alignment)) or
(adjustedpos+hp^.size-size = align(adjustedpos+hp^.size-size,alignment))) then
begin
{ Slot is the same size then leave immediatly }
if (hp^.size=size) then
@ -293,25 +307,25 @@ implementation
{ still suffices. And we pick the block which will }
{ have the best alignmenment after this new block is }
{ substracted from it. }
fitatend:=(hp^.pos+hp^.size-size)=align(hp^.pos+hp^.size-size,alignment);
fitatbegin:=hp^.pos=align(hp^.pos,alignment);
fitatend:=(adjustedpos+hp^.size-size)=align(adjustedpos+hp^.size-size,alignment);
fitatbegin:=adjustedpos=align(adjustedpos,alignment);
if assigned(bestslot) then
begin
fitatend:=fitatend and
((not bestatend and
(direction=-1)) or
(bestatend and
isbetteralignedthan(abs(bestslot^.pos+hp^.size-size),abs(hp^.pos+hp^.size-size),current_settings.alignment.localalignmax)));
isbetteralignedthan(abs(bestslot^.pos+hp^.size-size),abs(adjustedpos+hp^.size-size),current_settings.alignment.localalignmax)));
fitatbegin:=fitatbegin and
(not bestatend or
(direction=1)) and
isbetteralignedthan(abs(hp^.pos+size),abs(bestslot^.pos+size),current_settings.alignment.localalignmax);
isbetteralignedthan(abs(adjustedpos+size),abs(bestslot^.pos+size),current_settings.alignment.localalignmax);
end;
if fitatend and
fitatbegin then
if isbetteralignedthan(abs(hp^.pos+hp^.size-size),abs(hp^.pos+size),current_settings.alignment.localalignmax) then
if isbetteralignedthan(abs(adjustedpos+hp^.size-size),abs(adjustedpos+size),current_settings.alignment.localalignmax) then
fitatbegin:=false
else if isbetteralignedthan(abs(hp^.pos+size),abs(hp^.pos+hp^.size-size),current_settings.alignment.localalignmax) then
else if isbetteralignedthan(abs(adjustedpos+size),abs(adjustedpos+hp^.size-size),current_settings.alignment.localalignmax) then
fitatend:=false
else if (direction=1) then
fitatend:=false
@ -392,13 +406,13 @@ implementation
{ Extend the temp }
if direction=-1 then
begin
lasttemp:=(-align(-lasttemp,alignment))-size;
tl^.pos:=lasttemp;
lasttemp:=(-align(-lasttemp-alignmismatch,alignment))-size-alignmismatch;
tl^.pos:=lasttemp;
end
else
begin
tl^.pos:=align(lasttemp,alignment);
lasttemp:=tl^.pos+size;
tl^.pos:=align(lasttemp+alignmismatch,alignment)-alignmismatch;
lasttemp:=tl^.pos+size;
end;
tl^.size:=size;

52
tests/webtbs/tw15582.pp Normal file
View File

@ -0,0 +1,52 @@
{ %cpu=x86_64,i386,powerpc,powerpc64}
{ %skiptarget=linux,freebsd,netbsd,openbsd,win32,os2,go32v2}
{ should actually only skip i386-variants of win32/linux/.. for now, but that can't be specified }
{ test can only work correctly (for now) on targets with 16-byte aligned stacks }
program tw15582;
{$MODE OBJFPC}{$H+}
{$codealign varmin=16}
{$codealign localmin=16}
uses
uw15582;
var g1,g2,g3 : byte;
g4 : integer;
g5 : byte;
g6 : array[0..39] of double;
procedure l;
var l1,l2,l3 : byte;
l4 : integer;
l5 : byte;
l6 : array[0..39] of double;
begin
check('l1',@l1);
check('l2',@l2);
check('l3',@l3);
check('l4',@l4);
check('l5',@l5);
check('l6',@l6);
end;
begin
check('g1',@g1);
check('g2',@g2);
check('g3',@g3);
check('g4',@g4);
check('g5',@g5);
check('g6',@g6);
l;
l_unit('main ');
l_unit_nostackframe;
writeln(n_checks,' tests. ',n_failed,' failed');
if n_failed > 0 then
halt(1);
end.

72
tests/webtbs/uw15582.pp Normal file
View File

@ -0,0 +1,72 @@
unit uw15582;
{$MODE OBJFPC}{$H+}
{$codealign varmin=16}
{$codealign localmin=16}
interface
var
n_checks : integer = 0;
n_failed : integer = 0;
procedure check(const v : string;p : pointer);
procedure l_unit(const pfx : string);
procedure l_unit_nostackframe;
implementation
var g1,g2,g3 : byte;
g4 : integer;
g5 : byte;
g6 : array[0..39] of double;
procedure check(const v : string;p : pointer);
begin
inc(n_checks);
if (ptruint(p) and ptruint(-16)) <> ptruint(p) then begin
writeln('Wrong aligned: "',v,'" : ',hexstr(p));
inc(n_failed);
end;
end;
procedure l_unit(const pfx : string);
var l1,l2,l3 : byte;
l4 : integer;
l5 : byte;
l6 : array[0..39] of double;
begin
check(pfx+'l_unit1',@l1);
check(pfx+'l_unit2',@l2);
check(pfx+'l_unit3',@l3);
check(pfx+'l_unit4',@l4);
check(pfx+'l_unit5',@l5);
check(pfx+'l_unit6',@l6);
end;
procedure l_unit_nostackframe;
var
b1, b2: byte;
begin
inc(n_checks);
if (ptruint(@b1) and ptruint(15)) <> 0 then
inc(n_failed);
inc(n_checks);
if (ptruint(@b2) and ptruint(15)) <> 0 then
inc(n_failed);
end;
initialization
check('g_unit1',@g1);
check('g_unit2',@g2);
check('g_unit3',@g3);
check('g_unit4',@g4);
check('g_unit5',@g5);
check('g_unit6',@g6);
l_unit('ca_unit.initialization ');
end.