* synchronized with trunk

git-svn-id: branches/wasm@46697 -

compiler/aarch64/aasmcpu.pas

@@ -999,13 +999,11 @@ implementation
            A_SDIV,
            A_SMULL,
            A_SUB,
-           A_SXT,
            A_UBFIZ,
            A_UBFX,
            A_UCVTF,
            A_UDIV,
-           A_UMULL,
-           A_UXT:
+           A_UMULL:
              if opnr=0 then
                result:=operand_write
              else

compiler/powerpc64/cgcpu.pas

@@ -545,7 +545,7 @@ var
   bytesize : byte;
 begin
   {$ifdef extdebug}
-  list.concat(tai_comment.create(strpnew('a_load_reg_reg from : ' + cgsize2string(fromsize) + ' to ' + cgsize2string(tosize))));
+  list.concat(tai_comment.create(strpnew('a_load_reg_reg from : ' + tcgsize2str(fromsize) + ' to ' + tcgsize2str(tosize))));
   {$endif}
 
   if (tcgsize2size[fromsize] > tcgsize2size[tosize]) or
@@ -891,7 +891,7 @@ var
   op : TAsmOp;
 begin
   {$IFDEF EXTDEBUG}
-  list.concat(tai_comment.create(strpnew('a_cmp_const_reg_label ' + cgsize2string(size) + ' ' + booltostr(cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE]) + ' ' + inttostr(a) )));
+  list.concat(tai_comment.create(strpnew('a_cmp_const_reg_label ' + tcgsize2str(size) + ' ' + booltostr(cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE]) + ' ' + inttostr(a) )));
   {$ENDIF EXTDEBUG}
 
   signed := cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE];
@@ -936,7 +936,7 @@ var
   op: tasmop;
 begin
   {$IFDEF extdebug}
-  list.concat(tai_comment.create(strpnew('a_cmp_reg_reg_label, size ' + cgsize2string(size) + ' op ' + inttostr(ord(cmp_op)))));
+  list.concat(tai_comment.create(strpnew('a_cmp_reg_reg_label, size ' + tcgsize2str(size) + ' op ' + inttostr(ord(cmp_op)))));
   {$ENDIF extdebug}
 
   {$note Commented out below check because of compiler weirdness}
@@ -1666,7 +1666,7 @@ const
   overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG];
 begin
   {$IFDEF EXTDEBUG}
-  list.concat(tai_comment.create(strpnew('maybeadjustresult op = ' + cgop2string(op) + ' size = ' + cgsize2string(size))));
+  list.concat(tai_comment.create(strpnew('maybeadjustresult op = ' + cgop2string(op) + ' size = ' + tcgsize2str(size))));
   {$ENDIF EXTDEBUG}
 
   if (op in overflowops) and (size in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32]) then

compiler/powerpc64/hlcgcpu.pas

@@ -59,7 +59,7 @@ implementation
     begin
       subsetcgsize:=def_cgsize(subsetsize);
 {$ifdef extdebug}
-      list.concat(tai_comment.create(strpnew('a_load_subsetreg_reg subsetregsize = ' + cgsize2string(sreg.subsetregsize) + ' subsetsize = ' + cgsize2string(subsetcgsize) + ' startbit = ' + ToStr(sreg.startbit) + ' tosize = ' + cgsize2string(def_cgsize(tosize)))));
+      list.concat(tai_comment.create(strpnew('a_load_subsetreg_reg subsetregsize = ' + tcgsize2str(sreg.subsetregsize) + ' subsetsize = ' + tcgsize2str(subsetcgsize) + ' startbit = ' + ToStr(sreg.startbit) + ' tosize = ' + tcgsize2str(def_cgsize(tosize)))));
 {$endif}
       { do the extraction if required and then extend the sign correctly. (The latter is actually required only for signed subsets
       and if that subset is not >= the tosize). }
@@ -92,7 +92,7 @@ implementation
       tmpreg : TRegister;
     begin
 {$ifdef extdebug}
