* synchronized with trunk

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

.gitattributes

@@ -16740,6 +16740,7 @@ tests/webtbf/tw36720.pp svneol=native#text/pascal
 tests/webtbf/tw3680.pp svneol=native#text/plain
 tests/webtbf/tw36975.pp svneol=native#text/pascal
 tests/webtbf/tw3716.pp svneol=native#text/plain
+tests/webtbf/tw37217.pp svneol=native#text/pascal
 tests/webtbf/tw37272b.pp svneol=native#text/pascal
 tests/webtbf/tw37303.pp -text svneol=native#text/pascal
 tests/webtbf/tw3738.pp svneol=native#text/plain
@@ -18687,7 +18688,10 @@ tests/webtbs/tw38309.pp svneol=native#text/pascal
 tests/webtbs/tw38310a.pp svneol=native#text/pascal
 tests/webtbs/tw38310b.pp svneol=native#text/pascal
 tests/webtbs/tw38310c.pp svneol=native#text/pascal
+tests/webtbs/tw38316.pp svneol=native#text/plain
 tests/webtbs/tw3833.pp svneol=native#text/plain
+tests/webtbs/tw38337.pp svneol=native#text/plain
+tests/webtbs/tw38339.pp svneol=native#text/plain
 tests/webtbs/tw3840.pp svneol=native#text/plain
 tests/webtbs/tw3841.pp svneol=native#text/plain
 tests/webtbs/tw3863.pp svneol=native#text/plain

compiler/aoptobj.pas

@@ -1382,12 +1382,10 @@ Unit AoptObj;
         removedSomething := false;
         firstRemovedWasAlloc := false;
 {$ifdef allocregdebug}
-        hp := tai_comment.Create(strpnew('allocating '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+
-          ' from here...'));
-        insertllitem(asml,p1.previous,p1,hp);
-        hp := tai_comment.Create(strpnew('allocated '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+
-          ' till here...'));
-        insertllitem(asml,p2,p2.next,hp);
+        hp := tai_comment.Create(strpnew('allocating '+std_regname(reg)+' from here...'));
+        insertllitem(p1.previous,p1,hp);
+        hp := tai_comment.Create(strpnew('allocated '+std_regname(reg)+' till here...'));
+        insertllitem(p2,p2.next,hp);
 {$endif allocregdebug}
         { do it the safe way: always allocate the full super register,
           as we do no register re-allocation in the peephole optimizer,

compiler/fpcdefs.inc

@@ -31,6 +31,31 @@
   {$define USEINLINE}
 {$endif EXTDEBUG}
 
+{$ifdef DEBUG_ALL_OPT}
+  { for aopt unit }
+  {$define DEBUG_OPTALLOC}
+  {$define DEBUG_INSTRUCTIONREGISTERDEPENDENCIES}
+  {for CPU/aoptcpu unit }
+  {$define DEBUG_AOPTCPU}
+  {$define DEBUG_PREREGSCHEDULER (arm specific) }
+  { for aoptobj unit }
+  {$define DEBUG_AOPTOBJ}
+  {$define ALLOCREGDEBUG}
+  { for optconstprop unit }
+  {$define DEBUG_CONSTPROP}
+  { for optcse unit }
+  {$define CSEDEBUG}
+  { for optdeadstore unit }
+  {$define DEBUG_DEADSTORE}
+  { for optdfa unit }
+  {$define DEBUG_DFA}
+  { for optloop unit }
+  {$define DEBUG_OPTFORLOOP}
+  {$define DEBUG_OPTSTRENGTH}
+  { for optvirt unit }
+  {$define DEBUG_DEVIRT}
+{$endif}
+
 {$define USEEXCEPT}
 
 {$ifdef VER3_0}

compiler/i386/aoptcpu.pas

@@ -137,6 +137,8 @@ unit aoptcpu;
               if InsContainsSegRef(taicpu(p)) then
                 exit;
               case taicpu(p).opcode Of
+                A_ADD:
+                  Result:=OptPass1ADD(p);
                 A_AND:
                   Result:=OptPass1And(p);
                 A_IMUL:

compiler/msg/errore.msg

@@ -1555,7 +1555,7 @@ parser_w_ptr_type_ignored=03338_W_Pointer type "$1" ignored
 % The specified pointer type modifier is ignored, because it is not supported on
 % the current platform. This happens, for example, when a far pointer is
 % declared on a non-x86 platform.
-parser_e_global_generic_references_static=03339_E_Global Generic template references static symtable
+parser_e_global_generic_references_static=03339_E_Generic template in interface section references symbol in implementation section
 % A generic declared in the interface section of a unit must not reference symbols that belong
 % solely to the implementation section of that unit.
 parser_u_already_compiled=03340_UL_Unit $1 has been already compiled meanwhile.
@@ -1622,6 +1622,8 @@ parser_e_location_regpair_only_data=03358_E_Only data registers are supported fo
 % AmigaOS/MorphOS syscall specific: for 64bit register pairs, only data registers are supported
 parser_e_location_regpair_only_consecutive=03359_E_Only consecutive registers are supported for explicit location register pairs
 % MorphOS syscall specific: only consecutive (f.e.: d1-d2) registers are supported for 64bit register pairs
+parser_e_constructurs_cannot_take_type_parameters=03360_E_Constructors cannot take type parameters
+% The use of type parameters in constructors is not allowed.
 %
 % \end{description}
 %

compiler/msgidx.inc

@@ -471,6 +471,7 @@ const
   parser_e_location_size_too_large=03357;
   parser_e_location_regpair_only_data=03358;
   parser_e_location_regpair_only_consecutive=03359;
+  parser_e_constructurs_cannot_take_type_parameters=03360;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -1135,9 +1136,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 86847;
+  MsgTxtSize = 86927;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,107,360,130,99,63,145,36,223,68,
+    28,107,361,130,99,63,145,36,223,68,
     63,20,30,1,1,1,1,1,1,1
   );

compiler/ncal.pas

@@ -928,7 +928,10 @@ implementation
                   reused above) }
                 left:=ctemprefnode.create(paratemp);
               end;
+            { add the finish statements to the call cleanup block }
             addstatement(finistat,ctempdeletenode.create(paratemp));
+            aktcallnode.add_done_statement(finiblock);
+
             firstpass(fparainit);
             firstpass(left);
           end;

compiler/pdecsub.pas

@@ -1133,61 +1133,70 @@ implementation
 
         if assigned(genericparams) then
           begin
-            include(pd.defoptions,df_generic);
-            { push the parameter symtable so that constraint definitions are added
-              there and not in the owner symtable }
-            symtablestack.push(pd.parast);
-            { register the parameters }
-            for i:=0 to genericparams.count-1 do
+            if potype=potype_constructor then
               begin
-                 tsym(genericparams[i]).register_sym;
-                 if tsym(genericparams[i]).typ=typesym then
-                   tstoreddef(ttypesym(genericparams[i]).typedef).register_def;
-              end;
-            insert_generic_parameter_types(pd,nil,genericparams);
-            { the list is no longer required }
-            genericparams.free;
-            genericparams:=nil;
-            symtablestack.pop(pd.parast);
-            parse_generic:=true;
-            { also generate a dummy symbol if none exists already }
-            if assigned(astruct) then
-              dummysym:=tsym(astruct.symtable.find(spnongen))
+                Message(parser_e_constructurs_cannot_take_type_parameters);
+                genericparams.free;
+                genericparams:=nil;
+              end
             else
               begin
