* synchronized with trunk

git-svn-id: branches/unicodekvm@48847 -

.gitattributes

@@ -14541,6 +14541,7 @@ tests/test/talign1.pp svneol=native#text/plain
 tests/test/talign2.pp svneol=native#text/plain
 tests/test/taligned1.pp svneol=native#text/pascal
 tests/test/tand1.pp svneol=native#text/plain
+tests/test/tandorandnot1.pp svneol=native#text/pascal
 tests/test/targ1a.pp svneol=native#text/plain
 tests/test/targ1b.pp svneol=native#text/plain
 tests/test/tarray1.pp svneol=native#text/plain
@@ -16791,6 +16792,8 @@ tests/webtbf/tw38287.pp svneol=native#text/pascal
 tests/webtbf/tw38289a.pp svneol=native#text/pascal
 tests/webtbf/tw38289b.pp svneol=native#text/pascal
 tests/webtbf/tw38439.pp svneol=native#text/pascal
+tests/webtbf/tw38504.pp svneol=native#text/pascal
+tests/webtbf/tw38504b.pp svneol=native#text/pascal
 tests/webtbf/tw3930a.pp svneol=native#text/plain
 tests/webtbf/tw3931b.pp svneol=native#text/plain
 tests/webtbf/tw3969.pp svneol=native#text/plain
@@ -18591,6 +18594,7 @@ tests/webtbs/tw36196.pp svneol=native#text/pascal
 tests/webtbs/tw3621.pp svneol=native#text/plain
 tests/webtbs/tw36212.pp svneol=native#text/pascal
 tests/webtbs/tw36215.pp svneol=native#text/pascal
+tests/webtbs/tw36250.pp svneol=native#text/plain
 tests/webtbs/tw3628.pp svneol=native#text/plain
 tests/webtbs/tw3634.pp svneol=native#text/plain
 tests/webtbs/tw36381.pp svneol=native#text/plain
@@ -18739,6 +18743,8 @@ tests/webtbs/tw3841.pp svneol=native#text/plain
 tests/webtbs/tw38412.pp svneol=native#text/pascal
 tests/webtbs/tw38413.pp svneol=native#text/pascal
 tests/webtbs/tw38429.pp svneol=native#text/pascal
+tests/webtbs/tw38497.pp svneol=native#text/pascal
+tests/webtbs/tw38527.pp svneol=native#text/plain
 tests/webtbs/tw3863.pp svneol=native#text/plain
 tests/webtbs/tw3864.pp svneol=native#text/plain
 tests/webtbs/tw3865.pp svneol=native#text/plain

compiler/Makefile

@@ -5052,7 +5052,9 @@ endif
 cycledep:
 	$(MAKE) cycle USEDEPEND=1
 extcycle:
-	$(MAKE) cycle OPT="$(OPT) -n -OG2p3 -glttt -CRriot -dEXTDEBUG" ALLOW_WARNINGS=1
+	$(MAKE) cycle OPT="$(OPT) -n -glttt -CRriot -dEXTDEBUG" ALLOW_WARNINGS=1
+extoptcycle:
+	$(MAKE) cycle OPT="$(OPT) -n -glttt -CRriot -dEXTDEBUG -dDEBUG_ALL_OPT" ALLOW_WARNINGS=1
 cvstest:
 	$(MAKE) cycle 'LOCALOPT=-n -Se' 'RTLOPT=-n -Se'
 ifeq ($(findstring -dFPC_SOFT_FPUX80,$(LOCALOPT)),)

compiler/Makefile.fpc

@@ -1024,7 +1024,10 @@ cycledep:
 # extcycle should still work, but generates
 # lots of warnings, so ALLOW_WARNINGS=1 is required
 extcycle:
-        $(MAKE) cycle OPT="$(OPT) -n -OG2p3 -glttt -CRriot -dEXTDEBUG" ALLOW_WARNINGS=1
+        $(MAKE) cycle RTLOPT="$(RTLOPT) -n -glttt -CRriot -dEXTDEBUG" LOCALOPT="$(LOCALOPT) -n -glttt -CRriot -dEXTDEBUG" ALLOW_WARNINGS=1
+
+extoptcycle:
+        $(MAKE) cycle RTLOPT="$(RTLOPT) -n -glttt -CRriot -dEXTDEBUG -dDEBUG_ALL_OPT" LOCALOPT="$(LOCALOPT) -n -glttt -CRriot -dEXTDEBUG -dDEBUG_ALL_OPT" ALLOW_WARNINGS=1
 
 cvstest:
         $(MAKE) cycle 'LOCALOPT=-n -Se' 'RTLOPT=-n -Se'

compiler/aarch64/racpugas.pas

@@ -556,6 +556,10 @@ Unit racpugas;
 
 
     function taarch64attreader.ToConditionCode(const hs: string; is_operand: boolean): tasmcond;
+{$push}{$j-}
+      const
+        extracond2str: array[C_HS..C_LO] of string[2] = ('CS','CC');
+{$pop}
       begin
         case actopcode of
           A_CSEL,A_CSINC,A_CSINV,A_CSNEG,A_CSET,A_CSETM,
@@ -568,11 +572,16 @@ Unit racpugas;
                 begin
                   { workaround for DFA bug }
                   result:=low(tasmcond);
-                  for result:=low(tasmcond) to high(tasmcond) do
+                  for result:=low(uppercond2str) to high(uppercond2str) do
                     begin
                       if hs=uppercond2str[result] then
                         exit;
                     end;
+                  for result:=low(extracond2str) to high(extracond2str) do
+                    begin
+                      if hs=extracond2str[result] then
+                        exit;
+                    end;
                 end;
             end;
           else

compiler/aasmcnst.pas

@@ -1584,7 +1584,9 @@ implementation
 
    class function ttai_typedconstbuilder.is_smartlink_vectorized_dead_strip: boolean;
      begin
-       result:=tf_smartlink_sections in target_info.flags;
+       result:=(tf_smartlink_sections in target_info.flags) and
+               (not(target_info.system in systems_darwin) or
+                (tf_supports_symbolorderfile in target_info.flags));
      end;
 
 

compiler/cgexcept.pas

@@ -129,12 +129,13 @@ unit cgexcept;
        be modified, all temps should be allocated on the heap instead of the
        stack. }
 
-
     class procedure tcgexceptionstatehandler.get_exception_temps(list:TAsmList;var t:texceptiontemps);
-     begin
+      begin
+        if not assigned(exceptionreasontype) then
+          exceptionreasontype:=search_system_proc('fpc_setjmp').returndef;
         tg.gethltemp(list,rec_exceptaddr,rec_exceptaddr.size,tt_persistent,t.envbuf);
         tg.gethltemp(list,rec_jmp_buf,rec_jmp_buf.size,tt_persistent,t.jmpbuf);
-        tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
+        tg.gethltemp(list,exceptionreasontype,exceptionreasontype.size,tt_persistent,t.reasonbuf);
       end;
 
 
@@ -207,7 +208,7 @@ unit cgexcept;
         location_reset(tmpresloc,LOC_REGISTER,def_cgsize(setjmpres.def));
         tmpresloc.register:=hlcg.getintregister(list,setjmpres.def);
         hlcg.gen_load_cgpara_loc(list,setjmpres.def,setjmpres,tmpresloc,true);
-        hlcg.g_exception_reason_save(list,setjmpres.def,ossinttype,tmpresloc.register,t.reasonbuf);
+        hlcg.g_exception_reason_save(list,setjmpres.def,exceptionreasontype,tmpresloc.register,t.reasonbuf);
         { if we get 1 here in the function result register, it means that we
           longjmp'd back here }
         hlcg.a_cmp_const_reg_label(list,setjmpres.def,OC_NE,0,tmpresloc.register,exceptstate.exceptionlabel);
@@ -237,9 +238,9 @@ unit cgexcept;
          popaddrstack(list);
          if not onlyfree then
           begin
-            reasonreg:=hlcg.getintregister(list,osuinttype);
-            hlcg.g_exception_reason_load(list,osuinttype,osuinttype,t.reasonbuf,reasonreg);
-            hlcg.a_cmp_const_reg_label(list,osuinttype,OC_EQ,a,reasonreg,endexceptlabel);
+            reasonreg:=hlcg.getintregister(list,exceptionreasontype);
+            hlcg.g_exception_reason_load(list,exceptionreasontype,exceptionreasontype,t.reasonbuf,reasonreg);
+            hlcg.a_cmp_const_reg_label(list,exceptionreasontype,OC_EQ,a,reasonreg,endexceptlabel);
           end;
       end;
 

compiler/cutils.pas

@@ -1298,9 +1298,10 @@ implementation
           { if one of the two is at the end while the other isn't, add a '.0' }
           if (i1>length(s1)) and
              (i2<=length(s2)) then
-            s1:=s1+'.0'
-          else if i2>length(s2) then
-            s2:=s2+'.0';
+            s1:=s1+'.0';
+          if (i2>length(s2)) and
+             (i1<=length(s1)) then
+             s2:=s2+'.0';
           { compare non-numerical characters normally }
           while (i1<=length(s1)) and
                 not(s1[i1] in ['0'..'9']) and

compiler/dbgdwarf.pas

@@ -4521,6 +4521,12 @@ implementation
 
       begin
         case def.objecttype of
+          odt_objcclass,
+          odt_objcprotocol:
+            begin
+              inherited;
+              exit
+            end;
           odt_cppclass,
           odt_object:
             begin

compiler/defutil.pas

@@ -149,6 +149,9 @@ interface
     {# Returns true, if p points to an array of const }
     function is_array_of_const(p : tdef) : boolean;
 
+    {# Returns true if p is an arraydef that describes a constant string }
+    function is_conststring_array(p : tdef) : boolean;
+
     {# Returns true, if p points any kind of special array
 
        That is if the array is an open array, a variant
@@ -796,8 +799,7 @@ implementation
            range is also -1 ! (PFV) }
          result:=(p.typ=arraydef) and
                  (tarraydef(p).rangedef=sizesinttype) and
-                 (tarraydef(p).lowrange=0) and
-                 (tarraydef(p).highrange=-1) and
+                 (ado_OpenArray in tarraydef(p).arrayoptions) and
                  ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])=[]);
       end;
 
@@ -822,6 +824,12 @@ implementation
                  (ado_IsArrayOfConst in tarraydef(p).arrayoptions);
       end;
 
+    function is_conststring_array(p: tdef): boolean;
+      begin
+        result:=(p.typ=arraydef) and
+                (ado_IsConstString in tarraydef(p).arrayoptions);
+      end;
+
     { true, if p points to a special array, bitpacked arrays aren't special in this regard though }
     function is_special_array(p : tdef) : boolean;
       begin

compiler/i386/n386add.pas

@@ -486,13 +486,13 @@ interface
         begin
           cg.getcpuregister(current_asmdata.CurrAsmList,NR_EDX);
           hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,right.resultdef,osuinttype,right.location,NR_EDX);
-          cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EDX);
           reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
           reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
           if use_ref then
             current_asmdata.CurrAsmList.concat(Taicpu.Op_ref_reg_reg(A_MULX,S_L,ref,reglo,reghi))
           else
             emit_reg_reg_reg(A_MULX,S_L,reg,reglo,reghi);
+          cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EDX);
 
           location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
           location.register64.reglo:=reglo;

compiler/jvm/hlcgcpu.pas

@@ -2292,6 +2292,10 @@ implementation
       { a constructor doesn't actually return a value in the jvm }
       if (tabstractprocdef(pd).proctypeoption=potype_constructor) then
         totalremovesize:=paraheight
+      else if jvmimplicitpointertype(realresdef) then
+        totalremovesize:=paraheight-1
+      else if is_void(realresdef) then
+        totalremovesize:=paraheight
       else
         { even a byte takes up a full stackslot -> align size to multiple of 4 }
         totalremovesize:=paraheight-(align(realresdef.size,4) shr 2);

compiler/jvm/jvmdef.pas

@@ -517,7 +517,8 @@ implementation
             result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
                 is_open_array(def) or
                 is_array_of_const(def) or
-                is_array_constructor(def);
+                is_array_constructor(def) or
+                is_conststring_array(def);
           filedef,
           recorddef,
           setdef:

compiler/llvm/llvmpi.pas

@@ -88,6 +88,8 @@ implementation
 
       class procedure tllvmexceptionstatehandler.get_exception_temps(list: TAsmList; var t: texceptiontemps);
         begin
+          if not assigned(exceptionreasontype) then
+            exceptionreasontype:=ossinttype;
           tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
         end;
 

compiler/m68k/n68kmem.pas

@@ -35,7 +35,6 @@ interface
        t68kvecnode = class(tcgvecnode)
           procedure update_reference_reg_mul(maybe_const_reg: tregister; regsize: tdef; l: aint); override;
           procedure update_reference_reg_packed(maybe_const_reg: tregister; regsize: tdef; l:aint); override;
-          function valid_index_size(size: tcgsize): boolean; override;
           //procedure pass_generate_code;override;
        end;
 
@@ -55,14 +54,6 @@ implementation
                              T68KVECNODE
 *****************************************************************************}
 
-     function t68kvecnode.valid_index_size(size: tcgsize): boolean;
-       begin
-         if (CPUM68K_HAS_INDEXWORD in cpu_capabilities[current_settings.cputype]) then
-           result:=tcgsize2signed[size] in [OS_S16,OS_S32]
-         else
-           result:=inherited;
-       end;
-
     { this routine must, like any other routine, not change the contents }
     { of base/index registers of references, as these may be regvars.    }
     { The register allocator can coalesce one LOC_REGISTER being moved   }

compiler/nadd.pas

@@ -489,6 +489,20 @@ implementation
         end;
 
 
