* synchronized with trunk

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

compiler/xtensa/aasmcpu.pas

@@ -441,10 +441,20 @@ uses cutils, cclasses;
         else
           result := operand_read;
         case opcode of
+          A_CALL0,
+          A_CALL4,
+          A_CALL8,
+          A_CALL12,
+          A_CALLX0,
+          A_CALLX4,
+          A_CALLX8,
+          A_CALLX12,
           A_S8I,
           A_S16I,
           A_S32I,
           A_SSI,
+          A_J,
+          A_JX,
           A_B:
             result := operand_read;
           else

compiler/xtensa/cpupi.pas

@@ -200,7 +200,7 @@ unit cpupi;
           end
         else
           begin
-            { a frame pointer would be only needed if we do an " alloca" }
+            { a frame pointer would be only needed if we do an "alloca" }
             RS_FRAME_POINTER_REG:=RS_A15;
             NR_FRAME_POINTER_REG:=NR_A15;
           end;

compiler/xtensa/rgcpu.pas

@@ -41,7 +41,6 @@ unit rgcpu;
       end;
 
       trgintcpu=class(trgcpu)
-        procedure add_cpu_interferences(p: tai); override;
       end;
 
 
@@ -117,9 +116,9 @@ implementation
             tmpref.offset:=spilltemp.offset mod 256;
 
             helpins:=taicpu.op_reg_ref(op,tempreg,tmpref);
-            if getregtype(tempreg)=R_INTREGISTER then
-              ungetregisterinline(helplist,hreg);
             helplist.concat(helpins);
+            if (getregtype(tempreg)=R_INTREGISTER) and not(isload) then
+              ungetregisterinline(helplist,hreg);
             list.insertlistafter(pos,helplist);
             helplist.free;
           end
@@ -130,13 +129,4 @@ implementation
       end;
 
 
-    procedure trgintcpu.add_cpu_interferences(p: tai);
-     var
-       i, j: longint;
-     begin
-       if p.typ=ait_instruction then
-         begin
-         end;
-     end;
-
 end.

packages/fcl-passrc/src/pasresolver.pp

@@ -20259,12 +20259,12 @@ begin
     begin
     bt:=ParamResolved.BaseType;
     case bt of
-    btChar: if BaseTypeChar=btAnsiChar then aName:='tkChar' else aName:='tkWChar';
+    btChar: {$ifdef FPC_HAS_CPSTRING}if BaseTypeChar=btAnsiChar then aName:='tkChar' else {$ENDIF}aName:='tkWChar';
     {$ifdef FPC_HAS_CPSTRING}
     btAnsiChar: aName:='tkChar';
     {$endif}
-    btWideChar: aName:='tkWideChar';
-    btString: if BaseTypeString=btAnsiString then aName:='tkAString' else aName:='tkUString';
+    btWideChar: aName:='tkWChar';
+    btString: {$ifdef FPC_HAS_CPSTRING}if BaseTypeString=btAnsiString then aName:='tkAString' else {$ENDIF}aName:='tkUString';
     {$ifdef FPC_HAS_CPSTRING}
     btAnsiString,
     btShortString,

packages/pastojs/src/fppas2js.pp

@@ -668,6 +668,7 @@ type
     pbivnIntfKind,
     pbivnIntfMaps,
     pbivnImplementation,
+    pbivnImplCode,
     pbivnMessageInt,
     pbivnMessageStr,
     pbivnLocalModuleRef,
@@ -849,10 +850,11 @@ const
     '$kind', // pbivnIntfKind
     '$intfmaps', // pbivnIntfMaps
     '$impl', // pbivnImplementation
+    '$implcode', // pbivnImplCode
     '$msgint', // pbivnMessageInt
     '$msgstr', // pbivnMessageStr
-    '$lmr', // pbivnLocalModuleRef
-    '$ltr', // pbivnLocalTypeRef
+    '$lm', // pbivnLocalModuleRef
+    '$lt', // pbivnLocalTypeRef
     '$l', // pbivnLoop
     '$end', // pbivnLoopEnd
     '$in', // pbivnLoopIn
@@ -2797,7 +2799,7 @@ procedure TPas2jsPasScanner.DoHandleOptimization(OptName, OptValue: string);
 
 begin
   case lowercase(OptName) of
-  'aliasglobals':
+  'jsaliasglobals':
     HandleBoolean(coAliasGlobals,true);
   else
     DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,['optimization '+OptName]);
@@ -7600,28 +7602,40 @@ Program:
  rtl.module('program',
     [<uses1>,<uses2>, ...],
     function(){
+      var $mod = this;
       <programsection>
       this.$main=function(){
         <initialization>
         };
     });
 
