From fd609fe19cba7f538abddd54d91b1e5dd644a173 Mon Sep 17 00:00:00 2001 From: michael Date: Tue, 4 Dec 2018 21:42:53 +0000 Subject: [PATCH] * Web browser compiler, initial implementation git-svn-id: trunk@40471 - --- .gitattributes | 2 + utils/pas2js/pas2js.lpi | 34 +- utils/pas2js/pas2jswebcompiler.pp | 97 ++++++ utils/pas2js/webfilecache.pp | 529 ++++++++++++++++++++++++++++++ 4 files changed, 661 insertions(+), 1 deletion(-) create mode 100644 utils/pas2js/pas2jswebcompiler.pp create mode 100644 utils/pas2js/webfilecache.pp diff --git a/.gitattributes b/.gitattributes index b77d75d327..8e10619308 100644 --- a/.gitattributes +++ b/.gitattributes @@ -17449,6 +17449,7 @@ utils/pas2js/pas2js.lpi svneol=native#text/plain utils/pas2js/pas2js.pp svneol=native#text/plain utils/pas2js/pas2jslib.lpi svneol=native#text/plain utils/pas2js/pas2jslib.pp svneol=native#text/plain +utils/pas2js/pas2jswebcompiler.pp svneol=native#text/plain utils/pas2js/samples/arraydemo.pp svneol=native#text/plain utils/pas2js/samples/fordemo.pp svneol=native#text/plain utils/pas2js/samples/fordowndemo.pp svneol=native#text/plain @@ -17456,6 +17457,7 @@ utils/pas2js/samples/hello.pas svneol=native#text/plain utils/pas2js/samples/ifdemo.pp svneol=native#text/plain utils/pas2js/samples/repeatdemo.pp svneol=native#text/plain utils/pas2js/samples/whiledemo.pp svneol=native#text/plain +utils/pas2js/webfilecache.pp svneol=native#text/plain utils/pas2js/webidl2pas.lpi svneol=native#text/plain utils/pas2js/webidl2pas.pp svneol=native#text/plain utils/pas2ut/Makefile svneol=native#text/plain diff --git a/utils/pas2js/pas2js.lpi b/utils/pas2js/pas2js.lpi index 35bdb9e568..b5f4541f8c 100644 --- a/utils/pas2js/pas2js.lpi +++ b/utils/pas2js/pas2js.lpi @@ -21,17 +21,43 @@ + + + + + + - + + + + + + + + + + + + + + + + + + + + + @@ -49,6 +75,12 @@ + + + diff --git a/utils/pas2js/pas2jswebcompiler.pp b/utils/pas2js/pas2jswebcompiler.pp new file mode 100644 index 0000000000..1e2b085758 --- /dev/null +++ b/utils/pas2js/pas2jswebcompiler.pp @@ -0,0 +1,97 @@ +unit pas2jswebcompiler; + +{$mode objfpc} + +interface + +uses + Classes, SysUtils, pas2jsfs, pasuseanalyzer, pas2jscompiler, FPPJsSrcMap, webfilecache; + +Type + + { TPas2JSWebcompiler } + + TPas2JSWebcompiler = Class(TPas2JSCompiler) + private + function GetWebFS: TPas2JSWebFS; + Protected + function DoWriteJSFile(const DestFilename: String; aWriter: TPas2JSMapper): Boolean; override; + function CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet; override; + function CreateFS : TPas2JSFS; override; + Public + Property WebFS : TPas2JSWebFS read GetWebFS; + end; + +implementation + +uses js; + +function Pas2jsCompilerFile_FilenameToKeyName(Item: Pointer): String; +var + aFile: TPas2jsCompilerFile absolute Item; +begin + Result:=LowerCase(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; + +function PtrFilenameToKeyName(FilenameAsPtr: Pointer): string; +var + Filename: String absolute FilenameAsPtr; +begin + Result:=LowerCase(Filename); +end; + + +{ TPas2JSWebcompiler } + +function TPas2JSWebcompiler.GetWebFS: TPas2JSWebFS; +begin + Result:=TPas2JSWebFS(FS) +end; + +function TPas2JSWebcompiler.DoWriteJSFile(const DestFilename: String; aWriter: TPas2JSMapper): Boolean; + +Var + S : String; + T : String; + +begin +// Writeln('aWriter',AWriter.BufferLength,', array size ',Length(AWriter.Buffer)); + S:=TJSArray(AWriter.Buffer).Join(''); +// Writeln('TPas2JSWebcompiler.DoWriteJSFile(',DestFileName,') (',Length(S),' chars): ',S); + WebFS.SetFileContent(DestFileName,S); + Result:=True; +end; + +function TPas2JSWebcompiler.CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet; +begin + Case keyType of + kcFileName: + Result:=TPasAnalyzerKeySet.Create(@Pas2jsCompilerFile_FilenameToKeyName,@PtrFilenameToKeyName); + kcUnitName: + Result:=TPasAnalyzerKeySet.Create(@Pas2jsCompilerFile_UnitnameToKeyName,@PtrUnitnameToKeyName); + else + Raise EPas2jsFS.CreateFmt('Internal Unknown key type: %d',[Ord(KeyType)]); + end; +end; + +function TPas2JSWebcompiler.CreateFS: TPas2JSFS; +begin + Result:=TPas2JSWebFS.Create; +end; + +end. + diff --git a/utils/pas2js/webfilecache.pp b/utils/pas2js/webfilecache.pp new file mode 100644 index 0000000000..fcd76cd6a0 --- /dev/null +++ b/utils/pas2js/webfilecache.pp @@ -0,0 +1,529 @@ +unit webfilecache; + +{$mode objfpc} + +// Enable this to write lots of debugging info to the browser console. +{ $DEFINE VERBOSEWEBCACHE} + +interface + +uses + Classes, SysUtils, JS, Web, fpjson, pas2jsfs, pscanner, contnrs; + +type + TPas2jsWebFS = Class; + + { TWebFileContent } + + TWebFileContent = Class(TObject) + private + FContents: string; + FFileName: String; + FModified: Boolean; + procedure SetContents(AValue: string); + Public + Constructor Create(const aFileName,aContents : String); + Property FileName : String Read FFileName Write FFileName; + Property Contents : string Read FContents Write SetContents; + Property Modified : Boolean Read FModified; + end; + { TWebFilesCache } + + TWebFilesCache = Class(TObject) + Private + FFiles : TFPObjectHashTable; + Function FindFile(aFileName : String) : TWebFileContent; + Public + Constructor Create; + Destructor Destroy; override; + Function HasFile(aFileName : String) : Boolean; + Function GetFileContent(Const aFileName : String) : String; + function SetFileContent(const aFileName, aContent: String): Boolean; + end; + + { TPas2jsWebFile } + + TPas2jsWebFile = Class(TPas2jsFile) + public + function CreateLineReader(RaiseOnError: boolean): TSourceLineReader; override; + function Load(RaiseOnError: boolean; Binary: boolean): boolean; override; + end; + + { TWebSourceLineReader } + + TWebSourceLineReader = Class(TSourceLineReader) + private + FFS: TPas2jsFS; + Protected + Property FS : TPas2jsFS Read FFS; + Procedure IncLineNumber; override; + end; + + // aFileName is the original filename, not normalized one + TLoadFileEvent = Reference to Procedure(Sender : TObject; aFileName : String; aError : string); + + { TLoadFileRequest } + + TLoadFileRequest = Class(TObject) + FFS : TPas2jsWebFS; + FFileName : string; + FXML : TJSXMLHttpRequest; + FOnLoaded : TLoadFileEvent; + private + procedure DoChange; + Public + constructor Create(aFS: TPas2jsWebFS; const aFileName : string; aOnLoaded: TLoadFileEvent); + Procedure DoLoad(const aURL : String); + end; + + + { TPas2jsWebFS } + + TPas2jsWebFS = Class(TPas2jsFS) + Private + FCache : TWebFilesCache; + FLoadBaseURL: String; + FOnLoadedFile: TLoadFileEvent; + protected + // Only for names, no paths + Class Function NormalizeFileName(Const aFileName : String) : String; + function FindSourceFileName(const aFilename: string): String; override; + public + Constructor Create; override; + // Overrides + function CreateResolver: TPas2jsFSResolver; override; + function FileExists(const aFileName: String): Boolean; override; + function FindCustomJSFileName(const aFilename: string): String; override; + function FindIncludeFileName(const aFilename: string): String; override; + function FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String; override; + function FindUnitJSFileName(const aUnitFilename: string): String; override; + function LoadFile(Filename: string; Binary: boolean=false): TPas2jsFile; override; + procedure SaveToFile(ms: TFPJSStream; Filename: string); override; + Function SetFileContent(Const aFileName,aContents : String) : Boolean; + Function GetFileContent(Const aFileName : String) : String; + // Returns false if the file was already loaded. OnLoaded is called in either case. + Function LoadFile(aFileName : String; OnLoaded : TLoadFileEvent = Nil) : Boolean; + // Returns number of load requests. OnLoaded is called for each file in the list + Function LoadFiles(aList : TStrings;OnLoaded : TLoadFileEvent = Nil) : Integer; + Function LoadFiles(aList : array of String;OnLoaded : TLoadFileEvent = Nil) : integer; + Property OnLoadedFile : TLoadFileEvent Read FOnLoadedFile Write FOnLoadedFile; + Property LoadBaseURL : String Read FLoadBaseURL Write FLoadBaseURL; + end; + + { TPas2jsFileResolver } + + { TPas2jsWebResolver } + + TPas2jsWebResolver = class(TPas2jsFSResolver) + private + function GetWebFS: TPas2jsWebFS; + public + Property WebFS : TPas2jsWebFS Read GetWebFS; + end; + +implementation + +{ TWebSourceLineReader } + +procedure TWebSourceLineReader.IncLineNumber; +begin + if (FFS<>nil) then + FFS.IncReadLineCounter; + inherited IncLineNumber; +end; + +{ TLoadFileRequest } + +procedure TLoadFileRequest.DoChange; + +Var + Err : String; +begin + Case FXML.readyState of + TJSXMLHttpRequest.UNSENT : ; + TJSXMLHttpRequest.OPENED : ; + TJSXMLHttpRequest.HEADERS_RECEIVED : ; + TJSXMLHttpRequest.LOADING : ; + TJSXMLHttpRequest.DONE : + begin + if (FXML.Status div 100)=2 then + begin + Err:=''; + // FS will normalize filename + FFS.SetFileContent(FFileName,FXML.responsetext) + end + else + Err:='Error loading file: '+FXML.StatusText; + If Assigned(FOnLoaded) then + FOnLoaded(FFS,FFileName,Err); + if Assigned(FFS.OnLoadedFile) then + FFS.OnLoadedFile(FFS,FFileName,Err); + Free; + end; + end +end; + +constructor TLoadFileRequest.Create(aFS: TPas2jsWebFS; const aFileName : string; aOnLoaded: TLoadFileEvent); +begin + FFS:=aFS; + FOnLoaded:=aOnLoaded; + FFileName:=aFileName; +end; + +Procedure TLoadFileRequest.DoLoad(const aURL: String); +begin + FXML:=TJSXMLHttpRequest.new; + FXML.onreadystatechange:=@DoChange; + // Maybe one day allow do this sync, so the compiler can load files on demand. + FXML.Open('GET',aURL); + FXML.Send; +end; + +{ TPas2jsWebFile } + +function TPas2jsWebFile.CreateLineReader(RaiseOnError: boolean): TSourceLineReader; +begin + {$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': Creating line reader for ',FileName); + {$ENDIF} + if Load(RaiseOnError,False) then + begin + Result:=TWebSourceLineReader.Create(FileName,Source); + TWebSourceLineReader(Result).FFS:=Self.FS; + end + else + Result:=Nil; +end; + +function TPas2jsWebFile.Load(RaiseOnError: boolean; Binary: boolean): boolean; +begin + Result:=False; + {$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': Loading for ',FileName); + {$ENDIF} + With (FS as TPas2jsWebFS).FCache do + if HasFile(FileName) then + begin + SetSource(GetFileContent(FileName)); + Result:=True; + end; + if Not Result then + if RaiseOnError then + Raise EFileNotFoundError.Create('File not loaded '+FileName) +{$IFDEF VERBOSEWEBCACHE} + else + Writeln('File not loaded '+FileName); +{$ENDIF} +end; + +{ TWebFilesCache } + +function TWebFilesCache.FindFile(aFileName: String): TWebFileContent; + +Var + N : THTCustomNode; + +begin +{$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': Looking for file : ',aFileName); +{$ENDIF} + N:=FFiles.Find(aFileName); + if N=Nil then + result:=Nil + else + Result:=TWebFileContent(THTObjectNode(N).Data); +{$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': Looking for file : ',aFileName, ': ',Assigned(Result)); +{$ENDIF} +end; + +constructor TWebFilesCache.Create; +begin + FFiles:=TFPObjectHashTable.Create(True); +end; + +destructor TWebFilesCache.Destroy; +begin + FreeAndNil(FFiles); + inherited Destroy; +end; + +function TWebFilesCache.HasFile(aFileName: String): Boolean; +begin + Result:=FindFile(aFileName)<>Nil; +{$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': HasFile(',aFileName,') : ',Result); +{$ENDIF} +end; + +function TWebFilesCache.GetFileContent(const aFileName: String): String; + +Var + W : TWebFileContent; + +begin + {$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': GetFileContent(',aFileName,')'); + {$ENDIF} + W:=FindFile(aFileName); + if Assigned(W) then + Result:=W.Contents + else + Raise EFileNotFoundError.Create('No such file '+AFileName); +end; + +function TWebFilesCache.SetFileContent(const aFileName, aContent: String) : Boolean; + +Var + W : TWebFileContent; + +begin + {$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': SetFileContent(',aFileName,')'); + {$ENDIF} + W:=FindFile(aFileName); + Result:=Assigned(W); + if Result then + W.Contents:=aContent + else + FFiles.Add(aFileName,TWebFileContent.Create(aFileName,aContent)); +end; + +{ TWebFileContent } + +procedure TWebFileContent.SetContents(AValue: string); +begin + if FContents=AValue then Exit; + FContents:=AValue; + FModified:=True; +end; + +constructor TWebFileContent.Create(const aFileName, aContents: String); +begin + FContents:=aContents; + FFileName:=aFileName; +end; + + +{ TPas2jsWebFS } + +function TPas2jsWebFS.FileExists(const aFileName: String): Boolean; +begin + {$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': FileExists(',aFileName,')'); + {$ENDIF} + Result:=FCache.HasFile(NormalizeFileName(aFileName)); + {$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': FileExists(',aFileName,') : ',Result); + {$ENDIF} +end; + +function TPas2jsWebFS.FindCustomJSFileName(const aFilename: string): String; +begin +{$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': FindCustomJSFileName(',aFileName,')'); +{$ENDIF} + Result:=NormalizeFileName(aFileName); + If not FCache.HasFile(Result) then + Result:=''; +{$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': FindCustomJSFileName(',aFileName,'): ',Result); +{$ENDIF} +end; + +function TPas2jsWebFS.FindIncludeFileName(const aFilename: string): String; +begin +{$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': FindIncludeFileName(',aFileName,')'); +{$ENDIF} + Result:=NormalizeFileName(aFileName); + If not FCache.HasFile(Result) then + Result:=''; +{$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': FindIncludeFileName(',aFileName,') : ',Result); +{$ENDIF} +end; + +class function TPas2jsWebFS.NormalizeFileName(const aFileName: String): String; +begin + Result:=LowerCase(ExtractFileName(aFileName)); +end; + +function TPas2jsWebFS.FindSourceFileName(const aFilename: string): String; +begin +{$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': FindSourceFileName(',aFileName,')'); +{$ENDIF} + Result:=NormalizeFileName(aFileName); + If not FCache.HasFile(Result) then + Result:=''; +{$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': FindSourceFileName(',aFileName,') : ',Result); +{$ENDIF} +end; + +constructor TPas2jsWebFS.Create; +begin + inherited Create; + FCache:=TWebFilesCache.Create; +end; + +function TPas2jsWebFS.CreateResolver: TPas2jsFSResolver; +begin + Result:=TPas2jsWebResolver.Create(Self); +end; + +function TPas2jsWebFS.FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String; +begin +{$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': FindUnitFileName(',aUnitName,')'); +{$ENDIF} + Result:=NormalizeFileName(aUnitName+'.pas'); + isForeign:=False; +{$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': FindUnitFileName(',aUnitName,') : ',Result); +{$ENDIF} +end; + +function TPas2jsWebFS.FindUnitJSFileName(const aUnitFilename: string): String; +begin +{$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': FindUnitJSFileName(',aUnitFileName,')'); +{$ENDIF} + Result:=NormalizeFileName(aUnitFileName); +{$IFDEF VERBOSEWEBCACHE} + Writeln(ClassName,': FindUnitJSFileName(',aUnitFileName,') : ',Result); +{$ENDIF} +end; + +function TPas2jsWebFS.LoadFile(Filename: string; Binary: boolean): TPas2jsFile; + +begin + Result:=TPas2jsWebFile.Create(Self,FileName); + Result.Load(True,False); +end; + +(* + // Check if we should not be using this instead, as the compiler outputs UTF8 ? + // Found on + // https://weblog.rogueamoeba.com/2017/02/27/javascript-correctly-converting-a-byte-array-to-a-utf-8-string/ +function stringFromUTF8Array(data) + { + const extraByteMap = [ 1, 1, 1, 1, 2, 2, 3, 0 ]; + var count = data.length; + var str = ""; + + for (var index = 0;index < count;) + { + var ch = data[index++]; + if (ch & 0x80) + { + var extra = extraByteMap[(ch >> 3) & 0x07]; + if (!(ch & 0x40) || !extra || ((index + extra) > count)) + return null; + + ch = ch & (0x3F >> extra); + for (;extra > 0;extra -= 1) + { + var chx = data[index++]; + if ((chx & 0xC0) != 0x80) + return null; + + ch = (ch << 6) | (chx & 0x3F); + } + } + + str += String.fromCharCode(ch); + } + + return str; + } +*) +procedure TPas2jsWebFS.SaveToFile(ms: TFPJSStream; Filename: string); + +Var + aContent : String; + i : Integer; + v : JSValue; + +begin + aContent:=''; + for I:=0 to MS.Length-1 do + begin + v:=MS[i]; + Writeln('Char ',i,'(',v,') : ',TJSString.fromCharCode(v)); + aContent:=aContent+TJSString.fromCharCode(MS[i]); + end; + SetFileContent(FileName,aContent); +end; + +function TPas2jsWebFS.SetFileContent(const aFileName, aContents: String): Boolean; +begin + Result:=FCache.SetFileContent(NormalizeFileName(aFileName),aContents); +end; + +function TPas2jsWebFS.GetFileContent(const aFileName: String): String; +begin + Result:=FCache.GetFileContent(NormalizeFileName(aFileName)); +end; + +function TPas2jsWebFS.LoadFile(aFileName: String; OnLoaded: TLoadFileEvent): Boolean; + +Var + FN : String; + aURL : String; + LF : TLoadFileRequest; + +begin + FN:=NormalizeFileName(aFileName); + Result:=Not FCache.HasFile(FN); + if Not result then + begin + // It is already loaded + if Assigned(OnLoaded) then + OnLoaded(Self,aFileName,'') + end + else + begin + // Not yet already loaded + aURL:=IncludeTrailingPathDelimiter(LoadBaseURL)+FN; + LF:=TLoadFileRequest.Create(Self,aFileName,OnLoaded); + LF.DoLoad(aURL); + end; +end; + +Function TPas2jsWebFS.LoadFiles(aList: TStrings; OnLoaded: TLoadFileEvent): Integer; + +Var + i: Integer; + +begin + Result:=0; + For I:=0 to aList.Count-1 do + if LoadFile(aList[i],OnLoaded) then + Inc(Result); +end; + +function TPas2jsWebFS.LoadFiles(aList: array of String; OnLoaded: TLoadFileEvent): Integer; + +Var + i: Integer; + +begin + Result:=0; + For I:=0 to Length(aList)-1 do + if LoadFile(aList[i],OnLoaded) then + Inc(Result); +end; + +{ TPas2jsWebResolver } + +function TPas2jsWebResolver.GetWebFS: TPas2jsWebFS; +begin + Result:=TPas2jsWebFS(FS) +end; + + + +end. +