* synchronized with trunk

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

.gitattributes

@@ -16596,6 +16596,7 @@ tests/webtbf/tw3740.pp svneol=native#text/plain
 tests/webtbf/tw37460.pp svneol=native#text/pascal
 tests/webtbf/tw37462.pp svneol=native#text/pascal
 tests/webtbf/tw37475.pp svneol=native#text/pascal
+tests/webtbf/tw37476.pp svneol=native#text/pascal
 tests/webtbf/tw3790.pp svneol=native#text/plain
 tests/webtbf/tw3812.pp svneol=native#text/plain
 tests/webtbf/tw3930a.pp svneol=native#text/plain

compiler/aarch64/aoptcpu.pas

@@ -50,6 +50,7 @@ Interface
         function RemoveSuperfluousFMov(const p: tai; movp: tai; const optimizer: string): boolean;
         function OptPass1STP(var p: tai): boolean;
         function OptPass1Mov(var p: tai): boolean;
+        function OptPass1FMov(var p: tai): Boolean;
       End;
 
 Implementation
@@ -60,6 +61,16 @@ Implementation
     cgutils,
     verbose;
 
+{$ifdef DEBUG_AOPTCPU}
+    const
+      SPeepholeOptimization: shortstring = 'Peephole Optimization: ';
+{$else DEBUG_AOPTCPU}
+    { Empty strings help the optimizer to remove string concatenations that won't
+      ever appear to the user on release builds. [Kit] }
+    const
+      SPeepholeOptimization = '';
+{$endif DEBUG_AOPTCPU}
+
   function CanBeCond(p : tai) : boolean;
     begin
       result:=(p.typ=ait_instruction) and (taicpu(p).condition=C_None);
@@ -490,6 +501,31 @@ Implementation
     end;
 
 
+  function TCpuAsmOptimizer.OptPass1FMov(var p: tai): Boolean;
+    var
+      hp1: tai;
+    begin
+      {
+        change
+        fmov reg0,reg1
+        fmov reg1,reg0
+        into
+        fmov reg0,reg1
+      }
+      Result := False;
+      while GetNextInstruction(p, hp1) and
+        MatchInstruction(hp1, A_FMOV, [taicpu(p).condition], [taicpu(p).oppostfix]) and
+        MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[1]^) and
+        MatchOperand(taicpu(p).oper[1]^, taicpu(hp1).oper[0]^) do
+        begin
+          asml.Remove(hp1);
+          hp1.free;
+          DebugMsg(SPeepholeOptimization + 'FMovFMov2FMov done', p);
+          Result:=true;
+        end;
+    end;
+
+
   function TCpuAsmOptimizer.OptPostCMP(var p : tai): boolean;
     var
      hp1,hp2: tai;
@@ -580,7 +616,9 @@ Implementation
                 if GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
                   RemoveSuperfluousFMov(p, hp1, 'FOpFMov2FOp') then
                   Result:=true;
-              end
+              end;
+            A_FMOV:
+              Result:=OptPass1FMov(p);
             else
               ;
           end;

compiler/link.pas

@@ -882,7 +882,7 @@ Implementation
               if (target_ar.id in [ar_gnu_ar_scripted,ar_sdcc_sdar_scripted]) then
                 writeln(script, 'CREATE ' + current_module.staticlibfilename)
               else { wlib case }