-      list.concat(tai_comment.create(strpnew('a_load_const_subsetreg subsetregsize = ' + cgsize2string(sreg.subsetregsize) + ' subsetsize = ' + cgsize2string(def_cgsize(tosubsetsize)) + ' startbit = ' + ToStr(sreg.startbit) + ' a = ' + ToStr(a))));
+      list.concat(tai_comment.create(strpnew('a_load_const_subsetreg subsetregsize = ' + tcgsize2str(sreg.subsetregsize) + ' subsetsize = ' + tcgsize2str(def_cgsize(tosubsetsize)) + ' startbit = ' + ToStr(sreg.startbit) + ' a = ' + ToStr(a))));
 {$endif}
       { loading the constant into the lowest bits of a temp register and then inserting is
         better than loading some usually large constants and do some masking and shifting on ppc64 }
@@ -105,7 +105,7 @@ implementation
   procedure thlcgcpu.a_load_regconst_subsetreg_intern(list: TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt);
     begin
 {$ifdef extdebug}
-      list.concat(tai_comment.create(strpnew('a_load_reg_subsetreg fromsize = ' + cgsize2string(def_cgsize(fromsize)) + ' subsetregsize = ' + cgsize2string(sreg.subsetregsize) + ' subsetsize = ' + cgsize2string(def_cgsize(subsetsize)) + ' startbit = ' + ToStr(sreg.startbit))));
+      list.concat(tai_comment.create(strpnew('a_load_reg_subsetreg fromsize = ' + tcgsize2str(def_cgsize(fromsize)) + ' subsetregsize = ' + tcgsize2str(sreg.subsetregsize) + ' subsetsize = ' + tcgsize2str(def_cgsize(subsetsize)) + ' startbit = ' + ToStr(sreg.startbit))));
 {$endif}
       if slopt in [SL_SETZERO,SL_SETMAX] then
         inherited a_load_regconst_subsetreg_intern(list,fromsize,subsetsize,fromreg,sreg,slopt)

compiler/powerpc64/nppcadd.pas

@@ -284,7 +284,7 @@ begin
       ltn, lten, gtn, gten, equaln, unequaln:
         begin
           {$ifdef extdebug}
-          current_asmdata.CurrAsmList.concat(tai_comment.create('tppcaddnode.pass2'));
+          current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('tppcaddnode.pass2')));
           {$endif extdebug}
 
           emit_compare(unsigned);

compiler/ppcgen/cgppc.pas

@@ -126,7 +126,6 @@ unit cgppc;
 
 {$ifdef extdebug}
      function ref2string(const ref : treference) : string;
-     function cgsize2string(const size : TCgSize) : string;
      function cgop2string(const op : TOpCg) : String;
 {$endif extdebug}
 
@@ -151,35 +150,6 @@ unit cgppc;
            result := result + ref.symbol.name;
        end;
 
