Browse Source

* synchronised with fixes_3_0 till r32666, adding the AArch64-specific part
of r30765

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

Jonas Maebe 9 years ago
parent
commit
4e6d5f3538

+ 11 - 0
.gitattributes

@@ -12033,6 +12033,7 @@ tests/test/tobjc39.pp svneol=native#text/plain
 tests/test/tobjc4.pp svneol=native#text/plain
 tests/test/tobjc4.pp svneol=native#text/plain
 tests/test/tobjc40.pp svneol=native#text/plain
 tests/test/tobjc40.pp svneol=native#text/plain
 tests/test/tobjc41.pp svneol=native#text/plain
 tests/test/tobjc41.pp svneol=native#text/plain
+tests/test/tobjc42.pp svneol=native#text/plain
 tests/test/tobjc4a.pp svneol=native#text/plain
 tests/test/tobjc4a.pp svneol=native#text/plain
 tests/test/tobjc5.pp svneol=native#text/plain
 tests/test/tobjc5.pp svneol=native#text/plain
 tests/test/tobjc5a.pp svneol=native#text/plain
 tests/test/tobjc5a.pp svneol=native#text/plain
@@ -12717,6 +12718,7 @@ tests/test/uobjc35f.pp svneol=native#text/plain
 tests/test/uobjc35g.pp svneol=native#text/plain
 tests/test/uobjc35g.pp svneol=native#text/plain
 tests/test/uobjc39.pp svneol=native#text/plain
 tests/test/uobjc39.pp svneol=native#text/plain
 tests/test/uobjc41.pp svneol=native#text/plain
 tests/test/uobjc41.pp svneol=native#text/plain
+tests/test/uobjc42.pp svneol=native#text/plain
 tests/test/uobjc7.pp svneol=native#text/plain
 tests/test/uobjc7.pp svneol=native#text/plain
 tests/test/uobjcl1.pp svneol=native#text/plain
 tests/test/uobjcl1.pp svneol=native#text/plain
 tests/test/uprec6.pp svneol=native#text/plain
 tests/test/uprec6.pp svneol=native#text/plain
@@ -13573,6 +13575,7 @@ tests/webtbs/tw1430.pp svneol=native#text/plain
 tests/webtbs/tw14307.pp svneol=native#text/plain
 tests/webtbs/tw14307.pp svneol=native#text/plain
 tests/webtbs/tw14315.pp svneol=native#text/plain
 tests/webtbs/tw14315.pp svneol=native#text/plain
 tests/webtbs/tw1433.pp svneol=native#text/plain
 tests/webtbs/tw1433.pp svneol=native#text/plain
+tests/webtbs/tw14347.pp svneol=native#text/pascal
 tests/webtbs/tw14363.pp svneol=native#text/plain
 tests/webtbs/tw14363.pp svneol=native#text/plain
 tests/webtbs/tw14388.pp svneol=native#text/pascal
 tests/webtbs/tw14388.pp svneol=native#text/pascal
 tests/webtbs/tw14403.pp svneol=native#text/plain
 tests/webtbs/tw14403.pp svneol=native#text/plain
@@ -14148,6 +14151,7 @@ tests/webtbs/tw24651.pp svneol=native#text/pascal
 tests/webtbs/tw24690.pp svneol=native#text/pascal
 tests/webtbs/tw24690.pp svneol=native#text/pascal
 tests/webtbs/tw24705.pp svneol=native#text/pascal
 tests/webtbs/tw24705.pp svneol=native#text/pascal
 tests/webtbs/tw2473.pp svneol=native#text/plain
 tests/webtbs/tw2473.pp svneol=native#text/plain
+tests/webtbs/tw24796.pp svneol=native#text/pascal
 tests/webtbs/tw2480.pp svneol=native#text/plain
 tests/webtbs/tw2480.pp svneol=native#text/plain
 tests/webtbs/tw2481.pp svneol=native#text/plain
 tests/webtbs/tw2481.pp svneol=native#text/plain
 tests/webtbs/tw2483.pp svneol=native#text/plain
 tests/webtbs/tw2483.pp svneol=native#text/plain
@@ -14253,6 +14257,8 @@ tests/webtbs/tw26482.pp svneol=native#text/pascal
 tests/webtbs/tw26483.pp svneol=native#text/pascal
 tests/webtbs/tw26483.pp svneol=native#text/pascal
 tests/webtbs/tw2649.pp svneol=native#text/plain
 tests/webtbs/tw2649.pp svneol=native#text/plain
 tests/webtbs/tw2651.pp svneol=native#text/plain
 tests/webtbs/tw2651.pp svneol=native#text/plain
+tests/webtbs/tw26534a.pp svneol=native#text/pascal
+tests/webtbs/tw26534b.pp svneol=native#text/pascal
 tests/webtbs/tw26536.pp svneol=native#text/plain
 tests/webtbs/tw26536.pp svneol=native#text/plain
 tests/webtbs/tw2656.pp svneol=native#text/plain
 tests/webtbs/tw2656.pp svneol=native#text/plain
 tests/webtbs/tw2659.pp svneol=native#text/plain
 tests/webtbs/tw2659.pp svneol=native#text/plain
@@ -14291,6 +14297,7 @@ tests/webtbs/tw27185.pp svneol=native#text/pascal
 tests/webtbs/tw2721.pp svneol=native#text/plain
 tests/webtbs/tw2721.pp svneol=native#text/plain
 tests/webtbs/tw2723.pp svneol=native#text/plain
 tests/webtbs/tw2723.pp svneol=native#text/plain
 tests/webtbs/tw2725.pp svneol=native#text/plain
 tests/webtbs/tw2725.pp svneol=native#text/plain
