Просмотр исходного кода

--- Merging r41243 into '.':
U rtl/inc/objc.pp
--- Recording mergeinfo for merge of r41243 into '.':
U .
--- Merging r41335 into '.':
U compiler/arm/cgcpu.pas
U compiler/cgobj.pas
--- Recording mergeinfo for merge of r41335 into '.':
G .
--- Merging r41422 into '.':
U compiler/scanner.pas
--- Recording mergeinfo for merge of r41422 into '.':
G .
--- Merging r41474 into '.':
U compiler/pexpr.pas
A tests/webtbf/tw35149a.pp
A tests/webtbs/tw35149.pp
--- Recording mergeinfo for merge of r41474 into '.':
G .
--- Merging r41650 into '.':
U compiler/aarch64/racpugas.pas
--- Recording mergeinfo for merge of r41650 into '.':
G .
--- Merging r41651 into '.':
U tests/test/taarch64abi.pp
--- Recording mergeinfo for merge of r41651 into '.':
G .
--- Merging r41905 into '.':
U compiler/utils/ppuutils/ppudump.pp
--- Recording mergeinfo for merge of r41905 into '.':
G .

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

Jonas Maebe 6 лет назад
Родитель
Сommit
846da37c9f

+ 2 - 0
.gitattributes

@@ -14625,6 +14625,7 @@ tests/webtbf/tw34821.pp svneol=native#text/plain
 tests/webtbf/tw3488.pp svneol=native#text/plain
 tests/webtbf/tw3495.pp svneol=native#text/plain
 tests/webtbf/tw3502.pp svneol=native#text/plain
+tests/webtbf/tw35149a.pp svneol=native#text/plain
 tests/webtbf/tw3553.pp svneol=native#text/plain
 tests/webtbf/tw3562.pp svneol=native#text/plain
 tests/webtbf/tw3583.pp svneol=native#text/plain
@@ -16338,6 +16339,7 @@ tests/webtbs/tw3504.pp svneol=native#text/plain
 tests/webtbs/tw3506.pp svneol=native#text/plain
 tests/webtbs/tw35139.pp svneol=native#text/plain
 tests/webtbs/tw35139a.pp svneol=native#text/plain
+tests/webtbs/tw35149.pp svneol=native#text/plain
 tests/webtbs/tw3523.pp svneol=native#text/plain
 tests/webtbs/tw3529.pp svneol=native#text/plain
 tests/webtbs/tw3531.pp svneol=native#text/plain

+ 6 - 3
compiler/aarch64/racpugas.pas

@@ -485,8 +485,8 @@ Unit racpugas;
                       useszr:=false;
                       for i:=low(instr.operands) to pred(opnr) do
                         begin
-                          if (instr.operands[1].opr.typ=OPR_REGISTER) then
-                            case getsupreg(instr.operands[1].opr.reg) of
+                          if (instr.operands[i].opr.typ=OPR_REGISTER) then
+                            case getsupreg(instr.operands[i].opr.reg) of
                               RS_XZR:
                                 useszr:=true;
                               RS_SP:
@@ -494,7 +494,10 @@ Unit racpugas;
                             end;
                         end;
                       result:=valid_shifter_operand(instr.opcode,useszr,usessp,instr.Is64bit,sm,instr.operands[opnr].opr.shifterop.shiftimm);
-                    end
+                      if result then
+                        instr.Ops:=opnr;
+                    end;
+                  break;
                 end;
           end;
       end;

+ 11 - 45
compiler/arm/cgcpu.pas

@@ -42,7 +42,9 @@ unit cgcpu;
         cgsetflags : boolean;
 
         procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const paraloc : TCGPara);override;
-        procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);override;
+       protected
+         procedure a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation); override;
+       public
         procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara);override;
 
         procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
@@ -569,52 +571,16 @@ unit cgcpu;
       end;
 
 
-    procedure tbasecgarm.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);
-      var
-        tmpref, ref: treference;
-        location: pcgparalocation;
-        sizeleft: aint;
+    procedure tbasecgarm.a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation);
       begin
-        location := paraloc.location;
-        tmpref := r;
-        sizeleft := paraloc.intsize;
-        while assigned(location) do
+        { doubles in softemu mode have a strange order of registers and references }
+        if (cgpara.size=OS_F64) and
+           (location^.size=OS_32) then
           begin
