diff options
| -rw-r--r-- | packages/pastojs/src/fppas2js.pp | 34 | ||||
| -rw-r--r-- | packages/pastojs/src/pas2jsfiler.pp | 84 | ||||
| -rw-r--r-- | packages/pastojs/tests/tcoptimizations.pas | 38 |
3 files changed, 115 insertions, 41 deletions
diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index c1cedbdee4..17934207ea 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -1788,7 +1788,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; @@ -8113,31 +8113,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: [<implementation uses1>,<uses2>, ...] ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext)); - CreateInitSection(El,Src,IntfSecCtx); - end; if (ModScope<>nil) and (coStoreImplJS in Options) then @@ -17494,14 +17497,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/packages/pastojs/src/pas2jsfiler.pp b/packages/pastojs/src/pas2jsfiler.pp index a40ab8b660..05677b9eac 100644 --- a/packages/pastojs/src/pas2jsfiler.pp +++ b/packages/pastojs/src/pas2jsfiler.pp @@ -1000,6 +1000,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); @@ -1097,6 +1098,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; @@ -2590,7 +2592,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); @@ -5533,7 +5535,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 @@ -6815,6 +6818,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 @@ -6825,10 +6872,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; @@ -6855,29 +6901,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/packages/pastojs/tests/tcoptimizations.pas b/packages/pastojs/tests/tcoptimizations.pas index 9fdd4343c5..4d0d374bba 100644 --- a/packages/pastojs/tests/tcoptimizations.pas +++ b/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); |