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

* synchronized with trunk

Browse Source 
git-svn-id: branches/wasm@46920 -
This commit is contained in:
nickysn 2020-09-23 00:53:13 +00:00
commit 47eeaa0b83
11 changed files with 280 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -18510,6 +18510,7 @@ tests/webtbs/tw37650.pp svneol=native#text/pascal
tests/webtbs/tw3768.pp svneol=native#text/plain
tests/webtbs/tw3774.pp svneol=native#text/plain
tests/webtbs/tw3777.pp svneol=native#text/plain
tests/webtbs/tw37779.pp svneol=native#text/pascal
tests/webtbs/tw3778.pp svneol=native#text/plain
tests/webtbs/tw37780.pp svneol=native#text/plain
tests/webtbs/tw3780.pp svneol=native#text/plain

179
compiler/aarch64/aoptcpu.pas
View File

@ -39,6 +39,7 @@ Interface
TCpuAsmOptimizer = class(TARMAsmOptimizer)
{ uses the same constructor as TAopObj }
function PeepHoleOptPass1Cpu(var p: tai): boolean; override;
function PeepHoleOptPass2Cpu(var p: tai): boolean; override;
function PostPeepHoleOptsCpu(var p: tai): boolean; override;
function RegLoadedWithNewValue(reg: tregister; hp: tai): boolean;override;
function InstructionLoadsFromReg(const reg: TRegister; const hp: tai): boolean;override;
@ -51,6 +52,8 @@ Interface
function OptPass1STP(var p: tai): boolean;
function OptPass1Mov(var p: tai): boolean;
function OptPass1FMov(var p: tai): Boolean;
function OptPass2LDRSTR(var p: tai): boolean;
End;
Implementation
@ -526,6 +529,164 @@ Implementation
end;
function TCpuAsmOptimizer.OptPass2LDRSTR(var p: tai): boolean;
var
hp1, hp1_last: tai;
ThisRegister: TRegister;
OffsetVal, ValidOffset, MinOffset, MaxOffset: asizeint;
TargetOpcode: TAsmOp;
Breakout: Boolean;
begin
Result := False;
ThisRegister := taicpu(p).oper[0]^.reg;
case taicpu(p).opcode of
A_LDR:
TargetOpcode := A_LDP;
A_STR:
TargetOpcode := A_STP;
else
InternalError(2020081501);
end;
{ reg appearing in ref invalidates these optimisations }
if (TargetOpcode = A_STP) or not RegInRef(ThisRegister, taicpu(p).oper[1]^.ref^) then
begin
{ LDP/STP has a smaller permitted offset range than LDR/STR.
TODO: For a group of out-of-range LDR/STR instructions, can
we declare a temporary register equal to the offset base
address, modify the STR instructions to use that register
and then convert them to STP instructions? Note that STR
generally takes 2 cycles (on top of the memory latency),
while LDP/STP takes 3.
}
if (getsubreg(ThisRegister) = R_SUBQ) then
begin
ValidOffset := 8;
MinOffset := -512;
MaxOffset := 504;
end
else
begin
ValidOffset := 4;
MinOffset := -256;
MaxOffset := 252;
end;
hp1_last := p;
{ Look for nearby LDR/STR instructions }
if (taicpu(p).oppostfix = PF_NONE) and
(taicpu(p).oper[1]^.ref^.addressmode = AM_OFFSET) then
{ If SkipGetNext is True, GextNextInstruction isn't called }
while GetNextInstruction(hp1_last, hp1) do
begin
if (hp1.typ <> ait_instruction) then
Break;
if (taicpu(hp1).opcode = taicpu(p).opcode) then
begin
Breakout := False;
if (taicpu(hp1).oppostfix = PF_NONE) and
{ Registers need to be the same size }
(getsubreg(ThisRegister) = getsubreg(taicpu(hp1).oper[0]^.reg)) and
(
(TargetOpcode = A_STP) or
{ LDP x0, x0, [sp, #imm] is undefined behaviour, even
though such an LDR pair should have been optimised
out by now. STP is okay }
(ThisRegister <> taicpu(hp1).oper[0]^.reg)
) and
(taicpu(hp1).oper[1]^.ref^.addressmode = AM_OFFSET) and
(taicpu(p).oper[1]^.ref^.base = taicpu(hp1).oper[1]^.ref^.base) and
(taicpu(p).oper[1]^.ref^.index = taicpu(hp1).oper[1]^.ref^.index) and
{ Make sure the address registers haven't changed }
not RegModifiedBetween(taicpu(hp1).oper[1]^.ref^.base, p, hp1) and
(
(taicpu(hp1).oper[1]^.ref^.index = NR_NO) or
not RegModifiedBetween(taicpu(hp1).oper[1]^.ref^.index, p, hp1)
) and
{ Don't need to check "RegInRef" because the base registers are identical,
and the first one was checked already. [Kit] }
(((TargetOpcode=A_LDP) and not RegUsedBetween(taicpu(hp1).oper[0]^.reg, p, hp1)) or
((TargetOpcode=A_STP) and not RegModifiedBetween(taicpu(hp1).oper[0]^.reg, p, hp1))) then
begin
{ Can we convert these two LDR/STR instructions into a
single LDR/STP? }
OffsetVal := taicpu(hp1).oper[1]^.ref^.offset - taicpu(p).oper[1]^.ref^.offset;
if (OffsetVal = ValidOffset) then
begin
if (taicpu(p).oper[1]^.ref^.offset >= MinOffset) and (taicpu(hp1).oper[1]^.ref^.offset <= MaxOffset) then
begin
{ Convert:
LDR/STR reg0, [reg2, #ofs]
...
LDR/STR reg1. [reg2, #ofs + 8] // 4 if registers are 32-bit
To:
LDP/STP reg0, reg1, [reg2, #ofs]
}
taicpu(p).opcode := TargetOpcode;
if TargetOpcode = A_STP then
DebugMsg('Peephole Optimization: StrStr2Stp', p)
else
DebugMsg('Peephole Optimization: LdrLdr2Ldp', p);
taicpu(p).ops := 3;
taicpu(p).loadref(2, taicpu(p).oper[1]^.ref^);
taicpu(p).loadreg(1, taicpu(hp1).oper[0]^.reg);
asml.Remove(hp1);
hp1.Free;
Result := True;
Exit;
end;
end
else if (OffsetVal = -ValidOffset) then
begin
if (taicpu(hp1).oper[1]^.ref^.offset >= MinOffset) and (taicpu(p).oper[1]^.ref^.offset <= MaxOffset) then
begin
{ Convert:
LDR/STR reg0, [reg2, #ofs + 8] // 4 if registers are 32-bit
...
LDR/STR reg1. [reg2, #ofs]
To:
LDP/STP reg1, reg0, [reg2, #ofs]
}
taicpu(p).opcode := TargetOpcode;
if TargetOpcode = A_STP then
DebugMsg('Peephole Optimization: StrStr2Stp (reverse)', p)
else
DebugMsg('Peephole Optimization: LdrLdr2Ldp (reverse)', p);
taicpu(p).ops := 3;
taicpu(p).loadref(2, taicpu(hp1).oper[1]^.ref^);
taicpu(p).loadreg(1, taicpu(p).oper[0]^.reg);
taicpu(p).loadreg(0, taicpu(hp1).oper[0]^.reg);
asml.Remove(hp1);
hp1.Free;
Result := True;
Exit;
end;
end;
end;
end
else
Break;
{ Don't continue looking for LDR/STR pairs if the address register
gets modified }
if RegModifiedByInstruction(taicpu(p).oper[1]^.ref^.base, hp1) then
Break;
hp1_last := hp1;
end;
end;
end;
function TCpuAsmOptimizer.OptPostCMP(var p : tai): boolean;
var
hp1,hp2: tai;
@ -626,6 +787,24 @@ Implementation
end;
function TCpuAsmOptimizer.PeepHoleOptPass2Cpu(var p: tai): boolean;
var
hp1: tai;
begin
result := false;
if p.typ=ait_instruction then
begin
case taicpu(p).opcode of
A_LDR,
A_STR:
Result:=OptPass2LDRSTR(p);
else
;
end;
end;
end;
function TCpuAsmOptimizer.PostPeepHoleOptsCpu(var p: tai): boolean;
begin
result := false;

2
compiler/ninl.pas
View File

@ -4754,7 +4754,7 @@ implementation
elesizeppn:=cordconstnode.create(tarraydef(paradef).elesize,sinttype,false);
if is_managed_type(tarraydef(paradef).elementdef) then
eletypeppn:=caddrnode.create_internal(
crttinode.create(tstoreddef(tarraydef(paradef).elementdef),fullrtti,rdt_normal))
crttinode.create(tstoreddef(tarraydef(paradef).elementdef),initrtti,rdt_normal))
else
eletypeppn:=cordconstnode.create(0,voidpointertype,false);
maxcountppn:=geninlinenode(in_length_x,false,ppn.left.getcopy);

1
compiler/systems/t_linux.pas
View File

@ -170,6 +170,7 @@ begin
LibrarySearchPath.AddLibraryPath(sysrootpath,'=/lib/i386-linux-gnu',true);
{$endif i386}
{$ifdef aarch64}
LibrarySearchPath.AddLibraryPath(sysrootpath,'=/usr/lib64',true);
LibrarySearchPath.AddLibraryPath(sysrootpath,'=/usr/lib/aarch64-linux-gnu',true);
LibrarySearchPath.AddLibraryPath(sysrootpath,'=/lib/aarch64-linux-gnu',true);
{$endif aarch64}

71
compiler/x86/aoptx86.pas
View File

@ -5482,32 +5482,81 @@ unit aoptx86;
if reg_and_hp1_is_instr and
(taicpu(hp1).opcode = A_AND) and
MatchOpType(taicpu(hp1),top_const,top_reg) and
(taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) then
((taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg)
{$ifdef x86_64}
{ check for implicit extension to 64 bit }
or
((taicpu(p).opsize in [S_BL,S_WL]) and
(taicpu(hp1).opsize=S_Q) and
SuperRegistersEqual(taicpu(p).oper[1]^.reg,taicpu(hp1).oper[1]^.reg)
)
{$endif x86_64}
)
then
begin
case taicpu(p).opsize Of
S_BL, S_BW{$ifdef x86_64}, S_BQ{$endif x86_64}:
if (taicpu(hp1).oper[0]^.val = $ff) then
begin
DebugMsg(SPeepholeOptimization + 'var4',p);
DebugMsg(SPeepholeOptimization + 'MovzAnd2Movz1',p);
RemoveInstruction(hp1);
Result:=true;
exit;
end;
S_WL{$ifdef x86_64}, S_WQ{$endif x86_64}:
if (taicpu(hp1).oper[0]^.val = $ffff) then
begin
DebugMsg(SPeepholeOptimization + 'var5',p);
DebugMsg(SPeepholeOptimization + 'MovzAnd2Movz2',p);
RemoveInstruction(hp1);
Result:=true;
exit;
end;
{$ifdef x86_64}
S_LQ:
if (taicpu(hp1).oper[0]^.val = $ffffffff) then
begin
if (cs_asm_source in current_settings.globalswitches) then
asml.insertbefore(tai_comment.create(strpnew(SPeepholeOptimization + 'var6')),p);
DebugMsg(SPeepholeOptimization + 'MovzAnd2Movz3',p);
RemoveInstruction(hp1);
Result:=true;
exit;
end;
{$endif x86_64}
else
;
else
;
end;
{ we cannot get rid of the and, but can we get rid of the movz ?}
if SuperRegistersEqual(taicpu(p).oper[0]^.reg,taicpu(p).oper[1]^.reg) then
begin
case taicpu(p).opsize Of
S_BL, S_BW{$ifdef x86_64}, S_BQ{$endif x86_64}:
if (taicpu(hp1).oper[0]^.val and $ff)=taicpu(hp1).oper[0]^.val then
begin
DebugMsg(SPeepholeOptimization + 'MovzAnd2And1',p);
RemoveCurrentP(p,hp1);
Result:=true;
exit;
end;
S_WL{$ifdef x86_64}, S_WQ{$endif x86_64}:
if (taicpu(hp1).oper[0]^.val and $ffff)=taicpu(hp1).oper[0]^.val then
begin
DebugMsg(SPeepholeOptimization + 'MovzAnd2And2',p);
RemoveCurrentP(p,hp1);
Result:=true;
exit;
end;
{$ifdef x86_64}
S_LQ:
if (taicpu(hp1).oper[0]^.val and $ffffffff)=taicpu(hp1).oper[0]^.val then
begin
DebugMsg(SPeepholeOptimization + 'MovzAnd2And3',p);
RemoveCurrentP(p,hp1);
Result:=true;
exit;
end;
{$endif x86_64}
else
;
end;
end;
end;
{ changes some movzx constructs to faster synonyms (all examples
@ -5702,17 +5751,17 @@ unit aoptx86;
end
else if MatchOpType(taicpu(p),top_const,top_reg) and
MatchInstruction(hp1,A_MOVZX,[]) and
(taicpu(hp1).oper[0]^.typ = top_reg) and
MatchOperand(taicpu(p).oper[1]^,taicpu(hp1).oper[1]^) and
MatchOpType(taicpu(hp1),top_reg,top_reg) and
SuperRegistersEqual(taicpu(p).oper[1]^.reg,taicpu(hp1).oper[1]^.reg) and
(getsupreg(taicpu(hp1).oper[0]^.reg)=getsupreg(taicpu(hp1).oper[1]^.reg)) and
(((taicpu(p).opsize=S_W) and
(taicpu(hp1).opsize=S_BW)) or
((taicpu(p).opsize=S_L) and
(taicpu(hp1).opsize in [S_WL,S_BL]))
(taicpu(hp1).opsize in [S_WL,S_BL{$ifdef x86_64},S_BQ,S_WQ{$endif x86_64}]))
{$ifdef x86_64}
or
((taicpu(p).opsize=S_Q) and
(taicpu(hp1).opsize in [S_BQ,S_WQ]))
(taicpu(hp1).opsize in [S_BQ,S_WQ,S_BL,S_WL]))
{$endif x86_64}
) then
begin

2
compiler/z80/agz80asm.pas
View File

@ -434,7 +434,7 @@ unit agz80asm;
asmbin : 'z80asm';
asmcmd : '-o $OBJ $EXTRAOPT $ASM';
supported_targets : [system_Z80_embedded];
flags : [af_needar,af_smartlink_sections];
flags : [af_needar{,af_smartlink_sections}];
labelprefix : '.L';
labelmaxlen : -1;
comment : '; ';

2
compiler/z80/agz80vasm.pas
View File

@ -920,7 +920,7 @@ unit agz80vasm;
asmbin : 'vasmz80_std';
asmcmd : '-quiet -Fvobj -o $OBJ $EXTRAOPT $ASM';
supported_targets : [system_z80_embedded, system_z80_zxspectrum, system_z80_msxdos];
flags : [af_needar,af_smartlink_sections];
flags : [af_needar{,af_smartlink_sections}];
labelprefix : '.L';
labelmaxlen : -1;
comment : '; ';

4
packages/fcl-passrc/src/pasresolver.pp
View File

@ -6719,7 +6719,7 @@ begin
if TPasClassType(LastType).ObjKind<>okInterface then
RaiseCannotBeTogether(20190720211304,LastType.Name,MemberType.Name);
end;
end
end;
else
RaiseXIsNotAValidConstraint(20190720210919,MemberType.Name);
end;
@ -7480,7 +7480,7 @@ begin
if (ClassOrRecScope is TPasClassScope)
and (TPasClassScope(ClassOrRecScope).CanonicalClassOf<>nil) then
begin
// 'Self' in a method is the hidden classtype argument
// 'Self' in a class method is the hidden classtype argument
// Note: this is true in classes, adv records and helpers
SelfArg:=TPasArgument.Create('Self',DeclProc);
ImplProcScope.SelfArg:=SelfArg;

24
packages/rtl-extra/fpmake.pp
View File

@ -91,21 +91,12 @@ begin
if Defaults.CPU<>jvm then
T:=P.Targets.AddUnit('clocale.pp',[android]);
{ Ideally, we should check if rtl contians math unit,
{ Ideally, we should check if rtl contains math unit,
I do know how that can be checked. PM 2019/11/27 }
if (Defaults.CPU<>i8086) or (Defaults.OS<>embedded) then
T:=P.Targets.AddUnit('ucomplex.pp',UComplexOSes);
T:=P.Targets.AddUnit('objects.pp',ObjectsOSes);
T:=P.Targets.AddUnit('printer.pp',PrinterOSes);
T.Dependencies.AddInclude('printerh.inc',PrinterOSes);
T.Dependencies.AddInclude('printer.inc',PrinterOSes);
{ Ideally, we should check if rtl contians math unit,
I do know how that can be checked. PM 2019/11/27 }
if (Defaults.CPU<>i8086) or (Defaults.OS<>embedded) then
if ((Defaults.CPU<>i8086) and (Defaults.CPU<>z80))
or (Defaults.OS<>embedded) then
begin
T:=P.Targets.AddUnit('ucomplex.pp',UComplexOSes);
T:=P.Targets.AddUnit('matrix.pp',MatrixOSes);
with T.Dependencies do
begin
@ -113,6 +104,13 @@ begin
AddInclude('mmatimp.inc');
end;
end;
T:=P.Targets.AddUnit('objects.pp',ObjectsOSes);
T:=P.Targets.AddUnit('printer.pp',PrinterOSes);
T.Dependencies.AddInclude('printerh.inc',PrinterOSes);
T.Dependencies.AddInclude('printer.inc',PrinterOSes);
T:=P.Targets.AddUnit('winsock.pp',WinSockOSes);
with T.Dependencies do
begin

6
rtl/inc/iso7185.pp
View File

@ -206,8 +206,10 @@ unit iso7185;
procedure Get(var f:TypedFile);[IOCheck];
Begin
if not(eof(f)) then
BlockRead(f,(pbyte(@f)+sizeof(FileRec))^,1);
if not(system.eof(f)) then
BlockRead(f,(pbyte(@f)+sizeof(FileRec))^,1)
else
FileRec(f)._private[1]:=1;
End;

19
tests/webtbs/tw37779.pp Normal file
View File

@ -0,0 +1,19 @@
{ %NORUN }
program tw37779;
type
Complex = record
re : Double;
im : Double;
end;
TComplexArray = array of Complex;
TComplexArrayArray = array of TComplexArray;
var
MC: array of array of array of array of TComplexArrayArray;
begin
MC := nil;
MC := Copy(MC);
end.