+      function IsAndOrAndNot(n1,n2,n3,n4 : tnode): Boolean;
+        begin
+          result:=(n4.nodetype=notn) and
+            tnotnode(n4).left.isequal(n2);
+        end;
+
+
+      function TransformAndOrAndNot(n1,n2,n3,n4 : tnode): tnode;
+        begin
+          result:=caddnode.create_internal(xorn,n3.getcopy,
+            caddnode.create_internal(andn,caddnode.create_internal(xorn,n3.getcopy,n1.getcopy),n2.getcopy));
+        end;
+
+
       function SwapRightWithLeftRight : tnode;
         var
           hp : tnode;
@@ -1689,6 +1703,28 @@ implementation
                    end;
               end;
 {$endif cpurox}
+            { optimize
+
+                (a and b) or (c and not(b))
+
+                into
+
+                c xor ((c xor a) and b)
+            }
+            if (nodetype=orn) and
+             (left.resultdef.typ=orddef) and
+             (left.nodetype=andn) and
+             (right.nodetype=andn) and
+             { this test is not needed but it speeds up the test and allows to bail out early }
+             ((taddnode(left).left.nodetype=notn) or (taddnode(left).right.nodetype=notn) or
+              (taddnode(right).left.nodetype=notn) or (taddnode(right).right.nodetype=notn)
+             ) and
+             not(might_have_sideeffects(self)) then
+             begin
+               if MatchAndTransformNodesCommutative(taddnode(left).left,taddnode(left).right,taddnode(right).left,taddnode(right).right,
+                 @IsAndOrAndNot,@TransformAndOrAndNot,Result) then
+                 exit;
+             end;
           end;
       end;
 
@@ -1939,7 +1975,11 @@ implementation
               not(tfloatdef(left.resultdef).floattype in [s64comp,s64currency]) then
              begin
                if cs_excessprecision in current_settings.localswitches then
-                 resultrealdef:=pbestrealtype^
+                 begin
+                   resultrealdef:=pbestrealtype^;
+                   inserttypeconv(right,resultrealdef);
+                   inserttypeconv(left,resultrealdef);
+                 end
                else
                  resultrealdef:=left.resultdef
              end

compiler/ncgflw.pas

@@ -542,7 +542,7 @@ implementation
           { we must also destroy the address frame which guards
             the exception object }
           cexceptionstatehandler.popaddrstack(list);
-          hlcg.g_exception_reason_discard(list,osuinttype,excepttemps.reasonbuf);
+          hlcg.g_exception_reason_discard(list,exceptionreasontype,excepttemps.reasonbuf);
           if frametype=ft_except then
             begin
               cexceptionstatehandler.cleanupobjectstack(list);
@@ -875,8 +875,8 @@ implementation
     procedure tcgtryfinallynode.emit_jump_out_of_try_finally_frame(list: TasmList; const reason: byte; const finallycodelabel: tasmlabel; var excepttemps: tcgexceptionstatehandler.texceptiontemps; framelabel: tasmlabel);
       begin
          hlcg.a_label(list,framelabel);
-         hlcg.g_exception_reason_discard(list,osuinttype,excepttemps.reasonbuf);
-         hlcg.g_exception_reason_save_const(list,osuinttype,reason,excepttemps.reasonbuf);
+         hlcg.g_exception_reason_discard(list,exceptionreasontype,excepttemps.reasonbuf);
+         hlcg.g_exception_reason_save_const(list,exceptionreasontype,reason,excepttemps.reasonbuf);
          hlcg.a_jmp_always(list,finallycodelabel);
       end;
 
@@ -936,13 +936,13 @@ implementation
         procedure handle_breakcontinueexit(const finallycode: tasmlabel; doreraise: boolean);
           begin
             { no exception happened, but maybe break/continue/exit }
-            hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
+            hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,exceptionreasontype,OC_EQ,0,reasonreg,endfinallylabel);
             if fc_exit in finallyexceptionstate.newflowcontrol then
-              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,2,reasonreg,oldCurrExitLabel);
+              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,exceptionreasontype,OC_EQ,2,reasonreg,oldCurrExitLabel);
             if fc_break in finallyexceptionstate.newflowcontrol then
-              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,3,reasonreg,oldBreakLabel);
+              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,exceptionreasontype,OC_EQ,3,reasonreg,oldBreakLabel);
             if fc_continue in finallyexceptionstate.newflowcontrol then
-              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,4,reasonreg,oldContinueLabel);
+              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,exceptionreasontype,OC_EQ,4,reasonreg,oldContinueLabel);
             if doreraise then
               cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,tek_normalfinally)
             else
@@ -1019,8 +1019,8 @@ implementation
                exit;
              if not implicitframe then
                current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
-             reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,osuinttype);
-             hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,osuinttype,osuinttype,excepttemps.reasonbuf,reasonreg);
+             reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,exceptionreasontype);
+             hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,exceptionreasontype,exceptionreasontype,excepttemps.reasonbuf,reasonreg);
              handle_breakcontinueexit(finallyNoExceptionLabel,false);
 
              current_asmdata.CurrAsmList.concatList(tmplist);
@@ -1058,11 +1058,11 @@ implementation
          if not assigned(third) then
            begin
              { the value should now be in the exception handler }
-             reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,osuinttype);
-             hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,osuinttype,osuinttype,excepttemps.reasonbuf,reasonreg);
+             reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,exceptionreasontype);
+             hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,exceptionreasontype,exceptionreasontype,excepttemps.reasonbuf,reasonreg);
              if implicitframe then
                begin
-                 hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
+                 hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,exceptionreasontype,OC_EQ,0,reasonreg,endfinallylabel);
                  { finally code only needed to be executed on exception (-> in
                    if-branch -> fc_inflowcontrol) }
                  if current_procinfo.procdef.generate_safecall_wrapper then

compiler/ncginl.pas

@@ -888,7 +888,8 @@ implementation
             internalerror(2013120110);
         end;
 
-        hlcg.location_force_reg(current_asmdata.CurrAsmList,op1.location,op1.resultdef,resultdef,true);
+        if not(op1.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,op1.location,op1.resultdef,resultdef,true);
 
         location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
 {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
@@ -920,8 +921,10 @@ implementation
 {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                  if def_cgsize(resultdef) in [OS_64,OS_S64] then
                    begin
-                     hlcg.location_force_reg(current_asmdata.CurrAsmList,op2.location,
-                                             op2.resultdef,alusinttype,true);
+                     if not(op2.location.loc in [LOC_REGISTER,LOC_CREGISTER]) or
+                       not(equal_defs(op2.resultdef,alusinttype)) then
+                       hlcg.location_force_reg(current_asmdata.CurrAsmList,op2.location,
+                                               op2.resultdef,alusinttype,true);
                      cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,op,def_cgsize(resultdef),
                                              joinreg64(op2.location.register,NR_NO),op1.location.register64,
                                              location.register64);
@@ -929,8 +932,9 @@ implementation
                  else
 {$endif not cpu64bitalu and not cpuhighleveltarget}
                    begin
-                     hlcg.location_force_reg(current_asmdata.CurrAsmList,op2.location,
-                                             op2.resultdef,resultdef,true);
+                     if not(op2.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                       hlcg.location_force_reg(current_asmdata.CurrAsmList,op2.location,
+                                               op2.resultdef,resultdef,true);
                      hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,op,resultdef,
                                            op2.location.register,op1.location.register,
                                            location.register);

compiler/ncon.pas

@@ -948,20 +948,15 @@ implementation
          dogetcopy:=n;
       end;
 
+
     function tstringconstnode.pass_typecheck:tnode;
-      var
-        l : aint;
       begin
         result:=nil;
         case cst_type of
           cst_conststring :
             begin
               { handle and store as array[0..len-1] of char }
-              if len>0 then
-                l:=len-1
-              else
-                l:=0;
-              resultdef:=carraydef.create(0,l,s32inttype);
+              resultdef:=carraydef.create(0,len-1,s32inttype);
               tarraydef(resultdef).elementdef:=cansichartype;
               include(tarraydef(resultdef).arrayoptions,ado_IsConstString);
             end;
@@ -981,6 +976,7 @@ implementation
         end;
       end;
 
+
     function tstringconstnode.pass_1 : tnode;
       begin
         result:=nil;

compiler/ngtcon.pas

@@ -328,6 +328,25 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
 {$push}
 {$r-}
 {$q-}
+    { to work around broken x86 shifting, while generating bitmask }
+    function getbitmask(len: byte): aword;
+      begin
+        if len >= (sizeof(result) * 8) then
+          result:=0
+        else
+          result:=aword(1) shl len;
+        result:=aword(result-1);
+      end;
+
+    { shift left, and always pad the right bits with zeroes }
+    function shiftleft(value: aword; count: byte): aword;
+      begin
+        if count >= (sizeof(result) * 8) then
+          result:=0
+        else
+          result:=(value shl count) and (not getbitmask(count));
+      end;
+
     { (values between quotes below refer to fields of bp; fields not         }
     {  mentioned are unused by this routine)                                 }
     { bitpacks "value" as bitpacked value of bitsize "packedbitsize" into    }
@@ -342,16 +361,15 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         if (target_info.endian=endian_big) then
           begin
             { bitpacked format: left-aligned (i.e., "big endian bitness") }
-            { work around broken x86 shifting }
-            if (AIntBits<>bp.packedbitsize) and
+            if (bp.packedbitsize<AIntBits) and
                (bp.curbitoffset<AIntBits) then
-              bp.curval:=bp.curval or ((value shl (AIntBits-bp.packedbitsize)) shr bp.curbitoffset);
+              bp.curval:=bp.curval or (shiftleft(value,AIntBits-bp.packedbitsize) shr bp.curbitoffset);
             shiftcount:=((AIntBits-bp.packedbitsize)-bp.curbitoffset);
             { carry-over to the next element? }
             if (shiftcount<0) then
               begin
                 if shiftcount>=-AIntBits then
-                  bp.nextval:=(value and ((aword(1) shl (-shiftcount))-1)) shl
+                  bp.nextval:=(value and getbitmask(-shiftcount)) shl
                               (AIntBits+shiftcount)
                 else
                   bp.nextval:=0;

compiler/nmat.pas

@@ -97,7 +97,7 @@ implementation
       systems,
       verbose,globals,cutils,compinnr,
       globtype,constexp,
-      symconst,symtype,symdef,
+      symconst,symtype,symdef,symcpu,
       defcmp,defutil,
       htypechk,pass_1,
       cgbase,
@@ -966,10 +966,18 @@ implementation
            exit;
 
          resultdef:=left.resultdef;
-         if (left.resultdef.typ=floatdef) or
-            is_currency(left.resultdef) then
+         if is_currency(left.resultdef) then
            begin
            end
+         else if left.resultdef.typ=floatdef then
+           begin
+             if not(tfloatdef(left.resultdef).floattype in [s64comp,s64currency]) and
+               (cs_excessprecision in current_settings.localswitches) then
+               begin
+                 inserttypeconv(left,pbestrealtype^);
+                 resultdef:=left.resultdef
+               end;
+           end
 {$ifdef SUPPORT_MMX}
          else if (cs_mmx in current_settings.localswitches) and
            is_mmx_able_array(left.resultdef) then

compiler/nset.pas

@@ -247,6 +247,7 @@ implementation
 
       begin
          result:=nil;
+
          resultdef:=pasbool1type;
          typecheckpass(right);
          set_varstate(right,vs_read,[vsf_must_be_valid]);
@@ -269,6 +270,13 @@ implementation
          if not assigned(left.resultdef) then
            internalerror(20021126);
 
+         { avoid any problems with type parameters later on }
+         if is_typeparam(left.resultdef) or is_typeparam(right.resultdef) then
+           begin
+             resultdef:=cundefinedtype;
+             exit;
+           end;
+
          t:=self;
          if isbinaryoverloaded(t,[]) then
            begin

compiler/nutils.pas

@@ -186,11 +186,22 @@ interface
     type
       TMatchProc2 = function(n1,n2 : tnode) : Boolean is nested;
       TTransformProc2 = function(n1,n2 : tnode) : tnode is nested;
+      TMatchProc4 = function(n1,n2,n3,n4 : tnode) : Boolean is nested;
+      TTransformProc4 = function(n1,n2,n3,n4 : tnode) : tnode is nested;
 
     { calls matchproc with n1 and n2 as parameters, if it returns true, transformproc is called, does the same with the nodes swapped,
       the result of transformproc is assigned to res }
     function MatchAndTransformNodesCommutative(n1,n2 : tnode;matchproc : TMatchProc2;transformproc : TTransformProc2;var res : tnode) : Boolean;
 
+    { calls matchproc with n1, n2, n3 and n4 as parameters being considered as the leafs of commutative nodes so all 8 possible
+      combinations are tested, if it returns true, transformproc is called,
+      the result of transformproc is assigned to res
+
+      this allows to find pattern like (3*a)+(3*b) and transfrom them into 3*(a+b)
+    }
+    function MatchAndTransformNodesCommutative(n1,n2,n3,n4 : tnode;matchproc : TMatchProc4;transformproc : TTransformProc4;var res : tnode) : Boolean;
+
+
 implementation
 
     uses
@@ -1642,4 +1653,29 @@ implementation
           result:=false;
       end;
 
+
+    function MatchAndTransformNodesCommutative(n1,n2,n3,n4 : tnode;matchproc : TMatchProc4;transformproc : TTransformProc4;var res : tnode) : Boolean;
+      begin
+        res:=nil;
+        result:=true;
+        if matchproc(n1,n2,n3,n4) then
+          res:=transformproc(n1,n2,n3,n4)
+        else if matchproc(n1,n2,n4,n3) then
+          res:=transformproc(n1,n2,n4,n3)
+        else if matchproc(n2,n1,n3,n4) then
+          res:=transformproc(n2,n1,n3,n4)
+        else if matchproc(n2,n1,n4,n3) then
+          res:=transformproc(n2,n1,n4,n3)
+        else if matchproc(n3,n4,n1,n2) then
+          res:=transformproc(n3,n4,n1,n2)
+        else if matchproc(n4,n3,n1,n2) then
+          res:=transformproc(n4,n3,n1,n2)
+        else if matchproc(n3,n4,n2,n1) then
+          res:=transformproc(n3,n4,n2,n1)
+        else if matchproc(n4,n3,n2,n1) then
+          res:=transformproc(n4,n3,n2,n1)
+        else
+          result:=false;
+      end;
+
 end.

compiler/psabiehpi.pas

@@ -522,7 +522,9 @@ implementation
 
     class procedure tpsabiehexceptionstatehandler.get_exception_temps(list: TAsmList; var t: texceptiontemps);
       begin
-        tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
+        if not assigned(exceptionreasontype) then
+          exceptionreasontype:=ossinttype;
+        tg.gethltemp(list,exceptionreasontype,exceptionreasontype.size,tt_persistent,t.reasonbuf);
       end;
 
 

compiler/pstatmnt.pas

@@ -991,6 +991,7 @@ implementation
                                sym:=clocalvarsym.create('$exceptsym',vs_value,ot,[]);
                             end;
                           excepTSymtable:=tstt_excepTSymtable.create;
+                          excepTSymtable.defowner:=current_procinfo.procdef;
                           excepTSymtable.insert(sym);
                           symtablestack.push(excepTSymtable);
                        end

compiler/psub.pas

@@ -466,7 +466,7 @@ implementation
               cifnode.create(caddnode.create(equaln,
                 ccallnode.createintern('fpc_setjmp',
                   ccallparanode.create(cloadnode.create(tlabelsym(p).jumpbuf,tlabelsym(p).jumpbuf.owner),nil)),
-                cordconstnode.create(1,sinttype,true))
+                cordconstnode.create(1,search_system_proc('fpc_setjmp').returndef,true))
               ,cgotonode.create(tlabelsym(p)),nil)
             );
           end;

