Explorar o código

--- Merging r46880 into '.':
U rtl/aarch64/mathu.inc
--- Recording mergeinfo for merge of r46880 into '.':
U .
--- Merging r40512 into '.':
A tests/webtbs/tw33607.pp
--- Recording mergeinfo for merge of r40512 into '.':
G .
--- Merging r42961 into '.':
U compiler/aarch64/aasmcpu.pas
--- Recording mergeinfo for merge of r42961 into '.':
G .
--- Merging r44932 into '.':
G compiler/aarch64/aasmcpu.pas
--- Recording mergeinfo for merge of r44932 into '.':
G .
--- Merging r44933 into '.':
U compiler/aarch64/racpugas.pas
--- Recording mergeinfo for merge of r44933 into '.':
G .
--- Merging r44998 into '.':
U compiler/aarch64/racpu.pas
--- Recording mergeinfo for merge of r44998 into '.':
G .
--- Merging r45667 into '.':
G compiler/aarch64/racpugas.pas
U compiler/rautils.pas
A tests/webtbs/tw37218.pp
--- Recording mergeinfo for merge of r45667 into '.':
G .
--- Merging r45814 into '.':
U compiler/aarch64/rgcpu.pas
A tests/webtbs/tw37393.pp
--- Recording mergeinfo for merge of r45814 into '.':
G .
--- Merging r46690 into '.':
G compiler/aarch64/aasmcpu.pas
--- Recording mergeinfo for merge of r46690 into '.':
G .
--- Merging r46871 into '.':
U compiler/aarch64/cgcpu.pas
--- Recording mergeinfo for merge of r46871 into '.':
G .

git-svn-id: branches/fixes_3_2@47756 -

Jonas Maebe %!s(int64=4) %!d(string=hai) anos
pai
achega
c9c1c1686c

+ 3 - 0
.gitattributes

@@ -17638,6 +17638,7 @@ 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/tw3360.pp svneol=native#text/plain
+tests/webtbs/tw33607.pp svneol=native#text/plain
 tests/webtbs/tw33635.pp svneol=native#text/pascal
 tests/webtbs/tw3364.pp svneol=native#text/plain
 tests/webtbs/tw3366.pp svneol=native#text/plain
@@ -17766,11 +17767,13 @@ tests/webtbs/tw37095d/uw37095.pp svneol=native#text/plain
 tests/webtbs/tw37154.pp svneol=native#text/pascal
 tests/webtbs/tw3719.pp svneol=native#text/plain
 tests/webtbs/tw3721.pp svneol=native#text/plain
+tests/webtbs/tw37218.pp svneol=native#text/pascal
 tests/webtbs/tw37228.pp svneol=native#text/plain
 tests/webtbs/tw37322.pp svneol=native#text/pascal
 tests/webtbs/tw37323.pp svneol=native#text/pascal
 tests/webtbs/tw37355.pp svneol=native#text/pascal
 tests/webtbs/tw37382.pp svneol=native#text/pascal
+tests/webtbs/tw37393.pp svneol=native#text/pascal
 tests/webtbs/tw37397.pp svneol=native#text/plain
 tests/webtbs/tw37415.pp svneol=native#text/plain
 tests/webtbs/tw3742.pp svneol=native#text/plain

+ 90 - 5
compiler/aarch64/aasmcpu.pas

@@ -567,10 +567,27 @@ implementation
              not assigned(ref.symboldata))) then
           exit;
         { if this is a (got) page offset load, we must have a base register and a
-          symbol }
+          symbol (except if we have an ADD with a non-got page offset load) }
         if (ref.refaddr in [addr_gotpageoffset,addr_pageoffset]) and