-     function cgsize2string(const size : TCgSize) : string;
-       const
-       (* TCgSize = (OS_NO,
-                  OS_8,   OS_16,   OS_32,   OS_64,   OS_128,
-                  OS_S8,  OS_S16,  OS_S32,  OS_S64,  OS_S128,
-                 { single, double, extended, comp, float128 }
-                  OS_F32, OS_F64,  OS_F80,  OS_C64,  OS_F128,
-                 { multi-media sizes: split in byte, word, dword, ... }
-                 { entities, then the signed counterparts             }
-                  OS_M8,  OS_M16,  OS_M32,  OS_M64,  OS_M128,  OS_M256,  OS_M512,
-                  OS_MS8, OS_MS16, OS_MS32, OS_MS64, OS_MS128, OS_MS256, OS_MS512,
-                 { multi-media sizes: single-precision floating-point }
-                  OS_MF32, OS_MF128, OS_MF256, OS_MF512,
-                 { multi-media sizes: double-precision floating-point }
-                  OS_MD64, OS_MD128, OS_MD256, OS_MD512); *)
-
-          cgsize_strings : array[TCgSize] of string[8] = (
-           'OS_NO',
-           'OS_8', 'OS_16', 'OS_32', 'OS_64', 'OS_128',
-           'OS_S8', 'OS_S16', 'OS_S32', 'OS_S64', 'OS_S128',
-           'OS_F32', 'OS_F64', 'OS_F80', 'OS_C64', 'OS_F128',
-           'OS_M8', 'OS_M16', 'OS_M32', 'OS_M64', 'OS_M128', 'OS_M256', 'OS_M512',
-           'OS_MS8', 'OS_MS16', 'OS_MS32', 'OS_MS64', 'OS_MS128', 'OS_MS256', 'OS_MS512',
-           'OS_MF32', 'OS_MF128', 'OS_MF256', 'OS_MF512',
-           'OS_MD64', 'OS_MD128', 'OS_MD256', 'OS_MD512');
-       begin
-         result := cgsize_strings[size];
-       end;
-
      function cgop2string(const op : TOpCg) : String;
        const
          opcg_strings : array[TOpCg] of string[6] = (

compiler/riscv/cgrv.pas

@@ -92,7 +92,6 @@ unit cgrv;
 
 {$ifdef extdebug}
      function ref2string(const ref : treference) : string;
-     function cgsize2string(const size : TCgSize) : string;
      function cgop2string(const op : TOpCg) : String;
 {$endif extdebug}
 
@@ -112,35 +111,6 @@ unit cgrv;
            result := result + ref.symbol.name;
        end;
 
-     function cgsize2string(const size : TCgSize) : string;
-       const
-       (* TCgSize = (OS_NO,
-                  OS_8,   OS_16,   OS_32,   OS_64,   OS_128,
-                  OS_S8,  OS_S16,  OS_S32,  OS_S64,  OS_S128,
-                 { single, double, extended, comp, float128 }
-                  OS_F32, OS_F64,  OS_F80,  OS_C64,  OS_F128,
-                 { multi-media sizes: split in byte, word, dword, ... }
-                 { entities, then the signed counterparts             }
-                  OS_M8,  OS_M16,  OS_M32,  OS_M64,  OS_M128,  OS_M256,  OS_M512,
-                  OS_MS8, OS_MS16, OS_MS32, OS_MS64, OS_MS128, OS_MS256, OS_MS512,
-                 { multi-media sizes: single-precision floating-point }
-                  OS_MF32, OS_MF128, OS_MF256, OS_MF512,
-                 { multi-media sizes: double-precision floating-point }
-                  OS_MD64, OS_MD128, OS_MD256, OS_MD512); *)
-
-          cgsize_strings : array[TCgSize] of string[8] = (
-           'OS_NO',
-           'OS_8', 'OS_16', 'OS_32', 'OS_64', 'OS_128',
-           'OS_S8', 'OS_S16', 'OS_S32', 'OS_S64', 'OS_S128',
-           'OS_F32', 'OS_F64', 'OS_F80', 'OS_C64', 'OS_F128',
-           'OS_M8', 'OS_M16', 'OS_M32', 'OS_M64', 'OS_M128', 'OS_M256', 'OS_M512',
-           'OS_MS8', 'OS_MS16', 'OS_MS32', 'OS_MS64', 'OS_MS128', 'OS_MS256', 'OS_MS512',
-           'OS_MF32', 'OS_MF128', 'OS_MF256', 'OS_MF512',
-           'OS_MD64', 'OS_MD128', 'OS_MD256', 'OS_MD512');
-       begin
-         result := cgsize_strings[size];
-       end;
-
      function cgop2string(const op : TOpCg) : String;
        const
          opcg_strings : array[TOpCg] of string[6] = (

compiler/riscv64/hlcgcpu.pas

@@ -58,7 +58,7 @@ implementation
       tmpreg : TRegister;
     begin
 {$ifdef extdebug}
-      list.concat(tai_comment.create(strpnew('a_load_const_subsetreg subsetregsize = ' + cgsize2string(sreg.subsetregsize) + ' subsetsize = ' + cgsize2string(def_cgsize(tosubsetsize)) + ' startbit = ' + ToStr(sreg.startbit) + ' a = ' + ToStr(a))));
+      list.concat(tai_comment.create(strpnew('a_load_const_subsetreg subsetregsize = ' + tcgsize2str(sreg.subsetregsize) + ' subsetsize = ' + tcgsize2str(def_cgsize(tosubsetsize)) + ' startbit = ' + ToStr(sreg.startbit) + ' a = ' + ToStr(a))));
 {$endif}
       { loading the constant into the lowest bits of a temp register and then inserting is
         better than loading some usually large constants and do some masking and shifting on riscv64 }

compiler/xtensa/cgcpu.pas

@@ -744,9 +744,7 @@ implementation
               else
                 Internalerror(2020031401);
             end;
-          end
-        else if target_info.abi=abi_xtensa_windowed then
-          list.concat(taicpu.op_reg_const(A_ENTRY,NR_STACK_POINTER_REG,16));
+          end;
       end;
 
 

compiler/xtensa/ncpumat.pas

@@ -118,7 +118,7 @@ implementation
         if is_64bit(resultdef) then
           begin
             if not(left.location.loc in [LOC_CREGISTER,LOC_REGISTER]) then
-              hlcg.location_force_reg(current_asmdata.CurrAsmList,location,resultdef,resultdef,false);
+              hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,resultdef,resultdef,false);
             hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
             cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT,left.location.register64.reglo,left.location.register64.reghi,hreg1);
             hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);