compiler/symconst.pas

@@ -572,7 +572,9 @@ type
     ado_IsConstString,      // string constant
     ado_IsBitPacked,        // bitpacked array
     ado_IsVector,           // Vector
-    ado_IsGeneric           // the index of the array is generic (meaning that the size is not yet known)
+    ado_IsGeneric,          // the index of the array is generic (meaning that the size is not yet known)
+    ado_OpenArray           // open array, replaces the old hack with high being -1 for an open array:
+                            // this is still true, but this flag is set as well
   );
   tarraydefoptions=set of tarraydefoption;
 

compiler/symdef.pas

@@ -1213,7 +1213,10 @@ interface
        { several types to simulate more or less C++ objects for GDB }
        vmttype,
        vmtarraytype,
-       pvmttype      : tdef;     { type of classrefs, used for stabs }
+       { type of classrefs, used for stabs }
+       pvmttype,
+       { return type of the setjmp function }
+       exceptionreasontype      : tdef;
 
        { pointer to the anchestor of all classes }
        class_tobject : tobjectdef;
@@ -4154,6 +4157,7 @@ implementation
          symtable:=tarraysymtable.create(self);
       end;
 
+
     constructor tarraydef.create_vector(l ,h: asizeint; def: tdef);
       begin
         self.create(l,h,def);
@@ -4163,7 +4167,8 @@ implementation
 
     constructor tarraydef.create_openarray;
       begin
-        self.create(0,-1,sizesinttype)
+        self.create(0,-1,sizesinttype);
+        include(arrayoptions,ado_OpenArray);
       end;
 
 
@@ -4367,7 +4372,7 @@ implementation
           end;
 
         { Tarraydef.size may never be called for an open array! }
-        if (highrange=-1) and (lowrange=0) then
+        if ado_OpenArray in arrayoptions then
           internalerror(99080501);
         if not (ado_IsBitPacked in arrayoptions) then
           cachedelesize:=elesize
@@ -4383,7 +4388,10 @@ implementation
 
         if (cachedelecount = 0) then
           begin
-            size := -1;
+            if ado_isconststring in arrayoptions then
+              size := 0
+            else
+              size := -1;
             exit;
           end;
 
@@ -4472,7 +4480,7 @@ implementation
            end
          else if (ado_IsDynamicArray in arrayoptions) then
            GetTypeName:='{Dynamic} Array Of '+elementdef.typename
-         else if ((highrange=-1) and (lowrange=0)) then
+         else if (ado_OpenArray in arrayoptions) then
            GetTypeName:='{Open} Array Of '+elementdef.typename
          else
            begin

compiler/systems/i_darwin.pas

@@ -194,7 +194,7 @@ const
         name         : 'Darwin/iPhoneSim for i386';
         shortname    : 'iPhoneSim';
         flags        : [tf_p_ext_support,tf_files_case_sensitive,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,
-                        tf_pic_uses_got,tf_pic_default,tf_has_winlike_resources,tf_use_hlcfi,tf_supports_hidden_symbols];
+                        tf_pic_uses_got,tf_pic_default,tf_has_winlike_resources,tf_use_hlcfi,tf_supports_symbolorderfile,tf_supports_hidden_symbols];
         cpu          : cpu_i386;
         unit_env     : 'BSDUNITS';
         extradefines : 'UNIX;BSD;HASUNIX;DARWIN'; // also define darwin for code compatibility
@@ -263,7 +263,7 @@ const
         name         : 'Darwin for PowerPC64';
         shortname    : 'Darwin';
         flags        : [tf_p_ext_support,tf_files_case_sensitive,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,
-                        tf_pic_default,tf_has_winlike_resources,tf_supports_symbolorderfile,tf_supports_hidden_symbols];
+                        tf_pic_default,tf_has_winlike_resources,tf_supports_hidden_symbols];
         cpu          : cpu_powerpc64;
         unit_env     : 'BSDUNITS';
         extradefines : 'UNIX;BSD;HASUNIX';
@@ -400,7 +400,7 @@ const
         name         : 'Darwin/iPhoneSim for x86_64';
         shortname    : 'iPhoneSim';
         flags        : [tf_p_ext_support,tf_files_case_sensitive,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,
-                        tf_pic_default,tf_has_winlike_resources,tf_use_hlcfi,tf_supports_hidden_symbols];
+                        tf_pic_default,tf_has_winlike_resources,tf_use_hlcfi,tf_supports_symbolorderfile,tf_supports_hidden_symbols];
         cpu          : cpu_x86_64;
         unit_env     : 'BSDUNITS';
         extradefines : 'UNIX;BSD;HASUNIX;DARWIN'; // also define darwin for code compatibility

compiler/systems/i_linux.pas

@@ -227,17 +227,17 @@ unit i_linux;
                 coalescealign   : 0;
                 coalescealignskipmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 4;
+                constalignmax   : 16;
                 varalignmin     : 0;
-                varalignmax     : 4;
+                varalignmax     : 16;
                 localalignmin   : 4;
-                localalignmax   : 4;
+                localalignmax   : 8;
                 recordalignmin  : 0;
-                recordalignmax  : 4;
+                recordalignmax  : 16;
                 maxCrecordalign : 2;
               );
             first_parm_offset : 8;
-            stacksize    : 32*1024*1024;
+            stacksize    : 8*1024*1024;
             stackalign   : 4;
             abi : abi_default;
             llvmdatalayout : 'todo';

compiler/utils/ppuutils/ppudump.pp

@@ -3284,7 +3284,8 @@ const
    { ado_IsConstString      } 'ConstString',
    { ado_IsBitPacked        } 'BitPacked',
    { ado_IsVector           } 'Vector',
-   { ado_IsGeneric          } 'Generic'
+   { ado_IsGeneric          } 'Generic',
+   { ado_OpenArray          } 'OpenArray'
   );
 var
   symoptions: tarraydefoptions;

compiler/x86/aoptx86.pas

@@ -3360,67 +3360,168 @@ unit aoptx86;
         if (taicpu(p).oper[1]^.reg <> NR_STACK_POINTER_REG) and
           GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[1]^.reg) then
           begin
-            { changes
-                lea offset1(regX), reg1
-                lea offset2(reg1), reg1
-                to
-                lea offset1+offset2(regX), reg1 }
-
+            { Check common LEA/LEA conditions }
             if MatchInstruction(hp1,A_LEA,[taicpu(p).opsize]) and
