Merging 30268,32182,32399,33379,33380,33393,33498,33594,33595

git-svn-id: branches/fixes_3_0_ios@33851 -

.gitattributes

@@ -10420,6 +10420,7 @@ tests/tbs/tb0606.pp svneol=native#text/pascal
 tests/tbs/tb0607.pp svneol=native#text/plain
 tests/tbs/tb0608.pp svneol=native#text/pascal
 tests/tbs/tb0609.pp svneol=native#text/plain
+tests/tbs/tb0618.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tbs0594.pp svneol=native#text/pascal
@@ -14393,8 +14394,11 @@ tests/webtbs/tw2975.pp svneol=native#text/plain
 tests/webtbs/tw2976.pp svneol=native#text/plain
 tests/webtbs/tw2983.pp svneol=native#text/plain
 tests/webtbs/tw2984.pp svneol=native#text/plain
+tests/webtbs/tw29912.pp svneol=native#text/plain
+tests/webtbs/tw29933.pp svneol=native#text/plain
 tests/webtbs/tw2998.pp svneol=native#text/plain
 tests/webtbs/tw2999.pp svneol=native#text/plain
+tests/webtbs/tw30007.pp svneol=native#text/plain
 tests/webtbs/tw3004.pp svneol=native#text/plain
 tests/webtbs/tw3005.pp svneol=native#text/plain
 tests/webtbs/tw3010.pp svneol=native#text/plain

compiler/aarch64/cgcpu.pas

@@ -813,7 +813,7 @@ implementation
         if fromsize in [OS_64,OS_S64] then
           begin
             { split into two 32 bit loads }
-            hreg1:=makeregsize(register,OS_32);
+            hreg1:=getintregister(list,OS_32);
             hreg2:=getintregister(list,OS_32);
             if target_info.endian=endian_big then
               begin
@@ -832,6 +832,7 @@ implementation
                 inc(href.offset,4);
                 a_load_ref_reg(list,OS_32,OS_32,href,hreg2);
               end;
+            a_load_reg_reg(list,OS_32,OS_64,hreg1,register);
             list.concat(taicpu.op_reg_reg_const_const(A_BFI,register,makeregsize(hreg2,OS_64),32,32));
           end
        else
@@ -1116,8 +1117,9 @@ implementation
         if fromsize in [OS_64,OS_S64] then
           begin
             { split into two 32 bit stores }
-            hreg1:=makeregsize(register,OS_32);
+            hreg1:=getintregister(list,OS_32);
             hreg2:=getintregister(list,OS_32);
+            a_load_reg_reg(list,OS_32,OS_32,makeregsize(register,OS_32),hreg1);
             a_op_const_reg_reg(list,OP_SHR,OS_64,32,register,makeregsize(hreg2,OS_64));
             if target_info.endian=endian_big then
               begin
@@ -1341,7 +1343,7 @@ implementation
 
     procedure tcgaarch64.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: topcg; size: tcgsize; src1, src2, dst: tregister; setflags : boolean; var ovloc : tlocation);
       var
-        tmpreg1: tregister;
+        tmpreg1, tmpreg2: tregister;
       begin
         ovloc.loc:=LOC_VOID;
         { overflow can only occur with 64 bit calculations on 64 bit cpus }
@@ -1361,9 +1363,7 @@ implementation
                       ovloc.resflags:=F_CC
                   else
                     ovloc.resflags:=F_VS;
-                  { finished; since we won't call through to a_op_reg_reg_reg,
-                    adjust the result here if necessary }
-                  maybeadjustresult(list,op,size,dst);
+                  { finished }
                   exit;
                 end;
               OP_MUL:
@@ -1378,17 +1378,22 @@ implementation
                 end;
               OP_IMUL:
                 begin
-                  { check whether the sign bit of the (128 bit) result is the
-                    same as "sign bit of src1" xor "signbit of src2" (if so, no
-                    overflow and the xor-product of all sign bits is 0) }
+                  { check whether the upper 64 bits of the 128 bit multiplication
+                    result have the same value as the replicated sign bit of the
+                    lower 64 bits }
                   tmpreg1:=getintregister(list,OS_64);
                   list.concat(taicpu.op_reg_reg_reg(A_SMULH,tmpreg1,src2,src1));