packages/fcl-passrc/src/pasresolver.pp

@@ -2212,8 +2212,7 @@ type
     procedure CheckUseAsType(aType: TPasElement; id: TMaxPrecInt;
       ErrorEl: TPasElement);
     function CheckCallProcCompatibility(ProcType: TPasProcedureType;
-      Params: TParamsExpr; RaiseOnError: boolean;
-      SetReferenceFlags: boolean = false): integer;
+      Params: TParamsExpr; RaiseOnError: boolean; SetReferenceFlags: boolean = false): integer;
     function CheckCallPropertyCompatibility(PropEl: TPasProperty;
       Params: TParamsExpr; RaiseOnError: boolean): integer;
     function CheckCallArrayCompatibility(ArrayEl: TPasArrayType;
@@ -10864,6 +10863,11 @@ begin
         [GetElementTypeName(FoundEl)+' '+FoundEl.Name],NameExpr);
     CheckTemplParams(GenTemplates,TemplParams);
     FoundEl:=GetSpecializedEl(NameExpr,FoundEl,TemplParams);
+    if FoundEl is TPasProcedure then
+      begin
+      // check if params fit the implicit specialized function
+      CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true);
+      end;
     end
   else if (GenTemplates<>nil) and (GenTemplates.Count>0) then
     begin
@@ -10875,12 +10879,12 @@ begin
       try
         CheckTemplParams(GenTemplates,InferenceParams);
         FoundEl:=GetSpecializedEl(NameExpr,FoundEl,InferenceParams);
+        // check if params fit the implicit specialized function
+        CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true);
       finally
         ReleaseElementList(InferenceParams{$IFDEF CheckPasTreeRefCount},RefIdInferenceParamsExpr{$ENDIF});
         FreeAndNil(InferenceParams);
       end;
-      // check if params fit the implicit specialized function
-      CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true);
       end
     else
       // GenericType()  -> missing type params
@@ -23065,11 +23069,11 @@ begin
 
   Value:=Params.Value;
   if Value is TBinaryExpr then
-    Value:=TBinaryExpr(Value).right;
+    Value:=TBinaryExpr(Value).right; // Note: parser guarantees that this is the rightmost
 
   // check args
   ParamCnt:=length(Params.Params);
-  ArgResolved.BaseType:=btNone;;
+  ArgResolved.BaseType:=btNone;
   i:=0;
   while i<ParamCnt do
     begin
@@ -29350,9 +29354,47 @@ end;
 
 function TPasResolver.CheckClassIsClass(SrcType, DestType: TPasType): integer;
 // check if Src is equal or descends from Dest