+tests/webtbs/tw27256.pp svneol=native#text/pascal
 tests/webtbs/tw2727.pp svneol=native#text/plain
 tests/webtbs/tw2727.pp svneol=native#text/plain
 tests/webtbs/tw2728.pp svneol=native#text/plain
 tests/webtbs/tw2728.pp svneol=native#text/plain
 tests/webtbs/tw2729.pp svneol=native#text/plain
 tests/webtbs/tw2729.pp svneol=native#text/plain
@@ -14304,22 +14311,26 @@ tests/webtbs/tw2737.pp svneol=native#text/plain
 tests/webtbs/tw2738.pp svneol=native#text/plain
 tests/webtbs/tw2738.pp svneol=native#text/plain
 tests/webtbs/tw2739.pp svneol=native#text/plain
 tests/webtbs/tw2739.pp svneol=native#text/plain
 tests/webtbs/tw27424.pp svneol=native#text/pascal
 tests/webtbs/tw27424.pp svneol=native#text/pascal
+tests/webtbs/tw27517.pp svneol=native#text/pascal
 tests/webtbs/tw2758.pp svneol=native#text/plain
 tests/webtbs/tw2758.pp svneol=native#text/plain
 tests/webtbs/tw2763.pp svneol=native#text/plain
 tests/webtbs/tw2763.pp svneol=native#text/plain
 tests/webtbs/tw2765.pp svneol=native#text/plain
 tests/webtbs/tw2765.pp svneol=native#text/plain
 tests/webtbs/tw27658.pp svneol=native#text/pascal
 tests/webtbs/tw27658.pp svneol=native#text/pascal
 tests/webtbs/tw27665.pp svneol=native#text/plain
 tests/webtbs/tw27665.pp svneol=native#text/plain
 tests/webtbs/tw2767.pp svneol=native#text/plain
 tests/webtbs/tw2767.pp svneol=native#text/plain
+tests/webtbs/tw27691.pp svneol=native#text/plain
 tests/webtbs/tw2771.pp svneol=native#text/plain
 tests/webtbs/tw2771.pp svneol=native#text/plain
 tests/webtbs/tw2772.pp svneol=native#text/plain
 tests/webtbs/tw2772.pp svneol=native#text/plain
 tests/webtbs/tw2776.pp svneol=native#text/plain
 tests/webtbs/tw2776.pp svneol=native#text/plain
 tests/webtbs/tw2778.pp svneol=native#text/plain
 tests/webtbs/tw2778.pp svneol=native#text/plain
 tests/webtbs/tw2779.pp svneol=native#text/plain
 tests/webtbs/tw2779.pp svneol=native#text/plain
 tests/webtbs/tw2780.pp svneol=native#text/plain
 tests/webtbs/tw2780.pp svneol=native#text/plain
+tests/webtbs/tw27811.pp svneol=native#text/plain
 tests/webtbs/tw27832.pp svneol=native#text/plain
 tests/webtbs/tw27832.pp svneol=native#text/plain
 tests/webtbs/tw2788.pp svneol=native#text/plain
 tests/webtbs/tw2788.pp svneol=native#text/plain
 tests/webtbs/tw2789.pp svneol=native#text/plain
 tests/webtbs/tw2789.pp svneol=native#text/plain
 tests/webtbs/tw2794.pp svneol=native#text/plain
 tests/webtbs/tw2794.pp svneol=native#text/plain
+tests/webtbs/tw28007.pp svneol=native#text/pascal
 tests/webtbs/tw2803.pp svneol=native#text/plain
 tests/webtbs/tw2803.pp svneol=native#text/plain
 tests/webtbs/tw2806.pp svneol=native#text/plain
 tests/webtbs/tw2806.pp svneol=native#text/plain
 tests/webtbs/tw2807.pp svneol=native#text/plain
 tests/webtbs/tw2807.pp svneol=native#text/plain

+ 4 - 0
compiler/aarch64/ncpucnv.pas

@@ -163,6 +163,10 @@ implementation
        exit;
        exit;
 
 
       case left.location.loc of
       case left.location.loc of
+        LOC_SUBSETREG,
+        LOC_CSUBSETREG,
+        LOC_SUBSETREF,
+        LOC_CSUBSETREF,
         LOC_CREFERENCE,
         LOC_CREFERENCE,
         LOC_REFERENCE,
         LOC_REFERENCE,
         LOC_REGISTER,
         LOC_REGISTER,

+ 2 - 2
compiler/aasmbase.pas

@@ -197,7 +197,7 @@ interface
     function EncodeUleb128(a: qword;out buf) : byte;
     function EncodeUleb128(a: qword;out buf) : byte;
     function EncodeSleb128(a: int64;out buf) : byte;
     function EncodeSleb128(a: int64;out buf) : byte;
 
 
-    function ReplaceForbiddenAsmSymbolChars(const s: string): string;
+    function ReplaceForbiddenAsmSymbolChars(const s: ansistring): ansistring;
 
 
     { dummy default noop callback }
     { dummy default noop callback }
     procedure default_global_used;
     procedure default_global_used;
@@ -348,7 +348,7 @@ implementation
       end;
       end;
 
 
 
 
-    function ReplaceForbiddenAsmSymbolChars(const s: string): string;
+    function ReplaceForbiddenAsmSymbolChars(const s: ansistring): ansistring;
       var
       var
         i : longint;
         i : longint;
         rchar: char;
         rchar: char;