-Unit:
+Unit without implementation:
  rtl.module('<unitname>',
     [<interface uses1>,<uses2>, ...],
     function(){
-      var $impl = {};
+      var $mod = this;
       this.$impl = $impl;
       <interface>
       this.$init=function(){
         <initialization>
         };
+    });
+
+Unit with implementation:
+ rtl.module('<unitname>',
+    [<interface uses1>,<uses2>, ...],
+    function(){
+      var $mod = this;
+      var $impl = $mod.$impl;
+      <interface>
+      $impl.$code=function(){
+        };
+      this.$init=function(){
+        <initialization>
+        };
     },
     [<implementation uses1>,<uses2>, ...],
-    function(){
-      var $impl = this.$impl;
-      <implementation>
-    });
+    );
 *)
 Var
   OuterSrc , Src: TJSSourceElements;
@@ -7633,9 +7647,9 @@ Var
   IntfContext: TSectionContext;
   ImplVarSt: TJSVariableStatement;
   HasImplUsesClause, ok, NeedRTLCheckVersion: Boolean;
-  UsesClause: TPasUsesClause;
   Prg: TPasProgram;
   Lib: TPasLibrary;
+  AssignSt: TJSSimpleAssignStatement;
 begin
   Result:=Nil;
   OuterSrc:=TJSSourceElements(CreateElement(TJSSourceElements, El));
@@ -7683,8 +7697,6 @@ begin
       end;
 
     ImplVarSt:=nil;
-    HasImplUsesClause:=false;
-
     IntfContext:=TSectionContext.Create(El,Src,AContext);
     try
       // add "var $mod = this;"
@@ -7725,18 +7737,28 @@ begin
           end;
         if Assigned(El.InterfaceSection) then
           AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfContext));
-        CreateInitSection(El,Src,IntfContext);
 
-        // add optional implementation uses list: [<implementation uses1>,<uses2>, ...]
-        if Assigned(El.ImplementationSection) then
+        ImplFunc:=CreateImplementationSection(El,IntfContext);
+        if ImplFunc=nil then
           begin
-          UsesClause:=El.ImplementationSection.UsesClause;
-          if length(UsesClause)>0 then
-            begin
-            ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext));
-            HasImplUsesClause:=true;
-            end;
+          // remove unneeded $impl from interface
+          RemoveFromSourceElements(Src,ImplVarSt);
+          HasImplUsesClause:=length(El.ImplementationSection.UsesClause)>0;
+          end
+        else
+          begin
+          // add $mod.$implcode = ImplFunc;
+          AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+          AssignSt.LHS:=CreateMemberExpression([ModVarName,GetBIName(pbivnImplCode)]);
+          AssignSt.Expr:=ImplFunc;
+          AddToSourceElements(Src,AssignSt);
+          HasImplUsesClause:=true;
           end;
+        if HasImplUsesClause then
+          // add implementation uses list: [<implementation uses1>,<uses2>, ...]
+          ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext));
+
+        CreateInitSection(El,Src,IntfContext);
 
         end;
     finally
@@ -7746,19 +7768,6 @@ begin
     // add implementation function
     if ImplVarSt<>nil then
       begin
-      ImplFunc:=CreateImplementationSection(El,AContext);
-      if ImplFunc=nil then
-        begin
-        // remove unneeded $impl from interface
-        RemoveFromSourceElements(Src,ImplVarSt);
-        end
-      else
-        begin
-        // add param
-        if not HasImplUsesClause then
-          ArgArray.AddElement(CreateLiteralNull(El));
-        ArgArray.AddElement(ImplFunc);
-        end;
       end;
     ok:=true;
   finally
@@ -16731,43 +16740,23 @@ var
   Src: TJSSourceElements;
   ImplContext: TSectionContext;
   ImplDecl: TJSElement;
-  ImplVarSt: TJSVariableStatement;
   FunDecl: TJSFunctionDeclarationStatement;
-  ModVarName, ImplVarName: String;
 begin
   Result:=nil;
   // create function(){}
-  FunDecl:=CreateFunctionSt(El,true,true);
+  FunDecl:=CreateFunctionSt(El.ImplementationSection,true,true);
   Src:=TJSSourceElements(FunDecl.AFunction.Body.A);
 
   // create section context (a function)
-  ImplContext:=TSectionContext.Create(El,Src,AContext);
+  ImplContext:=TSectionContext.Create(El.ImplementationSection,Src,AContext);
   try
-    if coUseStrict in Options then
-      AddToSourceElements(Src,CreateLiteralString(El,'use strict'));
-
-    // add "var $mod = this;"
-    ImplContext.ThisPas:=El;
-    ModVarName:=GetBIName(pbivnModule);
-    AddToSourceElements(Src,CreateVarStatement(ModVarName,
-      CreatePrimitiveDotExpr('this',El),El));
-    ImplContext.AddLocalVar(ModVarName,El,false);
-
-    // add var $impl = $mod.$impl
-    ImplVarName:=GetBIName(pbivnImplementation);
-    ImplVarSt:=CreateVarStatement(ImplVarName,
-      CreateMemberExpression([ModVarName,ImplVarName]),El.ImplementationSection);
-    AddToSourceElements(Src,ImplVarSt);
-    ImplContext.AddLocalVar(ImplVarName,El.ImplementationSection,false);
-
+    // ToDo: ImplContext.ThisPas:=El;
     // create implementation declarations
     ImplDecl:=ConvertDeclarations(El.ImplementationSection,ImplContext);
     if ImplDecl<>nil then
       RaiseInconsistency(20170910175032,El); // elements should have been added directly