-              MatchOperand(taicpu(p).oper[1]^,taicpu(hp1).oper[1]^) and
-              (taicpu(p).oper[0]^.ref^.relsymbol=nil) and
-              (taicpu(p).oper[0]^.ref^.segment=NR_NO) and
-              (taicpu(p).oper[0]^.ref^.symbol=nil) and
-              (((taicpu(hp1).oper[0]^.ref^.base=taicpu(p).oper[1]^.reg) and
-                (taicpu(p).oper[0]^.ref^.scalefactor <= 1) and
-                (taicpu(p).oper[0]^.ref^.index=NR_NO) and
-                (taicpu(p).oper[0]^.ref^.index=taicpu(hp1).oper[0]^.ref^.index) and
-                (taicpu(p).oper[0]^.ref^.scalefactor=taicpu(hp1).oper[0]^.ref^.scalefactor)
-               ) or
-               ((taicpu(hp1).oper[0]^.ref^.index=taicpu(p).oper[1]^.reg) and
-                (taicpu(p).oper[0]^.ref^.index=NR_NO)
-               ) or
-               ((taicpu(hp1).oper[0]^.ref^.base=taicpu(p).oper[1]^.reg) and
-                (taicpu(hp1).oper[0]^.ref^.scalefactor <= 1) and
-                ((taicpu(p).oper[0]^.ref^.base=NR_NO) or
-                 ((taicpu(p).oper[0]^.ref^.base=taicpu(p).oper[0]^.ref^.base) and
-                  (taicpu(p).oper[0]^.ref^.index=NR_NO)
-                 )
-                ) and
-                not(RegUsedBetween(taicpu(p).oper[0]^.ref^.index,p,hp1)))
-              ) and
-              not(RegUsedBetween(taicpu(p).oper[0]^.ref^.base,p,hp1)) and
-              (taicpu(p).oper[0]^.ref^.relsymbol=taicpu(hp1).oper[0]^.ref^.relsymbol) and
-              (taicpu(p).oper[0]^.ref^.segment=taicpu(hp1).oper[0]^.ref^.segment) and
-              (taicpu(p).oper[0]^.ref^.symbol=taicpu(hp1).oper[0]^.ref^.symbol) then
+              (taicpu(p).oper[1]^.reg = taicpu(hp1).oper[1]^.reg) and
+              (taicpu(p).oper[0]^.ref^.relsymbol = nil) and
+              (taicpu(p).oper[0]^.ref^.segment = NR_NO) and
+              (taicpu(p).oper[0]^.ref^.symbol = nil) and
+              (taicpu(hp1).oper[0]^.ref^.relsymbol = nil) and
+              (taicpu(hp1).oper[0]^.ref^.segment = NR_NO) and
+              (taicpu(hp1).oper[0]^.ref^.symbol = nil) and
+              (
+                (taicpu(p).oper[0]^.ref^.base = NR_NO) or { Don't call RegModifiedBetween unnecessarily }
+                not(RegModifiedBetween(taicpu(p).oper[0]^.ref^.base,p,hp1))
+              ) and (
+                (taicpu(p).oper[0]^.ref^.index = taicpu(p).oper[0]^.ref^.base) or { Don't call RegModifiedBetween unnecessarily }
+                (taicpu(p).oper[0]^.ref^.index = NR_NO) or
+                not(RegModifiedBetween(taicpu(p).oper[0]^.ref^.index,p,hp1))
+              ) then
               begin
-                DebugMsg(SPeepholeOptimization + 'LeaLea2Lea done',p);
-                if taicpu(hp1).oper[0]^.ref^.index=taicpu(p).oper[1]^.reg then
+                { changes
+                    lea (regX,scale), reg1
+                    lea offset(reg1,reg1), reg1
+                    to
+                    lea offset(regX,scale*2), reg1
+
+                  and
+                    lea (regX,scale1), reg1
+                    lea offset(reg1,scale2), reg1
+                    to
+                    lea offset(regX,scale1*scale2), reg1
+
+                  ... so long as the final scale does not exceed 8
+
+                  (Similarly, allow the first instruction to be "lea (regX,regX),reg1")
+                  }
+                if (taicpu(p).oper[0]^.ref^.offset = 0) and
+                  (taicpu(hp1).oper[0]^.ref^.index = taicpu(p).oper[1]^.reg) and
+                  (
+                    (
+                      (taicpu(p).oper[0]^.ref^.base = NR_NO)
+                    ) or (
+                      (taicpu(p).oper[0]^.ref^.scalefactor <= 1) and
+                      (
+                        (taicpu(p).oper[0]^.ref^.base = taicpu(p).oper[0]^.ref^.index) and
+                        not(RegUsedBetween(taicpu(p).oper[0]^.ref^.index, p, hp1))
+                      )
+                    )
+                  ) and (
+                    (
+                      { lea (reg1,scale2), reg1 variant }
+                      (taicpu(hp1).oper[0]^.ref^.base = NR_NO) and
+                      (
+                        (
+                          (taicpu(p).oper[0]^.ref^.base = NR_NO) and
+                          (taicpu(hp1).oper[0]^.ref^.scalefactor * taicpu(p).oper[0]^.ref^.scalefactor <= 8)
+                        ) or (
+                          { lea (regX,regX), reg1 variant }
+                          (taicpu(p).oper[0]^.ref^.base <> NR_NO) and
+                          (taicpu(hp1).oper[0]^.ref^.scalefactor <= 4)
+                        )
+                      )
+                    ) or (
+                      { lea (reg1,reg1), reg1 variant }
+                      (taicpu(hp1).oper[0]^.ref^.base = taicpu(p).oper[1]^.reg) and
+                      (taicpu(hp1).oper[0]^.ref^.scalefactor <= 1)
+                    )
+                  ) then
                   begin
-                    taicpu(hp1).oper[0]^.ref^.index:=taicpu(p).oper[0]^.ref^.base;
-                    inc(taicpu(hp1).oper[0]^.ref^.offset,taicpu(p).oper[0]^.ref^.offset*max(taicpu(hp1).oper[0]^.ref^.scalefactor,1));
-                    { if the register is used as index and base, we have to increase for base as well
-                      and adapt base }
-                    if taicpu(hp1).oper[0]^.ref^.base=taicpu(p).oper[1]^.reg then
+                    DebugMsg(SPeepholeOptimization + 'LeaLea2Lea 2 done',p);
+
+                    { Make everything homogeneous to make calculations easier }
+                    if (taicpu(p).oper[0]^.ref^.base <> NR_NO) then
                       begin
-                        taicpu(hp1).oper[0]^.ref^.base:=taicpu(p).oper[0]^.ref^.base;
-                        inc(taicpu(hp1).oper[0]^.ref^.offset,taicpu(p).oper[0]^.ref^.offset);
+                        if taicpu(p).oper[0]^.ref^.index <> NR_NO then
+                          { Convert lea (regX,regX),reg1 to lea (regX,2),reg1 }
+                          taicpu(p).oper[0]^.ref^.scalefactor := 2
+                        else
+                          taicpu(p).oper[0]^.ref^.index := taicpu(p).oper[0]^.ref^.base;
+
+                        taicpu(p).oper[0]^.ref^.base := NR_NO;
                       end;
+
+                    if (taicpu(hp1).oper[0]^.ref^.base = NR_NO) then
+                      begin
+                        { Just to prevent miscalculations }
+                        if (taicpu(hp1).oper[0]^.ref^.scalefactor = 0) then
+                          taicpu(hp1).oper[0]^.ref^.scalefactor := taicpu(p).oper[0]^.ref^.scalefactor
+                        else
+                          taicpu(hp1).oper[0]^.ref^.scalefactor := taicpu(hp1).oper[0]^.ref^.scalefactor * taicpu(p).oper[0]^.ref^.scalefactor;
+                      end
+                    else
+                      begin
+                        taicpu(hp1).oper[0]^.ref^.base := NR_NO;
+                        taicpu(hp1).oper[0]^.ref^.scalefactor := taicpu(p).oper[0]^.ref^.scalefactor * 2;
+                      end;
+
+                    taicpu(hp1).oper[0]^.ref^.index := taicpu(p).oper[0]^.ref^.index;
+                    RemoveCurrentP(p);
+                    result:=true;
+                    exit;
                   end
-                else
-                  begin
-                    inc(taicpu(hp1).oper[0]^.ref^.offset,taicpu(p).oper[0]^.ref^.offset);
-                    taicpu(hp1).oper[0]^.ref^.base:=taicpu(p).oper[0]^.ref^.base;
-                  end;
-                if taicpu(p).oper[0]^.ref^.index<>NR_NO then
+
+                { changes
+                    lea offset1(regX), reg1
+                    lea offset2(reg1), reg1
+                    to
+                    lea offset1+offset2(regX), reg1 }
+                else if
+                  (
+                    (taicpu(hp1).oper[0]^.ref^.index = taicpu(p).oper[1]^.reg) and
+                    (taicpu(p).oper[0]^.ref^.index = NR_NO)
+                  ) or (
+                    (taicpu(hp1).oper[0]^.ref^.base = taicpu(p).oper[1]^.reg) and
+                    (taicpu(hp1).oper[0]^.ref^.scalefactor <= 1) and
+                    (
+                      (
+                        (taicpu(p).oper[0]^.ref^.index = NR_NO) or
+                        (taicpu(p).oper[0]^.ref^.base = NR_NO)
+                      ) or (
+                        (taicpu(p).oper[0]^.ref^.scalefactor <= 1) and
+                        (
+                          (taicpu(p).oper[0]^.ref^.index = NR_NO) or
+                          (
+                            (taicpu(p).oper[0]^.ref^.index = taicpu(p).oper[0]^.ref^.base) and
+                            (
+                              (taicpu(hp1).oper[0]^.ref^.index = NR_NO) or
+                              (taicpu(hp1).oper[0]^.ref^.base = NR_NO)
+                            )
+                          )
+                        )
+                      )
+                    )
+                  ) then
                   begin
-                    taicpu(hp1).oper[0]^.ref^.base:=taicpu(hp1).oper[0]^.ref^.index;
-                    taicpu(hp1).oper[0]^.ref^.index:=taicpu(p).oper[0]^.ref^.index;
-                    taicpu(hp1).oper[0]^.ref^.scalefactor:=taicpu(p).oper[0]^.ref^.scalefactor;
+                    DebugMsg(SPeepholeOptimization + 'LeaLea2Lea 1 done',p);
+
+                    if taicpu(hp1).oper[0]^.ref^.index=taicpu(p).oper[1]^.reg then
+                      begin
+                        taicpu(hp1).oper[0]^.ref^.index:=taicpu(p).oper[0]^.ref^.base;
+                        inc(taicpu(hp1).oper[0]^.ref^.offset,taicpu(p).oper[0]^.ref^.offset*max(taicpu(hp1).oper[0]^.ref^.scalefactor,1));
+                        { if the register is used as index and base, we have to increase for base as well
+                          and adapt base }
+                        if taicpu(hp1).oper[0]^.ref^.base=taicpu(p).oper[1]^.reg then
+                          begin
+                            taicpu(hp1).oper[0]^.ref^.base:=taicpu(p).oper[0]^.ref^.base;
+                            inc(taicpu(hp1).oper[0]^.ref^.offset,taicpu(p).oper[0]^.ref^.offset);
+                          end;
+                      end
+                    else
+                      begin
+                        inc(taicpu(hp1).oper[0]^.ref^.offset,taicpu(p).oper[0]^.ref^.offset);
+                        taicpu(hp1).oper[0]^.ref^.base:=taicpu(p).oper[0]^.ref^.base;
+                      end;
+                    if taicpu(p).oper[0]^.ref^.index<>NR_NO then
+                      begin
+                        taicpu(hp1).oper[0]^.ref^.base:=taicpu(hp1).oper[0]^.ref^.index;
+                        taicpu(hp1).oper[0]^.ref^.index:=taicpu(p).oper[0]^.ref^.index;
+                        taicpu(hp1).oper[0]^.ref^.scalefactor:=taicpu(p).oper[0]^.ref^.scalefactor;
+                      end;
+                    RemoveCurrentP(p);
+                    result:=true;
+                    exit;
                   end;
-                RemoveCurrentP(p);
-                result:=true;
-                exit;
               end;
 
             { Change:
@@ -3890,76 +3991,92 @@ unit aoptx86;
       begin
         Result:=false;
 
-        if MatchOpType(taicpu(p),top_reg) and
-          GetNextInstruction(p, hp1) and
-          ((MatchInstruction(hp1, A_TEST, [S_B]) and
-           MatchOpType(taicpu(hp1),top_reg,top_reg) and
-           (taicpu(hp1).oper[0]^.reg = taicpu(hp1).oper[1]^.reg)) or
-           (MatchInstruction(hp1, A_CMP, [S_B]) and
-            MatchOpType(taicpu(hp1),top_const,top_reg) and
-            (taicpu(hp1).oper[0]^.val=0))
-          ) and
-          (taicpu(p).oper[0]^.reg = taicpu(hp1).oper[1]^.reg) and
-          GetNextInstruction(hp1, hp2) and
-          MatchInstruction(hp2, A_Jcc, []) then
-          { Change from:             To:
-
-            set(C) %reg              j(~C) label
-            test   %reg,%reg/cmp $0,%reg
-            je     label
-
-
-            set(C) %reg              j(C)  label
-            test   %reg,%reg/cmp $0,%reg
-            jne    label
-          }
+        if MatchOpType(taicpu(p),top_reg) and GetNextInstruction(p, hp1) then
           begin
-            next := tai(p.Next);
+            if ((MatchInstruction(hp1, A_TEST, [S_B]) and
+               MatchOpType(taicpu(hp1),top_reg,top_reg) and
+               (taicpu(hp1).oper[0]^.reg = taicpu(hp1).oper[1]^.reg)) or
+               (MatchInstruction(hp1, A_CMP, [S_B]) and
+                MatchOpType(taicpu(hp1),top_const,top_reg) and
+                (taicpu(hp1).oper[0]^.val=0))
+              ) and
+              (taicpu(p).oper[0]^.reg = taicpu(hp1).oper[1]^.reg) and
+              GetNextInstruction(hp1, hp2) and
+              MatchInstruction(hp2, A_Jcc, []) then
+              { Change from:             To:
 
-            TransferUsedRegs(TmpUsedRegs);
-            UpdateUsedRegs(TmpUsedRegs, next);
-            UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
+                set(C) %reg              j(~C) label
+                test   %reg,%reg/cmp $0,%reg
+                je     label
 
-            JumpC := taicpu(hp2).condition;
-            Unconditional := False;
 
-            if conditions_equal(JumpC, C_E) then
-              SetC := inverse_cond(taicpu(p).condition)
-            else if conditions_equal(JumpC, C_NE) then
-              SetC := taicpu(p).condition
-            else
-              { We've got something weird here (and inefficent) }
+                set(C) %reg              j(C)  label
+                test   %reg,%reg/cmp $0,%reg
+                jne    label
+              }
               begin
-                DebugMsg('DEBUG: Inefficient jump - check code generation', p);
-                SetC := C_NONE;
+                next := tai(p.Next);
+
+                TransferUsedRegs(TmpUsedRegs);
+                UpdateUsedRegs(TmpUsedRegs, next);
+                UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
 
-                { JAE/JNB will always branch (use 'condition_in', since C_AE <> C_NB normally) }
-                if condition_in(C_AE, JumpC) then
-                  Unconditional := True
+                JumpC := taicpu(hp2).condition;
+                Unconditional := False;
+
+                if conditions_equal(JumpC, C_E) then
+                  SetC := inverse_cond(taicpu(p).condition)
+                else if conditions_equal(JumpC, C_NE) then
+                  SetC := taicpu(p).condition
                 else
-                  { Not sure what to do with this jump - drop out }
-                  Exit;
-              end;
+                  { We've got something weird here (and inefficent) }
+                  begin
+                    DebugMsg('DEBUG: Inefficient jump - check code generation', p);
+                    SetC := C_NONE;
 
-            RemoveInstruction(hp1);
+                    { JAE/JNB will always branch (use 'condition_in', since C_AE <> C_NB normally) }
+                    if condition_in(C_AE, JumpC) then
+                      Unconditional := True
+                    else
+                      { Not sure what to do with this jump - drop out }
+                      Exit;
+                  end;
 
-            if Unconditional then
-              MakeUnconditional(taicpu(hp2))
-            else
-              begin
-                if SetC = C_NONE then
-                  InternalError(2018061402);
+                RemoveInstruction(hp1);
 
-                taicpu(hp2).SetCondition(SetC);
-              end;
+                if Unconditional then
+                  MakeUnconditional(taicpu(hp2))
+                else
+                  begin
+                    if SetC = C_NONE then
+                      InternalError(2018061402);
+
+                    taicpu(hp2).SetCondition(SetC);
+                  end;
+
+                if not RegUsedAfterInstruction(taicpu(p).oper[0]^.reg, hp2, TmpUsedRegs) then
+                  begin
+                    RemoveCurrentp(p, hp2);
+                    Result := True;
+                  end;
 
-            if not RegUsedAfterInstruction(taicpu(p).oper[0]^.reg, hp2, TmpUsedRegs) then
+                DebugMsg(SPeepholeOptimization + 'SETcc/TESTCmp/Jcc -> Jcc',p);
+              end
+            else if MatchInstruction(hp1, A_MOV, [S_B]) and
+              MatchOpType(taicpu(hp1),top_reg,top_reg) and
+              MatchOperand(taicpu(p).oper[0]^,taicpu(hp1).oper[0]^) then
               begin
-                RemoveCurrentp(p, hp2);
-                Result := True;
+                TransferUsedRegs(TmpUsedRegs);
+                UpdateUsedRegs(TmpUsedRegs, tai(p.Next));
+                if not RegUsedAfterInstruction(taicpu(p).oper[0]^.reg, hp1, TmpUsedRegs) then
+                  begin
+                    AllocRegBetween(taicpu(p).oper[0]^.reg,p,hp1,UsedRegs);
+                    taicpu(p).oper[0]^.reg:=taicpu(hp1).oper[1]^.reg;
+                    RemoveInstruction(hp1);
+                    DebugMsg(SPeepholeOptimization + 'SETcc/Mov -> SETcc',p);
+                    Result := true;
+                  end;
               end;
-
-            DebugMsg(SPeepholeOptimization + 'SETcc/TESTCmp/Jcc -> Jcc',p);
           end;
       end;
 
@@ -5251,6 +5368,25 @@ unit aoptx86;
                   if not MatchOpType(taicpu(hp1), top_reg, top_reg) then
                     Break;
 
+                  if not SuperRegistersEqual(taicpu(hp1).oper[0]^.reg, ThisReg) then
+                    begin
+                      { Because hp1 was obtained via GetNextInstructionUsingReg
+                        and ThisReg doesn't appear in the first operand, it
+                        must appear in the second operand and hence gets
+                        overwritten }
+                      if (InstrMax = -1) and
+                        Reg1WriteOverwritesReg2Entirely(taicpu(hp1).oper[1]^.reg, ThisReg) then
+                        begin
+                          { The two MOVZX instructions are adjacent, so remove the first one }
+                          DebugMsg(SPeepholeOptimization + 'Movzx2Nop 5', p);
+                          RemoveCurrentP(p);
+                          Result := True;
+                          Exit;
+                        end;
+
+                      Break;
+                    end;
+
                   { The objective here is to try to find a combination that
                     removes one of the MOV/Z instructions. }
                   case taicpu(hp1).opsize of
@@ -5363,8 +5499,7 @@ unit aoptx86;
                     ((TargetSize = S_W) and (taicpu(hp1).opsize in [S_W, S_BW])) then
                     begin
                       { Convert the output MOVZX to a MOV }
-                      if (taicpu(hp1).oper[0]^.typ = top_reg) and
-                        SuperRegistersEqual(taicpu(hp1).oper[1]^.reg, ThisReg) then
+                      if SuperRegistersEqual(taicpu(hp1).oper[1]^.reg, ThisReg) then
                         begin
                           { Or remove it completely! }
                           DebugMsg(SPeepholeOptimization + 'Movzx2Nop 2', hp1);

installer/install.dat

@@ -368,8 +368,6 @@ package=utils-pas2fpmos2.zip[up2fpos2.zip],Generate fpmake.pp for Pascal source
 package=utils-pas2jnios2.zip[p2jnos2.zip],Generate JNI bridge for Pascal code
 # OS/2 31
 package=utils-pas2utos2.zip[p2utos2.zip],Pascal source to FPC Unit test generator
-# OS/2 32
-package=ufcl-pdfos2.zip[ufcpdos2.zip],PDF generating and TTF file info library
 
 #
 # OS/2 packages 2nd part
@@ -438,8 +436,6 @@ package=utils-rmwaitos2.zip[rmwos2.zip],Remove (delete) file(s) with optional re
 package=utils-lexyaccos2.zip[lexyos2.zip],Compiler generator for TP and compatibles
 # OS/2-2 31
 package=utils-fpcmos2.zip[fpcmos2.zip],Generate Makefiles out of Makefile.fpc files
-# OS/2-2 32
-package=utils-unicodeos2.zip[ucodeos2.zip],Transformation of Unicode consortium data for FPC
 
 
 
@@ -457,6 +453,12 @@ package=utils-pas2jsos2.zip[p2jsos2.zip],Convert Pascal sources to Javascript
 package=utils-webidlos2.zip[widlos2.zip],Web IDL parser and converter to Object Pascal classes
 # OS/2-3 4
 package=utils-json2pasos2.zip[js2pos2.zip],Create Object Pascal classes from JSON files
+# OS/2-3 5
+package=ufcl-pdfos2.zip[ufcpdos2.zip],PDF generating and TTF file info library
+# OS/2-2 6
+package=utils-unicodeos2.zip[ucodeos2.zip],Transformation of Unicode consortium data for FPC
+# OS/2-3 7
+package=utplylibos2.zip[utpllos2.zip],Units for sources created with the compiler generator
 
 #
 # EMX packages
@@ -531,8 +533,6 @@ package=utils-pas2fpmemx.zip[up2fpemx.zip],Generate fpmake.pp for Pascal source
 package=utils-pas2jniemx.zip[p2jnemx.zip],Generate JNI bridge for Pascal code
 # EMX 31
 package=utils-pas2utemx.zip[p2utemx.zip],Pascal source to FPC Unit test generator
-# EMX 32
-package=ufcl-pdfemx.zip[ufcpdemx.zip],PDF generating and TTF file info library
 
 #
 # EMX packages 2nd part
@@ -601,8 +601,6 @@ package=utils-rmwaitemx.zip[rmwemx.zip],Remove (delete) file(s) with optional re
 package=utils-lexyaccemx.zip[ulexyemx.zip],Compiler generator for TP and compatibles
 # EMX-2 31
 package=utils-fpcmemx.zip[fpcmemx.zip],Generate Makefiles out of Makefile.fpc files
-# EMX-3 32
-package=utils-unicodeemx.zip[ucodeemx.zip],Transformation of Unicode consortium data for FPC
 
 
 #
@@ -618,6 +616,12 @@ package=utils-pas2jsemx.zip[p2jsemx.zip],Convert Pascal sources to Javascript
 package=utils-webidlemx.zip[widlemx.zip],Web IDL parser and converter to Object Pascal classes
 # EMX-3 4
 package=utils-json2pasemx.zip[js2pemx.zip],Create Object Pascal classes from JSON files
+# EMX-3 5
+package=ufcl-pdfemx.zip[ufcpdemx.zip],PDF generating and TTF file info library
+# EMX-2 6
+package=utils-unicodeemx.zip[ucodeemx.zip],Transformation of Unicode consortium data for FPC
+# EMX-3 7
+package=utplylibemx.zip[utpllemx.zip],Units for sources created with the compiler generator
 
 
 #
@@ -743,6 +747,8 @@ package=units-x11-3.3.1.source.zip[ux11src.zip],X Window (X11) interface units
 package=units-fcl-pdf-3.3.1.source.zip[ufcpdsrc.zip],PDF generating and TTF file info library
 # Source-2 30
 package=units-dblib-3.3.1.source.zip,Headers for the MS SQL Server RDBMS
+# Source-2 31
+package=units-tplylib.source.zip[utpllsrc.zip],Units for sources created with the compiler generator
 
 
 #

packages/fcl-db/src/export/fpxmlxsdexport.pp

@@ -2990,7 +2990,7 @@ begin
   }
 
   CreateXSD := True;
-  DecimalSeparator := char(''); //Don't override decimal separator by default
+  DecimalSeparator := #0; //Don't override decimal separator by default
 
   if Source is TXMLXSDFormatSettings then
   begin

packages/fcl-net/src/amiga/resolve.inc

@@ -48,7 +48,7 @@ Type
 
 { remember, classic style calls are also used on MorphOS, so don't test for AMIGA68K }
 {$ifndef AMIGAOS4}
-function gethostbyname(Name: PChar location 'a0'): PHostEntry; syscall SocketBase 210;
+function fpgethostbyname(Name: PChar location 'a0'): PHostEntry; syscall SocketBase 210;
 function getnetbyname(Name: PChar location 'a0'): PNetEntry; syscall SocketBase 222;
 function getnetbyaddr(Net: Longint location 'd0'; NetType: Longint location 'd1'): PNetEntry; syscall SocketBase 228;
 function getservbyname(Name: PChar location 'a0'; Protocol: PChar location 'a1'): PServEntry; syscall SocketBase 234;
@@ -63,7 +63,7 @@ function getservent: PServEntry; syscall SocketBase 564;
 
 {$else AMIGAOS4}
 
-function gethostbyname(const Name: PChar): PHostEntry; syscall ISocket 196;
+function fpgethostbyname(const Name: PChar): PHostEntry; syscall ISocket 196;
 function getnetbyname(Name: PChar): PNetEntry; syscall ISocket 204;
 function getnetbyaddr(Net: Longint; NetType: Longint): PNetEntry; syscall ISocket 208;
 function getservbyname(Name: PChar; Protocol: PChar): PServEntry; syscall ISocket 212;
@@ -77,12 +77,24 @@ procedure endservent; syscall ISocket 484;
 function getservent: PServEntry; syscall ISocket 488;
 {$endif AMIGAOS4}
 
+function gethostbyname(Name: PChar): PHostEntry;
+begin
+  if Assigned(SocketBase) then
+    gethostbyname := fpgethostbyname(Name)
+  else
+    gethostbyname := nil;
+end;
+
 function gethostbyaddr(Addr: PChar; Len: Longint; HType: Longint): PHostentry;
 var
   addr1,
   addr2: in_addr;
   IP: PPLongInt;
 begin
+  gethostbyaddr := nil;
+  if not Assigned(SocketBase) then
+    Exit;
+  //
   Addr1 :=  in_addr(PHostAddr(Addr)^);
   Addr2.s_addr := htonl(Addr1.s_addr);
   gethostbyaddr := Pointer(bsd_GetHostByAddr(Pointer(@Addr2.s_addr), Len, HType));
@@ -101,12 +113,14 @@ end;
 
 function  GetDNSError: integer;
 begin
-  GetDNSError:=bsd_Errno;
+  GetDNSError := 0;
+  if assigned(SocketBase) then
+    GetDNSError:=bsd_Errno;
 end;
 
 Function InitResolve : Boolean;
 begin
-  Result:=True;
+  Result:=Assigned(SocketBase);
 end;
 
 Function FinalResolve : Boolean;

packages/fcl-net/src/aros/resolve.inc

@@ -48,7 +48,7 @@ Type
 
 { C style calls, linked in from Libc }
 
-function gethostbyname(Name: PChar): PHostEntry; syscall SocketBase 35;
+function fpgethostbyname(Name: PChar): PHostEntry; syscall SocketBase 35;
 function getnetbyname(Name: PChar): PNetEntry; syscall SocketBase 37;
 function getnetbyaddr(Net: Longint; NetType: Longint): PNetEntry; syscall SocketBase 38;
 function getservbyname(Name: PChar; Protocol: PChar): PServEntry; syscall SocketBase 39;
@@ -61,12 +61,25 @@ procedure setservent(StayOpen: longint); syscall SocketBase 92;
 procedure endservent; syscall SocketBase 93;
 function getservent: PServEntry; syscall SocketBase 94;
 
+
+function gethostbyname(Name: PChar): PHostEntry;
+begin
+  if Assigned(SocketBase) then
+    gethostbyname := fpgethostbyname(Name)
+  else
+    gethostbyname := nil;
+end;
+
 function gethostbyaddr(Addr: PChar; Len: Longint; HType: Longint): PHostentry;
 var
   addr1,
   addr2: in_addr;
   IP: PPLongInt;
 begin
+  gethostbyaddr := nil;
+  if not Assigned(SocketBase) then
+    Exit;
+  //
   Addr1 :=  in_addr(PHostAddr(Addr)^);
   Addr2.s_addr := htonl(Addr1.s_addr);
   gethostbyaddr := Pointer(bsd_GetHostByAddr(Pointer(@Addr2.s_addr), Len, HType));
@@ -78,19 +91,21 @@ begin
       repeat
         ip^^ := ntohl(ip^^);
         Inc(IP);
-      until ip^ = nil; 
+      until ip^ = nil;
     end;
   end;
 end;
 
 function  GetDNSError: integer;
 begin
-  GetDNSError:=bsd_Errno;
+  GetDNSError := 0;
+  if assigned(SocketBase) then
+    GetDNSError := bsd_Errno;
 end;
 
 Function InitResolve : Boolean;
 begin
-  Result:=True;
+  Result := Assigned(SocketBase);
 end;
 
 Function FinalResolve : Boolean;

packages/fcl-passrc/src/pasresolver.pp

@@ -6229,16 +6229,43 @@ begin
 end;
 
 procedure TPasResolver.FinishSubElementType(Parent: TPasElement; El: TPasType);
+
+  procedure InsertInFront(NewParent: TPasElement; List: TFPList
+    {$IFDEF CheckPasTreeRefCount};const aId: string{$ENDIF});
+  var
+    i: Integer;
+    p: TPasElement;
+  begin
+    p:=El.Parent;
+    if NewParent=p.Parent then
+      begin
+      // e.g. a:array of longint; -> insert a$a in front of a
+      i:=List.Count-1;
+      while (i>=0) and (List[i]<>Pointer(p)) do
+        dec(i);
+      if i<0 then
+        List.Add(El)
+      else
+        List.Insert(i,El);
+      end
+    else
+      begin
+      List.Add(El);
+      end;
+    El.AddRef{$IFDEF CheckPasTreeRefCount}aID{$ENDIF};
+    El.Parent:=NewParent;
+  end;
+
 var
   Decl: TPasDeclarations;
   EnumScope: TPasEnumTypeScope;
+  p: TPasElement;
+  MembersType: TPasMembersType;
 begin
   EmitTypeHints(Parent,El);
   if (El.Name<>'') or (AnonymousElTypePostfix='') then exit;
   if Parent.Name='' then
     RaiseMsg(20170415165455,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
-  if not (Parent.Parent is TPasDeclarations) then
-    RaiseMsg(20170416094735,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
   if El.Parent<>Parent then
     RaiseNotYetImplemented(20190215085011,Parent);
   // give anonymous sub type a name
@@ -6246,11 +6273,27 @@ begin
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.FinishSubElementType parent="',GetObjName(Parent),'" named anonymous type "',GetObjName(El),'"');
   {$ENDIF}
-  Decl:=TPasDeclarations(Parent.Parent);
-  Decl.Declarations.Add(El);
-  El.AddRef{$IFDEF CheckPasTreeRefCount}('TPasDeclarations.Declarations'){$ENDIF};
-  El.Parent:=Decl;
-  Decl.Types.Add(El);
+
+  p:=Parent.Parent;
+  repeat
+    if p is TPasDeclarations then
+      begin
+      Decl:=TPasDeclarations(p);
+      InsertInFront(Decl,Decl.Declarations{$IFDEF CheckPasTreeRefCount},'TPasDeclarations.Declarations'{$ENDIF});
+      Decl.Types.Add(El);
+      break;
+      end
+    else if p is TPasMembersType then
+      begin
+      MembersType:=TPasMembersType(p);
+      InsertInFront(MembersType,MembersType.Members{$IFDEF CheckPasTreeRefCount},'TPasMembersType.Members'{$ENDIF});
+      break;
+      end
+    else
+      p:=p.Parent;
+    if p=nil then
+      RaiseMsg(20170416094735,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
+  until false;
   if (El.ClassType=TPasEnumType) and (Parent.ClassType=TPasSetType) then
     begin
     // anonymous enumtype
@@ -7819,6 +7862,8 @@ begin
     CheckUseAsType(El.VarType,20190123095916,El);
     if El.Expr<>nil then
       CheckAssignCompatibility(El,El.Expr,true);
+    if El.VarType.Parent=El then
+      FinishSubElementType(El,El.VarType);
     end
   else if El.Expr<>nil then
     begin
@@ -12278,12 +12323,17 @@ begin
   {$ENDIF}
   if not (TopScope is TPasIdentifierScope) then
     RaiseInvalidScopeForElement(20160929205732,El);
-  AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
+  if El.Name<>'' then
+    AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple)
+  else
+    begin
+    // anonymous enumtype
+    end;
   EnumScope:=TPasEnumTypeScope(PushScope(El,TPasEnumTypeScope));
   // add canonical set
   if El.Parent is TPasSetType then
     begin
-    // anonymous enumtype, e.g. "set of ()"
+    // set of anonymous enumtype, e.g. "set of ()"
     CanonicalSet:=TPasSetType(El.Parent);
     CanonicalSet.AddRef{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
     end
@@ -21051,8 +21101,8 @@ begin
       writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ...');
     {AllowWriteln-}
     {$ENDIF}
-    if not IsValidIdent(CurName) then
-      RaiseNotYetImplemented(20170328000033,ErrorEl,CurName);
+    // Note: CurName can be a non Pascal name, when specializing an autogenerated anonymous type
+    //if not IsValidIdent(CurName) then ;
     if CurScopeEl<>nil then
       begin
       NeedPop:=true;

packages/fpmkunit/src/fpmkunit.pp

@@ -7176,8 +7176,9 @@ begin
 
   // libc-linker path (always for Linux, since required for LLVM and SEH; this does not
   // force the linking of anything by itself, but just adds a search directory)
-  if APackage.NeedLibC or
-     (Defaults.OS=linux) then
+  // Do not add it if -Xd option is used
+  if (APackage.NeedLibC or (Defaults.OS=linux)) and
+     ((not Defaults.HaveOptions) or (Defaults.Options.IndexOf('-Xd')=-1)) then
     begin
       if FCachedlibcPath='' then
         begin

packages/hash/examples/sha1performancetest.pas

@@ -6,7 +6,7 @@ uses
   {$IFDEF UNIX}{$IFDEF UseCThreads}
   cthreads,
   {$ENDIF}{$ENDIF}
-  SysUtils,Classes,sha1,dateutils;
+  SysUtils,Classes,sha1;
 
 var
   StartTime: TDateTime;
@@ -24,6 +24,6 @@ begin
     ss := LowerCase(SHA1Print(SHA1string(s)));
   EndTime:=now;
   writeln('Performance test finished. Elapsed time:');
-  writeln(TimeToStr(EndTime-StartTime));
+  writeln((EndTime-StartTime)*3600*24:0:3,' s');
 end.
 

packages/pastojs/src/fppas2js.pp

@@ -2159,7 +2159,6 @@ type
       AContext: TConvertContext): TJSElement; virtual;
     Function CreateRTTIMemberProperty(Members: TFPList; Index: integer;
       AContext: TConvertContext): TJSElement; virtual;
-    Procedure CreateRTTIAnonymous(El: TPasType; AContext: TConvertContext); virtual;
     Function CreateRTTIMembers(El: TPasMembersType; Src: TJSSourceElements;
       FuncContext: TFunctionContext; MembersSrc: TJSSourceElements;
       MembersFuncContext: TFunctionContext; RTTIExpr: TJSElement;
@@ -9790,15 +9789,12 @@ begin
   if RightRefDecl is TPasProcedure then
     begin
     Proc:=TPasProcedure(RightRefDecl);
-    if coShortRefGlobals in Options then
+    if not aResolver.ProcHasSelf(Proc) then
       begin
-      if not aResolver.ProcHasSelf(Proc) then
-        begin
-        // a.StaticProc  ->  $lp(defaultargs)
-        // ToDo: check if left side has only types (no call nor field)
-        Result:=ConvertIdentifierExpr(RightEl,TPrimitiveExpr(RightEl).Value,aContext);
-        exit;
-        end;
+      // a.StaticProc  ->  pas.unit1.aclass.StaticProc(defaultargs)
+      // ToDo: check if left side has only types (no call nor field)
+      Result:=ConvertIdentifierExpr(RightEl,TPrimitiveExpr(RightEl).Value,aContext);
+      exit;
       end;
     end;
 
@@ -19965,23 +19961,6 @@ var
     ObjLit.Expr:=JS;
   end;
 
-  function VarTypeInfoAlreadyCreated(VarType: TPasType): boolean;
-  var
-    i: Integer;
-    PrevMember: TPasElement;
-  begin
-    i:=Index-1;
-    while (i>=0) do
-      begin
-      PrevMember:=TPasElement(Members[i]);
-      if (PrevMember is TPasVariable) and (TPasVariable(PrevMember).VarType=VarType)
-          and IsElementUsed(PrevMember) then
-        exit(true);
-      dec(i);
-      end;
-    Result:=false;
-  end;
-
 var
   JSTypeInfo: TJSElement;
   aName: String;
@@ -19994,10 +19973,7 @@ begin
   V:=TPasVariable(Members[Index]);
   VarType:=V.VarType;
   if (VarType<>nil) and (VarType.Name='') then
-    begin
-    if not VarTypeInfoAlreadyCreated(VarType) then
-      CreateRTTIAnonymous(VarType,AContext);
-    end;
+    RaiseNotSupported(VarType,AContext,20210223022919);
 
   JSTypeInfo:=CreateTypeInfoRef(VarType,AContext,V);
   OptionsEl:=nil;
@@ -20315,37 +20291,6 @@ begin
   end;
 end;
 
-procedure TPasToJSConverter.CreateRTTIAnonymous(El: TPasType;
-  AContext: TConvertContext);
-// if El has any anonymous types, create the RTTI
-var
-  C: TClass;
-  JS: TJSElement;
-  GlobalCtx: TFunctionContext;
-  Src: TJSSourceElements;
-begin
-  if El.Name<>'' then
-    RaiseNotSupported(El,AContext,20170905162324,'inconsistency');
-
-  GlobalCtx:=AContext.GetGlobalFunc;
-  if GlobalCtx=nil then
-    RaiseNotSupported(El,AContext,20181229130835);
-  if not (GlobalCtx.JSElement is TJSSourceElements) then
-    begin
-    {$IFDEF VerbosePas2JS}
-    writeln('TPasToJSConverter.CreateRTTIAnonymous GlobalCtx=',GetObjName(GlobalCtx),' JSElement=',GetObjName(GlobalCtx.JSElement));
-    {$ENDIF}
-    RaiseNotSupported(El,AContext,20181229130926);
-    end;
-  Src:=TJSSourceElements(GlobalCtx.JSElement);
-  C:=El.ClassType;
-  if C=TPasArrayType then
-    begin
-    JS:=ConvertArrayType(TPasArrayType(El),AContext);
-    AddToSourceElements(Src,JS);
-    end;
-end;
-
 function TPasToJSConverter.CreateRTTIMembers(El: TPasMembersType;
   Src: TJSSourceElements; FuncContext: TFunctionContext;
   MembersSrc: TJSSourceElements; MembersFuncContext: TFunctionContext;

packages/pastojs/tests/tcgenerics.pas

@@ -170,8 +170,8 @@ begin
     '']),
     LinesToStr([ // $mod.$main
     '$mod.TPoint$G1.x = $mod.p.x + 10;',
-    '$mod.p.Fly();',
-    '$mod.p.Fly();',
+    '$mod.TPoint$G1.Fly();',
+    '$mod.TPoint$G1.Fly();',
     '']));
 end;
 
@@ -256,6 +256,11 @@ begin
     '      this.x = $impl.TBird.$new();',
     '      this.a = rtl.arraySetLength(null, $impl.TBird, 2);',
     '    };',
+    '    this.a$a$clone = function (a) {',
+    '      var r = [];',
+    '      for (var i = 0; i < 2; i++) r.push($impl.TBird.$clone(a[i]));',
+    '      return r;',
+    '    };',
     '    this.$eq = function (b) {',
     '      return true;',
     '    };',
@@ -752,7 +757,7 @@ begin
     '    $mod.TPoint$G1.x = this.x + 5;',
     '    $mod.TPoint$G1.x = $mod.TPoint$G1.x + 6;',
     '    this.Fly();',
-    '    $mod.TPoint$G1.Fly();',
+    '    this.Fly();',
     '    this.Run();',
     '    $mod.TPoint$G1.Run();',
     '  };',
@@ -1169,6 +1174,11 @@ begin
     '      this.x = $impl.TBird.$new();',
     '      this.a = rtl.arraySetLength(null, $impl.TBird, 2);',
     '    };',
+    '    this.a$a$clone = function (a) {',
+    '      var r = [];',
+    '      for (var i = 0; i < 2; i++) r.push($impl.TBird.$clone(a[i]));',
+    '      return r;',
+    '    };',
     '  }, "TAnt<UnitA.TBird>");',
     '  $mod.$implcode = function () {',
     '    rtl.recNewT($impl, "TBird", function () {',

packages/pastojs/tests/tcmodules.pas

@@ -380,6 +380,7 @@ type
     Procedure TestEnum_ForIn;
     Procedure TestEnum_ScopedNumber;
     Procedure TestEnum_InFunction;
+    Procedure TestEnum_Name_Anonymous_Unit;
     Procedure TestSet_Enum;
     Procedure TestSet_Operators;
     Procedure TestSet_Operator_In;
@@ -522,6 +523,7 @@ type
     Procedure TestClasS_CallInheritedConstructor;
     Procedure TestClass_ClassVar_Assign;
     Procedure TestClass_CallClassMethod;
+    Procedure TestClass_CallClassMethodStatic; // ToDo
     Procedure TestClass_Property;
     Procedure TestClass_Property_ClassMethod;
     Procedure TestClass_Property_Indexed;
@@ -5949,6 +5951,34 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestEnum_Name_Anonymous_Unit;
+begin
+  StartUnit(true);
+  Add([
+  'interface',
+  'var color: (red, green);',
+  'implementation',
+  'initialization',
+  '  color:=green;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestEnum_Name_Anonymous_Unit',
+    LinesToStr([
+    'this.color$a = {',
+    '  "0": "red",',
+    '  red: 0,',
+    '  "1": "green",',
+    '  green: 1',
+    '};',
+    'this.color = 0;',
+    '']),
+    LinesToStr([ // this.$init
+    '$mod.color = $mod.color$a.green;',
+    '']),
+    LinesToStr([ // implementation
+    '']) );
+end;
+
 procedure TTestModule.TestSet_Enum;
 begin
   StartProgram(false);
@@ -9455,7 +9485,7 @@ begin
   '  arr2[6,3]:=i;',
   '  i:=arr2[5,2];',
   '  arr2:=arr2;',// clone multi dim static array
-  //'  arr3:=arr3;',// clone anonymous multi dim static array
+  '  arr3:=arr3;',// clone anonymous multi dim static array
   '']);
   ConvertProgram;
   CheckSource('TestArray_StaticMultiDim',
@@ -9467,6 +9497,11 @@ begin
     '};',
     'this.Arr = rtl.arraySetLength(null, 0, 3);',
     'this.Arr2 = rtl.arraySetLength(null, 0, 2, 3);',
+    'this.Arr3$a$clone = function (a) {',
+    '  var r = [];',
+    '  for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
+    '  return r;',
+    '};',
     'this.Arr3 = [[11, 12, 13], [21, 22, 23]];',
     'this.i = 0;'
     ]),
@@ -9483,6 +9518,7 @@ begin
     '$mod.Arr2[1][2] = $mod.i;',
     '$mod.i = $mod.Arr2[0][1];',
     '$mod.Arr2 = $mod.TArrayArrayInt$clone($mod.Arr2);',
+    '$mod.Arr3 = $mod.Arr3$a$clone($mod.Arr3);',
     '']));
 end;
 
@@ -9504,6 +9540,7 @@ begin
   'begin',
   '  arr2[5]:=arr;',
   '  arr2:=arr2;',// clone multi dim static array
+  '  arr3:=arr3;',// clone multi dim anonymous static array
   'end;',
   'begin',
   '']);
