* Refactor so PCU support is separated out

git-svn-id: trunk@40427 -

.gitattributes

@@ -7001,6 +7001,7 @@ packages/pastojs/src/pas2jsfileutilsunix.inc svneol=native#text/plain
 packages/pastojs/src/pas2jsfileutilswin.inc svneol=native#text/plain
 packages/pastojs/src/pas2jslibcompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jslogger.pp svneol=native#text/plain
+packages/pastojs/src/pas2jspcucompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspparser.pp svneol=native#text/plain
 packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
 packages/pastojs/tests/tcfiler.pas svneol=native#text/plain

packages/pastojs/fpmake.pp

@@ -52,7 +52,10 @@ begin
     T:=P.Targets.AddUnit('pas2jslogger.pp');
     T:=P.Targets.AddUnit('pas2jspparser.pp');
     T:=P.Targets.AddUnit('pas2jscompiler.pp');
+    T:=P.Targets.AddUnit('pas2jspcucompiler.pp');
+      T.Dependencies.AddUnit('pas2jscompiler');
     T:=P.Targets.AddUnit('pas2jslibcompiler.pp');
+      T.Dependencies.AddUnit('pas2jscompiler');
 {$ifndef ALLPACKAGES}
     Run;
     end;

packages/pastojs/src/pas2jsfilecache.pp

@@ -33,9 +33,6 @@ uses
   Classes, SysUtils,
   fpjson,
   PScanner, PasUseAnalyzer, PasResolver, FPPJsSrcMap,
-  {$IFDEF HasPas2jsFiler}
-  Pas2JsFiler,
-  {$ENDIF}
   Pas2jsLogger, Pas2jsFileUtils;
 
 const // Messages
@@ -288,9 +285,6 @@ type
     FOnReadFile: TPas2jsReadFileEvent;
     FOnWriteFile: TPas2jsWriteFileEvent;
     FOptions: TP2jsFileCacheOptions;
-    {$IFDEF HasPas2jsFiler}
-    FPrecompileFormat: TPas2JSPrecompileFormat;
-    {$ENDIF}
     FReadLineCounter: SizeInt;
     FResetStamp: TChangeStamp;
     FSrcMapBaseDir: string;
@@ -317,12 +311,13 @@ type
     procedure SetUnitOutputPath(AValue: string);
     procedure SetOption(Flag: TP2jsFileCacheOption; Enable: boolean);
   protected
+    function GetHasPCUSupport: Boolean; virtual;
     function ReadFile(Filename: string; var Source: string): boolean; virtual;
     procedure FindMatchingFiles(Mask: string; MaxCount: integer; Files: TStrings);// find files, matching * and ?
   public
     constructor Create(aLog: TPas2jsLogger);
     destructor Destroy; override;