-    if Src.Statements[Src.Statements.Count-1].Node=ImplVarSt then
+    if Src.Statements.Count=0 then
       exit; // no implementation
-    // add impl declarations
-    AddToSourceElements(Src,ImplDecl);
     Result:=FunDecl;
   finally
     ImplContext.Free;
@@ -23956,9 +23945,9 @@ var
 begin
   aType:=AContext.Resolver.ResolveAliasType(El);
   Result:=AContext.GetLocalName(aType,true);
-  AliasGlobals:=coAliasGlobals in Options;
   if Result<>'' then
     exit; // already exists
+  AliasGlobals:=coAliasGlobals in Options;
 
   Parent:=El.Parent;
   Result:=AContext.GetLocalName(Parent,AliasGlobals);
@@ -25484,7 +25473,7 @@ begin
     else
       Result:=GetBIName(pbivnModules)+'.'+Result;
 
-    if (coAliasGlobals in Options) and (Result<>'this') then
+    if coAliasGlobals in Options then
       Result:=CreateGlobalAlias(El,Result,AContext);
     end;
 end;
@@ -25752,11 +25741,8 @@ begin
     begin
     // El is from another unit
     SectionContext:=TSectionContext(AContext.GetContextOfType(TSectionContext));
-    if SectionContext.PasElement is TInterfaceSection then
-      begin
-      // check if from impl uses clause
-
-      end;
+    if SectionContext.Parent is TSectionContext then
+      SectionContext:=TSectionContext(SectionContext.Parent);
 
     FuncContext:=AContext.GetFunctionContext;
     if El is TPasModule then
@@ -25770,7 +25756,7 @@ begin
     // insert var $lmr = JSPath;
     Expr:=CreatePrimitiveDotExpr(JSPath,El);
     V:=CreateVarStatement(Result,Expr,El);
-    AddHeaderStatement(V,El,AContext);
+    AddHeaderStatement(V,El,SectionContext);
     // ToDo: check if from impl uses section and separate "var $lmr = null;" and "$lmr = JSPath";
     end;
 end;

packages/pastojs/tests/tcgenerics.pas

@@ -256,24 +256,23 @@ begin
     '    return this;',
     '    };',
     '  }, true);',
+    '  $mod.$implcode = function () {',
+    '    rtl.recNewT($impl, "TBird", function () {',
+    '      this.b = 0;',
+    '      this.$eq = function (b) {',
+    '        return this.b === b.b;',
+    '      };',
+    '      this.$assign = function (s) {',
+    '        this.b = s.b;',
+    '        return this;',
+    '      };',
+    '    });',
+    '    $impl.f = $mod.TAnt$G1.$new();',
+    '  };',
     '  $mod.$init = function () {',
     '    $impl.f.x.b = $impl.f.x.b + 10;',
     '  };',