@@ -9517,6 +9554,11 @@ begin
     '  for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
     '  return r;',
     '};',
+    'var Arr3$a$clone = function (a) {',
+    '  var r = [];',
+    '  for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
+    '  return r;',
+    '};',
     'this.DoIt = function () {',
     '  var Arr = rtl.arraySetLength(null, 0, 3);',
     '  var Arr2 = rtl.arraySetLength(null, 0, 2, 3);',
@@ -9524,6 +9566,7 @@ begin
     '  var i = 0;',
     '  Arr2[0] = Arr.slice(0);',
     '  Arr2 = TArrayArrayInt$1$clone(Arr2);',
+    '  Arr3 = Arr3$a$clone(Arr3);',
     '};',
     '']),
     LinesToStr([ // $mod.$main
@@ -11157,26 +11200,28 @@ end;
 procedure TTestModule.TestRecord_Assign;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  TEnum = (red,green);');
-  Add('  TEnums = set of TEnum;');
-  Add('  TSmallRec = record');
-  Add('    N: longint;');
-  Add('  end;');
-  Add('  TBigRec = record');
-  Add('    Int: longint;');
-  Add('    D: double;');
-  Add('    Arr: array of longint;');
-  Add('    Arr2: array[1..2] of longint;');
-  Add('    Small: TSmallRec;');
-  Add('    Enums: TEnums;');
-  Add('  end;');
-  Add('var');
-  Add('  r, s: TBigRec;');
-  Add('begin');
-  Add('  r:=s;');
-  Add('  r:=default(TBigRec);');
-  Add('  r:=default(s);');
+  Add([
+  'type',
+  '  TEnum = (red,green);',
+  '  TEnums = set of TEnum;',
+  '  TSmallRec = record',
+  '    N: longint;',
+  '  end;',
+  '  TBigRec = record',
+  '    Int: longint;',
+  '    D: double;',
+  '    Arr: array of longint;',
+  '    Arr2: array[1..2] of longint;',
+  '    Small: TSmallRec;',
+  '    Enums: TEnums;',
+  '  end;',
+  'var',
+  '  r, s: TBigRec;',
+  'begin',
+  '  r:=s;',
+  '  r:=default(TBigRec);',
+  '  r:=default(s);',
+  '']);
   ConvertProgram;
   CheckSource('TestRecord_Assign',
     LinesToStr([ // statements
@@ -12091,9 +12136,9 @@ begin
     '$mod.TRec.SetInt($mod.TRec.GetInt() + 2);',
     '$mod.TRec.SetInt($mod.TRec.Fx);',
     '$mod.TRec.Fy = $mod.r.Fx + 1;',
-    'if ($mod.r.GetInt() === 2) ;',
-    '$mod.r.SetInt($mod.r.GetInt() + 2);',
-    '$mod.r.SetInt($mod.r.Fx);',
+    'if ($mod.TRec.GetInt() === 2) ;',
+    '$mod.TRec.SetInt($mod.TRec.GetInt() + 2);',
+    '$mod.TRec.SetInt($mod.r.Fx);',
     '']));
 end;
 
@@ -12557,8 +12602,8 @@ begin
     '  $mod.TPoint.Fly();',
     '})();',
     '$mod.TPoint.x = $mod.r.x + 10;',
-    '$mod.r.Fly();',
-    '$mod.r.Fly();',
+    '$mod.TPoint.Fly();',
+    '$mod.TPoint.Fly();',
     '']));
 end;
 