-                dummysym:=tsym(symtablestack.top.find(spnongen));
-                if not assigned(dummysym) and
-                    (symtablestack.top=current_module.localsymtable) and
-                    assigned(current_module.globalsymtable) then
-                  dummysym:=tsym(current_module.globalsymtable.find(spnongen));
-              end;
-            if not assigned(dummysym) then
-              begin
-                { overloading generic routines with non-generic types is not
-                  allowed, so we create a procsym as dummy }
-                dummysym:=cprocsym.create(orgspnongen);
+                include(pd.defoptions,df_generic);
+                { push the parameter symtable so that constraint definitions are added
+                  there and not in the owner symtable }
+                symtablestack.push(pd.parast);
+                { register the parameters }
+                for i:=0 to genericparams.count-1 do
+                  begin
+                     tsym(genericparams[i]).register_sym;
+                     if tsym(genericparams[i]).typ=typesym then
+                       tstoreddef(ttypesym(genericparams[i]).typedef).register_def;
+                  end;
+                insert_generic_parameter_types(pd,nil,genericparams);
+                { the list is no longer required }
+                genericparams.free;
+                genericparams:=nil;
+                symtablestack.pop(pd.parast);
+                parse_generic:=true;
+                { also generate a dummy symbol if none exists already }
                 if assigned(astruct) then
-                  astruct.symtable.insert(dummysym)
+                  dummysym:=tsym(astruct.symtable.find(spnongen))
                 else
-                  symtablestack.top.insert(dummysym);
-              end
-            else if (dummysym.typ<>procsym) and
-                (
-                  { show error only for the declaration, not also the implementation }
-                  not assigned(astruct) or
-                  (symtablestack.top.symtablelevel<>main_program_level)
-                ) then
-              Message1(sym_e_duplicate_id,dummysym.realname);
-            if not (sp_generic_dummy in dummysym.symoptions) then
-              begin
-                include(dummysym.symoptions,sp_generic_dummy);
-                add_generic_dummysym(dummysym);
+                  begin
+                    dummysym:=tsym(symtablestack.top.find(spnongen));
+                    if not assigned(dummysym) and
+                        (symtablestack.top=current_module.localsymtable) and
+                        assigned(current_module.globalsymtable) then
+                      dummysym:=tsym(current_module.globalsymtable.find(spnongen));
+                  end;
+                if not assigned(dummysym) then
+                  begin
+                    { overloading generic routines with non-generic types is not
+                      allowed, so we create a procsym as dummy }
+                    dummysym:=cprocsym.create(orgspnongen);
+                    if assigned(astruct) then
+                      astruct.symtable.insert(dummysym)
+                    else
+                      symtablestack.top.insert(dummysym);
+                  end
+                else if (dummysym.typ<>procsym) and
+                    (
+                      { show error only for the declaration, not also the implementation }
+                      not assigned(astruct) or
+                      (symtablestack.top.symtablelevel<>main_program_level)
+                    ) then
+                  Message1(sym_e_duplicate_id,dummysym.realname);
+                if not (sp_generic_dummy in dummysym.symoptions) then
+                  begin
+                    include(dummysym.symoptions,sp_generic_dummy);
+                    add_generic_dummysym(dummysym);
+                  end;
+                if dummysym.typ=procsym then
+                  tprocsym(dummysym).add_generic_overload(aprocsym);
+                { start token recorder for the declaration }
+                pd.init_genericdecl;
+                current_scanner.startrecordtokens(pd.genericdecltokenbuf);
               end;
-            if dummysym.typ=procsym then
-              tprocsym(dummysym).add_generic_overload(aprocsym);
-            { start token recorder for the declaration }
-            pd.init_genericdecl;
-            current_scanner.startrecordtokens(pd.genericdecltokenbuf);
           end
         else if assigned(genericdef) then
           insert_generic_parameter_types(pd,tstoreddef(genericdef),generictypelist);

compiler/x86/aoptx86.pas

@@ -122,6 +122,7 @@ unit aoptx86;
         function PrePeepholeOptSxx(var p : tai) : boolean;
         function PrePeepholeOptIMUL(var p : tai) : boolean;
 
+        function OptPass1Add(var p: tai): boolean;
         function OptPass1AND(var p : tai) : boolean;
         function OptPass1_V_MOVAP(var p : tai) : boolean;
         function OptPass1VOP(var p : tai) : boolean;
@@ -3171,6 +3172,42 @@ unit aoptx86;
       end;
 
 
+    function TX86AsmOptimizer.OptPass1Add(var p : tai) : boolean;
+      var
+        hp1 : tai;
+      begin
+        result:=false;
+        { replace
+            addX     const,%reg1
+            leaX     (%reg1,%reg1,Y),%reg2   // Base or index might not be equal to reg1
+            dealloc  %reg1
+
+            by
+
+            leaX     const+const*Y(%reg1,%reg1,Y),%reg2
+        }
+        if MatchOpType(taicpu(p),top_const,top_reg) and
+          GetNextInstruction(p,hp1) and
+          MatchInstruction(hp1,A_LEA,[taicpu(p).opsize]) and
+          ((taicpu(p).oper[1]^.reg=taicpu(hp1).oper[0]^.ref^.base) or
+           (taicpu(p).oper[1]^.reg=taicpu(hp1).oper[0]^.ref^.index)) then
+          begin
+            TransferUsedRegs(TmpUsedRegs);
+            UpdateUsedRegs(TmpUsedRegs, tai(p.next));
+            if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,TmpUsedRegs)) then
+              begin
+                DebugMsg(SPeepholeOptimization + 'AddLea2Lea done',p);
+                if taicpu(p).oper[1]^.reg=taicpu(hp1).oper[0]^.ref^.base then
+                  inc(taicpu(hp1).oper[0]^.ref^.offset,taicpu(p).oper[0]^.val);
+                if taicpu(p).oper[1]^.reg=taicpu(hp1).oper[0]^.ref^.index then
+                  inc(taicpu(hp1).oper[0]^.ref^.offset,taicpu(p).oper[0]^.val*max(taicpu(hp1).oper[0]^.ref^.scalefactor,1));
+                RemoveCurrentP(p);
+                result:=true;
+              end;
+          end;
+      end;
+
+
     function TX86AsmOptimizer.OptPass1LEA(var p : tai) : boolean;
       var
         hp1, hp2, hp3: tai;
@@ -3350,7 +3387,11 @@ unit aoptx86;
                ) 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) 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
@@ -4945,7 +4986,7 @@ unit aoptx86;
         MinSize, MaxSize, TrySmaller, TargetSize: TOpSize;
         TargetSubReg: TSubRegister;
         hp1, hp2: tai;
-        RegInUse, p_removed: Boolean;
+        RegInUse, RegChanged, p_removed: Boolean;
 
         { Store list of found instructions so we don't have to call
           GetNextInstructionUsingReg multiple times }
@@ -4995,6 +5036,7 @@ unit aoptx86;
         TrySmallerLimit := UpperLimit;
         TrySmaller := S_NO;
         SmallerOverflow := False;
+        RegChanged := False;
 
         while GetNextInstructionUsingReg(hp1, hp1, ThisReg) and
           (hp1.typ = ait_instruction) and
@@ -5377,6 +5419,7 @@ unit aoptx86;
                             begin
                               DebugMsg(SPeepholeOptimization + 'Simplified register usage so ' + debug_regname(taicpu(hp1).oper[1]^.reg) + ' = ' + debug_regname(taicpu(p).oper[1]^.reg), p);
                               ThisReg := taicpu(hp1).oper[1]^.reg;