-    '}, null, function () {',
-    '  var $mod = this;',
-    '  var $impl = $mod.$impl;',
-    '  rtl.recNewT($impl, "TBird", function () {',
-    '    this.b = 0;',
-    '    this.$eq = function (b) {',
-    '      return this.b === b.b;',
-    '    };',
-    '    this.$assign = function (s) {',
-    '      this.b = s.b;',
-    '      return this;',
-    '    };',
-    '  });',
-    '  $impl.f = $mod.TAnt$G1.$new();',
-    '});']));
+    '}, []);']));
   CheckSource('TestGen_Record_ClassVarRecord_UnitImpl',
     LinesToStr([ // statements
     'pas.UnitA.TAnt$G1.$initSpec();',
@@ -1151,24 +1150,23 @@ begin
     '      this.a = rtl.arraySetLength(null, $impl.TBird, 2);',
     '    };',
     '  });',
+    '  $mod.$implcode = function () {',
+    '    rtl.recNewT($impl, "TBird", function () {',
+    '      this.b = 0;',
+    '      this.$eq = function (b) {',
+    '        return this.b === b.b;',
+    '      };',
+    '      this.$assign = function (s) {',
+    '        this.b = s.b;',
+    '        return this;',
+    '      };',
+    '    });',
+    '    $impl.f = null;',
+    '  };',
     '  $mod.$init = function () {',
     '    $impl.f.x.b = $impl.f.x.b + 10;',
     '  };',
-    '}, null, function () {',
-    '  var $mod = this;',
-    '  var $impl = $mod.$impl;',
-    '  rtl.recNewT($impl, "TBird", function () {',
-    '    this.b = 0;',
-    '    this.$eq = function (b) {',
-    '      return this.b === b.b;',
-    '    };',
-    '    this.$assign = function (s) {',
-    '      this.b = s.b;',
-    '      return this;',
-    '    };',
-    '  });',
-    '  $impl.f = null;',
-    '});']));
+    '}, []);']));
   CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
     LinesToStr([ // statements
     'pas.UnitA.TAnt$G1.$initSpec();',
@@ -1363,26 +1361,25 @@ begin
     '  $mod.$rtti.$ExtClass("TAnt<UnitA.TBird>", {',
     '    jsclass: "SET"',
     '  });',
+    '  $mod.$implcode = function () {',
+    '    rtl.recNewT($impl, "TBird", function () {',
+    '      this.b = 0;',
+    '      this.$eq = function (b) {',
+    '        return this.b === b.b;',
+    '      };',
+    '      this.$assign = function (s) {',
+    '        this.b = s.b;',
+    '        return this;',
+    '      };',
+    '      var $r = $mod.$rtti.$Record("TBird", {});',
+    '      $r.addField("b", rtl.word);',
+    '    });',
+    '    $impl.f = null;',
+    '  };',
     '  $mod.$init = function () {',
     '    $impl.f.x.b = $impl.f.x.b + 10;',
     '  };',
-    '}, null, function () {',
-    '  var $mod = this;',
-    '  var $impl = $mod.$impl;',
-    '  rtl.recNewT($impl, "TBird", function () {',
-    '    this.b = 0;',
-    '    this.$eq = function (b) {',
-    '      return this.b === b.b;',
-    '    };',
-    '    this.$assign = function (s) {',
-    '      this.b = s.b;',
-    '      return this;',
-    '    };',
-    '    var $r = $mod.$rtti.$Record("TBird", {});',
-    '    $r.addField("b", rtl.word);',
-    '  });',
-    '  $impl.f = null;',
-    '});']));
+    '}, []);']));
   CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
     LinesToStr([ // statements
     //'pas.UnitA.TAnt$G1.$initSpec();',
@@ -1560,15 +1557,14 @@ begin
     '      $impl.DoIt();',
     '    };',
     '  });',
-    '}, null, function () {',
-    '  var $mod = this;',
-    '  var $impl = $mod.$impl;',
-    '  $impl.DoIt = function () {',
-    '    var b = null;',
-    '    b = $mod.TBird$G2.$create("Create");',
-    '    b.Fly();',
+    '  $mod.$implcode = function () {',
+    '    $impl.DoIt = function () {',
+    '      var b = null;',
+    '      b = $mod.TBird$G2.$create("Create");',
+    '      b.Fly();',
+    '    };',
     '  };',
-    '});',
+    '}, []);',
     '']));
 end;
 
@@ -2082,28 +2078,27 @@ begin
     '  $mod.$rtti.$StaticArray("TStatic<UnitA.TBird>", {',
     '    dims: [2]',
     '  });',
+    '  $mod.$implcode = function () {',
+    '    rtl.recNewT($impl, "TBird", function () {',
+    '      this.b = 0;',
+    '      this.$eq = function (b) {',
+    '        return this.b === b.b;',
+    '      };',
+    '      this.$assign = function (s) {',
+    '        this.b = s.b;',
+    '        return this;',
+    '      };',
+    '      var $r = $mod.$rtti.$Record("TBird", {});',
+    '      $r.addField("b", rtl.word);',
+    '    });',
+    '    $impl.d = [];',
+    '    $impl.s = rtl.arraySetLength(null, $impl.TBird, 2);',
+    '  };',
     '  $mod.$init = function () {',
     '    $impl.d[0].b = $impl.s[0].b;',
     '    $impl.s = $mod.TStatic$G1$clone($impl.s);',
     '  };',
