Преглед изворни кода

* synchronized with trunk

git-svn-id: branches/wasm@46851 -
nickysn пре 4 година
родитељ
комит
3d3653f7de

+ 32 - 22
compiler/rgobj.pas

@@ -641,17 +641,10 @@ unit rgobj;
           i8086 where indexed memory access instructions allow only
           i8086 where indexed memory access instructions allow only
           few registers as arguments and additionally the calling convention
           few registers as arguments and additionally the calling convention
           provides no general purpose volatile registers.
           provides no general purpose volatile registers.
-          
-          Also spill registers which have the initial memory location
-          and are used only once. This allows to access the memory location
-          directly, without preloading it to a register.
         }
         }
         for i:=first_imaginary to maxreg-1 do
         for i:=first_imaginary to maxreg-1 do
           with reginfo[i] do
           with reginfo[i] do
-            if (real_reg_interferences>=usable_registers_cnt) or
-               { also spill registers which have the initial memory location
-                 and are used only once }
-               ((ri_has_initial_loc in flags) and (weight<=200)) then
+            if real_reg_interferences>=usable_registers_cnt then
               spillednodes.add(i);
               spillednodes.add(i);
         if spillednodes.length<>0 then
         if spillednodes.length<>0 then
           begin
           begin
@@ -1706,6 +1699,15 @@ unit rgobj;
       for i:=selectstack.length downto 1 do
       for i:=selectstack.length downto 1 do
         begin
         begin
           n:=selectstack.buf^[i-1];
           n:=selectstack.buf^[i-1];
+          { Always spill the register if it has the initial memory location
+            and is used only once (weight<=200). This allows to access the
+            memory location directly, without preloading it to a register. }
+          with reginfo[n] do
+            if (ri_has_initial_loc in flags) and (weight<=200) then
+              begin
+                spillednodes.add(n);
+                continue;
+              end;
           {Create a list of colours that we cannot assign to n.}
           {Create a list of colours that we cannot assign to n.}
           adj_colours:=[];
           adj_colours:=[];
           adj:=reginfo[n].adjlist;
           adj:=reginfo[n].adjlist;
@@ -2146,30 +2148,38 @@ unit rgobj;
 
 
     procedure trgobj.translate_registers(list: TAsmList);
     procedure trgobj.translate_registers(list: TAsmList);
 
 
-      function get_reg_name_full(r: tregister): string;
+      function get_reg_name_full(r: tregister; include_prefix: boolean): string;
         var
         var
           rr:tregister;
           rr:tregister;
           sr:TSuperRegister;
           sr:TSuperRegister;
         begin
         begin
-          rr:=r;
           sr:=getsupreg(r);
           sr:=getsupreg(r);
           if reginfo[sr].live_start=nil then
           if reginfo[sr].live_start=nil then
             begin
             begin
               result:='';
               result:='';
               exit;
               exit;
             end;
             end;
-          setsupreg(rr,reginfo[sr].colour);
-          result:=std_regname(rr);
-{$if defined(cpu8bitalu) or defined(cpu16bitalu)}
-          if sr<first_int_imreg then
-            exit;
-          while cg.has_next_reg[sr] do
+          if (sr<length(spillinfo)) and spillinfo[sr].spilled then
+            with spillinfo[sr].spilllocation do
+              begin
+                result:='['+std_regname(base);
+                if offset>=0 then
+                  result:=result+'+';
+                result:=result+IntToStr(offset)+']';
+                if include_prefix then
+                  result:='stack '+result;
+              end
+          else
             begin
             begin
-              r:=cg.GetNextReg(r);
-              sr:=getsupreg(r);
+              rr:=r;
               setsupreg(rr,reginfo[sr].colour);
               setsupreg(rr,reginfo[sr].colour);
-              result:=result+':'+std_regname(rr);
+              result:=std_regname(rr);
+              if include_prefix then
+                result:='register '+result;
             end;
             end;
+{$if defined(cpu8bitalu) or defined(cpu16bitalu)}
+          if (sr>=first_int_imreg) and cg.has_next_reg[sr] then
+            result:=result+':'+get_reg_name_full(cg.GetNextReg(r),false);
 {$endif defined(cpu8bitalu) or defined(cpu16bitalu)}
 {$endif defined(cpu8bitalu) or defined(cpu16bitalu)}
         end;
         end;
 
 