+                              RegChanged := True;
 
                               TransferUsedRegs(TmpUsedRegs);
                               AllocRegBetween(ThisReg, p, hp1, TmpUsedRegs);
@@ -5411,9 +5454,12 @@ unit aoptx86;
                   { Now go through every instruction we found and change the
                     size. If TargetSize = MaxSize, then almost no changes are
                     needed and Result can remain False if it hasn't been set
-                    yet. }
+                    yet.
+
+                    If RegChanged is True, then the register requires changing
+                    and so the point about TargetSize = MaxSize doesn't apply. }
 
-                  if (TargetSize <> MaxSize) and (InstrMax >= 0) then
+                  if ((TargetSize <> MaxSize) or RegChanged) and (InstrMax >= 0) then
                     begin
                       for Index := 0 to InstrMax do
                         begin
@@ -5647,6 +5693,7 @@ unit aoptx86;
         symbol: TAsmSymbol;
         reg: tsuperregister;
         regavailable: Boolean;
+        tmpreg: TRegister;
       begin
         result:=false;
         symbol:=nil;
@@ -5750,17 +5797,16 @@ unit aoptx86;
                    ((Taicpu(hp1).opcode=A_INC) or (Taicpu(hp1).opcode=A_DEC))
                   ) then
                   begin
-                    TransferUsedRegs(TmpUsedRegs);
-                    UpdateUsedRegs(TmpUsedRegs, tai(p.next));
-
                     { search for an available register which is volatile }
                     regavailable:=false;
                     for reg in tcpuregisterset do
                       begin
+                        tmpreg:=newreg(R_INTREGISTER,reg,R_SUBL);
                         if (reg in paramanager.get_volatile_registers_int(current_procinfo.procdef.proccalloption)) and
-                          not(reg in TmpUsedRegs[R_INTREGISTER].GetUsedRegs) and
-                          not(RegInInstruction(newreg(R_INTREGISTER,reg,R_SUBL),hp1))
+                          not(reg in UsedRegs[R_INTREGISTER].GetUsedRegs) and
+                          not(RegInInstruction(tmpreg,hp1))
 {$ifdef i386}
+                          { use only registers which can be accessed byte wise }
                           and (reg in [RS_EAX,RS_EBX,RS_ECX,RS_EDX])
 {$endif i386}
                           then
@@ -5772,23 +5818,24 @@ unit aoptx86;
 
                     if regavailable then
                       begin
+                        TAsmLabel(symbol).decrefs;
                         Taicpu(p).clearop(0);
                         Taicpu(p).ops:=1;
                         Taicpu(p).is_jmp:=false;
                         Taicpu(p).opcode:=A_SETcc;
                         DebugMsg(SPeepholeOptimization+'JccAdd2SetccAdd',p);
                         Taicpu(p).condition:=inverse_cond(Taicpu(p).condition);
-                        Taicpu(p).loadreg(0,newreg(R_INTREGISTER,reg,R_SUBL));
+                        Taicpu(p).loadreg(0,tmpreg);
 
                         if getsubreg(Taicpu(hp1).oper[1]^.reg)<>R_SUBL then
                           begin
                             case getsubreg(Taicpu(hp1).oper[1]^.reg) of
                               R_SUBW:
-                                hp2:=Taicpu.op_reg_reg(A_MOVZX,S_BW,newreg(R_INTREGISTER,reg,R_SUBL),
+                                hp2:=Taicpu.op_reg_reg(A_MOVZX,S_BW,tmpreg,
                                   newreg(R_INTREGISTER,reg,R_SUBW));
                               R_SUBD,
                               R_SUBQ:
-                                hp2:=Taicpu.op_reg_reg(A_MOVZX,S_BL,newreg(R_INTREGISTER,reg,R_SUBL),
+                                hp2:=Taicpu.op_reg_reg(A_MOVZX,S_BL,tmpreg,
                                   newreg(R_INTREGISTER,reg,R_SUBD));
                               else
                                 Internalerror(2020030601);
@@ -7476,7 +7523,8 @@ unit aoptx86;
                   (taicpu(hp1).opcode = A_TEST) and MatchOperand(taicpu(hp1).oper[0]^, taicpu(hp1).oper[1]^)
                 )
               ) and
-              (reg2opsize(taicpu(hp1).oper[1]^.reg) <= reg2opsize(taicpu(p).oper[1]^.reg)) then
+              (reg2opsize(taicpu(hp1).oper[1]^.reg) <= reg2opsize(taicpu(p).oper[1]^.reg)) and
+              SuperRegistersEqual(taicpu(p).oper[1]^.reg, taicpu(hp1).oper[1]^.reg) then
               begin
                 PreMessage := debug_op2str(taicpu(hp1).opcode) + debug_opsize2str(taicpu(hp1).opsize) + ' ' + debug_operstr(taicpu(hp1).oper[0]^) + ',' + debug_regname(taicpu(hp1).oper[1]^.reg) + ' -> ' + debug_op2str(taicpu(hp1).opcode);
 

compiler/x86_64/aoptcpu.pas

@@ -71,6 +71,8 @@ uses
           ait_instruction:
             begin
               case taicpu(p).opcode of
+                A_ADD:
+                  Result:=OptPass1ADD(p);
                 A_AND:
                   Result:=OptPass1AND(p);
                 A_IMUL:

packages/fcl-passrc/src/pasresolver.pp

@@ -9049,7 +9049,7 @@ begin
     CurEl:=nil;
     if not SameText(RightStr(AttrName,length('Attribute')),'Attribute') then
       begin
-      // first search AttrName+'Attibute'
+      // first search AttrName+'Attribute'
       CurEl:=FindFirstEl(AttrName+'Attribute',Data,NameExpr);
       end;
     // then search the name
@@ -9164,12 +9164,14 @@ var
   FindData: TPRFindData;
   Ref: TResolvedReference;
   ResolvedEl: TPasResolverResult;
+  Section: TPasSection;
+  Scope: TPasIdentifierScope;
+  ScopeIdent: TPasIdentifier;
 begin
   Expr:=El.NameExpr;
   if Expr<>nil then
     begin
     ResolveExpr(Expr,rraRead);
-    //ResolveGlobalSymbol(Expr);
     ComputeElement(Expr,ResolvedEl,[rcConstant]);
     DeclEl:=ResolvedEl.IdentEl;
     if DeclEl=nil then
@@ -9189,6 +9191,18 @@ begin
     CheckFoundElement(FindData,Ref);
     end;
 
+  if DeclEl is TPasProcedure then
+    begin
+    Section:=DeclEl.Parent as TPasSection;
+    Scope:=Section.CustomData as TPasIdentifierScope;
+    ScopeIdent:=Scope.FindLocalIdentifier(DeclEl.Name);
+    if (ScopeIdent=nil) then
+      RaiseNotYetImplemented(20210106103001,El,GetObjPath(DeclEl));
+    if ScopeIdent.NextSameIdentifier<>nil then
+      RaiseMsg(20210106103320,nCantDetermineWhichOverloadedFunctionToCall,
+        sCantDetermineWhichOverloadedFunctionToCall,[],El);
+    end;
+
   // check index and name
   CheckConstExpr(El.ExportIndex,[revkInt,revkUInt],'integer');
   CheckConstExpr(El.ExportName,[revkString,revkUnicodeString],'string');