+ 4 - 0
compiler/arm/narmcnv.pas

@@ -314,6 +314,10 @@ implementation
 
 
          { Load left node into flag F_NE/F_E }
          { Load left node into flag F_NE/F_E }
          resflags:=F_NE;
          resflags:=F_NE;
+
+         if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then
+           hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+
          case left.location.loc of
          case left.location.loc of
             LOC_CREFERENCE,
             LOC_CREFERENCE,
             LOC_REFERENCE :
             LOC_REFERENCE :

+ 1 - 1
compiler/arm/narminl.pas

@@ -372,7 +372,7 @@ implementation
                   current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_PLD,ref));
                   current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_PLD,ref));
                 end;
                 end;
               else
               else
-                internalerror(200402021);
+                { nothing to prefetch };
             end;
             end;
           end;
           end;
       end;
       end;

+ 2 - 2
compiler/comprsrc.pas

@@ -283,10 +283,10 @@ begin
       Replace(s,'$OBJ',maybequoted(OutName));
       Replace(s,'$OBJ',maybequoted(OutName));
       subarch:='all';
       subarch:='all';
       arch:=cpu2str[target_cpu];
       arch:=cpu2str[target_cpu];
-      if (source_info.cpu=systems.cpu_arm) then
+      if (target_info.cpu=systems.cpu_arm) then
         begin
         begin
           //Differentiate between arm and armeb
           //Differentiate between arm and armeb
-          if (source_info.endian=endian_big) then
+          if (target_info.endian=endian_big) then
             arch:=arch+'eb';
             arch:=arch+'eb';
         end;
         end;
       Replace(s,'$ARCH',arch);
       Replace(s,'$ARCH',arch);

+ 1 - 1
compiler/finput.pas

@@ -454,7 +454,7 @@ uses
         fileopen:=false;
         fileopen:=false;
         try
         try
           f:=CFileStreamClass.Create(filename,fmOpenRead);
           f:=CFileStreamClass.Create(filename,fmOpenRead);
-          fileopen:=true;
+          fileopen:=CStreamError=0;
         except
         except
         end;
         end;
       end;
       end;

+ 1 - 0
compiler/fmodule.pas

@@ -983,6 +983,7 @@ implementation
                 { Give a note when the unit is not referenced, skip
                 { Give a note when the unit is not referenced, skip
                   this is for units with an initialization/finalization }
                   this is for units with an initialization/finalization }
                 if (unitmap[pu.u.moduleid].refs=0) and
                 if (unitmap[pu.u.moduleid].refs=0) and
+                   pu.in_uses and
                    ((pu.u.flags and (uf_init or uf_finalize))=0) then
                    ((pu.u.flags and (uf_init or uf_finalize))=0) then
                   CGMessagePos2(pu.unitsym.fileinfo,sym_n_unit_not_used,pu.u.realmodulename^,realmodulename^);
                   CGMessagePos2(pu.unitsym.fileinfo,sym_n_unit_not_used,pu.u.realmodulename^,realmodulename^);
               end;
               end;

+ 4 - 0
compiler/m68k/n68kcnv.pas

@@ -201,6 +201,10 @@ implementation
 
 
          newsize:=def_cgsize(resultdef);
          newsize:=def_cgsize(resultdef);
          opsize := def_cgsize(left.resultdef);
          opsize := def_cgsize(left.resultdef);
+
+        if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+
          case left.location.loc of
          case left.location.loc of
             LOC_CREFERENCE,LOC_REFERENCE :
             LOC_CREFERENCE,LOC_REFERENCE :
               begin
               begin

+ 3 - 1
compiler/mips/aoptcpu.pas

@@ -310,7 +310,9 @@ unit aoptcpu;
 
 
   function TCpuAsmOptimizer.TryRemoveMovToRefIndex(var p: tai; next: taicpu): boolean;
   function TCpuAsmOptimizer.TryRemoveMovToRefIndex(var p: tai; next: taicpu): boolean;
     begin
     begin
-      result:=(next.oper[1]^.typ=top_ref) and
+      result:=(next.ops>1) and
+        (next.oper[1]^.typ=top_ref) and
+        (next.oper[1]^.ref^.refaddr<>addr_full) and
         (next.oper[1]^.ref^.base=taicpu(p).oper[0]^.reg) and
         (next.oper[1]^.ref^.base=taicpu(p).oper[0]^.reg) and
         (not RegModifiedBetween(taicpu(p).oper[1]^.reg,p,next)) and
         (not RegModifiedBetween(taicpu(p).oper[1]^.reg,p,next)) and
         Assigned(FindRegDealloc(taicpu(p).oper[0]^.reg,tai(next.next)));
         Assigned(FindRegDealloc(taicpu(p).oper[0]^.reg,tai(next.next)));

+ 21 - 17
compiler/mips/ncpucnv.pas

@@ -207,26 +207,30 @@ begin
   if codegenerror then
   if codegenerror then
     exit;
     exit;
 
 