+// Generics: TBird<T> is both directions a TBird<word>
+//       and TBird<TMap<T>> is both directions a TBird<TMap<word>>
+
+  function CheckSpecialized(SrcScope, DestScope: TPasGenericScope): boolean;
+  var
+    SrcParams, DestParams: TPasTypeArray;
+    i: Integer;
+    SrcParam, DestParam: TPasType;
+    SrcParamScope, DestParamScope: TPasGenericScope;
+  begin
+    if SrcScope.SpecializedFromItem.GenericEl<>DestScope.SpecializedFromItem.GenericEl then
+      exit(false);
+    // specialized from same generic -> check params
+    SrcParams:=SrcScope.SpecializedFromItem.Params;
+    DestParams:=DestScope.SpecializedFromItem.Params;
+    for i:=0 to length(SrcParams)-1 do
+      begin
+      SrcParam:=SrcParams[i];
+      DestParam:=DestParams[i];
+      if (SrcParam is TPasGenericTemplateType)
+          or (DestParam is TPasGenericTemplateType)
+          or (SrcParam=DestParam)
+      then
+        // ok
+      else if (SrcParam is TPasGenericType) and (DestParam is TPasGenericType) then
+        begin
+        // e.g. TList<Src<...>> and TList<Dest<...>>
+        SrcParamScope:=SrcParam.CustomData as TPasGenericScope;
+        DestParamScope:=DestParam.CustomData as TPasGenericScope;
+        if not CheckSpecialized(SrcParamScope,DestParamScope) then
+          exit(false);
+        end
+      else
+        exit(false); // specialized with different params -> incompatible
+      end;
+    Result:=true;
+  end;
+
 var
-  ClassEl: TPasClassType;
-  DestScope: TPasClassScope;
+  SrcClassEl: TPasClassType;
+  SrcScope, DestScope: TPasClassScope;
   GenericType: TPasGenericType;
 begin
   {$IFDEF VerbosePasResolver}
@@ -29362,6 +29404,7 @@ begin
   DestType:=ResolveAliasType(DestType);
   if DestType.ClassType<>TPasClassType then
     exit(cIncompatible);
+  DestScope:=DestType.CustomData as TPasClassScope;
 
   Result:=cExact;
   while SrcType<>nil do
@@ -29390,16 +29433,15 @@ begin
       end
     else if SrcType.ClassType=TPasClassType then
       begin
-      ClassEl:=TPasClassType(SrcType);
-      if ClassEl.IsForward then
+      SrcClassEl:=TPasClassType(SrcType);
+      if SrcClassEl.IsForward then
         // class forward -> skip
-        SrcType:=(ClassEl.CustomData as TResolvedReference).Declaration as TPasType
+        SrcType:=(SrcClassEl.CustomData as TResolvedReference).Declaration as TPasType
       else
         begin
-        if (ClassEl.GenericTemplateTypes<>nil) and (ClassEl.GenericTemplateTypes.Count>0) then
+        if (SrcClassEl.GenericTemplateTypes<>nil) and (SrcClassEl.GenericTemplateTypes.Count>0) then
           begin
           // SrcType is a generic
-          DestScope:=DestType.CustomData as TPasClassScope;
           if DestScope.SpecializedFromItem<>nil then
             begin
             // DestType is specialized
@@ -29411,8 +29453,14 @@ begin
               exit; // DestType is a specialized SrcType
             end;
           end;
+        SrcScope:=SrcClassEl.CustomData as TPasClassScope;
+        if (SrcScope.SpecializedFromItem<>nil)
+            and (DestScope.SpecializedFromItem<>nil)
+            and CheckSpecialized(SrcScope,DestScope) then
+          exit;
+
         // class ancestor -> increase distance
-        SrcType:=(ClassEl.CustomData as TPasClassScope).DirectAncestor;
+        SrcType:=SrcScope.DirectAncestor;
         inc(Result);
         end;
       end

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -31,8 +31,7 @@ type
     procedure TestGen_ConstraintArrayFail;
     procedure TestGen_ConstraintConstructor;
     procedure TestGen_ConstraintUnit;
-    // ToDo: constraint T:Unit2.TBird
-    // ToDo: constraint T:Unit2.TGen<word>
+    // ToDo: constraint T:Unit2.specialize TGen<word>
     procedure TestGen_ConstraintSpecialize;
     procedure TestGen_ConstraintTSpecializeWithT;
     procedure TestGen_ConstraintTSpecializeAsTFail; // TBird<T; U: T<word>>  and no T<>
