From 99c5c7932700bdc6796b58175c99cf7e2f7b5062 Mon Sep 17 00:00:00 2001 From: michael Date: Sun, 2 Dec 2018 08:08:01 +0000 Subject: [PATCH 01/21] * Move finding unit to compiler instead of Compilerfile git-svn-id: trunk@40446 - --- packages/pastojs/src/pas2jscompiler.pp | 351 +++++++++++++------------ 1 file changed, 189 insertions(+), 162 deletions(-) diff --git a/packages/pastojs/src/pas2jscompiler.pp b/packages/pastojs/src/pas2jscompiler.pp index e703059b15..16ba2e43ef 100644 --- a/packages/pastojs/src/pas2jscompiler.pp +++ b/packages/pastojs/src/pas2jscompiler.pp @@ -281,6 +281,13 @@ type end; + TFindUnitInfo = Record + FileName : String; + UnitName : String; + isPCU : Boolean; + isForeign : Boolean; + end; + { TPas2jsCompilerFile } TPas2jsCompilerFile = class @@ -551,6 +558,7 @@ type function IsDefined(const aName: String): boolean; procedure SetOption(Flag: TP2jsCompilerOption; Enable: boolean); + function GetUnitInfo(const UseUnitName, InFileName: String; PCUSupport: TPCUSupport): TFindUnitInfo; function FindUnitWithFile(PasFilename: string): TPas2jsCompilerFile; procedure LoadPasFile(UnitFilename, UseUnitName: string; out aFile: TPas2jsCompilerFile; isPCU : Boolean); Function FindUnitJSFileName(aFileName : String) : String; @@ -1335,7 +1343,7 @@ begin Compiler.AddReadingModule(Self); PascalResolver.InterfaceOnly:=IsForeign; - if Assigned(PCUSupport) then + if IsUnitReadFromPCU then PCUSupport.ReadUnit else begin @@ -1566,179 +1574,30 @@ end; function TPas2jsCompilerFile.OnResolverFindModule(const UseUnitName, InFilename: String; NameExpr, InFileExpr: TPasExpr): TPasModule; -var - FoundPasFilename, FoundPasUnitName: string; - FoundPasIsForeign: Boolean; - FoundPCUFilename, FoundPCUUnitName: string; - - procedure TryUnitName(const TestUnitName: string); - var - aFile: TPas2jsCompilerFile; - begin - if FoundPasFilename='' then - begin - // search loaded units - aFile:=Compiler.FindLoadedUnit(TestUnitName); - if aFile<>nil then - begin - FoundPasFilename:=aFile.PasFilename; - FoundPasUnitName:=TestUnitName; - end else begin - // search pas in unit path - FoundPasFilename:=Compiler.FileCache.FindUnitFileName(TestUnitName,'',FoundPasIsForeign); - if FoundPasFilename<>'' then - FoundPasUnitName:=TestUnitName; - end; - end; - if Assigned(PCUSupport) and (FoundPCUFilename='') then - begin - FoundPCUFilename:=PCUSupport.FindPCU(TestUnitName); - if FoundPCUFilename<>'' then - FoundPCUUnitName:=TestUnitName; - end; - end; var - aNameSpace, DefNameSpace: String; - i: Integer; aFile: TPas2jsCompilerFile; + UnitInfo : TFindUnitInfo; + begin Result:=nil; + aFile:=Nil; + // duplicate identifier or unit cycle if CompareText(ExtractFilenameOnly(PasFilename),UseUnitname)=0 then - begin - // duplicate identifier or unit cycle Parser.RaiseParserError(nUnitCycle,[UseUnitname]); - end; - - FoundPasFilename:=''; - FoundPasIsForeign:=false; - FoundPasUnitName:=''; - FoundPCUFilename:=''; - FoundPCUUnitName:=''; - if (InFilename='') and (Pos('.',UseUnitname)<1) then - begin - // generic unit -> search with namespaces - // first the default program namespace - DefNameSpace:=Compiler.GetDefaultNamespace; - if DefNameSpace<>'' then - TryUnitName(DefNameSpace+'.'+UseUnitname); - - if (FoundPasFilename='') or (FoundPCUFilename='') then + UnitInfo:=Compiler.GetUnitInfo(UseUnitName,InFileName,PCUSupport); + if UnitInfo.FileName<>'' then begin - // then the cmdline namespaces - for i:=0 to Compiler.FileCache.Namespaces.Count-1 do begin - aNameSpace:=Compiler.FileCache.Namespaces[i]; - if aNameSpace='' then continue; - if SameText(aNameSpace,DefNameSpace) then continue; - TryUnitName(aNameSpace+'.'+UseUnitname); - end; + if UnitInfo.isPCU then + aFile:=LoadUsedUnit(UnitInfo.FileName,UnitInfo.UnitName,'',NameExpr,nil,false,True) + else + aFile:=LoadUsedUnit(UnitInfo.FileName,UnitInfo.UnitName,InFilename,NameExpr,InFileExpr,UnitInfo.IsForeign,False); end; - end; - - if FoundPasFilename='' then - begin - if InFilename='' then - begin - // search unitname in loaded units - aFile:=Compiler.FindLoadedUnit(UseUnitname); - if aFile<>nil then - begin - FoundPasFilename:=aFile.PasFilename; - FoundPasUnitName:=UseUnitName; - end; - end; - if FoundPasFilename='' then - begin - // search Pascal file - FoundPasFilename:=Compiler.FileCache.FindUnitFileName(UseUnitname,InFilename,FoundPasIsForeign); - if FoundPasFilename<>'' then - begin - if InFilename<>'' then - FoundPasUnitName:=ExtractFilenameOnly(InFilename) - else - FoundPasUnitName:=UseUnitName; - end - else if InFilename<>'' then - exit; // an in-filename unit source is missing -> stop - end; - end; - - if Assigned(PCUSupport) and (FoundPCUFilename='') then - begin - FoundPCUFilename:=PCUSupport.FindPCU(UseUnitName); - FoundPCUUnitName:=UseUnitName; - end; - - if (FoundPasFilename='') and (FoundPCUFilename<>'') then - begin - aFile:=LoadUsedUnit(FoundPCUFilename,FoundPCUUnitName,'',NameExpr,nil,false,True); - if aFile<>nil then - Result:=aFile.PasModule; - exit; - end; - - if FoundPasFilename<>'' then - begin - // load unit - aFile:=LoadUsedUnit(FoundPasFilename,FoundPasUnitName,InFilename, - NameExpr,InFileExpr,FoundPasIsForeign,False); - if aFile<>nil then - Result:=aFile.PasModule; - end; + if aFile<>nil then + Result:=aFile.PasModule; // if Result=nil resolver will give a nice error position end; -function TPas2jsCompiler.ResolvedMainJSFile: string; - -Var - OP,UP : String; - -begin - OP:=FileCache.MainOutputPath; - UP:=FileCache.UnitOutputPath; - if MainJSFile='.' then - Result:='' - else begin - Result:=MainJSFile; - if Result<>'' then - begin - // has option -o - if ExtractFilePath(Result)='' then - begin - // -o - if OP<>'' then - Result:=OP+Result - else if UP<>'' then - Result:=UP+Result; - end; - end else begin - // no option -o - Result:=ChangeFileExt(MainSrcFile,'.js'); - if OP<>'' then - begin - // option -FE and no -o => put into MainOutputPath - Result:=OP+ExtractFilename(Result) - end else if UP<>'' then - begin - // option -FU and no -o => put into UnitOutputPath - Result:=UP+ExtractFilename(Result) - end else begin - // no -FU and no -o => put into source directory - end; - end; - end; -end; - -function TPas2jsCompiler.GetResolvedMainJSFile: string; - -begin - if not FIsMainJSFileResolved then - begin - FMainJSFileResolved:=ResolvedMainJSFile; - FIsMainJSFileResolved:=True; - end; - Result:=FMainJSFileResolved; -end; function TPas2jsCompilerFile.LoadUsedUnit(const UseFilename, UseUnitname, @@ -4886,5 +4745,173 @@ begin InsertFilenames.Delete(i); end; + +function TPas2jsCompiler.GetUnitInfo(const UseUnitName,InFileName : String; PCUSupport : TPCUSupport) : TFindUnitInfo; + +var + FoundPasFilename, FoundPasUnitName: string; + FoundPasIsForeign: Boolean; + FoundPCUFilename, FoundPCUUnitName: string; + + procedure TryUnitName(const TestUnitName: string); + var + aFile: TPas2jsCompilerFile; + begin + if FoundPasFilename='' then + begin + // search loaded units + aFile:=FindLoadedUnit(TestUnitName); + if aFile<>nil then + begin + FoundPasFilename:=aFile.PasFilename; + FoundPasUnitName:=TestUnitName; + end else begin + // search pas in unit path + FoundPasFilename:=FileCache.FindUnitFileName(TestUnitName,'',FoundPasIsForeign); + if FoundPasFilename<>'' then + FoundPasUnitName:=TestUnitName; + end; + end; + if Assigned(PCUSupport) and (FoundPCUFilename='') then + begin + FoundPCUFilename:=PCUSupport.FindPCU(TestUnitName); + if FoundPCUFilename<>'' then + FoundPCUUnitName:=TestUnitName; + end; + end; + +var + aFile : TPas2jsCompilerFile; + aNameSpace, DefNameSpace: String; + i: Integer; + +begin + Result:=Default(TFindUnitInfo); + FoundPasFilename:=''; + FoundPasIsForeign:=false; + FoundPasUnitName:=''; + FoundPCUFilename:=''; + FoundPCUUnitName:=''; + if (InFilename='') and (Pos('.',UseUnitname)<1) then + begin + // generic unit -> search with namespaces + // first the default program namespace + DefNameSpace:=GetDefaultNamespace; + if DefNameSpace<>'' then + TryUnitName(DefNameSpace+'.'+UseUnitname); + + if (FoundPasFilename='') or (FoundPCUFilename='') then + begin + // then the cmdline namespaces + for i:=0 to FileCache.Namespaces.Count-1 do begin + aNameSpace:=FileCache.Namespaces[i]; + if aNameSpace='' then continue; + if SameText(aNameSpace,DefNameSpace) then continue; + TryUnitName(aNameSpace+'.'+UseUnitname); + end; + end; + end; + + if FoundPasFilename='' then + begin + if InFilename='' then + begin + // search unitname in loaded units + aFile:=FindLoadedUnit(UseUnitname); + if aFile<>nil then + begin + FoundPasFilename:=aFile.PasFilename; + FoundPasUnitName:=UseUnitName; + end; + end; + if FoundPasFilename='' then + begin + // search Pascal file + FoundPasFilename:=FileCache.FindUnitFileName(UseUnitname,InFilename,FoundPasIsForeign); + if FoundPasFilename<>'' then + begin + if InFilename<>'' then + FoundPasUnitName:=ExtractFilenameOnly(InFilename) + else + FoundPasUnitName:=UseUnitName; + end + else if InFilename<>'' then + exit; // an in-filename unit source is missing -> stop + end; + end; + + if Assigned(PCUSupport) and (FoundPCUFilename='') then + begin + FoundPCUFilename:=PCUSupport.FindPCU(UseUnitName); + FoundPCUUnitName:=UseUnitName; + end; + if (FoundPasFilename='') and (FoundPCUFilename<>'') then + begin + Result.FileName:=FoundPCUFilename; + Result.UnitName:=FoundPCUUnitName; + Result.isPCU:=True; + Result.isForeign:=False; + end; + if (FoundPasFileName<>'') then + begin + Result.FileName:=FoundPasFilename; + Result.UnitName:=FoundPasUnitName; + Result.isPCU:=False; + Result.isForeign:=FoundPasIsForeign; + end; +end; + +function TPas2jsCompiler.ResolvedMainJSFile: string; + +Var + OP,UP : String; + +begin + OP:=FileCache.MainOutputPath; + UP:=FileCache.UnitOutputPath; + if MainJSFile='.' then + Result:='' + else begin + Result:=MainJSFile; + if Result<>'' then + begin + // has option -o + if ExtractFilePath(Result)='' then + begin + // -o + if OP<>'' then + Result:=OP+Result + else if UP<>'' then + Result:=UP+Result; + end; + end else begin + // no option -o + Result:=ChangeFileExt(MainSrcFile,'.js'); + if OP<>'' then + begin + // option -FE and no -o => put into MainOutputPath + Result:=OP+ExtractFilename(Result) + end else if UP<>'' then + begin + // option -FU and no -o => put into UnitOutputPath + Result:=UP+ExtractFilename(Result) + end else begin + // no -FU and no -o => put into source directory + end; + end; + end; +end; + +function TPas2jsCompiler.GetResolvedMainJSFile: string; + +begin + if not FIsMainJSFileResolved then + begin + FMainJSFileResolved:=ResolvedMainJSFile; + FIsMainJSFileResolved:=True; + end; + Result:=FMainJSFileResolved; +end; + end. From e8a8046d3e019f5c7daf3e56f12bd6d18600ee65 Mon Sep 17 00:00:00 2001 From: michael Date: Sun, 2 Dec 2018 08:27:05 +0000 Subject: [PATCH 02/21] * Moved LoadUsedUnit from compilerfile to compiler git-svn-id: trunk@40447 - --- packages/pastojs/src/pas2jscompiler.pp | 354 +++++++++++++------------ 1 file changed, 188 insertions(+), 166 deletions(-) diff --git a/packages/pastojs/src/pas2jscompiler.pp b/packages/pastojs/src/pas2jscompiler.pp index 16ba2e43ef..57feedebd1 100644 --- a/packages/pastojs/src/pas2jscompiler.pp +++ b/packages/pastojs/src/pas2jscompiler.pp @@ -288,6 +288,15 @@ type isForeign : Boolean; end; + TLoadInfo = Record + UseFilename, + UseUnitname, + InFilename: String; + NameExpr, + InFileExpr: TPasExpr; + UseIsForeign: boolean; + IsPCU : Boolean; + end; { TPas2jsCompilerFile } TPas2jsCompilerFile = class @@ -345,7 +354,7 @@ type procedure CreateConverter; function OnResolverFindModule(const UseUnitName, InFilename: String; NameExpr, InFileExpr: TPasExpr): TPasModule; - function LoadUsedUnit(const UseFilename, UseUnitname, InFilename: String; NameExpr, InFileExpr: TPasExpr; UseIsForeign: boolean; IsPCU : Boolean): TPas2jsCompilerFile; +// function LoadUsedUnit(Info : TLoadInfo): TPas2jsCompilerFile; procedure OnResolverCheckSrcName(const Element: TPasElement); procedure OpenFile(aFilename: string);// beware: this changes FileResolver.BaseDirectory procedure ReadUnit; @@ -442,6 +451,7 @@ type function HandleOptionOptimization(C: Char; aValue: String): Boolean; function IndexOfInsertJSFilename(const aFilename: string): integer; procedure InsertCustomJSFiles(aWriter: TPas2JSMapper); + function LoadUsedUnit(Info: TLoadInfo; Context: TPas2jsCompilerFile): TPas2jsCompilerFile; function OnMacroCfgDir(Sender: TObject; var Params: string; Lvl: integer ): boolean; function OnMacroEnv(Sender: TObject; var Params: string; Lvl: integer @@ -1578,7 +1588,7 @@ function TPas2jsCompilerFile.OnResolverFindModule(const UseUnitName, var aFile: TPas2jsCompilerFile; UnitInfo : TFindUnitInfo; - + LoadInfo : TLoadInfo; begin Result:=nil; aFile:=Nil; @@ -1588,10 +1598,23 @@ begin UnitInfo:=Compiler.GetUnitInfo(UseUnitName,InFileName,PCUSupport); if UnitInfo.FileName<>'' then begin + LoadInfo.UseFilename:=UnitInfo.FileName; + LoadInfo.UseUnitname:=UnitInfo.UnitName; + LoadInfo.NameExpr:=NameExpr; + LoadInfo.IsPCU:=UnitInfo.isPCU; if UnitInfo.isPCU then - aFile:=LoadUsedUnit(UnitInfo.FileName,UnitInfo.UnitName,'',NameExpr,nil,false,True) + begin + LoadInfo.InFilename:=''; + LoadInfo.InFileExpr:=Nil; + LoadInfo.UseIsForeign:=False; + end else - aFile:=LoadUsedUnit(UnitInfo.FileName,UnitInfo.UnitName,InFilename,NameExpr,InFileExpr,UnitInfo.IsForeign,False); + begin + LoadInfo.InFilename:=InFileName; + LoadInfo.InFileExpr:=InFileExpr; + LoadInfo.UseIsForeign:=UnitInfo.isForeign; + end; + aFile:=Compiler.LoadUsedUnit(LoadInfo,Self); end; if aFile<>nil then Result:=aFile.PasModule; @@ -1600,168 +1623,6 @@ end; -function TPas2jsCompilerFile.LoadUsedUnit(const UseFilename, UseUnitname, - InFilename: String; NameExpr, InFileExpr: TPasExpr; UseIsForeign: boolean; IsPCU : Boolean - ): TPas2jsCompilerFile; - - function FindCycle(aFile, SearchFor: TPas2jsCompilerFile; - var Cycle: TFPList): boolean; - var - i: Integer; - aParent: TPas2jsCompilerFile; - begin - for i:=0 to aFile.UsedByCount[ubMainSection]-1 do begin - aParent:=aFile.UsedBy[ubMainSection,i]; - if aParent=SearchFor then - begin - // unit cycle found - Cycle:=TFPList.Create; - Cycle.Add(aParent); - Cycle.Add(aFile); - exit(true); - end; - if FindCycle(aParent,SearchFor,Cycle) then - begin - Cycle.Add(aFile); - exit(true); - end; - end; - Result:=false; - end; - -var - aFile: TPas2jsCompilerFile; - - procedure CheckCycle; - var - i: Integer; - Cycle: TFPList; - CyclePath: String; - begin - if PasModule.ImplementationSection=nil then - begin - // main uses section (e.g. interface or program, not implementation) - // -> check for cycles - - aFile.FUsedBy[ubMainSection].Add(Self); - - Cycle:=nil; - try - if FindCycle(aFile,aFile,Cycle) then - begin - CyclePath:=''; - for i:=0 to Cycle.Count-1 do begin - if i>0 then CyclePath+=','; - CyclePath+=TPas2jsCompilerFile(Cycle[i]).GetModuleName; - end; - PascalResolver.RaiseMsg(20180223141537,nUnitCycle,sUnitCycle,[CyclePath],NameExpr); - end; - finally - Cycle.Free; - end; - end else begin - // implementation uses section - aFile.FUsedBy[ubImplSection].Add(Self); - end; - end; - -var - UseJSFilename: String; - OtherFile: TPas2jsCompilerFile; -begin - Result:=nil; - - aFile:=Compiler.FindUnitWithFile(UseFilename); - - if aFile<>nil then - begin - // known unit - if (aFile.PasUnitName<>'') and (CompareText(aFile.PasUnitName,UseUnitname)<>0) then - begin - Log.LogPlain(['Debug: TPas2jsPasTree.FindUnit unitname MISMATCH aFile.PasUnitname="',aFile.PasUnitName,'"', - ' Self=',FileResolver.Cache.FormatPath(PasFilename), - ' Uses=',UseUnitname, - ' IsForeign=',IsForeign]); - RaiseInternalError(20170504161412,'TPas2jsPasTree.FindUnit unit name mismatch'); - end; - CheckCycle; - end else begin - // new unit - - if InFilename<>'' then - begin - aFile:=Compiler.FindLoadedUnit(UseUnitname); - if aFile<>nil then - begin - {$IF defined(VerbosePasResolver) or defined(VerbosePas2JS)} - writeln('TPas2jsCompilerFile.FindUnit in-file unit name duplicate: New=',UseFilename,' Old=',aFile.PasFilename); - {$ENDIF} - PascalResolver.RaiseMsg(20180223141323,nDuplicateFileFound,sDuplicateFileFound, - [UseFilename,aFile.PasFilename],InFileExpr); - end; - end; - - UseJSFilename:=''; - if (not IsForeign) then - UseJSFilename:=Compiler.FindUnitJSFileName(UseFilename); - // Log.LogPlain(['Debug: TPas2jsPasTree.FindUnit Self=',FileResolver.Cache.FormatPath(PasFilename), - // ' Uses=',ActualUnitname,' Found="',FileResolver.Cache.FormatPath(UseFilename),'"', - // ' IsForeign=',IsForeign,' JSFile="',FileResolver.Cache.FormatPath(useJSFilename),'"']); - // load Pascal or PCU file - Compiler.LoadPasFile(UseFilename,UseUnitname,aFile,IsPCU); - - // consistency checks - if aFile.PasUnitName<>UseUnitname then - RaiseInternalError(20170922143329,'aFile.PasUnitName='+aFile.PasUnitName+' UseUnitname='+UseUnitname); - if isPCU then - begin - if CompareFilenames(aFile.PCUFilename,UseFilename)<>0 then - RaiseInternalError(20180312122331,'aFile.PCUFilename='+aFile.PCUFilename+' UseFilename='+UseFilename); - end else - begin - if CompareFilenames(aFile.PasFilename,UseFilename)<>0 then - RaiseInternalError(20170922143330,'aFile.PasFilename='+aFile.PasFilename+' UseFilename='+UseFilename); - end; - - if aFile=Self then - begin - // unit uses itself -> cycle - Parser.RaiseParserError(nUnitCycle,[UseUnitname]); - end; - - // add file to trees - Compiler.AddUsedUnit(aFile); - // consistency checks - OtherFile:=Compiler.FindLoadedUnit(UseUnitname); - if aFile<>OtherFile then - begin - if OtherFile=nil then - RaiseInternalError(20170922143405,'UseUnitname='+UseUnitname) - else - RaiseInternalError(20170922143511,'UseUnitname='+UseUnitname+' Found='+OtherFile.PasUnitName); - end; - OtherFile:=Compiler.FindUnitWithFile(UseFilename); - if aFile<>OtherFile then - begin - if OtherFile=nil then - RaiseInternalError(20180224094625,'UsePasFilename='+UseFilename) - else - RaiseInternalError(20180224094627,'UsePasFilename='+UseFilename+' Found='+OtherFile.PasFilename); - end; - - CheckCycle; - - aFile.JSFilename:=UseJSFilename; - aFile.IsForeign:=UseIsForeign; - - // read - aFile.ReadUnit; - // beware: the parser may not yet have finished - end; - - Result:=aFile; -end; - { TPas2jsCompiler } procedure TPas2jsCompiler.SetFileCache(AValue: TPas2jsFilesCache); @@ -4861,6 +4722,167 @@ begin end; end; + +function TPas2JSCompiler.LoadUsedUnit(Info : TLoadInfo; Context : TPas2jsCompilerFile): TPas2jsCompilerFile; + + function FindCycle(aFile, SearchFor: TPas2jsCompilerFile; + var Cycle: TFPList): boolean; + var + i: Integer; + aParent: TPas2jsCompilerFile; + begin + for i:=0 to aFile.UsedByCount[ubMainSection]-1 do begin + aParent:=aFile.UsedBy[ubMainSection,i]; + if aParent=SearchFor then + begin + // unit cycle found + Cycle:=TFPList.Create; + Cycle.Add(aParent); + Cycle.Add(aFile); + exit(true); + end; + if FindCycle(aParent,SearchFor,Cycle) then + begin + Cycle.Add(aFile); + exit(true); + end; + end; + Result:=false; + end; + +var + aFile: TPas2jsCompilerFile; + + procedure CheckCycle; + var + i: Integer; + Cycle: TFPList; + CyclePath: String; + begin + if Context.PasModule.ImplementationSection=nil then + begin + // main uses section (e.g. interface or program, not implementation) + // -> check for cycles + + aFile.FUsedBy[ubMainSection].Add(Context); + + Cycle:=nil; + try + if FindCycle(aFile,aFile,Cycle) then + begin + CyclePath:=''; + for i:=0 to Cycle.Count-1 do begin + if i>0 then CyclePath+=','; + CyclePath+=TPas2jsCompilerFile(Cycle[i]).GetModuleName; + end; + Context.PascalResolver.RaiseMsg(20180223141537,nUnitCycle,sUnitCycle,[CyclePath],Info.NameExpr); + end; + finally + Cycle.Free; + end; + end else begin + // implementation uses section + aFile.FUsedBy[ubImplSection].Add(Context); + end; + end; + +var + UseJSFilename: String; + OtherFile: TPas2jsCompilerFile; +begin + Result:=nil; + + aFile:=FindUnitWithFile(Info.UseFilename); + + if aFile<>nil then + begin + // known unit + if (aFile.PasUnitName<>'') and (CompareText(aFile.PasUnitName,Info.UseUnitname)<>0) then + begin + Log.LogPlain(['Debug: TPas2jsPasTree.FindUnit unitname MISMATCH aFile.PasUnitname="',aFile.PasUnitName,'"', + ' Self=',Context.FileResolver.Cache.FormatPath(Context.PasFilename), + ' Uses=',Info.UseUnitname, + ' IsForeign=',Context.IsForeign]); + RaiseInternalError(20170504161412,'TPas2jsPasTree.FindUnit unit name mismatch'); + end; + CheckCycle; + end else begin + // new unit + + if Info.InFilename<>'' then + begin + aFile:=FindLoadedUnit(Info.UseUnitname); + if aFile<>nil then + begin + {$IF defined(VerbosePasResolver) or defined(VerbosePas2JS)} + writeln('TPas2jsCompilerFile.FindUnit in-file unit name duplicate: New=',Info.UseFilename,' Old=',aFile.PasFilename); + {$ENDIF} + Context.PascalResolver.RaiseMsg(20180223141323,nDuplicateFileFound,sDuplicateFileFound, + [Info.UseFilename,aFile.PasFilename],Info.InFileExpr); + end; + end; + + UseJSFilename:=''; + if (not Context.IsForeign) then + UseJSFilename:=FindUnitJSFileName(Info.UseFilename); + // Log.LogPlain(['Debug: TPas2jsPasTree.FindUnit Self=',FileResolver.Cache.FormatPath(PasFilename), + // ' Uses=',ActualUnitname,' Found="',FileResolver.Cache.FormatPath(UseFilename),'"', + // ' IsForeign=',IsForeign,' JSFile="',FileResolver.Cache.FormatPath(useJSFilename),'"']); + // load Pascal or PCU file + LoadPasFile(Info.UseFilename,Info.UseUnitname,aFile,Info.IsPCU); + + // consistency checks + if aFile.PasUnitName<>Info.UseUnitname then + RaiseInternalError(20170922143329,'aFile.PasUnitName='+aFile.PasUnitName+' UseUnitname='+Info.UseUnitname); + if Info.isPCU then + begin + if CompareFilenames(aFile.PCUFilename,Info.UseFilename)<>0 then + RaiseInternalError(20180312122331,'aFile.PCUFilename='+aFile.PCUFilename+' UseFilename='+Info.UseFilename); + end else + begin + if CompareFilenames(aFile.PasFilename,Info.UseFilename)<>0 then + RaiseInternalError(20170922143330,'aFile.PasFilename='+aFile.PasFilename+' UseFilename='+Info.UseFilename); + end; + + if aFile=Context then + begin + // unit uses itself -> cycle + Context.Parser.RaiseParserError(nUnitCycle,[Info.UseUnitname]); + end; + + // add file to trees + AddUsedUnit(aFile); + // consistency checks + OtherFile:=FindLoadedUnit(Info.UseUnitname); + if aFile<>OtherFile then + begin + if OtherFile=nil then + RaiseInternalError(20170922143405,'UseUnitname='+Info.UseUnitname) + else + RaiseInternalError(20170922143511,'UseUnitname='+Info.UseUnitname+' Found='+OtherFile.PasUnitName); + end; + OtherFile:=FindUnitWithFile(Info.UseFilename); + if aFile<>OtherFile then + begin + if OtherFile=nil then + RaiseInternalError(20180224094625,'UsePasFilename='+Info.UseFilename) + else + RaiseInternalError(20180224094627,'UsePasFilename='+Info.UseFilename+' Found='+OtherFile.PasFilename); + end; + + CheckCycle; + + aFile.JSFilename:=UseJSFilename; + aFile.IsForeign:=Info.UseIsForeign; + + // read + aFile.ReadUnit; + // beware: the parser may not yet have finished + end; + + Result:=aFile; +end; + function TPas2jsCompiler.ResolvedMainJSFile: string; Var From 31ae109a317d480dec469a000603d82f58d813b7 Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 2 Dec 2018 08:49:03 +0000 Subject: [PATCH 03/21] * properly initialize phdr and phnum git-svn-id: trunk@40448 - --- rtl/linux/system.pp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/rtl/linux/system.pp b/rtl/linux/system.pp index 0d7ed2b152..74b4592ace 100644 --- a/rtl/linux/system.pp +++ b/rtl/linux/system.pp @@ -525,6 +525,8 @@ procedure InitTLS; [public,alias:'FPC_INITTLS']; while assigned(auxp^) do inc(auxp); inc(auxp); + phdr:=nil; + phnum:=0; { now we are at the auxillary vector } while assigned(auxp^) do begin From 90557f2e6203427f135eecf9f56ae8eaab5c1ced Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 2 Dec 2018 14:49:24 +0000 Subject: [PATCH 04/21] * properly calcualte aligncount as proposed by Jeppe, should resolve #33323 git-svn-id: trunk@40449 - --- rtl/inc/generic.inc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rtl/inc/generic.inc b/rtl/inc/generic.inc index 52240a2120..686901e4ea 100644 --- a/rtl/inc/generic.inc +++ b/rtl/inc/generic.inc @@ -76,7 +76,7 @@ begin then begin { Align on native pointer size } - aligncount:=(PtrUInt(pdest) and (sizeof(PtrUInt)-1)); + aligncount:=(sizeof(PtrUInt)-PtrInt(pdest)) and (sizeof(PtrUInt)-1); dec(count,aligncount); pend:=psrc+aligncount; while psrc Date: Sun, 2 Dec 2018 18:41:38 +0000 Subject: [PATCH 05/21] * Refactored so compiler itself is filesystem agnostic git-svn-id: trunk@40450 - --- .gitattributes | 5 + packages/pastojs/fpmake.pp | 14 +- packages/pastojs/src/pas2jscompiler.pp | 838 +++++++++------------- packages/pastojs/src/pas2jscompilercfg.pp | 95 +++ packages/pastojs/src/pas2jscompilerpp.pp | 262 +++++++ packages/pastojs/src/pas2jsfilecache.pp | 414 ++++------- packages/pastojs/src/pas2jsfileutils.pp | 88 --- packages/pastojs/src/pas2jsfs.pp | 426 +++++++++++ packages/pastojs/src/pas2jsfscompiler.pp | 164 +++++ packages/pastojs/src/pas2jslibcompiler.pp | 10 +- packages/pastojs/src/pas2jspcucompiler.pp | 93 ++- packages/pastojs/src/pas2jsutils.pp | 430 +++++++++++ 12 files changed, 1962 insertions(+), 877 deletions(-) create mode 100644 packages/pastojs/src/pas2jscompilercfg.pp create mode 100644 packages/pastojs/src/pas2jscompilerpp.pp create mode 100644 packages/pastojs/src/pas2jsfs.pp create mode 100644 packages/pastojs/src/pas2jsfscompiler.pp create mode 100644 packages/pastojs/src/pas2jsutils.pp diff --git a/.gitattributes b/.gitattributes index ce66308b16..475ae06738 100644 --- a/.gitattributes +++ b/.gitattributes @@ -6993,16 +6993,21 @@ packages/pastojs/src/fppas2js.pp svneol=native#text/plain packages/pastojs/src/fppjssrcmap.pp svneol=native#text/plain packages/pastojs/src/pas2js_defines.inc svneol=native#text/plain packages/pastojs/src/pas2jscompiler.pp svneol=native#text/plain +packages/pastojs/src/pas2jscompilercfg.pp svneol=native#text/plain +packages/pastojs/src/pas2jscompilerpp.pp svneol=native#text/plain packages/pastojs/src/pas2jsfilecache.pp svneol=native#text/plain packages/pastojs/src/pas2jsfiler.pp svneol=native#text/plain packages/pastojs/src/pas2jsfileutils.pp svneol=native#text/plain packages/pastojs/src/pas2jsfileutilsnodejs.inc svneol=native#text/plain packages/pastojs/src/pas2jsfileutilsunix.inc svneol=native#text/plain packages/pastojs/src/pas2jsfileutilswin.inc svneol=native#text/plain +packages/pastojs/src/pas2jsfs.pp svneol=native#text/plain +packages/pastojs/src/pas2jsfscompiler.pp 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/src/pas2jsutils.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/tests/tcmodules.pas svneol=native#text/plain diff --git a/packages/pastojs/fpmake.pp b/packages/pastojs/fpmake.pp index a713b569a2..631c9fba48 100644 --- a/packages/pastojs/fpmake.pp +++ b/packages/pastojs/fpmake.pp @@ -44,7 +44,11 @@ begin T:=P.Targets.AddUnit('fppas2js.pp'); T.ResourceStrings:=true; T:=P.Targets.AddUnit('fppjssrcmap.pp'); + T:=P.Targets.AddUnit('pas2jsfs.pp'); + T:=P.Targets.AddUnit('pas2jsutils.pp'); T:=P.Targets.AddUnit('pas2jsfilecache.pp'); + T.Dependencies.AddUnit('pas2jsfs'); + T.Dependencies.AddUnit('pas2jsutils'); T:=P.Targets.AddUnit('pas2jsfileutils.pp'); T.Dependencies.AddInclude('pas2js_defines.inc'); T.Dependencies.AddInclude('pas2jsfileutilsunix.inc',AllUnixOSes); @@ -52,10 +56,18 @@ begin T:=P.Targets.AddUnit('pas2jslogger.pp'); T:=P.Targets.AddUnit('pas2jspparser.pp'); T:=P.Targets.AddUnit('pas2jscompiler.pp'); + T:=P.Targets.AddUnit('pas2jsfscompiler.pp'); + T.Dependencies.AddUnit('pas2jscompiler'); T:=P.Targets.AddUnit('pas2jspcucompiler.pp'); + T.Dependencies.AddUnit('pas2jsfscompiler'); + T:=P.Targets.AddUnit('pas2jscompilercfg.pp'); + T.Dependencies.AddUnit('pas2jscompiler'); + T:=P.Targets.AddUnit('pas2jscompilerpp.pp'); T.Dependencies.AddUnit('pas2jscompiler'); T:=P.Targets.AddUnit('pas2jslibcompiler.pp'); - T.Dependencies.AddUnit('pas2jscompiler'); + T.Dependencies.AddUnit('pas2jspcucompiler'); + T.Dependencies.AddUnit('pas2jscompilercfg'); + T.Dependencies.AddUnit('pas2jscompilerpp'); {$ifndef ALLPACKAGES} Run; end; diff --git a/packages/pastojs/src/pas2jscompiler.pp b/packages/pastojs/src/pas2jscompiler.pp index 57feedebd1..09f925c6ad 100644 --- a/packages/pastojs/src/pas2jscompiler.pp +++ b/packages/pastojs/src/pas2jscompiler.pp @@ -4,6 +4,13 @@ Abstract: TPas2jsCompiler is the wheel boss of the pas2js compiler. It can be used in a command line program or compiled into an application. + TPas2jsCompiler does not have understanding of the file system. + DO NOT ADD filesystem related calls to this unit. + The file system is abstracted out in TPas2JSFS (unit pas2jsfs) + Add high-level calls to TPas2JSFS instead or create virtual methods that can be overridden. + + FileSystem specific things should go in Pas2JSFileCache and Pas2JSFSCompiler. + Compiler-ToDos: Warn if -Ju and -Fu intersect -Fa[,y] (for a program) load units and [y] before uses is parsed @@ -24,14 +31,15 @@ interface uses {$IFDEF Pas2js} - JS, NodeJSFS, + JS, {$ELSE} - RtlConsts, process, + RtlConsts, {$ENDIF} + // !! No filesystem units here. Classes, SysUtils, contnrs, jstree, jswriter, JSSrcMap, PScanner, PParser, PasTree, PasResolver, PasUseAnalyzer, PasResolveEval, - FPPas2Js, FPPJsSrcMap, Pas2jsFileUtils, Pas2jsLogger, Pas2jsFileCache, Pas2jsPParser; + FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser; const VersionMajor = 1; @@ -296,14 +304,24 @@ type InFileExpr: TPasExpr; UseIsForeign: boolean; IsPCU : Boolean; + end; + + + TPas2JSCompilerSupport = Class + private + FCompiler: TPas2JSCompiler; + Public + Constructor Create(aCompiler : TPas2JSCompiler); virtual; + Property Compiler : TPas2JSCompiler read FCompiler; + end; + { TPas2jsCompilerFile } - TPas2jsCompilerFile = class + TPas2jsCompilerFile = class(TPas2JSCompilerSupport) private - FCompiler: TPas2jsCompiler; FConverter: TPasToJSConverter; - FFileResolver: TPas2jsFileResolver; + FFileResolver: TPas2jsFSResolver; FIsForeign: boolean; FIsMainFile: boolean; FJSFilename: string; @@ -311,7 +329,7 @@ type FLog: TPas2jsLogger; FNeedBuild: Boolean; FParser: TPas2jsPasParser; - FPasFilename: String; + FPasFileName: String; FPasModule: TPasModule; FPasResolver: TPas2jsCompilerResolver; FPasUnitName: string; @@ -343,14 +361,14 @@ type procedure RaiseInternalError(id: TMaxPrecInt; Msg: string); procedure ReaderFinished; public - constructor Create(aCompiler: TPas2jsCompiler; const aPasFilename: string); + constructor Create(aCompiler: TPas2jsCompiler; const aPasFilename: string); reintroduce; destructor Destroy; override; Function CreatePCUSupport : TPCUSupport; virtual; function GetInitialModeSwitches: TModeSwitches; function IsUnitReadFromPCU: Boolean; function GetInitialBoolSwitches: TBoolSwitches; function GetInitialConverterOptions: TPasToJsConverterOptions; - procedure CreateScannerAndParser(aFileResolver: TPas2jsFileResolver); + procedure CreateScannerAndParser(aFileResolver: TPas2jsFSResolver); procedure CreateConverter; function OnResolverFindModule(const UseUnitName, InFilename: String; NameExpr, InFileExpr: TPasExpr): TPasModule; @@ -369,9 +387,10 @@ type function GetModuleName: string; class function GetFile(aModule: TPasModule): TPas2jsCompilerFile; public - property Compiler: TPas2jsCompiler read FCompiler; + Property PasFileName : String Read FPasFileName; + property PasUnitName: string read FPasUnitName write FPasUnitName;// unit name in program property Converter: TPasToJSConverter read FConverter; - property FileResolver: TPas2jsFileResolver read FFileResolver; + property FileResolver: TPas2jsFSResolver read FFileResolver; property IsForeign: boolean read FIsForeign write FIsForeign;// true = do not build property IsMainFile: boolean read FIsMainFile write FIsMainFile; property JSFilename: string read FJSFilename write FJSFilename; @@ -380,9 +399,7 @@ type property NeedBuild: Boolean read FNeedBuild write FNeedBuild; property Parser: TPas2jsPasParser read FParser; property PascalResolver: TPas2jsCompilerResolver read FPasResolver; - property PasFilename: String read FPasFilename; // can be the PCUFilename property PasModule: TPasModule read FPasModule; - property PasUnitName: string read FPasUnitName write FPasUnitName;// unit name in program property PCUFilename: string read FPCUFilename; Property PCUSupport : TPCUSupport Read FPCUSupport; property Scanner: TPas2jsPasScanner read FScanner; @@ -392,6 +409,43 @@ type property UsedBy[Section: TUsedBySection; Index: integer]: TPas2jsCompilerFile read GetUsedBy; end; + { TPas2JSCompilerSupport } + + TPas2JSPostProcessorSupport = Class(TPas2JSCompilerSupport) + Public + Procedure WriteUsedTools; virtual; abstract; + Procedure Clear; virtual; abstract; + Procedure AddPostProcessor(Const Cmd : String); virtual; abstract; + Procedure CallPostProcessors(Const JSFileName : String; aWriter : TPas2JSMapper); virtual; abstract; + end; + + + { TPas2JSConfigSupport } + + TPas2JSConfigSupport = Class(TPas2JSCompilerSupport) + private + FConditionEval: TCondDirectiveEvaluator; + FCurrentCfgFilename: string; + FCurrentCfgLineNumber: integer; + Protected + procedure CfgSyntaxError(const Msg: string); + function ConditionEvalVariable(Sender: TCondDirectiveEvaluator; aName: String; out Value: string): boolean; + procedure ConditionEvalLog(Sender: TCondDirectiveEvaluator; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}); + property ConditionEvaluator: TCondDirectiveEvaluator read FConditionEval; + property CurrentCfgFilename: string read FCurrentCfgFilename; + property CurrentCfgLineNumber: integer read FCurrentCfgLineNumber; + Protected + // These must be overridden in descendents + function FindDefaultConfig: String; virtual; abstract; + function GetReader(aFileName: string): TSourceLineReader; virtual; abstract; + Public + Constructor Create(aCompiler : TPas2jsCompiler); override; + Destructor Destroy; override; + procedure LoadDefaultConfig; + Procedure LoadConfig(Const aFileName : String);virtual; + Property Compiler : TPas2jsCompiler Read FCompiler; + end; + { TPas2JSWPOptimizer } TPas2JSWPOptimizer = class(TPasAnalyzer) @@ -404,12 +458,9 @@ type FMainJSFileResolved : String; FIsMainJSFileResolved : Boolean; FCompilerExe: string; - FConditionEval: TCondDirectiveEvaluator; - FCurrentCfgFilename: string; - FCurrentCfgLineNumber: integer; FDefines: TStrings; // Objects can be TMacroDef - FFileCache: TPas2jsFilesCache; - FFileCacheAutoFree: boolean; + FFS: TPas2jsFS; + FOwnsFS : boolean; FFiles: TPasAnalyzerKeySet; // set of TPas2jsCompilerFile, key is PasFilename FReadingModules: TFPList; // list of TPas2jsCompilerFile ordered by uses sections FHasShownEncoding: boolean; @@ -419,7 +470,6 @@ type FMode: TP2jsMode; FOptions: TP2jsCompilerOptions; FParamMacros: TPas2jsMacroEngine; - FPostProcs: TObjectList; FSrcMapSourceRoot: string; FTargetPlatform: TPasToJsPlatform; FTargetProcessor: TPasToJsProcessor; @@ -429,11 +479,15 @@ type FRTLVersionCheck: TP2jsRTLVersionCheck; FPrecompileGUID: TGUID; FInsertFilenames: TStringList; + FNamespaces: TStringList; + FNamespacesFromCmdLine: integer; + FAllJSIntoMainJS: Boolean; + FConfigSupport: TPas2JSConfigSupport; + FMainJSFile: String; + FMainSrcFile: String; + FSrcMapBaseDir: string; procedure AddInsertJSFilename(const aFilename: string); - procedure ConditionEvalLog(Sender: TCondDirectiveEvaluator; - Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}); - function ConditionEvalVariable(Sender: TCondDirectiveEvaluator; - aName: String; out Value: string): boolean; + Procedure AddNamespaces(const Paths: string; FromCmdLine: boolean); function GetDefaultNamespace: String; function GetFileCount: integer; function GetResolvedMainJSFile: string; @@ -452,14 +506,11 @@ type function IndexOfInsertJSFilename(const aFilename: string): integer; procedure InsertCustomJSFiles(aWriter: TPas2JSMapper); function LoadUsedUnit(Info: TLoadInfo; Context: TPas2jsCompilerFile): TPas2jsCompilerFile; - function OnMacroCfgDir(Sender: TObject; var Params: string; Lvl: integer - ): boolean; - function OnMacroEnv(Sender: TObject; var Params: string; Lvl: integer - ): boolean; + function OnMacroCfgDir(Sender: TObject; var Params: string; Lvl: integer): boolean; procedure RemoveInsertJSFilename(const aFilename: string); function ResolvedMainJSFile: string; procedure SetCompilerExe(AValue: string); - procedure SetFileCache(AValue: TPas2jsFilesCache); + procedure SetFS(AValue: TPas2jsFS); procedure SetMode(AValue: TP2jsMode); procedure SetOptions(AValue: TP2jsCompilerOptions); procedure SetShowDebug(AValue: boolean); @@ -481,16 +532,10 @@ type procedure AddDefinesForTargetProcessor; procedure AddReadingModule(aFile: TPas2jsCompilerFile); procedure RemoveReadingModule(aFile: TPas2jsCompilerFile); - function CreateSetOfCompilerFiles_Filename: TPasAnalyzerKeySet; private - FAllJSIntoMainJS: Boolean; - FMainJSFile: String; - FMainSrcFile: String; - FSrcMapBaseDir: string; + FPostProcessorSupport: TPas2JSPostProcessorSupport; // params, cfg files - procedure CfgSyntaxError(const Msg: string); procedure LoadConfig(CfgFilename: string); - procedure LoadDefaultConfig; procedure ReadParam(Param: string; Quick, FromCmdLine: boolean); procedure ReadSingleLetterOptions(const Param: string; p: integer; const Allowed: string; out Enabled, Disabled: string); @@ -500,10 +545,11 @@ type procedure RegisterMessages; procedure SetAllJSIntoMainJS(AValue: Boolean); protected + function CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet; virtual; abstract; + function CreateFS : TPas2JSFS; virtual; abstract; Function FormatPath(Const aPath : String) : String; Function FullFormatPath(Const aPath : String) : String; Procedure WritePrecompiledFormats;virtual; - procedure ParamFatal(Msg: string); procedure WriteHelpLine(S: String); // Override these for PCU format function CreateCompilerFile(const UnitFileName: String): TPas2jsCompilerFile; virtual; @@ -514,8 +560,6 @@ type procedure HandleOptionConfigFile(aPos: Integer; const aFileName: string); virtual; procedure HandleOptionInfo(aValue: string); // DoWriteJSFile: return false to use the default write function. - procedure CallPostProcessors(const JSFilename: String; aWriter: TPas2JSMapper); virtual; - function CallPostProcessor(const JSFilename: String; Cmd: TStringList; JS: TJSWriterString): TJSWriterString; virtual; function DoWriteJSFile(const DestFilename: String; aWriter: TPas2JSMapper): Boolean; virtual; procedure Compile(StartTime: TDateTime); procedure ProcessQueue; @@ -529,7 +573,7 @@ type procedure WriteJSFiles(aFile: TPas2jsCompilerFile; var CombinedFileWriter: TPas2JSMapper; Checked: TPasAnalyzerKeySet { set of TPas2jsCompilerFile, key is PasFilename }); - procedure InitParamMacros; + procedure InitParamMacros;virtual; procedure ClearDefines; procedure RaiseInternalError(id: TMaxPrecInt; Msg: string); {$IFDEF Pas2js} @@ -537,11 +581,12 @@ type {$ENDIF} function GetExitCode: Longint; virtual; procedure SetExitCode(Value: Longint); virtual; + Procedure SetWorkingDir(const aDir : String); virtual; public constructor Create; virtual; destructor Destroy; override; - procedure Reset; virtual; + procedure ParamFatal(Msg: string); procedure Run( aCompilerExe: string; // needed for default config and help aWorkingDir: string; @@ -560,7 +605,6 @@ type procedure WriteFoldersAndSearchPaths; procedure WriteInfo; function GetShownMsgTypes: TMessageTypes; - function CmdListAsStr(CmdList: TStrings): string; procedure AddDefine(const aName: String); procedure AddDefine(const aName, Value: String); @@ -578,13 +622,10 @@ type function ExpandFileName(const Filename: string): string; public property CompilerExe: string read FCompilerExe write SetCompilerExe; - property ConditionEvaluator: TCondDirectiveEvaluator read FConditionEval; - property CurrentCfgFilename: string read FCurrentCfgFilename; - property CurrentCfgLineNumber: integer read FCurrentCfgLineNumber; property DefaultNamespace: String read GetDefaultNamespace; property Defines: TStrings read FDefines; - property FileCache: TPas2jsFilesCache read FFileCache write SetFileCache; - property FileCacheAutoFree: boolean read FFileCacheAutoFree write FFileCacheAutoFree; + property FS: TPas2jsFS read FFS write SetFS; + property OwnsFS : boolean read FOwnsFS write FOwnsFS; property FileCount: integer read GetFileCount; property InterfaceType: TPasClassInterfaceType read FInterfaceType write FInterfaceType; property Log: TPas2jsLogger read FLog; @@ -593,7 +634,6 @@ type property Options: TP2jsCompilerOptions read FOptions write SetOptions; property ParamMacros: TPas2jsMacroEngine read FParamMacros; property PrecompileGUID: TGUID read FPrecompileGUID write FPrecompileGUID; - property PostProcs: TObjectList read FPostProcs; // list of TStrings property RTLVersionCheck: TP2jsRTLVersionCheck read FRTLVersionCheck write FRTLVersionCheck; property SrcMapEnable: boolean read GetSrcMapEnable write SetSrcMapEnable; property SrcMapSourceRoot: string read FSrcMapSourceRoot write FSrcMapSourceRoot; @@ -616,85 +656,26 @@ type Property MainJSFile : String Read FMainJSFile Write FMainJSFile; Property MainSrcFile : String Read FMainSrcFile Write FMainSrcFile; property SrcMapBaseDir: string read FSrcMapBaseDir write SetSrcMapBaseDir; // includes trailing pathdelim + property Namespaces: TStringList read FNamespaces; + property NamespacesFromCmdLine: integer read FNamespacesFromCmdLine; + // Will be freed by compiler. + Property ConfigSupport : TPas2JSConfigSupport Read FConfigSupport Write FConfigSupport; + Property PostProcessorSupport : TPas2JSPostProcessorSupport Read FPostProcessorSupport Write FPostProcessorSupport; end; -{$IFDEF Pas2js} -function Pas2jsCompilerFile_FilenameToKeyName(Item: Pointer): String; -function PtrUnitnameToKeyName(Item: Pointer): String; -function Pas2jsCompilerFile_UnitnameToKeyName(Item: Pointer): String; -{$ELSE} -function CompareCompilerFilesPasFile(Item1, Item2: Pointer): integer; -function CompareFileAndCompilerFilePasFile(Filename, Item: Pointer): integer; -function CompareCompilerFilesPasUnitname(Item1, Item2: Pointer): integer; -function CompareUnitnameAndCompilerFile(TheUnitname, Item: Pointer): integer; -{$ENDIF} - function GetCompiledDate: string; function GetCompiledVersion: string; function GetCompiledTargetOS: string; function GetCompiledTargetCPU: string; implementation +// !! No filesystem units here. -{$IFDEF Pas2js} -function Pas2jsCompilerFile_FilenameToKeyName(Item: Pointer): String; -var - aFile: TPas2jsCompilerFile absolute Item; -begin - Result:=FilenameToKey(aFile.PasFilename); -end; +uses pas2jsutils; -function PtrUnitnameToKeyName(Item: Pointer): String; -var - aUnitName: string absolute Item; -begin - Result:=LowerCase(aUnitName); -end; - -function Pas2jsCompilerFile_UnitnameToKeyName(Item: Pointer): String; -var - aFile: TPas2jsCompilerFile absolute Item; -begin - Result:=LowerCase(aFile.PasUnitName); -end; -{$ELSE} -function CompareCompilerFilesPasFile(Item1, Item2: Pointer): integer; -var - File1: TPas2jsCompilerFile absolute Item1; - File2: TPas2jsCompilerFile absolute Item2; -begin - Result:=CompareFilenames(File1.PasFilename,File2.PasFilename); -end; - -function CompareFileAndCompilerFilePasFile(Filename, Item: Pointer): integer; -var - aFile: TPas2jsCompilerFile absolute Item; - aFilename: String; -begin - aFilename:=AnsiString(Filename); - Result:=CompareFilenames(aFilename,aFile.PasFilename); -end; - -function CompareCompilerFilesPasUnitname(Item1, Item2: Pointer): integer; -var - File1: TPas2jsCompilerFile absolute Item1; - File2: TPas2jsCompilerFile absolute Item2; -begin - Result:=CompareText(File1.PasUnitName,File2.PasUnitName); -end; - -function CompareUnitnameAndCompilerFile(TheUnitname, Item: Pointer): integer; -var - aFile: TPas2jsCompilerFile absolute Item; - anUnitname: String; -begin - anUnitname:=AnsiString(TheUnitname); - Result:=CompareText(anUnitname,aFile.PasUnitName); -end; -{$ENDIF} function GetCompiledDate: string; begin @@ -716,6 +697,31 @@ begin Result:=lowerCase({$I %FPCTARGETCPU%}); end; +{ TPas2JSCompilerSupport } + + +constructor TPas2JSCompilerSupport.Create(aCompiler: TPas2JSCompiler); +begin + FCompiler:=aCompiler; +end; + +{ TPas2JSConfigSupport } + +constructor TPas2JSConfigSupport.Create(aCompiler: TPas2jsCompiler); +begin + Inherited Create(aCompiler); + FConditionEval:=TCondDirectiveEvaluator.Create; + FConditionEval.OnLog:=@ConditionEvalLog; + FConditionEval.OnEvalVariable:=@ConditionEvalVariable; +end; + +destructor TPas2JSConfigSupport.Destroy; +begin + FreeAndNil(FConditionEval); + inherited Destroy; +end; + + { TPCUSupport } @@ -892,8 +898,8 @@ constructor TPas2jsCompilerFile.Create(aCompiler: TPas2jsCompiler; const aPasFil var ub: TUsedBySection; begin - FCompiler:=aCompiler; - FPasFilename:=aPasFilename; + Inherited create(aCompiler); + FPasFileName:=aPasFilename; FLog:=Compiler.Log; FPasResolver:=TPas2jsCompilerResolver.Create; FPasResolver.Owner:=Self; @@ -902,7 +908,7 @@ begin FPasResolver.OnLog:=@OnPasResolverLog; FPasResolver.Log:=Log; FPasResolver.AddObjFPCBuiltInIdentifiers(btAllJSBaseTypes,bfAllJSBaseProcs); - FIsMainFile:=CompareFilenames(Compiler.MainSrcFile,PasFilename)=0; + FIsMainFile:=Compiler.FS.SameFileName(Compiler.MainSrcFile,PasFilename); for ub in TUsedBySection do FUsedBy[ub]:=TFPList.Create; FUseAnalyzer:=TPasAnalyzer.Create; @@ -993,7 +999,7 @@ begin end; end; -procedure TPas2jsCompilerFile.CreateScannerAndParser(aFileResolver: TPas2jsFileResolver); +procedure TPas2jsCompilerFile.CreateScannerAndParser(aFileResolver: TPas2jsFSResolver); var aUnitName: String; i: Integer; @@ -1238,7 +1244,7 @@ begin Log.Log(mtFatal,E.Message); Compiler.Terminate(ExitCodeFileNotFound); end - else if E is EPas2jsFileCache then + else if E is EPas2jsFS then begin Log.Log(mtFatal,E.Message); Compiler.Terminate(ExitCodeFileNotFound); @@ -1625,11 +1631,11 @@ end; { TPas2jsCompiler } -procedure TPas2jsCompiler.SetFileCache(AValue: TPas2jsFilesCache); +procedure TPas2jsCompiler.SetFS(AValue: TPas2jsFS); begin - if FFileCache=AValue then Exit; - FFileCacheAutoFree:=false; - FFileCache:=AValue; + if FFS=AValue then Exit; + FOwnsFS:=false; + FFS:=AValue; end; function TPas2jsCompiler.GetFileCount: integer; @@ -1649,13 +1655,13 @@ begin Result:=FMainFile.PascalResolver.DefaultNameSpace; end; -procedure TPas2jsCompiler.ConditionEvalLog(Sender: TCondDirectiveEvaluator; +procedure TPas2JSConfigSupport.ConditionEvalLog(Sender: TCondDirectiveEvaluator; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}); begin CfgSyntaxError(SafeFormat(Sender.MsgPattern,Args)); end; -function TPas2jsCompiler.ConditionEvalVariable(Sender: TCondDirectiveEvaluator; +function TPas2JSConfigSupport.ConditionEvalVariable(Sender: TCondDirectiveEvaluator; aName: String; out Value: string): boolean; var i: Integer; @@ -1663,10 +1669,10 @@ var ms: TModeSwitch; begin // check defines - i:=FDefines.IndexOf(aName); + i:=Compiler.Defines.IndexOf(aName); if i>=0 then begin - M:=TMacroDef(FDefines.Objects[i]); + M:=TMacroDef(Compiler.Defines.Objects[i]); if M=nil then Value:=CondDirectiveBool[true] else @@ -1676,7 +1682,7 @@ begin // check modeswitches ms:=StrToModeSwitch(aName); - if (ms<>msNone) and (ms in p2jsMode_SwitchSets[Mode]) then + if (ms<>msNone) and (ms in p2jsMode_SwitchSets[Compiler.Mode]) then begin Value:=CondDirectiveBool[true]; exit(true); @@ -1717,18 +1723,18 @@ begin OptimizeProgram(MainFile); // check what files need building - Checked:=CreateSetOfCompilerFiles_Filename; + Checked:=CreateSetOfCompilerFiles(kcFilename); MarkNeedBuilding(MainFile,Checked,SrcFileCount); SrcFileCount:=Checked.Count;// all modules, including skipped modules FreeAndNil(Checked); // convert all Pascal to JavaScript - Checked:=CreateSetOfCompilerFiles_Filename; + Checked:=CreateSetOfCompilerFiles(kcFilename); CreateJavaScript(MainFile,Checked); FreeAndNil(Checked); // write .js files - Checked:=CreateSetOfCompilerFiles_Filename; + Checked:=CreateSetOfCompilerFiles(kcFilename); WriteJSFiles(MainFile,CombinedFileWriter,Checked); FreeAndNil(Checked); @@ -1737,7 +1743,7 @@ begin begin Seconds:=(Now-StartTime)*86400; Log.LogMsgIgnoreFilter(nLinesInFilesCompiled, - [IntToStr(FileCache.ReadLineCounter),IntToStr(SrcFileCount), + [IntToStr(FS.ReadLineCounter),IntToStr(SrcFileCount), FormatFloat('0.0',Seconds),'s']); ok:=true; end; @@ -1877,11 +1883,11 @@ begin Mark(nUnitNeedsCompileDueToOption,[aFile.GetModuleName,'-B']) else if AllJSIntoMainJS then Mark(nUnitNeedsCompileDueToOption,[aFile.GetModuleName,'-Jc']) - else if (aFile.JSFilename<>'') and (not FileCache.FileExists(aFile.JSFilename)) then + else if (aFile.JSFilename<>'') and (not FS.FileExists(aFile.JSFilename)) then Mark(nUnitNeedsCompileJSMissing,[aFile.GetModuleName,FormatPath(aFile.JSFilename)]) else if (aFile.JSFilename<>'') - and (FileCache.FileAge(aFile.PasFilename)>FileCache.FileAge(aFile.JSFilename)) - then begin + and FS.File1IsNewer(aFile.PasFilename,aFile.JSFilename) then + begin Mark(nUnitNeedsCompilePasHasChanged,[aFile.GetModuleName,FullFormatPath(aFile.JSFilename)]) end; end; @@ -1949,7 +1955,7 @@ end; procedure TPas2jsCompiler.FinishSrcMap(SrcMap: TPas2JSSrcMap); var LocalFilename, MapFilename, BaseDir: String; - aFile: TPas2jsCachedFile; + aFile: TPas2jsFile; i: Integer; begin if SrcMapBaseDir<>'' then @@ -1959,16 +1965,16 @@ begin for i:=0 to SrcMap.SourceCount-1 do begin LocalFilename:=SrcMap.SourceFiles[i]; if LocalFilename='' then continue; - if SrcMapInclude and FileCache.FileExists(LocalFilename) then + if SrcMapInclude and FS.FileExists(LocalFilename) then begin // include source in SrcMap - aFile:=FileCache.LoadFile(LocalFilename); + aFile:=FS.LoadFile(LocalFilename); SrcMap.SourceContents[i]:=aFile.Source; end; // translate local file name if BaseDir<>'' then begin - if not TryCreateRelativePath(LocalFilename,BaseDir,true,MapFilename) then + if not FS.TryCreateRelativePath(LocalFilename,BaseDir,true,MapFilename) then begin // e.g. file is on another partition if not SrcMapInclude then @@ -2107,7 +2113,8 @@ begin if FreeWriter then begin - CallPostProcessors(aFile.JSFilename,aFileWriter); + if Assigned(PostProcessorSupport) then + PostProcessorSupport.CallPostProcessors(aFile.JSFilename,aFileWriter); // Give chance to descendants to write file if DoWriteJSFile(aFile.JSFilename,aFileWriter) then @@ -2188,7 +2195,7 @@ begin {$ELSE} buf.Position:=0; {$ENDIF} - FileCache.SaveToFile(buf,DestFilename); + FS.SaveToFile(buf,DestFilename); finally {$IFDEF Pas2js} buf:=nil; @@ -2231,7 +2238,7 @@ begin {$ELSE} buf.Position:=0; {$ENDIF} - FileCache.SaveToFile(buf,MapFilename); + FS.SaveToFile(buf,MapFilename); finally {$IFDEF Pas2js} buf:=nil; @@ -2273,7 +2280,6 @@ procedure TPas2jsCompiler.InitParamMacros; begin ParamMacros.AddValue('Pas2jsFullVersion','major.minor.release',GetVersion(false)); ParamMacros.AddValue('Pas2jsVersion','major.minor.release',GetVersion(true)); - ParamMacros.AddFunction('Env','environment variable, e.g. $Env(HOME)',@OnMacroEnv,true); ParamMacros.AddFunction('CfgDir','Use within a config file. The directory of this config file',@OnMacroCfgDir,false); // Additionally, under windows the following special variables are recognized: @@ -2365,6 +2371,11 @@ begin System.ExitCode:=Value; end; +procedure TPas2jsCompiler.SetWorkingDir(const aDir: String); +begin + // Do nothing +end; + procedure TPas2jsCompiler.Terminate(TheExitCode: integer); begin ExitCode:=TheExitCode; @@ -2379,7 +2390,7 @@ end; function TPas2jsCompiler.GetShowFullPaths: boolean; begin - Result:=FileCache.ShowFullPaths; + Result:=FS.ShowFullPaths; end; function TPas2jsCompiler.GetShowLogo: Boolean; @@ -2451,7 +2462,7 @@ begin FOptions:=AValue; Log.ShowMsgNumbers:=coShowMessageNumbers in FOptions; Log.ShowMsgTypes:=GetShownMsgTypes; - FileCache.ShowTriedUsedFiles:=coShowTriedUsedFiles in FOptions; + FS.ShowTriedUsedFiles:=coShowTriedUsedFiles in FOptions; end; procedure TPas2jsCompiler.SetShowDebug(AValue: boolean); @@ -2464,7 +2475,7 @@ end; procedure TPas2jsCompiler.SetShowFullPaths(AValue: boolean); begin - FileCache.ShowFullPaths:=AValue; + FS.ShowFullPaths:=AValue; end; procedure TPas2jsCompiler.SetShowLogo(AValue: Boolean); @@ -2474,7 +2485,7 @@ end; procedure TPas2jsCompiler.SetShowTriedUsedFiles(AValue: boolean); begin - FileCache.ShowTriedUsedFiles:=AValue; + FS.ShowTriedUsedFiles:=AValue; SetOption(coShowTriedUsedFiles,AValue); end; @@ -2492,7 +2503,7 @@ procedure TPas2jsCompiler.SetSrcMapBaseDir(const AValue: string); var NewValue: String; begin - NewValue:=FileCache.ExpandDirectory(AValue,FileCache.BaseDirectory); + NewValue:=FS.ExpandDirectory(AValue); if FSrcMapBaseDir=NewValue then Exit; FSrcMapBaseDir:=NewValue; end; @@ -2571,24 +2582,22 @@ begin FReadingModules.Remove(aFile); end; -function TPas2jsCompiler.CreateSetOfCompilerFiles_Filename: TPasAnalyzerKeySet; +procedure TPas2JSConfigSupport.CfgSyntaxError(const Msg: string); begin - Result:=TPasAnalyzerKeySet.Create( - {$IFDEF Pas2js} - @Pas2jsCompilerFile_FilenameToKeyName,@PtrFilenameToKeyName - {$ELSE} - @CompareCompilerFilesPasFile,@CompareFileAndCompilerFilePasFile - {$ENDIF}); -end; - -procedure TPas2jsCompiler.CfgSyntaxError(const Msg: string); -begin - Log.Log(mtError,Msg,0,CurrentCfgFilename,CurrentCfgLineNumber,0); - Terminate(ExitCodeErrorInConfig); + Compiler.Log.Log(mtError,Msg,0,CurrentCfgFilename,CurrentCfgLineNumber,0); + Compiler.Terminate(ExitCodeErrorInConfig); end; procedure TPas2jsCompiler.LoadConfig(CfgFilename: string); + +begin + ConfigSupport.LoadConfig(CfgFileName); +end; + + +procedure TPas2JSConfigSupport.LoadConfig(Const aFileName : String); type + TSkip = ( skipNone, skipIf, @@ -2610,33 +2619,31 @@ var procedure DebugCfgDirective(const s: string); begin - Log.LogMsg(nCfgDirective,[QuoteStr(Line),s],CurrentCfgFilename,CurrentCfgLineNumber,1,false); + Compiler.Log.LogMsg(nCfgDirective,[QuoteStr(Line),s],CurrentCfgFilename,CurrentCfgLineNumber,1,false); end; var OldCfgFilename, Directive, aName, Expr: String; - aFile: TPas2jsFileLineReader; + aFile: TSourceLineReader; IfLvl, SkipLvl, OldCfgLineNumber: Integer; Skip: TSkip; - CacheFile: TPas2jsCachedFile; begin - if ShowDebug or ShowTriedUsedFiles then - Log.LogMsgIgnoreFilter(nReadingOptionsFromFile,[QuoteStr(CfgFilename)]); + if Compiler.ShowDebug or Compiler.ShowTriedUsedFiles then + Compiler.Log.LogMsgIgnoreFilter(nReadingOptionsFromFile,[QuoteStr(aFilename)]); IfLvl:=0; SkipLvl:=0; Skip:=skipNone; aFile:=nil; try OldCfgFilename:=FCurrentCfgFilename; - FCurrentCfgFilename:=CfgFilename; + FCurrentCfgFilename:=aFilename; OldCfgLineNumber:=FCurrentCfgLineNumber; - CacheFile:=FileCache.LoadFile(CfgFilename); - aFile:=CacheFile.CreateLineReader(true); + aFile:=GetReader(aFileName); while not aFile.IsEOF do begin Line:=aFile.ReadLine; FCurrentCfgLineNumber:=aFile.LineNumber; - if ShowDebug then - Log.LogMsgIgnoreFilter(nInterpretingFileOption,[QuoteStr(Line)]); + if Compiler.ShowDebug then + Compiler.Log.LogMsgIgnoreFilter(nInterpretingFileOption,[QuoteStr(Line)]); if Line='' then continue; l:=length(Line); p:=1; @@ -2656,14 +2663,14 @@ begin if Skip=skipNone then begin aName:=GetWord; - if IsDefined(aName)=(Directive='ifdef') then + if Compiler.IsDefined(aName)=(Directive='ifdef') then begin // execute block - if ShowDebug then + if Compiler.ShowDebug then DebugCfgDirective('true -> execute'); end else begin // skip block - if ShowDebug then + if Compiler.ShowDebug then DebugCfgDirective('false -> skip'); SkipLvl:=IfLvl; Skip:=skipIf; @@ -2679,11 +2686,11 @@ begin if ConditionEvaluator.Eval(Expr) then begin // execute block - if ShowDebug then + if Compiler.ShowDebug then DebugCfgDirective('true -> execute'); end else begin // skip block - if ShowDebug then + if Compiler.ShowDebug then DebugCfgDirective('false -> skip'); SkipLvl:=IfLvl; Skip:=skipIf; @@ -2699,14 +2706,14 @@ begin if (Skip=skipIf) and (IfLvl=SkipLvl) then begin // if-block was skipped -> execute else block - if ShowDebug then + if Compiler.ShowDebug then DebugCfgDirective('execute'); SkipLvl:=0; Skip:=skipNone; end else if Skip=skipNone then begin // if-block was executed -> skip else block - if ShowDebug then + if Compiler.ShowDebug then DebugCfgDirective('skip'); Skip:=skipElse; SkipLvl:=IfLvl; @@ -2723,19 +2730,19 @@ begin if ConditionEvaluator.Eval(Expr) then begin // execute elseif block - if ShowDebug then + if Compiler.ShowDebug then DebugCfgDirective('true -> execute'); SkipLvl:=0; Skip:=skipNone; end else begin // skip elseif block - if ShowDebug then + if Compiler.ShowDebug then DebugCfgDirective('false -> skip'); end; end else if Skip=skipNone then begin // if-block was executed -> skip without test - if ShowDebug then + if Compiler.ShowDebug then DebugCfgDirective('no test -> skip'); Skip:=skipIf; end; @@ -2748,14 +2755,14 @@ begin if IfLvl'' then - begin - aFilename:=aFilename+PathDelim{$IFDEF UNIX}+'.'{$ENDIF}+DefaultConfigFile; - if TryConfig(aFileName) then exit; - end; - - // then try compiler directory - if (CompilerExe<>'') then - begin - aFilename:=ExtractFilePath(CompilerExe); - if aFilename<>'' then - begin - aFilename:=IncludeTrailingPathDelimiter(aFilename)+DefaultConfigFile; - if TryConfig(aFilename) then exit; - end; - end; - - // finally try global directory - {$IFDEF Unix} - if TryConfig('/etc/'+DefaultConfigFile) then exit; - {$ENDIF} + aFileName:=FindDefaultConfig; + if aFileName<>'' then + LoadConfig(aFilename); end; procedure TPas2jsCompiler.ParamFatal(Msg: string); begin - if CurrentCfgFilename<>'' then - Log.Log(mtFatal,Msg,0,CurrentCfgFilename,CurrentCfgLineNumber,0) + if Assigned(ConfigSupport) and (ConfigSupport.CurrentCfgFilename<>'') then + Log.Log(mtFatal,Msg,0,ConfigSupport.CurrentCfgFilename,ConfigSupport.CurrentCfgLineNumber,0) else Log.LogPlain(['Fatal: ',Msg]); Terminate(ExitCodeErrorInParams); @@ -2843,18 +2820,13 @@ Var begin Result:=True; case c of - 'e': Log.OutputFilename:=aValue; - 'E': FileCache.MainOutputPath:=aValue; - 'i': if not FileCache.AddIncludePaths(aValue,FromCmdLine,ErrorMsg) then - ParamFatal('invalid include path (-Fi) "'+ErrorMsg+'"'); - 'N': if not FileCache.AddNamespaces(aValue,FromCmdLine,ErrorMsg) then - ParamFatal('invalid namespace (-FN) "'+ErrorMsg+'"'); + 'N': AddNamespaces(aValue,FromCmdLine); 'r': Log.Log(mtNote,'-Fr not yet implemented'); - 'u': if not FileCache.AddUnitPaths(aValue,FromCmdLine,ErrorMsg) then - ParamFatal('invalid unit path (-Fu) "'+ErrorMsg+'"'); - 'U': FileCache.UnitOutputPath:=aValue; + 'e': Log.OutputFilename:=aValue; else - Result:=False; + ErrorMsg:=FS.HandleOptionPaths(C,aValue,FromCmdLine); + if ErrorMsg<>'' then + ParamFatal(ErrorMsg); end; end; @@ -2899,7 +2871,6 @@ Var S, ErrorMsg : String; i : Integer; enable : Boolean; - PostProc : TStringList; begin Result:=True; @@ -3005,7 +2976,7 @@ begin Delete(S,length(S),1); end; Case lowercase(S) of - 'searchlikefpc' : FileCache.SearchLikeFPC:=Enable; + 'searchlikefpc' : FS.SearchLikeFPC:=Enable; 'usestrict' : SetOption(coUseStrict,Enable); 'checkversion=main' : RTLVersionCheck:=rvcMain; 'checkversion=system' : RTLVersionCheck:=rvcSystem; @@ -3017,29 +2988,23 @@ begin 'p': // -Jp<...> begin + if not Assigned(PostProcessorSupport) then + ParamFatal('-Jp : No postprocessor support available'); Result:=copy(aValue,1,3)='cmd'; if Result then begin delete(aValue,1,3); if not Quick then - begin - PostProc:=TStringList.Create; - PostProcs.Add(PostProc); - SplitCmdLineParams(aValue,PostProc); - if PostProc.Count<1 then - ParamFatal('-Jpcmd executable missing'); - // check executable - S:=FileCache.ExpandExecutable(PostProc[0],''); - if (S='') then - ParamFatal('-Jpcmd executable "'+S+'" not found'); - PostProc[0]:=S; - end; + PostProcessorSupport.AddPostProcessor(aValue); end; end; 'u': if not Quick then - if not FileCache.AddSrcUnitPaths(aValue,FromCmdLine,ErrorMsg) then + begin + ErrorMsg:=FS.AddForeignUnitPath(aValue,FromCmdLine); + if ErrorMsg<>'' then ParamFatal('invalid foreign unit path (-Ju) "'+ErrorMsg+'"'); + end; 'U': HandleOptionPCUFormat(aValue); else Result:=False; @@ -3056,7 +3021,7 @@ begin if aFilename='' then ParamFatal('invalid config file at param position '+IntToStr(aPos)); FN:=ExpandFileName(aFilename); - if not FileCache.FileExists(FN) then + if not FS.FileExists(FN) then ParamFatal('config file not found: "'+aFileName+'"'); LoadConfig(FN); end; @@ -3372,7 +3337,7 @@ begin if (not Quick) then begin if not FromCmdLine then - CfgSyntaxError('invalid parameter'); + ConfigSupport.CfgSyntaxError('invalid parameter'); if MainSrcFile<>'' then ParamFatal('Only one Pascal file is supported, but got "'+MainSrcFile+'" and "'+Param+'".'); MainSrcFile:=ExpandFileName(Param); @@ -3620,205 +3585,36 @@ end; function TPas2jsCompiler.FormatPath(const aPath: String): String; begin - Result:=FileCache.FormatPath(aPath); + Result:=FS.FormatPath(aPath); end; function TPas2jsCompiler.FullFormatPath(const aPath: String): String; begin Result:=QuoteStr(FormatPath(aPath)); - end; -procedure TPas2jsCompiler.CallPostProcessors(const JSFilename: String; - aWriter: TPas2JSMapper); -var - i: Integer; - JS, OrigJS: TJSWriterString; -begin - if PostProcs.Count=0 then exit; - OrigJS:=aWriter.AsString; - JS:=OrigJS; - for i:=0 to PostProcs.Count-1 do - JS:=CallPostProcessor(JSFilename,TStringList(PostProcs[i]),JS); - if JS<>OrigJS then - begin - aWriter.AsString:=JS; - if aWriter.SrcMap<>nil then - aWriter.SrcMap.Clear; - end; -end; - -function TPas2jsCompiler.CallPostProcessor(const JSFilename: String; - Cmd: TStringList; JS: TJSWriterString): TJSWriterString; -{$IFDEF pas2js} -begin - Result:=''; - if ShowDebug or ShowUsedTools then - Log.LogMsgIgnoreFilter(nPostProcessorRunX,[QuoteStr(JSFilename)+' | '+CmdListAsStr(Cmd)]); - raise EFOpenError.Create('post processing is not yet implemented in platform nodejs'); - if JSFilename='' then ; - if Cmd=nil then ; - if JS='' then ; -end; -{$ELSE} -const - BufSize = 65536; -var - Exe: String; - TheProcess: TProcess; - WrittenBytes, ReadBytes: LongInt; - Buf, s, ErrBuf: string; - OutputChunks: TStringList; - CurExitCode, i, InPos: Integer; -begin - Result:=''; - Buf:=''; - Exe:=Cmd[0]; - if ShowDebug or ShowUsedTools then - Log.LogMsgIgnoreFilter(nPostProcessorRunX,[QuoteStr(JSFilename)+' | '+CmdListAsStr(Cmd)]); - if FileCache.DirectoryExists(Exe) then - raise EFOpenError.Create('post processor "'+Exe+'" is a directory'); - if not FileIsExecutable(Exe) then - raise EFOpenError.Create('post processor "'+Exe+'" is a not executable'); - try - TheProcess := TProcess.Create(nil); - OutputChunks:=TStringList.Create; - try - TheProcess.Executable := Exe; - for i:=1 to Cmd.Count-1 do - TheProcess.Parameters.Add(Cmd[i]); - TheProcess.Options:= [poUsePipes]; - TheProcess.ShowWindow := swoHide; - //TheProcess.CurrentDirectory:=WorkingDirectory; - TheProcess.Execute; - ErrBuf:=''; - SetLength(Buf,BufSize); - InPos:=1; - repeat - // read stderr and log immediately as warnings - repeat - if TheProcess.Stderr.NumBytesAvailable=0 then break; - ReadBytes:=TheProcess.Stderr.Read(Buf[1],BufSize); - if ReadBytes=0 then break; - ErrBuf+=LeftStr(Buf,ReadBytes); - repeat - i:=1; - while (i<=length(ErrBuf)) and (i<128) and not (ErrBuf[i] in [#10,#13]) do - inc(i); - if i>length(ErrBuf) then break; - Log.LogMsg(nPostProcessorWarnX,[LeftStr(ErrBuf,i)]); - if (i<=length(ErrBuf)) and (ErrBuf[i] in [#10,#13]) then - begin - // skip linebreak - if (iErrBuf[i+1]) then - inc(i,2) - else - inc(i); - end; - Delete(ErrBuf,1,i-1); - until false; - until false; - // write to stdin - if InPosBufSize then i:=BufSize; - WrittenBytes:=TheProcess.Input.Write(JS[InPos],i); - inc(InPos,WrittenBytes); - if InPos>length(JS) then - TheProcess.CloseInput; - end else - WrittenBytes:=0; - // read stdout - if TheProcess.Output.NumBytesAvailable=0 then - ReadBytes:=0 - else - ReadBytes:=TheProcess.Output.Read(Buf[1],BufSize); - if ReadBytes>0 then - OutputChunks.Add(LeftStr(Buf,ReadBytes)); - - if (WrittenBytes=0) and (ReadBytes=0) then - begin - if not TheProcess.Running then break; - Sleep(10); // give tool some time - end; - until false; - TheProcess.WaitOnExit; - CurExitCode:=TheProcess.ExitCode; - - // concatenate output chunks - ReadBytes:=0; - for i:=0 to OutputChunks.Count-1 do - inc(ReadBytes,length(OutputChunks[i])); - SetLength(Result,ReadBytes); - ReadBytes:=0; - for i:=0 to OutputChunks.Count-1 do - begin - s:=OutputChunks[i]; - if s='' then continue; - System.Move(s[1],Result[ReadBytes+1],length(s)); - inc(ReadBytes,length(s)); - end; - finally - OutputChunks.Free; - TheProcess.Free; - end; - except - on E: Exception do begin - if ShowDebug then - Log.LogExceptionBackTrace(E); - Log.LogPlain('Error: '+E.Message); - Log.LogMsg(nPostProcessorFailX,[CmdListAsStr(Cmd)]); - Terminate(ExitCodeToolError); - end - {$IFDEF Pas2js} - else HandleJSException('[20181118170506] TPas2jsCompiler.CallPostProcessor Cmd: '+CmdListAsStr(Cmd),JSExceptValue,true); - {$ENDIF} - end; - if CurExitCode<>0 then - begin - Log.LogMsg(nPostProcessorFailX,[CmdListAsStr(Cmd)]); - Terminate(ExitCodeToolError); - end; - if ShowDebug or ShowUsedTools then - Log.LogMsgIgnoreFilter(nPostProcessorFinished,[]); -end; -{$ENDIF} - constructor TPas2jsCompiler.Create; begin FOptions:=DefaultP2jsCompilerOptions; + FNamespaces:=TStringList.Create; FLog:=TPas2jsLogger.Create; FParamMacros:=TPas2jsMacroEngine.Create; RegisterMessages; FInsertFilenames:=TStringList.Create; - - FFileCache:=TPas2jsFilesCache.Create(Log); - FFileCache.BaseDirectory:=GetCurrentDirPJ; - FFileCacheAutoFree:=true; + FS:=CreateFS; + FOwnsFS:=true; FLog.OnFormatPath:=@FormatPath; - FPostProcs:=TObjectList.Create(true); FDefines:=TStringList.Create; // Done by Reset: TStringList(FDefines).Sorted:=True; // Done by Reset: TStringList(FDefines).Duplicates:=dupError; - FConditionEval:=TCondDirectiveEvaluator.Create; - FConditionEval.OnLog:=@ConditionEvalLog; - FConditionEval.OnEvalVariable:=@ConditionEvalVariable; //FConditionEval.OnEvalFunction:=@ConditionEvalFunction; - FFiles:=CreateSetOfCompilerFiles_Filename; + FFiles:=CreateSetOfCompilerFiles(kcFilename); FReadingModules:=TFPList.Create; - FUnits:=TPasAnalyzerKeySet.Create( - {$IFDEF Pas2js} - @Pas2jsCompilerFile_UnitnameToKeyName,@PtrUnitnameToKeyName - {$ELSE} - @CompareCompilerFilesPasUnitname,@CompareUnitnameAndCompilerFile - {$ENDIF}); - + FUnits:=CreateSetOfCompilerFiles(kcUnitName); InitParamMacros; Reset; end; @@ -3827,6 +3623,7 @@ destructor TPas2jsCompiler.Destroy; procedure FreeStuff; begin + FreeAndNil(FNamespaces); FreeAndNil(FWPOAnalyzer); FreeAndNil(FInsertFilenames); @@ -3838,16 +3635,16 @@ destructor TPas2jsCompiler.Destroy; ClearDefines; FreeAndNil(FDefines); - FreeAndNil(FConditionEval); - FreeAndNil(FPostProcs); FLog.OnFormatPath:=nil; - if FFileCacheAutoFree then - FreeAndNil(FFileCache) + if FOwnsFS then + FreeAndNil(FFS) else - FFileCache:=nil; + FFS:=nil; FreeAndNil(FParamMacros); + FreeAndNil(FConfigSupport); + FreeAndNil(FPostProcessorSupport); end; begin @@ -3874,15 +3671,7 @@ function TPas2jsCompiler.OnMacroCfgDir(Sender: TObject; var Params: string; Lvl: integer): boolean; begin if Lvl=0 then ; - Params:=ExtractFilePath(CurrentCfgFilename); - Result:=true; -end; - -function TPas2jsCompiler.OnMacroEnv(Sender: TObject; var Params: string; - Lvl: integer): boolean; -begin - if Lvl=0 then ; - Params:=GetEnvironmentVariablePJ(Params); + Params:=ExtractFilePath(ConfigSupport.CurrentCfgFilename); Result:=true; end; @@ -3940,17 +3729,97 @@ begin WriteHelpLine('No support for PCU files in this class'); end; + +Procedure TPas2jsCompiler.AddNamespaces(const Paths: string; FromCmdLine: boolean); + +// cmd line paths are added in front of the cfg paths +// cmd line paths are added in order, cfg paths are added in reverse order +// multi paths separated by semicolon are added in order +// duplicates are removed +var + Added: Integer; + + function Add(aPath: string): boolean; + var + Remove: Boolean; + i: Integer; + begin + Remove:=false; + // search duplicate + if aPath[length(aPath)]='-' then + begin + Delete(aPath,length(aPath),1); + Remove:=true; + end; + if not IsValidIdent(aPath,true,true) then + exit(False); + i:=Namespaces.Count-1; + while (i>=0) and (CompareText(aPath,NameSpaces[i])<>0) do dec(i); + + if Remove then + begin + // remove + if i>=0 then + begin + NameSpaces.Delete(i); + if NamespacesFromCmdLine>i then dec(FNamespacesFromCmdLine); + end; + exit(true); + end; + + if FromCmdLine then + begin + // from cmdline: append in order to the cmdline params, in front of cfg params + if i>=0 then + begin + if i<=NamespacesFromCmdLine then exit(true); + NameSpaces.Delete(i); + end; + NameSpaces.Insert(NamespacesFromCmdLine,aPath); + inc(FNamespacesFromCmdLine); + end else begin + // from cfg: append in reverse order to the cfg params, behind cmdline params + if i>=0 then + begin + if i<=FNamespacesFromCmdLine+Added then exit(true); + NameSpaces.Delete(i); + end; + NameSpaces.Insert(FNamespacesFromCmdLine+Added,aPath); + inc(Added); + end; + Result:=true; + end; + +var + aPath: String; + p : integer; + +begin + p:=1; + Added:=0; + while p<=length(Paths) do + begin + aPath:=GetNextDelimitedItem(Paths,';',p); + if aPath='' then + continue; + if not Add(aPath) then + exit; + end; +end; + procedure TPas2jsCompiler.Reset; begin FreeAndNil(FWPOAnalyzer); FPrecompileGUID:=default(TGUID); - + FNamespaces.Clear; + FNamespacesFromCmdLine:=0; FMainFile:=nil; FUnits.Clear; FReadingModules.Clear; FFiles.FreeItems; FInsertFilenames.Clear; - FPostProcs.Clear; + if Assigned(FPostProcessorSupport) then + FPostProcessorSupport.Clear; FCompilerExe:=''; FSrcMapBaseDir:=''; @@ -3993,7 +3862,7 @@ begin FHasShownLogo:=false; FHasShownEncoding:=false; - FFileCache.Reset; + FFS.Reset; end; procedure TPas2jsCompiler.Run(aCompilerExe: string; aWorkingDir: string; @@ -4009,8 +3878,9 @@ begin RaiseInternalError(20170504161340,'internal error: TPas2jsCompiler.Run FileCount>0'); try + // set working directory, need by all relative filenames - FileCache.BaseDirectory:=aWorkingDir; + SetWorkingDir(aWorkingDir); CompilerExe:=aCompilerExe; // maybe needed to find the default config @@ -4023,8 +3893,8 @@ begin WriteLogo; // read default config - if not SkipDefaultConfig then - LoadDefaultConfig; + if Assigned(ConfigSupport) and not SkipDefaultConfig then + ConfigSupport.LoadDefaultConfig; // read command line parameters for i:=0 to ParamList.Count-1 do @@ -4047,7 +3917,7 @@ begin if MainSrcFile='' then ParamFatal('No source file name in command line'); - if not FileCache.FileExists(MainSrcFile) then + if not FS.FileExists(MainSrcFile) then ParamFatal('Pascal file not found: "'+MainSrcFile+'"'); // compile @@ -4306,7 +4176,7 @@ end; procedure TPas2jsCompiler.WriteOptions; var co: TP2jsCompilerOption; - fco: TP2jsFileCacheOption; + fco: TP2jsFSOption; begin // message encoding WriteEncoding; @@ -4320,9 +4190,9 @@ begin for co in TP2jsCompilerOption do Log.LogMsgIgnoreFilter(nOptionIsEnabled, [p2jscoCaption[co],BoolToStr(co in Options,'enabled','disabled')]); - for fco in TP2jsFileCacheOption do + for fco in TP2jsFSOption do Log.LogMsgIgnoreFilter(nOptionIsEnabled, - [p2jsfcoCaption[fco],BoolToStr(fco in FileCache.Options,'enabled','disabled')]); + [p2jsfcoCaption[fco],BoolToStr(fco in FS.Options,'enabled','disabled')]); // source map options if SrcMapEnable then @@ -4350,22 +4220,21 @@ begin end; procedure TPas2jsCompiler.WriteUsedTools; -var - i: Integer; - PostProc: TStringList; + begin - // post processors - for i:=0 to PostProcs.Count-1 do - begin - PostProc:=TStringList(PostProcs[i]); - Log.LogMsgIgnoreFilter(nPostProcessorInfoX,[CmdListAsStr(PostProc)]); - end; + If Assigned(FPostProcessorSupport) then + FPostProcessorSupport.WriteUsedTools; end; procedure TPas2jsCompiler.WriteFoldersAndSearchPaths; +Var + I : integer; + begin - FileCache.WriteFoldersAndSearchPaths; + FS.WriteFoldersAndSearchPaths; + for i:=0 to Namespaces.Count-1 do + Log.LogMsgIgnoreFilter(nUsingPath,['unit scope',Namespaces[i]]); Log.LogMsgIgnoreFilter(nNameValue,['output file',QuoteStr(MainJSFile)]); end; @@ -4417,17 +4286,6 @@ begin if coShowDebug in FOptions then Include(Result,mtDebug); end; -function TPas2jsCompiler.CmdListAsStr(CmdList: TStrings): string; -var - i: Integer; -begin - Result:=''; - for i:=0 to CmdList.Count-1 do - begin - if Result<>'' then Result+=' '; - Result+=QuoteStr(CmdList[i]); - end; -end; procedure TPas2jsCompiler.SetOption(Flag: TP2jsCompilerOption; Enable: boolean); begin @@ -4459,7 +4317,7 @@ begin aFile:=FindUnitWithFile(UnitFilename); if aFile<>nil then exit; - if (UnitFilename='') or not FileCache.FileExists(UnitFilename) then + if (UnitFilename='') or not FS.FileExists(UnitFilename) then begin if isPCU then Log.LogMsg(nSourceFileNotFound,[QuoteStr(UnitFilename)]) @@ -4469,7 +4327,7 @@ begin end; UnitFilename:=ExpandFileName(UnitFilename); - if FileCache.DirectoryExists(UnitFilename) then + if FS.DirectoryExists(UnitFilename) then begin Log.LogMsg(nFileIsFolder,[QuoteStr(UnitFilename)]); Terminate(ExitCodeFileNotFound); @@ -4501,7 +4359,7 @@ begin aPasTree.ParserLogEvents:=aPasTree.ParserLogEvents+[pleInterface,pleImplementation]; // scanner - aFile.CreateScannerAndParser(FileCache.CreateResolver); + aFile.CreateScannerAndParser(FS.CreateResolver); if ShowDebug then Log.LogPlain(['Debug: Opening file "',UnitFilename,'"...']); @@ -4522,7 +4380,7 @@ begin if AllJSIntoMainJS then Result:=GetResolvedMainJSFile else - Result:=FileCache.FindUnitJSFileName(aFilename); + Result:=FS.FindUnitJSFileName(aFilename); end; function TPas2jsCompiler.FindLoadedUnit(const TheUnitName: string @@ -4551,27 +4409,27 @@ end; function TPas2jsCompiler.ExpandFileName(const Filename: string): string; begin - Result:=ExpandFileNamePJ(Filename,FileCache.BaseDirectory); + Result:=FS.ExpandFileName(Filename); end; procedure TPas2jsCompiler.InsertCustomJSFiles(aWriter: TPas2JSMapper); var i: Integer; Filename: String; - FileResolver: TPas2jsFileResolver; - aFile: TPas2jsCachedFile; + FileResolver: TPas2jsFSResolver; + aFile: TPas2jsFile; begin if InsertFilenames.Count=0 then exit; - FileResolver:=FileCache.CreateResolver; + FileResolver:=FS.CreateResolver; try for i:=0 to InsertFilenames.Count-1 do begin - Filename:=FileCache.FindCustomJSFileName(ResolveDots(InsertFilenames[i])); + Filename:=FS.FindCustomJSFileName(InsertFilenames[i]); if Filename='' then begin Log.LogMsg(nCustomJSFileNotFound,[InsertFilenames[i]]); raise EFileNotFoundError.Create(''); end; - aFile:=FileCache.LoadFile(Filename); + aFile:=FS.LoadFile(Filename); if aFile.Source='' then continue; aWriter.WriteFile(aFile.Source,Filename); end @@ -4586,7 +4444,7 @@ var i: Integer; begin for i:=0 to FInsertFilenames.Count-1 do - if CompareFilenames(aFilename,InsertFilenames[i])=0 then + if FS.SameFileName(aFilename,InsertFilenames[i]) then exit(i); Result:=-1; end; @@ -4628,7 +4486,7 @@ var FoundPasUnitName:=TestUnitName; end else begin // search pas in unit path - FoundPasFilename:=FileCache.FindUnitFileName(TestUnitName,'',FoundPasIsForeign); + FoundPasFilename:=FS.FindUnitFileName(TestUnitName,'',FoundPasIsForeign); if FoundPasFilename<>'' then FoundPasUnitName:=TestUnitName; end; @@ -4664,8 +4522,8 @@ begin if (FoundPasFilename='') or (FoundPCUFilename='') then begin // then the cmdline namespaces - for i:=0 to FileCache.Namespaces.Count-1 do begin - aNameSpace:=FileCache.Namespaces[i]; + for i:=0 to Namespaces.Count-1 do begin + aNameSpace:=Namespaces[i]; if aNameSpace='' then continue; if SameText(aNameSpace,DefNameSpace) then continue; TryUnitName(aNameSpace+'.'+UseUnitname); @@ -4688,7 +4546,7 @@ begin if FoundPasFilename='' then begin // search Pascal file - FoundPasFilename:=FileCache.FindUnitFileName(UseUnitname,InFilename,FoundPasIsForeign); + FoundPasFilename:=FS.FindUnitFileName(UseUnitname,InFilename,FoundPasIsForeign); if FoundPasFilename<>'' then begin if InFilename<>'' then @@ -4800,7 +4658,7 @@ begin if (aFile.PasUnitName<>'') and (CompareText(aFile.PasUnitName,Info.UseUnitname)<>0) then begin Log.LogPlain(['Debug: TPas2jsPasTree.FindUnit unitname MISMATCH aFile.PasUnitname="',aFile.PasUnitName,'"', - ' Self=',Context.FileResolver.Cache.FormatPath(Context.PasFilename), + ' Self=',Context.FileResolver.FS.FormatPath(Context.PasFilename), ' Uses=',Info.UseUnitname, ' IsForeign=',Context.IsForeign]); RaiseInternalError(20170504161412,'TPas2jsPasTree.FindUnit unit name mismatch'); @@ -4836,11 +4694,11 @@ begin RaiseInternalError(20170922143329,'aFile.PasUnitName='+aFile.PasUnitName+' UseUnitname='+Info.UseUnitname); if Info.isPCU then begin - if CompareFilenames(aFile.PCUFilename,Info.UseFilename)<>0 then + if Not FS.SameFileName(aFile.PCUFilename,Info.UseFilename) then RaiseInternalError(20180312122331,'aFile.PCUFilename='+aFile.PCUFilename+' UseFilename='+Info.UseFilename); end else begin - if CompareFilenames(aFile.PasFilename,Info.UseFilename)<>0 then + if Not FS.SameFileName(aFile.PasFilename,Info.UseFilename) then RaiseInternalError(20170922143330,'aFile.PasFilename='+aFile.PasFilename+' UseFilename='+Info.UseFilename); end; @@ -4889,8 +4747,8 @@ Var OP,UP : String; begin - OP:=FileCache.MainOutputPath; - UP:=FileCache.UnitOutputPath; + OP:=FS.MainOutputPath; + UP:=FS.UnitOutputPath; if MainJSFile='.' then Result:='' else begin diff --git a/packages/pastojs/src/pas2jscompilercfg.pp b/packages/pastojs/src/pas2jscompilercfg.pp new file mode 100644 index 0000000000..315b9d0535 --- /dev/null +++ b/packages/pastojs/src/pas2jscompilercfg.pp @@ -0,0 +1,95 @@ +{ + This file is part of the Free Component Library (FCL) + Copyright (c) 2018 Michael Van Canneyt + + Pascal to Javascript converter class. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + ********************************************************************** + + Abstract: + Config file handling for compiler, depends on filesystem. +} +unit pas2jscompilercfg; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, pas2JSCompiler, pas2jsfs; + +Type + TPas2JSFileConfigSupport = Class(TPas2JSConfigSupport) + function FindDefaultConfig: String; override; + function GetReader(aFileName: string): TSourceLineReader; override; + end; + +implementation + +uses pas2jsfileutils; + +function TPas2JSFileConfigSupport.GetReader(aFileName: string): TSourceLineReader; + +Var + CacheFile: TPas2jsFile; + +begin + CacheFile:=Compiler.FS.LoadFile(aFilename); + Result:=CacheFile.CreateLineReader(true); +end; + +Function TPas2JSFileConfigSupport.FindDefaultConfig : String; + + + function TryConfig(aFilename: string): boolean; + begin + Result:=false; + if aFilename='' then exit; + aFilename:=ExpandFileName(aFilename); + if Compiler.ShowDebug or Compiler.ShowTriedUsedFiles then + Compiler.Log.LogMsgIgnoreFilter(nConfigFileSearch,[aFilename]); + if not Compiler.FS.FileExists(aFilename) then exit; + Result:=true; + end; + +var + aFilename: String; + +begin + // first try HOME directory + aFilename:=ChompPathDelim(GetEnvironmentVariablePJ('HOME')); + if aFilename<>'' then + begin + aFilename:=aFilename+PathDelim{$IFDEF UNIX}+'.'{$ENDIF}+DefaultConfigFile; + if TryConfig(aFileName) then + exit(aFileName); + end; + + // then try compiler directory + if (Compiler.CompilerExe<>'') then + begin + aFilename:=ExtractFilePath(Compiler.CompilerExe); + if aFilename<>'' then + begin + aFilename:=IncludeTrailingPathDelimiter(aFilename)+DefaultConfigFile; + if TryConfig(aFilename) then + exit(aFileName); + end; + end; + + // finally try global directory + {$IFDEF Unix} + if TryConfig('/etc/'+DefaultConfigFile) then + exit(aFileName); + {$ENDIF} +end; + +end. + diff --git a/packages/pastojs/src/pas2jscompilerpp.pp b/packages/pastojs/src/pas2jscompilerpp.pp new file mode 100644 index 0000000000..077a9ab3bf --- /dev/null +++ b/packages/pastojs/src/pas2jscompilerpp.pp @@ -0,0 +1,262 @@ +{ + This file is part of the Free Component Library (FCL) + Copyright (c) 2018 Michael Van Canneyt + + Pascal to Javascript converter class. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + ********************************************************************** + + Abstract: + Pas2JS compiler Preprocessor support. Can depend on filesystem. +} +unit pas2jscompilerpp; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, pas2jscompiler, jswriter, FPPJSSrcMap, contnrs; + +Type + + { TPas2JSFSPostProcessorSupport } + + TPas2JSFSPostProcessorSupport = Class(TPas2JSPostProcessorSupport) + Private + FPostProcs: TObjectList; + function CmdListAsStr(CmdList: TStrings): string; + Public + Constructor Create(aCompiler: TPas2JSCompiler); override; + Destructor Destroy; override; + Procedure Clear; override; + Procedure WriteUsedTools; override; + Procedure AddPostProcessor(const Cmd: String); override; + Procedure CallPostProcessors(const JSFileName: String; aWriter: TPas2JSMapper); override; + function Execute(const JSFilename: String; Cmd: TStringList; JS: TJSWriterString): TJSWriterString; + end; + +implementation + +uses process, pas2jslogger, pas2jsutils, pas2jsfileutils; + +function TPas2JSFSPostProcessorSupport.CmdListAsStr(CmdList: TStrings): string; +var + i: Integer; +begin + Result:=''; + for i:=0 to CmdList.Count-1 do + begin + if Result<>'' then Result+=' '; + Result+=QuoteStr(CmdList[i]); + end; +end; + +constructor TPas2JSFSPostProcessorSupport.Create(aCompiler: TPas2JSCompiler); +begin + inherited Create(aCompiler); + FPostProcs:=TObjectList.Create; // Owns objects +end; + +destructor TPas2JSFSPostProcessorSupport.Destroy; +begin + FreeAndNil(FPostProcs); + inherited Destroy; +end; + +procedure TPas2JSFSPostProcessorSupport.Clear; +begin + FPostProcs.Clear; +end; + +procedure TPas2JSFSPostProcessorSupport.WriteUsedTools; + +Var + I : integer; + PostProc : TStringList; + +begin + // post processors + for i:=0 to FPostProcs.Count-1 do + begin + PostProc:=TStringList(FPostProcs[i]); + Compiler.Log.LogMsgIgnoreFilter(nPostProcessorInfoX,[CmdListAsStr(PostProc)]); + end; +end; + +procedure TPas2JSFSPostProcessorSupport.AddPostProcessor(const Cmd: String); + +Var + PostProc : TStringList; + S : String; + +begin + PostProc:=TStringList.Create; + FPostProcs.Add(PostProc); + SplitCmdLineParams(Cmd,PostProc); + if PostProc.Count<1 then + Compiler.ParamFatal('-Jpcmd executable missing'); + // check executable + S:=Compiler.FS.ExpandExecutable(PostProc[0]); + if (S='') then + Compiler.ParamFatal('-Jpcmd executable "'+S+'" not found'); + PostProc[0]:=S; +end; + +procedure TPas2JSFSPostProcessorSupport.CallPostProcessors(const JSFileName: String; aWriter: TPas2JSMapper); + +var + i: Integer; + JS, OrigJS: TJSWriterString; + +begin + if FPostProcs.Count=0 then exit; + OrigJS:=aWriter.AsString; + JS:=OrigJS; + for i:=0 to FPostProcs.Count-1 do + JS:=Execute(JSFilename,TStringList(FPostProcs[i]),JS); + if JS<>OrigJS then + begin + aWriter.AsString:=JS; + if aWriter.SrcMap<>nil then + aWriter.SrcMap.Clear; + end; + +end; + +function TPas2JSFSPostProcessorSupport.Execute(const JSFilename: String; Cmd: TStringList; JS: TJSWriterString): TJSWriterString; + +const + BufSize = 65536; +var + Exe: String; + TheProcess: TProcess; + WrittenBytes, ReadBytes: LongInt; + Buf, s, ErrBuf: string; + OutputChunks: TStringList; + CurExitCode, i, InPos: Integer; +begin + Result:=''; + Buf:=''; + Exe:=Cmd[0]; + if Compiler.ShowDebug or Compiler.ShowUsedTools then + Compiler.Log.LogMsgIgnoreFilter(nPostProcessorRunX,[QuoteStr(JSFilename)+' | '+CmdListAsStr(Cmd)]); + if Compiler.FS.DirectoryExists(Exe) then + raise EFOpenError.Create('post processor "'+Exe+'" is a directory'); + if not FileIsExecutable(Exe) then + raise EFOpenError.Create('post processor "'+Exe+'" is a not executable'); + try + TheProcess := TProcess.Create(nil); + OutputChunks:=TStringList.Create; + try + TheProcess.Executable := Exe; + for i:=1 to Cmd.Count-1 do + TheProcess.Parameters.Add(Cmd[i]); + TheProcess.Options:= [poUsePipes]; + TheProcess.ShowWindow := swoHide; + //TheProcess.CurrentDirectory:=WorkingDirectory; + TheProcess.Execute; + ErrBuf:=''; + SetLength(Buf,BufSize); + InPos:=1; + repeat + // read stderr and log immediately as warnings + repeat + if TheProcess.Stderr.NumBytesAvailable=0 then break; + ReadBytes:=TheProcess.Stderr.Read(Buf[1],BufSize); + if ReadBytes=0 then break; + ErrBuf+=LeftStr(Buf,ReadBytes); + repeat + i:=1; + while (i<=length(ErrBuf)) and (i<128) and not (ErrBuf[i] in [#10,#13]) do + inc(i); + if i>length(ErrBuf) then break; + Compiler.Log.LogMsg(nPostProcessorWarnX,[LeftStr(ErrBuf,i)]); + if (i<=length(ErrBuf)) and (ErrBuf[i] in [#10,#13]) then + begin + // skip linebreak + if (iErrBuf[i+1]) then + inc(i,2) + else + inc(i); + end; + Delete(ErrBuf,1,i-1); + until false; + until false; + // write to stdin + if InPosBufSize then i:=BufSize; + WrittenBytes:=TheProcess.Input.Write(JS[InPos],i); + inc(InPos,WrittenBytes); + if InPos>length(JS) then + TheProcess.CloseInput; + end else + WrittenBytes:=0; + // read stdout + if TheProcess.Output.NumBytesAvailable=0 then + ReadBytes:=0 + else + ReadBytes:=TheProcess.Output.Read(Buf[1],BufSize); + if ReadBytes>0 then + OutputChunks.Add(LeftStr(Buf,ReadBytes)); + + if (WrittenBytes=0) and (ReadBytes=0) then + begin + if not TheProcess.Running then break; + Sleep(10); // give tool some time + end; + until false; + TheProcess.WaitOnExit; + CurExitCode:=TheProcess.ExitCode; + + // concatenate output chunks + ReadBytes:=0; + for i:=0 to OutputChunks.Count-1 do + inc(ReadBytes,length(OutputChunks[i])); + SetLength(Result,ReadBytes); + ReadBytes:=0; + for i:=0 to OutputChunks.Count-1 do + begin + s:=OutputChunks[i]; + if s='' then continue; + System.Move(s[1],Result[ReadBytes+1],length(s)); + inc(ReadBytes,length(s)); + end; + finally + OutputChunks.Free; + TheProcess.Free; + end; + except + on E: Exception do begin + if Compiler.ShowDebug then + Compiler.Log.LogExceptionBackTrace(E); + Compiler.Log.LogPlain('Error: '+E.Message); + Compiler.Log.LogMsg(nPostProcessorFailX,[CmdListAsStr(Cmd)]); + Compiler.Terminate(ExitCodeToolError); + end + {$IFDEF Pas2js} + else HandleJSException('[20181118170506] TPas2jsCompiler.CallPostProcessor Cmd: '+CmdListAsStr(Cmd),JSExceptValue,true); + {$ENDIF} + end; + if CurExitCode<>0 then + begin + Compiler.Log.LogMsg(nPostProcessorFailX,[CmdListAsStr(Cmd)]); + Compiler.Terminate(ExitCodeToolError); + end; + if Compiler.ShowDebug or Compiler.ShowUsedTools then + Compiler.Log.LogMsgIgnoreFilter(nPostProcessorFinished,[]); +end; + + +end. + diff --git a/packages/pastojs/src/pas2jsfilecache.pp b/packages/pastojs/src/pas2jsfilecache.pp index a408c55f0d..75723e1629 100644 --- a/packages/pastojs/src/pas2jsfilecache.pp +++ b/packages/pastojs/src/pas2jsfilecache.pp @@ -32,20 +32,11 @@ uses {$ENDIF} Classes, SysUtils, fpjson, - PScanner, PasUseAnalyzer, PasResolver, Pas2jsLogger, Pas2jsFileUtils; + PScanner, PasUseAnalyzer, PasResolver, Pas2jsLogger, Pas2jsFileUtils, pas2jsfs; -const // Messages - nIncludeSearch = 201; sIncludeSearch = 'Include file search: %s'; - nUnitSearch = 202; sUnitSearch = 'Unitsearch: %s'; - nSearchingFileFound = 203; sSearchingFileFound = 'Searching file: %s... found'; - nSearchingFileNotFound = 204; sSearchingFileNotFound = 'Searching file: %s... not found'; - nDuplicateFileFound = 205; sDuplicateFileFound = 'Duplicate file found: "%s" and "%s"'; - nCustomJSFileNotFound = 206; sCustomJSFileNotFound = 'custom JS file not found: "%s"'; - nUsingPath = 104; sUsingPath = 'Using %s: "%s"'; - nFolderNotFound = 105; sFolderNotFound = '%s not found: %s'; type - EPas2jsFileCache = class(Exception); + EPas2jsFileCache = class(EPas2JSFS); type TPas2jsFileAgeTime = longint; @@ -159,93 +150,58 @@ type property OnReadDirectory: TReadDirectoryEvent read FOnReadDirectory write FOnReadDirectory; end; -type - TP2jsFileCacheOption = ( - caoShowFullFilenames, - caoShowTriedUsedFiles, - caoSearchLikeFPC, - caoStrictFileCase - ); - TP2jsFileCacheOptions = set of TP2jsFileCacheOption; - -const - DefaultPas2jsFileCacheOptions = []; - - p2jsfcoCaption: array[TP2jsFileCacheOption] of string = ( - // only used by experts, no need for resourcestrings - 'Show full filenames', - 'Show tried/used files', - 'Search files like FPC', - 'Strict file case' - ); - // 'Combine all JavaScript into main file', - - EncodingBinary = 'Binary'; type TPas2jsFilesCache = class; TPas2jsCachedFile = class; { TPas2jsFileResolver } - TPas2jsFileResolver = class(TFileResolver) + TPas2jsFileResolver = class(TPas2JSFSResolver) private - FCache: TPas2jsFilesCache; + function GetCache: TPas2jsFilesCache; public constructor Create(aCache: TPas2jsFilesCache); reintroduce; // Redirect all calls to cache. - function FindIncludeFileName(const aFilename: string): String; override; - function FindIncludeFile(const aFilename: string): TLineReader; override; - function FindSourceFile(const aFilename: string): TLineReader; override; - property Cache: TPas2jsFilesCache read FCache; + property Cache: TPas2jsFilesCache read GetCache; end; { TPas2jsFileLineReader } - TPas2jsFileLineReader = class(TLineReader) + TPas2jsFileLineReader = class(TSourceLineReader) private FCachedFile: TPas2jsCachedFile; - FIsEOF: boolean; - FLineNumber: integer; - FSource: string; - FSrcPos: integer; + Protected + Procedure IncLineNumber; override; + property CachedFile: TPas2jsCachedFile read FCachedFile; public constructor Create(const AFilename: string); override; constructor Create(aFile: TPas2jsCachedFile); reintroduce; - function IsEOF: Boolean; override; - function ReadLine: string; override; - property LineNumber: integer read FLineNumber; - property CachedFile: TPas2jsCachedFile read FCachedFile; - property Source: string read FSource; - property SrcPos: integer read FSrcPos; end; { TPas2jsCachedFile } - TPas2jsCachedFile = class + TPas2jsCachedFile = class(TPas2JSFile) private - FCache: TPas2jsFilesCache; FChangeStamp: TChangeStamp; FFileEncoding: string; - FFilename: string; FLastErrorMsg: string; FLoaded: boolean; FLoadedFileAge: longint; - FSource: string; FCacheStamp: TChangeStamp; // Cache.ResetStamp when file was loaded + function GetCache: TPas2jsFilesCache; function GetIsBinary: boolean; inline; - public - constructor Create(aCache: TPas2jsFilesCache; const aFilename: string); reintroduce; - function Load(RaiseOnError: boolean; Binary: boolean = false): boolean; - function CreateLineReader(RaiseOnError: boolean): TPas2jsFileLineReader; + Protected property IsBinary: boolean read GetIsBinary; property FileEncoding: string read FFileEncoding; - property Filename: string read FFilename; - property Source: string read FSource; // UTF-8 without BOM or Binary - property Cache: TPas2jsFilesCache read FCache; + property Cache: TPas2jsFilesCache read GetCache; property ChangeStamp: TChangeStamp read FChangeStamp;// changed when Source changed property Loaded: boolean read FLoaded; // Source valid, but may contain an old version property LastErrorMsg: string read FLastErrorMsg; property LoadedFileAge: longint read FLoadedFileAge;// only valid if Loaded=true + public + constructor Create(aCache: TPas2jsFilesCache; const aFilename: string); reintroduce; + function Load(RaiseOnError: boolean; Binary: boolean = false): boolean; override; + function CreateLineReader(RaiseOnError: boolean): TSourceLineReader; override; end; TPas2jsReadFileEvent = function(aFilename: string; var aSource: string): boolean of object; @@ -258,10 +214,9 @@ type { TPas2jsFilesCache } - TPas2jsFilesCache = class + TPas2jsFilesCache = class (TPas2JSFS) private FBaseDirectory: string; - FDefaultOutputPath: string; FDirectoryCache: TPas2jsCachedDirectories; FFiles: TPasAnalyzerKeySet; // set of TPas2jsCachedFile, key is Filename FForeignUnitPaths: TStringList; @@ -269,19 +224,14 @@ type FIncludePaths: TStringList; FIncludePathsFromCmdLine: integer; FLog: TPas2jsLogger; - FNamespaces: TStringList; - FNamespacesFromCmdLine: integer; FOnReadFile: TPas2jsReadFileEvent; FOnWriteFile: TPas2jsWriteFileEvent; - FOptions: TP2jsFileCacheOptions; - FReadLineCounter: SizeInt; FResetStamp: TChangeStamp; - FUnitOutputPath: string; FUnitPaths: TStringList; FUnitPathsFromCmdLine: integer; function FileExistsILogged(var Filename: string): integer; function FileExistsLogged(const Filename: string): boolean; - function FindSourceFileName(const aFilename: string): String; + function GetOnReadDirectory: TReadDirectoryEvent; function GetSearchLikeFPC: boolean; function GetShowFullFilenames: boolean; function GetShowTriedUsedFiles: boolean; @@ -290,70 +240,66 @@ type procedure SetBaseDirectory(AValue: string); function AddSearchPaths(const Paths: string; Kind: TPas2jsSearchPathKind; FromCmdLine: boolean; var List: TStringList; var CmdLineCount: integer): string; - procedure SetDefaultOutputPath(AValue: string); - procedure SetOptions(AValue: TP2jsFileCacheOptions); + procedure SetOnReadDirectory(AValue: TReadDirectoryEvent); procedure SetSearchLikeFPC(const AValue: boolean); procedure SetShowFullFilenames(const AValue: boolean); procedure SetShowTriedUsedFiles(const AValue: boolean); procedure SetStrictFileCase(AValue: Boolean); - procedure SetUnitOutputPath(AValue: string); - procedure SetOption(Flag: TP2jsFileCacheOption; Enable: boolean); protected + function FindSourceFileName(const aFilename: string): String; override; 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); + constructor Create(aLog: TPas2jsLogger); overload; destructor Destroy; override; - procedure Reset; virtual; - procedure WriteFoldersAndSearchPaths; virtual; + procedure Reset; override; + procedure WriteFoldersAndSearchPaths; override; + procedure GetPCUDirs(aList: TStrings; const aBaseDir: String); override; + Function SameFileName(Const File1,File2 : String) : Boolean; override; + Function File1IsNewer(const File1, File2: String): Boolean; override; function SearchLowUpCase(var Filename: string): boolean; - function FindCustomJSFileName(const aFilename: string): String; - function FindUnitJSFileName(const aUnitFilename: string): String; - function FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String; virtual; - function FindIncludeFileName(const aFilename: string): String; virtual; + function FindCustomJSFileName(const aFilename: string): String; override; + function FindUnitJSFileName(const aUnitFilename: string): String; override; + function FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String; override; + function FindIncludeFileName(const aFilename: string): String; override; 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; function AddSrcUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean; - function CreateResolver: TPas2jsFileResolver; - function FormatPath(const aPath: string): string; - Function DirectoryExists(Filename: string): boolean; virtual; - function FileExists(Filename: string): boolean; virtual; + function CreateResolver: TPas2jsFSResolver; override; + function FormatPath(const aPath: string): string; override; + Function DirectoryExists(Const Filename: string): boolean; override; + function FileExists(const Filename: string): boolean; override; function FileExistsI(var Filename: string): integer; // returns number of found files function FileAge(const Filename: string): TPas2jsFileAgeTime; virtual; function FindFile(Filename: string): TPas2jsCachedFile; - function LoadFile(Filename: string; Binary: boolean = false): TPas2jsCachedFile; + function LoadFile(Filename: string; Binary: boolean = false): TPas2jsFile; override; function NormalizeFilename(const Filename: string; RaiseOnError: boolean): string; procedure GetListing(const aDirectory: string; var Files: TStrings; FullPaths: boolean = true); procedure RaiseDuplicateFile(aFilename: string); - procedure SaveToFile(ms: TFPJSStream; Filename: string); - function ExpandDirectory(const Filename, BaseDir: string): string; - function ExpandExecutable(const Filename, BaseDir: string): string; + procedure SaveToFile(ms: TFPJSStream; Filename: string); override; + function ExpandDirectory(const Filename: string): string; override; + function ExpandFileName(const Filename: string): string; override; + function ExpandExecutable(const Filename: string): string; override; + function HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): String; override; + Function AddForeignUnitPath(const aValue: String; FromCmdLine: Boolean): String; override; + function TryCreateRelativePath(const Filename, BaseDirectory: String; UsePointDirectory: boolean; out RelPath: String): Boolean; override; + Protected + property DirectoryCache: TPas2jsCachedDirectories read FDirectoryCache; public property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; // includes trailing pathdelim - property MainOutputPath: string read FDefaultOutputPath write SetDefaultOutputPath; // includes trailing pathdelim - property DirectoryCache: TPas2jsCachedDirectories read FDirectoryCache; property ForeignUnitPaths: TStringList read FForeignUnitPaths; property ForeignUnitPathsFromCmdLine: integer read FForeignUnitPathsFromCmdLine; property IncludePaths: TStringList read FIncludePaths; property IncludePathsFromCmdLine: integer read FIncludePathsFromCmdLine; property Log: TPas2jsLogger read FLog; - property Namespaces: TStringList read FNamespaces; - property NamespacesFromCmdLine: integer read FNamespacesFromCmdLine; - property Options: TP2jsFileCacheOptions read FOptions write SetOptions default DefaultPas2jsFileCacheOptions; - property ReadLineCounter: SizeInt read FReadLineCounter write FReadLineCounter; property ResetStamp: TChangeStamp read FResetStamp; - property SearchLikeFPC: boolean read GetSearchLikeFPC write SetSearchLikeFPC; - property ShowFullPaths: boolean read GetShowFullFilenames write SetShowFullFilenames; - property ShowTriedUsedFiles: boolean read GetShowTriedUsedFiles write SetShowTriedUsedFiles; - property UnitOutputPath: string read FUnitOutputPath write SetUnitOutputPath; // includes trailing pathdelim property UnitPaths: TStringList read FUnitPaths; property UnitPathsFromCmdLine: integer read FUnitPathsFromCmdLine; + property OnReadDirectory: TReadDirectoryEvent read GetOnReadDirectory write SetOnReadDirectory; property OnReadFile: TPas2jsReadFileEvent read FOnReadFile write FOnReadFile; property OnWriteFile: TPas2jsWriteFileEvent read FOnWriteFile write FOnWriteFile; - Property StrictFileCase : Boolean Read GetStrictFileCase Write SetStrictFileCase; end; @@ -409,6 +355,7 @@ var begin Result:=FilenameToKey(Dir.Path); end; + {$ELSE} function CompareFilenameWithCachedFile(Filename, CachedFile: Pointer): integer; var @@ -439,6 +386,7 @@ var begin Result:=CompareFilenames(AnsiString(Path),Directory.Path); end; + {$ENDIF} function ComparePas2jsDirectoryEntries(Entry1, Entry2: {$IFDEF Pas2js}jsvalue{$ELSE}Pointer{$ENDIF}): integer; @@ -1105,6 +1053,13 @@ end; { TPas2jsFileLineReader } +procedure TPas2jsFileLineReader.IncLineNumber; +begin + if (CachedFile<>nil) and (CachedFile.Cache<>nil) then + CachedFile.Cache.IncReadLineCounter; + inherited IncLineNumber; +end; + constructor TPas2jsFileLineReader.Create(const AFilename: string); begin raise Exception.Create('TPas2jsFileLineReader.Create [20180126090825] no cache "'+AFilename+'"'); @@ -1112,60 +1067,10 @@ end; constructor TPas2jsFileLineReader.Create(aFile: TPas2jsCachedFile); begin - inherited Create(aFile.Filename); + inherited Create(aFile.Filename,aFile.Source); FCachedFile:=aFile; - FSource:=aFile.Source; - FSrcPos:=1; - FIsEOF:=FSource=''; end; -function TPas2jsFileLineReader.IsEOF: Boolean; -begin - Result:=FIsEOF; -end; - -function TPas2jsFileLineReader.ReadLine: string; -var - S: string; - p, SrcLen: integer; - - procedure GetLine; - var - l: SizeInt; - begin - l:=p-FSrcPos; - Result:=copy(S,FSrcPos,l); - FSrcPos:=p; - inc(FLineNumber); - if (CachedFile<>nil) and (CachedFile.Cache<>nil) then - inc(CachedFile.Cache.FReadLineCounter); - //writeln('GetLine "',Result,'"'); - end; - -begin - if FIsEOF then exit(''); - S:=Source; - SrcLen:=length(S); - p:=FSrcPos; - while p<=SrcLen do - case S[p] of - #10,#13: - begin - GetLine; - inc(p); - if (p<=SrcLen) and (S[p] in [#10,#13]) and (S[p]<>S[p-1]) then - inc(p); - if p>SrcLen then - FIsEOF:=true; - FSrcPos:=p; - exit; - end; - else - inc(p); - end; - FIsEOF:=true; - GetLine; -end; { TPas2jsCachedFile } @@ -1175,13 +1080,17 @@ begin Result:=FFileEncoding=EncodingBinary; end; +function TPas2jsCachedFile.GetCache: TPas2jsFilesCache; +begin + Result:=TPas2jsFilesCache(FS); +end; + constructor TPas2jsCachedFile.Create(aCache: TPas2jsFilesCache; const aFilename: string); begin + inHerited Create(aCache,aFileName); FChangeStamp:=InvalidChangeStamp; - FCache:=aCache; FCacheStamp:=Cache.ResetStamp; - FFilename:=aFilename; end; function TPas2jsCachedFile.Load(RaiseOnError: boolean; Binary: boolean @@ -1254,14 +1163,14 @@ begin {$ENDIF} if Binary then begin - FSource:=NewSource; + SetSource(NewSource); FFileEncoding:=EncodingBinary; end else begin {$IFDEF FPC_HAS_CPSTRING} - FSource:=ConvertTextToUTF8(NewSource,FFileEncoding); + SetSource(ConvertTextToUTF8(NewSource,FFileEncoding)); {$ELSE} - FSource:=NewSource; + SetSource(NewSource); {$ENDIF} end; FLoaded:=true; @@ -1273,7 +1182,7 @@ begin end; function TPas2jsCachedFile.CreateLineReader(RaiseOnError: boolean - ): TPas2jsFileLineReader; + ): TSourceLineReader; begin if not Load(RaiseOnError) then exit(nil); @@ -1282,41 +1191,14 @@ end; { TPas2jsFileResolver } +function TPas2jsFileResolver.GetCache: TPas2jsFilesCache; +begin + Result:=TPas2jsFilesCache(FS); +end; + constructor TPas2jsFileResolver.Create(aCache: TPas2jsFilesCache); begin - inherited Create; - FCache:=aCache; -end; - -function TPas2jsFileResolver.FindIncludeFile(const aFilename: string): TLineReader; -var - Filename: String; -begin - Result:=nil; - Filename:=Cache.FindIncludeFileName(aFilename); - if Filename='' then exit; - try - Result:=FindSourceFile(Filename); - except - // error is shown in the scanner, which has the context information - end; -end; - -function TPas2jsFileResolver.FindIncludeFileName(const aFilename: string): String; - -begin - Result:=Cache.FindIncludeFileName(aFilename); -end; - - -function TPas2jsFileResolver.FindSourceFile(const aFilename: string): TLineReader; - -var - CurFilename: String; - -begin - CurFilename:=Cache.FindSourceFileName(aFileName); - Result:=Cache.LoadFile(CurFilename).CreateLineReader(false); + inherited Create(aCache); end; @@ -1340,22 +1222,22 @@ end; function TPas2jsFilesCache.GetStrictFileCase : Boolean; begin - Result:=caoStrictFileCase in FOptions; + Result:=caoStrictFileCase in Options; end; function TPas2jsFilesCache.GetSearchLikeFPC: boolean; begin - Result:=caoSearchLikeFPC in FOptions; + Result:=caoSearchLikeFPC in Options; end; function TPas2jsFilesCache.GetShowFullFilenames: boolean; begin - Result:=caoShowFullFilenames in FOptions; + Result:=caoShowFullFilenames in Options; end; function TPas2jsFilesCache.GetShowTriedUsedFiles: boolean; begin - Result:=caoShowTriedUsedFiles in FOptions; + Result:=caoShowTriedUsedFiles in Options; end; @@ -1456,7 +1338,7 @@ begin if aPath='' then continue; if Kind=spkPath then begin - aPath:=ExpandDirectory(aPath,BaseDirectory); + aPath:=ExpandDirectory(aPath); if aPath='' then continue; end; aPaths.Clear; @@ -1474,18 +1356,9 @@ begin end; end; -procedure TPas2jsFilesCache.SetDefaultOutputPath(AValue: string); +procedure TPas2jsFilesCache.SetOnReadDirectory(AValue: TReadDirectoryEvent); begin - AValue:=ExpandDirectory(AValue,BaseDirectory); - if FDefaultOutputPath=AValue then Exit; - FDefaultOutputPath:=AValue; -end; - - -procedure TPas2jsFilesCache.SetOptions(AValue: TP2jsFileCacheOptions); -begin - if FOptions=AValue then Exit; - FOptions:=AValue; + DirectoryCache.OnReadDirectory:=AValue; end; procedure TPas2jsFilesCache.SetSearchLikeFPC(const AValue: boolean); @@ -1508,23 +1381,6 @@ begin SetOption(caoStrictFileCase,aValue) end; - -procedure TPas2jsFilesCache.SetUnitOutputPath(AValue: string); -begin - AValue:=ExpandDirectory(AValue,BaseDirectory); - if FUnitOutputPath=AValue then Exit; - FUnitOutputPath:=AValue; -end; - -procedure TPas2jsFilesCache.SetOption(Flag: TP2jsFileCacheOption; Enable: boolean - ); -begin - if Enable then - Include(FOptions,Flag) - else - Exclude(FOptions,Flag); -end; - function TPas2jsFilesCache.ReadFile(Filename: string; var Source: string ): boolean; {$IFDEF Pas2js} @@ -1629,10 +1485,8 @@ begin inherited Create; FResetStamp:=InvalidChangeStamp; FLog:=aLog; - FOptions:=DefaultPas2jsFileCacheOptions; FIncludePaths:=TStringList.Create; FForeignUnitPaths:=TStringList.Create; - FNamespaces:=TStringList.Create; FUnitPaths:=TStringList.Create; FFiles:=TPasAnalyzerKeySet.Create( {$IFDEF Pas2js} @@ -1652,28 +1506,23 @@ begin FreeAndNil(FFiles); FreeAndNil(FIncludePaths); FreeAndNil(FForeignUnitPaths); - FreeAndNil(FNamespaces); FreeAndNil(FUnitPaths); inherited Destroy; end; procedure TPas2jsFilesCache.Reset; begin + Inherited; IncreaseChangeStamp(FResetStamp); FDirectoryCache.Invalidate; // FFiles: keep data, files are checked against LoadedFileAge - FOptions:=DefaultPas2jsFileCacheOptions; FBaseDirectory:=''; - FUnitOutputPath:=''; - FReadLineCounter:=0; FForeignUnitPaths.Clear; FForeignUnitPathsFromCmdLine:=0; FUnitPaths.Clear; FUnitPathsFromCmdLine:=0; FIncludePaths.Clear; FIncludePathsFromCmdLine:=0; - FNamespaces.Clear; - FNamespacesFromCmdLine:=0; // FOnReadFile: TPas2jsReadFileEvent; keep // FOnWriteFile: TPas2jsWriteFileEvent; keep end; @@ -1695,14 +1544,28 @@ begin WriteFolder('foreign unit path',ForeignUnitPaths[i]); for i:=0 to UnitPaths.Count-1 do WriteFolder('unit path',UnitPaths[i]); - for i:=0 to Namespaces.Count-1 do - Log.LogMsgIgnoreFilter(nUsingPath,['unit scope',Namespaces[i]]); for i:=0 to IncludePaths.Count-1 do WriteFolder('include path',IncludePaths[i]); WriteFolder('unit output path',UnitOutputPath); WriteFolder('main output path',MainOutputPath); end; +procedure TPas2jsFilesCache.GetPCUDirs(aList: TStrings; const aBaseDir: String); +begin + inherited GetPCUDirs(aList, aBaseDir); + aList.AddStrings(UnitPaths); +end; + +function TPas2jsFilesCache.SameFileName(const File1, File2: String): Boolean; +begin + Result:=Pas2jsFileUtils.CompareFilenames(File1,File2)=0; +end; + +function TPas2jsFilesCache.File1IsNewer(const File1, File2: String): Boolean; +begin + Result:=FileAge(File1)>FileAge(File2); +end; + function TPas2jsFilesCache.AddIncludePaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean; begin @@ -1710,12 +1573,6 @@ begin Result:=ErrorMsg=''; end; -function TPas2jsFilesCache.AddNamespaces(const Paths: string; - FromCmdLine: boolean; out ErrorMsg: string): boolean; -begin - ErrorMsg:=AddSearchPaths(Paths,spkIdentifier,FromCmdLine,FNamespaces,FNamespacesFromCmdLine); - Result:=ErrorMsg=''; -end; function TPas2jsFilesCache.AddUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean; @@ -1731,7 +1588,8 @@ begin Result:=ErrorMsg=''; end; -function TPas2jsFilesCache.CreateResolver: TPas2jsFileResolver; +function TPas2jsFilesCache.CreateResolver: TPas2jsFSResolver; + begin Result := TPas2jsFileResolver.Create(Self); {$IFDEF HasStreams} @@ -1759,12 +1617,12 @@ end; -function TPas2jsFilesCache.DirectoryExists(Filename: string): boolean; +function TPas2jsFilesCache.DirectoryExists(Const Filename: string): boolean; begin Result:=DirectoryCache.DirectoryExists(FileName); end; -function TPas2jsFilesCache.FileExists(Filename: string): boolean; +function TPas2jsFilesCache.FileExists(const Filename: string): boolean; begin Result:=DirectoryCache.FileExists(FileName); end; @@ -1786,7 +1644,7 @@ begin end; function TPas2jsFilesCache.LoadFile(Filename: string; Binary: boolean - ): TPas2jsCachedFile; + ): TPas2jsFile; begin Result:=FindFile(FileName); if Result=nil then @@ -1899,20 +1757,20 @@ begin end; end; -function TPas2jsFilesCache.ExpandDirectory(const Filename, BaseDir: string - ): string; +function TPas2jsFilesCache.ExpandDirectory(const Filename: string): string; begin if Filename='' then exit(''); - if BaseDir<>'' then - Result:=ExpandFileNamePJ(Filename,BaseDir) - else - Result:=ExpandFileNamePJ(Filename,BaseDirectory); + Result:=ExpandFileNamePJ(Filename,BaseDirectory); if Result='' then exit; Result:=IncludeTrailingPathDelimiter(Result); end; -function TPas2jsFilesCache.ExpandExecutable(const Filename, BaseDir: string - ): string; +function TPas2jsFilesCache.ExpandFileName(const Filename: string): string; +begin + Result:=ExpandFileNamePJ(Filename,BaseDirectory); +end; + +function TPas2jsFilesCache.ExpandExecutable(const Filename: string): string; function TryFile(CurFilename: string): boolean; begin @@ -1955,10 +1813,38 @@ begin if CurPath='' then continue; if TryFile(IncludeTrailingPathDelimiter(CurPath)+Filename) then exit; end; - end else if BaseDir<>'' then - Result:=ExpandFileNamePJ(Filename,BaseDir) + end else + Result:=ExpandFileName(Filename); +end; + +function TPas2jsFilesCache.HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): String; + +Var + ErrorMsg : String; + +begin + Result:=''; + case C of + 'E': MainOutputPath:=aValue; + 'i': if not AddIncludePaths(aValue,FromCmdLine,ErrorMsg) then + Result:='invalid include path (-Fi) "'+ErrorMsg+'"'; + 'u': if not AddUnitPaths(aValue,FromCmdLine,ErrorMsg) then + Result:='invalid unit path (-Fu) "'+ErrorMsg+'"'; + 'U': UnitOutputPath:=aValue; else - Result:=ExpandFileNamePJ(Filename,BaseDirectory); + Result:=inherited HandleOptionPaths(C, aValue, FromCmdLine); + end; +end; + +function TPas2jsFilesCache.AddForeignUnitPath(const aValue: String; FromCmdLine: Boolean): String; +begin + AddSrcUnitPaths(aValue,FromCmdLine,Result); +end; + +function TPas2jsFilesCache.TryCreateRelativePath(const Filename, BaseDirectory: String; UsePointDirectory: boolean; out + RelPath: String): Boolean; +begin + Result:=Pas2jsFileUtils.TryCreateRelativePath(Filename, BaseDirectory, UsePointDirectory, RelPath); end; function TPas2jsFilesCache.FindIncludeFileName(const aFilename: string): String; @@ -2112,12 +1998,15 @@ end; function TPas2jsFilesCache.FindCustomJSFileName(const aFilename: string): String; +Var + FN : String; + function SearchInDir(Dir: string): boolean; var CurFilename: String; begin Dir:=IncludeTrailingPathDelimiter(Dir); - CurFilename:=Dir+aFilename; + CurFilename:=Dir+FN; Result:=FileExistsLogged(CurFilename); if Result then FindCustomJSFileName:=CurFilename; @@ -2127,18 +2016,18 @@ var i: Integer; begin Result:=''; - - if FilenameIsAbsolute(aFilename) then + FN:=ResolveDots(aFileName); + if FilenameIsAbsolute(FN) then begin - Result:=aFilename; + Result:=FN; if not FileExistsLogged(Result) then Result:=''; exit; end; - if ExtractFilePath(aFilename)<>'' then + if ExtractFilePath(FN)<>'' then begin - Result:=ExpandFileNamePJ(aFilename,BaseDirectory); + Result:=ExpandFileNamePJ(FN,BaseDirectory); if not FileExistsLogged(Result) then Result:=''; exit; @@ -2169,6 +2058,11 @@ begin Log.LogMsgIgnoreFilter(nSearchingFileNotFound,[FormatPath(Filename)]); end; +function TPas2jsFilesCache.GetOnReadDirectory: TReadDirectoryEvent; +begin + Result:=DirectoryCache.OnReadDirectory; +end; + function TPas2jsFilesCache.FileExistsILogged(var Filename: string): integer; begin Result:=DirectoryCache.FileExistsI(Filename); diff --git a/packages/pastojs/src/pas2jsfileutils.pp b/packages/pastojs/src/pas2jsfileutils.pp index dfb876fb74..1f5d166baf 100644 --- a/packages/pastojs/src/pas2jsfileutils.pp +++ b/packages/pastojs/src/pas2jsfileutils.pp @@ -66,8 +66,6 @@ function GetEnvironmentVariablePJ(const EnvVar: string): String; function GetNextDelimitedItem(const List: string; Delimiter: char; var Position: integer): string; -procedure SplitCmdLineParams(const Params: string; ParamList: TStrings; - ReadBackslash: boolean = false); type TChangeStamp = SizeInt; const InvalidChangeStamp = low(TChangeStamp); @@ -732,92 +730,6 @@ begin if Position<=length(List) then inc(Position); // skip Delimiter end; -procedure SplitCmdLineParams(const Params: string; ParamList: TStrings; - ReadBackslash: boolean = false); -// split spaces, quotes are parsed as single parameter -// if ReadBackslash=true then \" is replaced to " and not treated as quote -// #0 is always end -type - TMode = (mNormal,mApostrophe,mQuote); -var - p: Integer; - Mode: TMode; - Param: String; -begin - p:=1; - while p<=length(Params) do - begin - // skip whitespace - while (p<=length(Params)) and (Params[p] in [' ',#9,#10,#13]) do inc(p); - if (p>length(Params)) or (Params[p]=#0) then - break; - // read param - Param:=''; - Mode:=mNormal; - while p<=length(Params) do - begin - case Params[p] of - #0: - break; - '\': - begin - inc(p); - if ReadBackslash then - begin - // treat next character as normal character - if (p>length(Params)) or (Params[p]=#0) then - break; - if ord(Params[p])<128 then - begin - Param+=Params[p]; - inc(p); - end else begin - // next character is already a normal character - end; - end else begin - // treat backslash as normal character - Param+='\'; - end; - end; - '''': - begin - inc(p); - case Mode of - mNormal: - Mode:=mApostrophe; - mApostrophe: - Mode:=mNormal; - mQuote: - Param+=''''; - end; - end; - '"': - begin - inc(p); - case Mode of - mNormal: - Mode:=mQuote; - mApostrophe: - Param+='"'; - mQuote: - Mode:=mNormal; - end; - end; - ' ',#9,#10,#13: - begin - if Mode=mNormal then break; - Param+=Params[p]; - inc(p); - end; - else - Param+=Params[p]; - inc(p); - end; - end; - //writeln('SplitCmdLineParams Param=#'+Param+'#'); - ParamList.Add(Param); - end; -end; procedure IncreaseChangeStamp(var Stamp: TChangeStamp); begin diff --git a/packages/pastojs/src/pas2jsfs.pp b/packages/pastojs/src/pas2jsfs.pp new file mode 100644 index 0000000000..cde85aba59 --- /dev/null +++ b/packages/pastojs/src/pas2jsfs.pp @@ -0,0 +1,426 @@ +{ + This file is part of the Free Component Library (FCL) + Copyright (c) 2018 Michael Van Canneyt + + Pascal to Javascript converter class. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + ********************************************************************** + + Abstract: + FileSystem abstraction layer for compiler. + Has only abstract classes with no actual implementation, so it does not actually + interacts with the filesystem. + See Pas2JSFileCache for an actual implementation. +} +unit pas2jsfs; + +{$mode objfpc}{$H+} + +interface + +uses + // No filesystem-dependent units here ! + Classes, SysUtils, pscanner, fpjson; + +const // Messages + nIncludeSearch = 201; sIncludeSearch = 'Include file search: %s'; + nUnitSearch = 202; sUnitSearch = 'Unitsearch: %s'; + nSearchingFileFound = 203; sSearchingFileFound = 'Searching file: %s... found'; + nSearchingFileNotFound = 204; sSearchingFileNotFound = 'Searching file: %s... not found'; + nDuplicateFileFound = 205; sDuplicateFileFound = 'Duplicate file found: "%s" and "%s"'; + nCustomJSFileNotFound = 206; sCustomJSFileNotFound = 'custom JS file not found: "%s"'; + nUsingPath = 104; sUsingPath = 'Using %s: "%s"'; + nFolderNotFound = 105; sFolderNotFound = '%s not found: %s'; + +Type + // Forward definitions + EPas2jsFS = Class(Exception); + TPas2jsFile = class; + TSourceLineReader = class; + TPas2jsFSResolver = class; + TPas2JSFS = Class; + + { TSourceLineReader } + + TSourceLineReader = class(TLineReader) + private + FIsEOF: boolean; + FLineNumber: integer; + FSource: string; + FSrcPos: integer; + Protected + Procedure IncLineNumber; virtual; + property Source: string read FSource; + property SrcPos: integer read FSrcPos; + public + Constructor Create(Const aFileName, aSource : String); overload; + function IsEOF: Boolean; override; + function ReadLine: string; override; + property LineNumber: integer read FLineNumber; + end; + + TP2jsFSOption = ( + caoShowFullFilenames, + caoShowTriedUsedFiles, + caoSearchLikeFPC, + caoStrictFileCase + ); + TP2jsFSOptions = set of TP2jsFSOption; + TKeyCompareType = (kcFilename,kcUnitName); + + { TPas2JSFS } + + TPas2JSFS = Class + Private + FOptions: TP2jsFSOptions; + FReadLineCounter: SizeInt; + FDefaultOutputPath: string; + FUnitOutputPath: string; + procedure SetOptionFromIndex(AIndex: Integer; AValue: boolean); + procedure SetDefaultOutputPath(AValue: string); + procedure SetUnitOutputPath(AValue: string); + Protected + // Not to be overridden + procedure SetOption(Flag: TP2jsFSOption; Enable: boolean); + Function OptionIsSet(Index : Integer) : Boolean; + Protected + // Protected Abstract. Must be overridden + function FindSourceFileName(const aFilename: string): String; virtual; abstract; + Public + // Public Abstract. Must be overridden + function FindIncludeFileName(const aFilename: string): String; virtual; abstract; + function LoadFile(Filename: string; Binary: boolean = false): TPas2jsFile; virtual; abstract; + Function FileExists(Const aFileName : String) : Boolean; virtual; abstract; + function FindUnitJSFileName(const aUnitFilename: string): String; virtual; abstract; + function FindCustomJSFileName(const aFilename: string): String; virtual; abstract; + function FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String; virtual; abstract; + procedure SaveToFile(ms: TFPJSStream; Filename: string); virtual; abstract; + Function PCUExists(var aFileName : string) : Boolean; virtual; + procedure GetPCUDirs(aList: TStrings; const aBaseDir: String); virtual; + Public + // Public, may be overridden + Function SameFileName(Const File1,File2 : String) : Boolean; virtual; + Function File1IsNewer(Const File1,File2 : String) : Boolean; virtual; + function ExpandDirectory(const Filename: string): string; virtual; + function ExpandFileName(const Filename: string): string; virtual; + function ExpandExecutable(const Filename: string): string; virtual; + Function FormatPath(Const aFileName : string) : String; virtual; + Function DirectoryExists(Const aDirectory : string) : boolean; virtual; + function TryCreateRelativePath(const Filename, BaseDirectory: String; UsePointDirectory: boolean; out RelPath: String): Boolean; virtual; + Procedure WriteFoldersAndSearchPaths; virtual; + function CreateResolver: TPas2jsFSResolver; virtual; + // On success, return '', On error, return error message. + Function AddForeignUnitPath(Const aValue : String; FromCmdLine : Boolean) : String; virtual; + Function HandleOptionPaths(C : Char; aValue : String; FromCmdLine : Boolean) : String; virtual; + Public + Constructor Create; virtual; + Procedure Reset; virtual; + Procedure IncReadLineCounter; + property ReadLineCounter: SizeInt read FReadLineCounter write FReadLineCounter; + property Options: TP2jsFSOptions read FOptions write FOptions; + property ShowFullPaths: boolean Index 0 Read OptionIsSet Write SetOptionFromIndex; + property ShowTriedUsedFiles: boolean Index 1 read OptionIsSet Write SetOptionFromIndex; + property SearchLikeFPC: boolean index 2 read OptionIsSet Write SetOptionFromIndex; + Property StrictFileCase : Boolean Index 3 Read OptionIsSet Write SetOptionFromIndex; + property MainOutputPath: string read FDefaultOutputPath write SetDefaultOutputPath; // includes trailing pathdelim + property UnitOutputPath: string read FUnitOutputPath write SetUnitOutputPath; // includes trailing pathdelim + end; + + { TPas2jsFile } + + TPas2jsFile = class + private + FFilename: string; + FFS: TPas2JSFS; + FSource: string; + Protected + Procedure SetSource(aSource : String); + public + constructor Create(aFS: TPas2jsFS; const aFilename: string); + function CreateLineReader(RaiseOnError: boolean): TSourceLineReader; virtual; abstract; + function Load(RaiseOnError: boolean; Binary: boolean): boolean; virtual; abstract; + property Source: string read FSource; // UTF-8 without BOM or Binary + Property FS : TPas2JSFS Read FFS; + property Filename: string read FFilename; + end; + + { TPas2jsFSResolver } + + TPas2jsFSResolver = class(TFileResolver) + private + FFS: TPas2jsFS; + public + constructor Create(aFS : TPas2jsFS); reintroduce; + // Redirect all calls to FS. + function FindIncludeFileName(const aFilename: string): String; override; + function FindIncludeFile(const aFilename: string): TLineReader; override; + function FindSourceFile(const aFilename: string): TLineReader; override; + property FS: TPas2jsFS read FFS; + end; + + +Const + p2jsfcoCaption: array[TP2jsFSOption] of string = ( + // only used by experts, no need for resourcestrings + 'Show full filenames', + 'Show tried/used files', + 'Search files like FPC', + 'Strict file case' + ); + // 'Combine all JavaScript into main file', + EncodingBinary = 'Binary'; + + DefaultPas2jsFSOptions = []; + +implementation + +// No filesystem-dependent units here ! + +{ TPas2JSFS } + +procedure TPas2JSFS.SetOptionFromIndex(AIndex: Integer; AValue: boolean); +begin + SetOption(TP2jsFSOption(aIndex),aValue); +end; + +procedure TPas2JSFS.SetOption(Flag: TP2jsFSOption; Enable: boolean); +begin + if Enable then + Include(FOptions,Flag) + else + Exclude(FOptions,Flag); +end; + +function TPas2JSFS.OPtionIsSet(Index: Integer): Boolean; +begin + Result:=TP2jsFSOption(Index) in FOptions; +end; + +function TPas2JSFS.PCUExists(var aFileName: string): Boolean; +begin + Result:=Self.FileExists(aFileName); +end; + +procedure TPas2JSFS.GetPCUDirs(aList: TStrings; Const aBaseDir : String); +begin + if UnitOutputPath<>'' then + Alist.Add(UnitOutputPath); + Alist.Add(aBaseDir); +end; + +function TPas2JSFS.SameFileName(const File1, File2: String): Boolean; +begin + Result:=CompareText(File1,File2)=0; +end; + +function TPas2JSFS.File1IsNewer(const File1, File2: String): Boolean; +begin + Result:=False; +end; + +function TPas2JSFS.ExpandDirectory(const Filename : String): string; +begin + Result:=FileName; +end; + +function TPas2JSFS.ExpandFileName(const Filename: string): string; +begin + Result:=FileName; +end; + +function TPas2JSFS.ExpandExecutable(const Filename : string): string; +begin + Result:=FileName +end; + +function TPas2JSFS.FormatPath(const aFileName: string): String; +begin + Result:=aFileName; +end; + +function TPas2JSFS.DirectoryExists(const aDirectory: string): boolean; +begin + Result:=False; +end; + +function TPas2JSFS.TryCreateRelativePath(const Filename, BaseDirectory: String; UsePointDirectory: boolean; out RelPath: String + ): Boolean; +begin + Result:=True; + RelPath:=FileName; +end; + +procedure TPas2JSFS.WriteFoldersAndSearchPaths; +begin + // Do nothing +end; + +function TPas2JSFS.CreateResolver: TPas2jsFSResolver; +begin + Result:=TPas2jsFSResolver.Create(Self); +end; + +function TPas2JSFS.AddForeignUnitPath(const aValue: String; FromCmdLine: Boolean): String; +begin + Result:=''; +end; + +function TPas2JSFS.HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): String; +begin + Result:='Invalid parameter : -F'+C+aValue; +end; + +constructor TPas2JSFS.Create; +begin + FOptions:=DefaultPas2jsFSOptions; +end; + +procedure TPas2JSFS.Reset; +begin + FReadLineCounter:=0; + FUnitOutputPath:=''; + FDefaultOutputPath:=''; +end; + +procedure TPas2JSFS.IncReadLineCounter; +begin + Inc(FReadLineCounter); +end; + +procedure TPas2jsFS.SetDefaultOutputPath(AValue: string); +begin + AValue:=ExpandDirectory(AValue); + if FDefaultOutputPath=AValue then Exit; + FDefaultOutputPath:=AValue; +end; + +procedure TPas2jsFS.SetUnitOutputPath(AValue: string); + +begin + AValue:=ExpandDirectory(AValue); + if FUnitOutputPath=AValue then Exit; + FUnitOutputPath:=AValue; +end; + + +{ TPas2jsFile } + +procedure TPas2jsFile.SetSource(aSource: String); +begin + FSource:=ASource; +end; + +constructor TPas2jsFile.Create(aFS: TPas2jsFS; const aFilename: string); +begin + FFS:=aFS; + FFileName:=aFileName; +end; + +procedure TSourceLineReader.IncLineNumber; +begin + inc(FLineNumber); +end; + +Constructor TSourceLineReader.Create(Const aFileName, aSource : String); + +begin + Inherited Create(aFileName); + FSource:=aSource; + FSrcPos:=1; + FIsEOF:=FSource=''; +end; + +function TSourceLineReader.IsEOF: Boolean; +begin + Result:=FIsEOF; +end; + +function TSourceLineReader.ReadLine: string; +var + S: string; + p, SrcLen: integer; + + procedure GetLine; + var + l: SizeInt; + begin + l:=p-FSrcPos; + Result:=copy(S,FSrcPos,l); + FSrcPos:=p; + IncLineNumber; + //writeln('GetLine "',Result,'"'); + end; + +begin + if FIsEOF then exit(''); + S:=Source; + SrcLen:=length(S); + p:=FSrcPos; + while p<=SrcLen do + case S[p] of + #10,#13: + begin + GetLine; + inc(p); + if (p<=SrcLen) and (S[p] in [#10,#13]) and (S[p]<>S[p-1]) then + inc(p); + if p>SrcLen then + FIsEOF:=true; + FSrcPos:=p; + exit; + end; + else + inc(p); + end; + FIsEOF:=true; + GetLine; +end; + + +function TPas2jsFSResolver.FindIncludeFile(const aFilename: string): TLineReader; +var + Filename: String; +begin + Result:=nil; + Filename:=FS.FindIncludeFileName(aFilename); + if Filename='' then exit; + try + Result:=FindSourceFile(Filename); + except + // error is shown in the scanner, which has the context information + end; +end; + +constructor TPas2jsFSResolver.Create(aFS: TPas2jsFS); +begin + FFS:=aFS; +end; + +function TPas2jsFSResolver.FindIncludeFileName(const aFilename: string): String; + +begin + Result:=FS.FindIncludeFileName(aFilename); +end; + + +function TPas2jsFSResolver.FindSourceFile(const aFilename: string): TLineReader; + +var + CurFilename: String; + +begin + CurFilename:=FS.FindSourceFileName(aFileName); + Result:=FS.LoadFile(CurFilename).CreateLineReader(false); +end; + + + +end. + diff --git a/packages/pastojs/src/pas2jsfscompiler.pp b/packages/pastojs/src/pas2jsfscompiler.pp new file mode 100644 index 0000000000..25cbd45868 --- /dev/null +++ b/packages/pastojs/src/pas2jsfscompiler.pp @@ -0,0 +1,164 @@ +{ + This file is part of the Free Component Library (FCL) + Copyright (c) 2018 Michael Van Canneyt + + Pascal to Javascript converter class. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + ********************************************************************** + + Abstract: + FileSystem aware compiler descendent. No support for PCU. +} +unit pas2jsfscompiler; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, pastree, pas2jscompiler, + pas2jsfs, pas2jsfilecache, pasuseanalyzer; + +Type + TPas2jsFSCompiler = Class(TPas2JSCompiler) + private + function GetFileCache: TPas2jsFilesCache; + function OnMacroEnv(Sender: TObject; var Params: string; Lvl: integer): boolean; + Public + Procedure SetWorkingDir(const aDir: String); override; + function CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet; override; + Function CreateFS : TPas2JSFS; override; + Procedure InitParamMacros; override; + Property FileCache : TPas2jsFilesCache Read GetFileCache; + end; + +implementation + +uses fppas2js, pscanner, pas2jsfileutils; + +{$IFDEF PAS2JS} +function Pas2jsCompilerFile_FilenameToKeyName(Item: Pointer): String; +var + aFile: TPas2jsCompilerFile absolute Item; +begin + Result:=FilenameToKey(aFile.PasFilename); +end; + +function PtrUnitnameToKeyName(Item: Pointer): String; +var + aUnitName: string absolute Item; +begin + Result:=LowerCase(aUnitName); +end; + +function Pas2jsCompilerFile_UnitnameToKeyName(Item: Pointer): String; +var + aFile: TPas2jsCompilerFile absolute Item; +begin + Result:=LowerCase(aFile.PasUnitName); +end; +{$ELSE} +function CompareCompilerFilesPasFile(Item1, Item2: Pointer): integer; +var + File1: TPas2JSCompilerFile absolute Item1; + File2: TPas2JSCompilerFile absolute Item2; +begin + Result:=CompareFilenames(File1.PasFilename,File2.PasFilename); +end; + +function CompareFileAndCompilerFilePasFile(Filename, Item: Pointer): integer; +var + aFile: TPas2JSCompilerFile absolute Item; + aFilename: String; +begin + aFilename:=AnsiString(Filename); + Result:=CompareFilenames(aFilename,aFile.PasFilename); +end; + +function CompareCompilerFilesPasUnitname(Item1, Item2: Pointer): integer; +var + File1: TPas2JSCompilerFile absolute Item1; + File2: TPas2JSCompilerFile absolute Item2; +begin + Result:=CompareText(File1.PasUnitName,File2.PasUnitName); +end; + +function CompareUnitnameAndCompilerFile(TheUnitname, Item: Pointer): integer; +var + aFile: TPas2JSCompilerFile absolute Item; + anUnitname: String; +begin + anUnitname:=AnsiString(TheUnitname); + Result:=CompareText(anUnitname,aFile.PasUnitName); +end; +{$ENDIF} + +function TPas2jsFSCompiler.CreateFS: TPas2JSFS; + +Var + C : TPas2jsFilesCache; + +begin + C:=TPas2jsFilesCache.Create(Log); + C.BaseDirectory:=GetCurrentDirPJ; + Result:=C; +end; + +function TPas2jsFSCompiler.GetFileCache: TPas2jsFilesCache; +begin + Result:=FS as TPas2jsFilesCache; +end; + +function TPas2jsFSCompiler.OnMacroEnv(Sender: TObject; var Params: string; Lvl: integer): boolean; + +begin + if Lvl=0 then ; + Params:=GetEnvironmentVariablePJ(Params); + Result:=true; +end; + +procedure TPas2jsFSCompiler.SetWorkingDir(const aDir: String); +begin + inherited SetWorkingDir(aDir); + FileCache.BaseDirectory:=aDir; +end; + +function TPas2jsFSCompiler.CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet; +begin + Case keyType of + kcFileName: + Result:=TPasAnalyzerKeySet.Create( + {$IFDEF Pas2js} + @Pas2jsCompilerFile_FilenameToKeyName,@PtrFilenameToKeyName + {$ELSE} + @CompareCompilerFilesPasFile,@CompareFileAndCompilerFilePasFile + {$ENDIF}); + kcUnitName: + Result:=TPasAnalyzerKeySet.Create( + {$IFDEF Pas2js} + @Pas2jsCompilerFile_UnitnameToKeyName,@PtrUnitnameToKeyName + {$ELSE} + @CompareCompilerFilesPasUnitname,@CompareUnitnameAndCompilerFile + {$ENDIF}); + else + Raise EPas2jsFileCache.CreateFmt('Internal Unknown key type: %d',[Ord(KeyType)]); + end; +end; + +procedure TPas2jsFSCompiler.InitParamMacros; +begin + inherited InitParamMacros; + ParamMacros.AddFunction('Env','environment variable, e.g. $Env(HOME)',@OnMacroEnv,true); +end; + + + +end. + diff --git a/packages/pastojs/src/pas2jslibcompiler.pp b/packages/pastojs/src/pas2jslibcompiler.pp index f9f49692ff..f032ee16a8 100644 --- a/packages/pastojs/src/pas2jslibcompiler.pp +++ b/packages/pastojs/src/pas2jslibcompiler.pp @@ -2,7 +2,7 @@ This file is part of the Free Component Library (FCL) Copyright (c) 2018 Michael Van Canneyt - Pascal to Javascript converter class. + Pascal to Javascript converter class. Library version See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -21,7 +21,7 @@ unit pas2jslibcompiler; interface uses - SysUtils, Classes, FPPJsSrcMap, Pas2jsFileCache, Pas2jsCompiler; + SysUtils, Classes, FPPJsSrcMap, Pas2jsFileCache, Pas2JSCompiler, Pas2jsPCUCompiler, pas2jscompilercfg, pas2jscompilerpp; { --------------------------------------------------------------------- Compiler descendant, usable in library @@ -44,7 +44,7 @@ Type { TLibraryPas2JSCompiler } - TLibraryPas2JSCompiler = Class(TPas2JSCompiler) + TLibraryPas2JSCompiler = Class(TPas2JSPCUCompiler) private FLastError: String; FLastErrorClass: String; @@ -181,7 +181,9 @@ begin Log.OnLog:=@DoLibraryLog; FileCache.OnReadFile:=@ReadFile; FReadBufferLen:=DefaultReadBufferSize; - FileCache.DirectoryCache.OnReadDirectory:=@ReadDirectory; + FileCache.OnReadDirectory:=@ReadDirectory; + ConfigSupport:=TPas2JSFileConfigSupport.Create(Self); + PostProcessorSupport:=TPas2JSFSPostProcessorSupport.Create(Self); end; procedure TLibraryPas2JSCompiler.DoLibraryLog(Sender: TObject; const Msg: String); diff --git a/packages/pastojs/src/pas2jspcucompiler.pp b/packages/pastojs/src/pas2jspcucompiler.pp index fcfc4e395d..10c721b2c8 100644 --- a/packages/pastojs/src/pas2jspcucompiler.pp +++ b/packages/pastojs/src/pas2jspcucompiler.pp @@ -1,3 +1,21 @@ +{ + This file is part of the Free Component Library (FCL) + Copyright (c) 2018 Michael Van Canneyt + + Pascal to Javascript converter class. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + ********************************************************************** + + Abstract: + FileSystem aware compiler descendent with support for PCU files. +} unit pas2jspcucompiler; {$mode objfpc}{$H+} @@ -11,11 +29,11 @@ unit pas2jspcucompiler; interface uses - Classes, SysUtils, pastree, pas2jscompiler, Pas2JsFiler; + SysUtils,Classes, + pastree, + pas2jscompiler, pas2jsfs, pas2jsfscompiler, Pas2JsFiler; Type - { TFilerPCUSupport } - TFilerPCUSupport = Class(TPCUSupport) Private // This is the format that will be written. @@ -46,15 +64,17 @@ Type property PrecompileInitialFlags: TPCUInitialFlags read FPrecompileInitialFlags; end; - { TPas2jsPCUCompiler } - { TPas2jsPCUCompilerFile } TPas2jsPCUCompilerFile = Class(TPas2jsCompilerFile) Function CreatePCUSupport: TPCUSupport; override; end; - TPas2jsPCUCompiler = Class(TPas2JSCompiler) + + { TPas2jsPCUCompiler } + + TPas2jsPCUCompiler = Class(TPas2JSFSCompiler) + Private FPrecompileFormat : TPas2JSPrecompileFormat; Protected procedure WritePrecompiledFormats; override; @@ -64,7 +84,11 @@ Type implementation -uses fppas2js, pscanner, pas2jslogger, pas2jsfilecache, pasresolveeval, jstree, pas2jsfileutils; +uses fppas2js, pscanner, pas2jslogger, pasresolveeval, jstree, pas2jsfileutils; + + + +{$IFDEF HASPAS2JSFILER} { --------------------------------------------------------------------- TFilerPCUSupport @@ -148,7 +172,7 @@ end; procedure TFilerPCUSupport.CreatePCUReader; var - aFile: TPas2jsCachedFile; + aFile: TPas2jsFile; s: String; begin if MyFile.PCUFilename='' then @@ -162,7 +186,7 @@ begin if MyFile.ShowDebug then MyFile.Log.LogMsg(nParsingFile,[QuoteStr(MyFile.PCUFilename)]); - aFile:=Compiler.FileCache.LoadFile(MyFile.PCUFilename,true); + aFile:=Compiler.FS.LoadFile(MyFile.PCUFilename,true); if aFile=nil then RaiseInternalError(20180312145941,MyFile.PCUFilename); FPCUReaderStream:=TMemoryStream.Create; @@ -199,7 +223,7 @@ function TFilerPCUSupport.FindPCU(const UseUnitName: string; out aFormat: TPas2 CurFormat:=PrecompileFormats[i]; if not CurFormat.Enabled then continue; Filename:=DirPath+UseUnitName+'.'+CurFormat.Ext; - if Compiler.FileCache.SearchLowUpCase(Filename) then + if Compiler.FS.PCUExists(Filename) then begin FindPCU:=Filename; aFormat:=CurFormat; @@ -210,23 +234,20 @@ function TFilerPCUSupport.FindPCU(const UseUnitName: string; out aFormat: TPas2 end; var - Cache: TPas2jsFilesCache; + L : TstringList; 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; + L:=TstringList.Create; + try + Compiler.FS.GetPCUDirs(L,MyFile.FileResolver.BaseDirectory); + for i:=0 to L.Count-1 do + if SearchInDir(L[i]) then exit; + finally + L.Free; + end; end; function TFilerPCUSupport.OnWriterIsElementUsed(Sender: TObject; @@ -269,8 +290,8 @@ begin // Determine output filename FN:=ExtractFilenameOnly(MyFile.PasFilename)+'.'+FPCUFormat.Ext; - if Compiler.FileCache.UnitOutputPath<>'' then - FN:=Compiler.FileCache.UnitOutputPath+FN + if Compiler.FS.UnitOutputPath<>'' then + FN:=Compiler.FS.UnitOutputPath+FN else FN:=ExtractFilePath(MyFile.PasFilename)+FN; // Set as our filename @@ -302,30 +323,30 @@ begin writeln('TPas2jsCompilerFile.WritePCU precompiled ',MyFile.PCUFilename); {$ENDIF} - MyFile.Log.LogMsg(nWritingFile,[QuoteStr(Compiler.FileCache.FormatPath(MyFile.PCUFilename))],'',0,0, + MyFile.Log.LogMsg(nWritingFile,[QuoteStr(Compiler.FS.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 + if (DestDir<>'') and not Compiler.FS.DirectoryExists(DestDir) then begin {$IFDEF REALLYVERBOSE} writeln('TPas2jsCompilerFile.WritePCU output dir not found "',DestDir,'"'); {$ENDIF} - MyFile.Log.LogMsg(nOutputDirectoryNotFound,[QuoteStr(Compiler.FileCache.FormatPath(DestDir))]); + MyFile.Log.LogMsg(nOutputDirectoryNotFound,[QuoteStr(Compiler.FS.FormatPath(DestDir))]); Compiler.Terminate(ExitCodeFileNotFound); end; - if Compiler.FileCache.DirectoryExists(MyFile.PCUFilename) then + if Compiler.FS.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))]); + MyFile.Log.LogMsg(nFileIsFolder,[QuoteStr(Compiler.FS.FormatPath(MyFile.PCUFilename))]); Compiler.Terminate(ExitCodeWriteError); end; ms.Position:=0; - Compiler.FileCache.SaveToFile(ms,MyFile.PCUFilename); + Compiler.FS.SaveToFile(ms,MyFile.PCUFilename); {$IFDEF REALLYVERBOSE} writeln('TPas2jsCompilerFile.WritePCU written ',MyFile.PCUFilename); {$ENDIF} @@ -339,11 +360,11 @@ end; procedure TFilerPCUSupport.OnFilerGetSrc(Sender: TObject; aFilename: string; out p: PChar; out Count: integer); var - SrcFile: TPas2jsCachedFile; + SrcFile: TPas2jsFile; begin if Sender=nil then RaiseInternalError(20180311135558,aFilename); - SrcFile:=MyFile.Compiler.FileCache.LoadFile(aFilename); + SrcFile:=MyFile.Compiler.FS.LoadFile(aFilename); if SrcFile=nil then RaiseInternalError(20180311135329,aFilename); p:=PChar(SrcFile.Source); @@ -370,6 +391,8 @@ end; { TPas2jsPCUCompiler } + + procedure TPas2jsPCUCompiler.WritePrecompiledFormats; Var @@ -410,6 +433,8 @@ begin ParamFatal('invalid precompile output format (-JU) "'+Value+'"'); end; + + { TPas2jsPCUCompilerFile } function TPas2jsPCUCompilerFile.CreatePCUSupport: TPCUSupport; @@ -425,7 +450,7 @@ begin else Result:=Nil; end; - +{$ENDIF} end. diff --git a/packages/pastojs/src/pas2jsutils.pp b/packages/pastojs/src/pas2jsutils.pp new file mode 100644 index 0000000000..0c4ab96fa7 --- /dev/null +++ b/packages/pastojs/src/pas2jsutils.pp @@ -0,0 +1,430 @@ +unit pas2jsutils; +{ + This file is part of the Free Component Library (FCL) + Copyright (c) 2018 Mattias Gaertner mattias@freepascal.org + + Pascal to Javascript converter class. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + ********************************************************************** + + Abstract: + Utility routines that do not need a filesystem or OS functionality. + Filesystem-specific things should go to pas2jsfileutils instead. +} +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +function ChompPathDelim(const Path: string): string; +function GetNextDelimitedItem(const List: string; Delimiter: char; + var Position: integer): string; +type + TChangeStamp = SizeInt; + +const + InvalidChangeStamp = low(TChangeStamp); + +Function IncreaseChangeStamp(Stamp: TChangeStamp) : TChangeStamp; +const + EncodingUTF8 = 'UTF-8'; + EncodingSystem = 'System'; + +function NormalizeEncoding(const Encoding: string): string; +function IsASCII(const s: string): boolean; inline; +{$IFDEF FPC_HAS_CPSTRING} +const + UTF8BOM = #$EF#$BB#$BF; +function UTF8CharacterStrictLength(P: PChar): integer; + +function UTF8ToUTF16(const s: string): UnicodeString; +function UTF16ToUTF8(const s: UnicodeString): string; + +{$ENDIF FPC_HAS_CPSTRING} + +function IsNonUTF8System: boolean;// true if system encoding is not UTF-8 +{$IFDEF Windows} +// AConsole - If false, it is the general system encoding, +// if true, it is the console encoding +function GetWindowsEncoding(AConsole: Boolean = False): string; +{$ENDIF} +{$IF defined(Unix) and not defined(Darwin)} +function GetUnixEncoding: string; +{$ENDIF} + +Function NonUTF8System: boolean; +function GetDefaultTextEncoding: string; + +procedure SplitCmdLineParams(const Params: string; ParamList: TStrings; + ReadBackslash: boolean = false); + +implementation + +{$IFDEF Windows} +uses Windows; +{$ENDIF} + +Var + {$IFDEF Unix} + {$IFNDEF Darwin} + Lang: string = ''; + {$ENDIF} + {$ENDIF} + EncodingValid: boolean = false; + DefaultTextEncoding: string = EncodingSystem; + gNonUTF8System : Boolean = {$IFDEF FPC_HAS_CPSTRING}false{$ELSE}true{$ENDIF}; + +Function NonUTF8System: boolean; + +begin + Result:=gNonUTF8System; +end; + +function GetNextDelimitedItem(const List: string; Delimiter: char; + var Position: integer): string; +var + StartPos: Integer; +begin + StartPos:=Position; + while (Position<=length(List)) and (List[Position]<>Delimiter) do + inc(Position); + Result:=copy(List,StartPos,Position-StartPos); + if Position<=length(List) then inc(Position); // skip Delimiter +end; + +function IncreaseChangeStamp(Stamp: TChangeStamp): TChangeStamp; +begin + if Stamp= 2) and (Result[2] in AllowDirectorySeparators) then + MinLen := 2; // keep UNC '\\', chomp 'a\' to 'a' + {$ENDIF} + {$IFDEF Pas2js} + if (Len >= 2) and (Result[2]=Result[1]) and (PathDelim='\') then + MinLen := 2; // keep UNC '\\', chomp 'a\' to 'a' + {$ENDIF} + end + else begin + MinLen := 0; + {$IFdef MSWindows} + if (Len >= 3) and (Result[1] in ['a'..'z', 'A'..'Z']) and + (Result[2] = ':') and (Result[3] in AllowDirectorySeparators) + then + MinLen := 3; + {$ENDIF} + {$IFdef Pas2js} + if (PathDelim='\') + and (Len >= 3) and (Result[1] in ['a'..'z', 'A'..'Z']) + and (Result[2] = ':') and (Result[3] in AllowDirectorySeparators) + then + MinLen := 3; + {$ENDIF} + end; + + while (Len > MinLen) and (Result[Len] in AllowDirectorySeparators) do dec(Len); + if Len#127 then exit(false); + Result:=true; +end; +{$ELSE} +var + p: PChar; +begin + if s='' then exit(true); + p:=PChar(s); + repeat + case p^ of + #0: if p-PChar(s)=length(s) then exit(true); + #128..#255: exit(false); + end; + inc(p); + until false; +end; +{$ENDIF} + +{$IFDEF FPC_HAS_CPSTRING} +function UTF8CharacterStrictLength(P: PChar): integer; +begin + if p=nil then exit(0); + if ord(p^)<%10000000 then + begin + // regular single byte character + exit(1); + end + else if ord(p^)<%11000000 then + begin + // invalid single byte character + exit(0); + end + else if ((ord(p^) and %11100000) = %11000000) then + begin + // should be 2 byte character + if (ord(p[1]) and %11000000) = %10000000 then + exit(2) + else + exit(0); + end + else if ((ord(p^) and %11110000) = %11100000) then + begin + // should be 3 byte character + if ((ord(p[1]) and %11000000) = %10000000) + and ((ord(p[2]) and %11000000) = %10000000) then + exit(3) + else + exit(0); + end + else if ((ord(p^) and %11111000) = %11110000) then + begin + // should be 4 byte character + if ((ord(p[1]) and %11000000) = %10000000) + and ((ord(p[2]) and %11000000) = %10000000) + and ((ord(p[3]) and %11000000) = %10000000) then + exit(4) + else + exit(0); + end else + exit(0); +end; + +function UTF8ToUTF16(const s: string): UnicodeString; +begin + Result:=UTF8Decode(s); +end; + +function UTF16ToUTF8(const s: UnicodeString): string; +begin + if s='' then exit(''); + Result:=UTF8Encode(s); + // prevent UTF8 codepage appear in the strings - we don't need codepage + // conversion magic + SetCodePage(RawByteString(Result), CP_ACP, False); +end; +{$ENDIF} + +function IsNonUTF8System: boolean; +begin + Result:=NonUTF8System; +end; + +{$IFDEF UNIX} +{$IFNDEF Darwin} +function GetUnixEncoding: string; +var + i: integer; +begin + Result:=EncodingSystem; + i:=pos('.',Lang); + if (i>0) and (i<=length(Lang)) then + Result:=copy(Lang,i+1,length(Lang)-i); +end; +{$ENDIF} +{$ENDIF} + +function GetDefaultTextEncoding: string; + + +begin + if EncodingValid then + begin + Result:=DefaultTextEncoding; + exit; + end; + + {$IFDEF Pas2js} + Result:=EncodingUTF8; + {$ELSE} + {$IFDEF Windows} + Result:=GetWindowsEncoding; + {$ELSE} + {$IFDEF Darwin} + Result:=EncodingUTF8; + {$ELSE} + // unix + Lang := GetEnvironmentVariable('LC_ALL'); + if Lang='' then + begin + Lang := GetEnvironmentVariable('LC_MESSAGES'); + if Lang='' then + Lang := GetEnvironmentVariable('LANG'); + end; + Result:=GetUnixEncoding; + {$ENDIF} + {$ENDIF} + {$ENDIF} + Result:=NormalizeEncoding(Result); + + DefaultTextEncoding:=Result; + EncodingValid:=true; +end; + +procedure InternalInit; +begin + {$IFDEF FPC_HAS_CPSTRING} + SetMultiByteConversionCodePage(CP_UTF8); + // SetMultiByteFileSystemCodePage(CP_UTF8); not needed, this is the default under Windows + SetMultiByteRTLFileSystemCodePage(CP_UTF8); + + GetDefaultTextEncoding; + {$IFDEF Windows} + gNonUTF8System:=true; + {$ELSE} + gNonUTF8System:=SysUtils.CompareText(DefaultTextEncoding,'UTF8')<>0; + {$ENDIF} + {$ENDIF} +end; +procedure SplitCmdLineParams(const Params: string; ParamList: TStrings; + ReadBackslash: boolean = false); +// split spaces, quotes are parsed as single parameter +// if ReadBackslash=true then \" is replaced to " and not treated as quote +// #0 is always end +type + TMode = (mNormal,mApostrophe,mQuote); +var + p: Integer; + Mode: TMode; + Param: String; +begin + p:=1; + while p<=length(Params) do + begin + // skip whitespace + while (p<=length(Params)) and (Params[p] in [' ',#9,#10,#13]) do inc(p); + if (p>length(Params)) or (Params[p]=#0) then + break; + // read param + Param:=''; + Mode:=mNormal; + while p<=length(Params) do + begin + case Params[p] of + #0: + break; + '\': + begin + inc(p); + if ReadBackslash then + begin + // treat next character as normal character + if (p>length(Params)) or (Params[p]=#0) then + break; + if ord(Params[p])<128 then + begin + Param+=Params[p]; + inc(p); + end else begin + // next character is already a normal character + end; + end else begin + // treat backslash as normal character + Param+='\'; + end; + end; + '''': + begin + inc(p); + case Mode of + mNormal: + Mode:=mApostrophe; + mApostrophe: + Mode:=mNormal; + mQuote: + Param+=''''; + end; + end; + '"': + begin + inc(p); + case Mode of + mNormal: + Mode:=mQuote; + mApostrophe: + Param+='"'; + mQuote: + Mode:=mNormal; + end; + end; + ' ',#9,#10,#13: + begin + if Mode=mNormal then break; + Param+=Params[p]; + inc(p); + end; + else + Param+=Params[p]; + inc(p); + end; + end; + //writeln('SplitCmdLineParams Param=#'+Param+'#'); + ParamList.Add(Param); + end; +end; + + +initialization + InternalInit; +end. + From 2c7f401bf796b5b153ad9eef501ea2c821616bc6 Mon Sep 17 00:00:00 2001 From: michael Date: Sun, 2 Dec 2018 18:44:21 +0000 Subject: [PATCH 06/21] * Instantiate PCU compiler git-svn-id: trunk@40451 - --- utils/pas2js/pas2js.pp | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/utils/pas2js/pas2js.pp b/utils/pas2js/pas2js.pp index c4ba8d6c2c..7c691ce139 100644 --- a/utils/pas2js/pas2js.pp +++ b/utils/pas2js/pas2js.pp @@ -12,7 +12,7 @@ uses cthreads, cwstring, {$ENDIF} Classes, SysUtils, CustApp, - Pas2jsFileUtils, Pas2jsLogger, Pas2jsCompiler; + Pas2jsFileUtils, Pas2jsLogger, Pas2jsCompiler, pas2jspcucompiler, pas2jscompilerpp, pas2JScompilercfg; Type @@ -20,14 +20,14 @@ Type TPas2jsCLI = class(TCustomApplication) private - FCompiler: TPas2jsCompiler; + FCompiler: TPas2jsPCUCompiler; FWriteOutputToStdErr: Boolean; protected procedure DoRun; override; public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; - property Compiler: TPas2jsCompiler read FCompiler; + property Compiler: TPas2jsPCUCompiler read FCompiler; property WriteOutputToStdErr: Boolean read FWriteOutputToStdErr write FWriteOutputToStdErr; end; @@ -66,7 +66,9 @@ constructor TPas2jsCLI.Create(TheOwner: TComponent); begin inherited Create(TheOwner); StopOnException:=True; - FCompiler:=TPas2jsCompiler.Create; + FCompiler:=TPas2jsPCUCompiler.Create; + FCompiler.ConfigSupport:=TPas2JSFileConfigSupport.Create(FCompiler); + FCompiler.PostProcessorSupport:=TPas2JSFSPostProcessorSupport.Create(FCompiler); end; destructor TPas2jsCLI.Destroy; From b9905f6a2ca89881160a8938e68e600cef7cd607 Mon Sep 17 00:00:00 2001 From: michael Date: Sun, 2 Dec 2018 18:44:34 +0000 Subject: [PATCH 07/21] * Instantiate FS compiler git-svn-id: trunk@40452 - --- utils/pas2js/nodepas2js.pp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/utils/pas2js/nodepas2js.pp b/utils/pas2js/nodepas2js.pp index 8f4d6c7fd4..dd030d21b0 100644 --- a/utils/pas2js/nodepas2js.pp +++ b/utils/pas2js/nodepas2js.pp @@ -6,7 +6,7 @@ program nodepas2js; uses JS, NodeJSApp, Classes, SysUtils, - Pas2jsFileUtils, Pas2jsLogger, Pas2jsCompiler; + Pas2jsFileUtils, Pas2jsLogger, pas2jscompiler, Pas2jsfscompiler; type @@ -14,13 +14,13 @@ type TPas2jsCLI = class(TNodeJSApplication) private - FCompiler: TPas2jsCompiler; + FCompiler: TPas2jsFSCompiler; protected procedure DoRun; override; public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; - property Compiler: TPas2jsCompiler read FCompiler; + property Compiler: TPas2jsFsCompiler read FCompiler; end; procedure TPas2jsCLI.DoRun; @@ -65,7 +65,7 @@ constructor TPas2jsCLI.Create(TheOwner: TComponent); begin inherited Create(TheOwner); StopOnException:=True; - FCompiler:=TPas2jsCompiler.Create; + FCompiler:=TPas2jsFSCompiler.Create; end; destructor TPas2jsCLI.Destroy; From 6629e72d795b94e237dea897f8526617d6c5160d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A1roly=20Balogh?= Date: Sun, 2 Dec 2018 18:54:04 +0000 Subject: [PATCH 08/21] m68k: reinstate the inc/dec tempregister type hack again in an isolated way (it was removed in r40385, as it was breaking llvm target) git-svn-id: trunk@40453 - --- compiler/m68k/n68kinl.pas | 16 +++++++++++++++- compiler/ncginl.pas | 15 +++++++++++---- 2 files changed, 26 insertions(+), 5 deletions(-) diff --git a/compiler/m68k/n68kinl.pas b/compiler/m68k/n68kinl.pas index ef61d0e94e..b6389d1923 100644 --- a/compiler/m68k/n68kinl.pas +++ b/compiler/m68k/n68kinl.pas @@ -26,7 +26,7 @@ unit n68kinl; interface uses - node,ninl,ncginl,cpubase; + node,ninl,ncginl,symtype,cpubase; type t68kinlinenode = class(tcgInlineNode) @@ -51,6 +51,8 @@ interface procedure second_frac_real; override; {procedure second_prefetch; override; procedure second_abs_long; override;} + protected + function second_incdec_tempregdef: tdef; override; private procedure second_do_operation(op: TAsmOp); end; @@ -342,6 +344,18 @@ implementation eor.l d1,d2 sub.l d1,d2 } + + function t68kinlinenode.second_incdec_tempregdef: tdef; + begin + { this kludge results in the increment/decrement value of inc/dec to be loaded + always in a datareg, regardless of the target type. This results in significantly + better code on m68k, where if the inc/decrement is loaded to an address register + for pointers, the compiler will generate a bunch of useless data<->address register + shuffling, as it cannot do some operations on address registers (like shifting + or multiplication) (KB) } + second_incdec_tempregdef:=cgsize_orddef(def_cgsize(left.resultdef)); + end; + begin cinlinenode:=t68kinlinenode; end. diff --git a/compiler/ncginl.pas b/compiler/ncginl.pas index 1489db118f..7a58ee4da4 100644 --- a/compiler/ncginl.pas +++ b/compiler/ncginl.pas @@ -26,7 +26,7 @@ unit ncginl; interface uses - node,ninl; + node,ninl,symtype; type tcginlinenode = class(tinlinenode) @@ -66,6 +66,8 @@ interface procedure second_seg; virtual; abstract; procedure second_fma; virtual; procedure second_frac_real; virtual; + protected + function second_incdec_tempregdef: tdef;virtual; end; implementation @@ -73,7 +75,7 @@ implementation uses globtype,constexp, verbose,globals,compinnr, - symconst,symtype,symdef,defutil, + symconst,symdef,defutil, aasmbase,aasmdata, cgbase,pass_2, cpubase,procinfo, @@ -332,6 +334,11 @@ implementation {***************************************************************************** INC/DEC GENERIC HANDLING *****************************************************************************} + function tcginlinenode.second_incdec_tempregdef: tdef; + begin + second_incdec_tempregdef:=left.resultdef; + end; + procedure tcginlinenode.second_IncDec; const addsubop:array[in_inc_x..in_dec_x] of TOpCG=(OP_ADD,OP_SUB); @@ -382,7 +389,7 @@ implementation addvalue:=addvalue*tpointerconstnode(tcallparanode(tcallparanode(left).right).left).value else begin - hlcg.location_force_reg(current_asmdata.CurrAsmList,tcallparanode(tcallparanode(left).right).left.location,tcallparanode(tcallparanode(left).right).left.resultdef,left.resultdef,addvalue<=1); + hlcg.location_force_reg(current_asmdata.CurrAsmList,tcallparanode(tcallparanode(left).right).left.location,tcallparanode(tcallparanode(left).right).left.resultdef,second_incdec_tempregdef,addvalue<=1); hregister:=tcallparanode(tcallparanode(left).right).left.location.register; {$ifndef cpu64bitalu} hregisterhi:=tcallparanode(tcallparanode(left).right).left.location.register64.reghi; @@ -684,7 +691,7 @@ implementation tempreg1:=hlcg.getintregister(current_asmdata.CurrAsmList,left.resultdef); tempreg2:=hlcg.getintregister(current_asmdata.CurrAsmList,left.resultdef); - + hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SAR,left.resultdef,left.resultdef.size*8-1,left.location.register,tempreg1); hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_XOR,left.resultdef,left.location.register,tempreg1,tempreg2); hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmlist,OP_SUB,left.resultdef,tempreg1,tempreg2,location.register); From eeadf618b8320fc653e66ff4b24b58017c10c607 Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 2 Dec 2018 22:56:12 +0000 Subject: [PATCH 09/21] + abi tag for i386 * arm abi tag moved into pascal file git-svn-id: trunk@40454 - --- .gitattributes | 2 ++ compiler/raatt.pas | 4 ++-- rtl/linux/arm/abitag.inc | 32 ++++++++++++++++++++++++++++++++ rtl/linux/arm/cprt0.as | 15 --------------- rtl/linux/arm/gprt0.as | 15 --------------- rtl/linux/arm/prt0.as | 15 --------------- rtl/linux/arm/ucprt0.as | 15 --------------- rtl/linux/i386/abitag.inc | 32 ++++++++++++++++++++++++++++++++ rtl/linux/system.pp | 6 ++++++ 9 files changed, 74 insertions(+), 62 deletions(-) create mode 100644 rtl/linux/arm/abitag.inc create mode 100644 rtl/linux/i386/abitag.inc diff --git a/.gitattributes b/.gitattributes index 475ae06738..b77d75d327 100644 --- a/.gitattributes +++ b/.gitattributes @@ -9607,6 +9607,7 @@ rtl/linux/aarch64/stat.inc svneol=native#text/plain rtl/linux/aarch64/syscall.inc svneol=native#text/plain rtl/linux/aarch64/syscallh.inc svneol=native#text/plain rtl/linux/aarch64/sysnr.inc svneol=native#text/plain +rtl/linux/arm/abitag.inc svneol=native#text/plain rtl/linux/arm/bsyscall.inc svneol=native#text/plain rtl/linux/arm/cprt0.as svneol=native#text/plain rtl/linux/arm/dllprt0.as svneol=native#text/plain @@ -9628,6 +9629,7 @@ rtl/linux/errno.inc svneol=native#text/plain rtl/linux/errnostr.inc svneol=native#text/plain rtl/linux/fpcylix.pp svneol=native#text/plain rtl/linux/fpmake.inc svneol=native#text/plain +rtl/linux/i386/abitag.inc svneol=native#text/plain rtl/linux/i386/bsyscall.inc svneol=native#text/plain rtl/linux/i386/si_c.inc svneol=native#text/plain rtl/linux/i386/si_c21.inc svneol=native#text/plain diff --git a/compiler/raatt.pas b/compiler/raatt.pas index 4f9a4f9d98..0ba43ec845 100644 --- a/compiler/raatt.pas +++ b/compiler/raatt.pas @@ -1340,9 +1340,9 @@ unit raatt; if actasmtoken=AS_COMMA then begin Consume(AS_COMMA); - if actasmtoken=AS_MOD then + if (actasmtoken=AS_MOD) or (actasmtoken=AS_AT) then begin - Consume(AS_MOD); + Consume(actasmtoken); if actasmtoken=AS_ID then begin case actasmpattern of diff --git a/rtl/linux/arm/abitag.inc b/rtl/linux/arm/abitag.inc new file mode 100644 index 0000000000..0048d35a1f --- /dev/null +++ b/rtl/linux/arm/abitag.inc @@ -0,0 +1,32 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2002,2018 by Florian Klaempfl + members of the Free Pascal development team. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY;without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +**********************************************************************} + +procedure ABITag;nostackframe;assembler; +asm + .section ".note.ABI-tag", "a" + .align 4 + .long 4 + .long 16 + .long 1 + .asciz "GNU" + .align 4 + .long 0 + // oldest supported kernel version, just a guess for now (FK) + .long 2,6,0 + .align 4 + + .section ".note.GNU-stack","",@progbits + .text +end; + diff --git a/rtl/linux/arm/cprt0.as b/rtl/linux/arm/cprt0.as index 40755fe40f..694e4111ee 100644 --- a/rtl/linux/arm/cprt0.as +++ b/rtl/linux/arm/cprt0.as @@ -131,18 +131,3 @@ __data_start: .byte 0 .ascii "generated by FPC http://www.freepascal.org\0" -/* We need this stuff to make gdb behave itself, otherwise - gdb will chokes with SIGILL when trying to debug apps. -*/ - .section ".note.ABI-tag", "a" - .align 4 - .long 1f - 0f - .long 3f - 2f - .long 1 -0: .asciz "GNU" -1: .align 4 -2: .long 0 - .long 2,0,0 -3: .align 4 - -.section .note.GNU-stack,"",%progbits diff --git a/rtl/linux/arm/gprt0.as b/rtl/linux/arm/gprt0.as index dd7ebd0363..a0953e67f4 100644 --- a/rtl/linux/arm/gprt0.as +++ b/rtl/linux/arm/gprt0.as @@ -143,18 +143,3 @@ __data_start: .byte 0 .ascii "generated by FPC http://www.freepascal.org\0" -/* We need this stuff to make gdb behave itself, otherwise - gdb will chokes with SIGILL when trying to debug apps. -*/ - .section ".note.ABI-tag", "a" - .align 4 - .long 1f - 0f - .long 3f - 2f - .long 1 -0: .asciz "GNU" -1: .align 4 -2: .long 0 - .long 2,0,0 -3: .align 4 - -.section .note.GNU-stack,"",%progbits diff --git a/rtl/linux/arm/prt0.as b/rtl/linux/arm/prt0.as index 05a8166c72..a45c448b74 100644 --- a/rtl/linux/arm/prt0.as +++ b/rtl/linux/arm/prt0.as @@ -173,18 +173,3 @@ __data_start: .byte 0 .ascii "generated by FPC http://www.freepascal.org\0" -/* We need this stuff to make gdb behave itself, otherwise - gdb will chokes with SIGILL when trying to debug apps. -*/ - .section ".note.ABI-tag", "a" - .align 4 - .long 1f - 0f - .long 3f - 2f - .long 1 -0: .asciz "GNU" -1: .align 4 -2: .long 0 - .long 2,0,0 -3: .align 4 - -.section .note.GNU-stack,"",%progbits diff --git a/rtl/linux/arm/ucprt0.as b/rtl/linux/arm/ucprt0.as index 0777096ada..89d59e5b1a 100644 --- a/rtl/linux/arm/ucprt0.as +++ b/rtl/linux/arm/ucprt0.as @@ -168,18 +168,3 @@ __data_start: .comm operatingsystem_parameter_argc,4 .comm operatingsystem_parameter_argv,4 -/* We need this stuff to make gdb behave itself, otherwise - gdb will chokes with SIGILL when trying to debug apps. -*/ - .section ".note.ABI-tag", "a" - .align 4 - .long 1f - 0f - .long 3f - 2f - .long 1 -0: .asciz "GNU" -1: .align 4 -2: .long 0 - .long 2,0,0 -3: .align 4 - -.section .note.GNU-stack,"",%progbits diff --git a/rtl/linux/i386/abitag.inc b/rtl/linux/i386/abitag.inc new file mode 100644 index 0000000000..0048d35a1f --- /dev/null +++ b/rtl/linux/i386/abitag.inc @@ -0,0 +1,32 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2002,2018 by Florian Klaempfl + members of the Free Pascal development team. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY;without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +**********************************************************************} + +procedure ABITag;nostackframe;assembler; +asm + .section ".note.ABI-tag", "a" + .align 4 + .long 4 + .long 16 + .long 1 + .asciz "GNU" + .align 4 + .long 0 + // oldest supported kernel version, just a guess for now (FK) + .long 2,6,0 + .align 4 + + .section ".note.GNU-stack","",@progbits + .text +end; + diff --git a/rtl/linux/system.pp b/rtl/linux/system.pp index 74b4592ace..8fa11ffc7c 100644 --- a/rtl/linux/system.pp +++ b/rtl/linux/system.pp @@ -575,6 +575,12 @@ procedure InitTLS; [public,alias:'FPC_INITTLS']; {$endif CPUARM} +{$if FPC_FULLVERSION>30200} +{$if defined(CPUI386) or defined(CPUARM)} +{$I abitag.inc} +{$endif defined(CPUI386) or defined(CPUARM)} +{$endif FPC_FULLVERSION>30200} + begin {$if defined(i386) and not defined(FPC_USE_LIBC)} InitSyscallIntf; From ec782c522e6eb15cf483d4698f11984d7a4775a9 Mon Sep 17 00:00:00 2001 From: michael Date: Mon, 3 Dec 2018 08:51:08 +0000 Subject: [PATCH 10/21] * No more basedir git-svn-id: trunk@40455 - --- packages/pastojs/src/pas2jsfilecache.pp | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/packages/pastojs/src/pas2jsfilecache.pp b/packages/pastojs/src/pas2jsfilecache.pp index 75723e1629..163ab9d315 100644 --- a/packages/pastojs/src/pas2jsfilecache.pp +++ b/packages/pastojs/src/pas2jsfilecache.pp @@ -78,7 +78,7 @@ type function Count: integer; procedure Clear; property ChangeStamp: TChangeStamp read FChangeStamp write FChangeStamp;// set on Update to Pool.ChangeStamp - function NeedsUpdate: boolean; inline; + function NeedsUpdate: boolean; procedure Update; procedure Reference; procedure Release; @@ -562,6 +562,7 @@ begin FPath:=IncludeTrailingPathDelimiter(aPath); FEntries:=TFPList.Create; FPool:=aPool; + FChangeStamp:=InvalidChangeStamp; end; destructor TPas2jsCachedDirectory.Destroy; @@ -1791,10 +1792,7 @@ begin // no file path -> search {$IFDEF Windows} // search in BaseDir - if BaseDir<>'' then - begin - if TryFile(IncludeTrailingPathDelimiter(BaseDir)+Filename) then exit; - end else if BaseDirectory<>'' then + if BaseDirectory<>'' then begin if TryFile(IncludeTrailingPathDelimiter(BaseDirectory)+Filename) then exit; end; From ca7d1876540f93b0946c8664455ca8b6e9c13c18 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Mon, 3 Dec 2018 16:23:55 +0000 Subject: [PATCH 11/21] pastojs: restored built-in function debugger git-svn-id: trunk@40456 - --- packages/pastojs/src/fppas2js.pp | 37 -------------------------------- 1 file changed, 37 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 4263ee4ef1..a6bb5a757f 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -354,7 +354,6 @@ Works: - typecast byte(longword) -> value & $ff - typecast TJSFunction(func) - modeswitch OmitRTTI -- debugger; ToDos: - do not rename property Date @@ -1263,11 +1262,8 @@ type procedure ComputeBinaryExprRes(Bin: TBinaryExpr; out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags; var LeftResolved, RightResolved: TPasResolverResult); override; - // built-in functions procedure BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc; Params: TParamsExpr; out ResolvedEl: TPasResolverResult); override; - function BI_Debugger_OnGetCallCompatibility(Proc: TResElDataBuiltInProc; - Expr: TPasExpr; RaiseOnError: boolean): integer; virtual; public constructor Create; reintroduce; destructor Destroy; override; @@ -1752,7 +1748,6 @@ type Function ConvertBuiltIn_New(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertBuiltIn_Dispose(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertBuiltIn_Default(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; - Function ConvertBuiltIn_Debugger(El: TPasExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertRecordValues(El: TRecordValues; AContext: TConvertContext): TJSElement; virtual; Function ConvertSelfExpression(El: TSelfExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertBinaryExpression(El: TBinaryExpr; AContext: TConvertContext): TJSElement; virtual; @@ -4236,16 +4231,6 @@ begin if Proc=nil then ; end; -function TPas2JSResolver.BI_Debugger_OnGetCallCompatibility( - Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer; -// debugger; -begin - if Expr is TParamsExpr then - Result:=CheckBuiltInMaxParamCount(Proc,TParamsExpr(Expr),0,RaiseOnError) - else - Result:=cExact; -end; - constructor TPas2JSResolver.Create; var bt: TPas2jsBaseType; @@ -4336,9 +4321,6 @@ begin AddBaseType(Pas2JSBuiltInNames[pbitnUIntDouble],btUIntDouble); if btIntDouble in TheBaseTypes then AddBaseType(Pas2JSBuiltInNames[pbitnIntDouble],btIntDouble); - AddBuiltInProc('Debugger','procedure Debugger', - @BI_Debugger_OnGetCallCompatibility,nil, - nil,nil,bfCustom,[bipfCanBeStatement]); end; function TPas2JSResolver.CheckTypeCastRes(const FromResolved, @@ -7302,12 +7284,6 @@ begin bfBreak: Result:=ConvertBuiltInBreak(El,AContext); bfContinue: Result:=ConvertBuiltInContinue(El,AContext); bfExit: Result:=ConvertBuiltIn_Exit(El,AContext); - bfCustom: - case BuiltInProc.Element.Name of - 'Debugger': Result:=ConvertBuiltIn_Debugger(El,AContext); - else - RaiseNotSupported(El,AContext,20181126102554,'built in custom proc '+BuiltInProc.Element.Name); - end else RaiseNotSupported(El,AContext,20161130164955,'built in proc '+ResolverBuiltInProcNames[BuiltInProc.BuiltIn]); end; @@ -8407,12 +8383,6 @@ begin if Result=nil then exit; end; bfDefault: Result:=ConvertBuiltIn_Default(El,AContext); - bfCustom: - case BuiltInProc.Element.Name of - 'Debugger': Result:=ConvertBuiltIn_Debugger(El,AContext); - else - RaiseNotSupported(El,AContext,20181126101801,'built in custom proc '+BuiltInProc.Element.Name); - end; else RaiseNotSupported(El,AContext,20161130164955,'built in proc '+ResolverBuiltInProcNames[BuiltInProc.BuiltIn]); end; @@ -11003,13 +10973,6 @@ begin AContext.Resolver.GetResolverResultDescription(ResolvedEl)],Param); end; -function TPasToJSConverter.ConvertBuiltIn_Debugger(El: TPasExpr; - AContext: TConvertContext): TJSElement; -begin - Result:=CreateLiteralCustomValue(El,'debugger'); - if AContext=nil then ; -end; - function TPasToJSConverter.ConvertRecordValues(El: TRecordValues; AContext: TConvertContext): TJSElement; var From 3c8c833234daffc2c68944d37cbc55ee1545e0a9 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Mon, 3 Dec 2018 16:41:45 +0000 Subject: [PATCH 12/21] pastojs: restored built-in function debugger git-svn-id: trunk@40457 - --- utils/pas2js/docs/translation.html | 2 -- 1 file changed, 2 deletions(-) diff --git a/utils/pas2js/docs/translation.html b/utils/pas2js/docs/translation.html index 4b0907cc2b..c9d5047a73 100644 --- a/utils/pas2js/docs/translation.html +++ b/utils/pas2js/docs/translation.html @@ -2923,8 +2923,6 @@ End. Width and precision is supported. str(i:10) will add spaces to the left to fill up to 10 characters. str(aDouble:1:5) returns a string in decimal format with 5 digits for the fraction.
  • Intrinsic procedure WriteStr(out s: string; params...)
    • -
  • Debugger; converts to debugger;. If a debugger is running - it will break on this line just like a break point.
    • From ada75392aa0c1fba342cb120d9f027efaa2e33ef Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Mon, 3 Dec 2018 16:43:10 +0000 Subject: [PATCH 13/21] pas2js: lpi removed default suite git-svn-id: trunk@40458 - --- packages/pastojs/tests/testpas2js.lpi | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/packages/pastojs/tests/testpas2js.lpi b/packages/pastojs/tests/testpas2js.lpi index 2ac714deb6..2e61c673f0 100644 --- a/packages/pastojs/tests/testpas2js.lpi +++ b/packages/pastojs/tests/testpas2js.lpi @@ -19,16 +19,9 @@ - - - - - - - - + @@ -110,6 +103,9 @@ + + + From 8b912d0fea5872a1b1d5fff53b20efb0e0ae7f50 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Mon, 3 Dec 2018 16:43:47 +0000 Subject: [PATCH 14/21] pastojs: restored test built-in debugger; git-svn-id: trunk@40459 - --- packages/pastojs/tests/tcmodules.pas | 25 ------------------------- 1 file changed, 25 deletions(-) diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 9341ab590b..883438c1dd 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -381,7 +381,6 @@ type Procedure TestCaseOfRange; Procedure TestCaseOfString; Procedure TestCaseOfExternalClassConst; - Procedure TestDebugger; // arrays Procedure TestArray_Dynamic; @@ -7082,30 +7081,6 @@ begin ])); end; -procedure TTestModule.TestDebugger; -begin - StartProgram(false); - Add([ - 'procedure DoIt;', - 'begin', - ' deBugger;', - ' DeBugger();', - 'end;', - 'begin', - ' Debugger;']); - ConvertProgram; - CheckSource('TestDebugger', - LinesToStr([ // statements - 'this.DoIt = function () {', - ' debugger;', - ' debugger;', - '};', - '']), - LinesToStr([ // $mod.$main - 'debugger;', - ''])); -end; - procedure TTestModule.TestArray_Dynamic; begin StartProgram(false); From 1fba127e21646e542861ad74f295e657e22319c9 Mon Sep 17 00:00:00 2001 From: michael Date: Mon, 3 Dec 2018 19:42:25 +0000 Subject: [PATCH 15/21] * Fix tests after latest batch of changes git-svn-id: trunk@40460 - --- packages/pastojs/tests/tcunitsearch.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/packages/pastojs/tests/tcunitsearch.pas b/packages/pastojs/tests/tcunitsearch.pas index 831ed0a35a..e0cedea74b 100644 --- a/packages/pastojs/tests/tcunitsearch.pas +++ b/packages/pastojs/tests/tcunitsearch.pas @@ -29,14 +29,14 @@ uses fpcunit, testregistry, PScanner, PasTree, {$IFDEF CheckPasTreeRefCount}PasResolveEval,{$ENDIF} - Pas2jsFileUtils, Pas2jsCompiler, Pas2jsFileCache, Pas2jsLogger, + Pas2jsFileUtils, Pas2jsCompiler, Pas2jsfsCompiler, Pas2jsFileCache, Pas2jsLogger, tcmodules; type { TTestCompiler } - TTestCompiler = class(TPas2jsCompiler) + TTestCompiler = class(TPas2jsFSCompiler) private FExitCode: longint; protected @@ -229,7 +229,7 @@ begin {$ENDIF} FCompiler:=TTestCompiler.Create; Compiler.Log.OnLog:=@DoLog; - Compiler.FileCache.DirectoryCache.OnReadDirectory:=@OnReadDirectory; + Compiler.FileCache.OnReadDirectory:=@OnReadDirectory; Compiler.FileCache.OnReadFile:=@OnReadFile; Compiler.FileCache.OnWriteFile:=@OnWriteFile; end; From 78b3b8ee4e5bfa2cd92e65b70b413c1ea0f3cb2e Mon Sep 17 00:00:00 2001 From: michael Date: Mon, 3 Dec 2018 21:46:36 +0000 Subject: [PATCH 16/21] * Modifications so it compiles for target browser git-svn-id: trunk@40461 - --- packages/pastojs/src/pas2js_defines.inc | 5 ++ packages/pastojs/src/pas2jscompiler.pp | 69 ++++++++++++++++++++----- packages/pastojs/src/pas2jsfs.pp | 3 +- packages/pastojs/src/pas2jslogger.pp | 69 +++++++++++++++++++++---- 4 files changed, 123 insertions(+), 23 deletions(-) diff --git a/packages/pastojs/src/pas2js_defines.inc b/packages/pastojs/src/pas2js_defines.inc index ceb8d559b8..763a4911f3 100644 --- a/packages/pastojs/src/pas2js_defines.inc +++ b/packages/pastojs/src/pas2js_defines.inc @@ -19,6 +19,11 @@ {$DEFINE UTF8_RTL} {$DEFINE HasStdErr} {$DEFINE HasPas2jsFiler} + {$DEFINE HASFILESYSTEM} +{$ENDIF} + +{$IFDEF NODEJS} +{$DEFINE HASFILESYSTEM} {$ENDIF} diff --git a/packages/pastojs/src/pas2jscompiler.pp b/packages/pastojs/src/pas2jscompiler.pp index 09f925c6ad..4094750225 100644 --- a/packages/pastojs/src/pas2jscompiler.pp +++ b/packages/pastojs/src/pas2jscompiler.pp @@ -545,6 +545,14 @@ type procedure RegisterMessages; procedure SetAllJSIntoMainJS(AValue: Boolean); protected + // Create various other classes. Virtual so they can be overridden in descendents + function CreateJSMapper: TPas2JSMapper;virtual; + function CreateJSWriter(aFileWriter: TPas2JSMapper): TJSWriter; virtual; + function CreateLog: TPas2jsLogger; virtual; + function CreateMacroEngine: TPas2jsMacroEngine;virtual; + function CreateSrcMap(const aFileName: String): TPas2JSSrcMap; virtual; + function CreateOptimizer: TPas2JSWPOptimizer; + // These are mandatory ! function CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet; virtual; abstract; function CreateFS : TPas2JSFS; virtual; abstract; Function FormatPath(Const aPath : String) : String; @@ -1906,12 +1914,18 @@ begin Result:=aFile.NeedBuild; end; +Function TPas2jsCompiler.CreateOptimizer : TPas2JSWPOptimizer; + +begin + Result:=TPas2JSWPOptimizer.Create; +end; + procedure TPas2jsCompiler.OptimizeProgram(aFile: TPas2jsCompilerFile); begin if not AllJSIntoMainJS then exit; if coKeepNotUsedDeclarationsWPO in Options then exit; if not (aFile.PasModule is TPasProgram) then exit; - FWPOAnalyzer:=TPas2JSWPOptimizer.Create; + FWPOAnalyzer:=CreateOptimizer; FWPOAnalyzer.Resolver:=aFile.PascalResolver; FWPOAnalyzer.Options:=FWPOAnalyzer.Options+[paoOnlyExports]; FWPOAnalyzer.AnalyzeWholeProgram(TPasProgram(aFile.PasModule)); @@ -2004,6 +2018,24 @@ begin if aWriter=nil then ; end; +Function TPas2jsCompiler.CreateJSWriter(aFileWriter: TPas2JSMapper): TJSWriter; + +begin + Result:=TJSWriter.Create(aFileWriter); +end; + +Function TPas2JSCompiler.CreateJSMapper : TPas2JSMapper; + +begin + Result:=TPas2JSMapper.Create(4096); +end; + +Function TPas2JSCompiler.CreateSrcMap(Const aFileName : String) : TPas2JSSrcMap; + +begin + Result:=TPas2JSSrcMap.Create(aFileName); +end; + procedure TPas2jsCompiler.WriteJSFiles(aFile: TPas2jsCompilerFile; var CombinedFileWriter: TPas2JSMapper; Checked: TPasAnalyzerKeySet); @@ -2031,11 +2063,11 @@ var var SrcMap: TPas2JSSrcMap; begin - aFileWriter:=TPas2JSMapper.Create(4096); + aFileWriter:=CreateJSMapper; FreeWriter:=true; if SrcMapEnable then begin - SrcMap:=TPas2JSSrcMap.Create(ExtractFilename(aFilename)); + SrcMap:=CreateSrcMap(ExtractFilename(aFilename)); aFileWriter.SrcMap:=SrcMap; SrcMap.Release;// release the refcount from the Create SrcMap.SourceRoot:=SrcMapSourceRoot; @@ -2091,7 +2123,7 @@ begin end; // write JavaScript - aJSWriter:=TJSWriter.Create(aFileWriter); + aJSWriter:=CreateJSWriter(aFileWriter); aJSWriter.Options:=DefaultJSWriterOptions; aJSWriter.IndentSize:=2; try @@ -2146,12 +2178,12 @@ begin // check output directory DestDir:=ChompPathDelim(ExtractFilePath(DestFilename)); - if (DestDir<>'') and not DirectoryExists(DestDir) then + if (DestDir<>'') and not FS.DirectoryExists(DestDir) then begin Log.LogMsg(nOutputDirectoryNotFound,[FullFormatPath(DestDir)]); Terminate(ExitCodeFileNotFound); end; - if DirectoryExists(DestFilename) then + if FS.DirectoryExists(DestFilename) then begin Log.LogMsg(nFileIsFolder,[FullFormatPath(DestFilename)]); Terminate(ExitCodeWriteError); @@ -3593,28 +3625,39 @@ begin Result:=QuoteStr(FormatPath(aPath)); end; +Function TPas2jsCompiler.CreateMacroEngine : TPas2jsMacroEngine; + +begin + Result:=TPas2jsMacroEngine.Create; +end; + +Function TPas2jsCompiler.CreateLog : TPas2jsLogger; + +begin + Result:=TPas2jsLogger.Create; +end; constructor TPas2jsCompiler.Create; + begin FOptions:=DefaultP2jsCompilerOptions; FNamespaces:=TStringList.Create; - FLog:=TPas2jsLogger.Create; - FParamMacros:=TPas2jsMacroEngine.Create; - RegisterMessages; + FDefines:=TStringList.Create; FInsertFilenames:=TStringList.Create; + FLog:=CreateLog; + FLog.OnFormatPath:=@FormatPath; + FParamMacros:=CreateMacroEngine; + RegisterMessages; FS:=CreateFS; FOwnsFS:=true; - FLog.OnFormatPath:=@FormatPath; - FDefines:=TStringList.Create; // Done by Reset: TStringList(FDefines).Sorted:=True; // Done by Reset: TStringList(FDefines).Duplicates:=dupError; - //FConditionEval.OnEvalFunction:=@ConditionEvalFunction; FFiles:=CreateSetOfCompilerFiles(kcFilename); - FReadingModules:=TFPList.Create; FUnits:=CreateSetOfCompilerFiles(kcUnitName); + FReadingModules:=TFPList.Create; InitParamMacros; Reset; end; diff --git a/packages/pastojs/src/pas2jsfs.pp b/packages/pastojs/src/pas2jsfs.pp index cde85aba59..f7321575ce 100644 --- a/packages/pastojs/src/pas2jsfs.pp +++ b/packages/pastojs/src/pas2jsfs.pp @@ -22,6 +22,7 @@ unit pas2jsfs; {$mode objfpc}{$H+} +{$I pas2js_defines.inc} interface @@ -153,7 +154,7 @@ Type { TPas2jsFSResolver } - TPas2jsFSResolver = class(TFileResolver) + TPas2jsFSResolver = class({$IFDEF HASFILESYSTEM}TFileResolver{$ELSE}TBaseFileResolver{$ENDIF}) private FFS: TPas2jsFS; public diff --git a/packages/pastojs/src/pas2jslogger.pp b/packages/pastojs/src/pas2jslogger.pp index 73d59e3694..e68680b168 100644 --- a/packages/pastojs/src/pas2jslogger.pp +++ b/packages/pastojs/src/pas2jslogger.pp @@ -28,10 +28,13 @@ interface uses {$IFDEF Pas2JS} - JS, NodeJSFS, + JS, {$ENDIF} - Classes, SysUtils, PasTree, PScanner, jstree, jsbase, jswriter, fpjson, - Pas2jsFileUtils; + pas2jsutils, + {$IFDEF HASFILESYSTEM} + pas2jsfileutils, + {$ENDIF} + Classes, SysUtils, PasTree, PScanner, jstree, jsbase, jswriter, fpjson; const ExitCodeErrorInternal = 1; // internal error @@ -95,6 +98,16 @@ type TPas2jsLogEvent = Procedure (Sender : TObject; Const Msg : String) Of Object; + + { TConsoleFileWriter } + + TConsoleFileWriter = Class(TTextWriter) + Public + Constructor Create(aFileName : String); reintroduce; + Function DoWrite(Const S : TJSWriterString) : Integer; override; + Procedure Flush; + end; + { TPas2jsLogger } TPas2jsLogger = class @@ -111,7 +124,7 @@ type FMsg: TFPList; // list of TPas2jsMessage FOnFormatPath: TPScannerFormatPathEvent; FOnLog: TPas2jsLogEvent; - FOutputFile: TFileWriter; + FOutputFile: TTextWriter; // TFileWriter; FOutputFilename: string; FShowMsgNumbers: boolean; FShowMsgTypes: TMessageTypes; @@ -129,6 +142,9 @@ type procedure SetSorted(AValue: boolean); procedure DoLogRaw(const Msg: string; SkipEncoding : Boolean); function Concatenate(Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF}): string; + Protected + // so it can be overridden + function CreateTextWriter(const aFileName: string): TTextWriter; virtual; public constructor Create; destructor Destroy; override; @@ -484,6 +500,27 @@ begin end; end; +{ TConsoleFileWriter } + +constructor TConsoleFileWriter.Create(aFileName: String); +begin + Inherited Create; + Write('Opening console log: '+aFileName); +end; + +Function TConsoleFileWriter.DoWrite(Const S : TJSWriterString) : Integer; + +begin + Result:=Length(S); + Writeln(S); +end; + +procedure TConsoleFileWriter.FLush; + +begin +end; + + {$IFDEF Pas2JS} { TPas2jsFileStream } @@ -1017,14 +1054,26 @@ begin end; end; +Function TPas2jsLogger.CreateTextWriter(const aFileName : string) : TTextWriter; + +begin +{$IFDEF HASFILESYSTEM} + Result:=TFileWriter.Create(aFilename); +{$ELSE} + Result:=TConsoleFileWriter.Create(aFileName); +{$ENDIF} +end; + procedure TPas2jsLogger.OpenOutputFile; begin +{$IFDEF HASFILESYSTEM} if FOutputFile<>nil then exit; if OutputFilename='' then raise Exception.Create('Log has empty OutputFilename'); - if DirectoryExists(OutputFilename) then + if DirectoryExists(OutputFilename) then raise Exception.Create('Log is directory: "'+OutputFilename+'"'); - FOutputFile:=TFileWriter.Create(OutputFilename); +{$ENDIF} + FOutputFile:=CreateTextWriter(OutputFileName); {$IFDEF FPC_HAS_CPSTRING} if (Encoding='') or (Encoding='utf8') then FOutputFile.Write(UTF8BOM); @@ -1033,14 +1082,16 @@ end; procedure TPas2jsLogger.Flush; begin - if FOutputFile<>nil then - FOutputFile.Flush; +{$IFDEF HASFILESYSTEM} + if Assigned(FOutputFile) and (FoutputFile is TFileWriter) then + TFileWriter(FOutputFile).Flush; +{$ENDIF} end; procedure TPas2jsLogger.CloseOutputFile; begin if FOutputFile=nil then exit; - FOutputFile.Flush; + Flush; FreeAndNil(FOutputFile); end; From 1cc3c199c854b052f820a6219fd1d86b6778ea6e Mon Sep 17 00:00:00 2001 From: yury Date: Tue, 4 Dec 2018 13:07:05 +0000 Subject: [PATCH 17/21] * pas2jni: TClass helper must be generated only for the system unit. git-svn-id: trunk@40462 - --- utils/pas2jni/writer.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/pas2jni/writer.pas b/utils/pas2jni/writer.pas index fd719348bc..784957b7ad 100644 --- a/utils/pas2jni/writer.pas +++ b/utils/pas2jni/writer.pas @@ -2075,7 +2075,7 @@ begin end; // Class ref helpers - if FClasses.IndexOf('system.TClass', nil) >= 0 then begin + if (u.Name = 'system') and (FClasses.IndexOf('system.TClass', nil) >= 0) then begin Fjs.WriteLn('native static long GetClassRef(int index);'); AddNativeMethod(u, '_GetClassRef', 'GetClassRef', '(I)J'); Fjs.WriteLn('static TClass GetTClass(int index) { TClass c = new TClass(null); c._pasobj=GetClassRef(index); return c; }'); From 2109612fa3bbc7feffcae2c52a7661e65eed250a Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Tue, 4 Dec 2018 19:53:13 +0000 Subject: [PATCH 18/21] - disable cs_opt_use_load_modify_store because for llvm because it is apparently buggy as far as type information is concerned, and it also results in tons of spilling git-svn-id: trunk@40463 - --- compiler/globtype.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/globtype.pas b/compiler/globtype.pas index 780da9b6aa..f883227ca1 100644 --- a/compiler/globtype.pas +++ b/compiler/globtype.pas @@ -392,7 +392,7 @@ interface { switches being applied to all CPUs at the given level } genericlevel1optimizerswitches = [cs_opt_level1,cs_opt_peephole]; genericlevel2optimizerswitches = [cs_opt_level2,cs_opt_remove_emtpy_proc]; - genericlevel3optimizerswitches = [cs_opt_level3,cs_opt_constant_propagate,cs_opt_nodedfa,cs_opt_use_load_modify_store,cs_opt_loopunroll]; + genericlevel3optimizerswitches = [cs_opt_level3,cs_opt_constant_propagate,cs_opt_nodedfa{$ifndef llvm},cs_opt_use_load_modify_store{$endif},cs_opt_loopunroll]; genericlevel4optimizerswitches = [cs_opt_level4,cs_opt_reorder_fields,cs_opt_dead_values,cs_opt_fastmath]; { whole program optimizations whose information generation requires From b7da7cd654a752872057bd48ac17628665750aa1 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Tue, 4 Dec 2018 19:53:16 +0000 Subject: [PATCH 19/21] * ensure the generic version of tcgshlshrnode gets used for llvm git-svn-id: trunk@40464 - --- compiler/llvm/nllvmmat.pas | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/llvm/nllvmmat.pas b/compiler/llvm/nllvmmat.pas index d2f08226df..539cdd0dc0 100644 --- a/compiler/llvm/nllvmmat.pas +++ b/compiler/llvm/nllvmmat.pas @@ -34,6 +34,9 @@ type procedure pass_generate_code; override; end; + tllvmshlshrnode = class(tcgshlshrnode) + end; + Tllvmunaryminusnode = class(tcgunaryminusnode) procedure emit_float_sign_change(r: tregister; _size : tdef);override; end; @@ -154,9 +157,7 @@ end; begin cmoddivnode := tllvmmoddivnode; -(* cshlshrnode := tllvmshlshrnode; -*) cnotnode := tllvmnotnode; cunaryminusnode := Tllvmunaryminusnode; end. From 122d0d36d61c25a5a879591b2923e1f904896de1 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Tue, 4 Dec 2018 19:53:20 +0000 Subject: [PATCH 20/21] + volatile() expression that marks an expression as volatile * disable matching volatile references in the assembler optimisers, so they can't be removed (more conservative than needed, but better than removing too many) o the CSE optimiser will ignore them by default, because they're an unknown inline node for it * also removed no longer used fpc_in_move_x and fpc_in_fillchar_x inline node identifiers from rtl/inc/innr.inc, and placed fpc_in_unaligned_x at the right place git-svn-id: trunk@40465 - --- compiler/aoptobj.pas | 5 ++++- compiler/arm/aoptcpu.pas | 4 +++- compiler/avr/aoptcpu.pas | 4 +++- compiler/compinnr.pas | 1 + compiler/m68k/aoptcpu.pas | 4 +++- compiler/ncginl.pas | 7 +++++++ compiler/ninl.pas | 9 ++++++++- compiler/nutils.pas | 1 + compiler/pexpr.pas | 3 ++- compiler/psystem.pas | 1 + compiler/x86/aoptx86.pas | 10 +++++++--- rtl/inc/innr.inc | 4 ++-- 12 files changed, 42 insertions(+), 11 deletions(-) diff --git a/compiler/aoptobj.pas b/compiler/aoptobj.pas index d4c6ffe06f..99ca8c3e81 100644 --- a/compiler/aoptobj.pas +++ b/compiler/aoptobj.pas @@ -1059,7 +1059,10 @@ Unit AoptObj; Top_Reg : OpsEqual:=o1.reg=o2.reg; Top_Ref : - OpsEqual := references_equal(o1.ref^, o2.ref^); + OpsEqual:= + references_equal(o1.ref^, o2.ref^) and + (o1.ref^.volatility=[]) and + (o2.ref^.volatility=[]); Top_Const : OpsEqual:=o1.val=o2.val; Top_None : diff --git a/compiler/arm/aoptcpu.pas b/compiler/arm/aoptcpu.pas index 5489fd856b..1e58a01d9b 100644 --- a/compiler/arm/aoptcpu.pas +++ b/compiler/arm/aoptcpu.pas @@ -117,7 +117,9 @@ Implementation (r1.signindex = r2.signindex) and (r1.shiftimm = r2.shiftimm) and (r1.addressmode = r2.addressmode) and - (r1.shiftmode = r2.shiftmode); + (r1.shiftmode = r2.shiftmode) and + (r1.volatility=[]) and + (r2.volatility=[]); end; function MatchInstruction(const instr: tai; const op: TCommonAsmOps; const cond: TAsmConds; const postfix: TOpPostfixes): boolean; diff --git a/compiler/avr/aoptcpu.pas b/compiler/avr/aoptcpu.pas index 3a182be179..e938b26e55 100644 --- a/compiler/avr/aoptcpu.pas +++ b/compiler/avr/aoptcpu.pas @@ -75,7 +75,9 @@ Implementation (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and (r1.relsymbol = r2.relsymbol) and - (r1.addressmode = r2.addressmode); + (r1.addressmode = r2.addressmode) and + (r1.volatility=[]) and + (r2.volatility=[]); end; diff --git a/compiler/compinnr.pas b/compiler/compinnr.pas index cda8a0fafd..fd94ac3056 100644 --- a/compiler/compinnr.pas +++ b/compiler/compinnr.pas @@ -117,6 +117,7 @@ type in_not_assign_x = 95, in_gettypekind_x = 96, in_faraddr_x = 97, + in_volatile_x = 98, { Internal constant functions } in_const_sqr = 100, diff --git a/compiler/m68k/aoptcpu.pas b/compiler/m68k/aoptcpu.pas index 896d8bd6d3..3f88d2bfba 100644 --- a/compiler/m68k/aoptcpu.pas +++ b/compiler/m68k/aoptcpu.pas @@ -65,7 +65,9 @@ unit aoptcpu; (r1.base = r2.base) and (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and - (r1.relsymbol = r2.relsymbol); + (r1.relsymbol = r2.relsymbol) and + (r1.volatility=[]) and + (r2.volatility=[]); end; function MatchOperand(const oper1: TOper; const oper2: TOper): boolean; diff --git a/compiler/ncginl.pas b/compiler/ncginl.pas index 7a58ee4da4..e059af8949 100644 --- a/compiler/ncginl.pas +++ b/compiler/ncginl.pas @@ -164,6 +164,13 @@ implementation if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then location.reference.alignment:=resultdef.alignment; end; + in_volatile_x: + begin + secondpass(tcallparanode(left).left); + location:=tcallparanode(left).left.location; + if location.loc in [LOC_CREFERENCE,LOC_REFERENCE,LOC_SUBSETREF,LOC_CSUBSETREF] then + location.reference.volatility:=[vol_read,vol_write]; + end; {$ifdef SUPPORT_MMX} in_mmx_pcmpeqb..in_mmx_pcmpgtw: begin diff --git a/compiler/ninl.pas b/compiler/ninl.pas index 585159fd67..05baedb0b1 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -3548,6 +3548,12 @@ implementation begin resultdef:=left.resultdef; end; + in_volatile_x: + begin + resultdef:=left.resultdef; + { volatile only makes sense if the value is in memory } + make_not_regable(left,[ra_addr_regable]); + end; in_assert_x_y : begin resultdef:=voidtype; @@ -4037,7 +4043,8 @@ implementation expectloc:=LOC_VOID; end; in_aligned_x, - in_unaligned_x: + in_unaligned_x, + in_volatile_x: begin expectloc:=tcallparanode(left).left.expectloc; end; diff --git a/compiler/nutils.pas b/compiler/nutils.pas index fff2bdf17c..274be0653d 100644 --- a/compiler/nutils.pas +++ b/compiler/nutils.pas @@ -891,6 +891,7 @@ implementation in_abs_real, in_aligned_x, in_unaligned_x, + in_volatile_x, in_prefetch_var: begin inc(result); diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 861a5c894c..459d89a385 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -515,7 +515,8 @@ implementation end; in_aligned_x, - in_unaligned_x : + in_unaligned_x, + in_volatile_x: begin err:=false; consume(_LKLAMMER); diff --git a/compiler/psystem.pas b/compiler/psystem.pas index eb310d3542..a6e2ba45b5 100644 --- a/compiler/psystem.pas +++ b/compiler/psystem.pas @@ -103,6 +103,7 @@ implementation {$endif SUPPORT_GET_FRAME} systemunit.insert(csyssym.create('Unaligned',in_unaligned_x)); systemunit.insert(csyssym.create('Aligned',in_aligned_x)); + systemunit.insert(csyssym.create('Volatile',in_volatile_x)); systemunit.insert(csyssym.create('ObjCSelector',in_objc_selector_x)); { objc only } systemunit.insert(csyssym.create('ObjCEncode',in_objc_encode_x)); { objc only } systemunit.insert(csyssym.create('Default',in_default_x)); diff --git a/compiler/x86/aoptx86.pas b/compiler/x86/aoptx86.pas index 8e95cc7106..ff31674508 100644 --- a/compiler/x86/aoptx86.pas +++ b/compiler/x86/aoptx86.pas @@ -218,7 +218,9 @@ unit aoptx86; (r1.segment = r2.segment) and (r1.base = r2.base) and (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and - (r1.relsymbol = r2.relsymbol); + (r1.relsymbol = r2.relsymbol) and + (r1.volatility=[]) and + (r2.volatility=[]); end; @@ -232,7 +234,8 @@ unit aoptx86; ((base=NR_INVALID) or (ref.base=base)) and ((index=NR_INVALID) or - (ref.index=index)); + (ref.index=index)) and + (ref.volatility=[]); end; @@ -245,7 +248,8 @@ unit aoptx86; ((base=NR_INVALID) or (ref.base=base)) and ((index=NR_INVALID) or - (ref.index=index)); + (ref.index=index)) and + (ref.volatility=[]); end; diff --git a/rtl/inc/innr.inc b/rtl/inc/innr.inc index e461cdc735..7207644c27 100644 --- a/rtl/inc/innr.inc +++ b/rtl/inc/innr.inc @@ -62,8 +62,7 @@ const fpc_in_leave = 51; {macpas} fpc_in_cycle = 52; {macpas} fpc_in_slice = 53; - fpc_in_move_x = 54; - fpc_in_fillchar_x = 55; + fpc_in_unaligned_x = 54; fpc_in_get_frame = 56; fpc_in_get_caller_addr = 57; fpc_in_get_caller_frame = 58; @@ -105,6 +104,7 @@ const fpc_in_neg_assign_x = 94; fpc_in_not_assign_x = 95; fpc_in_faraddr_x = 97; + fpc_in_volatile_x = 98; { Internal constant functions } fpc_in_const_sqr = 100; From 8846041b2358ad39ae0872417ba5b6ca3b24e8a7 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Tue, 4 Dec 2018 19:53:23 +0000 Subject: [PATCH 21/21] * use volatile() to prevent wrong optimizations by llvm git-svn-id: trunk@40466 - --- tests/test/tmt1.pp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/test/tmt1.pp b/tests/test/tmt1.pp index 243904fb07..b2992963ed 100644 --- a/tests/test/tmt1.pp +++ b/tests/test/tmt1.pp @@ -55,7 +55,7 @@ begin if BeginThread({$ifdef fpc}@{$endif}f,pointer(i)) <> tthreadid(0) then inc(started); - while finished