@@ -2225,12 +2235,12 @@ unit rgobj;
                     begin
                     begin
                       if (cs_asm_source in current_settings.globalswitches) then
                       if (cs_asm_source in current_settings.globalswitches) then
                         begin
                         begin
-                          s:=get_reg_name_full(tai_varloc(p).newlocation);
+                          s:=get_reg_name_full(tai_varloc(p).newlocation,tai_varloc(p).newlocationhi=NR_NO);
                           if s<>'' then
                           if s<>'' then
                             begin
                             begin
                               if tai_varloc(p).newlocationhi<>NR_NO then
                               if tai_varloc(p).newlocationhi<>NR_NO then
-                                s:=get_reg_name_full(tai_varloc(p).newlocationhi)+':'+s;
-                              hp:=Tai_comment.Create(strpnew('Var '+tai_varloc(p).varsym.realname+' located in register '+s));
+                                s:=get_reg_name_full(tai_varloc(p).newlocationhi,true)+':'+s;
+                              hp:=Tai_comment.Create(strpnew('Var '+tai_varloc(p).varsym.realname+' located in '+s));
                               list.insertafter(hp,p);
                               list.insertafter(hp,p);
                             end;
                             end;
                           setsupreg(tai_varloc(p).newlocation,reginfo[getsupreg(tai_varloc(p).newlocation)].colour);
                           setsupreg(tai_varloc(p).newlocation,reginfo[getsupreg(tai_varloc(p).newlocation)].colour);

+ 1 - 1
compiler/symdef.pas

@@ -3901,7 +3901,7 @@ implementation
 
 
     constructor tclassrefdef.create(def:tdef);
     constructor tclassrefdef.create(def:tdef);
       begin
       begin
-         while tobjectdef(def).is_unique_objpasdef do
+         while (def.typ=objectdef) and tobjectdef(def).is_unique_objpasdef do
            def:=tobjectdef(def).childof;
            def:=tobjectdef(def).childof;
          inherited create(classrefdef,def);
          inherited create(classrefdef,def);
          if df_specialization in tstoreddef(def).defoptions then
          if df_specialization in tstoreddef(def).defoptions then

+ 27 - 6
compiler/xtensa/cgcpu.pas

@@ -660,10 +660,27 @@ implementation
                            inc(registerarea,4);
                            inc(registerarea,4);
                      end;
                      end;
 
 
-                  inc(localsize,registerarea);
-                  if LocalSize<>0 then
+                  if stack_parameters and (pi_estimatestacksize in current_procinfo.flags) then
+                    begin
+                      list.concat(tai_comment.Create(strpnew('Stackframe size was estimated before code generation due to stack parameters')));
+                      list.concat(tai_comment.Create(strpnew('  Calculated stackframe size: '+tostr(txtensaprocinfo(current_procinfo).stackframesize))));
+                      list.concat(tai_comment.Create(strpnew('  Max. outgoing parameter size: '+tostr(txtensaprocinfo(current_procinfo).maxpushedparasize))));
+                      list.concat(tai_comment.Create(strpnew('  End of last temporary location: '+tostr(tg.lasttemp))));
+                      list.concat(tai_comment.Create(strpnew('  Size of register area: '+tostr(registerarea))));
+                      list.concat(tai_comment.Create(strpnew('  Required size after code generation: '+tostr(localsize))));
+
+                      if localsize>txtensaprocinfo(current_procinfo).stackframesize then
+                        internalerror(2020091001);
+                      localsize:=txtensaprocinfo(current_procinfo).stackframesize;
+                    end
+                  else
                     begin
                     begin
+                      inc(localsize,registerarea);
                       localsize:=align(localsize,current_settings.alignment.localalignmax);
                       localsize:=align(localsize,current_settings.alignment.localalignmax);
+                    end;
+
+                  if LocalSize<>0 then
+                    begin
                       a_reg_alloc(list,NR_STACK_POINTER_REG);
                       a_reg_alloc(list,NR_STACK_POINTER_REG);
                       list.concat(taicpu.op_reg_reg_const(A_ADDI,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,-localsize));
                       list.concat(taicpu.op_reg_reg_const(A_ADDI,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,-localsize));
                     end;
                     end;
@@ -785,11 +802,16 @@ implementation
                          if r in regs then
                          if r in regs then
                            inc(registerarea,4);
                            inc(registerarea,4);
                      end;
                      end;
-                  inc(localsize,registerarea);
 
 
-                  if LocalSize<>0 then
+                  { do we use then estimated stack size? }
+                  if not(stack_parameters and (pi_estimatestacksize in current_procinfo.flags)) then
                     begin
                     begin