@@ -21318,7 +21332,7 @@ procedure TPasResolver.CheckFoundElement(
 // Call this method after finding an element by searching the scopes.
 
   function IsFieldInheritingConst(aRef: TResolvedReference): boolean;
-  // returns true of aRef is a TPasVariable that inherits its const from parent.
+  // returns true if aRef is a TPasVariable that inherits its const from parent.
   // For example
   //  type TRecord = record
   //    a: word; // inherits const
@@ -27564,6 +27578,21 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
       end;
   end;
 
+  procedure ComputeExportSymbol(ExpSymbol: TPasExportSymbol);
+  var
+    Ref: TResolvedReference;
+  begin
+    if ExpSymbol.CustomData is TResolvedReference then
+      begin
+      Ref:=TResolvedReference(El.CustomData);
+      ComputeElement(Ref.Declaration,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
+      end
+    else if ExpSymbol.NameExpr<>nil then
+      ComputeElement(ExpSymbol.NameExpr,ResolvedEl,Flags,StartEl)
+    else
+      RaiseNotYetImplemented(20210106225512,ExpSymbol);
+  end;
+
 var
   DeclEl: TPasElement;
   ElClass: TClass;
@@ -27946,6 +27975,8 @@ begin
     ComputeSpecializeType(TPasSpecializeType(El))
   else if ElClass=TInlineSpecializeExpr then
     ComputeElement(TInlineSpecializeExpr(El).NameExpr,ResolvedEl,Flags,StartEl)
+  else if ElClass=TPasExportSymbol then
+    ComputeExportSymbol(TPasExportSymbol(El))
   else
     RaiseNotYetImplemented(20160922163705,El);
   {$IF defined(nodejs) and defined(VerbosePasResolver)}

packages/fcl-passrc/tests/tcresolver.pas

@@ -986,8 +986,8 @@ type
     Procedure TestLibrary_ExportFunc_IndexStringFail;
     Procedure TestLibrary_ExportVar; // ToDo
     Procedure TestLibrary_Initialization_Finalization;
-    Procedure TestLibrary_ExportFuncOverloadFail; // ToDo
-    // ToDo Procedure TestLibrary_UnitExports;
+    Procedure TestLibrary_ExportFuncOverloadFail;
+    Procedure TestLibrary_UnitExports;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -18836,8 +18836,6 @@ end;
 
 procedure TTestResolver.TestLibrary_ExportFuncOverloadFail;
 begin
-  exit;
-
   StartLibrary(false);
   Add([
   'procedure Run(w: word); overload;',
@@ -18850,7 +18848,24 @@ begin
   '  Run,',
   '  afile.run;',
   'begin']);
-  CheckResolverException('The symbol cannot be exported from a library',123);
+  CheckResolverException(sCantDetermineWhichOverloadedFunctionToCall,
+    nCantDetermineWhichOverloadedFunctionToCall);
+end;
+
+procedure TTestResolver.TestLibrary_UnitExports;
+begin
+  StartUnit(false);
+  Add([
+  'interface' ,
+  'procedure Run;',
+  'implementation',
+  'procedure Run;',
+  'begin',
+  'end;',
+  'exports',
+  '  Run;',
+  '']);
+  ParseUnit;
 end;
 
 initialization

packages/fv/src/views.pas

@@ -1905,7 +1905,8 @@ VAR S, D: Sw_Integer; Min, Max: TPoint;
    PROCEDURE GrowI (Var I: Sw_Integer);
    BEGIN
      If (GrowMode AND gfGrowRel = 0) Then Inc(I, D)
-       Else I := (I * S + (S - D) SHR 1) DIV (S - D); { Calc grow value }
+       Else If  S = D then I := 1
+         Else I := (I * S + (S - D) SHR 1) DIV (S - D); { Calc grow value }
    END;
 
 BEGIN

packages/pastojs/src/fppas2js.pp

@@ -506,6 +506,7 @@ const
   nDuplicateMessageIdXAtY = 4029;
   nDispatchRequiresX = 4030;
   nConstRefNotForXAsConst = 4031;
+  nSymbolCannotBeExportedFromALibrary = 4032;
 // resourcestring patterns of messages
 resourcestring
   sPasElementNotSupported = 'Pascal element not supported: %s';
@@ -539,6 +540,7 @@ resourcestring
   sDuplicateMessageIdXAtY = 'Duplicate message id "%s" at %s';
   sDispatchRequiresX = 'Dispatch requires %s';
   sConstRefNotForXAsConst = 'ConstRef not yet implemented for %s. Treating as Const';
+  sSymbolCannotBeExportedFromALibrary = 'The symbol cannot be exported from a library';
 
 const
   ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
@@ -606,6 +608,7 @@ type
     pbifnValEnum,
     pbifnFreeLocalVar,
     pbifnFreeVar,
+    pbifnLibraryMain,
     pbifnOverflowCheckInt,
     pbifnProcType_Create,
     pbifnProcType_CreateSafe,
@@ -671,6 +674,7 @@ type
     pbivnImplCode,
     pbivnMessageInt,
     pbivnMessageStr,
+    pbivnLibrary, // library
     pbivnLocalModuleRef,
     pbivnLocalProcRef,
     pbivnLocalTypeRef,
@@ -682,6 +686,7 @@ type
     pbivnPtrClass,
     pbivnPtrRecord,
     pbivnProcOk,
+    pbivnProgram,  // program
     pbivnResourceStrings,
     pbivnResourceStringOrig,
     pbivnRTL,
@@ -791,6 +796,7 @@ const
     'valEnum', // pbifnValEnum  rtl.valEnum
     'freeLoc', // pbifnFreeLocalVar  rtl.freeLoc
     'free', // pbifnFreeVar  rtl.free
+    '$main', // pbifnLibraryMain
     'oc', //  pbifnOverflowCheckInt rtl.oc
     'createCallback', // pbifnProcType_Create  rtl.createCallback
     'createSafeCallback', // pbifnProcType_CreateSafe  rtl.createSafeCallback
@@ -855,6 +861,7 @@ const
     '$implcode', // pbivnImplCode
     '$msgint', // pbivnMessageInt
     '$msgstr', // pbivnMessageStr
+    'library', //  pbivnLibrary  pas.library
     '$lm', // pbivnLocalModuleRef
     '$lp', // pbivnLocalProcRef
     '$lt', // pbivnLocalTypeRef
@@ -866,6 +873,7 @@ const
     '$class', // pbivnPtrClass, ClassType
     '$record', // pbivnPtrRecord, hidden recordtype
     '$ok', // pbivnProcOk
+    'program', // pbivnProgram  pas.program
     '$resourcestrings', // pbivnResourceStrings
     'org', // pbivnResourceStringOrig
     'rtl', // pbivnRTL
@@ -1538,6 +1546,7 @@ type
       Params: TParamsExpr); override;
     procedure FinishPropertyParamAccess(Params: TParamsExpr; Prop: TPasProperty
       ); override;
+    procedure FinishExportSymbol(El: TPasExportSymbol); override;
     procedure FindCreatorArrayOfConst(Args: TFPList; ErrorEl: TPasElement);
     function FindProc_ArrLitToArrayOfConst(ErrorEl: TPasElement): TPasFunction; virtual;
     function FindSystemExternalClassType(const aClassName, JSName: string;
@@ -2071,7 +2080,7 @@ type
     Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     Procedure AddHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual;
     Procedure AddImplHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual;
-    Procedure AddDelayedInits(El: TPasProgram; Src: TJSSourceElements; AContext: TConvertContext); virtual;
+    Procedure AddDelayedInits(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     Procedure AddDelaySpecializeInit(El: TPasGenericType; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     // enum and sets
     Function CreateReferencedSet(El: TPasElement; SetExpr: TJSElement): TJSElement; virtual;
@@ -4880,6 +4889,41 @@ begin
   FindCreatorArrayOfConst(Args,Params);
 end;
 
+procedure TPas2JSResolver.FinishExportSymbol(El: TPasExportSymbol);
+var
+  ResolvedEl: TPasResolverResult;
+  DeclEl: TPasElement;
+  Proc: TPasProcedure;
+begin
+  if El.Parent is TLibrarySection then
+    // ok
+  else
+    // everywhere else: not supported
+    RaiseMsg(20210106224720,nNotSupportedX,sNotSupportedX,['non library export'],El.ExportIndex);
+  if El.ExportIndex<>nil then
+    RaiseMsg(20210106223403,nNotSupportedX,sNotSupportedX,['export index'],El.ExportIndex);
+
+  inherited FinishExportSymbol(El);
+
+  ComputeElement(El,ResolvedEl,[]);
+  DeclEl:=ResolvedEl.IdentEl;
+  if DeclEl=nil then
+    RaiseMsg(20210106223620,nSymbolCannotBeExportedFromALibrary,
+      sSymbolCannotBeExportedFromALibrary,[],El)
+  else if DeclEl is TPasProcedure then
+    begin
+    Proc:=TPasProcedure(DeclEl);
+    if Proc.Parent is TPasSection then
+      // ok
+    else
+      RaiseMsg(20210106224436,nSymbolCannotBeExportedFromALibrary,
+        sSymbolCannotBeExportedFromALibrary,[],El);
+    end
+  else
+    RaiseMsg(20210106223621,nSymbolCannotBeExportedFromALibrary,
+      sSymbolCannotBeExportedFromALibrary,[],El);
+end;
+
 procedure TPas2JSResolver.FindCreatorArrayOfConst(Args: TFPList;
   ErrorEl: TPasElement);
 var
@@ -8083,6 +8127,18 @@ Program:
         };
     });
 
+Library:
+ rtl.module('library',
+    [<uses1>,<uses2>, ...],
+    function(){
+      var $mod = this;
+      <librarysection>
+      this.$main=function(){
+        <initialization>
+        };
+    });
+  export1 = pas.unit1.func1;
+
 Unit without implementation:
  rtl.module('<unitname>',
     [<interface uses1>,<uses2>, ...],
@@ -8136,6 +8192,7 @@ begin
     ModScope:=nil;
   OuterSrc:=TJSSourceElements(CreateElement(TJSSourceElements, El));
   Result:=OuterSrc;
+  IntfContext:=nil;
   ok:=false;
   try
     // create 'rtl.module(...)'
@@ -8145,7 +8202,7 @@ begin
     ArgArray := RegModuleCall.Args;
     RegModuleCall.Args:=ArgArray;
 
-    // add unitname parameter: unitname
+    // add module name parameter
     ModuleName:=TransformModuleName(El,false,AContext);
     ArgArray.Elements.AddElement.Expr:=CreateLiteralString(El,ModuleName);
 
@@ -8183,95 +8240,88 @@ begin
       IntfContext:=TInterfaceSectionContext.Create(El,Src,AContext)
     else
       IntfContext:=TSectionContext.Create(El,Src,AContext);
-    try
-      // add "var $mod = this;"
-      IntfContext.ThisVar.Element:=El;
-      IntfContext.ThisVar.Kind:=cvkGlobal;
-      if El.CustomData is TPasModuleScope then
-        IntfContext.ScannerBoolSwitches:=TPasModuleScope(El.CustomData).BoolSwitches;
-      ModVarName:=GetBIName(pbivnModule);
-      IntfContext.AddLocalVar(ModVarName,El,cvkGlobal,false);
-      AddToSourceElements(Src,CreateVarStatement(ModVarName,
-        CreatePrimitiveDotExpr('this',El),El));
-
-      if (ModScope<>nil) then
-        RestoreImplJSLocals(ModScope,IntfContext);
-
-      if (El is TPasProgram) then
-        begin // program
-        Prg:=TPasProgram(El);
-        if Assigned(Prg.ProgramSection) then
-          AddToSourceElements(Src,ConvertDeclarations(Prg.ProgramSection,IntfContext));
-        AddDelayedInits(Prg,Src,IntfContext);
-        CreateInitSection(Prg,Src,IntfContext);
-        end
-      else if El is TPasLibrary then
-        begin // library
-        Lib:=TPasLibrary(El);
-        if Assigned(Lib.LibrarySection) then
-          AddToSourceElements(Src,ConvertDeclarations(Lib.LibrarySection,IntfContext));
-        // ToDo AddDelayedInits(Lib,Src,IntfContext);
-        CreateInitSection(Lib,Src,IntfContext);
-        end
-      else
-        begin // unit
-        IntfSecCtx:=TInterfaceSectionContext(IntfContext);
-        if Assigned(El.ImplementationSection) then
-          begin
-          // add var $impl = $mod.$impl
-          ImplVarSt:=CreateVarStatement(GetBIName(pbivnImplementation),
-            CreateMemberExpression([ModVarName,GetBIName(pbivnImplementation)]),El);
-          AddToSourceElements(Src,ImplVarSt);
-          // register local var $impl
-          IntfSecCtx.AddLocalVar(GetBIName(pbivnImplementation),El.ImplementationSection,cvkGlobal,false);
-          end;
-        if Assigned(El.InterfaceSection) then
-          AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfSecCtx));
-
-        ImplFunc:=CreateImplementationSection(El,IntfSecCtx);
-        // add $mod.$implcode = ImplFunc;
-        AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
-        AssignSt.LHS:=CreateMemberExpression([ModVarName,GetBIName(pbivnImplCode)]);
-        AssignSt.Expr:=ImplFunc;
-        AddToSourceElements(Src,AssignSt);
+    // add "var $mod = this;"
+    IntfContext.ThisVar.Element:=El;
+    IntfContext.ThisVar.Kind:=cvkGlobal;
+    if El.CustomData is TPasModuleScope then
+      IntfContext.ScannerBoolSwitches:=TPasModuleScope(El.CustomData).BoolSwitches;
+    ModVarName:=GetBIName(pbivnModule);
+    IntfContext.AddLocalVar(ModVarName,El,cvkGlobal,false);
+    AddToSourceElements(Src,CreateVarStatement(ModVarName,
+      CreatePrimitiveDotExpr('this',El),El));
+
+    if (ModScope<>nil) then
+      RestoreImplJSLocals(ModScope,IntfContext);
 
