mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 22:09:28 +02:00
* do not join register deallocations/allocations as it makes no use and causes later on trouble in
the assembler optimizer as register allocations are not correct, resolves #33565 git-svn-id: trunk@43384 -
This commit is contained in:
parent
a09c0a6857
commit
c6659d62f8
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -17736,6 +17736,7 @@ tests/webtbs/tw33548.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw3356.pp svneol=native#text/plain
|
tests/webtbs/tw3356.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw33563.pp svneol=native#text/pascal
|
tests/webtbs/tw33563.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw33564.pp svneol=native#text/pascal
|
tests/webtbs/tw33564.pp svneol=native#text/pascal
|
||||||
|
tests/webtbs/tw33565.pp -text svneol=native#text/pascal
|
||||||
tests/webtbs/tw3360.pp svneol=native#text/plain
|
tests/webtbs/tw3360.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw33607.pp svneol=native#text/plain
|
tests/webtbs/tw33607.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw33635.pp svneol=native#text/pascal
|
tests/webtbs/tw33635.pp svneol=native#text/pascal
|
||||||
|
@ -2047,29 +2047,6 @@ unit rgobj;
|
|||||||
internalerror(2015040501);
|
internalerror(2015040501);
|
||||||
{$endif}
|
{$endif}
|
||||||
setsupreg(reg,u);
|
setsupreg(reg,u);
|
||||||
{
|
|
||||||
Remove sequences of release and
|
|
||||||
allocation of the same register like. Other combinations
|
|
||||||
of release/allocate need to stay in the list.
|
|
||||||
|
|
||||||
# Register X released
|
|
||||||
# Register X allocated
|
|
||||||
}
|
|
||||||
if assigned(previous) and
|
|
||||||
(ratype=ra_alloc) and
|
|
||||||
(Tai(previous).typ=ait_regalloc) and
|
|
||||||
(Tai_regalloc(previous).reg=reg) and
|
|
||||||
(Tai_regalloc(previous).ratype=ra_dealloc) then
|
|
||||||
begin
|
|
||||||
q:=Tai(next);
|
|
||||||
hp:=tai(previous);
|
|
||||||
list.remove(hp);
|
|
||||||
hp.free;
|
|
||||||
list.remove(p);
|
|
||||||
p.free;
|
|
||||||
p:=q;
|
|
||||||
continue;
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
32
tests/webtbs/tw33565.pp
Normal file
32
tests/webtbs/tw33565.pp
Normal file
@ -0,0 +1,32 @@
|
|||||||
|
{ %OPT=-O- -OoREGVAR -Oolevel1 -Cr -Mobjfpc -Oopeephole }
|
||||||
|
program app_test_core;
|
||||||
|
|
||||||
|
uses
|
||||||
|
|
||||||
|
SysUtils, Classes;
|
||||||
|
|
||||||
|
procedure SetMemory(Stream: TStream; var P: Pointer; var PSize: Integer);
|
||||||
|
begin
|
||||||
|
PSize := Stream.Size;
|
||||||
|
GetMem(P, PSize);
|
||||||
|
Stream.Position := 0;
|
||||||
|
Stream.Read(P^, PSize);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
M: TMemoryStream;
|
||||||
|
L, V: Integer;
|
||||||
|
P: Pointer;
|
||||||
|
begin
|
||||||
|
M := TMemoryStream.Create;
|
||||||
|
V := -1;
|
||||||
|
M.Write(V, SizeOf(V));
|
||||||
|
M.Position := 0;
|
||||||
|
|
||||||
|
P := nil;
|
||||||
|
L := 0;
|
||||||
|
SetMemory(M, P, L);
|
||||||
|
FreeMem(P);
|
||||||
|
|
||||||
|
M.Free;
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user