paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 11:09:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

* synchronized with trunk

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
compiler/xtensa/aasmcpu.pas
View File

@ -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

2
compiler/xtensa/cpupi.pas
View File

@ -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;

14
compiler/xtensa/rgcpu.pas
View File

@ -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.

6
packages/fcl-passrc/src/pasresolver.pp
View File

@ -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,

118
packages/pastojs/src/fppas2js.pp
View File

@ -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;

178
packages/pastojs/tests/tcgenerics.pas
View File

@ -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();',

53
packages/pastojs/tests/tcmodules.pas
View File

@ -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);

129
packages/pastojs/tests/tcoptimizations.pas
View File

@ -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;

6
rtl/linux/osdefs.inc
View File

@ -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))}

8
rtl/linux/ostypes.inc
View File

@ -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

23
utils/pas2js/dist/rtl.js vendored
View File

@ -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;
}
},

31
utils/pas2js/docs/translation.html
View File

@ -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>