diff --git a/.gitattributes b/.gitattributes index b48439ea9f..1f35dec39b 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/compiler/i386/cpupi.pas b/compiler/i386/cpupi.pas index 426a188eae..2d071446fd 100644 --- a/compiler/i386/cpupi.pas +++ b/compiler/i386/cpupi.pas @@ -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; diff --git a/compiler/tgobj.pas b/compiler/tgobj.pas index b998e06f51..687fcb272b 100644 --- a/compiler/tgobj.pas +++ b/compiler/tgobj.pas @@ -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; diff --git a/tests/webtbs/tw15582.pp b/tests/webtbs/tw15582.pp new file mode 100644 index 0000000000..06c57e91c7 --- /dev/null +++ b/tests/webtbs/tw15582.pp @@ -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. diff --git a/tests/webtbs/uw15582.pp b/tests/webtbs/uw15582.pp new file mode 100644 index 0000000000..0a5e33508a --- /dev/null +++ b/tests/webtbs/uw15582.pp @@ -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.