+                      inc(localsize,registerarea);
                       localsize:=align(localsize,current_settings.alignment.localalignmax);
                       localsize:=align(localsize,current_settings.alignment.localalignmax);
+                    end;
+
+                  if LocalSize<>0 then
+                    begin
                       // Determine reference mode required to access stack
                       // Determine reference mode required to access stack
                       reference_reset(ref,4,[]);
                       reference_reset(ref,4,[]);
                       ref.base:=NR_STACK_POINTER_REG;
                       ref.base:=NR_STACK_POINTER_REG;
@@ -798,8 +820,7 @@ implementation
                         begin
                         begin
                           if ref.offset<=1024+32512 then
                           if ref.offset<=1024+32512 then
                             begin
                             begin
-                              // allocation done in proc_entry
-                              //list.concat(taicpu.op_reg_reg_const(A_ADDMI,NR_A8,NR_STACK_POINTER_REG,ref.offset and $fffffc00));
+                              list.concat(taicpu.op_reg_reg_const(A_ADDMI,NR_A8,NR_STACK_POINTER_REG,ref.offset and $fffffc00));
                               ref.offset:=ref.offset and $3ff;
                               ref.offset:=ref.offset and $3ff;
                               ref.base:=NR_A8;
                               ref.base:=NR_A8;
                             end
                             end

+ 11 - 0
compiler/xtensa/cpupara.pas

@@ -41,6 +41,7 @@ unit cpupara;
          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
          function ret_in_param(def: tdef; pd: tabstractprocdef): boolean;override;
          function ret_in_param(def: tdef; pd: tabstractprocdef): boolean;override;
+         function param_use_paraloc(const cgpara: tcgpara): boolean;override;
        private
        private
          { the max. register depends on the used call instruction }
          { the max. register depends on the used call instruction }
          maxintreg : TSuperRegister;
          maxintreg : TSuperRegister;
@@ -105,6 +106,16 @@ unit cpupara;
       end;
       end;
 
 
 
 
+    function tcpuparamanager.param_use_paraloc(const cgpara: tcgpara): boolean;
+      begin
+        { we always set up a stack frame -> we can always access the parameters
+          this way }
+        result:=
+          (cgpara.location^.loc=LOC_REFERENCE) and
+          not assigned(cgpara.location^.next);
+      end;
+
+
     function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
     function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
       begin
         result:=false;
         result:=false;

+ 27 - 0
packages/fcl-passrc/src/pasresolver.pp

@@ -2395,6 +2395,8 @@ type
     function GetLastSection: TPasSection;
     function GetLastSection: TPasSection;
     function GetParentSection(El: TPasElement): TPasSection;
     function GetParentSection(El: TPasElement): TPasSection;
     function FindUsedUnitInSection(aMod: TPasModule; Section: TPasSection): TPasUsesUnit;
     function FindUsedUnitInSection(aMod: TPasModule; Section: TPasSection): TPasUsesUnit;
+    function FirstSectionUsesUnit(aModule: TPasModule): boolean;
+    function ImplementationUsesUnit(aModule: TPasModule; NotInIntf: boolean = true): boolean;
     function GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
     function GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
       isLoFunc: Boolean; out Mask: LongWord): Integer;
       isLoFunc: Boolean; out Mask: LongWord): Integer;
   public
   public
@@ -29590,6 +29592,31 @@ begin
     if Clause[i].Module=aMod then exit(Clause[i]);
     if Clause[i].Module=aMod then exit(Clause[i]);
 end;
 end;
 
 
+function TPasResolver.FirstSectionUsesUnit(aModule: TPasModule): boolean;
+var
+  aSection: TPasSection;
+begin
+  Result:=false;
+  aSection:=GetFirstSection(false);
+  if aSection=nil then
+    exit;
+  Result:=FindUsedUnitInSection(aModule,aSection)<>nil;
+end;
+
+function TPasResolver.ImplementationUsesUnit(aModule: TPasModule;
+  NotInIntf: boolean): boolean;
+var
+  MyModule: TPasModule;
+begin
+  Result:=false;
+  MyModule:=RootElement;
+  if MyModule=nil then exit;
+  if FindUsedUnitInSection(aModule,MyModule.ImplementationSection)=nil then
+    exit;
+  if NotInIntf then
+    Result:=not FirstSectionUsesUnit(aModule);
+end;
+
 function TPasResolver.GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
 function TPasResolver.GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
   isLoFunc: Boolean; out Mask: LongWord): Integer;
   isLoFunc: Boolean; out Mask: LongWord): Integer;
 const
 const

