From e42140d8d4a4051e6000e304bdab9449f88443f4 Mon Sep 17 00:00:00 2001 From: mattias Date: Mon, 30 Nov 2020 22:05:02 +0000 Subject: [PATCH] pastojs: shortrefglobals: unit initialization and empty implementation --- compiler/packages/pastojs/src/fppas2js.pp | 34 ++++---- compiler/packages/pastojs/src/pas2jsfiler.pp | 84 +++++++++++++------ .../pastojs/tests/tcoptimizations.pas | 38 +++++++++ 3 files changed, 115 insertions(+), 41 deletions(-) diff --git a/compiler/packages/pastojs/src/fppas2js.pp b/compiler/packages/pastojs/src/fppas2js.pp index bc11c6e..10ba370 100644 --- a/compiler/packages/pastojs/src/fppas2js.pp +++ b/compiler/packages/pastojs/src/fppas2js.pp @@ -1786,7 +1786,7 @@ type ImplContext: TSectionContext; ImplHeaderStatements: TFPList; ImplSrcElements: TJSSourceElements; - ImplHeaderIndex: integer; // index in TJSSourceElements(JSElement).Statements + ImplHeaderIndex: integer; // index in ImplSrcElements.Statements destructor Destroy; override; procedure AddImplHeaderStatement(JS: TJSElement); end; @@ -8111,31 +8111,34 @@ begin AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfSecCtx)); ImplFunc:=CreateImplementationSection(El,IntfSecCtx); - if ImplFunc=nil then + // add $mod.$implcode = ImplFunc; + AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El)); + AssignSt.LHS:=CreateMemberExpression([ModVarName,GetBIName(pbivnImplCode)]); + AssignSt.Expr:=ImplFunc; + AddToSourceElements(Src,AssignSt); + + // append initialization section + CreateInitSection(El,Src,IntfSecCtx); + + if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count=0 then begin + // empty implementation + // remove unneeded $impl from interface RemoveFromSourceElements(Src,ImplVarSt); - if IntfSecCtx.HeaderIndex>0 then - dec(IntfSecCtx.HeaderIndex); - if IntfSecCtx.ImplHeaderIndex>0 then - dec(IntfSecCtx.ImplHeaderIndex); + // remove unneeded $mod.$implcode = function(){} + RemoveFromSourceElements(Src,AssignSt); 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,IntfSecCtx); - end; if (ModScope<>nil) and (coStoreImplJS in Options) then @@ -17492,14 +17495,15 @@ begin if ImplDecl<>nil then RaiseInconsistency(20170910175032,El); // elements should have been added directly IntfContext.ImplHeaderIndex:=ImplContext.HeaderIndex; - if Src.Statements.Count=0 then - exit; // no implementation Result:=FunDecl; finally IntfContext.ImplContext:=nil; ImplContext.Free; if Result=nil then + begin FunDecl.Free; + IntfContext.ImplSrcElements:=nil; + end; end; end; diff --git a/compiler/packages/pastojs/src/pas2jsfiler.pp b/compiler/packages/pastojs/src/pas2jsfiler.pp index 32182eb..0f531d6 100644 --- a/compiler/packages/pastojs/src/pas2jsfiler.pp +++ b/compiler/packages/pastojs/src/pas2jsfiler.pp @@ -995,6 +995,7 @@ type FElementRefsArray: TPCUFilerElementRefArray; // TPCUFilerElementRef by Id FJSON: TJSONObject; FPendingIdentifierScopes: TObjectList; // list of TPCUReaderPendingIdentifierScope + FIntfSectionObj: TJSONObject; procedure Set_Variable_VarType(RefEl: TPasElement; Data: TObject); procedure Set_AliasType_DestType(RefEl: TPasElement; Data: TObject); procedure Set_PointerType_DestType(RefEl: TPasElement; Data: TObject); @@ -1092,6 +1093,7 @@ type procedure ReadSpecialization(Obj: TJSONObject; GenEl: TPasGenericType; ParamIDs: TJSONArray); virtual; procedure ReadExternalReferences(Obj: TJSONObject; El: TPasElement); virtual; procedure ReadUsedUnitsInit(Obj: TJSONObject; Section: TPasSection; aContext: TPCUReaderContext); virtual; + procedure ReadIndirectUsedUnits(Obj: TJSONObject; Section: TPasSection; aComplete: boolean); virtual; procedure ReadUsedUnitsFinish(Obj: TJSONObject; Section: TPasSection; aContext: TPCUReaderContext); virtual; procedure ReadSectionScope(Obj: TJSONObject; Scope: TPas2JSSectionScope; aContext: TPCUReaderContext); virtual; procedure ReadSection(Obj: TJSONObject; Section: TPasSection; aContext: TPCUReaderContext); virtual; @@ -2585,7 +2587,7 @@ procedure TPCUWriter.WriteModule(Obj: TJSONObject; aModule: TPasModule; if Section=nil then exit; if Section.Parent<>aModule then RaiseMsg(20180205153912,aModule,PropName); - aContext.Section:=Section; // set Section before calling virtual method + aContext.Section:=Section; // set Section before calling virtual WriteSection aContext.SectionObj:=nil; aContext.IndirectUsesArr:=nil; WriteSection(Obj,Section,PropName,aContext); @@ -5527,7 +5529,8 @@ begin RaiseMsg(20200531101105,PendSpec.GenericEl,PendSpec.SpecName);// nothing uses this specialize end; if PendSpec.GenericEl=nil then - RaiseMsg(20200531101333,RefEl,PendSpec.SpecName); + // not yet ready + exit; Obj:=PendSpec.Obj; if Obj=nil then RaiseMsg(20200531101128,PendSpec.GenericEl,PendSpec.SpecName); // specialize missing in JSON @@ -6809,6 +6812,50 @@ begin if aContext=nil then ; end; +procedure TPCUReader.ReadIndirectUsedUnits(Obj: TJSONObject; + Section: TPasSection; aComplete: boolean); +// read external refs from indirectly used units +var + i: Integer; + Arr: TJSONArray; + Data: TJSONData; + UsesObj: TJSONObject; + Name: string; + Module: TPasModule; + UsedScope: TPas2JSSectionScope; +begin + if ReadArray(Obj,'IndirectUses',Arr,Section) then + begin + for i:=0 to Arr.Count-1 do + begin + Data:=Arr[i]; + if not (Data is TJSONObject) then + RaiseMsg(20180314155716,Section,GetObjName(Data)); + UsesObj:=TJSONObject(Data); + if not ReadString(UsesObj,'Name',Name,Section) then + RaiseMsg(20180314155756,Section); + if not IsValidIdent(Name,true,true) then + RaiseMsg(20180314155800,Section,Name); + Module:=Resolver.FindModule(Name,nil,nil); + if Module=nil then + RaiseMsg(20180314155840,Section,Name); + if Module.InterfaceSection=nil then + begin + if not aComplete then + continue; + {$IF defined(VerbosePCUFiler) or defined(VerbosePJUFiler)} + writeln('TPCUReader.ReadUsedUnitsFinish Resolver.RootElement=',GetObjPath(Resolver.RootElement),' Section=',GetObjPath(Section)); + {$ENDIF} + RaiseMsg(20180314155953,Section,'indirect unit "'+Name+'"'); + end; + UsedScope:=Module.InterfaceSection.CustomData as TPas2JSSectionScope; + if not UsedScope.Finished then + RaiseMsg(20180314155954,Section,'indirect unit "'+Name+'"'); + ReadExternalReferences(UsesObj,Module); + end; + end; +end; + procedure TPCUReader.ReadUsedUnitsFinish(Obj: TJSONObject; Section: TPasSection; aContext: TPCUReaderContext); var @@ -6819,10 +6866,9 @@ var Module: TPasModule; Data: TJSONData; UsesObj, ModuleObj: TJSONObject; - Name: string; begin Scope:=Section.CustomData as TPas2JSSectionScope; - // read external refs from used units + // read external refs from directly used units if ReadArray(Obj,'Uses',Arr,Section) then begin Scope:=Section.CustomData as TPas2JSSectionScope; @@ -6849,29 +6895,15 @@ begin end; // read external refs from indirectly used units - if ReadArray(Obj,'IndirectUses',Arr,Section) then + if Section.ClassType=TInterfaceSection then + FIntfSectionObj:=Obj + else if Section.ClassType=TImplementationSection then begin - for i:=0 to Arr.Count-1 do - begin - Data:=Arr[i]; - if not (Data is TJSONObject) then - RaiseMsg(20180314155716,Section,GetObjName(Data)); - UsesObj:=TJSONObject(Data); - if not ReadString(UsesObj,'Name',Name,Section) then - RaiseMsg(20180314155756,Section); - if not IsValidIdent(Name,true,true) then - RaiseMsg(20180314155800,Section,Name); - Module:=Resolver.FindModule(Name,nil,nil); - if Module=nil then - RaiseMsg(20180314155840,Section,Name); - if Module.InterfaceSection=nil then - RaiseMsg(20180314155953,Section,'indirect unit "'+Name+'"'); - UsedScope:=Module.InterfaceSection.CustomData as TPas2JSSectionScope; - if not UsedScope.Finished then - RaiseMsg(20180314155954,Section,'indirect unit "'+Name+'"'); - ReadExternalReferences(UsesObj,Module); - end; - end; + ReadIndirectUsedUnits(FIntfSectionObj,Section,true); + ReadIndirectUsedUnits(Obj,Section,true); + end + else + ReadIndirectUsedUnits(Obj,Section,true); Scope.UsesFinished:=true; diff --git a/compiler/packages/pastojs/tests/tcoptimizations.pas b/compiler/packages/pastojs/tests/tcoptimizations.pas index 9fdd434..4d0d374 100644 --- a/compiler/packages/pastojs/tests/tcoptimizations.pas +++ b/compiler/packages/pastojs/tests/tcoptimizations.pas @@ -72,6 +72,7 @@ type procedure TestOptShortRefGlobals_SameUnit_EnumType; procedure TestOptShortRefGlobals_SameUnit_ClassType; procedure TestOptShortRefGlobals_SameUnit_RecordType; + procedure TestOptShortRefGlobals_Unit_InitNoImpl; // Whole Program Optimization procedure TestWPO_OmitLocalVar; @@ -1485,6 +1486,43 @@ begin ''])); end; +procedure TTestOptimizations.TestOptShortRefGlobals_Unit_InitNoImpl; +begin + AddModuleWithIntfImplSrc('UnitA.pas', + LinesToStr([ + 'var a: word;', + 'procedure Run(w: word);', + '']), + LinesToStr([ + 'procedure Run(w: word);', + 'begin', + 'end;', + ''])); + StartUnit(true,[supTObject]); + Add([ + '{$optimization JSShortRefGlobals}', + 'interface', + 'implementation', + 'uses UnitA;', // empty implementation function + 'begin', + ' Run(a);', + '']); + ConvertUnit; + CheckSource('TestOptShortRefGlobals_Unit_InitNoImpl', + LinesToStr([ + 'var $impl = $mod.$impl;', + 'var $lm = null;', + 'var $lp = null;', + '']), + LinesToStr([ + '$lp($lm.a);', + '']), + LinesToStr([ + '$lm = pas.UnitA;', + '$lp = $lm.Run;', + ''])); +end; + procedure TTestOptimizations.TestWPO_OmitLocalVar; begin StartProgram(false);