-            paramanager.allocparaloc(list,location);
-            case location^.loc of
-              LOC_REGISTER,LOC_CREGISTER:
-                a_load_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
-              LOC_REFERENCE:
-                begin
-                  reference_reset_base(ref,location^.reference.index,location^.reference.offset,ctempposinvalid,paraloc.alignment,[]);
-                  { doubles in softemu mode have a strange order of registers and references }
-                  if location^.size=OS_32 then
-                    g_concatcopy(list,tmpref,ref,4)
-                  else
-                    begin
-                      g_concatcopy(list,tmpref,ref,sizeleft);
-                      if assigned(location^.next) then
-                        internalerror(2005010710);
-                    end;
-                end;
-              LOC_FPUREGISTER,LOC_CFPUREGISTER:
-                case location^.size of
-                   OS_F32, OS_F64:
-                     a_loadfpu_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
-                   else
-                     internalerror(2002072801);
-                end;
-              LOC_VOID:
-                begin
-                  // nothing to do
-                end;
-              else
-                internalerror(2002081103);
-            end;
-            inc(tmpref.offset,tcgsize2size[location^.size]);
-            dec(sizeleft,tcgsize2size[location^.size]);
-            location := location^.next;
-          end;
+            g_concatcopy(list,ref,paralocref,4)
+          end
+        else
+          inherited;
       end;
 
 

+ 22 - 10
compiler/cgobj.pas

@@ -170,6 +170,9 @@ unit cgobj;
              @param(cgpara where the parameter will be stored)
           }
           procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : TCGPara);virtual;
+         protected
+          procedure a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation); virtual;
+         public
           {# Pass the value of a parameter, which can be located either in a register or memory location,
              to a routine.
 
@@ -1123,16 +1126,8 @@ implementation
                 end;
               LOC_REFERENCE,LOC_CREFERENCE:
                 begin
-                   if assigned(location^.next) then
-                     internalerror(2010052906);
-                   reference_reset_base(ref,location^.reference.index,location^.reference.offset,ctempposinvalid,newalignment(cgpara.alignment,cgpara.intsize-sizeleft),[]);
-                   if (size <> OS_NO) and
-                      (tcgsize2size[size] <= sizeof(aint)) then
-                     a_load_ref_ref(list,size,location^.size,tmpref,ref)
-                   else
-                     { use concatcopy, because the parameter can be larger than }
-                     { what the OS_* constants can handle                       }
-                     g_concatcopy(list,tmpref,ref,sizeleft);
+                  reference_reset_base(ref,location^.reference.index,location^.reference.offset,ctempposinvalid,newalignment(cgpara.alignment,cgpara.intsize-sizeleft),[]);
+                  a_load_ref_cgparalocref(list,size,sizeleft,tmpref,ref,cgpara,location);
                 end;
               LOC_MMREGISTER,LOC_CMMREGISTER:
                 begin
@@ -1147,6 +1142,10 @@ implementation
                      else
                        internalerror(2010053101);
                    end;
+                end;
+              LOC_FPUREGISTER,LOC_CFPUREGISTER:
+                begin
+                  a_loadfpu_ref_reg(list,size,location^.size,tmpref,location^.register);
                 end
               else
                 internalerror(2010053111);
@@ -1157,6 +1156,19 @@ implementation
           end;
       end;
 
+    procedure tcg.a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation);
+      begin
+        if assigned(location^.next) then
+          internalerror(2010052906);
+        if (sourcesize<>OS_NO) and
+           (tcgsize2size[sourcesize]<=sizeof(aint)) then
+           a_load_ref_ref(list,sourcesize,location^.size,ref,paralocref)
+        else
+          { use concatcopy, because the parameter can be larger than }
+          { what the OS_* constants can handle                       }
+          g_concatcopy(list,ref,paralocref,sizeleft);
+       end;
+
 
     procedure tcg.a_load_loc_cgpara(list : TAsmList;const l:tlocation;const cgpara : TCGPara);
       begin

+ 1 - 3
compiler/pexpr.pas

@@ -1399,9 +1399,7 @@ implementation
                                 (current_procinfo.procdef.struct=structh))) then
                               Message(parser_e_only_class_members)
                             else