-        // append initialization section
-        CreateInitSection(El,Src,IntfSecCtx);
+    if (El is TPasProgram) then
+      begin // program
+      Prg:=TPasProgram(El);
+      if Assigned(Prg.ProgramSection) then
+        AddToSourceElements(Src,ConvertDeclarations(Prg.ProgramSection,IntfContext));
+      AddDelayedInits(Prg,Src,IntfContext);
+      CreateInitSection(Prg,Src,IntfContext);
+      end
+    else if El is TPasLibrary then
+      begin // library
+      Lib:=TPasLibrary(El);
+      if Assigned(Lib.LibrarySection) then
+        AddToSourceElements(Src,ConvertDeclarations(Lib.LibrarySection,IntfContext));
+      AddDelayedInits(Lib,Src,IntfContext);
+      CreateInitSection(Lib,Src,IntfContext);
+      // ToDo: append exports
+      end
+    else
+      begin // unit
+      IntfSecCtx:=TInterfaceSectionContext(IntfContext);
+      if Assigned(El.ImplementationSection) then
+        begin
+        // add var $impl = $mod.$impl
+        ImplVarSt:=CreateVarStatement(GetBIName(pbivnImplementation),
+          CreateMemberExpression([ModVarName,GetBIName(pbivnImplementation)]),El);
+        AddToSourceElements(Src,ImplVarSt);
+        // register local var $impl
+        IntfSecCtx.AddLocalVar(GetBIName(pbivnImplementation),El.ImplementationSection,cvkGlobal,false);
+        end;
+      if Assigned(El.InterfaceSection) then
+        AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfSecCtx));
+
+      ImplFunc:=CreateImplementationSection(El,IntfSecCtx);
+      // add $mod.$implcode = ImplFunc;
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      AssignSt.LHS:=CreateMemberExpression([ModVarName,GetBIName(pbivnImplCode)]);
+      AssignSt.Expr:=ImplFunc;
+      AddToSourceElements(Src,AssignSt);
 