@@ -13474,6 +13519,63 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestClass_CallClassMethodStatic;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  public',
+  '    class function Fly: tobject; static;',
+  '  end;',
+  'class function tobject.Fly: tobject;',
+  'begin',
+  '  Result.Fly;',
+  '  Result.Fly();',
+  '  Fly;',
+  '  Fly();',
+  '  Fly.Fly;',
+  '  Fly.Fly();',
+  'end;',
+  'var Obj: tobject;',
+  'begin',
+  '  obj.Fly;',
+  '  obj.Fly();',
+  '  with obj do begin',
+  '    Fly;',
+  '    Fly();',
+  '  end;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClass_CallClassMethodStatic',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Fly = function () {',
+    '    var Result = null;',
+    '    $mod.TObject.Fly();',
+    '    $mod.TObject.Fly();',
+    '    $mod.TObject.Fly();',
+    '    $mod.TObject.Fly();',
+    '    $mod.TObject.Fly();',
+    '    $mod.TObject.Fly();',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.TObject.Fly();',
+    '$mod.TObject.Fly();',
+    'var $with = $mod.Obj;',
+    '$with.Fly();',
+    '$with.Fly();',
+    '']));
+end;
+
 procedure TTestModule.TestClass_Property;
 begin
   StartProgram(false);