@@ -54,7 +53,7 @@ type
     procedure TestGen_Record_SpecializeSelfInsideFail;
     procedure TestGen_Record_ReferGenericSelfFail;
     procedure TestGen_RecordAnoArray;
-    // ToDo: unitname.specialize TBird<word>.specialize
+    // ToDo: unitname.specialize TBird<word>.specialize TAnt<word>
     procedure TestGen_RecordNestedSpecialize;
 
     // generic class
@@ -151,6 +150,7 @@ type
     procedure TestGenProc_TypeParamCntOverload;
     procedure TestGenProc_TypeParamCntOverloadNoParams;
     procedure TestGenProc_TypeParamWithDefaultParamDelphiFail;
+    procedure TestGenProc_ParamSpecWithT; // ToDo: Func<T>(Bird: TBird<T>)
     // ToDo: NestedResultAssign
 
     // generic function infer types
@@ -2427,6 +2427,31 @@ begin
   CheckResolverException(sParamOfThisTypeCannotHaveDefVal,nParamOfThisTypeCannotHaveDefVal);
 end;
 
+procedure TTestResolveGenerics.TestGenProc_ParamSpecWithT;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TBird<T> = class v: T; end;',
+  '  TAnt = class',
+  '    procedure Func<T: class>(Bird: TBird<T>);',
+  '  end;',
+  'procedure TAnt.Func<T>(Bird: TBird<T>);',
+  'begin',
+  'end;',
+  'var',
+  '  Ant: TAnt;',
+  '  Bird: TBird<TObject>;',
+  '  BirdOfBird: TBird<TBird<TObject>>;',
+  'begin',
+  '  Ant.Func<TObject>(Bird);',
+  '  Ant.Func<TBird<TObject>>(BirdOfBird);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGenProc_Infer_NeedExplicitFail;
 begin
   StartProgram(false);

packages/fpmkunit/src/fpmkunit.pp

@@ -8204,7 +8204,7 @@ procedure TBuildEngine.Compile(Packages: TPackages);
 Var
   I : integer;
 {$ifndef NO_THREADING}
-  Thr : Integer;
+  Thr, ThreadCount : Integer;
   Finished : boolean;
   ErrorState: boolean;
   ErrorMessage: string;
@@ -8234,7 +8234,7 @@ Var
             else // A problem occurred, stop the compilation
               begin
               ErrorState:=true;
-              ErrorMessage:=AThread.ErrorMessage;
+              ErrorMessage:='Error inside worker thread for package '+Athread.APackage.Name+': '+AThread.ErrorMessage;
               Finished:=true;
               end;
             AThread.APackage := nil;
@@ -8299,34 +8299,71 @@ begin
       ErrorState := False;
       Finished := False;
       I := 0;
+      ThreadCount:=0;
       // This event is set by the worker-threads to notify the main/this thread
       // that a package finished it's task.
       NotifyThreadWaiting := RTLEventCreate;
       SetLength(Threads,Defaults.ThreadsAmount);