-        if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count=0 then
-          begin
-          // empty implementation
-
-          // remove unneeded $impl from interface
-          RemoveFromSourceElements(Src,ImplVarSt);
-          // remove unneeded $mod.$implcode = function(){}
-          RemoveFromSourceElements(Src,AssignSt);
-          HasImplUsesClause:=(El.ImplementationSection<>nil)
-                         and (length(El.ImplementationSection.UsesClause)>0);
-          end
-        else
-          begin
-          HasImplUsesClause:=true;
-          end;
+      // append initialization section
+      CreateInitSection(El,Src,IntfSecCtx);
 
-        if HasImplUsesClause then
-          // add implementation uses list: [<implementation uses1>,<uses2>, ...]
-          ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext));
+      if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count=0 then
+        begin
+        // empty implementation
 
+        // remove unneeded $impl from interface
+        RemoveFromSourceElements(Src,ImplVarSt);
+        // remove unneeded $mod.$implcode = function(){}
+        RemoveFromSourceElements(Src,AssignSt);
+        HasImplUsesClause:=(El.ImplementationSection<>nil)
+                       and (length(El.ImplementationSection.UsesClause)>0);
+        end
+      else
+        begin
+        HasImplUsesClause:=true;
         end;
 
-      if (ModScope<>nil) and (coStoreImplJS in Options) then
-        StoreImplJSLocals(ModScope,IntfContext);
-    finally
-      IntfContext.Free;
-    end;
+      if HasImplUsesClause then
+        // add implementation uses list: [<implementation uses1>,<uses2>, ...]
+        ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext));
 
-    // add implementation function
-    if ImplVarSt<>nil then
-      begin
-      end;
+      end; // end unit
+
+    if (ModScope<>nil) and (coStoreImplJS in Options) then
+      StoreImplJSLocals(ModScope,IntfContext);
     ok:=true;
   finally
+    IntfContext.Free;
     if not ok then
       FreeAndNil(Result);
   end;
@@ -15397,6 +15447,8 @@ begin
         end
       else if C=TPasAttributes then
         continue
+      else if C=TPasExportSymbol then
+        continue
       else
         RaiseNotSupported(P as TPasElement,AContext,20161024191434);
       Add(E,P);
@@ -17148,11 +17200,21 @@ begin
     Scope:=nil;
     end;
 
-  IsMain:=(El is TPasProgram);
-  if IsMain then
+  if El.ClassType=TPasProgram then
+    begin
+    IsMain:=true;
     FunName:=GetBIName(pbifnProgramMain)
+    end
+  else if El.ClassType=TPasLibrary then
+    begin
+    IsMain:=true;
+    FunName:=GetBIName(pbifnLibraryMain)
+    end
   else
+    begin
+    IsMain:=false;
     FunName:=GetBIName(pbifnUnitInit);
+    end;
   NeedRTLCheckVersion:=IsMain and (coRTLVersionCheckMain in Options);
 
   RootContext:=AContext.GetRootContext as TRootContext;
@@ -17680,7 +17742,7 @@ begin
   IntfSec.AddImplHeaderStatement(JS);
 end;
 
-procedure TPasToJSConverter.AddDelayedInits(El: TPasProgram;
+procedure TPasToJSConverter.AddDelayedInits(El: TPasModule;
   Src: TJSSourceElements; AContext: TConvertContext);
 var
   aResolver: TPas2JSResolver;
@@ -26402,7 +26464,7 @@ begin
           if (C=TPasConstructor)
               or ((aResolver<>nil) and aResolver.IsClassMethod(P)
                 and not aResolver.MethodIsStatic(TPasProcedure(P))) then
-            IsComplex:=true; // needs $record
+            ; //IsComplex:=true; // needs $record
           end;
         end
       else if C=TPasAttributes then
@@ -26617,8 +26679,10 @@ begin
     if Result<>'' then
       exit;
     end;
-  if El is TPasProgram then
-    Result:='program'
+  if El.ClassType=TPasProgram then
+    Result:=GetBIName(pbivnProgram)
+  else if El.ClassType=TPasLibrary then
+    Result:=GetBIName(pbivnLibrary)
   else
     begin
     Result:='';

packages/pastojs/tests/tcmodules.pas

@@ -125,6 +125,7 @@ type
     FModules: TObjectList;// list of TTestEnginePasResolver
     FParser: TTestPasParser;
     FPasProgram: TPasProgram;
+    FPasLibrary: TPasLibrary;
     FHintMsgs: TObjectList; // list of TTestHintMessage
     FHintMsgsGood: TFPList; // list of TTestHintMessage marked as expected
     FJSRegModuleCall: TJSCallExpression;
@@ -157,6 +158,7 @@ type
     procedure ParseModuleQueue; virtual;
     procedure ParseModule; virtual;
     procedure ParseProgram; virtual;
+    procedure ParseLibrary; virtual;
     procedure ParseUnit; virtual;
   protected
     function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver; virtual;
@@ -166,9 +168,11 @@ type
       ImplementationSrc: string): TTestEnginePasResolver; virtual;
     procedure AddSystemUnit(Parts: TSystemUnitParts = []); virtual;
     procedure StartProgram(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []); virtual;
+    procedure StartLibrary(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []); virtual;
     procedure StartUnit(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []); virtual;
     procedure ConvertModule; virtual;
     procedure ConvertProgram; virtual;
+    procedure ConvertLibrary; virtual;
     procedure ConvertUnit; virtual;
     function ConvertJSModuleToString(El: TJSElement): string; virtual;
     procedure CheckDottedIdentifier(Msg: string; El: TJSElement; DottedName: string);
@@ -196,6 +200,7 @@ type
     function GetResolver(const Filename: string): TTestEnginePasResolver;
     function GetDefaultNamespace: string;
     property PasProgram: TPasProgram Read FPasProgram;
+    property PasLibrary: TPasLibrary Read FPasLibrary;
     property Resolvers[Index: integer]: TTestEnginePasResolver read GetResolvers;
     property ResolverCount: integer read GetResolverCount;
     property Engine: TTestEnginePasResolver read FEngine;
@@ -894,6 +899,12 @@ type
     Procedure TestAsync_Inherited;
     Procedure TestAsync_ClassInterface;
     Procedure TestAsync_ClassInterface_AsyncMissmatchFail;
+
+    // Library
+    Procedure TestLibrary_Empty;
+    Procedure TestLibrary_ExportFunc; // ToDo
+    // ToDo: test delayed specialization init
+    // ToDO: analyzer
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -1587,6 +1598,22 @@ begin
       FFirstPasStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
 end;
 
