--- Merging r20630 into '.':

A    tests/webtbs/tw21551.pp
U    compiler/nld.pas
--- Merging r20662 through r20663 into '.':
U    compiler/cgobj.pas
U    compiler/systems/i_bsd.pas
--- Merging r20665 into '.':
U    compiler/arm/cpupara.pas
--- Merging r20739 into '.':
U    compiler/optdead.pas
--- Merging r20947 into '.':
U    compiler/powerpc64/cpupara.pas
--- Merging r20950 through r20952 into '.':
G    compiler/optdead.pas
U    compiler/globtype.pas
U    compiler/ncgutil.pas
--- Merging r21095 into '.':
U    compiler/sparc/ncpuadd.pas
--- Merging r21113 through r21114 into '.':
U    compiler/aggas.pas
U    compiler/aoptobj.pas
--- Merging r21127 into '.':
U    compiler/i386/popt386.pas

git-svn-id: branches/fixes_2_6@21289 -

.gitattributes

@@ -11893,6 +11893,7 @@ tests/webtbs/tw2129.pp svneol=native#text/plain
 tests/webtbs/tw2129b.pp svneol=native#text/plain
 tests/webtbs/tw2131.pp svneol=native#text/plain
 tests/webtbs/tw2145.pp svneol=native#text/plain
+tests/webtbs/tw21551.pp svneol=native#text/plain
 tests/webtbs/tw2158.pp svneol=native#text/plain
 tests/webtbs/tw2159.pp svneol=native#text/plain
 tests/webtbs/tw2163.pp svneol=native#text/plain

compiler/aggas.pas

@@ -629,7 +629,7 @@ implementation
       constdef : taiconst_type;
       s,t      : string;
       i,pos,l  : longint;
-      InlineLevel : longint;
+      InlineLevel : cardinal;
       last_align : longint;
       co       : comp;
       sin      : single;

compiler/aoptobj.pas

@@ -1034,7 +1034,8 @@ Unit AoptObj;
                          (assigned(taicpu(p).oper[0]^.ref^.symbol)) and
                          (taicpu(p).oper[0]^.ref^.symbol is TAsmLabel) then
                         begin
-                          while GetNextInstruction(p, hp1) and
+                          hp2:=p;
+                          while GetNextInstruction(hp2, hp1) and
                                 (hp1.typ <> ait_label) do
                             if not(hp1.typ in ([ait_label,ait_align]+skipinstr)) then
                               begin
@@ -1044,8 +1045,15 @@ Unit AoptObj;
                                    assigned(taicpu(hp1).oper[0]^.ref^.symbol) and
                                    (taicpu(hp1).oper[0]^.ref^.symbol is TAsmLabel) then
                                    TAsmLabel(taicpu(hp1).oper[0]^.ref^.symbol).decrefs;
-                                asml.remove(hp1);
-                                hp1.free;
+                                { don't kill start/end of assembler block,
+                                  no-line-info-start/end etc }
+                                if hp1.typ<>ait_marker then
+                                  begin
+                                    asml.remove(hp1);
+                                    hp1.free;
+                                  end
+                                else
+                                  hp2:=hp1;
                               end
                             else break;
                           end;

compiler/arm/cpupara.pas

@@ -55,7 +55,7 @@ unit cpupara;
     uses
        verbose,systems,cutils,
        rgobj,
-       defutil,symsym;
+       defutil,symsym,symtable;
 
 
     function tarmparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
@@ -198,10 +198,75 @@ unit cpupara;
 
 
     function tarmparamanager.ret_in_param(def : tdef;calloption : tproccalloption) : boolean;
+      var
+        i: longint;
+        sym: tsym;
+        fpufield: boolean;
       begin
         case def.typ of
           recorddef:
-            result:=def.size>4;
+            begin
+              result:=def.size>4;
+              if not result and
+                 (target_info.abi in [abi_default,abi_armeb]) then
+                begin
+                  { in case of the old ARM abi (APCS), a struct is returned in
+                    a register only if it is simple. And what is a (non-)simple
+                    struct:
+
+                    "A non-simple type is any non-floating-point type of size
+                     greater than one word (including structures containing only
+                     floating-point fields), and certain single-word structured
+                     types."
+                       (-- ARM APCS documentation)
+
+                    So only floating point types or more than one word ->
+                    definitely non-simple (more than one word is already
+                    checked above). This includes unions/variant records with
+                    overlaid floating point and integer fields.
+
+                    Smaller than one word struct types are simple if they are
+                    "integer-like", and:
+
+                    "A structure is termed integer-like if its size is less than
+                    or equal to one word, and the offset of each of its
+                    addressable subfields is zero."
+                      (-- ARM APCS documentation)
+
+                    An "addressable subfield" is a field of which you can take
+                    the address, which in practive means any non-bitfield.
+                    In Pascal, there is no way to express the difference that
+                    you can have in C between "char" and "int :8". In this
+                    context, we use the fake distinction that a type defined
+                    inside the record itself (such as "a: 0..255;") indicates
+                    a bitpacked field while a field using a different type
+                    (such as "a: byte;") is not.
+                  }
+                  for i:=0 to trecorddef(def).symtable.SymList.count-1 do
+                    begin
+                      sym:=tsym(trecorddef(def).symtable.SymList[i]);
+                      if sym.typ<>fieldvarsym then
+                        continue;
+                      { bitfield -> ignore }
+                      if (trecordsymtable(trecorddef(def).symtable).usefieldalignment=bit_alignment) and
+                         (tfieldvarsym(sym).vardef.typ in [orddef,enumdef]) and
+                         (tfieldvarsym(sym).vardef.owner.defowner=def) then
+                        continue;
+                      { all other fields must be at offset zero }
+                      if tfieldvarsym(sym).fieldoffset<>0 then
+                        begin
+                          result:=true;
+                          exit;
+                        end;
+                      { floating point field -> also by reference }
+                      if tfieldvarsym(sym).vardef.typ=floatdef then
+                        begin
+                          result:=true;
+                          exit;
+                        end;
+                    end;
+                end;
+            end;
           procvardef:
             if not tprocvardef(def).is_addressonly then
               result:=true

compiler/cgobj.pas

@@ -3207,6 +3207,8 @@ implementation
 
 
     procedure tcg.a_loadmm_loc_reg(list: TAsmList; size: tcgsize; const loc: tlocation; const reg: tregister;shuffle : pmmshuffle);
+      var
+        tmpreg: tregister;
       begin
         case loc.loc of
           LOC_MMREGISTER,LOC_CMMREGISTER:
@@ -3215,6 +3217,13 @@ implementation
             a_loadmm_ref_reg(list,loc.size,size,loc.reference,reg,shuffle);
           LOC_REGISTER,LOC_CREGISTER:
             a_loadmm_intreg_reg(list,loc.size,size,loc.register,reg,shuffle);
+          LOC_SUBSETREF,LOC_CSUBSETREF,
+          LOC_SUBSETREG,LOC_CSUBSETREG:
+            begin
+              tmpreg:=getintregister(list,loc.size);
+              a_load_loc_reg(list,loc.size,loc,tmpreg);
+              a_loadmm_intreg_reg(list,loc.size,size,tmpreg,reg,shuffle);
+            end
           else
             internalerror(200310121);
         end;

compiler/globtype.pas

@@ -246,7 +246,7 @@ interface
        { whole program optimizations whose information generation requires
          information from all loaded units
        }
-       WPOptimizationsNeedingAllUnitInfo = [cs_wpo_devirtualize_calls];
+       WPOptimizationsNeedingAllUnitInfo = [cs_wpo_devirtualize_calls,cs_wpo_optimize_vmts];
 
        featurestr : array[tfeature] of string[12] = (
          'HEAP','INITFINAL','RTTI','CLASSES','EXCEPTIONS','EXITCODE',

compiler/i386/popt386.pas

@@ -637,12 +637,20 @@ begin
         because it can never be executed}
                 if (taicpu(p).opcode = A_JMP) then
                   begin
-                    while GetNextInstruction(p, hp1) and
+                    hp2:=p;
+                    while GetNextInstruction(hp2, hp1) and
                           (hp1.typ <> ait_label) do
                       if not(hp1.typ in ([ait_label,ait_align]+skipinstr)) then
                         begin
-                          asml.remove(hp1);
-                          hp1.free;
+                          { don't kill start/end of assembler block,
+                            no-line-info-start/end etc }
+                          if hp1.typ<>ait_marker then
+                            begin
+                              asml.remove(hp1);
+                              hp1.free;
+                            end
+                          else
+                            hp2:=hp1;
                         end
                       else break;
                     end;

compiler/ncgutil.pas

@@ -3011,6 +3011,12 @@ implementation
                 for j:=0 to ImplIntf.ProcDefs.Count-1 do
                   begin
                     pd:=TProcdef(ImplIntf.ProcDefs[j]);
+                    { we don't track method calls via interfaces yet ->
+                      assume that every method called via an interface call
+                      is reachable for now }
+                    if (po_virtualmethod in pd.procoptions) and
+                       not is_objectpascal_helper(tprocdef(pd).struct) then
+                      tobjectdef(tprocdef(pd).struct).register_vmt_call(tprocdef(pd).extnumber);
                     tmps:=make_mangledname('WRPR',_class.owner,_class.objname^+'_$_'+
                       ImplIntf.IntfDef.objname^+'_$_'+tostr(j)+'_$_'+pd.mangledname);
                     { create wrapper code }