@@ -22610,21 +22712,21 @@ begin
     'this.c = null;',
     '']),
     LinesToStr([ // $mod.$main
-    '$mod.b.SetSpeed($mod.b.GetSpeed() + 12);',
+    '$mod.TObject.SetSpeed($mod.TObject.GetSpeed() + 12);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 14);',
     'var $with = $mod.b;',
     '$with.SetSpeed($with.GetSpeed() + 32);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 33);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 34);',
-    '$mod.c.SetSpeed($mod.c.GetSpeed() + 12);',
+    '$mod.TObject.SetSpeed($mod.TObject.GetSpeed() + 12);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 14);',
     'var $with1 = $mod.c;',
     '$with1.SetSpeed($with1.GetSpeed() + 32);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 33);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 34);',
-    '$mod.TBird.SetSpeed($mod.TBird.GetSpeed() + 12);',
+    '$mod.TObject.SetSpeed($mod.TObject.GetSpeed() + 12);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 14);',
     'var $with2 = $mod.TBird;',
@@ -24410,7 +24512,7 @@ begin
     '']),
     LinesToStr([ // $mod.$main
     '$mod.THelper.Fly.call({',
-    '  p: $mod.o.GetField(),',
+    '  p: $mod.TObject.GetField(),',
     '  get: function () {',
     '      return this.p;',
     '    },',
@@ -24428,7 +24530,7 @@ begin
     '      this.p = v;',
     '    }',
     '}, 12);',
-    'var $with1 = $mod.o.GetField();',
+    'var $with1 = $mod.TObject.GetField();',
     '$mod.THelper.Fly.call({',
     '  get: function () {',
     '      return $with1;',
@@ -29490,6 +29592,9 @@ begin
   CheckSource('TestRTTI_Class_Field',
     LinesToStr([ // statements
     'rtl.createClass(this, "TObject", null, function () {',
+    '  $mod.$rtti.$DynArray("TObject.ArrB$a", {',
+    '    eltype: rtl.byte',
+    '  });',
     '  this.$init = function () {',
     '    this.FPropA = "";',
     '    this.VarLI = 0;',
@@ -29521,9 +29626,6 @@ begin
     '  $r.addField("VarShI", rtl.shortint);',
     '  $r.addField("VarBy", rtl.byte);',
     '  $r.addField("VarExt", rtl.longint);',
-    '  $mod.$rtti.$DynArray("TObject.ArrB$a", {',
-    '    eltype: rtl.byte',
-    '  });',
     '  $r.addField("ArrA", $mod.$rtti["TObject.ArrB$a"]);',
     '  $r.addField("ArrB", $mod.$rtti["TObject.ArrB$a"]);',
     '});',
@@ -30558,6 +30660,9 @@ begin
   CheckSource('TestRTTI_Record',
     LinesToStr([ // statements
     'rtl.recNewT(this, "TFloatRec", function () {',
+    '  $mod.$rtti.$DynArray("TFloatRec.d$a", {',
+    '    eltype: rtl.char',
+    '  });',
     '  this.$new = function () {',
     '    var r = Object.create(this);',
     '    r.c = [];',
@@ -30572,9 +30677,6 @@ begin
     '    this.d = rtl.arrayRef(s.d);',
     '    return this;',
     '  };',
-    '  $mod.$rtti.$DynArray("TFloatRec.d$a", {',
-    '    eltype: rtl.char',
-    '  });',
     '  var $r = $mod.$rtti.$Record("TFloatRec", {});',
     '  $r.addField("c", $mod.$rtti["TFloatRec.d$a"]);',
     '  $r.addField("d", $mod.$rtti["TFloatRec.d$a"]);',

packages/rtl-extra/src/amiga/sockets.pp

@@ -201,12 +201,18 @@ end;
 
 function fpgeterrno: longint; inline;
 begin
-  fpgeterrno := bsd_Errno;
+  if Assigned(SocketBase) then
+    fpgeterrno := bsd_Errno
+  else
+    fpgeterrno := 0;
 end;
 
 function fpClose(d: LongInt): LongInt; inline;
 begin
-  fpClose := bsd_CloseSocket(d);
+  if Assigned(SocketBase) then
+    fpClose := bsd_CloseSocket(d)
+  else
+    fpClose := -1;
 end;
 
 function fpaccept(s: cint; addrx: PSockaddr; Addrlen: PSocklen): cint;
@@ -289,8 +295,16 @@ end;
 
 function fpsocket(domain: cint; xtype: cint; protocol: cint): cint;
 begin
-  fpsocket := bsd_socket(domain, xtype, protocol);
-  internal_socketerror := fpgeterrno;
+  if Assigned(SocketBase) then
+  begin
+    fpsocket := bsd_socket(domain, xtype, protocol);
+    internal_socketerror := fpgeterrno;
+  end
+  else
+  begin
+    fpsocket := -1;
+    internal_socketerror := ESockEPROTONOSUPPORT;
+  end;
 end;
 
 

packages/rtl-extra/src/aros/sockets.pp

@@ -88,7 +88,7 @@ const
   SOL_SOCKET    = $FFFF;
 
 const
-  EsockEINTR            = 4; // EsysEINTR;   
+  EsockEINTR            = 4; // EsysEINTR;
   EsockEBADF            = 9; // EsysEBADF;
   EsockEFAULT           = 14; // EsysEFAULT;
   EsockEINVAL           = 22; //EsysEINVAL;
@@ -155,18 +155,24 @@ end;
 
 function fpgeterrno: longint; inline;
 begin
-  fpgeterrno := bsd_Errno;
+  if Assigned(SocketBase) then
+    fpgeterrno := bsd_Errno
+  else
+    fpgeterrno := 0;
 end;
 
 function fpClose(d: LongInt): LongInt; inline;
 begin
-  fpClose := bsd_CloseSocket(d);
+  if Assigned(SocketBase) then
+    fpClose := bsd_CloseSocket(d)
+  else
+    fpClose := -1;
 end;
 
 function fpaccept(s: cint; addrx: PSockaddr; Addrlen: PSocklen): cint;
 begin
   fpaccept := bsd_accept(s,addrx,addrlen);
-  internal_socketerror := fpgeterrno; 
+  internal_socketerror := fpgeterrno;
 end;
 
 function fpbind(s:cint; addrx: psockaddr; addrlen: tsocklen): cint;
@@ -177,8 +183,16 @@ end;
 
 function fpconnect(s:cint; name: psockaddr; namelen: tsocklen): cint;
 begin
-  fpconnect := bsd_connect(s, name, namelen);
-  internal_socketerror := fpgeterrno;
+  if Assigned(SocketBase) then
+  begin
+    fpconnect := bsd_connect(s, name, namelen);
+    internal_socketerror := fpgeterrno;
+  end
+  else
+  begin
+    fpconnect := -1;
+    internal_socketerror := ESockEPROTONOSUPPORT;
+  end;
 end;
 
 function fpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint;
@@ -243,8 +257,16 @@ end;
 
 function fpsocket(domain: cint; xtype: cint; protocol: cint): cint;
 begin
-  fpsocket := bsd_socket(domain, xtype, protocol);
-  internal_socketerror := fpgeterrno;
+  if Assigned(SocketBase) then
+  begin
+    fpsocket := bsd_socket(domain, xtype, protocol);
+    internal_socketerror := fpgeterrno;
+  end
+  else
+  begin
+    internal_socketerror := ESockEPROTONOSUPPORT;
+    fpsocket := -1;
+  end;
 end;
 
 

packages/tplylib/fpmake.pp

@@ -13,7 +13,7 @@ begin
 {$endif ALLPACKAGES}
 
     P:=AddPackage('tplylib');
-    P.ShortName:='tplylib';
+    P.ShortName:='tpll';
 {$ifdef ALLPACKAGES}
     P.Directory:=ADirectory;
 {$endif ALLPACKAGES}

rtl/linux/arm/sighnd.inc

@@ -41,6 +41,7 @@ end;
 {$endif not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
 
 {$if FPC_FULLVERSION >= 30200}
+{$if defined(CPU_HAS_THUMB))}
 Procedure SignalToHandleErrorAddrFrame_Thumb(Errno : longint;addr : CodePointer; frame : Pointer); nostackframe; assembler;
 asm
 .thumb_func
@@ -61,7 +62,8 @@ asm
 .code 32
 {$endif not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
 end;
-{$endif}
+{$endif defined(CPU_HAS_THUMB))}
+{$endif FPC_FULLVERSION >= 30200}
 
 procedure SignalToRunerror(Sig: longint; { _a2,_a3,_a4 : dword; } SigContext: PSigInfo; uContext : PuContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 var
@@ -110,7 +112,11 @@ begin
       else
 {$endif not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
         begin
+{$if defined(CPU_HAS_THUMB))}
           ucontext^.uc_mcontext.arm_pc:=ptruint(@SignalToHandleErrorAddrFrame_Thumb);
+{$else defined(CPU_HAS_THUMB))}
+          halt(217);
+{$endif defined(CPU_HAS_THUMB))}
         end;
 {$else}
       ucontext^.uc_mcontext.arm_pc:=ptruint(@SignalToHandleErrorAddrFrame_ARM);

rtl/objpas/math.pp

@@ -1159,7 +1159,7 @@ function sum(const data : array of Single) : float;inline;
 
 function sum(const data : PSingle;Const N : longint) : float;
   var
-     i : longint;
+     i : SizeInt;
   begin
      sum:=0.0;
      for i:=0 to N-1 do
@@ -1186,7 +1186,7 @@ function sum(const data : array of Double) : float; inline;
 
 function sum(const data : PDouble;Const N : longint) : float;
   var
-     i : longint;
+     i : SizeInt;
   begin
      sum:=0.0;
      for i:=0 to N-1 do
@@ -1213,7 +1213,7 @@ function sum(const data : array of Extended) : float; inline;
 
 function sum(const data : PExtended;Const N : longint) : float;
   var
-     i : longint;
+     i : SizeInt;
   begin
      sum:=0.0;
      for i:=0 to N-1 do
@@ -1223,7 +1223,7 @@ function sum(const data : PExtended;Const N : longint) : float;
 
 function sumInt(const data : PInt64;Const N : longint) : Int64;
   var
-     i : longint;
+     i : SizeInt;
   begin
      sumInt:=0;
      for i:=0 to N-1 do
@@ -1248,7 +1248,7 @@ function mean(const data: array of Int64):Float;
 
 function sumInt(const data : PInteger; Const N : longint) : Int64;
 var
-   i : longint;
+   i : SizeInt;
   begin
      sumInt:=0;
      for i:=0 to N-1 do
@@ -1279,7 +1279,7 @@ function mean(const data: array of Integer):Float;
 
  function sumofsquares(const data : PSingle; Const N : Integer) : float;
   var
-     i : longint;
+     i : SizeInt;
   begin
      sumofsquares:=0.0;
      for i:=0 to N-1 do
@@ -1295,7 +1295,7 @@ end;
 procedure sumsandsquares(const data : PSingle; Const N : Integer;
   var sum,sumofsquares : float);
   var
-     i : Integer;
+     i : SizeInt;
      temp : float;
   begin
      sumofsquares:=0.0;
@@ -1317,7 +1317,7 @@ procedure sumsandsquares(const data : PSingle; Const N : Integer;
 
  function sumofsquares(const data : PDouble; Const N : Integer) : float;
   var
-     i : longint;
+     i : SizeInt;
   begin
      sumofsquares:=0.0;
      for i:=0 to N-1 do
@@ -1333,7 +1333,7 @@ end;
 procedure sumsandsquares(const data : PDouble; Const N : Integer;
   var sum,sumofsquares : float);
   var
-     i : Integer;
+     i : SizeInt;
      temp : float;
   begin
      sumofsquares:=0.0;
@@ -1355,7 +1355,7 @@ procedure sumsandsquares(const data : PDouble; Const N : Integer;
 
  function sumofsquares(const data : PExtended; Const N : Integer) : float;
   var
-     i : longint;
+     i : SizeInt;
   begin
      sumofsquares:=0.0;
      for i:=0 to N-1 do
@@ -1371,7 +1371,7 @@ end;
 procedure sumsandsquares(const data : PExtended; Const N : Integer;
   var sum,sumofsquares : float);
   var
-     i : Integer;
+     i : SizeInt;
      temp : float;
   begin
      sumofsquares:=0.0;
@@ -1411,7 +1411,7 @@ end;
 {$ifdef FPC_HAS_TYPE_SINGLE}
 procedure MeanAndTotalVariance
   (const data: PSingle; N: LongInt; var mu, variance: float);
-var i: LongInt;
+var i: SizeInt;
 begin
   mu := Mean( data, N );
   variance := 0;
@@ -1511,7 +1511,7 @@ procedure momentskewkurtosis(
   out kurtosis: float
 );
 var
-  i: integer;
+  i: SizeInt;
   value : psingle;
   deviation, deviation2: single;
   reciprocalN: float;
@@ -1562,7 +1562,7 @@ function norm(const data : PSingle; Const N : Integer) : float;
 {$ifdef FPC_HAS_TYPE_DOUBLE}
 procedure MeanAndTotalVariance
   (const data: PDouble; N: LongInt; var mu, variance: float);
-var i: LongInt;
+var i: SizeInt;
 begin
   mu := Mean( data, N );
   variance := 0;
@@ -1666,7 +1666,7 @@ procedure momentskewkurtosis(
   out kurtosis: float
 );
 var
-  i: integer;
+  i: SizeInt;
   value : pdouble;
   deviation, deviation2: double;
   reciprocalN: float;
@@ -1717,7 +1717,7 @@ function norm(const data : PDouble; Const N : Integer) : float;
 {$ifdef FPC_HAS_TYPE_EXTENDED}
 procedure MeanAndTotalVariance
   (const data: PExtended; N: LongInt; var mu, variance: float);
-var i: LongInt;
+var i: SizeInt;
 begin
   mu := Mean( data, N );
   variance := 0;
@@ -1810,7 +1810,7 @@ end;
 
 procedure momentskewkurtosis(
   const data: pExtended;
-  Const N: integer;
+  Const N: Integer;
   out m1: float;
   out m2: float;
   out m3: float;
@@ -1870,7 +1870,7 @@ function norm(const data : PExtended; Const N : Integer) : float;
 
 function MinIntValue(const Data: array of Integer): Integer;
 var
-  I: Integer;
+  I: SizeInt;
 begin
   Result := Data[Low(Data)];
   For I := Succ(Low(Data)) To High(Data) Do
@@ -1879,7 +1879,7 @@ end;
 
 function MaxIntValue(const Data: array of Integer): Integer;
 var
-  I: Integer;
+  I: SizeInt;
 begin
   Result := Data[Low(Data)];
   For I := Succ(Low(Data)) To High(Data) Do
@@ -1893,7 +1893,7 @@ end;
 
 function MinValue(const Data: PInteger; Const N : Integer): Integer;
 var
-  I: Integer;
+  I: SizeInt;
 begin
   Result := Data[0];
   For I := 1 To N-1 do
@@ -1907,7 +1907,7 @@ end;
 
 function maxvalue(const data : PInteger; Const N : Integer) : Integer;
 var
-   i : longint;
+   i : SizeInt;
 begin
    { get an initial value }
    maxvalue:=data[0];
@@ -1924,7 +1924,7 @@ end;
 
 function minvalue(const data : PSingle; Const N : Integer) : Single;
 var
-   i : longint;
+   i : SizeInt;
 begin
    { get an initial value }
    minvalue:=data[0];
@@ -1941,7 +1941,7 @@ end;
 
 function maxvalue(const data : PSingle; Const N : Integer) : Single;
 var
-   i : longint;
+   i : SizeInt;
 begin
    { get an initial value }
    maxvalue:=data[0];
@@ -1959,7 +1959,7 @@ end;
 
 function minvalue(const data : PDouble; Const N : Integer) : Double;
 var
-   i : longint;
+   i : SizeInt;
 begin
    { get an initial value }
    minvalue:=data[0];
@@ -1976,7 +1976,7 @@ end;
 
 function maxvalue(const data : PDouble; Const N : Integer) : Double;
 var
-   i : longint;
+   i : SizeInt;
 begin
    { get an initial value }
    maxvalue:=data[0];
@@ -1994,7 +1994,7 @@ end;
 
 function minvalue(const data : PExtended; Const N : Integer) : Extended;
 var
-   i : longint;
+   i : SizeInt;
 begin
    { get an initial value }
    minvalue:=data[0];
@@ -2011,7 +2011,7 @@ end;
 
 function maxvalue(const data : PExtended; Const N : Integer) : Extended;
 var
-   i : longint;
+   i : SizeInt;
 begin
    { get an initial value }
    maxvalue:=data[0];

tests/test/tandorandnot1.pp

@@ -0,0 +1,34 @@
+{ test (a and b) or (c and not(b)) into c xor ((c xor a) and b) optimization with random values }
+var
+  i,a,b,c,_a,_b,_c : word;
+begin
+  for i:=1 to 1000 do
+    begin
+      a:=random(65536);
+      _a:=a;
+      b:=random(65536);
+      _b:=b;
+      c:=random(65536);
+      _c:=c;
+      if (a and b) or (c and not(b))<>_c xor ((_c xor _a) and _b) then
+        begin
+          writeln('Error: ','a=',a,'b=',b,'c=',c);
+          halt(1);
+        end;
+      if (a and b) or (not(b) and c)<>_c xor ((_c xor _a) and _b) then
+        begin
+          writeln('Error: ','a=',a,'b=',b,'c=',c);
+          halt(1);
+        end;
+      if (not(b) and c) or (a and b)<>_c xor ((_c xor _a) and _b) then
+        begin
+          writeln('Error: ','a=',a,'b=',b,'c=',c);
+          halt(1);
+        end;
+      if (not(b) and c) or (b and a)<>_c xor ((_c xor _a) and _b) then
+        begin
+          writeln('Error: ','a=',a,'b=',b,'c=',c);
+          halt(1);
+        end;
+    end;
+end.

tests/test/tmt1.pp

@@ -11,9 +11,9 @@ uses
   ;
 
 const
-{$ifdef cpuarm}
+{$if defined(cpuarm) or defined(cpuavr) or defined(cpui8086) or defined(cpum68k) or defined(cpumips) or defined(cpuz80)}
   {$define slowcpu}
-{$endif cpuarm}
+{$endif}
 
 {$ifdef slowcpu}
    threadcount = 40;

tests/utils/dotest.pp

@@ -839,7 +839,7 @@ end;
 function RunCompiler(const ExtraPara: string):boolean;
 var
   args,LocalExtraArgs,
-  wpoargs : string;
+  wpoargs,wposuffix : string;
   passnr,
   passes  : longint;
   execres : boolean;
@@ -880,6 +880,7 @@ begin
   if Config.NeedOptions<>'' then
    AppendOptions(Config.NeedOptions,args);
   wpoargs:='';
+  wposuffix:='';
   if (Config.WpoPasses=0) or
      (Config.WpoParas='') then
     passes:=1
@@ -891,6 +892,7 @@ begin
     begin
       if (passes>1) then
         begin
+          wposuffix:='_'+tostr(passnr);
           wpoargs:=' -OW'+config.wpoparas+' -FW'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr));
           if (passnr>1) then
             wpoargs:=wpoargs+' -Ow'+config.wpoparas+' -Fw'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr-1));
@@ -899,12 +901,12 @@ begin
       { also get the output from as and ld that writes to stderr sometimes }
       StartTicks:=GetMicroSTicks;
     {$ifndef macos}
-      execres:=ExecuteRedir(CompilerBin,args+wpoargs,'',CompilerLogFile,'stdout');
+      execres:=ExecuteRedir(CompilerBin,args+wpoargs,'',CompilerLogFile+wposuffix,'stdout');
     {$else macos}
       {Due to that Toolserver is not reentrant, we have to asm and link via script.}
-      execres:=ExecuteRedir(CompilerBin,'-s '+args+wpoargs,'',CompilerLogFile,'stdout');
+      execres:=ExecuteRedir(CompilerBin,'-s '+args+wpoargs,'',CompilerLogFile+wposuffix,'stdout');
       if execres then
-        execres:=ExecuteRedir(TestOutputDir + ':ppas','','',CompilerLogFile,'stdout');
+        execres:=ExecuteRedir(TestOutputDir + ':ppas','','',CompilerLogFile+wpo_suffix,'stdout');
     {$endif macos}
       EndTicks:=GetMicroSTicks;
       Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
@@ -913,6 +915,8 @@ begin
           Verbose(V_Normal,'Compilation took '+ToStr(EndTicks-StartTicks)+' us');
         end;
 
+      if passes > 1 then
+        CopyFile(CompilerLogFile+wposuffix,CompilerLogFile,true);
       { Error during execution? }
       if (not execres) and (ExecuteResult=0) then
         begin

tests/webtbf/tw38504.pp

@@ -0,0 +1,11 @@
+{ %fail }
+Var
+  MyVar : char;
+
+Procedure MyProc;
+Begin
+  MyVar := ''; (* <-- two single-quotes *)
+End;
+
+Begin
+End.

tests/webtbf/tw38504b.pp

@@ -0,0 +1,11 @@
+{ %fail }
+Var
+  MyVar : char;
+
+Procedure MyProc;
+Begin
+  MyVar := char('');
+End;
+
+Begin
+End.

tests/webtbs/tw28713.pp

@@ -6,7 +6,14 @@ type
   TWordArray = array [0..1023]of Word;
 
   WordRec = packed record
+{$ifdef FPC}
+{$ifdef FPC_LITTLE_ENDIAN}
     LoByte,HiByte:Byte
+{$endif}
+{$ifdef FPC_BIG_ENDIAN}
+    HiByte,LoByte:Byte
+{$endif}
+{$endif}
   end;
 
 var

tests/webtbs/tw36250.pp

@@ -0,0 +1,15 @@
+{ %norun }
+{ %target=darwin,ios,iphonesim}
+{ %opt=-gw3 }
+
+{$mode objfpc}{$h+}
+{$ModeSwitch objectivec2}
+
+function NSStringToString(ns: NSString): String;
+begin
+    Result := '';
+end;                 
+
+begin
+  WriteLn(NSStringToString(nil));
+end.

tests/webtbs/tw38497.pp

@@ -0,0 +1,24 @@
+program project1;
+
+{$mode delphi}
+
+type
+  TAlphabet = (A, B, C);
+  TAlphabets = set of TAlphabet;
+
+  procedure Test<TEnum, TSet>(E: TEnum; S: TSet);
+  var
+    I: TEnum;
+    B: Boolean;
+  begin
+    B := [E] <= S;
+    if E in S then
+      WriteLn(E);
+    for I := Low(TEnum) to High(TEnum) do
+      if I in S then
+      WriteLn(I);
+  end;
+
+begin
+  Test<TAlphabet, TAlphabets>(A, [A, B]);
+end.

tests/webtbs/tw38527.pp

@@ -0,0 +1,15 @@
+{%OPT=-O2}
+
+{$mode objfpc}
+
+function F(n: SizeUint): SizeUint;
+begin
+    result := 4 * n + 4 * n;
+end;
+
+begin
+    writeln('Reference F(5): ', 4 * 5 + 4 * 5);
+    writeln(' Actual F(5): ', F(5));
+    if (F(5) <> 40) then
+      halt(1);
+end.

tests/webtbs/tw8177.pp

@@ -6,10 +6,7 @@ program ValidateStrToInt;
   {$mode delphi}
 {$ENDIF}
 
-{$ifdef cpuarm}
-  {$define slowcpu}
-{$endif}
-{$ifdef cpumips}
+{$if defined(cpuarm) or defined(cpuavr) or defined(cpui8086) or defined(cpum68k) or defined(cpumips) or defined(cpuz80)}
   {$define slowcpu}
 {$endif}
 {$ifdef android}

utils/json2pas/fpmake.pp

@@ -17,7 +17,7 @@ begin
     P:=AddPackage('utils-json2pas');
     P.Dependencies.Add('fcl-json');
 
-    P.ShortName:='js2p';
+    P.ShortName:='jsnp';
     P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
     if Defaults.CPU=jvm then
       P.OSes := P.OSes - [java,android];