-                              Message(parser_e_only_class_members_via_class_ref)
-                          else if isobjecttype then
-                            Message(parser_e_only_static_members_via_object_type);
+                              Message(parser_e_only_class_members_via_class_ref);
                           p1:=csubscriptnode.create(sym,p1);
                         end;
                    end;

+ 6 - 4
compiler/scanner.pas

@@ -572,13 +572,15 @@ implementation
            { Default to intel assembler for delphi/tp7 on i386/i8086 }
            if (m_delphi in current_settings.modeswitches) or
               (m_tp7 in current_settings.modeswitches) then
+             begin
 {$ifdef i8086}
-             current_settings.asmmode:=asmmode_i8086_intel;
+               current_settings.asmmode:=asmmode_i8086_intel;
 {$else i8086}
-             current_settings.asmmode:=asmmode_i386_intel;
+               current_settings.asmmode:=asmmode_i386_intel;
 {$endif i8086}
-           if changeinit then
-             init_settings.asmmode:=current_settings.asmmode;
+               if changeinit then
+                 init_settings.asmmode:=current_settings.asmmode;
+             end;
 {$endif i386 or i8086}
 
            { Exception support explicitly turned on (mainly for macpas, to }

+ 2 - 2
compiler/utils/ppuutils/ppudump.pp

@@ -781,7 +781,7 @@ end;
 
 Procedure ReadContainer(const prefix:string);
 {
-  Read a serie of strings and write to the screen starting every line
+  Read a series of strings and write to the screen starting every line
   with prefix
 }
 begin
@@ -3825,7 +3825,7 @@ begin
 
          ibresources :
            if not silent then
-             ReadLinkContainer('Resource file: ');
+             ReadContainer('Resource file: ');
 
          iberror :
            begin

+ 3 - 0
rtl/inc/objc.pp

@@ -3,6 +3,9 @@ unit objc;
 
 {$ifdef darwin}
 {$define targethandled}
+
+{$linklib objc}
+
 {$if defined(iphonesim) or defined(cpuarm) or defined(cpux86_64) or defined(cpupowerpc64) or defined(cpuaarch64)}
 {$i objcnf.inc}
 {$endif}

+ 18 - 24
tests/test/taarch64abi.pp

@@ -23,34 +23,28 @@ begin
     Halt(3);
 end;
 
-function RetByte: byte;
-var
-  q: qword;
-begin
-  q:=$1111111112345678;
-  asm
-    ldr x0,q
-  end;
+function RetByte: byte; assembler;
+asm
+  movz    x0,#22136
+  movk    x0,#4660,lsl #16
+  movk    x0,#4369,lsl #32
+  movk    x0,#4369,lsl #48
 end;
 
-function RetWord: word;
-var
-  q: qword;
-begin
-  q:=$1111111112345678;
-  asm
-    ldr x0,q
-  end;
+function RetWord: word; assembler;
+asm
+  movz    x0,#22136
+  movk    x0,#4660,lsl #16
+  movk    x0,#4369,lsl #32
+  movk    x0,#4369,lsl #48
 end;
 
-function RetDWord: dword;
-var
-  q: qword;
-begin
-  q:=$1111111112345678;
-  asm
-    ldr x0,q
-  end;
+function RetDWord: dword; assembler;
+asm
+  movz    x0,#22136
+  movk    x0,#4660,lsl #16
+  movk    x0,#4369,lsl #32
+  movk    x0,#4369,lsl #48
 end;
 
 procedure TestParams;

+ 14 - 0
tests/webtbf/tw35149a.pp

@@ -0,0 +1,14 @@
+{ %fail }
+
+program project1;
+
+{$mode objfpc}
+type
+  TestObject = object
+  var
+    TestNested: Integer;
+  end;
+
+begin
+  writeln(TestObject.TestNested);
+end. 

+ 14 - 0
tests/webtbs/tw35149.pp

@@ -0,0 +1,14 @@
+{ %norun }
+
+program project1;
+
+{$mode objfpc}
+type
+  TestObject = object
+  var
+    TestNested: Integer;
+  end;
+
+begin
+  writeln(SizeOf(TestObject.TestNested));
+end.