-                writeln(script,'-q -fo -c -b '+
+                writeln(script,'-q -p=16 -fo -c -b '+
                   maybequoted(current_module.staticlibfilename));
               current := TCmdStrListItem(SmartLinkOFiles.First);
               while current <> nil do
@@ -1743,8 +1743,8 @@ Implementation
       ar_watcom_wlib_omf_info : tarinfo =
           ( id          : ar_watcom_wlib_omf;
             addfilecmd  : '+';
-            arfirstcmd  : 'wlib -q -fo -c -b -n -o=$OUTPUTLIB $LIB $FILES';
-            arcmd       : 'wlib -q -fo -c -b -o=$OUTPUTLIB $LIB $FILES';
+            arfirstcmd  : 'wlib -q -p=16 -fo -c -b -n -o=$OUTPUTLIB $LIB $FILES';
+            arcmd       : 'wlib -q -p=16 -fo -c -b -o=$OUTPUTLIB $LIB $FILES';
             arfinishcmd : ''
           );
 

compiler/nadd.pas

@@ -1326,7 +1326,9 @@ implementation
                    (right.nodetype in [ltn,lten,gtn,gten]) and
                    (not might_have_sideeffects(left)) and
                    (not might_have_sideeffects(right)) and
-                   is_range_test(taddnode(left),taddnode(right),vl,cl,cr) then
+                   is_range_test(taddnode(left),taddnode(right),vl,cl,cr) and
+                   { avoid optimization being applied to (<string. var > charconst1) and (<string. var < charconst2) }
+                   (vl.resultdef.typ in [orddef,enumdef]) then
                   begin
                     hdef:=get_unsigned_inttype(vl.resultdef);
                     vl:=ctypeconvnode.create_internal(vl.getcopy,hdef);
@@ -3000,7 +3002,7 @@ implementation
             end;
           end;
 
-         if not codegenerror and
+         if (errorcount=0) and
             not assigned(result) then
            result:=simplify(false);
       end;

compiler/ncgcal.pas

@@ -623,6 +623,18 @@ implementation
              assigned(funcretnode) then
             hlcg.gen_load_cgpara_loc(current_asmdata.CurrAsmList,realresdef,retloc,location,false);
 
+        if ((location.loc=LOC_REGISTER) and
+            not realresdef.is_intregable) or
+           ((location.loc in [LOC_FPUREGISTER,LOC_MMREGISTER]) and
+            (not realresdef.is_fpuregable or
+             ((location.loc=LOC_MMREGISTER)<>use_vectorfpu(realresdef)))) then
+          begin
+            hlcg.location_force_mem(current_asmdata.CurrAsmList,location,realresdef);
+            { may have been record returned in a floating point register (-> location.size
+              will be the size of the fpuregister instead of the int size of the record) }
+            location.size:=def_cgsize(realresdef);
+          end;
+
         { copy value to the final location if this was already provided to the
           callnode. This must be done after the call node, because the location can
           also be used as parameter and may not be finalized yet }

compiler/ncgrtti.pas

@@ -623,7 +623,7 @@ implementation
           begin
             sym:=tsym(fields[i]);
             write_rtti_reference(tcb,tfieldvarsym(sym).vardef,rt);
-            tcb.emit_ord_const(tfieldvarsym(sym).fieldoffset,ptruinttype);
+            tcb.emit_ord_const(tfieldvarsym(sym).fieldoffset,sizeuinttype);
           end;
         fields.free;
       end;

compiler/pdecsub.pas

@@ -3178,9 +3178,14 @@ const
                     result:=target_info.Cprefix+tprocdef(pd).procsym.realname
                   else
                     result:=pd.procsym.realname;
+{$ifdef i8086}
+                  { Turbo Pascal expects names of external routines
+                    to be all uppercase }
                   if (target_info.system=system_i8086_msdos) and
+                    (m_tp7 in current_settings.modeswitches) and
                     (pd.proccalloption=pocall_pascal) then
                     result:=UpCase(result);
+{$endif i8086}
                 end;
             end;
           end;

compiler/scanner.pas

@@ -460,6 +460,16 @@ implementation
                   end;
               end;
           end;
+
+{$ifdef i8086}
+        { enable cs_force_far_calls when m_nested_procvars is enabled }
+        if switch=m_nested_procvars then
+          begin
+            include(current_settings.localswitches,cs_force_far_calls);
+            if changeinit then
+              include(init_settings.localswitches,cs_force_far_calls);
+          end;
+{$endif i8086}
       end;
 
 
@@ -605,12 +615,18 @@ implementation
              end;
 
 {$ifdef i8086}
-           { Do not force far calls in the TP mode by default }
+           { Do not force far calls in the TP mode by default, force it in other modes }
            if (m_tp7 in current_settings.modeswitches) then
              begin
                exclude(current_settings.localswitches,cs_force_far_calls);
                if changeinit then
                  exclude(init_settings.localswitches,cs_force_far_calls);
+             end
+           else
+             begin
+               include(current_settings.localswitches,cs_force_far_calls);
+               if changeinit then
+                 include(init_settings.localswitches,cs_force_far_calls);
              end;
 {$endif i8086}
 

compiler/systems.pas

@@ -100,8 +100,8 @@ interface
        tarinfo = record
           id          : tar;
           addfilecmd  : string[10];
-          arfirstcmd  : string[50];
-          arcmd       : string[50];
+          arfirstcmd  : string[60];
+          arcmd       : string[60];
           arfinishcmd : string[11];
        end;
 

compiler/x86/aoptx86.pas

@@ -1788,14 +1788,16 @@ unit aoptx86;
           InternalError(2020072501);
 
         { do not mess with the stack point as adjusting it by lea is recommend, except if we optimize for size }
-         if (taicpu(p).oper[1]^.reg=NR_STACK_POINTER_REG) and
+         if (p.oper[1]^.reg=NR_STACK_POINTER_REG) and
            not(cs_opt_size in current_settings.optimizerswitches) then
            exit;
 
          with p.oper[0]^.ref^ do
           begin
-            if (base <> p.oper[1]^.reg) or (index <> NR_NO) then
-              Exit(False);
+            if (base <> p.oper[1]^.reg) or
+               (index <> NR_NO) or
+               assigned(symbol) then
+              exit;
 
             l:=offset;
             if (l=1) and UseIncDec then

compiler/xtensa/aoptcpu.pas

@@ -43,6 +43,8 @@ Interface
         function InstructionLoadsFromReg(const reg: TRegister; const hp: tai): boolean;override;
         function GetNextInstructionUsingReg(Current : tai; out Next : tai; reg : TRegister) : Boolean;
         procedure DebugMsg(const s : string; p : tai);
+
+        function PeepHoleOptPass1Cpu(var p: tai): boolean; override;
       private
         function RemoveSuperfluousMove(const p: tai; movp: tai; const optimizer: string): boolean;
       End;
@@ -145,6 +147,24 @@ Implementation
       Result := false;
       if not ((assigned(hp)) and (hp.typ = ait_instruction)) then
         exit;
+
+      if Result then
+        exit;
+
+      case p.opcode of
+        A_B,
+        A_SSI,A_SSIU,A_SSX,A_SSXU,
+        A_S16I,A_S32C1I,A_S32E,A_S32I,A_S32RI,A_S8I:
+          exit;
+        else
+          ;
+      end;
+      case p.oper[0]^.typ of
+        top_reg:
+          Result := (p.oper[0]^.reg = reg) ;
+        else
+          ;
+      end;
     end;
 
 
@@ -192,7 +212,6 @@ Implementation
     begin
       Result:=false;
       if MatchInstruction(movp, A_MOV, [PF_None,PF_N]) and
-        (taicpu(p).ops>=3) and
         { We can't optimize if there is a shiftop }
         (taicpu(movp).ops=2) and
         MatchOperand(taicpu(movp).oper[1]^, taicpu(p).oper[0]^.reg) and
@@ -200,10 +219,10 @@ Implementation
         not(RegUsedBetween(taicpu(movp).oper[0]^.reg,p,movp)) and
         { Take care to only do this for instructions which REALLY load to the first register.
           Otherwise
-            str reg0, [reg1]
+            s*  reg0, [reg1]
             mov reg2, reg0
           will be optimized to
-            str reg2, [reg1]
+            s*  reg2, [reg1]
         }
         RegLoadedWithNewValue(taicpu(p).oper[0]^.reg, p) then
         begin
@@ -239,25 +258,38 @@ Implementation
 
               { finally get rid of the mov }
               taicpu(p).loadreg(0,taicpu(movp).oper[0]^.reg);
-              { Remove preindexing and postindexing for LDR in some cases.
-                For example:
-                  ldr	reg2,[reg1, xxx]!
-                  mov reg1,reg2
-                must be translated to:
-                  ldr	reg1,[reg1, xxx]
-
-                Preindexing must be removed there, since the same register is used as the base and as the target.
-                Such case is not allowed for ARM CPU and produces crash. }
-              //if (taicpu(p).opcode = A_LDR) and (taicpu(p).oper[1]^.typ = top_ref)
-              //  and (taicpu(movp).oper[0]^.reg = taicpu(p).oper[1]^.ref^.base)
-              //then
-              //  taicpu(p).oper[1]^.ref^.addressmode:=AM_OFFSET;
               asml.remove(movp);
               movp.free;
             end;
         end;
     end;
 
+
+  function TCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean;
+    var
+      hp1: tai;
+    begin
+      result := false;
+      case p.typ of
+        ait_instruction:
+          begin
+            case taicpu(p).opcode of
+              A_L32I:
+                begin
+                  if GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
+                    RemoveSuperfluousMove(p, hp1, 'L32IMov2L32I') then
+                    Result:=true;
+                end;
+              else
+                ;
+            end;
+          end
+        else
+          ;
+      end
+    end;
+
+
 begin
   casmoptimizer:=TCpuAsmOptimizer;
 End.

packages/fcl-db/src/sql/fpsqlparser.pas

@@ -2880,7 +2880,10 @@ begin
         Result:=TSQLAsteriskExpression(CreateElement(TSQLAsteriskExpression,APArent));
         GetNextToken;
         end;
-      tsqlIdentifier:
+    else
+      // some keywords (FirstKeyword..LastKeyWord) can also be functions/identifiers (LEFT, RIGHT)
+      //   To-Do: remove some of them if necessary
+      if CurrentToken in [tsqlIdentifier, FirstKeyword..LastKeyWord] then
         begin
         N:=CurrentTokenString;
         If (GetNextToken<>tsqlBraceOpen) then
@@ -2941,10 +2944,10 @@ begin
           TSQLFunctionCallExpression(Result).IDentifier:=N;
           TSQLFunctionCallExpression(Result).Arguments:=L;
           end;
-        end;
+        end
       else
         UnexpectedToken;
-      end;
+    end;
   except
     FreeAndNil(Result);
     Raise;

packages/fcl-db/tests/tcparser.pas

@@ -450,6 +450,7 @@ type
     procedure TestAggregateAvgDistinct;
     procedure TestUpperConst;
     procedure TestUpperError;
+    procedure TestLeft;
     procedure TestGenID;
     procedure TestGenIDError1;
     procedure TestGenIDError2;
@@ -4778,6 +4779,31 @@ begin
   AssertAggregateExpression(H.Left,afCount,'C',aoNone);
 end;
 
+procedure TTestSelectParser.TestLeft;
+
+Var
+  E : TSQLFunctionCallExpression;
+  L : TSQLLiteralExpression;
+  S : TSQLStringLiteral;
+  I : TSQLIntegerLiteral;
+
+begin
+  TestSelect('SELECT LEFT(''abc'', 1) FROM A');
+  AssertEquals('One field',1,Select.Fields.Count);
+  AssertEquals('One table',1,Select.Tables.Count);
+  AssertTable(Select.Tables[0],'A');
+  CheckClass(Select.Fields[0],TSQLSelectField);
+  E:=TSQLFunctionCallExpression(CheckClass(TSQLSelectField(Select.Fields[0]).Expression,TSQLFunctionCallExpression));
+  AssertEquals('LEFT function name','LEFT',E.Identifier);
+  AssertEquals('Two function elements',2,E.Arguments.Count);
+  L:=TSQLLiteralExpression(CheckClass(E.Arguments[0],TSQLLiteralExpression));
+  S:=TSQLStringLiteral(CheckClass(L.Literal,TSQLStringLiteral));
+  AssertEquals('Correct string constant','abc',S.Value);
+  L:=TSQLLiteralExpression(CheckClass(E.Arguments[1],TSQLLiteralExpression));
+  I:=TSQLIntegerLiteral(CheckClass(L.Literal,TSQLIntegerLiteral));
+  AssertEquals('Correct integer constant',1,I.Value);
+end;
+
 procedure TTestSelectParser.TestNoTable;
 
 Var

packages/fcl-passrc/src/pasresolver.pp

@@ -1423,10 +1423,21 @@ type
     //ToDo: proStaticArrayConcat, // concat works with static arrays, returning a dynamic array
     proProcTypeWithoutIsNested, // proc types can use nested procs without 'is nested'
     proMethodAddrAsPointer,  // can assign @method to a pointer
-    proSafecallAllowsDefault // allow assigning a default calling convetnion to a SafeCall proc
+    proSafecallAllowsDefault // allow assigning a default calling convention to a SafeCall proc
     );
   TPasResolverOptions = set of TPasResolverOption;
 
+  { TPasResolverHub }
+
+  TPasResolverHub = class
+  private
+    FOwner: TObject;
+  public
+    constructor Create(TheOwner: TObject);
+    property Owner: TObject read FOwner;
+  end;
+  TPasResolverHubClass = class of TPasResolverHub;
+
   TPasResolverStep = (
     prsInit,
     prsParsing,
@@ -1480,6 +1491,7 @@ type
     FDefaultScope: TPasDefaultScope;
     FDynArrayMaxIndex: TMaxPrecInt;
     FDynArrayMinIndex: TMaxPrecInt;
+    FHub: TPasResolverHub;
     FLastCreatedData: array[TResolveDataListKind] of TResolveData;
     FLastElement: TPasElement;
     FLastMsg: string;
@@ -2363,10 +2375,12 @@ type
     function FindLocalBuiltInSymbol(El: TPasElement): TPasElement; virtual;
     function GetFirstSection(WithUnitImpl: boolean): TPasSection;
     function GetLastSection: TPasSection;
+    function GetParentSection(El: TPasElement): TPasSection;
     function FindUsedUnitInSection(aMod: TPasModule; Section: TPasSection): TPasUsesUnit;
     function GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
       isLoFunc: Boolean; out Mask: LongWord): Integer;
   public
+    property Hub: TPasResolverHub read FHub write FHub;
     // options
     property Options: TPasResolverOptions read FOptions write FOptions;
     property AnonymousElTypePostfix: String read FAnonymousElTypePostfix
@@ -2381,15 +2395,15 @@ type
     property ExprEvaluator: TResExprEvaluator read fExprEvaluator;
     property DynArrayMinIndex: TMaxPrecInt read FDynArrayMinIndex write FDynArrayMinIndex;
     property DynArrayMaxIndex: TMaxPrecInt read FDynArrayMaxIndex write FDynArrayMaxIndex;
+    property StoreSrcColumns: boolean read FStoreSrcColumns write FStoreSrcColumns; {
+       If true Line and Column is mangled together in TPasElement.SourceLineNumber.
+       Use method UnmangleSourceLineNumber to extract. }
     // parsed values
     property DefaultNameSpace: String read FDefaultNameSpace;
     property RootElement: TPasModule read FRootElement write SetRootElement;
     property Step: TPasResolverStep read FStep;
     property ActiveHelpers: TPRHelperEntryArray read FActiveHelpers;
     // scopes
-    property StoreSrcColumns: boolean read FStoreSrcColumns write FStoreSrcColumns; {
-       If true Line and Column is mangled together in TPasElement.SourceLineNumber.
-       Use method UnmangleSourceLineNumber to extract. }
     property Scopes[Index: integer]: TPasScope read GetScopes;
     property ScopeCount: integer read FScopeCount;
     property TopScope: TPasScope read FTopScope;
@@ -3063,6 +3077,13 @@ begin
   str(a,Result);
 end;
 
+{ TPasResolverHub }
+
+constructor TPasResolverHub.Create(TheOwner: TObject);
+begin
+  FOwner:=TheOwner;
+end;
+
 { TPRSpecializedItem }
 
 destructor TPRSpecializedItem.Destroy;
@@ -11780,6 +11801,8 @@ var
   C: TClass;
   ModScope: TPasModuleScope;
 begin
+  if Hub=nil then
+    RaiseNotYetImplemented(20200815182122,El);
   if TopScope<>DefaultScope then
     RaiseInvalidScopeForElement(20160922163504,El);
   ModScope:=TPasModuleScope(PushScope(El,FScopeClass_Module));
@@ -29229,6 +29252,16 @@ begin
     Result:=Module.InterfaceSection;
 end;
 
+function TPasResolver.GetParentSection(El: TPasElement): TPasSection;
+begin
+  while El<>nil do
+    begin
+    if El is TPasSection then exit(TPasSection(El));
+    El:=El.Parent;
+    end;
+  Result:=nil;
+end;
+
 function TPasResolver.FindUsedUnitInSection(aMod: TPasModule;
   Section: TPasSection): TPasUsesUnit;
 var

packages/fcl-passrc/src/pastree.pp

@@ -1750,7 +1750,7 @@ const
   cPasMemberHint : Array[TPasMemberHint] of string =
       ( 'deprecated', 'library', 'platform', 'experimental', 'unimplemented' );
   cCallingConventions : Array[TCallingConvention] of string =
-      ( '', 'Register','Pascal','CDecl','StdCall','OldFPCCall','SafeCall','SysCall','MWPascal',
+      ( '', 'Register','Pascal','cdecl','stdcall','OldFPCCall','safecall','SysCall','MWPascal',
                         'HardFloat','SysV_ABI_Default','SysV_ABI_CDecl',
                         'MS_ABI_Default','MS_ABI_CDecl',
                         'VectorCall');
@@ -4208,7 +4208,7 @@ end;
 
 function TPasClassOfType.GetDeclaration (full : boolean) : string;
 begin
-  Result:='Class of '+DestType.SafeName;
+  Result:='class of '+DestType.SafeName;
   If Full then
     Result:=FixTypeDecl(Result);
 end;

packages/fcl-passrc/src/paswrite.pp

@@ -43,6 +43,8 @@ type
                       );
   TPasWriterOptions = Set of TPasWriterOption;
 
+  TOnUnitAlias = function(const UnitName : String) : String of Object;
+
   TPasWriter = class
   private
     FCurrentLineNumber : Integer;
@@ -51,6 +53,7 @@ type
     FForwardClasses: TStrings;
     FLineEnding: String;
     FLineNumberWidth: Integer;
+    FOnUnitAlias: TOnUnitAlias;
     FOPtions: TPasWriterOptions;
     FStream: TStream;
     FIndentSize : Integer;
@@ -63,6 +66,7 @@ type
     FInImplementation : Boolean;
     procedure SetForwardClasses(AValue: TStrings);
     procedure SetIndentSize(AValue: Integer);
+    function CheckUnitAlias(const AUnitName : String) : String;
   protected
     procedure DisableHintsWarnings;
     procedure PrepareDeclSectionInStruct(const ADeclSection: string);
@@ -132,6 +136,7 @@ type
     procedure wrtln;overload; deprecated ;
     property Stream: TStream read FStream;
   Published
+    Property OnUnitAlias : TOnUnitAlias Read FOnUnitAlias Write FOnUnitAlias;
     Property Options : TPasWriterOptions Read FOPtions Write FOptions;
     Property IndentSize : Integer Read FIndentSize Write SetIndentSize;
     Property LineEnding : String Read FLineEnding Write FLineEnding;
@@ -478,7 +483,7 @@ end;
 procedure TPasWriter.WriteUnit(aModule: TPasModule);
 
 begin
-  AddLn('unit ' + AModule.SafeName + ';');
+  AddLn('unit ' + CheckUnitAlias(AModule.SafeName) + ';');
   if Assigned(AModule.GlobalDirectivesSection) then
     begin
     AddLn;
@@ -556,7 +561,7 @@ Var
       Add(', ')
     else
       Add('uses ');
-    Add(AName);
+    Add(CheckUnitAlias(AName));
     if (AUnitFile<>Nil) then
       Add(' in '+GetExpr(AUnitFile));
     Inc(c);
@@ -848,9 +853,7 @@ end;
 procedure TPasWriter.WriteRecordType(AType: TPasRecordType);
 
 Var
-  I : Integer;
   Temp : String;
-  el : TPasElement;
 
 begin
   Temp:='record';
@@ -1490,6 +1493,14 @@ begin
   FIndentStep:=StringOfChar(' ',aValue);
 end;
 
+function TPasWriter.CheckUnitAlias(const AUnitName: String): String;
+begin
+  if Assigned(FOnUnitAlias) then
+    Result := FOnUnitAlias(AUnitName)
+  else
+    Result := AUnitName;
+end;
+
 function TPasWriter.HasOption(aOption: TPasWriterOption): Boolean;
 begin
   Result:=(aOption in FOptions)

packages/fcl-passrc/tests/tcresolver.pas

@@ -112,6 +112,7 @@ type
 
   TCustomTestResolver = Class(TTestParser)
   Private
+    FHub: TPasResolverHub;
     {$IF defined(VerbosePasResolver) or defined(VerbosePasResolverMem)}
     FStartElementRefCount: int64;
     {$ENDIF}
@@ -173,6 +174,7 @@ type
     procedure StartUnit(NeedSystemUnit: boolean);
     property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
     property ModuleCount: integer read GetModuleCount;
+    property Hub: TPasResolverHub read FHub;
     property ResolverEngine: TTestEnginePasResolver read FResolverEngine;
     property MsgCount: integer read GetMsgCount;
     property Msgs[Index: integer]: TTestResolverMessage read GetMsgs;
@@ -1060,6 +1062,7 @@ begin
   FStartElementRefCount:=TPasElement.GlobalRefCount;
   {$ENDIF}
   FModules:=TObjectList.Create(true);
+  FHub:=TPasResolverHub.Create(Self);
   inherited SetUp;
   Parser.Options:=Parser.Options+[po_ResolveStandardTypes];
   Scanner.OnDirective:=@OnScannerDirective;
@@ -1096,6 +1099,7 @@ begin
     FModules.OwnsObjects:=true;
     FreeAndNil(FModules);// free all other modules
     end;
+  FreeAndNil(FHub);
   {$IFDEF VerbosePasResolverMem}
   writeln('TTestResolver.TearDown inherited');
   {$ENDIF}
@@ -2171,6 +2175,7 @@ begin
   Result.AddObjFPCBuiltInIdentifiers;
   Result.OnFindUnit:=@OnPasResolverFindUnit;
   Result.OnLog:=@OnPasResolverLog;
+  Result.Hub:=Hub;
   FModules.Add(Result);
 end;
 

packages/pastojs/src/fppas2js.pp

@@ -1369,6 +1369,11 @@ type
     property TargetProcessor: TPasToJsProcessor read FTargetProcessor write FTargetProcessor;
   end;
 
+  { TPas2JSResolverHub }
+
+  TPas2JSResolverHub = class(TPasResolverHub)
+  end;
+
   { TPas2JSResolver }
 
   TPas2JSResolver = class(TPasResolver)
@@ -1473,6 +1478,7 @@ type
     // generic/specialize
     procedure SpecializeGenericImpl(SpecializedItem: TPRSpecializedItem);
       override;
+    function SpecializeNeedsDelay(SpecializedItem: TPRSpecializedItem): TPasElement;
   protected
     const
       cJSValueConversion = 2*cTypeConversion;
@@ -4900,6 +4906,47 @@ begin
     end;
 end;
 
+function TPas2JSResolver.SpecializeNeedsDelay(
+  SpecializedItem: TPRSpecializedItem): TPasElement;
+// finds first specialize param defined later than the generic
+// For example: generic in the unit interface, param in implementation
+// or param in another unit, not used by the generic
+var
+  Gen: TPasElement;
+  GenMod, ParamMod: TPasModule;
+  Params: TPasTypeArray;
+  Param: TPasType;
+  i: Integer;
+  GenSection, ParamSection: TPasSection;
+begin
+  Result:=nil;
+  Gen:=SpecializedItem.GenericEl;
+  GenSection:=GetParentSection(Gen);
+  if not (GenSection is TInterfaceSection) then
+    exit; // generic in unit implementation/program/library -> params cannot be defined a later section
+  GenMod:=GenSection.GetModule;
+
+  Params:=SpecializedItem.Params;
+  for i:=0 to length(Params)-1 do
+    begin
+    Param:=ResolveAliasType(Params[i],false);
+    if Param.ClassType=TPasUnresolvedSymbolRef then
+      continue; // built-in type
+    ParamSection:=GetParentSection(Param);
+    if ParamSection=GenSection then continue;
+    // not in same section
+    ParamMod:=ParamSection.GetModule;
+    if ParamMod=GenMod then
+      exit(Param); // generic in unit interface, specialize in implementation
+    // param in another unit
+    if ParamSection is TImplementationSection then
+      exit(Param); // generic in unit interface, specialize in another(later) implementation
+    // param in another unit interface
+
+    //xxx
+    end;
+end;
+
 function TPas2JSResolver.AddJSBaseType(const aName: string; Typ: TPas2jsBaseType
   ): TResElDataPas2JSBaseType;
 var

packages/pastojs/src/pas2jscompiler.pp

@@ -500,6 +500,7 @@ type
     FPostProcessorSupport: TPas2JSPostProcessorSupport;
     FPrecompileGUID: TGUID;
     FReadingModules: TFPList; // list of TPas2jsCompilerFile ordered by uses sections
+    FResolverHub: TPas2JSResolverHub;
     FRTLVersionCheck: TP2jsRTLVersionCheck;
     FSrcMapBaseDir: string;
     FSrcMapSourceRoot: string;
@@ -680,14 +681,15 @@ type
     property DefaultNamespace: String read GetDefaultNamespace;
     property Defines: TStrings read FDefines;
     property FS: TPas2jsFS read FFS write SetFS;
-    property OwnsFS: boolean read FOwnsFS write FOwnsFS;
+    property OwnsFS: boolean read FOwnsFS write FOwnsFS; // true = auto free FS when compiler is freed
     property FileCount: integer read GetFileCount;
-    property InterfaceType: TPasClassInterfaceType read FInterfaceType write FInterfaceType;
+    property InterfaceType: TPasClassInterfaceType read FInterfaceType write FInterfaceType; // default interface type
     property Log: TPas2jsLogger read FLog;
     property MainFile: TPas2jsCompilerFile read FMainFile;
     property ModeSwitches: TModeSwitches read FModeSwitches write SetModeSwitches;
     property Options: TP2jsCompilerOptions read FOptions write SetOptions;
     property ConverterGlobals: TPasToJSConverterGlobals read FConverterGlobals write SetConverterGlobals;
+    property ResolverHub: TPas2JSResolverHub read FResolverHub;
     property ParamMacros: TPas2jsMacroEngine read FParamMacros;
     property PrecompileGUID: TGUID read FPrecompileGUID write FPrecompileGUID;
     property RTLVersionCheck: TP2jsRTLVersionCheck read FRTLVersionCheck write FRTLVersionCheck;
@@ -965,6 +967,7 @@ begin
   FPasResolver.OnCheckSrcName:=@OnResolverCheckSrcName;
   FPasResolver.OnLog:=@OnPasResolverLog;
   FPasResolver.Log:=Log;
+  FPasResolver.Hub:=aCompiler.ResolverHub;
   FPasResolver.AddObjFPCBuiltInIdentifiers(btAllJSBaseTypes,bfAllJSBaseProcs);
   FIsMainFile:=Compiler.FS.SameFileName(Compiler.MainSrcFile,PasFilename);
   for ub in TUsedBySection do
@@ -4191,6 +4194,7 @@ constructor TPas2jsCompiler.Create;
 begin
   FOptions:=DefaultP2jsCompilerOptions;
   FConverterGlobals:=TPasToJSConverterGlobals.Create(Self);
+  FResolverHub:=TPas2JSResolverHub.Create(Self);
   FNamespaces:=TStringList.Create;
   FDefines:=TStringList.Create;
   FInsertFilenames:=TStringList.Create;
@@ -4232,6 +4236,7 @@ destructor TPas2jsCompiler.Destroy;
     FreeAndNil(FPostProcessorSupport);
     FreeAndNil(FConfigSupport);
     ConverterGlobals:=nil;
+    FreeAndNil(FResolverHub);
 
     ClearDefines;
     FreeAndNil(FDefines);

packages/pastojs/tests/tcgenerics.pas

@@ -67,6 +67,7 @@ type
     procedure TestGenProc_TypeInfo;
     procedure TestGenProc_Infer_Widen;
     procedure TestGenProc_Infer_PassAsArg;
+    // ToDo: delay create: type TRec=record end; ... r:=GenProc<TRec>();
     // ToDo: FuncName:= instead of Result:=
 
     // generic methods

packages/pastojs/tests/tcmodules.pas

@@ -111,6 +111,7 @@ type
     FExpectedErrorNumber: integer;
     FFilename: string;
     FFileResolver: TStreamResolver;
+    FHub: TPas2JSResolverHub;
     FJSImplementationSrc: TJSSourceElements;
     FJSImplementationUses: TJSArrayLiteral;
     FJSInitBody: TJSFunctionBody;
@@ -216,6 +217,7 @@ type
   public
     constructor Create; override;
     destructor Destroy; override;
+    property Hub: TPas2JSResolverHub read FHub;
     property Source: TStringList read FSource;
     property FileResolver: TStreamResolver read FFileResolver;
     property Scanner: TPas2jsPasScanner read FScanner;
@@ -1310,6 +1312,8 @@ begin
   inherited SetUp;
   FSkipTests:=false;
   FSource:=TStringList.Create;
+
+  FHub:=TPas2JSResolverHub.Create(Self);
   FModules:=TObjectList.Create(true);
 
   FFilename:='test1.pp';
@@ -1404,6 +1408,7 @@ begin
     ReleaseAndNil(TPasElement(FModule){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
     FEngine:=nil;
     end;
+  FreeAndNil(FHub);
 
   inherited TearDown;
   {$IFDEF EnablePasTreeGlobalRefCount}
@@ -1558,6 +1563,7 @@ begin
   Result.AddObjFPCBuiltInIdentifiers(btAllJSBaseTypes,bfAllJSBaseProcs);
   Result.OnFindUnit:=@OnPasResolverFindUnit;
   Result.OnLog:=@OnPasResolverLog;
+  Result.Hub:=Hub;
   FModules.Add(Result);
 end;
 

packages/regexpr/src/regexpr.pas

@@ -56,7 +56,8 @@ interface
 {$BOOLEVAL OFF}
 {$EXTENDEDSYNTAX ON}
 {$LONGSTRINGS ON}
-{$OPTIMIZATION ON}
+{ use optimization settings passed via fpmake/make }
+{OPTIMIZATION ON}
 
 // ======== Define options for TRegExpr engine
 {$DEFINE UseFirstCharSet} // Enable optimization, which finds possible first chars of input string

packages/winunits-base/src/comobj.pp

@@ -325,6 +325,7 @@ unit ComObj;
       CoResumeClassObjects : TCoResumeClassObjectsProc = nil;
       CoSuspendClassObjects : TCoSuspendClassObjectsProc = nil;
       CoInitFlags : Longint = -1;
+      CoInitDisable : Boolean = False;
 
   {$ifdef DEBUG_COM}
      var printcom : boolean=true;
@@ -1877,6 +1878,20 @@ const
   Initialized : boolean = false;
 var
   Ole32Dll : HModule;
+  SaveInitProc : CodePointer;
+
+procedure InitComObj;
+begin
+  if SaveInitProc<>nil then
+    TProcedure(SaveInitProc)();
+  if not CoInitDisable then
+{$ifndef wince}
+    if (CoInitFlags=-1) or not(assigned(ComObj.CoInitializeEx)) then
+      Initialized:=Succeeded(CoInitialize(nil))
+    else
+{$endif wince}
+      Initialized:=Succeeded(ComObj.CoInitializeEx(nil, CoInitFlags));
+end;
 
 initialization
   Uninitializing:=false;
@@ -1893,12 +1908,10 @@ initialization
     end;
 
   if not(IsLibrary) then
-{$ifndef wince}
-    if (CoInitFlags=-1) or not(assigned(comobj.CoInitializeEx)) then
-      Initialized:=Succeeded(CoInitialize(nil))
-    else
-{$endif wince}
-      Initialized:=Succeeded(comobj.CoInitializeEx(nil, CoInitFlags));
+    begin
+      SaveInitProc:=InitProc;
+      InitProc:=@InitComObj;
+    end;
 
   SafeCallErrorProc:=@SafeCallErrorHandler;
   VarDispProc:=@ComObjDispatchInvoke;

rtl/freertos/consoleio.pp

@@ -169,7 +169,7 @@ finalization
      Writeln(pstdout^,'Runtime error ',Errorcode,' at $',hexstr(erroraddr));
      { to get a nice symify }
      Writeln(pstdout^,BackTraceStrFunc(Erroraddr));
-     dump_stack(pstdout^,ErrorBase);
+     dump_stack(pstdout^,ErrorBase,erroraddr);
      Writeln(pstdout^,'');
    End;
   SysFlushStdIO;

rtl/freertos/system.pp

@@ -208,6 +208,7 @@ const calculated_cmdline:Pchar=nil;
 {*****************************************************************************
                        Misc. System Dependent Functions
 *****************************************************************************}
+{$ifndef FPC_SYSTEM_HAS_STACKTOP}
 var
  _stack_top: record end; external name '_stack_top';
 
@@ -215,6 +216,7 @@ function StackTop: pointer;
 begin
   StackTop:=@_stack_top;
 end;
+{$endif FPC_SYSTEM_HAS_STACKTOP}
 
 
 procedure haltproc;cdecl;external name '_haltproc';

rtl/linux/m68k/sighnd.inc

@@ -62,8 +62,7 @@ Procedure ResetFPU;
 var
   l_fpucw : longint;
 begin
-  
-{$ifdef CPU68020}
+{$if defined(FPU68881) or defined(FPUCOLDFIRE)}
   asm 
     fmove.l fpcr,l_fpucw
   end;

rtl/linux/m68k/sighndh.inc

@@ -23,8 +23,8 @@ type
 
   pfpstate = ^tfpstate;
   tfpstate = record
-           pcr,psr,fpiaddr : longint;
-	   fpreg : array [0..7] of tfpreg;
+    pcr,psr,fpiaddr : longint;
+    fpreg : array [0..7] of tfpreg;
   end;
 
   { as defined in asm_m68k/signal.h }

rtl/xtensa/xtensa.inc

@@ -31,27 +31,114 @@ begin
     SysInitFPU;
 end;
 
-
-{$IFNDEF INTERNAL_BACKTRACE}
-{$define FPC_SYSTEM_HAS_GET_FRAME}
-function get_frame:pointer;assembler;nostackframe;
+{$ifdef fpc_abi_windowed}
+const
+  // Minimum call8 calls to force register spilling to stack for caller of forceSpilledRegs
+  spillcount = 6;
+
+procedure forceSpilledRegs(n: uint32); assembler; public name 'forcespilledregs';
+  label
+    done, fin;
   asm
+    beqz a2, done
+    addi a10, a2, -1
+    call8 forcespilledregs
+    done:
+    bnez a2, fin
+    movi a15, 0
+    fin:
+  end;
+
+procedure fixCodeAddress(var addr: pointer);
+  begin
+    // Check if valid code address
+    if ptruint(addr) and $C0000000 >= $40000000 then
+      begin
+        // Replace windowed call prefix
+        addr:=codepointer((ptruint(addr)and$00FFFFFF) or $40000000);
+        // Rewind to call instruction address
+        dec(addr,3);
+      end
+    else
+      addr:=nil;
   end;
+{$endif fpc_abi_windowed}
+
+{$IFNDEF INTERNAL_BACKTRACE}
+  {$define FPC_SYSTEM_HAS_GET_FRAME}
+  function get_frame:pointer;assembler;
+    label
+      done;
+    asm
+      {$ifdef fpc_abi_windowed}
+        // Force registers to spill onto stack
+        movi a10, spillcount
+        call8 forcespilledregs
+        // now get frame pointer of caller
+        addi a2, a1, -12
+        l32i a2, a2, 0
+        done:
+      {$else}
+        mov a2, a1
+      {$endif}
+    end;
 {$ENDIF not INTERNAL_BACKTRACE}
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;assembler;nostackframe;
-  asm
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;
+  begin
+    {$ifdef fpc_abi_windowed}
+      forceSpilledRegs(spillcount);
+      if (ptruint(framebp)>$3ff00000)and(ptruint(framebp)<$40000000) then
+        begin
+          get_caller_addr:=pointer((framebp-16)^);
+          fixCodeAddress(get_caller_addr);
+        end
+      else
+        get_caller_addr:=nil;
+    {$else}
+      get_caller_addr:=nil;
+    {$endif}
   end;
 
-
 {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;assembler;nostackframe;
-  asm
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;
+  begin
+    {$ifdef fpc_abi_windowed}
+      if (ptruint(framebp)>$3ff00000)and(ptruint(framebp)<$40000000) then
+        begin
+          forceSpilledRegs(spillcount);
+          get_caller_frame:=pointer((framebp-12)^);
+        end
+      else
+        get_caller_frame:=nil;
+    {$else}
+      get_caller_frame:=nil;
+    {$endif}
   end;
 
 
+{$ifdef fpc_abi_windowed}
+  {$define FPC_SYSTEM_HAS_GET_CALLER_STACKINFO}
+  procedure get_caller_stackinfo(var framebp : pointer; var addr : codepointer);
+    begin
+      if (ptruint(framebp)>$3ff00000)and(ptruint(framebp)<$40000000) then
+        begin
+          forceSpilledRegs(spillcount);
+          addr:=codepointer((framebp-16)^);
+          framebp := pointer((framebp-12)^);
+          fixCodeAddress(addr);
+        end
+      else
+        begin
+          addr:=nil;
+          framebp:=nil;
+        end;
+    end;
+{$endif fpc_abi_windowed}
+
+
 {$define FPC_SYSTEM_HAS_SPTR}
 Function Sptr : pointer;assembler;
   asm
@@ -59,6 +146,16 @@ Function Sptr : pointer;assembler;
   end;
 
 
+{$define FPC_SYSTEM_HAS_STACKTOP}
+// Interim fix for now, set to large address
+// TODO: provide more realistic value, possibly by inspecting stack pointer
+// when main or task is started
+function StackTop: pointer;
+  begin
+    StackTop:=pointer($3fffffff);
+  end;
+
+
 function InterLockedDecrement (var Target: longint) : longint;
   var
     temp_sreg : byte;

tests/tbs/tb0184.pp

@@ -2,6 +2,7 @@
 { in tp mode can't use the procvar in writeln          OK 0.99.11 (PFV) }
 
 {$ifdef fpc}{$mode tp}{$endif}
+{$F+}
 
 type tmpproc=function:longint;
 

tests/tbs/tb0218.pp

@@ -2,6 +2,7 @@
 { problem with procvars in tp mode                     OK 0.99.11 (PM) }
 
 {$mode tp}
+{$F+}
 
 type proc = procedure(a : longint);
 procedure test(b : longint);

tests/tbs/tb0251.pp

@@ -2,6 +2,7 @@
 { @procvar in tp mode bugss                             OK 0.99.13 (PFV) }
 
 {$ifdef fpc}{$mode tp}{$endif}
+{$F+}
 
 function ReturnString: string;
 begin

tests/tbs/tb0433.pp

@@ -4,6 +4,7 @@
 type
   codepointer = pointer;
 {$endif fpc}
+{$F+}
 
 function times2(x : longint) : longint;
 

tests/test/cg/taddr2.pp

@@ -16,6 +16,7 @@ program taddr;
 {$ifdef fpc}
   {$mode tp}
 {$endif}
+{$F+}
 
    procedure testprocvar;
      begin

tests/test/tprocvar2.pp

@@ -1,7 +1,7 @@
-{$F+}
 {$ifdef fpc}
 {$mode tp}
 {$endif fpc}
+{$F+}
 
 type
   tproc = procedure;

tests/webtbf/tw37476.pp

@@ -0,0 +1,5 @@
+{ %fail }
+var a : string = (a >= 'A') and (a <= 'F');
+
+begin
+end.

tests/webtbs/tw2059.pp

@@ -1,4 +1,5 @@
 {$mode tp}
+{$F+}
 type ProcType    = procedure(s:string);
      GetProcType = function(s:string;var Proc:ProcType):boolean;
 

tests/webtbs/tw2268.pp

@@ -2,6 +2,7 @@
 { Submitted by "marco" on  2002-12-19 }
 { e-mail: [email protected] }
 {$ifdef fpc}{$mode TP}{$endif}
+{$F+}
 
 function P1:longint; begin end;
 function P2:longint; begin end;

utils/pas2js/libstub.pp

@@ -147,6 +147,17 @@ begin
     Move(C[1],AErrorClass^,L);
 end;
 
+Procedure SetStubCreatorUnitAliasCallBack(P : PStubCreator; ACallBack : TUnitAliasCallBack; CallBackData : Pointer); stdcall;
+begin
+  TStubCreator(P).OnUnitAlias:=ACallBack;
+  TStubCreator(P).OnUnitAliasData:=CallBackData;
+end;
+
+Procedure AddStubCreatorExtraUnit(P : PStubCreator; AUnitName : PAnsiChar); stdcall;
+begin
+  TStubCreator(P).ExtraUnits:=AUnitName;
+end;
+
 exports
   // Stub creator
   GetStubCreator,
@@ -160,7 +171,9 @@ exports
   GetStubCreatorLastError,
   AddStubCreatorDefine,
   AddStubCreatorForwardClass,
-  ExecuteStubCreator;
+  AddStubCreatorExtraUnit,
+  ExecuteStubCreator,
+  SetStubCreatorUnitAliasCallBack;
 
 end.
 

utils/pas2js/stubcreator.pp

@@ -19,9 +19,6 @@ interface
 uses
   Classes, SysUtils, strutils, inifiles, pscanner, pparser, pastree, iostream, paswrite;
 
-Const
-  DTypesUnit = 'jsdelphisystem';
-
 type
   { We have to override abstract TPasTreeContainer methods  }
 
@@ -36,6 +33,8 @@ type
 
   TWriteCallBack = Procedure (Data : Pointer; AFileData : PAnsiChar; AFileDataLen: Int32); stdcall;
   TWriteEvent = Procedure(AFileData : String) of object;
+  TUnitAliasCallBack = Function (Data: Pointer; AUnitName: PAnsiChar;
+    var AUnitNameMaxLen: Int32): boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 
   { TStubCreator }
 
@@ -45,6 +44,7 @@ type
     FHeaderStream: TStream;
     FIncludePaths: TStrings;
     FInputFile: String;
+    FOnUnitAliasData: Pointer;
     FOnWrite: TWriteEvent;
     FOnWriteCallBack: TWriteCallBack;
     FOutputFile: String;
@@ -60,10 +60,12 @@ type
     FCallBackData : Pointer;
     FLastErrorClass : String;
     FLastError : String;
+    FOnUnitAlias : TUnitAliasCallBack;
     procedure SetDefines(AValue: TStrings);
     procedure SetIncludePaths(AValue: TStrings);
     procedure SetOnWrite(AValue: TWriteEvent);
     procedure SetWriteCallback(AValue: TWriteCallBack);
+    function CheckUnitAlias(const AUnitName: String): String;
   Protected
     procedure DoExecute;virtual;
     Procedure DoWriteEvent; virtual;
@@ -81,9 +83,11 @@ type
     // OutputStream can be used combined with write callbacks.
     Property OutputStream : TStream Read FOutputStream Write FOutputStream;
     Property HeaderStream : TStream Read FHeaderStream Write FHeaderStream;
+    Property OnUnitAlias: TUnitAliasCallBack read FOnUnitAlias Write FOnUnitAlias;
+    Property OnUnitAliasData : Pointer Read FOnUnitAliasData Write FOnUnitAliasData;
     Property OnWriteCallBack : TWriteCallBack Read FOnWriteCallBack Write SetWriteCallback;
     Property CallbackData : Pointer Read FCallBackData Write FCallBackData;
-
+    Property ExtraUnits : String Read FExtraUnits write FExtraUnits;
   Published
     Property Defines : TStrings Read FDefines Write SetDefines;
     Property ConfigFileName : String Read FConfigFile Write FConfigFile;
@@ -97,6 +101,8 @@ type
 
 Implementation
 
+uses Math;
+
 ResourceString
   SErrNoDestGiven = 'No destination file specified.';
   SErrNoSourceParsed = 'Parsing produced no file.';
@@ -131,6 +137,23 @@ begin
     FWriteStream:=TStringStream.Create('');
 end;
 
+function TStubCreator.CheckUnitAlias(const AUnitName: String): String;
+const
+  MAX_UNIT_NAME_LENGTH = 255;
+
+var
+   UnitMaxLenthName: Integer;
+
+begin
+  Result := AUnitName;
+  UnitMaxLenthName := Max(MAX_UNIT_NAME_LENGTH, Result.Length);
+
+  SetLength(Result, UnitMaxLenthName);
+
+  if FOnUnitAlias(OnUnitAliasData, @Result[1], UnitMaxLenthName) then
+    Result := LeftStr(PChar(Result), UnitMaxLenthName);
+end;
+
 procedure TStubCreator.DoWriteEvent;
 
 Var
@@ -279,7 +302,7 @@ end;
 
 
 
-Function TStubCreator.GetModule : TPasModule;
+function TStubCreator.GetModule: TPasModule;
 
 Var
   SE : TSimpleEngine;
@@ -327,7 +350,8 @@ begin
   end;
 end;
 
-function TStubCreator.MaybeGetFileStream(AStream: TStream; const AFileName: String; AfileMode : Word) : TStream;
+function TStubCreator.MaybeGetFileStream(AStream: TStream;
+  const AFileName: String; aFileMode: Word): TStream;
 begin
   If Assigned(AStream) then
     Result:=AStream
@@ -359,12 +383,11 @@ begin
 end;
 
 
-procedure TStubCreator.WriteModule(M : TPAsModule);
+procedure TStubCreator.WriteModule(M: TPasModule);
 
 Var
   F,H : TStream;
   W : TPasWriter;
-  U : String;
 
 begin
   W:=Nil;
@@ -385,14 +408,11 @@ begin
        end;
      W:=TPasWriter.Create(F);
      W.Options:=FOptions;
-     U:=FExtraUnits;
-     if Pos(LowerCase(DTypesUnit),LowerCase(U)) = 0 then
-       begin
-       if (U<>'') then
-         U:=','+U;
-       U:=DTypesUnit+U;
-       end;
-     W.ExtraUnits:=U;
+     W.ExtraUnits:=FExtraUnits;
+
+     if Assigned(FOnUnitAlias) then
+       W.OnUnitAlias:=@CheckUnitAlias;
+
      if FIndentSize<>-1 then
        W.IndentSize:=FIndentSize;
      if FLineNumberWidth>0 then