-      // Create all worker-threads
-      for Thr:=0 to Defaults.ThreadsAmount-1 do
-        Threads[Thr] := TCompileWorkerThread.Create(self,NotifyThreadWaiting);
-      try
-        // When a thread notifies this thread that it is ready, loop on all
-        // threads to check their state and if possible assign a new package
-        // to them to compile.
-        while not Finished do
-          begin
-            RTLeventWaitFor(NotifyThreadWaiting);
-            for Thr:=0 to Defaults.ThreadsAmount-1 do if not Finished then
-              ProcessThreadResult(Threads[Thr]);
-          end;
-        // Compilation finished or aborted. Wait for all threads to end.
-        for thr:=0 to Defaults.ThreadsAmount-1 do
-          begin
-            Threads[Thr].Terminate;
-            RTLeventSetEvent(Threads[Thr].NotifyStartTask);
-            Threads[Thr].WaitFor;
-          end;
+      try 
+        // Create all worker-threads
+        try
+          for Thr:=0 to Defaults.ThreadsAmount-1 do
+            begin
+              Threads[Thr] := TCompileWorkerThread.Create(self,NotifyThreadWaiting);
+              if assigned(Threads[Thr]) then
+                inc(ThreadCount);
+            end;
+        except
+          on E: Exception do
+            begin
+              ErrorMessage := E.Message;
+              ErrorState:=true;
+            end;
+        end;
+        try
+          // When a thread notifies this thread that it is ready, loop on all
+          // threads to check their state and if possible assign a new package
+          // to them to compile.
+          while not Finished do
+            begin
+              RTLeventWaitFor(NotifyThreadWaiting);
+              for Thr:=0 to Defaults.ThreadsAmount-1 do
+                if assigned(Threads[Thr]) and not Finished then
+                  ProcessThreadResult(Threads[Thr]);
+            end;
+        except
+          on E: Exception do
+            begin
+              if not ErrorState then
+                ErrorMessage := E.Message;
+              ErrorState:=true;
+            end;
+        end;
+        try
+          // Compilation finished or aborted. Wait for all threads to end.
+          for thr:=0 to Defaults.ThreadsAmount-1 do
+            if assigned(Threads[Thr]) then
+              begin
+                Threads[Thr].Terminate;
+                RTLeventSetEvent(Threads[Thr].NotifyStartTask);
+                Threads[Thr].WaitFor;
+              end;
+        except
+          on E: Exception do
+            begin
+              if not ErrorState then
+                ErrorMessage := E.Message;
+              ErrorState:=true;
+            end;
+        end;
       finally
         RTLeventdestroy(NotifyThreadWaiting);
         for thr:=0 to Defaults.ThreadsAmount-1 do
-          Threads[Thr].Free;
+          if assigned(Threads[Thr]) then
+            begin
+              Threads[Thr].Free;
+              dec(ThreadCount);
+            end;
       end;
     if ErrorState then
       raise Exception.Create(ErrorMessage);

rtl/embedded/rtl.cfg

@@ -9,12 +9,3 @@
 -CX
 -XX
 #endif
-
-# does not require extra memory, neither code nor data
-# in programs not using e. g. writeln based I/O which is the common case
-#ifdef CPUZ80
--SfOBJECTS
--SfEXCEPTIONS
--SfCLASSES
--SfRTTI
-#endif

rtl/embedded/system.cfg

@@ -265,6 +265,12 @@
 -SfRESOURCES
 #endif CPUXTENSA
 
+# does not require extra memory, neither code nor data
+# in programs not using e. g. writeln based I/O which is the common case
 #ifdef CPUZ80
+-SfOBJECTS
+-SfEXCEPTIONS
+-SfCLASSES
+-SfRTTI
 -SfSOFTFPU
-#endif CPUZ80
+#endif

rtl/freertos/xtensa/esp32.pp

@@ -46,29 +46,10 @@ unit esp32;
     function getchar : char;external;
     function __getreent : pointer;external;
     procedure fflush(f : pointer);external;
+    procedure vTaskDelay(xTicksToDelay: uint32); external;
 
-    procedure printpchar(p : pchar);
+    procedure flushOutput(var t : TextRec);
       begin
-        while p^<>#0 do
-           begin
-             putchar(p^);
-             inc(p);
-           end;
-        fflush(ppointer(__getreent+8)^);
-      end;
-
-
-    procedure printdword(d : dword);
-      const
-        s = '0123456789ABCDEF';
-      var
-        i : longint;
-      begin
-        for i:=1 to 8 do
-           begin
-             putchar(s[(d and $f)+1]);
-             d:=d shr 4;
-           end;
         fflush(ppointer(__getreent+8)^);
       end;
 
@@ -94,6 +75,7 @@ unit esp32;
         _FPC_haltproc;
       end;
 
+
     function WriteChar(ACh: char; AUserData: pointer): boolean;
       begin
         WriteChar:=true;

rtl/inc/softfpu.pp

@@ -562,6 +562,17 @@ implementation
 
 
 {$if not(defined(fpc_softfpu_interface))}