-           (not assigned(ref.symbol) or
-            (ref.base=NR_NO) or
+           (
+             (
+               (
+                 (op<>A_ADD) or
+                 (ref.refaddr=addr_gotpageoffset)
+               ) and
+               (
+                 not assigned(ref.symbol) or
+                 (ref.base=NR_NO)
+               )
+             ) or
+             (
+               (
+                 (op=A_ADD) and
+                 (ref.refaddr=addr_pageoffset)
+               ) and
+               not assigned(ref.symbol) and
+               (ref.base=NR_NO)
+             ) or
             (ref.index<>NR_NO) or
             (ref.offset<>0)) then
           begin
@@ -868,10 +885,13 @@ implementation
     function taicpu.spilling_get_operation_type(opnr: longint): topertype;
       begin
         case opcode of
-          A_B,A_BL,
+          A_B,A_BL,A_BR,A_BLR,
           A_CMN,A_CMP,
           A_CCMN,A_CCMP,
-          A_TST:
+          A_TST,
+          A_FCMP,A_FCMPE,
+          A_CBZ,A_CBNZ,
+          A_RET:
             result:=operand_read;
           A_STR,A_STUR:
             if opnr=0 then
@@ -904,11 +924,76 @@ implementation
                  { check for pre/post indexed in spilling_get_operation_type_ref }
                  result:=operand_read;
              end;
+{$ifdef EXTDEBUG}
+           { play save to avoid hard to find bugs, better fail at compile time }
+           A_ADD,
+           A_ADRP,
+           A_AND,
+           A_ASR,
+           A_BFI,
+           A_BFXIL,
+           A_CLZ,
+           A_CSEL,
+           A_CSET,
+           A_CSETM,
+           A_FABS,
+           A_EON,
+           A_EOR,
+           A_FADD,
+           A_FCVT,
+           A_FDIV,
+           A_FMADD,
+           A_FMOV,
+           A_FMSUB,
+           A_FMUL,
+           A_FNEG,
+           A_FNMADD,
+           A_FNMSUB,
+           A_FRINTX,
+           A_FSQRT,
+           A_FSUB,
+           A_ORR,
+           A_LSL,
+           A_LSLV,
+           A_LSR,
+           A_LSRV,
+           A_MOV,
+           A_MOVK,
+           A_MOVN,
+           A_MOVZ,
+           A_MSUB,
+           A_MUL,
+           A_MVN,
+           A_NEG,
+           A_LDR,
+           A_LDUR,
+           A_RBIT,
+           A_ROR,
+           A_RORV,
+           A_SBFX,
+           A_SCVTF,
+           A_FCVTZS,
+           A_SDIV,
+           A_SMULL,
+           A_SUB,
+           A_UBFIZ,
+           A_UBFX,
+           A_UCVTF,
+           A_UDIV,
+           A_UMULL:
+             if opnr=0 then
+               result:=operand_write
+             else
+               result:=operand_read;
+           else
+             Internalerror(2019090802);
+{$else EXTDEBUG}
            else
              if opnr=0 then
                result:=operand_write
              else
                result:=operand_read;
+{$endif EXTDEBUG}
         end;
       end;
 

+ 6 - 7
compiler/aarch64/cgcpu.pas

@@ -2280,7 +2280,7 @@ implementation
 
     procedure tcgaarch64.g_check_for_fpu_exception(list: TAsmList;force,clear : boolean);
       var
-        r : TRegister;
+        r, tmpreg: TRegister;
         ai: taicpu;
         l1,l2: TAsmLabel;
       begin
@@ -2289,18 +2289,17 @@ implementation
             (force or current_procinfo.FPUExceptionCheckNeeded)) then
           begin
             r:=getintregister(list,OS_INT);
+            tmpreg:=getintregister(list,OS_INT);
             list.concat(taicpu.op_reg_reg(A_MRS,r,NR_FPSR));
-            list.concat(taicpu.op_reg_const(A_TST,r,$1f));
+            list.concat(taicpu.op_reg_reg_const(A_AND,tmpreg,r,$1f));
             current_asmdata.getjumplabel(l1);
             current_asmdata.getjumplabel(l2);
-            ai:=taicpu.op_sym(A_B,l1);
+            ai:=taicpu.op_reg_sym_ofs(A_CBNZ,tmpreg,l1,0);
             ai.is_jmp:=true;
-            ai.condition:=C_NE;
             list.concat(ai);
-            list.concat(taicpu.op_reg_const(A_TST,r,$80));
-            ai:=taicpu.op_sym(A_B,l2);
+            list.concat(taicpu.op_reg_reg_const(A_AND,tmpreg,r,$80));
+            ai:=taicpu.op_reg_sym_ofs(A_CBZ,tmpreg,l2,0);
             ai.is_jmp:=true;
-            ai.condition:=C_EQ;
             list.concat(ai);
             a_label(list,l1);
             alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));

+ 2 - 0
compiler/aarch64/racpu.pas

@@ -67,6 +67,8 @@ unit racpu;
       begin
         if ops<1 then
           internalerror(2014122001);
+        if (ops=1) and (operands[1].opr.typ=OPR_REFERENCE) then
+          exit(OS_NO);
         if operands[1].opr.typ<>OPR_REGISTER then
           internalerror(2014122002);
         result:=reg_cgsize(operands[1].opr.reg);

+ 5 - 2
compiler/aarch64/racpugas.pas

@@ -789,8 +789,11 @@ Unit racpugas;
                           else
                             Message1(sym_e_unknown_id,expr);
                         end
-                       else
-                         MaybeAddGotAddrMode;
+                       else if oper.opr.typ<>OPR_LOCAL then
+                         begin
+                           oper.InitRef;
+                           MaybeAddGotAddrMode;
+                         end;
                      end;
                   end;
                   if actasmtoken=AS_DOT then

+ 10 - 0
compiler/aarch64/rgcpu.pas

@@ -36,6 +36,7 @@ unit rgcpu;
       trgcpu=class(trgobj)
         procedure do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
         procedure do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