-                  list.concat(taicpu.op_reg_reg_reg(A_EOR,tmpreg1,tmpreg1,src1));
-                  list.concat(taicpu.op_reg_reg_reg(A_EOR,tmpreg1,tmpreg1,src2));
-                  list.concat(taicpu.op_reg_const(A_TST,tmpreg1,$80000000));
+                  { calculate lower 64 bits (afterwards, because dst may be
+                    equal to src1 or src2) }
+                  a_op_reg_reg_reg(list,op,size,src1,src2,dst);
+                  { replicate sign bit }
+                  tmpreg2:=getintregister(list,OS_64);
+                  a_op_const_reg_reg(list,OP_SAR,OS_S64,63,dst,tmpreg2);
+                  list.concat(taicpu.op_reg_reg(A_CMP,tmpreg1,tmpreg2));
                   ovloc.loc:=LOC_FLAGS;
                   ovloc.resflags:=F_NE;
-                  { still have to perform the actual multiplication }
+                  { finished }
+                  exit;
                 end;
               OP_IDIV,
               OP_DIV:

compiler/aarch64/hlcgcpu.pas

@@ -136,7 +136,8 @@ implementation
     begin
       if slopt in [SL_SETZERO,SL_SETMAX] then
         inherited
-      else if not(sreg.bitlen in [32,64]) then
+      else if not(sreg.bitlen in [32,64]) or
+              (sreg.startbit<>0) then
         begin
           makeregssamesize(list,def_cgsize(fromsize),sreg.subsetregsize,fromreg,sreg.subsetreg,fromreg,toreg);
           list.concat(taicpu.op_reg_reg_const_const(A_BFI,toreg,fromreg,sreg.startbit,sreg.bitlen))

compiler/ncal.pas

@@ -283,7 +283,7 @@ implementation
       verbose,globals,
       symconst,defutil,defcmp,
       htypechk,pass_1,
-      ncnv,nld,ninl,nadd,ncon,nmem,nset,nobjc,
+      ncnv,nflw,nld,ninl,nadd,ncon,nmem,nset,nobjc,
       ngenutil,objcutil,
       procinfo,cpuinfo,
       wpobase;