compiler/nld.pas

@@ -1111,7 +1111,10 @@ implementation
     function ttypenode.docompare(p: tnode): boolean;
       begin
         docompare :=
-          inherited docompare(p);
+          inherited docompare(p) and
+          (typedef=ttypenode(p).typedef) and
+          (allowed=ttypenode(p).allowed) and
+          (helperallowed=ttypenode(p).helperallowed);
       end;
 
 
@@ -1193,7 +1196,8 @@ implementation
         docompare :=
           inherited docompare(p) and
           (rttidef = trttinode(p).rttidef) and
-          (rttitype = trttinode(p).rttitype);
+          (rttitype = trttinode(p).rttitype) and
+          (rttidatatype = trttinode(p).rttidatatype);
       end;
 
 end.

compiler/optdead.pas

@@ -354,7 +354,8 @@ const
       { regular nm }
       if not symbolprogfound then
         symbolprogfound:=findutil('nm',nmfullname,symbolprogfullpath);
-      if not symbolprogfound then
+      if not symbolprogfound and
+         (target_info.system in systems_linux) then
         begin
           { try objdump }
           symbolprogfound:=findutil('objdump',objdumpfullname,symbolprogfullpath);
@@ -364,6 +365,11 @@ const
       else
         begin
           symbolprogfullpath:=symbolprogfullpath+' -p ';
+          { GNU nm shows 64 bit addresses when processing 32 bit binaries on
+            a 64 bit platform, but only skips 8 spaces for the address in case
+            of undefined symbols -> skip undefined symbols }
+          if target_info.system in (systems_linux+systems_windows) then
+            symbolprogfullpath:=symbolprogfullpath+'--defined-only ';
           symbolprogisnm:=true;
         end;
       if not symbolprogfound then

compiler/powerpc64/cpupara.pas

@@ -486,7 +486,7 @@ begin
 
   result := create_paraloc_info_intern(p, callerside, p.paras, curintreg,
     curfloatreg, curmmreg, cur_stack_offset, false);
-  if (p.proccalloption in [pocall_cdecl, pocall_cppdecl]) then begin
+  if (p.proccalloption in [pocall_cdecl, pocall_cppdecl, pocall_mwpascal]) then begin
     { just continue loading the parameters in the registers }
     result := create_paraloc_info_intern(p, callerside, varargspara, curintreg,
       curfloatreg, curmmreg, cur_stack_offset, true);

compiler/sparc/ncpuadd.pas

@@ -256,17 +256,38 @@ interface
 
 
     procedure tsparcaddnode.second_cmpsmallset;
+      var
+        tmpreg : tregister;
       begin
         pass_left_right;
-        force_reg_left_right(true,true);
-
-        if right.location.loc = LOC_CONSTANT then
-          tcgsparc(cg).handle_reg_const_reg(current_asmdata.CurrAsmList,A_SUBcc,left.location.register,right.location.value,NR_G0)
-        else
-          current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBcc,left.location.register,right.location.register,NR_G0));
 
         location_reset(location,LOC_FLAGS,OS_NO);
-        location.resflags:=getresflags(true);
+
+        force_reg_left_right(false,false);
+
+        case nodetype of
+          equaln,
+          unequaln:
+            begin
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBcc,left.location.register,right.location.register,NR_G0));
+              location.resflags:=getresflags(true);
+            end;
+          lten,
+          gten:
+            begin
+              if (not(nf_swapped in flags) and
+                  (nodetype = lten)) or
+                 ((nf_swapped in flags) and
+                  (nodetype = gten)) then
+                swapleftright;
+              tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_AND,tmpreg,left.location.register,right.location.register));
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBcc,tmpreg,right.location.register,NR_G0));
+              location.resflags:=F_E;
+            end;
+          else
+            internalerror(2012042701);
+        end;
       end;
 
 

compiler/systems/i_bsd.pas

@@ -982,10 +982,10 @@ initialization
   {$ifdef Darwin}
      set_source_info(system_powerpc64_darwin_info);
   {$endif Darwin}
+{$endif powerpc64}
 {$ifdef cpuarm}
   {$ifdef Darwin}
      set_source_info(system_arm_darwin_info);
   {$endif Darwin}
 {$endif cpuarm}
-{$endif powerpc64}
 end.

tests/webtbs/tw21551.pp

@@ -0,0 +1,19 @@
+{ %opt=-O2 }
+{$mode delphi}
+
+type
+  tc1 = class
+  end;
+
+  tc2 = class
+  end;
+
+var
+  c: tobject;
+begin
+  c:=tc2.create;
+  if (c is tc1) or
+     (c is tc2) then
+    halt(0);
+  halt(1);
+end.