Browse Source

* synchronized with trunk

git-svn-id: branches/wasm@46920 -
nickysn 4 years ago
parent
commit
47eeaa0b83

+ 1 - 0
.gitattributes

@@ -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 - 0
compiler/aarch64/aoptcpu.pas

@@ -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;

+ 1 - 1
compiler/ninl.pas

@@ -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 - 0
compiler/systems/t_linux.pas

@@ -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}

+ 60 - 11
compiler/x86/aoptx86.pas

@@ -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

+ 1 - 1
compiler/z80/agz80asm.pas

@@ -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 : '; ';

+ 1 - 1
compiler/z80/agz80vasm.pas

@@ -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 : '; ';

+ 2 - 2
packages/fcl-passrc/src/pasresolver.pp

@@ -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;

+ 11 - 13
packages/rtl-extra/fpmake.pp

@@ -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

+ 4 - 2
rtl/inc/iso7185.pp

@@ -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 - 0
tests/webtbs/tw37779.pp

@@ -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.