+
+{$ifdef FPC}
+  { disable range and overflow checking explicitly }
+  { This might be more essential for x80 and 128-bit
+    floating point types and could, maybe be
+    restricted to code handle flatx80 and float128 }
+  {$push}
+  {$R-}
+  {$Q-}
+{$endif FPC}
+
 (*****************************************************************************)
 (*----------------------------------------------------------------------------*)
 (* Primitive arithmetic functions, including multi-word arithmetic, and       *)
@@ -9373,4 +9384,10 @@ end;
 
 end.
 
+{$ifdef FPC}
+  { restore context modified at implmentation start
+    to possibly re-enable range and overflow checking explicitly}
+  {$pop}
+{$endif FPC}
+
 {$endif not(defined(fpc_softfpu_interface)) and not(defined(fpc_softfpu_implementation))}

rtl/xtensa/setjump.inc

@@ -15,8 +15,8 @@
  **********************************************************************}
 
 
-function fpc_setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP']; compilerproc; nostackframe;
 {$ifdef fpc_abi_call0}
+function fpc_setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP']; compilerproc; nostackframe;
   asm
     s32i.n a0,S.a0
     s32i.n a1,S.a1
@@ -27,16 +27,9 @@ function fpc_setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_S
     s32i.n a15,S.a15
     movi.n a2,0
   end;
-{$endif fpc_abi_call0}
-{$ifdef fpc_abi_windowed}
-  asm
-    movi a2,0
-  end;
-{$endif fpc_abi_windowed}
 
 
 procedure fpc_longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP']; compilerproc; nostackframe;
-{$ifdef fpc_abi_call0}
   asm
     l32i.n a0,S.a0
     l32i.n a1,S.a1
@@ -48,9 +41,30 @@ procedure fpc_longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias
     movi.n a2,1
     movnez a2,value,value
   end;
-{$endif fpc_abi_call0}
-{$ifdef fpc_abi_windowed}
+{$elseif defined(freertos) and defined(fpc_abi_windowed)}
+
+function fpc_setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP']; compilerproc; nostackframe;
+  asm
+    j.l setjmp,a15
+  end;
+
+
+procedure fpc_longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP']; compilerproc; nostackframe;
+  asm
+    j.l longjmp,a15
+  end;
+
+{$else}
+function fpc_setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP']; compilerproc; external;
+  asm
+    entry a1,16
+    movi.n a2,0
+  end;
+
+
+procedure fpc_longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP']; compilerproc; external;
   asm
+    entry a1,16
   end;
-{$endif fpc_abi_windowed}
+{$endif}
 

rtl/xtensa/setjumph.inc

@@ -22,11 +22,15 @@ type
 {$endif fpc_abi_call0}
 {$ifdef fpc_abi_windowed}
    jmp_buf = record
+     data : array[0..16] of DWord;
    end;
 {$endif fpc_abi_windowed}
    pjmp_buf = ^jmp_buf;
 
+{$if defined(freertos) and defined(fpc_abi_windowed)}
+function setjmp(var S : jmp_buf) : longint;external;
+procedure longjmp(var S : jmp_buf;value : longint);external;
+{$else defined(freertos) and defined(fpc_abi_windowed)}
 function setjmp(var S : jmp_buf) : longint;[external name 'FPC_SETJMP'];
 procedure longjmp(var S : jmp_buf;value : longint);[external name 'FPC_LONGJMP'];
-
-
+{$endif defined(freertos) and defined(fpc_abi_windowed)}

tests/test/opt/tcse2.pp

@@ -2,8 +2,8 @@
 {$r+}
 
 type
-  tsubr = 1..100000;
-  tarr = array[1..100000] of longint;
+  tsubr = 1..10;
+  tarr = array[1..10] of longint;
 
 function test(b: tsubr): longint;
 begin
@@ -17,7 +17,7 @@ var
 
 begin
   getmem(p,4);
-  p^ := 100000;
+  p^ := 10;
   l := 5;
   { clear the optimizer state }
   asm
@@ -41,7 +41,7 @@ begin
   {                                                                     }
   { and as such the "pushl (%eax)" pushes a wrong value afterwards      }
   l := test(p^);
-  if l <> 100000 then
+  if l <> 10 then
     begin
       writeln('Problem 1!');
       halt(1);