+        function get_spill_subreg(r: tregister): tsubregister; override;
        protected
         procedure do_spill_op(list: tasmlist; op: tasmop; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
       end;
@@ -51,6 +52,15 @@ implementation
       verbose,cutils,
       cgobj;
 
+    function  trgcpu.get_spill_subreg(r:tregister) : tsubregister;
+      begin
+        if (getregtype(r)<>R_MMREGISTER) then
+          result:=defaultsub
+        else
+          result:=getsubreg(r);
+      end;
+
+
     procedure trgcpu.do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
       begin
         do_spill_op(list,A_LDR,pos,spilltemp,tempreg,orgsupreg);

+ 1 - 1
compiler/rautils.pas

@@ -1085,7 +1085,7 @@ end;
 
 procedure TOperand.InitRef;
 {*********************************************************************}
-{  Description: This routine first check if the opcode is of     }
+{  Description: This routine first check if the opcode is of          }
 {  type OPR_NONE, or OPR_REFERENCE , if not it gives out an error.    }
 {  If the operandtype = OPR_NONE or <> OPR_REFERENCE then it sets up  }
 {  the operand type to OPR_REFERENCE, as well as setting up the ref   }

+ 12 - 14
rtl/aarch64/mathu.inc

@@ -103,21 +103,23 @@ function GetExceptionMask: TFPUExceptionMask;
     if ((fpcr and fpu_ide)=0) then
       result := result+[exDenormalized];
     }
+    { as the fpcr flags might be RAZ, the softfloat exception mask
+      is considered as the authoritative mask }
     result:=softfloat_exception_mask;
   end;
 
 
 function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
-  {
   var
     newfpcr: dword;
-  }
   begin
-    { as I am not aware of any hardware exception supporting AArch64 implementation,
-      and else the trapping enable flags are RAZ, work solely with softfloat_exception_mask (FK)
-    }
+    { clear "exception happened" flags }
+    ClearExceptions(false);
     softfloat_exception_mask:=mask;
-    {
+
+    { at least the ThunderX AArch64 support apperently hardware exceptions,
+      so set fpcr correctly, thought it might be WI on most implementations it does not hurt
+    }
     newfpcr:=fpu_exception_mask;
     if exInvalidOp in Mask then
       newfpcr:=newfpcr and not(fpu_ioe);
@@ -131,14 +133,10 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
       newfpcr:=newfpcr and not(fpu_ixe);
     if exDenormalized in Mask then
       newfpcr:=newfpcr and not(fpu_ide);
-    }
-    { clear "exception happened" flags }
-    ClearExceptions(false);
-    { set new exception mask }
-//    setfpcr((getfpcr and not(fpu_exception_mask)) or newfpcr);
-    { unsupported mask bits will remain 0 -> read exception mask again }
-//    result:=GetExceptionMask;
-//    softfloat_exception_mask:=result;
+    setfpcr((getfpcr and not(fpu_exception_mask)) or newfpcr);
+
+    { as the fpcr flags might be RAZ, the softfloat exception mask
+      is considered as the authoritative mask }
     result:=softfloat_exception_mask;
   end;
 

+ 51 - 0
tests/webtbs/tw33607.pp

@@ -0,0 +1,51 @@
+{$mode objfpc}{$H+}
+{$modeSwitch advancedRecords}
+
+type
+   TRectangle = record
+		   public
+		   Left, Bottom: Integer;
+		   Width, Height: Cardinal;
+
+		function ScaleAround0(const Factor: Single): TRectangle;
+		end;
+
+function TRectangle.ScaleAround0(const Factor: Single): TRectangle;
+begin
+   if Width <= 0 then
+   begin
+      Result.Width  := Width;
+      Result.Left   := Left;
+   end else
+      halt(3);
+
+   Result.Height := Height;
+   Result.Bottom := Bottom;
+end;
+
+function Rectangle(const Left, Bottom: Integer;
+		   const Width, Height: Cardinal): TRectangle;
+begin
+   Rectangle.Left := Left;
+   Rectangle.Bottom := Bottom;
+   Rectangle.Width := Width;
+   Rectangle.Height := Height;
+end;
+
+procedure test(c: qword);
+begin
+  if c<>0 then
+    halt(2);
+end;
+
+var
+   R, S	:  TRectangle;
+begin
+   R := Rectangle(10, 20, 0, 50);
+   S := R.ScaleAround0(2);
+   if s.width<>0 then
+     halt(1);
+
+  test(R.ScaleAround0(2).Width);
+end.
+

+ 22 - 0
tests/webtbs/tw37218.pp

@@ -0,0 +1,22 @@
+{ %CPU=aarch64 }
+program project1;
+uses crt;
+procedure test;
+var a:uint64;
+begin
+a:=1;
+    asm
+    mov x4,# 0
+    mov x12,# 1
+    add x4,x4,x12,lsl # 2
+    str x4, a
+    end;
+
+  writeln(a);
+  if a<>4 then
+     halt(1);
+end;
+
+begin
+test;
+end.

+ 14 - 0
tests/webtbs/tw37393.pp

@@ -0,0 +1,14 @@
+{ %OPT=-O2 }
+program fx;
+procedure rep9(a,b,c,d, e,f,g,h, i,j,k,l: single);
+begin
+	writeln(a, ' ', b, ' ', c, ' ', d);
+	writeln(e, ' ', f, ' ', g, ' ', h);
+	writeln(i, ' ', j, ' ', k, ' ', l);
+    if (i<>9) or (j<>10) or (k<>11) or (l<>12) then
+       halt(1);
+end;
+begin
+	rep9(1,2,3,4,5,6,7,8,9,10,11,12);
+    writeln('ok');
+end.