+procedure TCustomTestModule.ParseLibrary;
+var
+  Init: TInitializationSection;
+begin
+  if SkipTests then exit;
+  ParseModule;
+  if SkipTests then exit;
+  AssertEquals('Has library',TPasLibrary,Module.ClassType);
+  FPasLibrary:=TPasLibrary(Module);
+  AssertNotNull('Has library section',PasLibrary.LibrarySection);
+  Init:=PasLibrary.InitializationSection;
+  if (Init<>nil) and (Init.Elements.Count>0) then
+    if TObject(Init.Elements[0]) is TPasImplBlock then
+      FFirstPasStatement:=TPasImplBlock(PasLibrary.InitializationSection.Elements[0]);
+end;
+
 procedure TCustomTestModule.ParseUnit;
 begin
   if SkipTests then exit;
@@ -1869,6 +1896,17 @@ begin
   Add('');
 end;
 
+procedure TCustomTestModule.StartLibrary(NeedSystemUnit: boolean;
+  SystemUnitParts: TSystemUnitParts);
+begin
+  if NeedSystemUnit then
+    AddSystemUnit(SystemUnitParts)
+  else
+    Parser.ImplicitUses.Clear;
+  Add('library '+ExtractFileUnitName(Filename)+';');
+  Add('');
+end;
+
 procedure TCustomTestModule.StartUnit(NeedSystemUnit: boolean;
   SystemUnitParts: TSystemUnitParts);
 begin
@@ -1974,6 +2012,8 @@ begin
   AssertEquals('module name param is string',ord(jstString),ord(ModuleNameExpr.Value.ValueType));
   if Module is TPasProgram then
     AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString))
+  else if Module is TPasLibrary then
+    AssertEquals('module name','library',String(ModuleNameExpr.Value.AsString))
   else
     AssertEquals('module name',Module.Name,String(ModuleNameExpr.Value.AsString));
 
@@ -1990,7 +2030,7 @@ begin
   CheckFunctionParam('module intf-function',Arg,FJSModuleSrc);
 
   // search for $mod.$init or $mod.$main - the last statement
-  if Module is TPasProgram then
+  if (Module is TPasProgram) or (Module is TPasLibrary) then
     begin
     InitName:='$main';
     AssertEquals('$mod.'+InitName+' function 1',true,JSModuleSrc.Statements.Count>0);
@@ -2009,7 +2049,7 @@ begin
         InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement;
         FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody;
         end
-      else if Module is TPasProgram then
+      else if (Module is TPasProgram) or (Module is TPasLibrary) then
         CheckDottedIdentifier('init function',InitAssign.LHS,'$mod.'+InitName);
       end;
     end;
@@ -2028,6 +2068,13 @@ begin
   ConvertModule;
 end;
 
+procedure TCustomTestModule.ConvertLibrary;
+begin
+  Add('end.');
+  ParseLibrary;
+  ConvertModule;
+end;
+
 procedure TCustomTestModule.ConvertUnit;
 begin
   Add('end.');
@@ -2089,7 +2136,7 @@ begin
   // program main or unit initialization
   if (Module is TPasProgram) or (Trim(InitStatements)<>'') then
     begin
-    if Module is TPasProgram then
+    if (Module is TPasProgram) or (Module is TPasLibrary) then
       InitName:='$main'
     else
       InitName:='$init';
@@ -12292,12 +12339,20 @@ begin
   'type',
   '  TPoint = record',
   '    x,y: longint;',
+  '    class procedure Run(w: longint = 13); static;',
   '    constructor Create(ax: longint; ay: longint = -1);',
   '  end;',
+  'class procedure tpoint.run(w: longint);',
+  'begin',
+  '   run;',
+  '   run();',
+  'end;',
   'constructor tpoint.create(ax,ay: longint);',
   'begin',
   '  x:=ax;',
   '  self.y:=ay;',
+  ' run;',
+  '  run(ax);',
   'end;',
   'var r: TPoint;',
   'begin',
@@ -12320,12 +12375,18 @@ begin
     '    this.y = s.y;',
     '    return this;',
     '  };',
+    '  this.Run = function (w) {',
+    '    $mod.TPoint.Run(13);',
+    '    $mod.TPoint.Run(13);',
+    '  };',
     '  this.Create = function (ax, ay) {',
     '    this.x = ax;',
     '    this.y = ay;',
+    '    this.Run(13);',
+    '    this.Run(ax);',
     '    return this;',
     '  };',