-         { Explicit typecasts from any ordinal type to a boolean type }
-         { must not change the ordinal value                          }
-         if (nf_explicit in flags) and
-            not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
-           begin
-              location_copy(location,left.location);
-              newsize:=def_cgsize(resultdef);
-              { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }
-              if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or
-                 ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
-                hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
-              else
-                location.size:=newsize;
-              current_procinfo.CurrTrueLabel:=oldTrueLabel;
-              current_procinfo.CurrFalseLabel:=oldFalseLabel;
-              exit;
-           end;
+  { Explicit typecasts from any ordinal type to a boolean type }
+  { must not change the ordinal value                          }
+  if (nf_explicit in flags) and
+     not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
+    begin
+       location_copy(location,left.location);
+       newsize:=def_cgsize(resultdef);
+       { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }
+       if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or
+          ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
+         hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
+       else
+         location.size:=newsize;
+       current_procinfo.CurrTrueLabel:=oldTrueLabel;
+       current_procinfo.CurrFalseLabel:=oldFalseLabel;
+       exit;
+    end;
 
 
   location_reset(location, LOC_REGISTER, def_cgsize(resultdef));
   location_reset(location, LOC_REGISTER, def_cgsize(resultdef));
   opsize := def_cgsize(left.resultdef);
   opsize := def_cgsize(left.resultdef);
+
+  if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then
+    hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+
   case left.location.loc of
   case left.location.loc of
     LOC_CREFERENCE, LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER:
     LOC_CREFERENCE, LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER:
     begin
     begin

+ 3 - 4
compiler/nadd.pas

@@ -409,8 +409,7 @@ implementation
           end;
           end;
 
 
         { both are int constants }
         { both are int constants }
-        if (
-            (
+        if  (
              is_constintnode(left) and
              is_constintnode(left) and
              is_constintnode(right)
              is_constintnode(right)
             ) or
             ) or
@@ -422,7 +421,7 @@ implementation
             (
             (
              is_constenumnode(left) and
              is_constenumnode(left) and
              is_constenumnode(right) and
              is_constenumnode(right) and
-             allowenumop(nodetype))
+             (allowenumop(nodetype) or (nf_internal in flags))
             ) or
             ) or
             (
             (
              (lt = pointerconstn) and
              (lt = pointerconstn) and
@@ -2140,7 +2139,7 @@ implementation
          { enums }
          { enums }
          else if (ld.typ=enumdef) and (rd.typ=enumdef) then
          else if (ld.typ=enumdef) and (rd.typ=enumdef) then
           begin
           begin
-            if allowenumop(nodetype) then
+            if allowenumop(nodetype) or (nf_internal in flags) then
               inserttypeconv(right,left.resultdef)
               inserttypeconv(right,left.resultdef)
             else
             else
               CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
               CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);

+ 39 - 5
compiler/ncal.pas

@@ -272,6 +272,9 @@ interface
        between the callparanodes and the callnode they belong to }
        between the callparanodes and the callnode they belong to }
       aktcallnode : tcallnode;
       aktcallnode : tcallnode;
 
 
+    const
+      { track current inlining depth }
+      inlinelevel : longint = 0;
 
 
 implementation
 implementation
 
 
@@ -1232,10 +1235,17 @@ implementation
                         { uninitialized warnings (tbs/tb0542)         }
                         { uninitialized warnings (tbs/tb0542)         }
                         set_varstate(left,vs_written,[]);
                         set_varstate(left,vs_written,[]);
                         set_varstate(left,vs_readwritten,[]);
                         set_varstate(left,vs_readwritten,[]);
+                        make_not_regable(left,[ra_addr_regable,ra_addr_taken]);
                       end;
                       end;
                     vs_var,
                     vs_var,
                     vs_constref:
                     vs_constref:
-                      set_varstate(left,vs_readwritten,[vsf_must_be_valid,vsf_use_hints]);
+                      begin
+                        set_varstate(left,vs_readwritten,[vsf_must_be_valid,vsf_use_hints]);
+                        { constref takes also the address, but storing it is actually the compiler
+                          is not supposed to expect }
+                        if parasym.varspez=vs_var then
+                          make_not_regable(left,[ra_addr_regable,ra_addr_taken]);
+                      end;
                     else
                     else
                       set_varstate(left,vs_read,[vsf_must_be_valid]);
                       set_varstate(left,vs_read,[vsf_must_be_valid]);
                   end;
                   end;
@@ -1930,7 +1940,10 @@ implementation
                       typecheckpass(temp);
                       typecheckpass(temp);
                       if (temp.nodetype <> ordconstn) or
                       if (temp.nodetype <> ordconstn) or
                          (tordconstnode(temp).value <> 0) then
                          (tordconstnode(temp).value <> 0) then
-                        hightree := caddnode.create(subn,hightree,temp)
+                        begin
+                          hightree:=caddnode.create(subn,hightree,temp);
+                          include(hightree.flags,nf_internal);
+                        end
                       else
                       else
                         temp.free;
                         temp.free;
                     end;
                     end;
@@ -3722,9 +3735,25 @@ implementation
         { Can we inline the procedure? }
         { Can we inline the procedure? }
         if (po_inline in procdefinition.procoptions) and
         if (po_inline in procdefinition.procoptions) and
            (procdefinition.typ=procdef) and
            (procdefinition.typ=procdef) and
-           tprocdef(procdefinition).has_inlininginfo then
+           tprocdef(procdefinition).has_inlininginfo and
+           {  Prevent too deep inlining recursion and code bloat by inlining
+
+              The actual formuala is
+                                inlinelevel+1  /-------
+                  node count <  -------------\/  10000
+
+              This allows exponential grow of the code only to a certain limit.
+
+              Remarks
+               - The current approach calculates the inlining level top down, so outer call nodes (nodes closer to the leaf) might not be inlined
+                 if the max. complexity is reached. This is done because it makes the implementation easier and because
+                 there might be situations were it is more beneficial to inline inner nodes and do the calls to the outer nodes
+                 if the outer nodes are in a seldomly used code path
+               - The code avoids to use functions from the math unit
+           }
+           (node_count(tprocdef(procdefinition).inlininginfo^.code)<round(exp((1.0/(inlinelevel+1))*ln(10000)))) then
           begin
           begin