+ 110 - 17
packages/pastojs/src/fppas2js.pp

@@ -1730,12 +1730,22 @@ type
 
 
   { TSectionContext - interface/implementation/program/library
   { TSectionContext - interface/implementation/program/library
     interface/program/library: PasElement is TPasModule, ThisPas is TPasModule
     interface/program/library: PasElement is TPasModule, ThisPas is TPasModule
-    implementation: PasElement is TImplementationSection, ThisPas is TPasModule }
+    implementation: PasElement is TImplementationSection, ThisPas=nil }
 
 
   TSectionContext = Class(TFunctionContext)
   TSectionContext = Class(TFunctionContext)
   public
   public
+    SrcElements: TJSSourceElements;
     HeaderIndex: integer; // index in TJSSourceElements(JSElement).Statements
     HeaderIndex: integer; // index in TJSSourceElements(JSElement).Statements
     constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override;
     constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override;
+    procedure AddHeaderStatement(JS: TJSElement);
+  end;
+
+  { TInterfaceSectionContext }
+
+  TInterfaceSectionContext = Class(TSectionContext)
+  public
+    ImplHeaderStatements: TFPList;
+    destructor Destroy; override;
   end;
   end;
 
 
   { TDotContext - used for converting eopSubIdent }
   { TDotContext - used for converting eopSubIdent }
@@ -1984,9 +1994,10 @@ type
       Full: boolean = false; Ref: TResolvedReference = nil): TJSElement; virtual;
       Full: boolean = false; Ref: TResolvedReference = nil): TJSElement; virtual;
     Function CreateGlobalTypePath(El: TPasType; AContext : TConvertContext): string; virtual;
     Function CreateGlobalTypePath(El: TPasType; AContext : TConvertContext): string; virtual;
     // section
     // section