-    '}, true);',
+    '});',
     'this.r = this.TPoint.$new();',
     '']),
     LinesToStr([ // $mod.$main
@@ -23241,7 +23302,7 @@ begin
     '    $mod.THelper.$new("NewHlp", [3]);',
     '    return this;',
     '  };',
-    '}, true);',
+    '});',
     'rtl.createHelper(this, "THelper", null, function () {',
     '  this.NewHlp = function (w) {',
     '    this.Create(2);',
@@ -33110,6 +33171,42 @@ begin
   ConvertProgram;
 end;
 
+procedure TTestModule.TestLibrary_Empty;
+begin
+  StartLibrary(false);
+  Add([
+  '']);
+  ConvertLibrary;
+  CheckSource('TestLibrary_Empty',
+    LinesToStr([ // statements
+    '']),
+    LinesToStr([
+    '']));
+  CheckResolverUnexpectedHints();
+end;
+
+procedure TTestModule.TestLibrary_ExportFunc;
+begin
+  exit;
+
+  StartLibrary(false);
+  Add([
+  'procedure Run(w: word);',
+  'begin',
+  'end;',
+  'exports',
+  '  Run,',
+  '  run name ''Foo'';',
+  '']);
+  ConvertLibrary;
+  CheckSource('TestLibrary_ExportFunc',
+    LinesToStr([ // statements
+    '']),
+    LinesToStr([
+    '']));
+  CheckResolverUnexpectedHints();
+end;
+
 Initialization
   RegisterTests([TTestModule]);
 end.

rtl/linux/i386/si_prc.inc

@@ -45,7 +45,9 @@ var
 procedure fpc_geteipasebxlocal; [external name 'fpc_geteipasebx'];
 {$endif}
 
+{$ifndef FPC_USE_LIBC}
 procedure InitTLS; [external name 'FPC_INITTLS'];
+{$endif}
 
 procedure _FPC_proc_start; assembler; nostackframe; public name '_start';
 asm
@@ -95,9 +97,9 @@ asm
   movl    %esp,initialstkptr
 {$endif FPC_PIC}
 
-{$if FPC_FULLVERSION>30200}
+{$if (FPC_FULLVERSION>30200) and not defined(FPC_USE_LIBC)}
   call    InitTLS
-{$endif FPC_FULLVERSION>30200}
+{$endif FPC_FULLVERSION>30200 and not FPC_USE_LIBC}
 
   xorl    %ebp,%ebp
   call    PASCALMAIN

rtl/linux/si_impl.inc

@@ -16,7 +16,9 @@ procedure PascalMain; external name 'PASCALMAIN';
 
 {$ifdef FPC_HAS_INDIRECT_ENTRY_INFORMATION}
 procedure SysEntry(constref info: TEntryInformation); external name 'FPC_SysEntry';
+{$ifndef FPC_USE_LIBC}
 procedure SysEntry_InitTLS(constref info: TEntryInformation); external name 'FPC_SysEntry_InitTLS';
+{$endif FPC_USE_LIBC}
 
 var
   InitFinalTable : record end; external name 'INITFINAL';

rtl/linux/system.pp

@@ -125,6 +125,9 @@ procedure OsSetupEntryInformation(constref info: TEntryInformation); forward;
                                TLS handling
 *****************************************************************************}
 
+{ TLS initialization is not required if linking against libc }
+{$if not defined(FPC_USE_LIBC)}
+
 {$if defined(CPUARM)}
 {$define INITTLS}
 Function fpset_tls(p : pointer;size : SizeUInt):cint;
@@ -185,6 +188,8 @@ begin
 end;
 {$endif defined(CPUX86_64)}
 
+{$endif not FPC_USE_LIBC}
+
 
 {$ifdef INITTLS}
 { This code initialized the TLS segment for single threaded and static programs.
@@ -323,6 +328,8 @@ begin
   info.PascalMain();
 end;
 
+
+{$ifndef FPC_USE_LIBC}
 procedure SysEntry_InitTLS(constref info: TEntryInformation);[public,alias:'FPC_SysEntry_InitTLS'];
 begin
   SetupEntryInformation(info);
@@ -334,6 +341,7 @@ begin
 {$endif cpui386}
   info.PascalMain();
 end;
+{$endif FPC_USE_LIBC}
 
 {$else}
 var
@@ -361,6 +369,7 @@ begin
 end;
 
 
+{$ifdef FPC_USE_LIBC}
 procedure SysEntry_InitTLS(constref info: TEntryInformation);[public,alias:'FPC_SysEntry_InitTLS'];
 begin
   initialstkptr := info.OS.stkptr;
@@ -375,6 +384,7 @@ begin
 {$endif cpui386}
   info.PascalMain();
 end;
+{$endif FPC_USE_LIBC}
 
 {$endif FPC_BOOTSTRAP_INDIRECT_ENTRY}
 

rtl/linux/x86_64/si_prc.inc

@@ -35,7 +35,9 @@
 
 {$L abitag.o}
 
+{$ifndef FPC_USE_LIBC}
 procedure InitTLS; [external name 'FPC_INITTLS'];
+{$endif}
 
 {******************************************************************************
                           Process start/halt
@@ -73,7 +75,11 @@ procedure _FPC_proc_start; assembler; nostackframe; public name '_start';
     movq    %r10,%rdi
 
     xorq    %rbp, %rbp
+{$ifdef FPC_USE_LIBC}
+    call    SysEntry
+{$else}
     call    SysEntry_InitTLS
+{$endif}
 {$else FPC_HAS_INDIRECT_ENTRY_INFORMATION}
     popq     %rsi                                  { Pop the argument count.  }
     movq     operatingsystem_parameter_argc@GOTPCREL(%rip),%rax
@@ -90,9 +96,9 @@ procedure _FPC_proc_start; assembler; nostackframe; public name '_start';
     movq    initialstkptr@GOTPCREL(%rip),%rax
     movq    %rsp,(%rax)
 
-{$if FPC_FULLVERSION>30200}
+{$if (FPC_FULLVERSION>30200) and not defined(FPC_USE_LIBC)}
     call    InitTLS
-{$endif FPC_FULLVERSION>30200}
+{$endif FPC_FULLVERSION>30200 and not FPC_USE_LIBC}
 
     xorq    %rbp, %rbp
     call    PASCALMAIN

rtl/unix/oscdeclh.inc

@@ -180,4 +180,6 @@ const
 {$endif}
     function  FpTime       (tloc:ptime_t): time_t; cdecl; external clib name 'time';
 
-
+{$if defined(linux)}
+    function  FpSchedGetAffinity(pid : pid_t;cpusetsize : size_t;mask : pcpu_set_t) : cint; cdecl; external clib name 'sched_getaffinity';
+{$endif}

tests/utils/testsuite/utests.pp

@@ -153,6 +153,9 @@ const
   faction_compare_with_next = 6;
   faction_compare2_with_previous = 7;
   faction_compare2_with_next = 8;
+  faction_compare_both_with_previous = 9;
+  faction_compare_both_with_next = 10;
+
 
   Function TestResultsTableName(const RunId : String) : string;
   var
@@ -347,6 +350,18 @@ begin
             FCompareRunID:=FNext2RunID;
             ShowRunComparison;
           end;
+        faction_compare_both_with_previous : 
+          begin
+            FRunID:=FPreviousRunID;
+            FCompareRunID:=FPrevious2RunID;
+            ShowRunComparison;
+          end;
+        faction_compare_both_with_next : 
+          begin
+            FRunID:=FNextRunID;
+            FCompareRunID:=FNext2RunID;
+            ShowRunComparison;
+          end;
 {$ifdef TEST}
         98 :
           begin
@@ -402,6 +417,10 @@ begin
     FAction:=faction_compare2_with_previous
   else if S='Compare_right_to_next' then
     FAction:=faction_compare2_with_next
+  else if S='Compare_both_to_previous' then
+    FAction:=faction_compare_both_with_previous
+  else if S='Compare_both_to_next' then
+    FAction:=faction_compare_both_with_next
   else
     FAction:=StrToIntDef(S,0);
   S:=RequestVariables['limit'];
@@ -1397,7 +1416,22 @@ begin
               ParaGraphStart;
             end;
               
-          EmitSubmitButton('action','Show/Compare');
+          if (FPrevious2RunID<>'') and (FPreviousRunId<>'') then
+            begin
+              EmitSubmitButton('action','Compare_both_to_previous');
+              AddNewPar:=true;
+            end;
+          if (FNext2RunID<>'') and (FNextRunId<>'') then
+            begin
+              EmitSubmitButton('action','Compare_both_to_next');
+              AddNewPar:=true;
+            end;
+          if AddNewPar then
+            begin
+              ParagraphEnd;
+              ParaGraphStart;
+            end;
+           EmitSubmitButton('action','Show/Compare');
           if FTestFileID<>'' then
             EmitSubmitButton('action','View_history');
           EmitResetButton('','Reset form');

tests/webtbf/tw37217.pp

@@ -0,0 +1,12 @@
+{ %fail }
+{$mode delphi}
+type
+  TEagle = class
+    constructor Create<Y>();
+  end;
+
+constructor TEagle.Create<Y>();
+begin
+end;
+begin
+end.

tests/webtbs/tw38316.pp

@@ -0,0 +1,21 @@
+{ %opt=-gh }
+
+program project1;
+
+procedure P1(A: array of Integer);
+begin
+end;
+
+procedure P2(A: array of Integer);
+begin
+  P1(A);
+end;
+
+var
+  A: array [0..2] of Integer;
+  i: Integer;
+begin
+  HaltOnNotReleased := true;
+  for i := 0 to 10 do
+    P2(A);
+end.

tests/webtbs/tw38337.pp

@@ -0,0 +1,20 @@
+program fs;
+
+{$mode objfpc}{$H+}
+
+function UTF8Length(const s: string): PtrInt; inline;
+begin
+  Result:=9;
+end;
+
+
+var
+  v1: string;
+  s: shortstring;
+  i: Integer;
+begin
+  v1 := '123456789';
+  s := v1;
+  for i := 1 to UTF8Length(s)-8 do begin
+  end;
+end.

tests/webtbs/tw38339.pp

@@ -0,0 +1,23 @@
+{%OPT=-O3 }
+program test48086;
+{$mode objfpc}{$H+}
+function IsFontNameXLogicalFontDesc(const LongFontName: string): boolean;
+var MinusCnt, p: integer;
+begin
+  MinusCnt:=0;
+  for p:=1 to length(LongFontName) do
+    if LongFontName[p]='-' then inc(MinusCnt);
+  Result:=(MinusCnt=14);
+end;
+var
+myfont:string;
+begin
+ myfont:='Myfont--------------';
+ if IsFontNameXLogicalFontDesc(myfont) then
+  writeln('NO ERROR')
+ else
+  begin
+    writeln('Error in count');
+    halt(1);
+  end;
+end.