-             include(callnodeflags,cnf_do_inline);
+            include(callnodeflags,cnf_do_inline);
             { Check if we can inline the procedure when it references proc/var that
             { Check if we can inline the procedure when it references proc/var that
               are not in the globally available }
               are not in the globally available }
             st:=procdefinition.owner;
             st:=procdefinition.owner;
@@ -4124,7 +4153,10 @@ implementation
             ((tloadnode(n).symtable.symtabletype in [globalsymtable,ObjectSymtable]) or
             ((tloadnode(n).symtable.symtabletype in [globalsymtable,ObjectSymtable]) or
             { statics can only be modified by functions in the same unit }
             { statics can only be modified by functions in the same unit }
              ((tloadnode(n).symtable.symtabletype = staticsymtable) and
              ((tloadnode(n).symtable.symtabletype = staticsymtable) and
-              (tloadnode(n).symtable = TSymtable(arg))))) or
+              (tloadnode(n).symtable = TSymtable(arg))) or
+              { if the addr of the symbol is taken somewhere, it can be also non-local }
+              (tabstractvarsym(tloadnode(n).symtableentry).addr_taken)
+           )) or
            ((n.nodetype = subscriptn) and
            ((n.nodetype = subscriptn) and
             (tsubscriptnode(n).vs.owner.symtabletype = ObjectSymtable)) then
             (tsubscriptnode(n).vs.owner.symtabletype = ObjectSymtable)) then
           result := fen_norecurse_true;
           result := fen_norecurse_true;
@@ -4400,6 +4432,7 @@ implementation
         inlineblock,
         inlineblock,
         inlinecleanupblock : tblocknode;
         inlinecleanupblock : tblocknode;
       begin
       begin
+        inc(inlinelevel);
         result:=nil;
         result:=nil;
         if not(assigned(tprocdef(procdefinition).inlininginfo) and
         if not(assigned(tprocdef(procdefinition).inlininginfo) and
                assigned(tprocdef(procdefinition).inlininginfo^.code)) then
                assigned(tprocdef(procdefinition).inlininginfo^.code)) then
@@ -4497,6 +4530,7 @@ implementation
         writeln('**************************',tprocdef(procdefinition).mangledname);
         writeln('**************************',tprocdef(procdefinition).mangledname);
         printnode(output,result);
         printnode(output,result);
 {$endif DEBUGINLINE}
 {$endif DEBUGINLINE}
+        dec(inlinelevel);
       end;
       end;
 
 
 end.
 end.

+ 10 - 10
compiler/ncgvmt.pas

@@ -246,9 +246,9 @@ implementation
            writestrentry(list,p^.l);
            writestrentry(list,p^.l);
 
 
          { write name label }
          { write name label }
-         list.concat(cai_align.create(const_align(sizeof(pint))));
+         list.concat(cai_align.create(sizeof(pint)));
          list.concat(Tai_const.Create_sym(p^.nl));
          list.concat(Tai_const.Create_sym(p^.nl));
-         list.concat(cai_align.create(const_align(sizeof(pint))));
+         list.concat(cai_align.create(sizeof(pint)));
          list.concat(Tai_const.Createname(p^.data.mangledname,AT_FUNCTION,0));
          list.concat(Tai_const.Createname(p^.data.mangledname,AT_FUNCTION,0));
 
 
          if assigned(p^.r) then
          if assigned(p^.r) then
@@ -271,11 +271,11 @@ implementation
 
 
          { now start writing of the message string table }
          { now start writing of the message string table }
          current_asmdata.getlabel(result,alt_data);
          current_asmdata.getlabel(result,alt_data);
-         list.concat(cai_align.create(const_align(sizeof(pint))));
+         list.concat(cai_align.create(sizeof(pint)));
          list.concat(Tai_label.Create(result));
          list.concat(Tai_label.Create(result));
-         list.concat(cai_align.create(const_align(sizeof(longint))));
+         list.concat(cai_align.create(sizeof(longint)));
          list.concat(Tai_const.Create_32bit(count));
          list.concat(Tai_const.Create_32bit(count));
-         list.concat(cai_align.create(const_align(sizeof(pint))));
+         list.concat(cai_align.create(sizeof(pint)));
          if assigned(root) then
          if assigned(root) then
            begin
            begin
               writestrentry(list,root);
               writestrentry(list,root);
@@ -290,9 +290,9 @@ implementation
            writeintentry(list,p^.l);
            writeintentry(list,p^.l);
 
 
          { write name label }
          { write name label }
-         list.concat(cai_align.create(const_align(sizeof(longint))));
+         list.concat(cai_align.create(sizeof(longint)));
          list.concat(Tai_const.Create_32bit(p^.data.messageinf.i));
          list.concat(Tai_const.Create_32bit(p^.data.messageinf.i));
-         list.concat(cai_align.create(const_align(sizeof(pint))));
+         list.concat(cai_align.create(sizeof(pint)));
          list.concat(Tai_const.Createname(p^.data.mangledname,AT_FUNCTION,0));
          list.concat(Tai_const.Createname(p^.data.mangledname,AT_FUNCTION,0));
 
 
          if assigned(p^.r) then
          if assigned(p^.r) then