-    Function CreateImplementationSection(El: TPasModule; AContext: TConvertContext): TJSFunctionDeclarationStatement; virtual;
+    Function CreateImplementationSection(El: TPasModule; AContext: TInterfaceSectionContext): TJSFunctionDeclarationStatement; virtual;
     Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     Procedure AddHeaderStatement(JS: TJSElement; PosEl: TPasElement; 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: TPasProgram; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     Procedure AddDelaySpecializeInit(El: TPasGenericType; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     Procedure AddDelaySpecializeInit(El: TPasGenericType; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     // set
     // set
@@ -2367,6 +2378,21 @@ begin
   Result:='['+Result+']';
   Result:='['+Result+']';
 end;
 end;
 
 
+{ TInterfaceSectionContext }
+
+destructor TInterfaceSectionContext.Destroy;
+var
+  i: Integer;
+begin
+  if ImplHeaderStatements<>nil then
+    begin
+    for i:=0 to ImplHeaderStatements.Count-1 do
+      TJSElement(ImplHeaderStatements[i]).Free;
+    FreeAndNil(ImplHeaderStatements);
+    end;
+  inherited Destroy;
+end;
+
 { TPas2JSResolverHub }
 { TPas2JSResolverHub }
 
 
 function TPas2JSResolverHub.GetJSDelaySpecializes(Index: integer
 function TPas2JSResolverHub.GetJSDelaySpecializes(Index: integer
@@ -7138,6 +7164,14 @@ constructor TSectionContext.Create(PasEl: TPasElement; JSEl: TJSElement;
 begin
 begin
   inherited;
   inherited;
   IsGlobal:=true;
   IsGlobal:=true;
+  SrcElements:=JSEl as TJSSourceElements;
+end;
+
+procedure TSectionContext.AddHeaderStatement(JS: TJSElement);
+begin
+  if JS=nil then exit;
+  SrcElements.Statements.InsertNode(HeaderIndex).Node:=JS;
+  inc(HeaderIndex);
 end;
 end;
 
 
 { TFunctionContext }
 { TFunctionContext }
@@ -7697,7 +7731,10 @@ begin
       end;
       end;
 
 
     ImplVarSt:=nil;
     ImplVarSt:=nil;
-    IntfContext:=TSectionContext.Create(El,Src,AContext);
+    if El.ClassType=TPasModule then
+      IntfContext:=TInterfaceSectionContext.Create(El,Src,AContext)
+    else
+      IntfContext:=TSectionContext.Create(El,Src,AContext);
     try
     try
       // add "var $mod = this;"
       // add "var $mod = this;"
       IntfContext.ThisPas:=El;
       IntfContext.ThisPas:=El;
@@ -7738,7 +7775,7 @@ begin
         if Assigned(El.InterfaceSection) then
         if Assigned(El.InterfaceSection) then
           AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfContext));
           AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfContext));
 
 
-        ImplFunc:=CreateImplementationSection(El,IntfContext);
+        ImplFunc:=CreateImplementationSection(El,TInterfaceSectionContext(IntfContext));
         if ImplFunc=nil then
         if ImplFunc=nil then
           begin
           begin
           // remove unneeded $impl from interface
           // remove unneeded $impl from interface
@@ -16734,15 +16771,16 @@ begin
 end;
 end;
 
 
 function TPasToJSConverter.CreateImplementationSection(El: TPasModule;
 function TPasToJSConverter.CreateImplementationSection(El: TPasModule;
-  AContext: TConvertContext
-  ): TJSFunctionDeclarationStatement;
+  AContext: TInterfaceSectionContext): TJSFunctionDeclarationStatement;
 var
 var
   Src: TJSSourceElements;
   Src: TJSSourceElements;
   ImplContext: TSectionContext;
   ImplContext: TSectionContext;
-  ImplDecl: TJSElement;
+  ImplDecl, JS: TJSElement;
   FunDecl: TJSFunctionDeclarationStatement;
   FunDecl: TJSFunctionDeclarationStatement;
+  i: Integer;
 begin
 begin
   Result:=nil;
   Result:=nil;
+
   // create function(){}
   // create function(){}
   FunDecl:=CreateFunctionSt(El.ImplementationSection,true,true);
   FunDecl:=CreateFunctionSt(El.ImplementationSection,true,true);
   Src:=TJSSourceElements(FunDecl.AFunction.Body.A);
   Src:=TJSSourceElements(FunDecl.AFunction.Body.A);
@@ -16750,7 +16788,21 @@ begin
   // create section context (a function)
   // create section context (a function)
   ImplContext:=TSectionContext.Create(El.ImplementationSection,Src,AContext);
   ImplContext:=TSectionContext.Create(El.ImplementationSection,Src,AContext);
   try
   try
-    // ToDo: ImplContext.ThisPas:=El;
+    // ToDo: IntfContext.ThisPas:=El;
+    // ToDo: IntfContext.ThisKind:=cctkGlobal;
+
+    // add pending impl header statements
+    if AContext.ImplHeaderStatements<>nil then
+      begin
+      for i:=0 to AContext.ImplHeaderStatements.Count-1 do
+        begin
+        JS:=TJSElement(AContext.ImplHeaderStatements[i]);
+        ImplContext.AddHeaderStatement(JS);
+        AContext.ImplHeaderStatements[i]:=nil;
+        end;
+      FreeAndNil(AContext.ImplHeaderStatements);
+      end;
+
     // create implementation declarations
     // create implementation declarations
     ImplDecl:=ConvertDeclarations(El.ImplementationSection,ImplContext);
     ImplDecl:=ConvertDeclarations(El.ImplementationSection,ImplContext);
     if ImplDecl<>nil then
     if ImplDecl<>nil then
@@ -16784,14 +16836,38 @@ procedure TPasToJSConverter.AddHeaderStatement(JS: TJSElement;
   PosEl: TPasElement; aContext: TConvertContext);
   PosEl: TPasElement; aContext: TConvertContext);
 var
 var
   SectionCtx: TSectionContext;
   SectionCtx: TSectionContext;
-  Src: TJSSourceElements;
 begin
 begin
+  if JS=nil then exit;
   SectionCtx:=TSectionContext(aContext.GetContextOfType(TSectionContext));
   SectionCtx:=TSectionContext(aContext.GetContextOfType(TSectionContext));
   if SectionCtx=nil then
   if SectionCtx=nil then
     RaiseNotSupported(PosEl,aContext,20200606142555);
     RaiseNotSupported(PosEl,aContext,20200606142555);
-  Src:=SectionCtx.JSElement as TJSSourceElements;
-  Src.Statements.InsertNode(SectionCtx.HeaderIndex).Node:=JS;
-  inc(SectionCtx.HeaderIndex);
+  if SectionCtx.Parent is TSectionContext then
+    SectionCtx:=TSectionContext(SectionCtx.Parent);
+  SectionCtx.AddHeaderStatement(JS);
+end;
+
+procedure TPasToJSConverter.AddImplHeaderStatement(JS: TJSElement;
+  PosEl: TPasElement; aContext: TConvertContext);
+var
+  SectionCtx: TSectionContext;
+  IntfSec: TInterfaceSectionContext;
+begin
+  if JS=nil then exit;
+  SectionCtx:=TSectionContext(aContext.GetContextOfType(TSectionContext));
+  if SectionCtx=nil then
+    RaiseNotSupported(PosEl,aContext,20200606142555);
+  if SectionCtx.PasElement is TImplementationSection then
+    SectionCtx.AddHeaderStatement(JS)
+  else if SectionCtx is TInterfaceSectionContext then
+    begin
+    // add pending impl header statement
+    IntfSec:=TInterfaceSectionContext(SectionCtx);
+    if IntfSec.ImplHeaderStatements=nil then
+      IntfSec.ImplHeaderStatements:=TFPList.Create;
+    IntfSec.ImplHeaderStatements.Add(JS);
+    end
+  else
+    RaiseNotSupported(PosEl,aContext,20200911165632);
 end;
 end;
 
 
 procedure TPasToJSConverter.AddDelayedInits(El: TPasProgram;
 procedure TPasToJSConverter.AddDelayedInits(El: TPasProgram;
@@ -25724,6 +25800,7 @@ var
   FuncContext: TFunctionContext;
   FuncContext: TFunctionContext;
   Expr: TJSElement;
   Expr: TJSElement;
   V: TJSVariableStatement;
   V: TJSVariableStatement;
+  AssignSt: TJSSimpleAssignStatement;
 begin
 begin
   Result:=JSPath;
   Result:=JSPath;
   if El is TPasUnresolvedSymbolRef then
   if El is TPasUnresolvedSymbolRef then
@@ -25753,11 +25830,27 @@ begin
       RaiseNotSupported(El,AContext,20200608160225);
       RaiseNotSupported(El,AContext,20200608160225);
     Result:=FuncContext.CreateLocalIdentifier(Result);
     Result:=FuncContext.CreateLocalIdentifier(Result);
     SectionContext.AddLocalVar(Result,El,false);
     SectionContext.AddLocalVar(Result,El,false);
-    // insert var $lmr = JSPath;
-    Expr:=CreatePrimitiveDotExpr(JSPath,El);
-    V:=CreateVarStatement(Result,Expr,El);
-    AddHeaderStatement(V,El,SectionContext);
-    // ToDo: check if from impl uses section and separate "var $lmr = null;" and "$lmr = JSPath";
+
+    // ToDo: check if from a unit used by impl uses section
+    if aResolver.ImplementationUsesUnit(ElModule) then
+      begin
+      // insert var $lm = null;
+      Expr:=CreateLiteralNull(El);
+      V:=CreateVarStatement(Result,Expr,El);
+      AddHeaderStatement(V,El,SectionContext);
+      // insert impl  $lm = JSPath;
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      AssignSt.LHS:=CreatePrimitiveDotExpr(Result,El);
+      AssignSt.Expr:=CreatePrimitiveDotExpr(JSPath,El);
+      AddImplHeaderStatement(AssignSt,El,AContext);
+      end
+    else
+      begin
+      // insert var $lm = JSPath;
+      Expr:=CreatePrimitiveDotExpr(JSPath,El);
+      V:=CreateVarStatement(Result,Expr,El);
+      AddHeaderStatement(V,El,SectionContext);
+      end;
     end;
     end;
 end;
 end;
 
 

+ 6 - 3
packages/pastojs/tests/tcoptimizations.pas

@@ -356,9 +356,9 @@ begin
     'var $impl = $mod.$impl;',
     'var $impl = $mod.$impl;',
     'var $lm = pas.UnitA;',
     'var $lm = pas.UnitA;',
     'var $lt = $lm.TBird;',
     'var $lt = $lm.TBird;',
-    'var $lm1 = pas.UnitB;',
-    'var $lt1 = $lm1.TAnt;',
-    'var $lt2 = $lm1.TBear;',
+    'var $lm1 = null;',
+    'var $lt1 = null;',
+    'var $lt2 = null;',
     'rtl.createClass($mod, "TEagle", $lt, function () {',
     'rtl.createClass($mod, "TEagle", $lt, function () {',
     '  this.Fly = function () {',
     '  this.Fly = function () {',
     '    $impl.TRedAnt.$create("Create");',
     '    $impl.TRedAnt.$create("Create");',
@@ -377,6 +377,9 @@ begin
     '$impl.RedAnt.Run();',
     '$impl.RedAnt.Run();',
     '']),
     '']),
     LinesToStr([
     LinesToStr([
+    '$lm1 = pas.UnitB;',
+    '$lt1 = $lm1.TAnt;',
+    '$lt2 = $lm1.TBear;',
     'rtl.createClass($impl, "TRedAnt", $lt1, function () {',
     'rtl.createClass($impl, "TRedAnt", $lt1, function () {',
     '  this.Run = function () {',
     '  this.Run = function () {',
     '    $impl.TRedAnt.$create("Create");',
     '    $impl.TRedAnt.$create("Create");',

+ 4 - 1
packages/rtl-generics/src/generics.collections.pas

@@ -2021,6 +2021,9 @@ end;
 
 
 function TQueue<T>.DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T;
 function TQueue<T>.DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T;
 begin
 begin
+  if Count = 0 then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
   Result := FItems[AIndex];
   Result := FItems[AIndex];
   FItems[AIndex] := Default(T);
   FItems[AIndex] := Default(T);
   Inc(FLow);
   Inc(FLow);
@@ -2151,7 +2154,7 @@ end;
 
 
 function TStack<T>.DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T;
 function TStack<T>.DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T;
 begin
 begin
-  if AIndex < 0 then
+  if (AIndex < 0) or (Count = 0) then
     raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
     raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
 
 
   Result := FItems[AIndex];
   Result := FItems[AIndex];

+ 9 - 0
packages/rtl-generics/src/inc/generics.dictionaries.inc

@@ -604,6 +604,15 @@ begin
     AValue := Default(TValue);
     AValue := Default(TValue);
 end;
 end;
 
 
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TryAdd(constref AKey: TKey; constref AValue: TValue): Boolean;
+var
+  LHash: UInt32;
+begin
+  Result := FindBucketIndex(FItems, AKey, LHash) < 0;
+  if Result then
+    DoAdd(AKey, AValue);
+end;
+
 procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.AddOrSetValue(constref AKey: TKey; constref AValue: TValue);
 procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.AddOrSetValue(constref AKey: TKey; constref AValue: TValue);
 var
 var
   LIndex: SizeInt;
   LIndex: SizeInt;

+ 1 - 0
packages/rtl-generics/src/inc/generics.dictionariesh.inc

@@ -262,6 +262,7 @@ type
     procedure Clear; override;
     procedure Clear; override;
     procedure TrimExcess;
     procedure TrimExcess;
     function TryGetValue(constref AKey: TKey; out AValue: TValue): Boolean;
     function TryGetValue(constref AKey: TKey; out AValue: TValue): Boolean;
+    function TryAdd(constref AKey: TKey; constref AValue: TValue): Boolean;
     procedure AddOrSetValue(constref AKey: TKey; constref AValue: TValue);
     procedure AddOrSetValue(constref AKey: TKey; constref AValue: TValue);
     function ContainsKey(constref AKey: TKey): Boolean; inline;
     function ContainsKey(constref AKey: TKey): Boolean; inline;
     function ContainsValue(constref AValue: TValue): Boolean; overload;
     function ContainsValue(constref AValue: TValue): Boolean; overload;

+ 40 - 9
packages/rtl-generics/tests/tests.generics.dictionary.pas

@@ -47,6 +47,7 @@ Type
     Procedure TestSetValue;
     Procedure TestSetValue;
     Procedure TestAddDuplicate;
     Procedure TestAddDuplicate;
     Procedure TestAddOrSet;
     Procedure TestAddOrSet;
+    Procedure TestTryAdd;
     Procedure TestContainsKey;
     Procedure TestContainsKey;
     Procedure TestContainsValue;
     Procedure TestContainsValue;
     Procedure TestDelete;
     Procedure TestDelete;
@@ -296,6 +297,13 @@ begin
   DoGetValue(2,'a new 2');
   DoGetValue(2,'a new 2');
 end;
 end;
 
 
+procedure TTestSimpleDictionary.TestTryAdd;
+begin
+  AssertTrue(Dict.TryAdd(1, 'Foobar'));
+  AssertFalse(Dict.TryAdd(1, 'Foo'));
+  AssertTrue(Dict.TryAdd(2, 'Bar'));
+end;
+
 procedure TTestSimpleDictionary.TestContainsKey;
 procedure TTestSimpleDictionary.TestContainsKey;
 
 
 Var
 Var
@@ -343,6 +351,7 @@ Var
 begin
 begin
   DoAdd(3);
   DoAdd(3);
   A:=Dict.ToArray;
   A:=Dict.ToArray;
+  specialize TArrayHelper<TMyPair>.Sort(A{$ifndef fpc}, specialize TComparer<TMySimpleDict.TMyPair>.Default{$endif});
   AssertEquals('Length Ok',3,Length(A));
   AssertEquals('Length Ok',3,Length(A));
   For I:=1 to 3 do
   For I:=1 to 3 do
     begin
     begin
@@ -362,6 +371,7 @@ Var
 begin
 begin
   DoAdd(3);
   DoAdd(3);
   A:=Dict.Keys.ToArray;
   A:=Dict.Keys.ToArray;
+  specialize TArrayHelper<Integer>.Sort(A{$ifndef fpc}, specialize TComparer<Integer>.Default{$endif});
   AssertEquals('Length Ok',3,Length(A));
   AssertEquals('Length Ok',3,Length(A));
   For I:=1 to 3 do
   For I:=1 to 3 do
     begin
     begin
@@ -379,6 +389,7 @@ Var
 begin
 begin
   DoAdd(3);
   DoAdd(3);
   A:=Dict.Values.ToArray;
   A:=Dict.Values.ToArray;
+  specialize TArrayHelper<String>.Sort(A{$ifndef fpc}, specialize TComparer<String>.Default{$endif});
   AssertEquals('Length Ok',3,Length(A));
   AssertEquals('Length Ok',3,Length(A));
   For I:=1 to 3 do
   For I:=1 to 3 do
     begin
     begin
@@ -388,6 +399,9 @@ begin
 end;
 end;
 
 
 procedure TTestSimpleDictionary.TestEnumerator;
 procedure TTestSimpleDictionary.TestEnumerator;
+type
+  TStringList = specialize TList<String>;
+  TIntegerList = specialize TList<Integer>;
 
 
 Var
 Var
 {$ifdef fpc}
 {$ifdef fpc}
@@ -395,19 +409,36 @@ Var
 {$else}
 {$else}
   A : TMySimpleDict.TMyPair;
   A : TMySimpleDict.TMyPair;
 {$endif}
 {$endif}
-  I : Integer;
+  I,J : Integer;
   SI : String;
   SI : String;
-
+  IL: TIntegerList;
+  SL: TStringList;
 begin
 begin
   DoAdd(3);
   DoAdd(3);
-  I:=1;
-  For A in Dict do
-    begin
-    SI:=IntToStr(I);
-    AssertEquals('key '+SI,I,A.Key);
-    AssertEquals('Value '+SI,SI,A.Value);
-    Inc(I);
+  IL:=Nil;
+  SL:=TStringList.Create;
+  try
+    IL:=TIntegerList.Create;
+    for I:=1 to 3 do begin
+      IL.Add(I);
+      SL.Add(IntToStr(I));
     end;
     end;
+    I:=1;
+    For A in Dict do
+      begin
+      SI:=IntToStr(I);
+      J:=IL.IndexOf(A.Key);
+      AssertTrue('key '+SI,J>=0);
+      IL.Delete(J);
+      J:=SL.IndexOf(A.Value);
+      AssertTrue('value '+SI,J>=0);
+      SL.Delete(J);
+      Inc(I);
+      end;
+  finally
+    IL.Free;
+    SL.Free;
+  end;
 end;
 end;
 
 
 procedure TTestSimpleDictionary.TestNotification;
 procedure TTestSimpleDictionary.TestNotification;

+ 1 - 1
packages/rtl-generics/tests/tests.generics.queue.pas

@@ -377,7 +377,7 @@ procedure TTestSimpleQueue.TestValueNotificationDelete;
 begin
 begin
   DoAdd(3);
   DoAdd(3);
   Queue.OnNotify:=@DoValueNotify;
   Queue.OnNotify:=@DoValueNotify;
-  SetExpectValues('Clear',['1','2','3'],[cnRemoved,cnRemoved,cnRemoved],{$IFDEF FPC}true{$ELSE}False{$endif});
+  SetExpectValues('Clear',['1','2','3'],[cnRemoved,cnRemoved,cnRemoved]);
   Queue.Clear;
   Queue.Clear;
   DoneExpectValues;
   DoneExpectValues;
 end;
 end;