* 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:
florian 2019-11-03 17:13:59 +00:00
parent a09c0a6857
commit c6659d62f8
3 changed files with 33 additions and 23 deletions

1
.gitattributes vendored
View File

@ -17736,6 +17736,7 @@ tests/webtbs/tw33548.pp svneol=native#text/plain
tests/webtbs/tw3356.pp svneol=native#text/plain
tests/webtbs/tw33563.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/tw33607.pp svneol=native#text/plain
tests/webtbs/tw33635.pp svneol=native#text/pascal

View File

@ -2047,29 +2047,6 @@ unit rgobj;
internalerror(2015040501);
{$endif}
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;

32
tests/webtbs/tw33565.pp Normal file
View 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.