@@ -312,12 +312,12 @@ implementation
 
 
          { now start writing of the message string table }
          { now start writing of the message string table }
          current_asmdata.getlabel(r,alt_data);
          current_asmdata.getlabel(r,alt_data);
-         list.concat(cai_align.create(const_align(sizeof(pint))));
+         list.concat(cai_align.create(sizeof(pint)));
          list.concat(Tai_label.Create(r));
          list.concat(Tai_label.Create(r));
          genintmsgtab:=r;
          genintmsgtab:=r;
-         list.concat(cai_align.create(const_align(sizeof(longint))));
+         list.concat(cai_align.create(sizeof(longint)));
          list.concat(Tai_const.Create_32bit(count));
          list.concat(Tai_const.Create_32bit(count));
-         list.concat(cai_align.create(const_align(sizeof(pint))));
+         list.concat(cai_align.create(sizeof(pint)));
          if assigned(root) then
          if assigned(root) then
            begin
            begin
               writeintentry(list,root);
               writeintentry(list,root);

+ 8 - 0
compiler/optdfa.pas

@@ -517,6 +517,10 @@ unit optdfa;
                   end;
                   end;
               end;
               end;
 
 
+{$ifdef JVM}
+            { all other platforms except jvm translate raise nodes into call nodes during pass_1 }
+            raisen,
+{$endif JVM}
             asn,
             asn,
             inlinen,
             inlinen,
             calln:
             calln:
@@ -918,6 +922,10 @@ unit optdfa;
                   end
                   end
               end;
               end;
             { could be the implicitly generated load node for the result }
             { could be the implicitly generated load node for the result }
+{$ifdef JVM}
+            { all other platforms except jvm translate raise nodes into call nodes during pass_1 }
+            raisen,
+{$endif JVM}
             loadn,
             loadn,
             assignn,
             assignn,
             calln,
             calln,

+ 3 - 6
compiler/pexpr.pas

@@ -3260,12 +3260,9 @@ implementation
                  if try_to_consume(_LKLAMMER) then
                  if try_to_consume(_LKLAMMER) then
                   begin
                   begin
                     p1:=factor(true,false);
                     p1:=factor(true,false);
-                    if token in postfixoperator_tokens then
-                     begin
-                       again:=true;
-                       postfixoperators(p1,again,getaddr);
-                     end
-                    else
+                    { inside parentheses a full expression is allowed, see also tests\webtbs\tb27517.pp }
+                    if token<>_RKLAMMER then
+                      p1:=sub_expr(opcompare,true,false,p1);
                     consume(_RKLAMMER);
                     consume(_RKLAMMER);
                   end
                   end
                  else
                  else

+ 4 - 0
compiler/ppcgen/ngppccnv.pas

@@ -110,6 +110,10 @@ implementation
          if (opsize in [OS_64,OS_S64]) then
          if (opsize in [OS_64,OS_S64]) then
            opsize:=OS_32;
            opsize:=OS_32;
 {$endif not cpu64bitalu}
 {$endif not cpu64bitalu}
+
+        if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+
          case left.location.loc of
          case left.location.loc of
             LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER :
             LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER :
               begin
               begin

+ 1 - 1
compiler/ppcgen/ngppcinl.pas

@@ -227,7 +227,7 @@ implementation
                  end;
                  end;
              end;
              end;
            else
            else
-             internalerror(200402021);
+             { nothing to prefetch };
          end;
          end;
        end;
        end;
 
 

+ 6 - 1
compiler/psub.pas

@@ -1293,7 +1293,12 @@ implementation
         { there's always a call to FPC_INITIALIZEUNITS/FPC_DO_EXIT in the main program }
         { there's always a call to FPC_INITIALIZEUNITS/FPC_DO_EXIT in the main program }
         if (procdef.localst.symtablelevel=main_program_level) and
         if (procdef.localst.symtablelevel=main_program_level) and
            (not current_module.is_unit) then
            (not current_module.is_unit) then
-          include(flags,pi_do_call);
+          begin
+            include(flags,pi_do_call);
+            { the main program never returns due to the do_exit call }
+            if not(DLLsource) then
+              include(procdef.procoptions,po_noreturn);
+          end;
 
 
         { set implicit_finally flag when there are locals/paras to be finalized }
         { set implicit_finally flag when there are locals/paras to be finalized }
         procdef.parast.SymList.ForEachCall(@check_finalize_paras,nil);
         procdef.parast.SymList.ForEachCall(@check_finalize_paras,nil);

+ 4 - 0
compiler/sparc/ncpucnv.pas

@@ -264,6 +264,10 @@ implementation
 
 
         location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
         location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
         opsize:=def_cgsize(left.resultdef);
         opsize:=def_cgsize(left.resultdef);
+
+        if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+
         case left.location.loc of
         case left.location.loc of
           LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER:
           LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER:
             begin
             begin

+ 1 - 1
compiler/symdef.pas

@@ -6312,7 +6312,7 @@ implementation
          inherited derefimpl;
          inherited derefimpl;
          { the procdefs are not owned by the class helper procsyms, so they
          { the procdefs are not owned by the class helper procsyms, so they
            are not stored/restored either -> re-add them here }
            are not stored/restored either -> re-add them here }
-         if (objecttype=odt_objcclass) or
+         if (objecttype in [odt_objcclass,odt_objcprotocol]) or
             (oo_is_classhelper in objectoptions) then
             (oo_is_classhelper in objectoptions) then
            symtable.DefList.ForEachCall(@create_class_helper_for_procdef,nil);
            symtable.DefList.ForEachCall(@create_class_helper_for_procdef,nil);
       end;
       end;

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

@@ -3121,8 +3121,7 @@ begin
 
 
              writeln([space,' Abstract methods : ',getlongint]);
              writeln([space,' Abstract methods : ',getlongint]);
 
 
-             if (tobjecttyp(b)=odt_helper) or
-                 (oo_is_classhelper in current_objectoptions) then
+             if tobjecttyp(b)=odt_helper then
                begin
                begin
                  write([space,'    Helper parent : ']);
                  write([space,'    Helper parent : ']);
                  readderef('',objdef.HelperParent);
                  readderef('',objdef.HelperParent);

+ 2 - 1
compiler/x86/cpubase.pas

@@ -116,9 +116,10 @@ uses
       RS_ST5        = $05;
       RS_ST5        = $05;
       RS_ST6        = $06;
       RS_ST6        = $06;
       RS_ST7        = $07;
       RS_ST7        = $07;
+      RS_ST         = $08;
 
 
       { Number of first imaginary register }
       { Number of first imaginary register }
-      first_fpu_imreg     = $08;
+      first_fpu_imreg     = $09;
 
 
       { MM Super registers }
       { MM Super registers }
       RS_XMM0        = $00;
       RS_XMM0        = $00;

+ 1 - 1
compiler/x86/nx86inl.pas

@@ -595,7 +595,7 @@ implementation
                    current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_PREFETCHNTA,S_NO,ref));
                    current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_PREFETCHNTA,S_NO,ref));
                  end;
                  end;
                else
                else