@@ -690,16 +690,24 @@ implementation
                  { move(para,temp,sizeof(arr)) (no "left.getcopy" below because
                    we replace left afterwards) }
                  addstatement(initstat,
-                   ccallnode.createintern('MOVE',
-                     ccallparanode.create(
-                       arraysize,
+                   cifnode.create_internal(
+                     caddnode.create_internal(
+                       unequaln,
+                       arraysize.getcopy,
+                       genintconstnode(0)
+                     ),
+                     ccallnode.createintern('MOVE',
                        ccallparanode.create(
-                         cderefnode.create(ctemprefnode.create(paratemp)),
+                         arraysize,
                          ccallparanode.create(
-                           arraybegin,nil
+                           cderefnode.create(ctemprefnode.create(paratemp)),
+                           ccallparanode.create(
+                             arraybegin,nil
+                           )
                          )
                        )
-                     )
+                     ),
+                     nil
                    )
                  );
                  { no reference count increases, that's still done on the callee

compiler/nflw.pas

@@ -84,6 +84,7 @@ interface
 
        tifnode = class(tloopnode)
           constructor create(l,r,_t1 : tnode);virtual;reintroduce;
+          constructor create_internal(l,r,_t1 : tnode);virtual;reintroduce;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
           function simplify(forinline : boolean) : tnode;override;
@@ -1334,6 +1335,13 @@ implementation
       end;
 
 
+    constructor tifnode.create_internal(l,r,_t1 : tnode);
+      begin
+        create(l,r,_t1);
+        include(flags,nf_internal);
+      end;
+
+
     function tifnode.internalsimplify(warn: boolean) : tnode;
       begin
         result:=nil;

compiler/objcgutl.pas

@@ -1493,9 +1493,10 @@ procedure tobjcrttiwriter_nonfragile.gen_objc_classes_sections(list:TAsmList; ob
       ObjCEmptyCacheVar:=current_asmdata.RefAsmSymbol(target_info.Cprefix+'_objc_empty_cache');
     list.Concat(Tai_const.Create_sym(ObjCEmptyCacheVar));
     { pointer to vtable }
-    if not assigned(ObjCEmptyVtableVar) then
+    if not assigned(ObjCEmptyVtableVar) and
+       not(target_info.system in [system_arm_darwin,system_aarch64_darwin,system_i386_iphonesim,system_x86_64_iphonesim]) then
       ObjCEmptyVtableVar:=current_asmdata.RefAsmSymbol(target_info.Cprefix+'_objc_empty_vtable');
-    list.Concat(Tai_const.Create_sym(ObjCEmptyVtableVar));
+    ConcatSymOrNil(list,ObjCEmptyVtableVar);
     { the read-only part }
     list.Concat(Tai_const.Create_sym(metarosym));
 
@@ -1509,7 +1510,7 @@ procedure tobjcrttiwriter_nonfragile.gen_objc_classes_sections(list:TAsmList; ob
     { pointer to cache }
     list.Concat(Tai_const.Create_sym(ObjCEmptyCacheVar));
     { pointer to vtable }
-    list.Concat(Tai_const.Create_sym(ObjCEmptyVtableVar));
+    ConcatSymOrNil(list,ObjCEmptyVtableVar);
     { the read-only part }
     list.Concat(Tai_const.Create_sym(rosym));
 

packages/fcl-res/src/machodefaulttarget.inc

@@ -26,6 +26,9 @@
   {$IFDEF CPUX86_64}
   fMachineType:=mmtx86_64;
   {$ENDIF}
+  {$IFDEF CPUARM}
+  fMachineType:=mmtarm;
+  {$ENDIF}
   {$IFDEF CPUAARCH64}
   fMachineType:=mmtarm64;
   {$ENDIF}

tests/tbs/tb0618.pp

@@ -0,0 +1,42 @@
+type
+     PStreamRec= ^TStreamRec;
+
+     TStreamRec = Packed Record
+       ObjType : byte;
+       Next : PStreamRec;
+     end;
+
+const
+   BaseRec : PStreamRec= nil;
+
+   RType1 : TStreamRec = (
+    ObjType : 79
+   );
+   RType2 : TStreamRec = (
+    objtype : 80
+   );
+
+
+procedure RegisterType(var R : TStreamRec);
+var
+  P : PStreamRec;
+
+begin
+  P := BaseRec;
+  while (P <> nil) and (P^.Objtype <> R.ObjType) do
+    P:=P^.Next;
+  if not assigned(P) then
+    begin
+      R.Next:=BaseRec;
+      BaseRec:=@R;
+    end;
+  { nothing to do here
+  else
+    P:=@R; }
+end;
+
+begin
+  RegisterType(Rtype1);
+  RegisterType(RType2);
+end.
+

tests/webtbs/tw29912.pp

@@ -0,0 +1,21 @@
+program Project1;
+
+{$mode objfpc}{$H+}
+{$R+,Q+,S+,T+}
+
+var
+  x,y,z:integer;
+begin
+  x:=0;
+  z:=0;
+  // all ok
+  y:=Int64(x-1);
+  writeln(y);
+  // all ok
+  y:=Int64(z);
+  writeln(y);
+  // arithmetic overflow
+  y:=Int64(x-1)*Int64(z);
+  writeln(y);
+end.
+

tests/webtbs/tw29933.pp

@@ -0,0 +1,34 @@
+{$mode objfpc}
+
+type
+  TPoint =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+  packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+  record
+    X : Longint;
+    Y : Longint;
+  end;
+
+
+function Point(x,y : Integer) : TPoint; inline;
+begin
+  Point.x:=x;
+  Point.y:=y;
+end;
+
+procedure test(p: tpoint);
+begin
+  if (p.x<>6) or
+     (p.y<>4) then
+    halt(1)
+end;
+
+var
+  pt: tpoint;
+  indent, secondy: longint;
+begin
+  indent:=5;
+  secondy:=2;
+  test(Point(Indent+1,secondy+2));
+end.

tests/webtbs/tw30007.pp

@@ -0,0 +1,16 @@
+program project6;
+
+{$r+}
+
+function LinesToText(Lines: array of String): String;
+begin
+end;
+
+var
+  SomeLines: array of String;
+begin
+  SetLength(SomeLines,1);
+  LinesToText(SomeLines); // <-- ok
+  SetLength(SomeLines,0);
+  LinesToText(SomeLines); // <-- range error
+end.