* synchronized with trunk

git-svn-id: branches/wasm@46821 -
This commit is contained in:
nickysn 2020-09-09 23:01:37 +00:00
commit 6a55837226
12 changed files with 295 additions and 283 deletions

View File

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

View File

@ -200,7 +200,7 @@ unit cpupi;
end end
else else
begin 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; RS_FRAME_POINTER_REG:=RS_A15;
NR_FRAME_POINTER_REG:=NR_A15; NR_FRAME_POINTER_REG:=NR_A15;
end; end;

View File

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

View File

@ -20259,12 +20259,12 @@ begin
begin begin
bt:=ParamResolved.BaseType; bt:=ParamResolved.BaseType;
case bt of 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} {$ifdef FPC_HAS_CPSTRING}
btAnsiChar: aName:='tkChar'; btAnsiChar: aName:='tkChar';
{$endif} {$endif}
btWideChar: aName:='tkWideChar'; 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} {$ifdef FPC_HAS_CPSTRING}
btAnsiString, btAnsiString,
btShortString, btShortString,

View File

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

View File

@ -256,12 +256,7 @@ begin
' return this;', ' return this;',
' };', ' };',
' }, true);', ' }, true);',
' $mod.$init = function () {', ' $mod.$implcode = function () {',
' $impl.f.x.b = $impl.f.x.b + 10;',
' };',
'}, null, function () {',
' var $mod = this;',
' var $impl = $mod.$impl;',
' rtl.recNewT($impl, "TBird", function () {', ' rtl.recNewT($impl, "TBird", function () {',
' this.b = 0;', ' this.b = 0;',
' this.$eq = function (b) {', ' this.$eq = function (b) {',
@ -273,7 +268,11 @@ begin
' };', ' };',
' });', ' });',
' $impl.f = $mod.TAnt$G1.$new();', ' $impl.f = $mod.TAnt$G1.$new();',
'});'])); ' };',
' $mod.$init = function () {',
' $impl.f.x.b = $impl.f.x.b + 10;',
' };',
'}, []);']));
CheckSource('TestGen_Record_ClassVarRecord_UnitImpl', CheckSource('TestGen_Record_ClassVarRecord_UnitImpl',
LinesToStr([ // statements LinesToStr([ // statements
'pas.UnitA.TAnt$G1.$initSpec();', 'pas.UnitA.TAnt$G1.$initSpec();',
@ -1151,12 +1150,7 @@ begin
' this.a = rtl.arraySetLength(null, $impl.TBird, 2);', ' this.a = rtl.arraySetLength(null, $impl.TBird, 2);',
' };', ' };',
' });', ' });',
' $mod.$init = function () {', ' $mod.$implcode = function () {',
' $impl.f.x.b = $impl.f.x.b + 10;',
' };',
'}, null, function () {',
' var $mod = this;',
' var $impl = $mod.$impl;',
' rtl.recNewT($impl, "TBird", function () {', ' rtl.recNewT($impl, "TBird", function () {',
' this.b = 0;', ' this.b = 0;',
' this.$eq = function (b) {', ' this.$eq = function (b) {',
@ -1168,7 +1162,11 @@ begin
' };', ' };',
' });', ' });',
' $impl.f = null;', ' $impl.f = null;',
'});'])); ' };',
' $mod.$init = function () {',
' $impl.f.x.b = $impl.f.x.b + 10;',
' };',
'}, []);']));
CheckSource('TestGen_Class_ClassVarRecord_UnitImpl', CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
LinesToStr([ // statements LinesToStr([ // statements
'pas.UnitA.TAnt$G1.$initSpec();', 'pas.UnitA.TAnt$G1.$initSpec();',
@ -1363,12 +1361,7 @@ begin
' $mod.$rtti.$ExtClass("TAnt<UnitA.TBird>", {', ' $mod.$rtti.$ExtClass("TAnt<UnitA.TBird>", {',
' jsclass: "SET"', ' jsclass: "SET"',
' });', ' });',
' $mod.$init = function () {', ' $mod.$implcode = function () {',
' $impl.f.x.b = $impl.f.x.b + 10;',
' };',
'}, null, function () {',
' var $mod = this;',
' var $impl = $mod.$impl;',
' rtl.recNewT($impl, "TBird", function () {', ' rtl.recNewT($impl, "TBird", function () {',
' this.b = 0;', ' this.b = 0;',
' this.$eq = function (b) {', ' this.$eq = function (b) {',
@ -1382,7 +1375,11 @@ begin
' $r.addField("b", rtl.word);', ' $r.addField("b", rtl.word);',
' });', ' });',
' $impl.f = null;', ' $impl.f = null;',
'});'])); ' };',
' $mod.$init = function () {',
' $impl.f.x.b = $impl.f.x.b + 10;',
' };',
'}, []);']));
CheckSource('TestGen_Class_ClassVarRecord_UnitImpl', CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
LinesToStr([ // statements LinesToStr([ // statements
//'pas.UnitA.TAnt$G1.$initSpec();', //'pas.UnitA.TAnt$G1.$initSpec();',
@ -1560,15 +1557,14 @@ begin
' $impl.DoIt();', ' $impl.DoIt();',
' };', ' };',
' });', ' });',
'}, null, function () {', ' $mod.$implcode = function () {',
' var $mod = this;',
' var $impl = $mod.$impl;',
' $impl.DoIt = function () {', ' $impl.DoIt = function () {',
' var b = null;', ' var b = null;',
' b = $mod.TBird$G2.$create("Create");', ' b = $mod.TBird$G2.$create("Create");',
' b.Fly();', ' b.Fly();',
' };', ' };',
'});', ' };',
'}, []);',
''])); '']));
end; end;
@ -2082,13 +2078,7 @@ begin
' $mod.$rtti.$StaticArray("TStatic<UnitA.TBird>", {', ' $mod.$rtti.$StaticArray("TStatic<UnitA.TBird>", {',
' dims: [2]', ' dims: [2]',
' });', ' });',
' $mod.$init = function () {', ' $mod.$implcode = 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 () {', ' rtl.recNewT($impl, "TBird", function () {',
' this.b = 0;', ' this.b = 0;',
' this.$eq = function (b) {', ' this.$eq = function (b) {',
@ -2103,7 +2093,12 @@ begin
' });', ' });',
' $impl.d = [];', ' $impl.d = [];',
' $impl.s = rtl.arraySetLength(null, $impl.TBird, 2);', ' $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);',
' };',
'}, []);']));
CheckSource('TestGen_Class_ClassVarRecord_UnitImpl', CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
LinesToStr([ // statements LinesToStr([ // statements
'pas.UnitA.$rtti["TDyn<UnitA.TBird>"].eltype = pas.UnitA.$rtti["TBird"];', 'pas.UnitA.$rtti["TDyn<UnitA.TBird>"].eltype = pas.UnitA.$rtti["TBird"];',
@ -2205,13 +2200,7 @@ begin
' this.procsig = rtl.newTIProcSig([["a", $mod.$rtti["TBird"], 2]], $mod.$rtti["TBird"]);', ' this.procsig = rtl.newTIProcSig([["a", $mod.$rtti["TBird"], 2]], $mod.$rtti["TBird"]);',
' }', ' }',
' });', ' });',
' $mod.$init = function () {', ' $mod.$implcode = 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 () {', ' rtl.recNewT($impl, "TBird", function () {',
' this.b = 0;', ' this.b = 0;',
' this.$eq = function (b) {', ' this.$eq = function (b) {',
@ -2227,7 +2216,12 @@ begin
' $impl.f = null;', ' $impl.f = null;',
' $impl.b = $impl.TBird.$new();', ' $impl.b = $impl.TBird.$new();',
' $impl.p = null;', ' $impl.p = null;',
'});'])); ' };',
' $mod.$init = function () {',
' $impl.b.$assign($impl.f($impl.b));',
' $impl.p = $mod.$rtti["TAnt<UnitA.TBird>"];',
' };',
'}, []);']));
CheckSource('TestGen_Class_ClassVarRecord_UnitImpl', CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
LinesToStr([ // statements LinesToStr([ // statements
'pas.UnitA.$rtti["TAnt<UnitA.TBird>"].init();', 'pas.UnitA.$rtti["TAnt<UnitA.TBird>"].init();',

View File

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

View File

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

View File

@ -28,9 +28,11 @@
{$endif} {$endif}
{$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))} (defined(cpuarm) and defined(FPC_ABI_EABI))}
{$DEFINE has_ugetrlimit} {$define HAS_UGETRLIMIT}
{$endif} {$endif}
{$if (defined(cpuarm) and defined(FPC_ABI_EABI))} {$if (defined(cpuarm) and defined(FPC_ABI_EABI))}

View File

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

View File

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