-                 internalerror(200402021);
+                 { nothing to prefetch };
              end;
              end;
            end;
            end;
        end;
        end;

+ 2 - 2
rtl/inc/cgenstr.inc

@@ -108,7 +108,7 @@
 
 
 {$ifndef FPC_UNIT_HAS_STRLCOMP}
 {$ifndef FPC_UNIT_HAS_STRLCOMP}
 {$define FPC_UNIT_HAS_STRLCOMP}
 {$define FPC_UNIT_HAS_STRLCOMP}
- function libc_strncmp(const str1,str2: pchar; l: Cardinal): longint; cdecl; external 'c' name 'strncmp';
+ function libc_strncmp(const str1,str2: pchar; l: sizeint): longint; cdecl; external 'c' name 'strncmp';
 
 
  function StrLComp(Str1, Str2 : PChar; L: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  function StrLComp(Str1, Str2 : PChar; L: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
    Begin
    Begin
@@ -119,7 +119,7 @@
 
 
 {$ifndef FPC_UNIT_HAS_STRLICOMP}
 {$ifndef FPC_UNIT_HAS_STRLICOMP}
 {$define FPC_UNIT_HAS_STRLICOMP}
 {$define FPC_UNIT_HAS_STRLICOMP}
- function libc_strncasecmp(const str1,str2: pchar; l: Cardinal): longint; cdecl; external 'c' name 'strncasecmp';
+ function libc_strncasecmp(const str1,str2: pchar; l: sizeint): longint; cdecl; external 'c' name 'strncasecmp';
 
 
  function StrLIComp(Str1, Str2 : PChar; L: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  function StrLIComp(Str1, Str2 : PChar; L: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
    Begin
    Begin

+ 13 - 0
tests/test/tobjc42.pp

@@ -0,0 +1,13 @@
+{ %target=darwin }
+{ %recompile }
+{ %norun }
+
+{$modeswitch objectivec2}
+
+uses uobjc42;
+
+var
+  i: id;
+begin
+  i.mytest;
+end.

+ 12 - 0
tests/test/uobjc42.pp

@@ -0,0 +1,12 @@
+{$modeswitch objectivec2}
+unit uobjc42;
+
+interface
+type
+  tinf = objcprotocol
+    procedure mytest; message 'mytest';
+  end;
+
+implementation
+
+end.

+ 7 - 2
tests/utils/dotest.pp

@@ -380,8 +380,13 @@ begin
       Err := IOResult;
       Err := IOResult;
       if Err <> 0 then
       if Err <> 0 then
        begin
        begin
-        Str (Err, SErr);
-        Verbose (V_Error, 'Directory creation failed ' + SErr);
+        { did another parallel instance create it in the mean time? }
+        if not PathExists(hs) then
+          begin
+            { no -> error }
+            Str (Err, SErr);
+            Verbose (V_Error, 'Directory creation of "'+HS+'" failed ' + SErr);
+          end;
        end;
        end;
     end;
     end;
 end;
 end;

+ 15 - 0
tests/webtbs/tw14347.pp

@@ -0,0 +1,15 @@
+{ %OPT=-Sew -Oodfa }
+program Project1;
+
+{$mode objfpc}{$H+}
+
+type
+  TRec = record a : Integer; end;
+  PRec = ^TRec;
+
+var
+  p : PRec;
+
+begin
+  writeln( sizeof(p^.a)); // warning here!
+end.

+ 94 - 0
tests/webtbs/tw24796.pp

@@ -0,0 +1,94 @@
+{$apptype console}
+{$mode objfpc}
+{$inline on}
+
+{$define debug_inline}
+
+var
+    fault_mask: integer = 0;
+
+/////////////////////////////////////////
+
+function dummy1( x: integer; var y: integer ): boolean; {$ifdef debug_inline}inline;{$endif}
+begin
+    y := x + 1;
+    result := ( y = x + 1 );
+end;
+
+function dummy2( x: integer; out y: integer ): boolean; {$ifdef debug_inline}inline;{$endif}
+begin
+    y := x + 1;
+    result := ( y = x + 1 );
+end;
+
+procedure test1;
+var
+    y: integer;
+begin
+
+    y := 0;
+
+    if not dummy1( y, y ) then
+    begin
+        writeln( 'fail 1' );
+        fault_mask := fault_mask or 1;
+    end;
+
+    if not dummy2( y, y ) then
+    begin
+        writeln( 'fail 2' );
+        fault_mask := fault_mask or 2;
+    end;
+
+end;
+
+/////////////////////////////////////////
+
+type
+    bits64 = qword;
+
+procedure add128( a0, a1, b0, b1 : bits64; var z0Ptr, z1Ptr : bits64); {$ifdef debug_inline}inline;{$endif}
+// routine from the SOFTFPU unit
+var
+    z1 : bits64;
+begin
+    z1 := a1 + b1;
+    z1Ptr := z1; // overrites "a1" when called as below and inlined
+    z0Ptr := a0 + b0 + ord( z1 < a1 ); // z1 compared with wrong value
+end;
+
+const
+    correct_zSig0 = bits64($0001A784379D99DB);
+    correct_zSig1 = bits64($4200000000000000);
+
+procedure test2;
+var
+    zSig0, zSig1, aSig0, aSig1: bits64;
+begin
+
+    zSig0 := bits64($000054B40B1F852B);
+    zSig1 := bits64($DA00000000000000);
+    aSig0 := bits64($000152D02C7E14AF);
+    aSig1 := bits64($6800000000000000);
+
+    // this usage pattern from routine SOFTFPU::float128_mul
+    add128( zSig0, zSig1, aSig0, aSig1, zSig0, zSig1 );
+
+    if zSig0 <> correct_zSig0 then
+    begin
+        writeln( 'fail 3' ); // fail if add128 is inlined
+        fault_mask := fault_mask or 4;
+    end;
+
+end;
+
+/////////////////////////////////////////
+
+begin
+    test1;
+    test2;
+    if fault_mask = 0 then
+        writeln( 'pass' )
+    else
+        halt( fault_mask );
+end.

+ 26 - 0
tests/webtbs/tw26534a.pp

@@ -0,0 +1,26 @@
+{ %norun }
+{ %opt=-O2 }
+{Opt.level: -O2}
+{$inline on}
+unit tw26534a;
+interface
+
+implementation
+
+procedure redirect( p: pointer );
+begin
+end;
+
+procedure inlined( var R: byte ); inline;
+begin
+  redirect(@R);
+end;
+
+procedure comp_failed;
+var
+  a: byte;
+begin
+  inlined(a); // ie2006111510
+end;
+
+end.

+ 19 - 0
tests/webtbs/tw26534b.pp

@@ -0,0 +1,19 @@
+{ %opt=-O2 }
+// Opt.level: -O2
+{$inline on}
+program test2;
+
+procedure redirect( p: pointer );
+begin
+end;
+
+procedure inlined( var R: byte ); inline;
+begin
+  redirect(@R);
+end;
+
+var
+  a: byte;
+begin
+  inlined(a); // ie2006111510
+end.

+ 25 - 0
tests/webtbs/tw27256.pp

@@ -0,0 +1,25 @@
+program Test;
+
+type
+  FullType = (Unknown,Stiletto,Vanguard);
+  SubType = Stiletto..Vanguard;
+
+const
+  full_choices: array[FullType] of String = ('U','S','V');
+  sub_choices: array[SubType] of String = ('S', 'V');
+
+var
+  x : longint;
+
+procedure abc(choices: array of String);
+begin
+  inc(x,high(choices));
+end;
+
+begin
+  abc(full_choices);
+  abc(sub_choices);
+  if x<>3 then
+    halt(1);
+  writeln('ok');
+end.

+ 11 - 0
tests/webtbs/tw27517.pp

@@ -0,0 +1,11 @@
+program Project1;
+
+{$mode objfpc}{$H+}
+
+var
+  pTyped: PInteger;
+  p: Pointer;
+begin
+  p := nil;
+  pTyped := @(PByte(p)+1)^; //project1.lpr(21,23) Fatal: Syntax error, ")" expected but "+" found
+end.

+ 6 - 0
tests/webtbs/tw27691.pp

@@ -0,0 +1,6 @@
+{ %opt=-Seh -vh }
+
+{$modeswitch unicodestrings}
+
+begin
+end.

+ 13 - 0
tests/webtbs/tw27811.pp

@@ -0,0 +1,13 @@
+{ %norun }
+
+{$optimization regvar on}
+procedure test;
+var m,n: integer;
+begin
+  for m := 100 downto 0 do begin
+    prefetch (m);
+  end;
+end;
+
+begin
+end.

+ 29 - 0
tests/webtbs/tw28007.pp

@@ -0,0 +1,29 @@
+program error_record;
+
+type
+
+  TPackedBool = bitpacked record
+    b0: Boolean;
+    b1: Boolean;
+    b2: Boolean;
+    b3: Boolean;
+    b4: Boolean;
+    b5: Boolean;
+    b6: Boolean;
+    b7: Boolean;
+  end;
+
+var
+  B: ByteBool;
+  PackedBool: TPackedBool;
+
+begin
+(*
+    - OK on x86, x86_64 compiler
+    - ERROR on cross arm compiler
+    - OK on cross arm compiler if we do typecast:
+        B := ByteBool(PackedBool.b0);
+                                                    *)
+
+  B := PackedBool.b0;
+end.