-    procedure Reset;
+    procedure Reset; virtual;
     function AddIncludePaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddNamespaces(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
@@ -364,9 +359,6 @@ type
     property Namespaces: TStringList read FNamespaces;
     property NamespacesFromCmdLine: integer read FNamespacesFromCmdLine;
     property Options: TP2jsFileCacheOptions read FOptions write SetOptions default DefaultPas2jsFileCacheOptions;
-    {$IFDEF HasPas2jsFiler}
-    property PrecompileFormat: TPas2JSPrecompileFormat read FPrecompileFormat write FPrecompileFormat;
-    {$ENDIF}
     property ReadLineCounter: SizeInt read FReadLineCounter write FReadLineCounter;
     property ResetStamp: TChangeStamp read FResetStamp;
     property SearchLikeFPC: boolean read GetSearchLikeFPC write SetSearchLikeFPC;
@@ -380,6 +372,7 @@ type
     property OnWriteFile: TPas2jsWriteFileEvent read FOnWriteFile write FOnWriteFile;
   end;
 
+
 {$IFDEF Pas2js}
 function PtrStrToStr(StrAsPtr: Pointer): string;
 function PtrFilenameToKeyName(FilenameAsPtr: Pointer): string;
@@ -572,6 +565,7 @@ begin
 end;
 {$ENDIF}
 
+
 { TPas2jsCachedDirectory }
 
 // inline
@@ -1605,6 +1599,11 @@ begin
   Result:=caoAllJSIntoMainJS in FOptions;
 end;
 
+function TPas2jsFilesCache.GetHasPCUSupport: Boolean;
+begin
+  Result:=False;
+end;
+
 function TPas2jsFilesCache.GetSearchLikeFPC: boolean;
 begin
   Result:=caoSearchLikeFPC in FOptions;
@@ -1958,9 +1957,6 @@ begin
   FStates:=FStates-[cfsMainJSFileResolved];
   FNamespaces.Clear;
   FNamespacesFromCmdLine:=0;
-  {$IFDEF HasPas2jsFiler}
-  FPrecompileFormat:=nil;
-  {$ENDIF}
   FSrcMapBaseDir:='';
   // FOnReadFile: TPas2jsReadFileEvent; keep
   // FOnWriteFile: TPas2jsWriteFileEvent; keep

packages/pastojs/src/pas2jspcucompiler.pp

@@ -0,0 +1,431 @@
+unit pas2jspcucompiler;
+
+{$mode objfpc}{$H+}
+
+{$I pas2js_defines.inc}
+
+{$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
+{$DEFINE ReallyVerbose}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils, pastree, pas2jscompiler, Pas2JsFiler;
+
+Type
+  { TFilerPCUSupport }
+
+  TFilerPCUSupport = Class(TPCUSupport)
+  Private
+    // This is the format that will be written.
+    FPCUFormat : TPas2JSPrecompileFormat;
+    // This is the format that will be read.
+    FFoundFormat : TPas2JSPrecompileFormat;
+    FPrecompileInitialFlags: TPCUInitialFlags;
+    FPCUReader: TPCUCustomReader;
+    FPCUReaderStream: TStream;
+    function OnPCUConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
+    function OnPCUConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
+    function OnWriterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
+    procedure OnFilerGetSrc(Sender: TObject; aFilename: string; out p: PChar; out Count: integer);
+  Public
+    constructor create(aCompilerFile: TPas2JSCompilerFile; aFormat: TPas2JSPrecompileFormat);
+    Destructor destroy; override;
+    Function Compiler : TPas2JSCompiler;
+    Function HandleException(E: exception) : Boolean; override;
+    function FindPCU(const UseUnitName: string): string;override;
+    function FindPCU(const UseUnitName: string; out  aFormat: TPas2JSPrecompileFormat): string;
+    Function HasReader : Boolean; override;
+    Function ReadContinue: Boolean; override;
+    Function ReadCanContinue : Boolean; override;
+    Procedure SetInitialCompileFlags; override;
+    Procedure WritePCU; override;
+    procedure CreatePCUReader; override;
+    Procedure ReadUnit; override;
+    property PrecompileInitialFlags: TPCUInitialFlags read FPrecompileInitialFlags;
+  end;
+
+  { TPas2jsPCUCompiler }
+
+  { TPas2jsPCUCompilerFile }
+
+  TPas2jsPCUCompilerFile = Class(TPas2jsCompilerFile)
+    Function CreatePCUSupport: TPCUSupport; override;
+  end;
+
+  TPas2jsPCUCompiler = Class(TPas2JSCompiler)
+    FPrecompileFormat : TPas2JSPrecompileFormat;
+  Protected
+    procedure WritePrecompiledFormats; override;
+    function CreateCompilerFile(const UnitFileName: String): TPas2jsCompilerFile; override;
+    Procedure HandleOptionPCUFormat(Value : string) ; override;
+  end;
+
+implementation
+
+uses fppas2js, pscanner, pas2jslogger, pas2jsfilecache, pasresolveeval, jstree, pas2jsfileutils;
+
+{ ---------------------------------------------------------------------
+  TFilerPCUSupport
+  ---------------------------------------------------------------------}
+
+{ TFilerPCUSupport }
+
+constructor TFilerPCUSupport.create(aCompilerFile: TPas2JSCompilerFile; aFormat: TPas2JSPrecompileFormat);
+begin
+  Inherited Create(aCompilerFile);
+  FPCUFormat:=AFormat;
+  FPrecompileInitialFlags:=TPCUInitialFlags.Create;
+end;
+
+destructor TFilerPCUSupport.destroy;
+begin
+  FreeAndNil(FPrecompileInitialFlags);
+  FreeAndNil(FPCUReader);
+  FreeAndNil(FPCUReaderStream);
+  inherited destroy;
+end;
+
+function TFilerPCUSupport.Compiler: TPas2JSCompiler;
+begin
+  Result:=MyFile.Compiler;
+end;
+
+Function TFilerPCUSupport.HandleException(E: Exception) : Boolean;
+
+begin
+  Result:=False;
+  if E is EPas2JsReadError then
+    begin
+    Result:=True;
+    if EPas2JsReadError(E).Owner is TPCUCustomReader then
+      begin
+        MyFile.Log.Log(mtError,E.Message,0,MyFile.PCUFilename);
+      end else begin
+        MyFile.Log.Log(mtError,E.Message);
+      end;
+    Compiler.Terminate(ExitCodePCUError);
+    end
+  else if (E is EPas2JsWriteError) then
+    begin
+    MyFile.Log.Log(mtFatal,E.ClassName+':'+E.Message);
+    Compiler.Terminate(ExitCodeErrorInternal);
+    Result:=True;
+    end
+end;
+
+function TFilerPCUSupport.FindPCU(const UseUnitName: string): string;
+
+begin
+  Result:=FindPCU(UseUnitName,FFoundFormat);
+end;
+
+function TFilerPCUSupport.HasReader: Boolean;
+begin
+  Result:=Assigned(FPCUReader);
+end;
+
+function TFilerPCUSupport.ReadContinue: Boolean;
+begin
+  Result:=FPCUReader.ReadContinue;
+end;
+
+function TFilerPCUSupport.ReadCanContinue: Boolean;
+begin
+  Result:=FPCUReader.ReadCanContinue;
+end;
+
+procedure TFilerPCUSupport.SetInitialCompileFlags;
+begin
+  PrecompileInitialFlags.ParserOptions:=MyFile.Parser.Options;
+  PrecompileInitialFlags.ModeSwitches:=MyFile.Scanner.CurrentModeSwitches;
+  PrecompileInitialFlags.BoolSwitches:=MyFile.Scanner.CurrentBoolSwitches;
+  PrecompileInitialFlags.ConverterOptions:=MyFile.GetInitialConverterOptions;
+  PrecompileInitialFlags.TargetPlatform:=Compiler.TargetPlatform;
+  PrecompileInitialFlags.TargetProcessor:=Compiler.TargetProcessor;
+end;
+
+procedure TFilerPCUSupport.CreatePCUReader;
+var
+  aFile: TPas2jsCachedFile;
+  s: String;
+begin
+  if MyFile.PCUFilename='' then
+    RaiseInternalError(20180312144742,MyFile.PCUFilename);
+  if FPCUReader<>nil then
+    RaiseInternalError(20180312142938,GetObjName(FPCUReader));
+  if FFoundFormat=nil then
+    RaiseInternalError(20180312142954,'');
+  FPCUReader:=FFoundFormat.ReaderClass.Create;
+  FPCUReader.SourceFilename:=ExtractFileName(MyFile.PCUFilename);
+
+  if MyFile.ShowDebug then
+    MyFile.Log.LogMsg(nParsingFile,[QuoteStr(MyFile.PCUFilename)]);
+  aFile:=Compiler.FileCache.LoadFile(MyFile.PCUFilename,true);
+  if aFile=nil then
+    RaiseInternalError(20180312145941,MyFile.PCUFilename);
+  FPCUReaderStream:=TMemoryStream.Create;
+  s:=aFile.Source;
+  //writeln('TPas2jsCompilerFile.CreatePCUReader ',PCUFilename,'-----START-----');
+  //writeln(s);
+  //writeln('TPas2jsCompilerFile.CreatePCUReader ',PCUFilename,'-----END-------');
+  if s<>'' then
+  begin
+    FPCUReaderStream.Write(s[1],length(s));
+    FPCUReaderStream.Position:=0;
+  end;
+end;
+
+procedure TFilerPCUSupport.ReadUnit;
+begin
+  FPCUReader.ReadPCU(MyFile.PascalResolver,FPCUReaderStream);
+  SetPasModule(MyFile.PascalResolver.RootElement);
+  SetReaderState(prsCanContinue);
+end;
+
+function TFilerPCUSupport.FindPCU(const UseUnitName: string; out  aFormat: TPas2JSPrecompileFormat): string;
+
+  function SearchInDir(DirPath: string): boolean;
+  var
+    i: Integer;
+    CurFormat: TPas2JSPrecompileFormat;
+    Filename: String;
+  begin
+    if DirPath='' then exit(false);
+    DirPath:=IncludeTrailingPathDelimiter(DirPath);
+    for i:=0 to PrecompileFormats.Count-1 do
+    begin
+      CurFormat:=PrecompileFormats[i];
+      if not CurFormat.Enabled then continue;
+      Filename:=DirPath+UseUnitName+'.'+CurFormat.Ext;
+      if MyFile.FileResolver.SearchLowUpCase(Filename) then
+      begin
+        FindPCU:=Filename;
+        aFormat:=CurFormat;
+        exit(true);
+      end;
+    end;
+    Result:=false;
+  end;
+
+var
+  Cache: TPas2jsFilesCache;
+  i: Integer;
+begin
+  Result:='';
+  aFormat:=nil;
+  Cache:=Compiler.FileCache;
+
+  // search in output directory
+  if Cache.UnitOutputPath<>'' then
+    if SearchInDir(Cache.UnitOutputPath) then exit;
+
+  // then in BaseDirectory
+  if SearchInDir(MyFile.FileResolver.BaseDirectory) then exit;
+
+  // finally search in unit paths
+  for i:=0 to Cache.UnitPaths.Count-1 do
+    if SearchInDir(Cache.UnitPaths[i]) then exit;
+end;
+
+function TFilerPCUSupport.OnWriterIsElementUsed(Sender: TObject;
+  El: TPasElement): boolean;
+begin
+  Result:=MyFile.UseAnalyzer.IsUsed(El);
+end;
+
+procedure TFilerPCUSupport.WritePCU;
+
+Const
+  AllowCompressed =
+{$IFDEF DisablePCUCompressed}false{$ELSE}true{$ENDIF};
+
+var
+  Writer: TPCUWriter;
+  ms: TMemoryStream;
+  DestDir: String;
+  JS: TJSElement;
+  FN : String;
+
+begin
+  if FPCUFormat=Nil then
+    exit; // Don't write
+  if MyFile.PasModule.ClassType<>TPasModule then
+  begin
+    {$IFDEF REALLYVERBOSE}
+    writeln('TPas2jsCompilerFile.WritePCU not a unit: ',PasFilename,' skip');
+    {$ENDIF}
+    exit;
+  end;
+
+  if (MyFile.PCUFilename<>'') or (FPCUReader<>nil) then
+  begin
+    {$IFDEF REALLYVERBOSE}
+    writeln('TPas2jsCompilerFile.WritePCU already precompiled "',PCUFilename,'" Reader=',GetObjName(PCUReader));
+    {$ENDIF}
+    exit;
+  end;
+
+  // Determine output filename
+  FN:=ExtractFilenameOnly(MyFile.PasFilename)+'.'+FPCUFormat.Ext;
+  if Compiler.FileCache.UnitOutputPath<>'' then
+    FN:=Compiler.FileCache.UnitOutputPath+FN
+  else
+    FN:=ExtractFilePath(MyFile.PasFilename)+FN;
+  // Set as our filename
+  SetPCUFilename(FN);
+  {$IFDEF REALLYVERBOSE}
+  writeln('TPas2jsCompilerFile.WritePCU precompiling ',PCUFilename);
+  {$ENDIF}
+
+  JS:=nil;
+  ms:=TMemoryStream.Create;
+  Writer:=FPCUFormat.WriterClass.Create;
+  try
+    Writer.GUID:=Compiler.PrecompileGUID;
+    Writer.OnGetSrc:=@OnFilerGetSrc;
+    Writer.OnIsElementUsed:=@OnWriterIsElementUsed;
+
+    // create JavaScript for procs, initialization, finalization
+    MyFile.CreateConverter;
+    MyFile.Converter.Options:=MyFile.Converter.Options+[coStoreImplJS];
+    MyFile.Converter.OnIsElementUsed:=@OnPCUConverterIsElementUsed;
+    MyFile.Converter.OnIsTypeInfoUsed:=@OnPCUConverterIsTypeInfoUsed;
+    JS:=MyFile.Converter.ConvertPasElement(MyFile.PasModule,MyFile.PascalResolver);
+    MyFile.Converter.Options:=MyFile.Converter.Options-[coStoreImplJS];
+    {$IFDEF REALLYVERBOSE}
+    writeln('TPas2jsCompilerFile.WritePCU create pcu ... ',PCUFilename);
+    {$ENDIF}
+    Writer.WritePCU(MyFile.PascalResolver,MyFile.Converter,PrecompileInitialFlags,ms,AllowCompressed);
+    {$IFDEF REALLYVERBOSE}
+    writeln('TPas2jsCompilerFile.WritePCU precompiled ',PCUFilename);
+    {$ENDIF}
+
+    MyFile.Log.LogMsg(nWritingFile,[QuoteStr(Compiler.FileCache.FormatPath(MyFile.PCUFilename))],'',0,0,
+               not (coShowLineNumbers in Compiler.Options));
+
+    // check output directory
+    DestDir:=ChompPathDelim(ExtractFilePath(MyFile.PCUFilename));
+    if (DestDir<>'') and not Compiler.FileCache.DirectoryExists(DestDir) then
+    begin
+      {$IFDEF REALLYVERBOSE}
+      writeln('TPas2jsCompilerFile.WritePCU output dir not found "',DestDir,'"');
+      {$ENDIF}
+      MyFile.Log.LogMsg(nOutputDirectoryNotFound,[QuoteStr(Compiler.FileCache.FormatPath(DestDir))]);
+      Compiler.Terminate(ExitCodeFileNotFound);
+    end;
+    if Compiler.FileCache.DirectoryExists(MyFile.PCUFilename) then
+    begin
+      {$IFDEF REALLYVERBOSE}
+      writeln('TPas2jsCompilerFile.WritePCU file is folder "',DestDir,'"');
+      {$ENDIF}
+      MyFile.Log.LogMsg(nFileIsFolder,[QuoteStr(Compiler.FileCache.FormatPath(MyFile.PCUFilename))]);
+      Compiler.Terminate(ExitCodeWriteError);
+    end;
+
+    ms.Position:=0;
+    Compiler.FileCache.SaveToFile(ms,MyFile.PCUFilename);
+    {$IFDEF REALLYVERBOSE}
+    writeln('TPas2jsCompilerFile.WritePCU written ',PCUFilename);
+    {$ENDIF}
+  finally
+    JS.Free;
+    Writer.Free;
+    ms.Free;
+  end;
+end;
+
+procedure TFilerPCUSupport.OnFilerGetSrc(Sender: TObject; aFilename: string;
+  out p: PChar; out Count: integer);
+var
+  SrcFile: TPas2jsCachedFile;
+begin
+  if Sender=nil then
+    RaiseInternalError(20180311135558,aFilename);
+  SrcFile:=MyFile.Compiler.FileCache.LoadFile(aFilename);
+  if SrcFile=nil then
+    RaiseInternalError(20180311135329,aFilename);
+  p:=PChar(SrcFile.Source);
+  Count:=length(SrcFile.Source);
+end;
+
+function TFilerPCUSupport.OnPCUConverterIsElementUsed(Sender: TObject;
+  El: TPasElement): boolean;
+begin
+  if (coKeepNotUsedPrivates in MyFile.Compiler.Options) then
+    Result:=true
+  else
+    Result:=MyFile.UseAnalyzer.IsUsed(El);
+end;
+
+function TFilerPCUSupport.OnPCUConverterIsTypeInfoUsed(Sender: TObject;
+  El: TPasElement): boolean;
+begin
+  if Sender=nil then ;
+  if El=nil then ;
+  // PCU does not need precompiled typeinfo
+  Result:=false;
+end;
+
+{ TPas2jsPCUCompiler }
+
+procedure TPas2jsPCUCompiler.WritePrecompiledFormats;
+
+Var
+  I : Integer;
+
+begin
+  if PrecompileFormats.Count>0 then
+  begin
+    writeHelpLine('   -JU<x> : Create precompiled units in format x.');
+    for i:=0 to PrecompileFormats.Count-1 do
+      with PrecompileFormats[i] do
+        writeHelpLine('     -JU'+Ext+' : '+Description);
+    writeHelpLine('     -JU- : Disable prior -JU<x> option. Do not create precompiled units.');
+  end;
+end;
+
+function TPas2jsPCUCompiler.CreateCompilerFile(const UnitFileName: String): TPas2jsCompilerFile;
+begin
+  Result:=TPas2JSPCUCompilerFile.Create(Self,UnitFileName);
+end;
+
+procedure TPas2jsPCUCompiler.HandleOptionPCUFormat(Value: string);
+
+Var
+  Found : Boolean;
+  I : integer;
+  PF: TPas2JSPrecompileFormat;
+begin
+  Found:=false;
+  for i:=0 to PrecompileFormats.Count-1 do
+  begin
+    PF:=PrecompileFormats[i];
+    if not SameText(Value,PF.Ext) then continue;
+      FPrecompileFormat:=PrecompileFormats[i];
+    Found:=true;
+  end;
+  if not Found then
+    ParamFatal('invalid precompile output format (-JU) "'+Value+'"');
+end;
+
+{ TPas2jsPCUCompilerFile }
+
+function TPas2jsPCUCompilerFile.CreatePCUSupport: TPCUSupport;
+
+Var
+  PF: TPas2JSPrecompileFormat;
+
+begin
+  // Note that if no format was preset, no files will be written
+  PF:=(Compiler as TPas2jsPCUCompiler).FPrecompileFormat;
+  if PF<>Nil then
+    Result:=TFilerPCUSupport.Create(Self,PF)
+  else
+    Result:=Nil;
+end;
+
+
+end.
+