-    '}, null, function () {',
-    '  var $mod = this;',
-    '  var $impl = $mod.$impl;',
-    '  rtl.recNewT($impl, "TBird", function () {',
-    '    this.b = 0;',
-    '    this.$eq = function (b) {',
-    '      return this.b === b.b;',
-    '    };',
-    '    this.$assign = function (s) {',
-    '      this.b = s.b;',
-    '      return this;',
-    '    };',
-    '    var $r = $mod.$rtti.$Record("TBird", {});',
-    '    $r.addField("b", rtl.word);',
-    '  });',
-    '  $impl.d = [];',
-    '  $impl.s = rtl.arraySetLength(null, $impl.TBird, 2);',
-    '});']));
+    '}, []);']));
   CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
     LinesToStr([ // statements
     'pas.UnitA.$rtti["TDyn<UnitA.TBird>"].eltype = pas.UnitA.$rtti["TBird"];',
@@ -2205,29 +2200,28 @@ begin
     '      this.procsig = rtl.newTIProcSig([["a", $mod.$rtti["TBird"], 2]], $mod.$rtti["TBird"]);',
     '    }',
     '  });',
+    '  $mod.$implcode = function () {',
+    '    rtl.recNewT($impl, "TBird", function () {',
+    '      this.b = 0;',
+    '      this.$eq = function (b) {',
+    '        return this.b === b.b;',
+    '      };',
+    '      this.$assign = function (s) {',
+    '        this.b = s.b;',
+    '        return this;',
+    '      };',
+    '      var $r = $mod.$rtti.$Record("TBird", {});',
+    '      $r.addField("b", rtl.word);',
+    '    });',
+    '    $impl.f = null;',
+    '    $impl.b = $impl.TBird.$new();',
+    '    $impl.p = null;',
+    '  };',
     '  $mod.$init = function () {',
     '    $impl.b.$assign($impl.f($impl.b));',
     '    $impl.p = $mod.$rtti["TAnt<UnitA.TBird>"];',
     '  };',
-    '}, null, function () {',
-    '  var $mod = this;',
-    '  var $impl = $mod.$impl;',
-    '  rtl.recNewT($impl, "TBird", function () {',
-    '    this.b = 0;',
-    '    this.$eq = function (b) {',
-    '      return this.b === b.b;',
-    '    };',
-    '    this.$assign = function (s) {',
-    '      this.b = s.b;',
-    '      return this;',
-    '    };',
-    '    var $r = $mod.$rtti.$Record("TBird", {});',
-    '    $r.addField("b", rtl.word);',
-    '  });',
-    '  $impl.f = null;',
-    '  $impl.b = $impl.TBird.$new();',
-    '  $impl.p = null;',
-    '});']));
+    '}, []);']));
   CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
     LinesToStr([ // statements
     'pas.UnitA.$rtti["TAnt<UnitA.TBird>"].init();',

packages/pastojs/tests/tcmodules.pas

@@ -112,7 +112,6 @@ type
     FFilename: string;
     FFileResolver: TStreamResolver;
     FHub: TPas2JSResolverHub;
-    FJSImplementationSrc: TJSSourceElements;
     FJSImplementationUses: TJSArrayLiteral;
     FJSInitBody: TJSFunctionBody;
     FJSImplentationUses: TJSArrayLiteral;
@@ -211,7 +210,6 @@ type
     property JSInterfaceUses: TJSArrayLiteral read FJSInterfaceUses;
     property JSModuleSrc: TJSSourceElements read FJSModuleSrc;
     property JSInitBody: TJSFunctionBody read FJSInitBody;
-    property JSImplementationSrc: TJSSourceElements read FJSImplementationSrc;
     property ExpectedErrorClass: ExceptClass read FExpectedErrorClass write FExpectedErrorClass;
     property ExpectedErrorMsg: string read FExpectedErrorMsg write FExpectedErrorMsg;
     property ExpectedErrorNumber: integer read FExpectedErrorNumber write FExpectedErrorNumber;
@@ -1978,12 +1976,6 @@ begin
     exit;
   Arg:=JSModuleCallArgs.Elements.Elements[3];
   CheckUsesList('implementation',Arg,FJSImplentationUses);
-
-  // optional: implementation function()
-  if JSModuleCallArgs.Elements.Count<5 then
-    exit;
-  Arg:=JSModuleCallArgs.Elements.Elements[4];
-  CheckFunctionParam('module impl-function',Arg,FJSImplementationSrc);
 end;
 
 procedure TCustomTestModule.ConvertProgram;
@@ -2037,40 +2029,35 @@ var
   ActualSrc, ExpectedSrc, InitName: String;
 begin
   ActualSrc:=JSToStr(JSModuleSrc);
-  ExpectedSrc:=
-    'var $mod = this;'+LineEnding
-   +Statements;
   if coUseStrict in Converter.Options then
-    ExpectedSrc:='"use strict";'+LineEnding+ExpectedSrc;
-  if Module is TPasProgram then
-    InitName:='$main'
+    ExpectedSrc:='"use strict";'+LineEnding
   else
-    InitName:='$init';
+    ExpectedSrc:='';
+  ExpectedSrc:=ExpectedSrc+'var $mod = this;'+LineEnding;
+  ExpectedSrc:=ExpectedSrc+Statements;
+
+  // unit implementation
+  if (Trim(ImplStatements)<>'') then
+    ExpectedSrc:=ExpectedSrc+LineEnding
+      +'$mod.$implcode = function () {'+LineEnding
+      +ImplStatements
+      +'};'+LineEnding;
+
+  // program main or unit initialization
   if (Module is TPasProgram) or (Trim(InitStatements)<>'') then
+    begin
+    if Module is TPasProgram then
+      InitName:='$main'
+    else
+      InitName:='$init';
     ExpectedSrc:=ExpectedSrc+LineEnding
       +'$mod.'+InitName+' = function () {'+LineEnding
       +InitStatements
       +'};'+LineEnding;
-  //writeln('TCustomTestModule.CheckSource ExpectedIntf="',ExpectedSrc,'"');
-  //writeln('TTestModule.CheckSource InitStatements="',Trim(InitStatements),'"');
-  CheckDiff(Msg,ExpectedSrc,ActualSrc);
-
-  if (JSImplementationSrc<>nil) then
-    begin
-    ActualSrc:=JSToStr(JSImplementationSrc);
-    ExpectedSrc:=
-      'var $mod = this;'+LineEnding
-     +'var $impl = $mod.$impl;'+LineEnding
-     +ImplStatements;
-    end
-  else
-    begin
-    ActualSrc:='';
-    ExpectedSrc:=ImplStatements;
     end;
-  //writeln('TTestModule.CheckSource InitStatements="',InitStatements,'"');
-  //writeln('TCustomTestModule.CheckSource Expected: ',ExpectedSrc);
 
+  //writeln('TCustomTestModule.CheckSource ExpectedIntf="',ExpectedSrc,'"');
+  //writeln('TTestModule.CheckSource InitStatements="',Trim(InitStatements),'"');
   CheckDiff(Msg,ExpectedSrc,ActualSrc);
 end;
 

packages/pastojs/tests/tcoptimizations.pas

@@ -56,9 +56,9 @@ type
 
   TTestOptimizations = class(TCustomTestOptimizations)
   published
-    // unit optimization: aliasglobals
+    // unit optimization: jsaliasglobals
     procedure TestOptAliasGlobals_Program;
-    procedure TestOptAliasGlobals_Unit; // ToDo
+    procedure TestOptAliasGlobals_Unit_FromIntfImpl_ToIntfImpl;
     // ToDo: external var, const, class
     // ToDo: RTTI
     // ToDo: typeinfo(var), typeinfo(type)
@@ -203,8 +203,11 @@ procedure TTestOptimizations.TestOptAliasGlobals_Program;
 begin
   AddModuleWithIntfImplSrc('UnitA.pas',
   LinesToStr([
+    'type',
+    '  TColor = (red,green,blue);',
+    '  TColors = set of TColor;',
     'const',
-    '  cWidth = 17;',
+    '  cRedBlue = [red,blue];',
     'type',
     '  TBird = class',
     '  public',
@@ -221,7 +224,7 @@ begin
 
   StartProgram(true,[supTObject]);
   Add([
-  '{$optimization AliasGlobals}',
+  '{$optimization JSAliasGlobals}',
   'uses unita;',
   'type',
   '  TEagle = class(TBird)',
@@ -233,6 +236,7 @@ begin
   'var',
   '  e: TEagle;',
   '  r: TRec;',
+  '  c: TColors;',
   'begin',
   '  e:=TEagle.Create;',
   '  b:=TBird.Create;',
@@ -242,47 +246,44 @@ begin
   '  r.x:=e.Run;',
   '  r.x:=e.Run();',
   '  r.x:=e.Run(4);',
+  '  c:=cRedBlue;',
   '']);
   ConvertProgram;
   CheckSource('TestOptAliasGlobals_Program',
     LinesToStr([
-    'var $lmr = pas.UnitA;',
-    'var $ltr = $lmr.TBird;',
-    'var $ltr1 = $lmr.TRec;',
-    'rtl.createClass($mod, "TEagle", $ltr, function () {',
+    'var $lm = pas.UnitA;',
+    'var $lt = $lm.TBird;',
+    'var $lt1 = $lm.TRec;',
+    'rtl.createClass($mod, "TEagle", $lt, function () {',
     '  this.Run = function (w) {',
     '    var Result = 0;',
     '    return Result;',
     '  };',
     '});',
     'this.e = null;',
-    'this.r = $ltr1.$new();',
+    'this.r = $lt1.$new();',
+    'this.c = {};',
     '']),
     LinesToStr([
     '$mod.e = $mod.TEagle.$create("Create");',
-    '$lmr.b = $ltr.$create("Create");',
-    '$ltr.c = $mod.e.c + 1;',
-    '$mod.r.x = $ltr.c;',
-    '$mod.r.x = $lmr.b.c;',
+    '$lm.b = $lt.$create("Create");',
+    '$lt.c = $mod.e.c + 1;',
+    '$mod.r.x = $lt.c;',
+    '$mod.r.x = $lm.b.c;',
     '$mod.r.x = $mod.e.$class.Run(5);',
     '$mod.r.x = $mod.e.$class.Run(5);',
     '$mod.r.x = $mod.e.$class.Run(4);',
+    '$mod.c = rtl.refSet($lm.cRedBlue);',
     '']));
 end;
 
-procedure TTestOptimizations.TestOptAliasGlobals_Unit;
+procedure TTestOptimizations.TestOptAliasGlobals_Unit_FromIntfImpl_ToIntfImpl;
 begin
-  exit;
-
   AddModuleWithIntfImplSrc('UnitA.pas',
   LinesToStr([
-    'const',
-    '  cWidth = 17;',
     'type',
     '  TBird = class',
-    '  public',
-    '    class var Span: word;',
-    '    class procedure Fly(w: word); virtual; abstract;',
+    '  public Speed: word;',
     '  end;',
     '  TRecA = record',
     '    x: word;',
@@ -293,60 +294,102 @@ begin
     '']));
   AddModuleWithIntfImplSrc('UnitB.pas',
   LinesToStr([
-    'const',
-    '  cHeight = 23;',
     'type',
     '  TAnt = class',
-    '  public',
-    '    class var Legs: word;',
-    '    class procedure Run(w: word); virtual; abstract;',
+    '  public Size: word;',
     '  end;',
     '  TRecB = record',
     '    y: word;',
     '  end;',
+    '  TBear = class',
+    '  end;',
     'var Ant: TAnt;',
     '']),
   LinesToStr([
     '']));
   StartUnit(true,[supTObject]);
   Add([
-  '{$optimization AliasGlobals}',
+  '{$optimization JSAliasGlobals}',
   'interface',
   'uses unita;',
   'type',
-  '  TEagle = class(TBird)',
-  '    class var EagleRec: TRecA;',
-  '    class procedure Fly(w: word = 5); override;',
+  '  TEagle = class(TBird)', // intf-JS to intf-uses
+  '    procedure Fly;',
   '  end;',
   'implementation',
   'uses unitb;',
   'type',
-  '  TRedAnt = class(TAnt)',
-  '    class var RedAntRecA: TRecA;',
-  '    class var RedAntRecB: TRecB;',
-  '    class procedure Run(w: word = 6); override;',
+  '  TRedAnt = class(TAnt)', // impl-JS to impl-uses
+  '    procedure Run;',
   '  end;',
-  'class procedure TEagle.Fly(w: word);',
+  'procedure TEagle.Fly;',
   'begin',
+  '  TRedAnt.Create;', // intf-JS to impl-JS
+  '  TAnt.Create;', // intf-JS to impl-uses
+  '  TBird.Create;', // intf-JS to intf-uses
+  '  TEagle.Create;', // intf-JS to intf-JS
   'end;',
-  'class procedure TRedAnt.Run(w: word);',
+  'procedure TRedAnt.Run;',
   'begin',
+  '  TRedAnt.Create;', // impl-JS to impl-JS
+  '  TAnt.Create;', // impl-JS to impl-uses
+  '  TBird.Create;', // impl-JS to intf-uses
+  '  TEagle.Create;', // impl-JS to intf-JS
+  '  TBear.Create', // only in impl-JS to impl-uses
   'end;',
   'var',
-  '  Eagle: TEagle;',
   '  RedAnt: TRedAnt;',
+  '  Ant: TAnt;',
+  '  Bird: TBird;',
+  '  Eagle: TEagle;',
   'initialization',
-  '  Eagle:=TEagle.Create;',
-  '  RedAnt:=TRedAnt.Create;',
-  '  Bird:=TBird.Create;',
-  '  Ant:=TAnt.Create;',
-  '  TRedAnt.RedAntRecA.x:=TRedAnt.RedAntRecB.y;',
+  '  RedAnt:=TRedAnt.Create;', // init to impl-JS
+  '  Ant:=TAnt.Create;', // init to impl-uses
+  '  Bird:=TBird.Create;', // init to intf-uses
+  '  Eagle:=TEagle.Create;', // init to intf-JS
+  '  Eagle.Fly;',
+  '  RedAnt.Run;',
   '']);
   ConvertUnit;
-  CheckSource('TestOptAliasGlobals_Unit',
+  CheckSource('TestOptAliasGlobals_Unit_FromIntfImpl_ToIntfImpl',
+    LinesToStr([
+    'var $impl = $mod.$impl;',
+    'var $lm = pas.UnitA;',
+    'var $lt = $lm.TBird;',
+    'var $lm1 = pas.UnitB;',
+    'var $lt1 = $lm1.TAnt;',
+    'var $lt2 = $lm1.TBear;',
+    'rtl.createClass($mod, "TEagle", $lt, function () {',
+    '  this.Fly = function () {',
+    '    $impl.TRedAnt.$create("Create");',
+    '    $lt1.$create("Create");',
+    '    $lt.$create("Create");',
+    '    $mod.TEagle.$create("Create");',
+    '  };',
+    '});',
+    '']),
     LinesToStr([
+    '$impl.RedAnt = $impl.TRedAnt.$create("Create");',
+    '$impl.Ant = $lt1.$create("Create");',
+    '$impl.Bird = $lt.$create("Create");',
+    '$impl.Eagle = $mod.TEagle.$create("Create");',
+    '$impl.Eagle.Fly();',
+    '$impl.RedAnt.Run();',
     '']),
     LinesToStr([
+    'rtl.createClass($impl, "TRedAnt", $lt1, function () {',
+    '  this.Run = function () {',
+    '    $impl.TRedAnt.$create("Create");',
+    '    $lt1.$create("Create");',
+    '    $lt.$create("Create");',
+    '    $mod.TEagle.$create("Create");',
+    '    $lt2.$create("Create");',
+    '  };',
+    '});',
+    '$impl.RedAnt = null;',
+    '$impl.Ant = null;',
+    '$impl.Bird = null;',
+    '$impl.Eagle = null;',
     '']));
 end;
 

rtl/linux/osdefs.inc

@@ -28,9 +28,11 @@
   {$endif}
 {$endif}
 
-{$if defined(cpupowerpc) or defined(cpupowerpc64) or defined(cpui386) or
+{$if defined(cpupowerpc) or defined(cpupowerpc64) or
+  defined(cpui386) or
+  defined(cpum68k) or
   (defined(cpuarm) and defined(FPC_ABI_EABI))}
-  {$DEFINE has_ugetrlimit}
+  {$define HAS_UGETRLIMIT}
 {$endif}
 
 {$if (defined(cpuarm) and defined(FPC_ABI_EABI))}

rtl/linux/ostypes.inc

@@ -424,11 +424,11 @@ type
   end;
 
   iovec = record
-            iov_base : pointer;
-	    iov_len  : size_t;
-	   end;
+    iov_base : pointer;
+    iov_len  : size_t;
+  end;
   tiovec=iovec;
-  piovec=^tiovec;		
+  piovec=^tiovec;
 
 {$if defined(cpupowerpc)}
 const

utils/pas2js/dist/rtl.js

@@ -98,32 +98,31 @@ var rtl = {
   m_initializing: 4, // running initialization
   m_initialized: 5,
 
-  module: function(module_name, intfuseslist, intfcode, impluseslist, implcode){
-    if (rtl.debug_load_units) rtl.debug('rtl.module name="'+module_name+'" intfuses='+intfuseslist+' impluses='+impluseslist+' hasimplcode='+rtl.isFunction(implcode));
+  module: function(module_name, intfuseslist, intfcode, impluseslist){
+    if (rtl.debug_load_units) rtl.debug('rtl.module name="'+module_name+'" intfuses='+intfuseslist+' impluses='+impluseslist);
     if (!rtl.hasString(module_name)) rtl.error('invalid module name "'+module_name+'"');
     if (!rtl.isArray(intfuseslist)) rtl.error('invalid interface useslist of "'+module_name+'"');
     if (!rtl.isFunction(intfcode)) rtl.error('invalid interface code of "'+module_name+'"');
     if (!(impluseslist==undefined) && !rtl.isArray(impluseslist)) rtl.error('invalid implementation useslist of "'+module_name+'"');
-    if (!(implcode==undefined) && !rtl.isFunction(implcode)) rtl.error('invalid implementation code of "'+module_name+'"');
 
     if (pas[module_name])
       rtl.error('module "'+module_name+'" is already registered');
 
-    var module = pas[module_name] = {
+    var r = Object.create(rtl.tSectionRTTI);
+    var module = r.$module = pas[module_name] = {
       $name: module_name,
       $intfuseslist: intfuseslist,
       $impluseslist: impluseslist,
       $state: rtl.m_loading,
       $intfcode: intfcode,
-      $implcode: implcode,
+      $implcode: null,
       $impl: null,
-      $rtti: Object.create(rtl.tSectionRTTI)
-    };
-    module.$rtti.$module = module;
-    if (implcode) module.$impl = {
-      $module: module,
-      $rtti: module.$rtti
+      $rtti: r
     };
+    if (impluseslist) module.$impl = {
+          $module: module,
+          $rtti: r
+        };
   },
 
   exitcode: 0,
@@ -353,6 +352,7 @@ var rtl = {
     if (isFunc){
       // create pascal class descendent from JS function
       c = Object.create(ancestor.prototype);
+      c.$ancestorfunc = ancestor;
     } else if (ancestor.$func){
       // create pascal class descendent from a pascal class descendent of a JS function
       isFunc = true;
@@ -397,7 +397,6 @@ var rtl = {
       function f(){}
       f.prototype = c;
       c.$func = f;
-      c.$ancestorfunc = ancestor;
     }
   },
 

utils/pas2js/docs/translation.html

@@ -370,15 +370,18 @@ End.
 <pre>rtl.module('&lt;unitname&gt;',
   ['system',...other used units of the interface section...],
   function(){
+    var $mod = this;
+    var $impl = $mod.$impl;
     [interface section]
-    this.$init=function(){
+    $mod.$implcode = function(){
+      [implementation section]
+    }
+    $mod.$init = function(){
       [initialization section]
     };
   },
-  [...used units of the implementation section],
-  function(){
-    [implementation section]
-  }};
+  [...used units of the implementation section]
+  };
 </pre>
           </td>
         </tr>
@@ -429,18 +432,16 @@ function(){
   this.MyIntfProc = function(){
     $impl.dImpl = $mod.dIntf;
   };
-  this.$init = function() {
+  $mod.$implcode = function(){
+    $impl.dImpl = 0.0;
+    $impl.MyImplProc = function() {
+      $impl.dImpl = $mod.dIntf;
+    };
+  }
+  $mod.$init = function() {
   };
 },
-["Classes"],
-function(){
-  var $mod = this;
-  var $impl = $mod.$impl;
-  $impl.dImpl = 0.0;
-  $impl.MyImplProc = function() {
-    $impl.dImpl = $mod.dIntf;
-  };
-});
+["Classes"]);
 </pre>
           </td>
         </tr>