From 1d3ea626747a277a9ca137d67f688d6cb103f128 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Wed, 9 Sep 2020 10:39:29 +0000 Subject: [PATCH 01/12] pastojs: renamed aliasglobals to jsaliasglobals git-svn-id: trunk@46805 - --- packages/pastojs/src/fppas2js.pp | 2 +- packages/pastojs/tests/tcoptimizations.pas | 62 ++++++++++++++++++---- 2 files changed, 53 insertions(+), 11 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 56e817c3df..2e42cae9bd 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -2797,7 +2797,7 @@ procedure TPas2jsPasScanner.DoHandleOptimization(OptName, OptValue: string); begin case lowercase(OptName) of - 'aliasglobals': + 'jsaliasglobals': HandleBoolean(coAliasGlobals,true); else DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,['optimization '+OptName]); diff --git a/packages/pastojs/tests/tcoptimizations.pas b/packages/pastojs/tests/tcoptimizations.pas index 67c4e254af..26de86b358 100644 --- a/packages/pastojs/tests/tcoptimizations.pas +++ b/packages/pastojs/tests/tcoptimizations.pas @@ -56,7 +56,7 @@ type TTestOptimizations = class(TCustomTestOptimizations) published - // unit optimization: aliasglobals + // unit optimization: jsaliasglobals procedure TestOptAliasGlobals_Program; procedure TestOptAliasGlobals_Unit; // ToDo // ToDo: external var, const, class @@ -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,6 +246,7 @@ begin ' r.x:=e.Run;', ' r.x:=e.Run();', ' r.x:=e.Run(4);', + ' c:=cRedBlue;', '']); ConvertProgram; CheckSource('TestOptAliasGlobals_Program', @@ -257,6 +262,7 @@ begin '});', 'this.e = null;', 'this.r = $ltr1.$new();', + 'this.c = {};', '']), LinesToStr([ '$mod.e = $mod.TEagle.$create("Create");', @@ -267,22 +273,20 @@ begin '$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($lmr.cRedBlue);', ''])); end; procedure TTestOptimizations.TestOptAliasGlobals_Unit; begin - exit; - AddModuleWithIntfImplSrc('UnitA.pas', LinesToStr([ - 'const', - ' cWidth = 17;', 'type', ' TBird = class', ' public', ' class var Span: word;', ' class procedure Fly(w: word); virtual; abstract;', + ' class procedure Swim; static;', ' end;', ' TRecA = record', ' x: word;', @@ -290,16 +294,16 @@ begin 'var Bird: TBird;', '']), LinesToStr([ + 'class procedure TBird.Swim; begin end;', ''])); AddModuleWithIntfImplSrc('UnitB.pas', LinesToStr([ - 'const', - ' cHeight = 23;', 'type', ' TAnt = class', ' public', ' class var Legs: word;', ' class procedure Run(w: word); virtual; abstract;', + ' class procedure Walk; static;', ' end;', ' TRecB = record', ' y: word;', @@ -307,10 +311,11 @@ begin 'var Ant: TAnt;', '']), LinesToStr([ + 'class procedure TAnt.Walk; begin end;', ''])); StartUnit(true,[supTObject]); Add([ - '{$optimization AliasGlobals}', + '{$optimization JSAliasGlobals}', 'interface', 'uses unita;', 'type', @@ -341,12 +346,49 @@ begin ' Bird:=TBird.Create;', ' Ant:=TAnt.Create;', ' TRedAnt.RedAntRecA.x:=TRedAnt.RedAntRecB.y;', + ' Ant.Walk;', + ' RedAnt.Walk;', + ' RedAnt.Run(17);', '']); ConvertUnit; CheckSource('TestOptAliasGlobals_Unit', LinesToStr([ + 'var $impl = $mod.$impl;', + 'var $lmr = pas.UnitA;', + 'var $ltr = $lmr.TBird;', + 'var $ltr1 = $lmr.TRecA;', + 'var $lmr1 = pas.UnitB;', + 'var $ltr2 = $lmr1.TAnt;', + 'rtl.createClass($mod, "TEagle", $ltr, function () {', + ' this.EagleRec = $ltr1.$new();', + ' this.Fly = function (w) {', + ' };', + '});', '']), LinesToStr([ + '$impl.Eagle = $mod.TEagle.$create("Create");', + '$impl.RedAnt = $impl.TRedAnt.$create("Create");', + '$lmr.Bird = $ltr.$create("Create");', + '$lmr1.Ant = $ltr2.$create("Create");', + '$impl.TRedAnt.RedAntRecA.x = $impl.TRedAnt.RedAntRecB.y;', + '$lmr1.Ant.Walk();', + '$impl.RedAnt.Walk();', + '$impl.RedAnt.$class.Run(17);', + '']), + LinesToStr([ + 'var $lmr = pas.UnitB;', + 'var $ltr = $lmr.TAnt;', + 'var $lmr1 = pas.UnitA;', + 'var $ltr1 = $lmr1.TRecA;', + 'var $ltr2 = $lmr.TRecB;', + 'rtl.createClass($impl, "TRedAnt", $ltr, function () {', + ' this.RedAntRecA = $ltr1.$new();', + ' this.RedAntRecB = $ltr2.$new();', + ' this.Run = function (w) {', + ' };', + '});', + '$impl.Eagle = null;', + '$impl.RedAnt = null;', ''])); end; From 9d3daca70c48851842d4fab3b43eea98713debaa Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Wed, 9 Sep 2020 10:54:26 +0000 Subject: [PATCH 02/12] pastojs: pass impl uses as [] instead of null git-svn-id: trunk@46806 - --- packages/pastojs/src/fppas2js.pp | 2 +- packages/pastojs/tests/tcgenerics.pas | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 2e42cae9bd..335f2037aa 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -7756,7 +7756,7 @@ begin begin // add param if not HasImplUsesClause then - ArgArray.AddElement(CreateLiteralNull(El)); + ArgArray.AddElement(CreateElement(TJSArrayLiteral,El)); ArgArray.AddElement(ImplFunc); end; end; diff --git a/packages/pastojs/tests/tcgenerics.pas b/packages/pastojs/tests/tcgenerics.pas index cd69f43547..a890e869eb 100644 --- a/packages/pastojs/tests/tcgenerics.pas +++ b/packages/pastojs/tests/tcgenerics.pas @@ -259,7 +259,7 @@ begin ' $mod.$init = function () {', ' $impl.f.x.b = $impl.f.x.b + 10;', ' };', - '}, null, function () {', + '}, [], function () {', ' var $mod = this;', ' var $impl = $mod.$impl;', ' rtl.recNewT($impl, "TBird", function () {', @@ -1154,7 +1154,7 @@ begin ' $mod.$init = function () {', ' $impl.f.x.b = $impl.f.x.b + 10;', ' };', - '}, null, function () {', + '}, [], function () {', ' var $mod = this;', ' var $impl = $mod.$impl;', ' rtl.recNewT($impl, "TBird", function () {', @@ -1366,7 +1366,7 @@ begin ' $mod.$init = function () {', ' $impl.f.x.b = $impl.f.x.b + 10;', ' };', - '}, null, function () {', + '}, [], function () {', ' var $mod = this;', ' var $impl = $mod.$impl;', ' rtl.recNewT($impl, "TBird", function () {', @@ -1560,7 +1560,7 @@ begin ' $impl.DoIt();', ' };', ' });', - '}, null, function () {', + '}, [], function () {', ' var $mod = this;', ' var $impl = $mod.$impl;', ' $impl.DoIt = function () {', @@ -2086,7 +2086,7 @@ begin ' $impl.d[0].b = $impl.s[0].b;', ' $impl.s = $mod.TStatic$G1$clone($impl.s);', ' };', - '}, null, function () {', + '}, [], function () {', ' var $mod = this;', ' var $impl = $mod.$impl;', ' rtl.recNewT($impl, "TBird", function () {', @@ -2209,7 +2209,7 @@ begin ' $impl.b.$assign($impl.f($impl.b));', ' $impl.p = $mod.$rtti["TAnt"];', ' };', - '}, null, function () {', + '}, [], function () {', ' var $mod = this;', ' var $impl = $mod.$impl;', ' rtl.recNewT($impl, "TBird", function () {', From 342771c0c74445d93e86ff10a6b49c804abe24d1 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Wed, 9 Sep 2020 11:24:56 +0000 Subject: [PATCH 03/12] pastojs: fixed create pascal class descendent from a pascal class descendent of a JS function git-svn-id: trunk@46807 - --- utils/pas2js/dist/rtl.js | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/pas2js/dist/rtl.js b/utils/pas2js/dist/rtl.js index efba60fdc1..9594091f97 100644 --- a/utils/pas2js/dist/rtl.js +++ b/utils/pas2js/dist/rtl.js @@ -353,6 +353,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 +398,6 @@ var rtl = { function f(){} f.prototype = c; c.$func = f; - c.$ancestorfunc = ancestor; } }, From 13c10cc6225e37aa6113c82a9f8f97017ce0ed49 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Wed, 9 Sep 2020 11:40:53 +0000 Subject: [PATCH 04/12] fcl-passrc: fixed compile with pas2js git-svn-id: trunk@46808 - --- packages/fcl-passrc/src/pasresolver.pp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index eab18fed0d..41a2608012 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -20259,11 +20259,11 @@ 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'; + btWideChar: aName:='tkWChar'; btString: if BaseTypeString=btAnsiString then aName:='tkAString' else aName:='tkUString'; {$ifdef FPC_HAS_CPSTRING} btAnsiString, From 0f466cbed7401e3e042e8398a6eb060e31ab7b95 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Wed, 9 Sep 2020 11:43:57 +0000 Subject: [PATCH 05/12] fcl-passrc: fixed compile with pas2js git-svn-id: trunk@46809 - --- packages/fcl-passrc/src/pasresolver.pp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 41a2608012..606ad86825 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -20264,7 +20264,7 @@ begin btAnsiChar: aName:='tkChar'; {$endif} btWideChar: aName:='tkWChar'; - btString: if BaseTypeString=btAnsiString then aName:='tkAString' else aName:='tkUString'; + btString: {$ifdef FPC_HAS_CPSTRING}if BaseTypeString=btAnsiString then aName:='tkAString' else {$ENDIF}aName:='tkUString'; {$ifdef FPC_HAS_CPSTRING} btAnsiString, btShortString, From b49aa071ca8e4d2396afee7a85cdf34695a664d8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A1roly=20Balogh?= Date: Wed, 9 Sep 2020 14:58:45 +0000 Subject: [PATCH 06/12] * linux: fix some formatting in ostypes.inc, no functional change git-svn-id: trunk@46810 - --- rtl/linux/ostypes.inc | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/rtl/linux/ostypes.inc b/rtl/linux/ostypes.inc index 4f7a56cef9..b07bed63dc 100644 --- a/rtl/linux/ostypes.inc +++ b/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 From 277d98431c0aa3a72664b639fcc02124bf870a14 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A1roly=20Balogh?= Date: Wed, 9 Sep 2020 15:15:52 +0000 Subject: [PATCH 07/12] * linux: use ugetrlimit syscall on m68k for rlimits retrieval. this fixes fpgetrlimit() call, and stack checking on Linux/m68k (tstack.pp test), at least on anything newer than kernel 2.4+ (2001) git-svn-id: trunk@46811 - --- rtl/linux/osdefs.inc | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/rtl/linux/osdefs.inc b/rtl/linux/osdefs.inc index 1e114a948e..7b38c2ef48 100644 --- a/rtl/linux/osdefs.inc +++ b/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))} From 02c72dd5c43d53115aa774d1c14f6853f8f05329 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Wed, 9 Sep 2020 19:56:43 +0000 Subject: [PATCH 08/12] pastojs: moved unit implementation js function into unit interface to share local vars git-svn-id: trunk@46816 - --- packages/pastojs/src/fppas2js.pp | 116 ++++++-------- packages/pastojs/tests/tcgenerics.pas | 178 ++++++++++----------- packages/pastojs/tests/tcmodules.pas | 53 +++--- packages/pastojs/tests/tcoptimizations.pas | 133 +++++++-------- utils/pas2js/dist/rtl.js | 19 ++- 5 files changed, 233 insertions(+), 266 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 335f2037aa..35d55acf61 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/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 @@ -7600,28 +7602,40 @@ Program: rtl.module('program', [,, ...], function(){ + var $mod = this; this.$main=function(){ }; }); -Unit: +Unit without implementation: rtl.module('', [,, ...], function(){ - var $impl = {}; + var $mod = this; this.$impl = $impl; this.$init=function(){ }; + }); + +Unit with implementation: + rtl.module('', + [,, ...], + function(){ + var $mod = this; + var $impl = $mod.$impl; + + $impl.$code=function(){ + }; + this.$init=function(){ + + }; }, [,, ...], - function(){ - var $impl = this.$impl; - - }); + ); *) 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: [,, ...] - 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: [,, ...] + 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(CreateElement(TJSArrayLiteral,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; diff --git a/packages/pastojs/tests/tcgenerics.pas b/packages/pastojs/tests/tcgenerics.pas index a890e869eb..3beb9a68c9 100644 --- a/packages/pastojs/tests/tcgenerics.pas +++ b/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;', ' };', - '}, [], 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;', ' };', - '}, [], 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", {', ' 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;', ' };', - '}, [], 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();', ' };', ' });', - '}, [], 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", {', ' 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);', ' };', - '}, [], 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"].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"];', ' };', - '}, [], 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"].init();', diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index be5ec3d108..1c846598ae 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/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,41 +2029,36 @@ 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; + end; + //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); - - CheckDiff(Msg,ExpectedSrc,ActualSrc); end; procedure TCustomTestModule.CheckDiff(Msg, Expected, Actual: string); diff --git a/packages/pastojs/tests/tcoptimizations.pas b/packages/pastojs/tests/tcoptimizations.pas index 26de86b358..4f8fc6cb3c 100644 --- a/packages/pastojs/tests/tcoptimizations.pas +++ b/packages/pastojs/tests/tcoptimizations.pas @@ -58,7 +58,7 @@ type published // 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) @@ -251,42 +251,39 @@ begin 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($lmr.cRedBlue);', + '$mod.c = rtl.refSet($lm.cRedBlue);', ''])); end; -procedure TTestOptimizations.TestOptAliasGlobals_Unit; +procedure TTestOptimizations.TestOptAliasGlobals_Unit_FromIntfImpl_ToIntfImpl; begin AddModuleWithIntfImplSrc('UnitA.pas', LinesToStr([ 'type', ' TBird = class', - ' public', - ' class var Span: word;', - ' class procedure Fly(w: word); virtual; abstract;', - ' class procedure Swim; static;', + ' public Speed: word;', ' end;', ' TRecA = record', ' x: word;', @@ -294,24 +291,21 @@ begin 'var Bird: TBird;', '']), LinesToStr([ - 'class procedure TBird.Swim; begin end;', ''])); AddModuleWithIntfImplSrc('UnitB.pas', LinesToStr([ 'type', ' TAnt = class', - ' public', - ' class var Legs: word;', - ' class procedure Run(w: word); virtual; abstract;', - ' class procedure Walk; static;', + ' public Size: word;', ' end;', ' TRecB = record', ' y: word;', ' end;', + ' TBear = class', + ' end;', 'var Ant: TAnt;', '']), LinesToStr([ - 'class procedure TAnt.Walk; begin end;', ''])); StartUnit(true,[supTObject]); Add([ @@ -319,76 +313,83 @@ begin '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;', - ' Ant.Walk;', - ' RedAnt.Walk;', - ' RedAnt.Run(17);', + ' 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 $lmr = pas.UnitA;', - 'var $ltr = $lmr.TBird;', - 'var $ltr1 = $lmr.TRecA;', - 'var $lmr1 = pas.UnitB;', - 'var $ltr2 = $lmr1.TAnt;', - 'rtl.createClass($mod, "TEagle", $ltr, function () {', - ' this.EagleRec = $ltr1.$new();', - ' this.Fly = function (w) {', + '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.Eagle = $mod.TEagle.$create("Create");', '$impl.RedAnt = $impl.TRedAnt.$create("Create");', - '$lmr.Bird = $ltr.$create("Create");', - '$lmr1.Ant = $ltr2.$create("Create");', - '$impl.TRedAnt.RedAntRecA.x = $impl.TRedAnt.RedAntRecB.y;', - '$lmr1.Ant.Walk();', - '$impl.RedAnt.Walk();', - '$impl.RedAnt.$class.Run(17);', + '$impl.Ant = $lt1.$create("Create");', + '$impl.Bird = $lt.$create("Create");', + '$impl.Eagle = $mod.TEagle.$create("Create");', + '$impl.Eagle.Fly();', + '$impl.RedAnt.Run();', '']), LinesToStr([ - 'var $lmr = pas.UnitB;', - 'var $ltr = $lmr.TAnt;', - 'var $lmr1 = pas.UnitA;', - 'var $ltr1 = $lmr1.TRecA;', - 'var $ltr2 = $lmr.TRecB;', - 'rtl.createClass($impl, "TRedAnt", $ltr, function () {', - ' this.RedAntRecA = $ltr1.$new();', - ' this.RedAntRecB = $ltr2.$new();', - ' this.Run = function (w) {', + '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.Eagle = null;', '$impl.RedAnt = null;', + '$impl.Ant = null;', + '$impl.Bird = null;', + '$impl.Eagle = null;', ''])); end; diff --git a/utils/pas2js/dist/rtl.js b/utils/pas2js/dist/rtl.js index 9594091f97..84726659f8 100644 --- a/utils/pas2js/dist/rtl.js +++ b/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 r = Object.create(rtl.tSectionRTTI); var module = pas[module_name] = { $name: module_name, $intfuseslist: intfuseslist, $impluseslist: impluseslist, $state: rtl.m_loading, $intfcode: intfcode, - $implcode: implcode, - $impl: null, - $rtti: Object.create(rtl.tSectionRTTI) + $implcode: null, + $impl: impluseslist?{ + $module: module, + $rtti: r + }:null, + $rtti: r }; module.$rtti.$module = module; - if (implcode) module.$impl = { - $module: module, - $rtti: module.$rtti - }; }, exitcode: 0, From aae5c452cba018e82b3fe564f9b1cd72e93fc70d Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Wed, 9 Sep 2020 20:32:01 +0000 Subject: [PATCH 09/12] pastojs: fixed impl rtti git-svn-id: trunk@46817 - --- utils/pas2js/dist/rtl.js | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/utils/pas2js/dist/rtl.js b/utils/pas2js/dist/rtl.js index 84726659f8..c7f51e8072 100644 --- a/utils/pas2js/dist/rtl.js +++ b/utils/pas2js/dist/rtl.js @@ -109,20 +109,20 @@ var rtl = { rtl.error('module "'+module_name+'" is already registered'); var r = Object.create(rtl.tSectionRTTI); - var module = pas[module_name] = { + var module = r.$module = pas[module_name] = { $name: module_name, $intfuseslist: intfuseslist, $impluseslist: impluseslist, $state: rtl.m_loading, $intfcode: intfcode, $implcode: null, - $impl: impluseslist?{ - $module: module, - $rtti: r - }:null, + $impl: null, $rtti: r }; - module.$rtti.$module = module; + if (impluseslist) module.$impl = { + $module: module, + $rtti: r + }; }, exitcode: 0, From edd10be1e2be0475a034c743fe270c5dfafcc77d Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Wed, 9 Sep 2020 20:40:58 +0000 Subject: [PATCH 10/12] pastojs: docs updated git-svn-id: trunk@46818 - --- utils/pas2js/docs/translation.html | 31 +++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/utils/pas2js/docs/translation.html b/utils/pas2js/docs/translation.html index c82d184908..6aad85fea4 100644 --- a/utils/pas2js/docs/translation.html +++ b/utils/pas2js/docs/translation.html @@ -370,15 +370,18 @@ End. 
rtl.module('<unitname>',
   ['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]
+  };
@@ -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"]); From 27b4f3df60156766fee4f681dac5f3d784de856f Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 9 Sep 2020 21:08:03 +0000 Subject: [PATCH 11/12] * Xtensa: taicpu.spilling_get_operation_type improved git-svn-id: trunk@46819 - --- compiler/xtensa/aasmcpu.pas | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/compiler/xtensa/aasmcpu.pas b/compiler/xtensa/aasmcpu.pas index de4e30e9f4..f727d3effa 100644 --- a/compiler/xtensa/aasmcpu.pas +++ b/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 From ddf26cb3d2aa757a578531e5f59ba2bef189fdbf Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 9 Sep 2020 21:08:04 +0000 Subject: [PATCH 12/12] * Xtensa: trgcpu.do_spill_op fixed * cleanup git-svn-id: trunk@46820 - --- compiler/xtensa/cpupi.pas | 2 +- compiler/xtensa/rgcpu.pas | 14 ++------------ 2 files changed, 3 insertions(+), 13 deletions(-) diff --git a/compiler/xtensa/cpupi.pas b/compiler/xtensa/cpupi.pas index 29b2ae8a7e..f438823ca8 100644 --- a/compiler/xtensa/cpupi.pas +++ b/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; diff --git a/compiler/xtensa/rgcpu.pas b/compiler/xtensa/rgcpu.pas index e2e39277c2..94aa6f496b 100644 --- a/compiler/xtensa/rgcpu.pas +++ b/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.