--- Merging r39851 into '.':

G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/pastojs/tests/tcprecompile.pas
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/src/pas2jscompiler.pp
U    packages/pastojs/src/pas2jsfiler.pp
G    utils/pas2js/dist/rtl.js
--- Recording mergeinfo for merge of r39851 into '.':
 G   .
--- Merging r39853 into '.':
U    packages/fcl-js/src/jsbase.pp
--- Recording mergeinfo for merge of r39853 into '.':
 G   .
--- Merging r39854 into '.':
U    packages/fcl-js/src/jswriter.pp
U    packages/pastojs/tests/tcsrcmap.pas
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/pas2jscompiler.pp
U    packages/pastojs/src/pas2jslogger.pp
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r39854 into '.':
 G   .
--- Merging r39855 into '.':
U    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r39855 into '.':
 G   .
--- Merging r39856 into '.':
U    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r39856 into '.':
 G   .
--- Merging r39857 into '.':
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r39857 into '.':
 G   .
--- Merging r39898 into '.':
G    packages/fcl-js/src/jsbase.pp
G    packages/fcl-js/src/jswriter.pp
--- Recording mergeinfo for merge of r39898 into '.':
 G   .
--- Merging r39899 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r39899 into '.':
 G   .
--- Merging r39904 into '.':
U    packages/fcl-json/src/fpjson.pp
--- Recording mergeinfo for merge of r39904 into '.':
 G   .
--- Merging r39906 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r39906 into '.':
 G   .
--- Merging r39908 into '.':
U    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r39908 into '.':
 G   .
--- Merging r39919 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
U    packages/fcl-passrc/tests/tcuseanalyzer.pas
U    packages/fcl-passrc/src/pasuseanalyzer.pas
--- Recording mergeinfo for merge of r39919 into '.':
 G   .
--- Merging r39921 into '.':
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r39921 into '.':
 G   .
--- Merging r39926 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r39926 into '.':
 G   .
--- Merging r39928 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r39928 into '.':
 G   .
--- Merging r39929 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r39929 into '.':
 G   .
--- Merging r39932 into '.':
G    packages/fcl-passrc/src/pasuseanalyzer.pas
G    packages/fcl-passrc/tests/tcuseanalyzer.pas
--- Recording mergeinfo for merge of r39932 into '.':
 G   .
--- Merging r39937 into '.':
G    packages/fcl-passrc/tests/tcuseanalyzer.pas
G    packages/fcl-passrc/src/pasuseanalyzer.pas
--- Recording mergeinfo for merge of r39937 into '.':
 G   .
--- Merging r39939 into '.':
U    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r39939 into '.':
 G   .
--- Merging r39940 into '.':
U    packages/fcl-passrc/src/pasresolveeval.pas
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pparser.pp
U    packages/pastojs/tests/tcfiler.pas
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/src/pas2jsfiler.pp
--- Recording mergeinfo for merge of r39940 into '.':
 G   .
--- Merging r39942 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r39942 into '.':
 G   .
--- Merging r39944 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r39944 into '.':
 G   .
--- Merging r39946 into '.':
G    packages/fcl-passrc/src/pasresolveeval.pas
--- Recording mergeinfo for merge of r39946 into '.':
 G   .
--- Merging r39966 into '.':
G    utils/pas2js/dist/rtl.js
--- Recording mergeinfo for merge of r39966 into '.':
 G   .
--- Merging r39968 into '.':
G    packages/fcl-passrc/src/pasresolveeval.pas
--- Recording mergeinfo for merge of r39968 into '.':
 G   .
--- Merging r39974 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r39974 into '.':
 G   .
--- Merging r39975 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r39975 into '.':
 G   .
--- Merging r39976 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r39976 into '.':
 G   .
--- Merging r39977 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r39977 into '.':
 G   .
--- Merging r39979 into '.':
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r39979 into '.':
 G   .
--- Merging r39985 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r39985 into '.':
 G   .
--- Merging r40013 into '.':
G    packages/fcl-passrc/src/pasuseanalyzer.pas
G    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r40013 into '.':
 G   .
--- Merging r40018 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolveeval.pas
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r40018 into '.':
 G   .
--- Merging r40029 into '.':
G    packages/fcl-js/src/jswriter.pp
--- Recording mergeinfo for merge of r40029 into '.':
 G   .
--- Merging r40030 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r40030 into '.':
 G   .
--- Merging r40032 into '.':
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r40032 into '.':
 G   .
--- Merging r40034 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r40034 into '.':
 G   .
--- Merging r40036 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/fcl-js/src/jsbase.pp
--- Recording mergeinfo for merge of r40036 into '.':
 G   .
--- Merging r40037 into '.':
A    utils/pas2js/nodepas2js.pp
A    utils/pas2js/nodepas2js.lpi
--- Recording mergeinfo for merge of r40037 into '.':
 G   .
--- Merging r40039 into '.':
G    packages/fcl-js/src/jswriter.pp
--- Recording mergeinfo for merge of r40039 into '.':
 G   .
--- Merging r40040 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r40040 into '.':
 G   .
--- Merging r40041 into '.':
G    packages/pastojs/src/pas2jslogger.pp
U    packages/pastojs/src/pas2jsfileutils.pp
U    packages/pastojs/src/pas2jsfilecache.pp
U    packages/pastojs/src/pas2js_defines.inc
U    packages/pastojs/src/pas2jsfileutilswin.inc
G    packages/pastojs/src/pas2jscompiler.pp
A    packages/pastojs/src/pas2jsfileutilsnodejs.inc
U    packages/pastojs/src/pas2jsfileutilsunix.inc
--- Recording mergeinfo for merge of r40041 into '.':
 G   .
--- Merging r40042 into '.':
U    utils/pas2js/pas2js.pp
U    utils/pas2js/nodepas2js.pp
--- Recording mergeinfo for merge of r40042 into '.':
 G   .
--- Merging r40043 into '.':
G    packages/pastojs/src/pas2jsfileutils.pp
--- Recording mergeinfo for merge of r40043 into '.':
 G   .
--- Merging r40044 into '.':
U    packages/pastojs/src/pas2jspparser.pp
G    packages/pastojs/src/pas2jslogger.pp
G    packages/pastojs/src/pas2jsfileutils.pp
G    utils/pas2js/nodepas2js.pp
--- Recording mergeinfo for merge of r40044 into '.':
 G   .
--- Merging r40045 into '.':
G    utils/pas2js/nodepas2js.pp
U    packages/fcl-json/src/jsonscanner.pp
--- Recording mergeinfo for merge of r40045 into '.':
 G   .
--- Merging r40046 into '.':
G    packages/pastojs/src/pas2jsfileutilswin.inc
--- Recording mergeinfo for merge of r40046 into '.':
 G   .
--- Merging r40047 into '.':
G    packages/pastojs/src/pas2jsfileutilswin.inc
--- Recording mergeinfo for merge of r40047 into '.':
 G   .
--- Merging r40048 into '.':
G    packages/fcl-js/src/jssrcmap.pas
G    utils/pas2js/nodepas2js.pp
--- Recording mergeinfo for merge of r40048 into '.':
 G   .
--- Merging r40049 into '.':
G    packages/pastojs/src/pas2jsfileutils.pp
G    packages/pastojs/src/pas2jsfiler.pp
G    packages/pastojs/src/pas2jsfilecache.pp
U    packages/pastojs/src/fppjssrcmap.pp
G    packages/pastojs/src/pas2js_defines.inc
G    utils/pas2js/nodepas2js.pp
--- Recording mergeinfo for merge of r40049 into '.':
 G   .
--- Merging r40051 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r40051 into '.':
 G   .
--- Merging r40053 into '.':
G    packages/pastojs/src/pas2jsfilecache.pp
G    packages/pastojs/src/fppjssrcmap.pp
--- Recording mergeinfo for merge of r40053 into '.':
 G   .
--- Merging r40055 into '.':
G    packages/fcl-json/src/fpjson.pp
U    packages/fcl-json/tests/testjsondata.pp
--- Recording mergeinfo for merge of r40055 into '.':
 G   .
--- Merging r40058 into '.':
U    packages/fcl-json/tests/testjsonparser.pp
U    packages/fcl-json/tests/testjson.pp
U    packages/fcl-json/tests/testjson.lpi
G    packages/fcl-json/tests/testjsondata.pp
G    packages/fcl-json/src/fpjson.pp
G    packages/fcl-json/src/jsonscanner.pp
--- Recording mergeinfo for merge of r40058 into '.':
 G   .
--- Merging r40061 into '.':
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r40061 into '.':
 G   .
--- Merging r40062 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/src/pas2jscompiler.pp
G    packages/pastojs/src/pas2jspparser.pp
G    packages/pastojs/src/pas2jsfileutils.pp
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/tests/tcfiler.pas
G    utils/pas2js/nodepas2js.pp
U    utils/pas2js/docs/translation.html
--- Recording mergeinfo for merge of r40062 into '.':
 G   .
--- Merging r40064 into '.':
G    packages/pastojs/src/pas2jscompiler.pp
U    packages/pastojs/src/pas2jsfileutilsnodejs.inc
G    packages/pastojs/src/pas2jsfileutils.pp
G    packages/fcl-json/src/fpjson.pp
G    utils/pas2js/docs/translation.html
--- Recording mergeinfo for merge of r40064 into '.':
 G   .
--- Merging r40067 into '.':
G    packages/pastojs/src/pas2jsfileutilsnodejs.inc
G    packages/pastojs/src/pas2jslogger.pp
G    packages/pastojs/src/pas2jsfileutils.pp
--- Recording mergeinfo for merge of r40067 into '.':
 G   .
--- Merging r40072 into '.':
G    packages/pastojs/src/pas2jsfilecache.pp
G    packages/pastojs/src/pas2jscompiler.pp
G    packages/fcl-json/src/fpjson.pp
G    packages/fcl-js/src/jswriter.pp
G    packages/fcl-js/src/jssrcmap.pas
--- Recording mergeinfo for merge of r40072 into '.':
 G   .
--- Merging r40075 into '.':
G    packages/fcl-json/src/fpjson.pp
G    packages/pastojs/src/pas2jscompiler.pp
G    utils/pas2js/nodepas2js.pp
--- Recording mergeinfo for merge of r40075 into '.':
 G   .
--- Merging r40077 into '.':
G    packages/fcl-js/src/jssrcmap.pas
G    packages/fcl-js/src/jswriter.pp
--- Recording mergeinfo for merge of r40077 into '.':
 G   .
--- Merging r40080 into '.':
G    packages/fcl-js/src/jswriter.pp
U    packages/fcl-js/src/jsscanner.pp
--- Recording mergeinfo for merge of r40080 into '.':
 G   .
--- Merging r40082 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pasresolveeval.pas
--- Recording mergeinfo for merge of r40082 into '.':
 G   .
--- Merging r40098 into '.':
G    utils/pas2js/nodepas2js.pp
U    utils/pas2js/nodepas2js.lpi
--- Recording mergeinfo for merge of r40098 into '.':
 G   .
--- Merging r40099 into '.':
G    packages/fcl-js/src/jssrcmap.pas
--- Recording mergeinfo for merge of r40099 into '.':
 G   .
--- Merging r40100 into '.':
G    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r40100 into '.':
 G   .
--- Merging r40108 into '.':
G    utils/pas2js/nodepas2js.lpi
G    packages/pastojs/src/pas2jsfilecache.pp
--- Recording mergeinfo for merge of r40108 into '.':
 G   .
--- Merging r40125 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r40125 into '.':
 G   .
--- Merging r40129 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r40129 into '.':
 G   .
--- Merging r40136 into '.':
G    packages/fcl-json/src/fpjson.pp
--- Recording mergeinfo for merge of r40136 into '.':
 G   .
--- Merging r40137 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pasuseanalyzer.pas
G    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r40137 into '.':
 G   .
--- Merging r40144 into '.':
G    packages/fcl-passrc/src/pasresolveeval.pas
G    utils/pas2js/nodepas2js.lpi
--- Recording mergeinfo for merge of r40144 into '.':
 G   .
--- Merging r40150 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r40150 into '.':
 G   .
--- Merging r40165 into '.':
G    packages/fcl-passrc/src/pasuseanalyzer.pas
G    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r40165 into '.':
 G   .
--- Merging r40166 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r40166 into '.':
 G   .
--- Merging r40171 into '.':
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r40171 into '.':
 G   .
--- Merging r40173 into '.':
G    packages/pastojs/src/pas2jsfilecache.pp
G    packages/pastojs/src/pas2jscompiler.pp
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r40173 into '.':
 G   .

# revisions: 39851,39853,39854,39855,39856,39857,39898,39899,39904,39906,39908,39919,39921,39926,39928,39929,39932,39937,39939,39940,39942,39944,39946,39966,39968,39974,39975,39976,39977,39979,39985,40013,40018,40029,40030,40032,40034,40036,40037,40039,40040,40041,40042,40043,40044,40045,40046,40047,40048,40049,40051,40053,40055,40058,40061,40062,40064,40067,40072,40075,40077,40080,40082,40098,40099,40100,40108,40125,40129,40136,40137,40144,40150,40165,40166,40171,40173

git-svn-id: branches/fixes_3_2@40709 -

.gitattributes

@@ -2144,6 +2144,7 @@ packages/fcl-db/src/export/fptexexport.pp svneol=native#text/plain
 packages/fcl-db/src/export/fpxmlxsdexport.pp svneol=native#text/plain
 packages/fcl-db/src/json/Makefile svneol=native#text/plain
 packages/fcl-db/src/json/Makefile.fpc svneol=native#text/plain
+packages/fcl-db/src/json/extjsdataset.pp svneol=native#text/plain
 packages/fcl-db/src/json/fpjsondataset.pp svneol=native#text/plain
 packages/fcl-db/src/memds/Makefile svneol=native#text/plain
 packages/fcl-db/src/memds/Makefile.fpc svneol=native#text/plain
@@ -6921,6 +6922,7 @@ packages/pastojs/src/pas2jscompiler.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/pas2jslibcompiler.pp svneol=native#text/plain
@@ -17274,6 +17276,8 @@ utils/pas2js/docs/translation.html svneol=native#text/html
 utils/pas2js/fpmake.lpi svneol=native#text/plain
 utils/pas2js/fpmake.pp svneol=native#text/plain
 utils/pas2js/httpcompiler.pp svneol=native#text/plain
+utils/pas2js/nodepas2js.lpi svneol=native#text/plain
+utils/pas2js/nodepas2js.pp svneol=native#text/plain
 utils/pas2js/pas2js.cfg svneol=native#text/plain
 utils/pas2js/pas2js.lpi svneol=native#text/plain
 utils/pas2js/pas2js.pp svneol=native#text/plain

packages/fcl-db/fpmake.pp

@@ -822,6 +822,13 @@ begin
     T.ResourceStrings := True;
 
     T:=P.Targets.AddUnit('fpjsondataset.pp');
+    with T.Dependencies do
+      AddUnit('db');
+    
+    T:=P.Targets.AddUnit('extjsdataset.pp');
+    with T.Dependencies do
+      AddUnit('fpjsondataset');
+
 
     P.ExamplePath.Add('tests');
     T:=P.Targets.AddExampleProgram('dbftoolsunit.pas', DBaseOSes);

packages/fcl-db/src/json/Makefile

@@ -2,7 +2,7 @@
 # Don't edit, this file is generated by FPCMake Version 2.0.0
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-darwin aarch64-android wasm-wasm sparc64-linux
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-darwin wasm-wasm sparc64-linux
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari
@@ -288,7 +288,9 @@ else
 ifeq ($(CPU_TARGET),i386)
 BINUTILSPREFIX=i686-linux-android-
 else
-BINUTILSPREFIX=$(CPU_TARGET)-linux-android-
+ifeq ($(CPU_TARGET),mipsel)
+BINUTILSPREFIX=mipsel-linux-android-
+endif
 endif
 endif
 endif
@@ -332,265 +334,259 @@ endif
 override PACKAGE_NAME=fcl-db
 PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-db/Makefile.fpc,$(PACKAGESDIR))))))
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-nativent)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-iphonesim)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-android)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i386-aros)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),m68k-macos)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),powerpc-wii)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),powerpc-aix)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),x86_64-openbsd)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),x86_64-iphonesim)
-override TARGET_UNITS+=fpjsondataset
-endif
-ifeq ($(FULL_TARGET),x86_64-android)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),x86_64-aros)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),arm-netbsd)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),arm-android)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),arm-aros)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),powerpc64-aix)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),mips-linux)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),mipsel-android)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),jvm-java)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),jvm-android)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i8086-embedded)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i8086-msdos)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),i8086-win16)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),aarch64-linux)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),aarch64-darwin)
-override TARGET_UNITS+=fpjsondataset
-endif
-ifeq ($(FULL_TARGET),aarch64-android)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),wasm-wasm)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 ifeq ($(FULL_TARGET),sparc64-linux)
-override TARGET_UNITS+=fpjsondataset
+override TARGET_UNITS+=fpjsondataset extjsdataset
 endif
 override INSTALL_FPCPACKAGE=y
 ifdef REQUIRE_UNITSDIR
@@ -967,7 +963,6 @@ endif
 ifeq ($(OS_TARGET),aix)
 BATCHEXT=.sh
 EXEEXT=
-SHAREDLIBEXT=.a
 SHORTSUFFIX=aix
 endif
 ifeq ($(OS_TARGET),java)
@@ -1779,16 +1774,6 @@ REQUIRE_PACKAGES_FPMKUNIT=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-JSON=1
 endif
-ifeq ($(FULL_TARGET),x86_64-android)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_FCL-PROCESS=1
-REQUIRE_PACKAGES_HASH=1
-REQUIRE_PACKAGES_LIBTAR=1
-REQUIRE_PACKAGES_FPMKUNIT=1
-REQUIRE_PACKAGES_FCL-BASE=1
-REQUIRE_PACKAGES_FCL-JSON=1
-endif
 ifeq ($(FULL_TARGET),x86_64-aros)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_PASZLIB=1
@@ -2099,16 +2084,6 @@ REQUIRE_PACKAGES_FPMKUNIT=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-JSON=1
 endif
-ifeq ($(FULL_TARGET),aarch64-android)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_FCL-PROCESS=1
-REQUIRE_PACKAGES_HASH=1
-REQUIRE_PACKAGES_LIBTAR=1
-REQUIRE_PACKAGES_FPMKUNIT=1
-REQUIRE_PACKAGES_FCL-BASE=1
-REQUIRE_PACKAGES_FCL-JSON=1
-endif
 ifeq ($(FULL_TARGET),wasm-wasm)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_PASZLIB=1

packages/fcl-db/src/json/Makefile.fpc

@@ -6,7 +6,7 @@
 main=fcl-db
 
 [target]
-units=fpjsondataset
+units=fpjsondataset extjsdataset
 
 [require]
 packages=fcl-base fcl-json

packages/fcl-db/src/json/extjsdataset.pp

@@ -0,0 +1,399 @@
+unit extjsdataset;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, db, fpjson, typinfo, fpjsondataset;
+
+Type
+   { TExtJSJSONDataSet }
+
+  // Base for ExtJS datasets. It handles MetaData conversion.
+  TExtJSJSONDataSet = Class(TBaseJSONDataset)
+  Private
+    FFields : TJSONArray;
+  Protected
+    Function GenerateMetaData : TJSONObject;
+    function ConvertDateFormat(S: String): String; virtual;
+    Procedure MetaDataToFieldDefs; override;
+    procedure InitDateTimeFields; override;
+    function StringToFieldType(S: String): TFieldType;virtual;
+    function GetStringFieldLength(F: TJSONObject; AName: String; AIndex: Integer): integer; virtual;
+  Public
+    // Use this to load MetaData/Rows from stream.
+    // If no metadata is present in the stream, FieldDefs must be filled manually.
+    Procedure LoadFromStream(S : TStream);
+    // Use this to load MetaData/Rows from file.
+    // If no metadata is present in the file, FieldDefs must be filled manually.
+    Procedure LoadFromFile(Const AFileName: string);
+    // Use this to save Rows and optionally metadata to Stream.
+    // Note that MetaData must be set.
+    Procedure SaveToStream(S : TStream; SaveMetaData : Boolean);
+    // Use this to save Rows and optionally metadata to Stream.
+    // Note that MetaData must be set.
+    Procedure SaveToFile(Const AFileName : String; SaveMetaData : Boolean);
+    // Can be set directly if the dataset is closed.
+    Property MetaData;
+    // Can be set directly if the dataset is closed. If metadata is set, it must match the data.
+    Property Rows;
+  Published
+    Property OwnsData;
+  end;
+
+  { TExtJSJSONObjectDataSet }
+  // Use this dataset for data where the data is an array of objects.
+  TExtJSJSONObjectDataSet = Class(TExtJSJSONDataSet)
+    Function CreateFieldMapper : TJSONFieldMapper; override;
+  end;
+
+  { TExtJSJSONArrayDataSet }
+  // Use this dataset for data where the data is an array of arrays.
+  TExtJSJSONArrayDataSet = Class(TExtJSJSONDataSet)
+    Function CreateFieldMapper : TJSONFieldMapper; override;
+  end;
+
+
+implementation
+
+{ TExtJSJSONDataSet }
+
+
+Function  TExtJSJSONDataSet.StringToFieldType(S : String) : TFieldType;
+
+begin
+  if (s='int') then
+    Result:=ftLargeInt
+  else if (s='float') then
+    Result:=ftFloat
+  else if (s='boolean') then
+    Result:=ftBoolean
+  else if (s='date') then
+    Result:=ftDateTime
+  else if (s='string') or (s='auto') or (s='') then
+    Result:=ftString
+  else
+    if MapUnknownToStringType then
+      Result:=ftString
+    else
+      Raise EJSONDataset.CreateFmt('Unknown JSON data type : %s',[s]);
+end;
+
+Function  TExtJSJSONDataSet.GetStringFieldLength(F : TJSONObject; AName : String; AIndex : Integer) : integer;
+
+Var
+  I,L : Integer;
+  D : TJSONData;
+
+begin
+  Result:=0;
+  I:=F.IndexOfName('maxlen');
+  if (I<>-1) and (F.Items[I].jsonType=jtNumber) then
+    begin
+    Result:=StrToIntDef(trim(F.Items[i].AsString),-1);
+    if (Result=-1) then
+      Raise EJSONDataset.CreateFmt('Invalid maximum length specifier for field %s : %s',[AName,F.Items[i].AsString])
+    end
+  else
+    begin
+    For I:=0 to Rows.Count-1 do
+      begin
+      D:=FieldMapper.GetJSONDataForField(Aname,AIndex,Rows[i]);
+      if (D<>Nil) and (D.JsonType<>jtNull) then
+        begin
+        l:=Length(D.AsString);
+        if L>Result then
+          Result:=L;
+        end;
+      end;
+    end;
+  if (Result=0) then
+    Result:=20;
+end;
+
+procedure TExtJSJSONDataSet.LoadFromStream(S: TStream);
+
+Var
+  D : TJSONData;
+  O : TJSONObject;
+  N : String;
+  I : Integer;
+
+begin
+  D:=GetJSON(S);
+  try
+    if (D.JSONType=jtObject) then
+      O:=D as TJSONObject
+    else
+      begin
+      FreeAndNil(D);
+      Raise EJSONDataset.Create('Not a valid ExtJS JSON data packet');
+      end;
+    N:='rows';
+    // Check metadata
+    I:=O.IndexOfName('metaData');
+    if (I<>-1) then
+      begin
+      If (O.Items[i].JSONType<>jtObject) then
+        Raise EJSONDataset.Create('Invalid ExtJS JSON metaData in data packet.');
+      Metadata:=O.Objects['metaData'];
+      O.Extract(I);
+      I:=Metadata.IndexOfName('root');
+      If (I<>-1) then
+        begin
+        if (MetaData.Items[i].JSONType<>jtString) then
+          Raise EJSONDataset.Create('Invalid ExtJS JSON root element in metaData.');
+        N:=MetaData.Strings['root'];
+        end;
+      end;
+    // Check rows
+    I:=O.IndexOfName(N);
+    if (I=-1) then
+      Raise EJSONDataset.Create('Missing rows in data packet');
+    if (O.Items[i].JSONType<>jtArray) then
+      Raise EJSONDataset.Create('Rows element must be an array');
+    Rows:=O.Items[i] as TJSONArray;
+    O.Extract(I);
+    OwnsData:=True;
+  finally
+    D.Free;
+  end;
+end;
+
+procedure TExtJSJSONDataSet.LoadFromFile(const AFileName: string);
+
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
+  try
+    LoadFromStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TExtJSJSONDataSet.SaveToStream(S: TStream; SaveMetaData: Boolean);
+
+Var
+  O : TJSONObject;
+  SS : TStringStream;
+  N : String;
+  I : Integer;
+  M : TJSONobject;
+
+begin
+  O:=TJSONObject.Create;
+  try
+    N:='rows';
+    If SaveMetaData then
+      begin
+      M:=MetaData;
+      if M=Nil then
+        M:=GenerateMetaData;
+      O.Add('metaData',M);
+      if M.IndexOfName('root')<>-1 then
+        N:=M.Strings['root'];
+      end;
+    O.Add(N,Rows);
+    SS:=TStringStream.Create(O.FormatJSON());
+    try
+      S.CopyFrom(SS,0);
+    finally
+      SS.Free;
+    end;
+  finally
+    If (MetaData<>Nil) and SaveMetaData then
+      begin
+      I:=O.IndexOfName('metaData');
+      if (I<>-1) then
+        O.Extract(i);
+      end;
+    O.Extract(O.IndexOfName(N));
+    O.Free;
+  end;
+end;
+
+procedure TExtJSJSONDataSet.SaveToFile(const AFileName: String;
+  SaveMetaData: Boolean);
+
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(AFileName,fmCreate);
+  try
+    SaveToStream(F,SaveMetaData);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TExtJSJSONDataSet.MetaDataToFieldDefs;
+
+Var
+  A : TJSONArray;
+  F : TJSONObject;
+  MaxLen,I,J,FS : Integer;
+  N,idf : String;
+  ft: TFieldType;
+  D : TJSONData;
+
+begin
+  FieldDefs.Clear;
+  I:=Metadata.IndexOfName('fields');
+  if (I=-1) or (MetaData.Items[i].JSONType<>jtArray) then
+    Raise EJSONDataset.Create('Invalid metadata object');
+  A:=Metadata.Arrays['fields'];
+  For I:=0 to A.Count-1 do
+    begin
+    If (A.Types[i]<>jtObject) then
+      Raise EJSONDataset.CreateFmt('Field definition %d in metadata (%s) is not an object',[i,A[i].AsJSON]);
+    F:=A.Objects[i];
+    J:=F.IndexOfName('name');
+    If (J=-1) or (F.Items[J].JSONType<>jtString) then
+      Raise EJSONDataset.CreateFmt('Field definition %d in has no or invalid name property',[i]);
+    N:=F.Items[J].AsString;
+    J:=F.IndexOfName('type');
+    If (J=-1) then
+      ft:=ftstring
+    else If (F.Items[J].JSONType<>jtString) then
+      Raise EJSONDataset.CreateFmt('Field definition %d in has invalid type property',[i])
+    else
+      ft:=StringToFieldType(F.Items[J].asString);
+    if (ft=ftString) then
+      begin
+      fs:=F.Get('maxLen',0);
+      if fs=0 then
+        fs:=GetStringFieldLength(F,N,I)
+      end
+    else
+      fs:=0;
+    FieldDefs.Add(N,ft,fs);
+    end;
+  FFields:=A;
+end;
+
+function TExtJSJSONDataSet.GenerateMetaData: TJSONObject;
+
+Var
+  F : TJSONArray;
+  O : TJSONObject;
+  I,M : Integer;
+  T : STring;
+
+begin
+  Result:=TJSONObject.Create;
+  F:=TJSONArray.Create;
+  Result.Add('fields',F);
+  For I:=0 to FieldDefs.Count -1 do
+    begin
+    O:=TJSONObject.Create(['name',FieldDefs[i].name]);
+    F.Add(O);
+    M:=0;
+    case FieldDefs[i].DataType of
+      ftfixedwidechar,
+      ftwideString,
+      ftfixedchar,
+      ftString:
+        begin
+        T:='string';
+        M:=FieldDefs[i].Size;
+        end;
+      ftBoolean: T:='boolean';
+      ftDate,
+      ftTime,
+      ftDateTime: T:='date';
+      ftFloat: t:='float';
+      ftSmallint,
+      ftInteger,
+      ftAutoInc,
+      ftLargeInt,
+      ftword: t:='int';
+    else
+      Raise EJSONDataset.CreateFmt('Unsupported field type : %s',[GetEnumName(TypeInfo(TFieldType),Ord(FieldDefs[i].DataType))]);
+    end; // case
+    O.Strings['type']:=t;
+    if M<>0 then
+      O.Integers['maxlen']:=M;
+    end;
+  Result.strings['root']:='rows';
+end;
+
+Function TExtJSJSONDataSet.ConvertDateFormat(S : String) : String;
+
+{ Not handled: N S w z W t L o O P T Z c U MS }
+
+begin
+  Result:=StringReplace(S,'y','yy',[rfReplaceall]);
+  Result:=StringReplace(Result,'Y','yyyy',[rfReplaceall]);
+  Result:=StringReplace(Result,'g','h',[rfReplaceall]);
+  Result:=StringReplace(Result,'G','hh',[rfReplaceall]);
+  Result:=StringReplace(Result,'F','mmmm',[rfReplaceall]);
+  Result:=StringReplace(Result,'M','mmm',[rfReplaceall]);
+  Result:=StringReplace(Result,'n','m',[rfReplaceall]);
+  Result:=StringReplace(Result,'D','ddd',[rfReplaceall]);
+  Result:=StringReplace(Result,'j','d',[rfReplaceall]);
+  Result:=StringReplace(Result,'l','dddd',[rfReplaceall]);
+  Result:=StringReplace(Result,'i','nn',[rfReplaceall]);
+  Result:=StringReplace(Result,'u','zzz',[rfReplaceall]);
+  Result:=StringReplace(Result,'a','am/pm',[rfReplaceall,rfIgnoreCase]);
+  Result:=LowerCase(Result);
+end;
+
+procedure TExtJSJSONDataSet.InitDateTimeFields;
+
+Var
+  F : TJSONObject;
+  FF : TField;
+  I,J : Integer;
+  Fmt : String;
+
+begin
+  If (FFields=Nil) then
+    Exit;
+  For I:=0 to FFields.Count-1 do
+    begin
+    F:=FFields.Objects[i];
+    J:=F.IndexOfName('type');
+    if (J<>-1) and (F.Items[J].JSONType=jtString) and (F.items[J].AsString='date') then
+      begin
+      J:=F.IndexOfName('dateFormat');
+      if (J<>-1) and (F.Items[J].JSONType=jtString) then
+         begin
+         FMT:=ConvertDateFormat(F.Items[J].AsString);
+         FF:=FindField(F.Strings['name']);
+         if (FF<>Nil) and (FF.DataType in [ftDate,ftTime,ftDateTime]) and (FF.FieldKind=fkData) then
+           begin
+
+           if FF is TJSONDateField then
+             TJSONDateField(FF).DateFormat:=Fmt
+           else if FF is TJSONTimeField then
+             TJSONTimeField(FF).TimeFormat:=Fmt
+           else if FF is TJSONDateTimeField then
+             TJSONDateTimeField(FF).DateTimeFormat:=Fmt;
+           end;
+         end;
+      end;
+    end;
+end;
+
+
+{ TJSONArrayDataSet }
+
+function TExtJSJSONArrayDataSet.CreateFieldMapper: TJSONFieldMapper;
+begin
+  Result:=TJSONArrayFieldMapper.Create;
+end;
+
+{ TJSONObjectDataSet }
+
+function TExtJSJSONObjectDataSet.CreateFieldMapper: TJSONFieldMapper;
+begin
+  Result:=TJSONObjectFieldMapper.Create;
+end;
+
+end.
+

packages/fcl-db/tests/testjsondataset.pp

@@ -1,190 +1,264 @@
 program testjsondataset;
 
-{$mode objfpc}{$H+}
+{$DEFINE TESTCALCFIELDS}
 
-uses
-  Classes, sysutils, DB, fpjsondataset, fpjson, jsonparser;
+uses sysutils, db, jsonparser, fpjson,fpjsondataset, extjsdataset;
 
-Function ExtractData(Const AFileName : string) : TJSONObject;
+Type
 
-Var
-  F : TFIleStream;
-  P : TJSONParser;
-  D : TJSONData;
+  { TApp }
 
-begin
-  Result:=Nil;
-  F:=TFileStream.Create(AFileName,fmOpenRead);
-  try
-    P:=TJSONParser.Create(F);
-    try
-      D:=P.Parse;
-      if (D.JSONType=jtObject) then
-        Result:=D as TJSONObject
-      else
-        FreeAndNil(D);
-    finally
-      P.Free;
-    end;
-  finally
-    F.Free;
+  TApp = Class(TObject)
+    Procedure DumpRecord(DS : TDataset);
+    Procedure DumpRecords(DS : TDataset);
+    Procedure Run;
+  private
+    procedure DoCalcFields(DataSet: TDataSet);
   end;
+
+Procedure TApp.DumpRecord(DS : TDataset);
+
+//Var
+//  F : TField;
+
+begin
+//  For F in  DS.Fields do
+//    Write(F.Name,' : ',F.IsNull,' ');
+//  WriteLn;
+  Writeln(
+  {$IFDEF TESTCALCFIELDS}
+          'Full name: ',DS.FieldByName('fullname').AsString,
+  {$ENDIF}
+          'First name: ',DS.FieldByName('firstname').AsString,
+          ', Last name: ', DS.FieldByName('lastname').AsString,
+          ', Children: ', DS.FieldByName('children').AsInteger,
+          ', Birthday: ', DS.FieldByName('birthday').AsString
+  );
 end;
-Procedure DumpDataset(DS : TDataset);
 
-Var
-  I,J : Integer;
+Procedure TApp.DumpRecords(DS : TDataset);
 
 begin
-  I:=0;
-  Writeln('Dataset contains ',DS.RecordCount,' records');
   While not DS.EOF do
     begin
-    Inc(I);
-    Writeln('=== Record ',I,' : ',DS.RecNo,' ===');
-    For J:=0 to DS.Fields.Count-1 do
-      With DS.Fields[J] do
-        Writeln(FieldName,' : ',AsString);
+    Write(DS.RecNo,': ');
+    DumpRecord(DS);
     DS.Next;
     end;
-  Writeln('Dataset contained ',I,' records');
 end;
 
-Procedure DoTest4(Const AFileName : string);
 
-Var
-  DS : TExtjsJSONObjectDataset;
-
-begin
-  DS:=TExtjsJSONObjectDataset.Create(Nil);
-  try
-    DS.LoadFromFile(AFileName);
-    DS.Open;
-    DumpDataset(DS);
-  finally
-    DS.Free;
-  end;
-end;
-
-Procedure DoTest1(Const AFileName : string);
+Procedure TApp.Run;
 
 Var
-  D,M : TJSONObject;
-  DS : TExtjsJSONObjectDataset;
-  I,J : Integer;
-  F : TFieldDef;
+  DS : TExtJSJSONObjectDataSet;
+  B : TBookmark;
+  t: TDataLink;
+  DSS : TDatasource;
+{$IFDEF TESTCALCFIELDS}
+  F : TField;
+{$ENDIF}
 
 begin
-  D:=ExtractData(AFileName);
-  try
-    DS:=TExtjsJSONObjectDataset.Create(Nil);
-    try
-      DS.Rows:=D.Arrays['rows'];
-      DS.Metadata:=D.Objects['metaData'];
-      DS.OwnsData:=False;
-      DS.Open;
-      For I:=0 to DS.FieldDefs.Count-1 do
-        begin
-        F:=DS.FieldDefs[i];
-        Writeln('FieldDefs.Add(''',F.Name,''',',F.DataType,',',F.Size,');');
-        end;
-      DumpDataset(DS);
-    finally
-      DS.Free;
-    end;
-  finally
-    D.Free;
-  end;
-end;
 
-Procedure DoTest2(Const AFileName : string);
+  DS:=TExtJSJSONObjectDataSet.Create(Nil);
+  DS.MetaData:=GetJSON(' { "fields" : [ {"name": "firstname", "maxLen" : 100}, {"name": "lastname","maxLen" : 100}, '+
+                       ' { "name" : "children", "type": "int" }, '+
+                       ' { "name" : "birthday", "type": "date", "dateFormat": "yyyy\"-\"mm\"-\"dd" } ]}') as TJSONObject;
+  DS.Rows:=GetJSON('[{"firstname" : "Michael", "lastname" : "Van Canneyt", "children" : 2, "birthday": "1970-07-07" },'+
+                                  '  {"firstname" : "Mattias", "lastname" : "Gaertner", "children" : 0, "birthday" : "1970-07-08" }, '+
+                                  '  {"firstname" : "Bruno", "lastname" : "Fierens", "children" : 3, "birthday" : "1970-07-09" },'+
+                                  '  {"firstname" : "Detlef", "lastname" : "Overbeek", "children" : 2, "birthday" : "1950-07-08" }'+
+                                  ' ]') as TJSONarray;
+{$IFDEF TESTCALCFIELDS}
+  F:=TStringField.Create(DS);
+  F.FieldKind:=fkCalculated;
+  F.Size:=200;
+  F.FieldName:='fullname';
+  F.Dataset:=DS;
+  F:=TStringField.Create(DS);
+  F.FieldKind:=fkData;
+  F.Size:=200;
+  F.FieldName:='firstname';
+  F.Dataset:=DS;
+  F:=TStringField.Create(DS);
+  F.FieldKind:=fkData;
+  F.Size:=200;
+  F.FieldName:='lastname';
+  F.Dataset:=DS;
+  F:=TIntegerField.Create(DS);
+  F.FieldKind:=fkData;
+  F.FieldName:='children';
+  F.Dataset:=DS;
+  F:=TJSONDateField.Create(DS);
+  TJSONDateField(F).DateFormat:='yyyy"-"mm"-"dd';
+  F.FieldKind:=fkData;
+  F.FieldName:='birthday';
 
-Var
-  D,M : TJSONObject;
-  DS : TExtjsJSONObjectDataset;
-  I,J : Integer;
-  F : TFieldDef;
-begin
-  D:=ExtractData(AFileName);
-  DS:=TExtjsJSONObjectDataset.Create(Nil);
-  DS.Rows:=D.Arrays['rows'];
-  With DS do
+  F.Dataset:=DS;
+  DS.OnCalcFields:=@DoCalcFields;
+{$ENDIF}
+  DS.Open;
+  Writeln('All records');
+  DumpRecords(DS);
+  Writeln('First record (expect Michael.)');
+  DS.First;
+  DumpRecord(DS);
+  Writeln('Jump to last (expect detlef)');
+  DS.Last;
+  DumpRecord(DS);
+  Writeln('Reverse order:');
+  While not DS.BOF do
     begin
-    FieldDefs.Add('ID',ftLargeint,0);
-    FieldDefs.Add('Name',ftString,20);
-    FieldDefs.Add('Email',ftString,30);
+    DumpRecord(DS);
+    DS.Prior;
     end;
-  DS.Open;
-  DumpDataset(DS);
-end;
-
-Procedure DoTest3(Const AFileName : string);
+  DS.Append;
+  Writeln('Dumping record after APPEND (expect empty)');
+  Writeln('Modified before dump (expect False): ',DS.Modified);
+  DumpRecord(DS);
+  DS.FieldByName('firstname').AsString:='Florian';
+  Write('Old value of field first name (expect null): ');
+  if DS.FieldByName('firstname').OldValue=Null then
+    Writeln('Null')
+  else
+    Writeln(DS.FieldByName('firstname').OldValue);
+  DS.FieldByName('lastname').AsString:='Klaempfl';
+  DS.FieldByName('children').AsInteger:=1;
+  DS.FieldByName('birthday').AsDateTime:=EncodeDate(1980,5,4);
+  Writeln('Modified after (expect true): ',DS.Modified);
+  Writeln('Dumping record before POST (Expect Florian)');
+  DumpRecord(DS);
+  DS.Post;
+  Writeln('Dumping record after POST (Expect Florian)');
+  DumpRecord(DS);
+  Writeln('Jump to first (expect Michael)');
+  DS.First;
+  DumpRecord(DS);
+  DS.Edit;
+  Writeln('Dumping record after EDIT');
+  Writeln('Modified before  (expect False): ',DS.Modified);
+  DumpRecord(DS);
+  DS.FieldByName('firstname').AsString:='Dolores';
+  DS.FieldByName('lastname').AsString:='Nabokov';
+  DS.FieldByName('children').AsInteger:=0;
+  DS.FieldByName('birthday').AsDateTime:=EncodeDate(1943,2,14);
+  Writeln('Modified after (expect true): ',DS.Modified);
+  Writeln('Dumping record before POST (expect Dolores)');
+  DumpRecord(DS);
+  DS.Post;
+  Writeln('Dumping record after POST (expect Dolores)');
+  DumpRecord(DS);
+  DS.Edit;
+  Writeln('Dumping record after second EDIT (Expect Dolores)');
+  DumpRecord(DS);
+  Writeln('Modified before  (expect False): ',DS.Modified);
+  DS.FieldByName('firstname').AsString:='Felicity';
+  Writeln('Old value of field first name (expect Dolores): ', DS.FieldByName('firstname').OldValue);
+  DS.FieldByName('lastname').AsString:='Brown';
+  DS.FieldByName('children').AsInteger:=0;
+  DS.FieldByName('birthday').AsDateTime:=EncodeDate(1943,2,14);
+  Writeln('Modified after (expect true): ',DS.Modified);
+  Writeln('Dumping record before Cancel (expect Filicity brown)');
+  DumpRecord(DS);
+  DS.Cancel;
+  Writeln('Dumping record after Cancel (expect Dolores)');
+  DumpRecord(DS);
+  Writeln('Jump to first and dumping all records (expect Dolores first)');
+  DS.First;
+  DumpRecords(DS);
+  Writeln('Jump to first  (expect Dolores)');
+  DS.First;
+  DumpRecord(DS);
+  DS.Next;
+  DS.Next;
+  DS.Next;
+  Writeln('Getting Bookmark (expect Detlef)');
+  DumpRecord(DS);
+  B:=DS.BookMark;
+  DS.First;
+  Writeln('Delete (expect Mattias)');
+  DS.Delete;
+  DumpRecord(DS);
+  Writeln('Setting Bookmark (expect Detlef)');
+  Writeln('BM value: ',PNativeInt(B)^);
+  DS.BookMark:=B;
+  DumpRecord(DS);
+  Writeln('Jump to second (expect Bruno)');
+  DS.First;
+  DS.Next;
+  DumpRecord(DS);
+  DS.Insert;
+  Writeln('Dumping record after second Insert (Expect empty)');
+  Writeln('Modified (expect False): ',DS.Modified);
+  DumpRecord(DS);
+  DS.FieldByName('firstname').AsString:='Felicity';
+  DS.FieldByName('lastname').AsString:='Brown';
+  DS.FieldByName('children').AsInteger:=0;
+  DS.FieldByName('birthday').AsDateTime:=EncodeDate(1963,4,6);
+  Writeln('Modified (expect true): ',DS.Modified);
+  Writeln('Dumping record before POST (expect Filicity)');
+  DumpRecord(DS);
+  DS.Post;
+  Writeln('Dumping record after POST (expect Felicity)');
+  DumpRecord(DS);
+  Writeln('Jump to first and dumping all records (expect Mattias first, then Felicity)');
+  DS.First;
+  DumpRecords(DS);
+  Writeln('Jump to first before edit');
+  DS.First;
+  DSS:=TDatasource.Create(Nil);
+  DSS.DataSet:=DS;
+  t:=TDataLink.Create;
+  try
+    Writeln('Buffercount');
+    t.BufferCount := 10;
+    t.DataSource := DSS;
+    Writeln('Doing edit');
+    t.Edit;
+    Writeln('Modified (expect false): ',DS.Modified);
+    Writeln('Done edit');
+    t.ActiveRecord := 0;
+    Writeln('Edit, expect Mattias');
+    DumpRecord(DS);
+    Writeln('Activerecord 1: expect Felicity');
+    t.ActiveRecord := 1;
+    DumpRecord(DS);
+    Writeln('Activerecord 2: expect Bruno');
+    t.ActiveRecord := 2;
+    DumpRecord(DS);
+    t.ActiveRecord := 0;
+  Finally
+    t.Free;
+  end;
+  t:=TDataLink.Create;
+  try
+    t.DataSource := DSS;
+    DS.Last;
+    Writeln('Last record :',DS.RecNo);
+    Writeln('Activerecord :',T.ActiveRecord);
+    DumpRecord(DS);
+    DS.First;
+    t.BufferCount := 3;
+    DS.Last;
+    Writeln('Last record after buffercount lessened:',DS.RecNo);
+    Writeln('Activerecord :',T.ActiveRecord);
+    DumpRecord(DS);
+    t.ActiveRecord := 0;
+  Finally
+    t.Free;
+  end;
 
-Var
-  DS : TExtjsJSONObjectDataset;
-  I,J : Integer;
-  F : TFieldDef;
+end;
 
+procedure TApp.DoCalcFields(DataSet: TDataSet);
 begin
-  DS:=TExtjsJSONObjectDataset.Create(Nil);
-  try
-    With DS do
-      begin
-      FieldDefs.Add('ID',ftLargeint,0);
-      FieldDefs.Add('Name',ftString,20);
-      FieldDefs.Add('Email',ftString,30);
-      Open;
-      // Record 1
-      Append;
-      FieldByName('ID').AsInteger:=3;
-      FieldByName('Name').AsString:='Michael';
-      FieldByName('Email').AsString:='[email protected]';
-      Post;
-      // Record 2
-      Append;
-      FieldByName('ID').AsInteger:=4;
-      FieldByName('Name').AsString:='jonas';
-      FieldByName('Email').AsString:='[email protected]';
-      Post;
-      DumpDataset(DS);
-      First;
-      // insert record 1
-      Insert;
-      FieldByName('ID').AsInteger:=1;
-      FieldByName('Name').AsString:='Florian';
-      FieldByName('Email').AsString:='[email protected]';
-      Post;
-      DumpDataset(DS);
-      Writeln('First');
-      First;
-      Writeln('Editing record ', RecNo,' ',FieldByName('Name').AsString);
-      Edit;
-      FieldByName('ID').AsInteger:=12;
-      FieldByName('Name').AsString:='Marco';
-      FieldByName('Email').AsString:='[email protected]';
-      Post;
-      First;
-      DumpDataset(DS);
-      First;
-      Next;
-      Writeln('Deleting record ', RecNo,' ',FieldByName('Name').AsString);
-      Delete;
-      First;
-      DumpDataset(DS);
-      SaveToFile(AFileName,True);
-      end;
-  finally
-    DS.Free
-  end;
+  Writeln('In calcfields callback');
+  Dataset.FieldByName('FullName').AsString:= Dataset.FieldByName('firstName').AsString+' '+Dataset.FieldByName('lastname').AsString;
 end;
+
 begin
-  Writeln('Test 1');
-  DoTest1('test.json');
-  Writeln('Test 2');
-  DoTest2('test.json');
-  Writeln('Test 3');
-  DoTest3('test3.json');
-  Writeln('Test 4');
-  DoTest4('test.json');
+  With Tapp.Create do
+    Run;
 end.
 

packages/fcl-js/src/jsbase.pp

@@ -20,27 +20,39 @@ unit jsbase;
 interface
 
 uses
+  {$ifdef pas2js}
+  js,
+  {$endif}
   Classes, SysUtils;
 
+const
+  MinSafeIntDouble = -$10000000000000; // -4503599627370496
+  MaxSafeIntDouble =   $fffffffffffff; //  4503599627370495
 Type
   TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,jstCompletion);
 
   TJSString = UnicodeString;
   TJSChar = WideChar;
-  TJSPChar = PWideChar;
   TJSNumber = Double;
+  {$ifdef fpc}
+  TJSPChar = PWideChar;
+  {$endif}
 
   { TJSValue }
 
   TJSValue = Class(TObject)
   private
     FValueType: TJSType;
+    {$ifdef pas2js}
+    FValue: JSValue;
+    {$else}
     FValue : Record
       Case Integer of
       0 : (P : Pointer);
       1 : (F : TJSNumber);
       2 : (I : Integer);
     end;
+    {$endif}
     FCustomValue: TJSString;
     procedure ClearValue(ANewValue: TJSType);
     function GetAsBoolean: Boolean;
@@ -79,10 +91,93 @@ Type
   end;
 
 function IsValidJSIdentifier(Name: TJSString; AllowEscapeSeq: boolean = false): boolean;
+function StrToJSString(const S: String): TJSString; inline;
+function JSStringToString(const S: TJSString): String; inline;
 
 implementation
 
 function IsValidJSIdentifier(Name: TJSString; AllowEscapeSeq: boolean): boolean;
+{$ifdef pas2js}
+const
+  HexChars = ['0'..'9','a'..'f','A'..'F'];
+var
+  p, l, i: Integer;
+begin
+  Result:=false;
+  if Name='' then exit;
+  l:=length(Name);
+  p:=1;
+  while p<=l do
+    case Name[p] of
+    '0'..'9':
+      if p=1 then
+        exit
+      else
+        inc(p);
+    'a'..'z','A'..'Z','_','$': inc(p);
+    '\':
+      begin
+      if not AllowEscapeSeq then exit;
+      inc(p);
+      if p>l then exit;
+      if Name[p]='x' then
+        begin
+        // \x00
+        inc(p);
+        if (p>l) or not (Name[p] in HexChars) then exit;
+        inc(p);
+        if (p>l) or not (Name[p] in HexChars) then exit;
+        end
+      else if Name[p]='u' then
+        begin
+        inc(p);
+        if p>l then exit;
+        if Name[p]='{' then
+          begin
+          // \u{00000}
+          i:=0;
+          repeat
+            inc(p);
+            if p>l then exit;
+            case Name[p] of
+            '}': break;
+            '0'..'9': i:=i*16+ord(Name[p])-ord('0');
+            'a'..'f': i:=i*16+ord(Name[p])-ord('a')+10;
+            'A'..'F': i:=i*16+ord(Name[p])-ord('A')+10;
+            else exit;
+            end;
+            if i>$FFFF then exit;
+          until false;
+          if (i>=$D800) and (i<$E000) then exit;
+          inc(p);
+          end
+        else
+          begin
+          // \u0000
+          for i:=1 to 4 do
+            begin
+            inc(p);
+            if (p>l) or not (Name[p] in HexChars) then exit;
+            end;
+          end;
+        // ToDo: check for invalid values like #$D800 and #$0041
+        end
+      else
+        exit; // unknown sequence
+      end;
+    #$200C,#$200D: inc(p); // zero width non-joiner/joiner
+    #$00AA..#$2000,
+    #$200E..#$D7FF:
+      inc(p); // ToDo: only those with ID_START/ID_CONTINUE see https://codepoints.net/search?IDC=1
+    #$D800..#$DFFF:
+      exit; // double code units are not allowed for JS identifiers
+    #$E000..#$FFFF:
+      inc(p);
+    else
+      exit;
+    end;
+end;
+{$else}
 var
   p: TJSPChar;
   i: Integer;
@@ -132,8 +227,9 @@ begin
             'A'..'F': i:=i*16+ord(p^)-ord('A')+10;
             else exit;
             end;
-            if i>$10FFFF then exit;
+            if i>$FFFF then exit;
           until false;
+          if (i>=$D800) and (i<$E000) then exit;
           inc(p);
           end
         else
@@ -145,6 +241,7 @@ begin
             if not (p^ in ['0'..'9','a'..'f','A'..'F']) then exit;
             end;
           end;
+        // ToDo: check for invalid values like #$D800 and #$0041
         end
       else
         exit; // unknown sequence
@@ -153,33 +250,46 @@ begin
     #$00AA..#$2000,
     #$200E..#$D7FF:
       inc(p); // ToDo: only those with ID_START/ID_CONTINUE see https://codepoints.net/search?IDC=1
-    #$D800..#$DBFF:
-      inc(p,2); // see above
+    #$D800..#$DFFF:
+      exit; // double code units are not allowed for JS identifiers
+    #$E000..#$FFFF:
+      inc(p);
     else
       exit;
     end;
   until false;
 end;
+{$endif}
+
+function StrToJSString(const S: String): TJSString;
+begin
+  Result:={$ifdef pas2js}S{$else}UTF8Decode(S){$endif};
+end;
+
+function JSStringToString(const S: TJSString): String;
+begin
+  Result:={$ifdef pas2js}S{$else}UTF8Encode(S){$endif};
+end;
 
 { TJSValue }
 
 function TJSValue.GetAsBoolean: Boolean;
 begin
   If (ValueType=jstBoolean) then
-    Result:=(FValue.I<>0)
+    Result:={$ifdef pas2js}boolean(FValue){$else}(FValue.I<>0){$endif}
   else
     Result:=False;
 end;
 
 function TJSValue.GetAsCompletion: TObject;
 begin
-  Result:=TObject(FValue.P);
+  Result:=TObject(FValue{$ifdef fpc}.P{$endif});
 end;
 
 function TJSValue.GetAsNumber: TJSNumber;
 begin
   If (ValueType=jstNumber) then
-    Result:=FValue.F
+    Result:={$ifdef pas2js}TJSNumber(FValue){$else}FValue.F{$endif}
   else
     Result:=0.0;
 end;
@@ -187,7 +297,7 @@ end;
 function TJSValue.GetAsObject: TObject;
 begin
   If (ValueType=jstObject) then
-    Result:=TObject(FValue.P)
+    Result:=TObject(FValue{$ifdef fpc}.P{$endif})
   else
     Result:=nil;
 end;
@@ -195,7 +305,7 @@ end;
 function TJSValue.GetAsReference: TObject;
 begin
   If (ValueType=jstReference) then
-    Result:=TObject(FValue.P)
+    Result:=TObject(FValue{$ifdef fpc}.P{$endif})
   else
     Result:=nil;
 end;
@@ -203,7 +313,7 @@ end;
 function TJSValue.GetAsString: TJSString;
 begin
   If (ValueType=jstString) then
-    Result:=TJSString(FValue.P)
+    Result:=TJSString(FValue{$ifdef fpc}.P{$endif})
   else
     Result:='';
 end;
@@ -221,12 +331,23 @@ end;
 procedure TJSValue.ClearValue(ANewValue : TJSType);
 
 begin
+  {$ifdef pas2js}
+  Case FValueType of
+    jstUNDEFINED: FValue:=JS.Undefined;
+    jstString : FValue:='';
+    jstNumber : FValue:=0;
+    jstBoolean : FValue:=false;
+  else
+    FValue:=JS.Null;
+  end;
+  {$else}
   Case FValueType of
     jstString : String(FValue.P):='';
     jstNumber : FValue.F:=0;
   else
     FValue.I:=0;
   end;
+  {$endif}
   FValueType:=ANewValue;
   FCustomValue:='';
 end;
@@ -234,37 +355,41 @@ end;
 procedure TJSValue.SetAsBoolean(const AValue: Boolean);
 begin
   ClearValue(jstBoolean);
+  {$ifdef pas2js}
+  FValue:=AValue;
+  {$else}
   FValue.I:=Ord(AValue);
+  {$endif}
 end;
 
 procedure TJSValue.SetAsCompletion(const AValue: TObject);
 begin
   ClearValue(jstBoolean);
-  FValue.P:=AValue;
+  FValue{$ifdef fpc}.P{$endif}:=AValue;
 end;
 
 procedure TJSValue.SetAsNumber(const AValue: TJSNumber);
 begin
   ClearValue(jstNumber);
-  FValue.F:=AValue;
+  FValue{$ifdef fpc}.F{$endif}:=AValue;
 end;
 
 procedure TJSValue.SetAsObject(const AValue: TObject);
 begin
   ClearValue(jstObject);
-  FValue.P:=AVAlue;
+  FValue{$ifdef fpc}.P{$endif}:=AVAlue;
 end;
 
 procedure TJSValue.SetAsReference(const AValue: TObject);
 begin
   ClearValue(jstReference);
-  FValue.P:=AVAlue;
+  FValue{$ifdef fpc}.P{$endif}:=AVAlue;
 end;
 
 procedure TJSValue.SetAsString(const AValue: TJSString);
 begin
   ClearValue(jstString);
-  TJSString(FValue.P):=AValue;
+  {$ifdef pas2js}FValue{$else}TJSString(FValue.P){$endif}:=AValue;
 end;
 
 procedure TJSValue.SetIsNull(const AValue: Boolean);

packages/fcl-js/src/jsscanner.pp

@@ -498,7 +498,7 @@ begin
   TokenStart := TokenStr;
   repeat
     Inc(TokenStr);
-    If (TokenStr[0]='\') and (TokenStr[1]='u') then
+    //If (TokenStr[0]='\') and (TokenStr[1]='u') then
   until not (TokenStr[0] in ['A'..'Z', 'a'..'z', '0'..'9', '_','$']);
   Len:=(TokenStr-TokenStart);
   SetLength(FCurTokenString,Len);

packages/fcl-js/src/jssrcmap.pas

@@ -19,14 +19,38 @@ unit JSSrcMap;
 
 {$mode objfpc}{$H+}
 
+{$ifdef fpc}
+  {$define UsePChar}
+  {$define HasJsonParser}
+  {$define HasStreams}
+  {$define HasFS}
+{$endif}
+
+{$ifdef pas2js}
+  {$ifdef nodejs}
+    {$define HasFS}
+  {$endif}
+{$endif}
+
 interface
 
 uses
-  Classes, SysUtils, contnrs, fpjson, jsonparser, jsonscanner;
+  {$ifdef pas2js}
+  JS,
+    {$ifdef nodejs}
+    NodeJSFS,
+    {$endif}
+  {$else}
+  contnrs,
+  {$endif}
+  Classes, SysUtils, fpjson
+  {$ifdef HasJsonParser}
+  , jsonparser, jsonscanner
+  {$endif}
+  ;
 
 const
   Base64Chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
-  DefaultSrcMapHeader = ')]}'''+LineEnding;
 
 type
   EJSSourceMap = class(Exception);
@@ -54,7 +78,8 @@ type
   TSourceMapOption = (
     smoAddMonotonous, // true = AddMapping GeneratedLine/Col must be behind last add, false = check all adds for duplicate
     smoAutoLineStart, // automatically add a first column mapping, repeating last mapping
-    smoSafetyHeader // insert ')]}' at start
+    smoSafetyHeader, // insert ')]}' at start
+    smoAllowSrcLine0 // don't bark on SrcLine=0
     );
   TSourceMapOptions = set of TSourceMapOption;
 const
@@ -71,7 +96,7 @@ type
 
       TStringToIndex = class
       private
-        FItems: TFPHashList;
+        FItems: {$ifdef pas2js}TJSObject{$else}TFPHashList{$endif};
       public
         constructor Create;
         destructor Destroy; override;
@@ -116,10 +141,12 @@ type
     function ToJSON: TJSONObject; virtual;
     function ToString: string; override;
     procedure LoadFromJSON(Obj: TJSONObject); virtual;
-    procedure SaveToStream(aStream: TStream); virtual;
+    procedure SaveToStream(aStream: TFPJSStream); virtual;
+    {$ifdef HasStreams}
     procedure LoadFromStream(aStream: TStream); virtual;
     procedure SaveToFile(Filename: string); virtual;
     procedure LoadFromFile(Filename: string); virtual;
+    {$endif}
     property GeneratedFilename: string read FGeneratedFilename write SetGeneratedFilename;
     function IndexOfName(const Name: string; AddIfNotExists: boolean = false): integer;
     function IndexOfSourceFile(const SrcFile: string; AddIfNotExists: boolean = false): integer;
@@ -139,17 +166,26 @@ type
     property Sorted: boolean read FSorted write SetSorted; // Segments are sorted for GeneratedLine/Col
   end;
 
+function DefaultSrcMapHeader: string;
+
 function EncodeBase64VLQ(i: NativeInt): String; // base64 Variable Length Quantity
 function DecodeBase64VLQ(const s: string): NativeInt; // base64 Variable Length Quantity
-function DecodeBase64VLQ(var p: PChar): NativeInt; // base64 Variable Length Quantity
+function DecodeBase64VLQ(
+  {$ifdef UsePChar}var p: PChar{$else}const s: string; var p: integer{$endif}): NativeInt; // base64 Variable Length Quantity
 
-function CompareSegmentWithGeneratedLineCol(Item1, Item2: Pointer): Integer;
+function CompareSegmentWithGeneratedLineCol(
+  Item1, Item2: {$ifdef pas2js}jsvalue{$else}Pointer{$endif}): Integer;
 
 procedure DebugSrcMapLine(GeneratedLine: integer; var GeneratedLineSrc: String;
   SrcMap: TSourceMap; out InfoLine: String);
 
 implementation
 
+function DefaultSrcMapHeader: string;
+begin
+  Result:=')]}'''+LineEnding;
+end;
+
 function EncodeBase64VLQ(i: NativeInt): String;
 { Convert signed number to base64-VLQ:
   Each base64 has 6bit, where the most significant bit is the continuation bit
@@ -196,36 +232,64 @@ end;
 
 function DecodeBase64VLQ(const s: string): NativeInt;
 var
+  {$ifdef UsePChar}
   p: PChar;
+  {$else}
+  p: integer;
+  {$endif}
 begin
   if s='' then
     raise EConvertError.Create('DecodeBase64VLQ empty');
+  {$ifdef UsePChar}
   p:=PChar(s);
   Result:=DecodeBase64VLQ(p);
   if p-PChar(s)<>length(s) then
     raise EConvertError.Create('DecodeBase64VLQ waste');
+  {$else}
+  p:=1;
+  Result:=DecodeBase64VLQ(s,p);
+  {$endif}
 end;
 
-function DecodeBase64VLQ(var p: PChar): NativeInt;
+function DecodeBase64VLQ(
+  {$ifdef UsePChar}var p: PChar{$else}const s: string; var p: integer{$endif}): NativeInt;
 { Convert base64-VLQ to signed number,
   For the fomat see EncodeBase64VLQ
 }
+var
+  {$ifdef UsePChar}
+  run: PChar;
+  {$else}
+  run, l: integer;
+  {$endif}
 
   procedure RaiseInvalid;
   begin
+    p:=run;
     raise ERangeError.Create('DecodeBase64VLQ');
   end;
 
 const
-  MaxShift = 63-5; // actually log2(High(NativeInt))-5
+  MaxShift = {$ifdef pas2js}32{$else}63{$endif}-5; // actually log2(High(NativeInt))-5
 var
   c: Char;
   digit, Shift: Integer;
 begin
   Result:=0;
   Shift:=0;
+  run:=p;
+  {$ifdef UsePChar}
+  {$else}
+  l:=length(s);
+  {$endif}
   repeat
-    c:=p^;
+    {$ifdef UsePChar}
+    c:=run^;
+    {$else}
+    if run>l then
+      RaiseInvalid;
+    c:=s[run];
+    {$endif}
     case c of
     'A'..'Z': digit:=ord(c)-ord('A');
     'a'..'z': digit:=ord(c)-ord('a')+26;
@@ -234,7 +298,7 @@ begin
     '/': digit:=63;
     else RaiseInvalid;
     end;
-    inc(p);
+    inc(run);
     if Shift>MaxShift then
       RaiseInvalid;
     inc(Result,(digit and %11111) shl Shift);
@@ -244,9 +308,11 @@ begin
     Result:=-(Result shr 1)
   else
     Result:=Result shr 1;
+  p:=run;
 end;
 
-function CompareSegmentWithGeneratedLineCol(Item1, Item2: Pointer): Integer;
+function CompareSegmentWithGeneratedLineCol(
+    Item1, Item2: {$ifdef pas2js}jsvalue{$else}Pointer{$endif}): Integer;
 var
   Seg1: TSourceMapSegment absolute Item1;
   Seg2: TSourceMapSegment absolute Item2;
@@ -321,7 +387,7 @@ begin
       Addition:='|';
       if LastSrcFile<>aSeg.SrcFileIndex then
         begin
-        Addition:=Addition+ExtractFileName(SrcMap.SourceFiles[aSeg.SrcFileIndex])+',';
+        Addition:=Addition+{$ifdef HasFS}ExtractFileName{$endif}(SrcMap.SourceFiles[aSeg.SrcFileIndex])+',';
         LastSrcFile:=aSeg.SrcFileIndex;
         end;
       if LastSrcLine<>aSeg.SrcLine then
@@ -378,32 +444,55 @@ end;
 
 constructor TSourceMap.TStringToIndex.Create;
 begin
+  {$ifdef pas2js}
+  FItems:=TJSObject.new;
+  {$else}
   FItems:=TFPHashList.Create;
+  {$endif}
 end;
 
 destructor TSourceMap.TStringToIndex.Destroy;
 begin
+  {$ifdef pas2js}
+  FItems:=nil;
+  {$else}
   FItems.Clear;
   FreeAndNil(FItems);
+  {$endif}
   inherited Destroy;
 end;
 
 procedure TSourceMap.TStringToIndex.Clear;
 begin
+  {$ifdef pas2js}
+  FItems:=TJSObject.new;
+  {$else}
   FItems.Clear;
+  {$endif}
 end;
 
 procedure TSourceMap.TStringToIndex.Add(const Value: String; Index: integer);
 begin
+  {$ifdef pas2js}
+  FItems[Value]:=Index;
+  {$else}
   // Note: nil=0 means not found in TFPHashList
   FItems.Add(Value,{%H-}Pointer(PtrInt(Index+1)));
+  {$endif}
 end;
 
 function TSourceMap.TStringToIndex.FindValue(const Value: String
   ): integer;
 begin
+  {$ifdef pas2js}
+  if FItems.hasOwnProperty(Value) then
+    Result:=integer(FItems[Value])
+  else
+    Result:=-1;
+  {$else}
   // Note: nil=0 means not found in TFPHashList
   Result:=integer({%H-}PtrInt(FItems.Find(Value))){%H-}-1;
+  {$endif}
 end;
 
 { TSourceMap }
@@ -501,10 +590,10 @@ begin
   FGeneratedFilename:='';
   FSourceToIndex.Clear;
   for i:=0 to FSources.Count-1 do
-    TObject(FSources[i]).Free;
+    TObject(FSources[i]).{$ifdef pas2js}Destroy{$else}Free{$endif};
   FSources.Clear;
   for i:=0 to FItems.Count-1 do
-    TObject(FItems[i]).Free;
+    TObject(FItems[i]).{$ifdef pas2js}Destroy{$else}Free{$endif};
   FItems.Clear;
   FNameToIndex.Clear;
   FNames.Clear;
@@ -548,7 +637,10 @@ begin
   else
     begin
     if SrcLine<1 then
-      RaiseInvalid('invalid SrcLine');
+    begin
+      if (SrcLine<0) or not (smoAllowSrcLine0 in Options) then
+        RaiseInvalid('invalid SrcLine');
+    end;
     if SrcCol<0 then
       RaiseInvalid('invalid SrcCol');
     end;
@@ -589,14 +681,36 @@ end;
 
 function TSourceMap.CreateMappings: String;
 
-  procedure Add(ms: TMemoryStream; const s: string);
+{$ifdef pas2js}
+var
+  buf: TJSArray;
+
+  procedure AddStr(const s: string); inline;
+  begin
+    buf.push(s);
+  end;
+
+  procedure AddChar(c: char); inline;
+  begin
+    buf.push(c);
+  end;
+{$else}
+var
+  buf: TMemoryStream;
+
+  procedure AddStr(const s: string);
   begin
     if s<>'' then
-      ms.Write(s[1],length(s));
+      buf.Write(s[1],length(s)*sizeof(char));
   end;
 
+  procedure AddChar(c: char);
+  begin
+    buf.Write(c,sizeof(char));
+  end;
+{$endif}
+
 var
-  ms: TMemoryStream;
   i, LastGeneratedLine, LastGeneratedColumn, j, LastSrcFileIndex, LastSrcLine,
     LastSrcColumn, SrcLine, LastNameIndex: Integer;
   Item: TSourceMapSegment;
@@ -608,7 +722,11 @@ begin
   LastSrcLine:=0;
   LastSrcColumn:=0;
   LastNameIndex:=0;
-  ms:=TMemoryStream.Create;
+  {$ifdef pas2js}
+  buf:=TJSArray.new;
+  {$else}
+  buf:=TMemoryStream.Create;
+  {$endif}
   try
     for i:=0 to Count-1 do
       begin
@@ -619,22 +737,22 @@ begin
         //LastGeneratedColumn:=0;
         for j:=LastGeneratedLine+1 to Item.GeneratedLine do
           begin
-          ms.WriteByte(ord(';'));
+          AddChar(';');
           if (smoAutoLineStart in FOptions)
               and ((j<Item.GeneratedLine) or (Item.GeneratedColumn>0)) then
             begin
             // repeat mapping at start of line
             // column 0
-            Add(ms,EncodeBase64VLQ(0-LastGeneratedColumn));
+            AddStr(EncodeBase64VLQ(0-LastGeneratedColumn));
             LastGeneratedColumn:=0;
             // same src file index
-            Add(ms,EncodeBase64VLQ(0));
+            AddStr(EncodeBase64VLQ(0));
             // same src line
-            Add(ms,EncodeBase64VLQ(0));
+            AddStr(EncodeBase64VLQ(0));
             // same src column
-            Add(ms,EncodeBase64VLQ(0));
+            AddStr(EncodeBase64VLQ(0));
             if j=Item.GeneratedLine then
-              ms.WriteByte(ord(','));
+              AddChar(',');
             end;
           end;
         LastGeneratedLine:=Item.GeneratedLine;
@@ -645,67 +763,103 @@ begin
         if (LastGeneratedLine=Item.GeneratedLine)
             and (LastGeneratedColumn=Item.GeneratedColumn) then
           continue;
-        ms.WriteByte(ord(','));
+        AddChar(',');
         end;
       // column diff
       //writeln('TSourceMap.CreateMappings Seg=',i,' Gen:Line=',LastGeneratedLine,',Col=',Item.GeneratedColumn,' Src:File=',Item.SrcFileIndex,',Line=',Item.SrcLine,',Col=',Item.SrcColumn,' Name=',Item.NameIndex);
-      Add(ms,EncodeBase64VLQ(Item.GeneratedColumn-LastGeneratedColumn));
+      AddStr(EncodeBase64VLQ(Item.GeneratedColumn-LastGeneratedColumn));
       LastGeneratedColumn:=Item.GeneratedColumn;
 
       if Item.SrcFileIndex<0 then
         continue; // no source -> segment length 1
       // src file index diff
-      Add(ms,EncodeBase64VLQ(Item.SrcFileIndex-LastSrcFileIndex));
+      AddStr(EncodeBase64VLQ(Item.SrcFileIndex-LastSrcFileIndex));
       LastSrcFileIndex:=Item.SrcFileIndex;
       // src line diff
       SrcLine:=Item.SrcLine-1; // 0 based in version 3
-      Add(ms,EncodeBase64VLQ(SrcLine-LastSrcLine));
+      AddStr(EncodeBase64VLQ(SrcLine-LastSrcLine));
       LastSrcLine:=SrcLine;
       // src column diff
-      Add(ms,EncodeBase64VLQ(Item.SrcColumn-LastSrcColumn));
+      AddStr(EncodeBase64VLQ(Item.SrcColumn-LastSrcColumn));
       LastSrcColumn:=Item.SrcColumn;
       // name index
       if Item.NameIndex<0 then
         continue; // no name -> segment length 4
-      Add(ms,EncodeBase64VLQ(Item.NameIndex-LastNameIndex));
+      AddStr(EncodeBase64VLQ(Item.NameIndex-LastNameIndex));
       LastNameIndex:=Item.NameIndex;
       end;
-    SetLength(Result,ms.Size);
+    {$ifdef pas2js}
+    Result:=buf.join('');
+    {$else}
+    SetLength(Result,buf.Size);
     if Result<>'' then
-      Move(ms.Memory^,Result[1],ms.Size);
+      Move(buf.Memory^,Result[1],buf.Size);
+    {$endif}
   finally
-    ms.Free;
+    {$ifdef pas2js}
+    {$else}
+    buf.Free;
+    {$endif}
   end;
 end;
 
 procedure TSourceMap.ParseMappings(const Mapping: String);
 const
   MaxInt = High(integer) div 2;
+{$ifdef UsePChar}
 var
   p: PChar;
+
+  function Decode: NativeInt; inline;
+  begin
+    Result:=DecodeBase64VLQ(p);
+  end;
+
+  procedure E(const Msg: string);
+  begin
+    raise EJSSourceMap.CreateFmt(Msg,[PtrUInt(p-PChar(Mapping))+1]);
+  end;
+{$else}
+var
+  p: integer;
+
+  function Decode: NativeInt; inline;
+  begin
+    Result:=DecodeBase64VLQ(Mapping,p);
+  end;
+
+  procedure E(const Msg: string);
+  begin
+    raise EJSSourceMap.CreateFmt(Msg,[p]);
+  end;
+{$endif}
+var
   GeneratedLine, LastColumn, Column, LastSrcFileIndex, LastSrcLine,
     LastSrcColumn, LastNameIndex, SrcFileIndex, SrcLine, SrcColumn,
-    NameIndex: Integer;
+    NameIndex, l: Integer;
   ColDiff, SrcFileIndexDiff, SrcLineDiff, SrcColumnDiff,
     NameIndexDiff: NativeInt;
   Segment: TSourceMapSegment;
 begin
-  if Mapping='' then exit;
-  p:=PChar(Mapping);
+  l:=length(Mapping);
+  if l=0 then exit;
+  p:={$ifdef UsePChar}PChar(Mapping){$else}1{$endif};
   GeneratedLine:=1;
   LastColumn:=0;
   LastSrcFileIndex:=0;
   LastSrcLine:=0;
   LastSrcColumn:=0;
   LastNameIndex:=0;
-  while p^<>#0 do
+  while {$ifdef UsePChar}true{$else}p<=l{$endif} do
     begin
-    case p^ of
+    case {$ifdef UsePChar}p^{$else}Mapping[p]{$endif} of
+    {$ifdef UsePChar}
     #0:
       if p-PChar(Mapping)=length(Mapping) then
         exit
       else
-        raise EJSSourceMap.CreateFmt('unexpected #0 at %d',[PtrUInt(p-PChar(Mapping))]);
+        E('unexpected #0 at %d');
+    {$endif}
     ',':
       begin
       // next segment
@@ -719,12 +873,12 @@ begin
       end;
     else
       begin
-      ColDiff:=DecodeBase64VLQ(p);
+      ColDiff:=Decode;
       if (ColDiff>MaxInt) or (ColDiff<-MaxInt) then
-        raise EJSSourceMap.CreateFmt('column out of range at %d',[PtrUInt(p-PChar(Mapping))]);
+        E('column out of range at %d');
       Column:=LastColumn+integer(ColDiff);
       if (Column>MaxInt) or (Column<-MaxInt) then
-        raise EJSSourceMap.CreateFmt('column out of range at %d',[PtrUInt(p-PChar(Mapping))]);
+        E('column out of range at %d');
       LastColumn:=Column;
 
       Segment:=TSourceMapSegment.Create;
@@ -734,44 +888,44 @@ begin
       Segment.GeneratedColumn:=Column;
       Segment.SrcFileIndex:=-1;
       Segment.NameIndex:=-1;
-      if not (p^ in [',',';',#0]) then
+      if {$ifdef UsePChar}not (p^ in [',',';',#0]){$else}(p<=l) and not (Mapping[p] in [',',';']){$endif} then
         begin
         // src file index
-        SrcFileIndexDiff:=DecodeBase64VLQ(p);
+        SrcFileIndexDiff:=Decode;
         if (SrcFileIndexDiff>MaxInt) or (SrcFileIndexDiff<-MaxInt) then
-          raise EJSSourceMap.CreateFmt('src file index out of range at %d',[PtrUInt(p-PChar(Mapping))]);
+          E('src file index out of range at %d');
         SrcFileIndex:=LastSrcFileIndex+integer(SrcFileIndexDiff);
         if (SrcFileIndex<0) or (SrcFileIndex>=SourceCount) then
-          raise EJSSourceMap.CreateFmt('src file index out of range at %d',[PtrUInt(p-PChar(Mapping))]);
+          E('src file index out of range at %d');
         LastSrcFileIndex:=SrcFileIndex;
         Segment.SrcFileIndex:=SrcFileIndex;
         // src line
-        SrcLineDiff:=DecodeBase64VLQ(p);
+        SrcLineDiff:=Decode;
         if (SrcLineDiff>MaxInt) or (SrcLineDiff<-MaxInt) then
-          raise EJSSourceMap.CreateFmt('src line out of range at %d',[PtrUInt(p-PChar(Mapping))]);
+          E('src line out of range at %d');
         SrcLine:=LastSrcLine+integer(SrcLineDiff);
         if (SrcLine>MaxInt) or (SrcLine<-MaxInt) then
-          raise EJSSourceMap.CreateFmt('src line out of range at %d',[PtrUInt(p-PChar(Mapping))]);
+          E('src line out of range at %d');
         LastSrcLine:=SrcLine;
         Segment.SrcLine:=SrcLine+1; // lines are stored 0-based
         // src column
-        SrcColumnDiff:=DecodeBase64VLQ(p);
+        SrcColumnDiff:=Decode;
         if (SrcColumnDiff>MaxInt) or (SrcColumnDiff<-MaxInt) then
-          raise EJSSourceMap.CreateFmt('src column out of range at %d',[PtrUInt(p-PChar(Mapping))]);
+          E('src column out of range at %d');
         SrcColumn:=LastSrcColumn+integer(SrcColumnDiff);
         if (SrcColumn>MaxInt) or (SrcColumn<-MaxInt) then
-          raise EJSSourceMap.CreateFmt('src column out of range at %d',[PtrUInt(p-PChar(Mapping))]);
+          E('src column out of range at %d');
         LastSrcColumn:=SrcColumn;
         Segment.SrcColumn:=SrcColumn;
-        if not (p^ in [',',';',#0]) then
+        if {$ifdef UsePChar}not (p^ in [',',';',#0]){$else}(p<=l) and not (Mapping[p] in [',',';']){$endif} then
           begin
           // name index
-          NameIndexDiff:=DecodeBase64VLQ(p);
+          NameIndexDiff:=Decode;
           if (NameIndexDiff>MaxInt) or (NameIndexDiff<-MaxInt) then
-            raise EJSSourceMap.CreateFmt('name index out of range at %d',[PtrUInt(p-PChar(Mapping))]);
+            E('name index out of range at %d');
           NameIndex:=LastNameIndex+integer(NameIndexDiff);
           if (NameIndex<0) or (NameIndex>=NameCount) then
-            raise EJSSourceMap.CreateFmt('name index out of range at %d',[PtrUInt(p-PChar(Mapping))]);
+            E('name index out of range at %d');
           LastNameIndex:=NameIndex;
           Segment.NameIndex:=NameIndex;
           end;
@@ -933,20 +1087,27 @@ begin
   ParseMappings(aMappings);
 end;
 
-procedure TSourceMap.SaveToStream(aStream: TStream);
+procedure TSourceMap.SaveToStream(aStream: TFPJSStream);
 var
   Obj: TJSONObject;
 begin
   Obj:=ToJSON;
   try
     if smoSafetyHeader in Options then
+      begin
+      {$ifdef pas2js}
+      aStream.push(DefaultSrcMapHeader);
+      {$else}
       aStream.Write(DefaultSrcMapHeader[1],length(DefaultSrcMapHeader));
+      {$endif}
+      end;
     Obj.DumpJSON(aStream);
   finally
     Obj.Free;
   end;
 end;
 
+{$ifdef HasStreams}
 procedure TSourceMap.LoadFromStream(aStream: TStream);
 var
   s: string;
@@ -997,6 +1158,7 @@ begin
     TheStream.Free;
   end;
 end;
+{$endif}
 
 function TSourceMap.IndexOfName(const Name: string; AddIfNotExists: boolean
   ): integer;

packages/fcl-js/src/jswriter.pp

@@ -18,12 +18,27 @@ unit jswriter;
 { $DEFINE DEBUGJSWRITER}
 {AllowWriteln}
 
+{$if defined(fpc) or defined(NodeJS)}
+  {$define HasFileWriter}
+{$endif}
+
 interface
 
 uses
-  SysUtils, jstoken, jsbase, jstree;
+  {$ifdef pas2js}
+  JS,
+  {$endif}
+  SysUtils, jsbase, jstree;
 
 Type
+  {$ifdef pas2js}
+  TJSWriterString = UnicodeString;
+  TJSWriterChar = WideChar;
+  {$else}
+  TJSWriterString = AnsiString;
+  TJSWriterChar = AnsiChar;
+  {$endif}
+
   TTextWriter = class;
 
   TTextWriterWriting = procedure(Sender: TTextWriter) of object;
@@ -37,67 +52,95 @@ Type
     FCurColumn: integer;
     FOnWriting: TTextWriterWriting;
   protected
-    Function DoWrite(Const S : AnsiString) : Integer; virtual; abstract;
+    Function DoWrite(Const S : TJSWriterString) : Integer; virtual; abstract;
+    {$ifdef FPC_HAS_CPSTRING}
     Function DoWrite(Const S : UnicodeString) : Integer; virtual; abstract;
+    {$endif}
     procedure SetCurElement(const AValue: TJSElement); virtual;
     Procedure Writing; virtual; // called before adding new characters
   Public
     // All functions return the number of bytes copied to output stream.
     constructor Create;
+    {$ifdef FPC_HAS_CPSTRING}
     Function Write(Const S : UnicodeString) : Integer;
-    Function Write(Const S : AnsiString) : Integer;
-    Function WriteLn(Const S : AnsiString) : Integer;
-    Function Write(Const Fmt : AnsiString; Args : Array of const) : Integer;
-    Function WriteLn(Const Fmt : AnsiString; Args : Array of const) : Integer;
-    Function Write(Const Args : Array of const) : Integer;
-    Function WriteLn(Const Args : Array of const) : Integer;
+    {$endif}
+    Function Write(Const S : TJSWriterString) : Integer;
+    Function WriteLn(Const S : TJSWriterString) : Integer;
+    Function Write(Const Fmt : TJSWriterString; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif}) : Integer;
+    Function WriteLn(Const Fmt : TJSWriterString; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif}) : Integer;
+    Function Write(Const Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif}) : Integer;
+    Function WriteLn(Const Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif}) : Integer;
     Property CurLine: integer read FCurLine write FCurLine;
     Property CurColumn: integer read FCurColumn write FCurColumn;// char index, not codepoint
     Property CurElement: TJSElement read FCurElement write SetCurElement;
     Property OnWriting: TTextWriterWriting read FOnWriting write FOnWriting;
   end;
 
+  {$ifdef HasFileWriter}
   { TFileWriter }
 
   TFileWriter = Class(TTextWriter)
   Protected
+    {$ifdef NodeJS}
+    {$else}
     FFile : Text;
+    {$endif}
     FFileName : String;
-    Function DoWrite(Const S : AnsiString) : Integer; override;
+    Function DoWrite(Const S : TJSWriterString) : Integer; override;
+    {$ifdef FPC_HAS_CPSTRING}
     Function DoWrite(Const S : UnicodeString) : Integer; override;
+    {$endif}
   Public
-    Constructor Create(Const AFileNAme : String);
+    Constructor Create(Const AFileName : String); reintroduce;
     Destructor Destroy; override;
     Procedure Flush;
     Procedure Close;
     Property FileName : String Read FFileName;
   end;
+  {$endif}
+
+  TBufferWriter_Buffer = Array of {$ifdef fpc}byte{$else}string{$endif};
 
   { TBufferWriter }
 
-  TBytes = Array of byte;
   TBufferWriter = Class(TTextWriter)
+  private type
+    TBuffer = TBufferWriter_Buffer;
   private
     FBufPos,
     FCapacity: Cardinal;
-    FBuffer : TBytes;
-    function GetAsAnsistring: AnsiString;
+    FBuffer : TBuffer;
+    function GetAsString: TJSWriterString;
+    {$ifdef fpc}
     function GetBuffer: Pointer;
+    {$endif}
     function GetBufferLength: Integer;
     function GetCapacity: Cardinal;
+    {$ifdef FPC_HAS_CPSTRING}
     function GetUnicodeString: UnicodeString;
+    {$endif}
     procedure SetCapacity(AValue: Cardinal);
   Protected
-    Function DoWrite(Const S : AnsiString) : integer; override;
+    Function DoWrite(Const S : TJSWriterString) : integer; override;
+    {$ifdef FPC_HAS_CPSTRING}
     Function DoWrite(Const S : UnicodeString) : integer; override;
+    {$endif}
   Public
-    Constructor Create(Const ACapacity : Cardinal);
+    Constructor Create(Const ACapacity : Cardinal); reintroduce;
+    {$ifdef fpc}
     Procedure SaveToFile(Const AFileName : String);
     Property Buffer : Pointer Read GetBuffer;
+    {$endif}
+    {$ifdef pas2js}
+    Property Buffer: TBufferWriter_Buffer read FBuffer;
+    {$endif}
     Property BufferLength : Integer Read GetBufferLength;
     Property Capacity : Cardinal Read GetCapacity Write SetCapacity;
-    Property AsAnsistring : AnsiString Read GetAsAnsistring;
+    Property AsString : TJSWriterString Read GetAsString;
+    {$ifdef FPC_HAS_CPSTRING}
+    Property AsAnsiString : AnsiString Read GetAsString; deprecated 'use AsString instead, fpc 3.3.1';
     Property AsUnicodeString : UnicodeString Read GetUnicodeString;
+    {$endif}
   end;
 
   TJSEscapeQuote = (
@@ -109,7 +152,9 @@ Type
   { TJSWriter }
 
   TWriteOption = (woCompact,
+                  {$ifdef FPC_HAS_CPSTRING}
                   woUseUTF8,
+                  {$endif}
                   woTabIndent,
                   woEmptyStatementAsComment,
                   woQuoteElementNames,
@@ -134,13 +179,17 @@ Type
     procedure SetOptions(AValue: TWriteOptions);
   Protected
     // Helper routines
-    Procedure Error(Const Msg : String);
-    Procedure Error(Const Fmt : String; Args : Array of const);
+    Procedure Error(Const Msg : TJSWriterString);
+    Procedure Error(Const Fmt : TJSWriterString; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif});
     Procedure WriteIndent; // inline;
+    {$ifdef FPC_HAS_CPSTRING}
     Procedure Write(Const U : UnicodeString);
-    Procedure Write(Const S : AnsiString);
-    Procedure WriteLn(Const S : AnsiString);
+    {$endif}
+    Procedure Write(Const S : TJSWriterString);
+    Procedure WriteLn(Const S : TJSWriterString);
+    {$ifdef FPC_HAS_CPSTRING}
     Procedure WriteLn(Const U : UnicodeString);
+    {$endif}
     // one per type of statement
     Procedure WriteValue(V : TJSValue);  virtual;
     Procedure WriteRegularExpressionLiteral(El: TJSRegularExpressionLiteral);
@@ -179,7 +228,9 @@ Type
   Public
     Function EscapeString(const S: TJSString; Quote: TJSEscapeQuote = jseqDouble): TJSString;
     Constructor Create(AWriter : TTextWriter);
+    {$ifdef HasFileWriter}
     Constructor Create(Const AFileName : String);
+    {$endif}
     Destructor Destroy; override;
     Procedure WriteJS(El : TJSElement);
     Procedure Indent;
@@ -192,7 +243,9 @@ Type
   end;
   EJSWriter = Class(Exception);
 
+{$ifdef FPC_HAS_CPSTRING}
 Function UTF16ToUTF8(const S: UnicodeString): string;
+{$endif}
 
 implementation
 
@@ -200,6 +253,7 @@ Resourcestring
   SErrUnknownJSClass = 'Unknown javascript element class : %s';
   SErrNilNode = 'Nil node in Javascript';
 
+{$ifdef FPC_HAS_CPSTRING}
 function HexDump(p: PChar; Count: integer): string;
 var
   i: Integer;
@@ -216,6 +270,7 @@ begin
   // conversion magic
   SetCodePage(RawByteString(Result), CP_ACP, False);
 end;
+{$endif}
 
 { TBufferWriter }
 
@@ -224,24 +279,33 @@ begin
   Result:=FBufPos;
 end;
 
-function TBufferWriter.GetAsAnsistring: AnsiString;
+function TBufferWriter.GetAsString: TJSWriterString;
 begin
+  {$ifdef pas2js}
+  if FBufPos<length(FBuffer) then
+    TJSArray(FBuffer).Length:=FBufPos;
+  Result:=TJSArray(FBuffer).join('');
+  {$else}
   Result:='';
   SetLength(Result,BufferLength);
   if (BufferLength>0) then
     Move(FBuffer[0],Result[1],BufferLength);
+  {$endif}
 end;
 
+{$ifdef fpc}
 function TBufferWriter.GetBuffer: Pointer;
 begin
   Result:=Pointer(FBuffer);
 end;
+{$endif}
 
 function TBufferWriter.GetCapacity: Cardinal;
 begin
   Result:=Length(FBuffer);
 end;
 
+{$ifdef FPC_HAS_CPSTRING}
 function TBufferWriter.GetUnicodeString: UnicodeString;
 
 Var
@@ -254,6 +318,7 @@ begin
   if (SL>0) then
     Move(FBuffer[0],Result[1],SL*SizeOf(UnicodeChar));
 end;
+{$endif}
 
 procedure TBufferWriter.SetCapacity(AValue: Cardinal);
 begin
@@ -263,13 +328,21 @@ begin
     FBufPos:=Capacity;
 end;
 
-Function TBufferWriter.DoWrite(Const S: AnsiString): integer;
-
+Function TBufferWriter.DoWrite(Const S: TJSWriterString): integer;
+{$ifdef pas2js}
+begin
+  Result:=Length(S)*2;
+  if Result=0 then exit;
+  TJSArray(FBuffer).push(S);
+  inc(FBufPos);
+  FCapacity:=FBufPos;
+end;
+{$else}
 Var
   DesLen,MinLen : Integer;
 
 begin
-  Result:=Length(S)*SizeOf(Char);
+  Result:=Length(S)*SizeOf(TJSWriterChar);
   if Result=0 then exit;
   MinLen:=Result+FBufPos;
   If (MinLen>Capacity) then
@@ -282,7 +355,9 @@ begin
   Move(S[1],FBuffer[FBufPos],Result);
   FBufPos:=FBufPos+Result;
 end;
+{$endif}
 
+{$ifdef FPC_HAS_CPSTRING}
 Function TBufferWriter.DoWrite(Const S: UnicodeString): integer;
 
 Var
@@ -302,6 +377,7 @@ begin
   Move(S[1],FBuffer[FBufPos],Result);
   FBufPos:=FBufPos+Result;
 end;
+{$endif}
 
 Constructor TBufferWriter.Create(Const ACapacity: Cardinal);
 begin
@@ -309,8 +385,8 @@ begin
   Capacity:=ACapacity;
 end;
 
+{$ifdef fpc}
 Procedure TBufferWriter.SaveToFile(Const AFileName: String);
-
 Var
   F : File;
 
@@ -323,6 +399,7 @@ begin
     Close(F);
   end;
 end;
+{$endif}
 
 { TJSWriter }
 
@@ -330,7 +407,7 @@ procedure TJSWriter.SetOptions(AValue: TWriteOptions);
 begin
   if FOptions=AValue then Exit;
   FOptions:=AValue;
-  If woTabIndent in Foptions then
+  If woTabIndent in FOptions then
     FIndentChar:=#9
   else
     FIndentChar:=' ';
@@ -338,15 +415,16 @@ end;
 
 function TJSWriter.GetUseUTF8: Boolean;
 begin
-  Result:=(woUseUTF8 in Options)
+  Result:={$ifdef FPC_HAS_CPSTRING}(woUseUTF8 in Options){$else}false{$endif};
 end;
 
-procedure TJSWriter.Error(const Msg: String);
+procedure TJSWriter.Error(const Msg: TJSWriterString);
 begin
   Raise EJSWriter.Create(Msg);
 end;
 
-procedure TJSWriter.Error(const Fmt: String; Args: array of const);
+procedure TJSWriter.Error(const Fmt: TJSWriterString;
+  Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});
 begin
   Raise EJSWriter.CreateFmt(Fmt,Args);
 end;
@@ -374,6 +452,7 @@ begin
     FCurIndent:=0;
 end;
 
+{$ifdef FPC_HAS_CPSTRING}
 procedure TJSWriter.Write(const U: UnicodeString);
 
 Var
@@ -394,12 +473,15 @@ begin
     FLastChar:=U[length(U)];
     end;
 end;
+{$endif}
 
-procedure TJSWriter.Write(const S: AnsiString);
+procedure TJSWriter.Write(const S: TJSWriterString);
 begin
+  {$ifdef FPC_HAS_CPSTRING}
   if Not (woUseUTF8 in Options) then
     Write(UnicodeString(S))
   else
+  {$endif}
     begin
     WriteIndent;
     if s='' then exit;
@@ -408,11 +490,13 @@ begin
     end;
 end;
 
-procedure TJSWriter.WriteLn(const S: AnsiString);
+procedure TJSWriter.WriteLn(const S: TJSWriterString);
 begin
+  {$ifdef FPC_HAS_CPSTRING}
   if Not (woUseUTF8 in Options) then
     Writeln(UnicodeString(S))
   else
+  {$endif}
     begin
     WriteIndent;
     Writer.WriteLn(S);
@@ -421,6 +505,7 @@ begin
     end;
 end;
 
+{$ifdef FPC_HAS_CPSTRING}
 procedure TJSWriter.WriteLn(const U: UnicodeString);
 Var
   S : String;
@@ -440,42 +525,43 @@ begin
     FLinePos:=0;
     end;
 end;
+{$endif}
 
 function TJSWriter.EscapeString(const S: TJSString; Quote: TJSEscapeQuote
   ): TJSString;
 
 Var
   I,J,L : Integer;
-  P : TJSPChar;
   R: TJSString;
+  c: WideChar;
 
 begin
   I:=1;
   J:=1;
   R:='';
   L:=Length(S);
-  P:=TJSPChar(S);
   While I<=L do
     begin
-    if (P^ in [#0..#31,'"','''','/','\']) then
+    c:=S[I];
+    if (c in [#0..#31,'"','''','/','\']) or (c>=#$ff00) then
       begin
       R:=R+Copy(S,J,I-J);
-      Case P^ of
+      Case c of
         '\' : R:=R+'\\';
         '/' : R:=R+'\/';
         '"' : if Quote=jseqSingle then R:=R+'"' else R:=R+'\"';
         '''': if Quote=jseqDouble then R:=R+'''' else R:=R+'\''';
-        #0..#7,#11,#14..#31: R:=R+'\x'+TJSString(hexStr(ord(P^),2));
+        #0..#7,#11,#14..#31: R:=R+'\x'+TJSString(hexStr(ord(c),2));
         #8  : R:=R+'\b';
         #9  : R:=R+'\t';
         #10 : R:=R+'\n';
         #12 : R:=R+'\f';
         #13 : R:=R+'\r';
+        #$ff00..#$ffff: R:=R+'\u'+TJSString(HexStr(ord(c),4));
       end;
       J:=I+1;
       end;
     Inc(I);
-    Inc(P);
     end;
   R:=R+Copy(S,J,I-1);
   Result:=R;
@@ -485,32 +571,36 @@ procedure TJSWriter.WriteValue(V: TJSValue);
 const
   TabWidth = 4;
 
-  function GetLineIndent(var p: PWideChar): integer;
+  function GetLineIndent(const S: TJSString; var p: integer): integer;
   var
-    h: PWideChar;
+    h, l: integer;
   begin
     h:=p;
+    l:=length(S);
     Result:=0;
-    repeat
-      case h^ of
-      #0: break;
+    while h<=l do
+      begin
+      case S[h] of
       #9: Result:=Result+(TabWidth-Result mod TabWidth);
       ' ': inc(Result);
       else break;
       end;
       inc(h);
-    until false;
+      end;
     p:=h;
   end;
 
-  function SkipToNextLineStart(p: PWideChar): PWideChar;
+  function SkipToNextLineStart(const S: TJSString; p: integer): integer;
+  var
+    l: Integer;
   begin
-    repeat
-      case p^ of
-      #0: break;
+    l:=length(S);
+    while p<=l do
+      begin
+      case S[p] of
       #10,#13:
         begin
-        if (p[1] in [#10,#13]) and (p^<>p[1]) then
+        if (p<l) and (S[p+1] in [#10,#13]) and (S[p]<>S[p+1]) then
           inc(p,2)
         else
           inc(p);
@@ -518,14 +608,14 @@ const
         end
       else inc(p);
       end;
-    until false;
+      end;
     Result:=p;
   end;
 
 Var
   S , S2: String;
   JS: TJSString;
-  p, StartP: PWideChar;
+  p, StartP: Integer;
   MinIndent, CurLineIndent, j, Exp, Code: Integer;
   i: SizeInt;
   D: TJSNumber;
@@ -535,8 +625,8 @@ begin
     JS:=V.CustomValue;
     if JS='' then exit;
 
-    p:=SkipToNextLineStart(PWideChar(JS));
-    if p^=#0 then
+    p:=SkipToNextLineStart(JS,1);
+    if p>length(JS) then
       begin
       // simple value
       Write(JS);
@@ -548,21 +638,21 @@ begin
     // find minimum indent
     MinIndent:=-1;
     repeat
-      CurLineIndent:=GetLineIndent(p);
+      CurLineIndent:=GetLineIndent(JS,p);
       if (MinIndent<0) or (MinIndent>CurLineIndent) then
         MinIndent:=CurLineIndent;
-      p:=SkipToNextLineStart(p);
-    until p^=#0;
+      p:=SkipToNextLineStart(JS,p);
+    until p>length(JS);
 
     // write value lines indented
-    p:=PWideChar(JS);
-    GetLineIndent(p); // the first line is already indented, skip
+    p:=1;
+    GetLineIndent(JS,p); // the first line is already indented, skip
     repeat
       StartP:=p;
-      p:=SkipToNextLineStart(StartP);
-      Write(copy(JS,StartP-PWideChar(JS)+1,p-StartP));
-      if p^=#0 then break;
-      CurLineIndent:=GetLineIndent(p);
+      p:=SkipToNextLineStart(JS,StartP);
+      Write(copy(JS,StartP,p-StartP));
+      if p>length(JS) then break;
+      CurLineIndent:=GetLineIndent(JS,p);
       Write(StringOfChar(FIndentChar,FCurIndent+CurLineIndent-MinIndent));
     until false;
 
@@ -584,8 +674,8 @@ begin
       end;
     jstNumber :
       if (Frac(V.AsNumber)=0)
-          and (V.AsNumber>double(low(int64)))
-          and (V.AsNumber<double(high(int64))) then
+          and (V.AsNumber>=double(MinSafeIntDouble))
+          and (V.AsNumber<=double(MaxSafeIntDouble)) then
         begin
         Str(Round(V.AsNumber),S);
         end
@@ -725,14 +815,16 @@ constructor TJSWriter.Create(AWriter: TTextWriter);
 begin
   FWriter:=AWriter;
   FIndentChar:=' ';
-  FOptions:=[woUseUTF8];
+  FOptions:=[{$ifdef FPC_HAS_CPSTRING}woUseUTF8{$endif}];
 end;
 
+{$ifdef HasFileWriter}
 constructor TJSWriter.Create(const AFileName: String);
 begin
   Create(TFileWriter.Create(AFileName));
   FFreeWriter:=True;
 end;
+{$endif}
 
 destructor TJSWriter.Destroy;
 begin
@@ -845,13 +937,15 @@ end;
 
 procedure TJSWriter.WriteArrayLiteral(El: TJSArrayLiteral);
 
+type
+  BracketString = string{$ifdef fpc}[2]{$endif};
 Var
-  Chars : Array[Boolean] of string[2] = ('[]','()');
+  Chars : Array[Boolean] of BracketString = ('[]','()');
 
 Var
   i,C : Integer;
   isArgs,WC , MultiLine: Boolean;
-  BC : String[2];
+  BC : BracketString;
 
 begin
   isArgs:=El is TJSArguments;
@@ -1128,7 +1222,7 @@ end;
 procedure TJSWriter.WriteBinary(El: TJSBinary);
 
 Var
-  S : AnsiString;
+  S : String;
   AllowCompact, WithBrackets: Boolean;
 begin
   {$IFDEF VerboseJSWriter}
@@ -1205,7 +1299,7 @@ end;
 procedure TJSWriter.WriteAssignStatement(El: TJSAssignStatement);
 
 Var
-  S : AnsiString;
+  S : String;
 begin
   WriteJS(El.LHS);
   Writer.CurElement:=El;
@@ -1374,14 +1468,6 @@ procedure TJSWriter.WriteSwitchStatement(El: TJSSwitchStatement);
 
 Var
   C : Boolean;
-
-  Procedure WriteCaseLabel(L : TJSString);
-
-  begin
-    Write(l);
-  end;
-
-Var
   I : Integer;
   EC : TJSCaseElement;
 
@@ -1695,26 +1781,37 @@ begin
   FSkipCurlyBrackets:=False;
 end;
 
+{$ifdef HasFileWriter}
 { TFileWriter }
 
-Function TFileWriter.DoWrite(Const S: AnsiString) : Integer;
+Function TFileWriter.DoWrite(Const S: TJSWriterString) : Integer;
 begin
   Result:=Length(S);
+  {$ifdef NodeJS}
+  system.writeln('TFileWriter.DoWrite ToDo ',S);
+  {$else}
   system.Write(FFile,S);
+  {$endif}
 end;
 
+{$ifdef FPC_HAS_CPSTRING}
 Function TFileWriter.DoWrite(Const S: UnicodeString) : Integer;
 begin
   Result:=Length(S)*SizeOf(UnicodeChar);
   system.Write(FFile,S);
 end;
+{$endif}
 
-Constructor TFileWriter.Create(Const AFileNAme: String);
+Constructor TFileWriter.Create(Const AFileName: String);
 begin
   inherited Create;
   FFileName:=AFileName;
+  {$ifdef NodeJS}
+  system.writeln('TFileWriter.Create ToDo ',AFileName);
+  {$else}
   Assign(FFile,AFileName);
   Rewrite(FFile);
+  {$endif}
 end;
 
 Destructor TFileWriter.Destroy;
@@ -1725,13 +1822,22 @@ end;
 
 Procedure TFileWriter.Flush;
 begin
+  {$ifdef NodeJS}
+  system.writeln('TFileWriter.Flush ToDO');
+  {$else}
   system.Flush(FFile);
+  {$endif}
 end;
 
 Procedure TFileWriter.Close;
 begin
+  {$ifdef NodeJS}
+  system.writeln('TFileWriter.DoWrite ToDo ');
+  {$else}
   system.Close(FFile);
+  {$endif}
 end;
+{$endif}
 
 { TTextWriter }
 
@@ -1752,6 +1858,7 @@ begin
   FCurColumn:=1;
 end;
 
+{$ifdef FPC_HAS_CPSTRING}
 function TTextWriter.Write(const S: UnicodeString): Integer;
 var
   p: PWideChar;
@@ -1784,66 +1891,67 @@ begin
     inc(p);
   until false;
 end;
+{$endif}
 
-function TTextWriter.Write(const S: AnsiString): Integer;
+function TTextWriter.Write(const S: TJSWriterString): Integer;
 var
-  p: PChar;
   c: Char;
+  l, p: Integer;
 begin
   if S='' then exit;
   Writing;
   Result:=DoWrite(S);
-  p:=PChar(S);
-  repeat
-    c:=p^;
+  l:=length(S);
+  p:=1;
+  while p<=l do
+    begin
+    c:=S[p];
     case c of
-    #0:
-      if p-PChar(S)=length(S) then
-        break
-      else
-        inc(FCurColumn);
     #10,#13:
       begin
       FCurColumn:=1;
       inc(FCurLine);
       inc(p);
-      if (p^ in [#10,#13]) and (c<>p^) then inc(p);
-      continue;
+      if (p<=l) and (S[p] in [#10,#13]) and (c<>S[p]) then inc(p);
       end;
     else
-      // ignore UTF-8 multibyte chars, CurColumn is char index, not codepoint
+      // Note about UTF-8 multibyte chars: CurColumn is char index, not codepoint
       inc(FCurColumn);
+      inc(p);
+    end;
     end;
-    inc(p);
-  until false;
 end;
 
-function TTextWriter.WriteLn(const S: AnsiString): Integer;
+function TTextWriter.WriteLn(const S: TJSWriterString): Integer;
 begin
   Result:=Write(S)+Write(sLineBreak);
 end;
 
-function TTextWriter.Write(const Fmt: AnsiString;
-  Args: array of const): Integer;
+function TTextWriter.Write(const Fmt: TJSWriterString;
+  Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}): Integer;
 
 begin
   Result:=Write(Format(Fmt,Args));
 end;
 
-function TTextWriter.WriteLn(const Fmt: AnsiString;
-  Args: array of const): Integer;
+function TTextWriter.WriteLn(const Fmt: TJSWriterString;
+  Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}): Integer;
 begin
   Result:=WriteLn(Format(Fmt,Args));
 end;
 
-function TTextWriter.Write(const Args: array of const): Integer;
+function TTextWriter.Write(const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}): Integer;
 
 Var
   I : Integer;
+  {$ifdef pas2js}
+  V: jsvalue;
+  S: TJSWriterString;
+  {$else}
   V : TVarRec;
   S : String;
   U : UnicodeString;
-
+  {$endif}
 
 begin
   Result:=0;
@@ -1851,6 +1959,21 @@ begin
     begin
     V:=Args[i];
     S:='';
+    {$ifdef pas2js}
+    case jsTypeOf(V) of
+    'boolean':
+      if V then S:='true' else S:='false';
+    'number':
+      if isInteger(V) then
+        S:=str(NativeInt(V))
+      else
+        S:=str(Double(V));
+    'string':
+      S:=String(V);
+    else continue;
+    end;
+    Result:=Result+Write(S);
+    {$else}
     U:='';
     case V.VType of
        vtInteger       : Str(V.VInteger,S);
@@ -1873,10 +1996,12 @@ begin
       Result:=Result+Write(u)
     else if (S<>'') then
       Result:=Result+Write(s);
+    {$endif}
     end;
 end;
 
-function TTextWriter.WriteLn(const Args: array of const): Integer;
+function TTextWriter.WriteLn(
+  const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}): Integer;
 begin
   Result:=Write(Args)+Writeln('');
 end;

packages/fcl-json/src/jsonscanner.pp

@@ -15,6 +15,10 @@
 {$mode objfpc}
 {$h+}
 
+{$ifdef fpc}
+  {$define UsePChar}
+{$endif}
+
 unit jsonscanner;
 
 interface
@@ -48,7 +52,7 @@ type
     tkUnknown
     );
 
-  EScannerError       = class(EParserError);
+  EScannerError = class(EParserError);
 
   TJSONOption = (joUTF8,joStrict,joComments,joIgnoreTrailingComma);
   TJSONOptions = set of TJSONOption;
@@ -62,24 +66,27 @@ Type
 
   TJSONScanner = class
   private
-    FSource : TStringList;
+    FSource: TStringList;
     FCurRow: Integer;
     FCurToken: TJSONToken;
     FCurTokenString: string;
     FCurLine: string;
-    TokenStr: PChar;
+    FTokenStr: {$ifdef UsePChar}PChar{$else}integer{$endif}; // position inside FCurLine
     FOptions : TJSONOptions;
     function GetCurColumn: Integer; inline;
     function GetO(AIndex: TJSONOption): Boolean;
     procedure SetO(AIndex: TJSONOption; AValue: Boolean);
   protected
     procedure Error(const Msg: string);overload;
-    procedure Error(const Msg: string; Const Args: array of Const);overload;
+    procedure Error(const Msg: string;
+      Const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});overload;
     function DoFetchToken: TJSONToken; inline;
   public
+    {$ifdef fpc}
     constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
     constructor Create(const Source : String; AUseUTF8 : Boolean = True); overload; deprecated  'use options form instead';
     constructor Create(Source: TStream; AOptions: TJSONOptions); overload;
+    {$endif}
     constructor Create(const Source: String; AOptions: TJSONOptions); overload;
     destructor Destroy; override;
     function FetchToken: TJSONToken;
@@ -122,6 +129,7 @@ const
 
 implementation
 
+{$ifdef fpc}
 constructor TJSONScanner.Create(Source : TStream; AUseUTF8 : Boolean = True);
 
 Var
@@ -155,6 +163,7 @@ begin
   FSource.LoadFromStream(Source);
   FOptions:=AOptions;
 end;
+{$endif}
 
 constructor TJSONScanner.Create(const Source: String; AOptions: TJSONOptions);
 begin
@@ -181,7 +190,8 @@ begin
   raise EScannerError.Create(Msg);
 end;
 
-procedure TJSONScanner.Error(const Msg: string; const Args: array of const);
+procedure TJSONScanner.Error(const Msg: string;
+  const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});
 begin
   raise EScannerError.CreateFmt(Msg, Args);
 end;
@@ -194,13 +204,13 @@ function TJSONScanner.DoFetchToken: TJSONToken;
     if Result then
       begin
       FCurLine:=FSource[FCurRow];
-      TokenStr:=PChar(FCurLine);
+      FTokenStr:=PChar(FCurLine);
       Inc(FCurRow);
       end
     else             
       begin
       FCurLine:='';
-      TokenStr:=nil;
+      FTokenStr:=nil;
       end;
   end;
 
@@ -208,13 +218,33 @@ var
   TokenStart: PChar;
   it : TJSONToken;
   I : Integer;
-  OldLength, SectionLength,  tstart,tcol, u: Integer;
+  OldLength, SectionLength,  tstart,tcol, u1,u2: Integer;
   C , c2: char;
   S : String;
   IsStar,EOC: Boolean;
 
+  Procedure MaybeAppendUnicode;
+
+  Var
+    u : String;
+
+  begin
+  // if there is a leftover \u, append
+  if (u1<>0) then
+    begin
+    if (joUTF8 in Options) or (DefaultSystemCodePage=CP_UTF8) then
+      U:=Utf8Encode(WideString(WideChar(u1))) // ToDo: use faster function
+    else
+      U:=String(WideChar(u1)); // WideChar converts the encoding. Should it warn on loss?
+    FCurTokenString:=FCurTokenString+U;
+    OldLength:=Length(FCurTokenString);
+    u1:=0;
+    end;
+  end;
+
+
 begin
-  if TokenStr = nil then
+  if FTokenStr = nil then
     if not FetchLine then
       begin
       Result := tkEOF;
@@ -224,7 +254,7 @@ begin
 
   FCurTokenString := '';
 
-  case TokenStr[0] of
+  case FTokenStr[0] of
     #0:         // Empty line
       begin
       FetchLine;
@@ -234,33 +264,34 @@ begin
       begin
       Result := tkWhitespace;
       repeat
-        Inc(TokenStr);
-        if TokenStr[0] = #0 then
+        Inc(FTokenStr);
+        if FTokenStr[0] = #0 then
           if not FetchLine then
           begin
             FCurToken := Result;
             exit;
           end;
-      until not (TokenStr[0] in [#9, ' ']);
+      until not (FTokenStr[0] in [#9, ' ']);
       end;
     '"','''':
       begin
-        C:=TokenStr[0];
+        C:=FTokenStr[0];
         If (C='''') and (joStrict in Options) then
-          Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
-        Inc(TokenStr);
-        TokenStart := TokenStr;
+          Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
+        Inc(FTokenStr);
+        TokenStart := FTokenStr;
         OldLength := 0;
         FCurTokenString := '';
-        while not (TokenStr[0] in [#0,C]) do
+        u1:=0;
+        while not (FTokenStr[0] in [#0,C]) do
           begin
-          if (TokenStr[0]='\') then
+          if (FTokenStr[0]='\') then
             begin
             // Save length
-            SectionLength := TokenStr - TokenStart;
-            Inc(TokenStr);
+            SectionLength := FTokenStr - TokenStart;
+            Inc(FTokenStr);
             // Read escaped token
-            Case TokenStr[0] of
+            Case FTokenStr[0] of
               '"' : S:='"';
               '''' : S:='''';
               't' : S:=#9;
@@ -272,90 +303,111 @@ begin
               '/' : S:='/';
               'u' : begin
                     S:='0000';
-                    u:=0;
+                    u2:=0;
                     For I:=1 to 4 do
                       begin
-                      Inc(TokenStr);
-                      c2:=TokenStr^;
+                      Inc(FTokenStr);
+                      c2:=FTokenStr^;
                       Case c2 of
-                        '0'..'9': u:=u*16+ord(c2)-ord('0');
-                        'A'..'F': u:=u*16+ord(c2)-ord('A')+10;
-                        'a'..'f': u:=u*16+ord(c2)-ord('a')+10;
+                        '0'..'9': u2:=u2*16+ord(c2)-ord('0');
+                        'A'..'F': u2:=u2*16+ord(c2)-ord('A')+10;
+                        'a'..'f': u2:=u2*16+ord(c2)-ord('a')+10;
                       else
-                        Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
+                        Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
                       end;
                       end;
                     // ToDo: 4-bytes UTF16
-                    if (joUTF8 in Options) or (DefaultSystemCodePage=CP_UTF8) then
-                      S:=Utf8Encode(WideString(WideChar(u))) // ToDo: use faster function
+                    if u1<>0 then
+                      begin
+                      if (joUTF8 in Options) or (DefaultSystemCodePage=CP_UTF8) then
+                        S:=Utf8Encode(WideString(WideChar(u1)+WideChar(u2))) // ToDo: use faster function
+                      else
+                        S:=String(WideChar(u1)+WideChar(u2)); // WideChar converts the encoding. Should it warn on loss?
+                      u1:=0;
+                      end
                     else
-                      S:=String(WideChar(u)); // WideChar converts the encoding. Should it warn on loss?
+                      begin
+                      S:='';
+                      u1:=u2;
+                      end
                     end;
               #0  : Error(SErrOpenString);
             else
-              Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
+              Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
             end;
-            SetLength(FCurTokenString, OldLength + SectionLength+1+Length(S));
-            if SectionLength > 0 then
-              Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
-            Move(S[1],FCurTokenString[OldLength + SectionLength+1],Length(S));
-            Inc(OldLength, SectionLength+Length(S));
+            I:=Length(S);
+            if (SectionLength+I>0) then
+              begin
+              // If length=1, we know it was not \uXX, but u1 can be nonzero, and we must first append it.
+              // example: \u00f8\"
+              if I=1 then
+                MaybeAppendUnicode;
+              SetLength(FCurTokenString, OldLength + SectionLength+Length(S));
+              if SectionLength > 0 then
+                Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
+              if I>0 then
+                Move(S[1],FCurTokenString[OldLength + SectionLength+1],i);
+              Inc(OldLength, SectionLength+Length(S));
+              end;
             // Next char
-            TokenStart := TokenStr+1;
-            end;
-          if TokenStr[0] = #0 then
+            TokenStart := FTokenStr+1;
+            end
+          else
+            MaybeAppendUnicode;
+          if FTokenStr[0] = #0 then
             Error(SErrOpenString);
-          Inc(TokenStr);
+          Inc(FTokenStr);
           end;
-        if TokenStr[0] = #0 then
+        if FTokenStr[0] = #0 then
           Error(SErrOpenString);
-        SectionLength := TokenStr - TokenStart;
+        MaybeAppendUnicode;
+        SectionLength := FTokenStr - TokenStart;
         SetLength(FCurTokenString, OldLength + SectionLength);
         if SectionLength > 0 then
           Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
-        Inc(TokenStr);
+        Inc(FTokenStr);
         Result := tkString;
       end;
     ',':
       begin
-        Inc(TokenStr);
+        Inc(FTokenStr);
         Result := tkComma;
       end;
     '0'..'9','.','-':
       begin
-        TokenStart := TokenStr;
+        TokenStart := FTokenStr;
         while true do
         begin
-          Inc(TokenStr);
-          case TokenStr[0] of
+          Inc(FTokenStr);
+          case FTokenStr[0] of
             '.':
               begin
-                if TokenStr[1] in ['0'..'9', 'e', 'E'] then
+                if FTokenStr[1] in ['0'..'9', 'e', 'E'] then
                 begin
-                  Inc(TokenStr);
+                  Inc(FTokenStr);
                   repeat
-                    Inc(TokenStr);
-                  until not (TokenStr[0] in ['0'..'9', 'e', 'E','-','+']);
+                    Inc(FTokenStr);
+                  until not (FTokenStr[0] in ['0'..'9', 'e', 'E','-','+']);
                 end;
                 break;
               end;
             '0'..'9': ;
             'e', 'E':
               begin
-                Inc(TokenStr);
-                if TokenStr[0] in ['-','+']  then
-                  Inc(TokenStr);
-                while TokenStr[0] in ['0'..'9'] do
-                  Inc(TokenStr);
+                Inc(FTokenStr);
+                if FTokenStr[0] in ['-','+']  then
+                  Inc(FTokenStr);
+                while FTokenStr[0] in ['0'..'9'] do
+                  Inc(FTokenStr);
                 break;
               end;
           else
-            if not (TokenStr[0] in [#0,'}',']',',',#9,' ']) then
-               Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
+            if not (FTokenStr[0] in [#0,'}',']',',',#9,' ']) then
+               Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
             break;
           end;
         end;
-        SectionLength := TokenStr - TokenStart;
+        SectionLength := FTokenStr - TokenStart;
         FCurTokenString:='';
         SetString(FCurTokenString, TokenStart, SectionLength);
         If (FCurTokenString[1]='.') then
@@ -364,74 +416,74 @@ begin
       end;
     ':':
       begin
-        Inc(TokenStr);
+        Inc(FTokenStr);
         Result := tkColon;
       end;
     '{':
       begin
-        Inc(TokenStr);
+        Inc(FTokenStr);
         Result := tkCurlyBraceOpen;
       end;
     '}':
       begin
-        Inc(TokenStr);
+        Inc(FTokenStr);
         Result := tkCurlyBraceClose;
       end;  
     '[':
       begin
-        Inc(TokenStr);
+        Inc(FTokenStr);
         Result := tkSquaredBraceOpen;
       end;
     ']':
       begin
-        Inc(TokenStr);
+        Inc(FTokenStr);
         Result := tkSquaredBraceClose;
       end;
     '/' :
       begin
       if Not (joComments in Options) then
-        Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
-      TokenStart:=TokenStr;
-      Inc(TokenStr);
-      Case Tokenstr[0] of
+        Error(SErrInvalidCharacter, [CurRow,CurCOlumn,FTokenStr[0]]);
+      TokenStart:=FTokenStr;
+      Inc(FTokenStr);
+      Case FTokenStr[0] of
         '/' : begin
-              SectionLength := Length(FCurLine)- (TokenStr - PChar(FCurLine));
-              Inc(TokenStr);
+              SectionLength := Length(FCurLine)- (FTokenStr - PChar(FCurLine));
+              Inc(FTokenStr);
               FCurTokenString:='';
-              SetString(FCurTokenString, TokenStr, SectionLength);
+              SetString(FCurTokenString, FTokenStr, SectionLength);
               Fetchline;
               end;
         '*' :
           begin
           IsStar:=False;
-          Inc(TokenStr);
-          TokenStart:=TokenStr;
+          Inc(FTokenStr);
+          TokenStart:=FTokenStr;
           Repeat
-            if (TokenStr[0]=#0) then
+            if (FTokenStr[0]=#0) then
               begin
-              SectionLength := (TokenStr - TokenStart);
+              SectionLength := (FTokenStr - TokenStart);
               S:='';
               SetString(S, TokenStart, SectionLength);
               FCurtokenString:=FCurtokenString+S;
               if not fetchLine then
-                Error(SUnterminatedComment, [CurRow,CurCOlumn,TokenStr[0]]);
-              TokenStart:=TokenStr;
+                Error(SUnterminatedComment, [CurRow,CurCOlumn,FTokenStr[0]]);
+              TokenStart:=FTokenStr;
               end;
-            IsStar:=TokenStr[0]='*';
-            Inc(TokenStr);
-            EOC:=(isStar and (TokenStr[0]='/'));
+            IsStar:=FTokenStr[0]='*';
+            Inc(FTokenStr);
+            EOC:=(isStar and (FTokenStr[0]='/'));
           Until EOC;
           if EOC then
             begin
-            SectionLength := (TokenStr - TokenStart-1);
+            SectionLength := (FTokenStr - TokenStart-1);
             S:='';
             SetString(S, TokenStart, SectionLength);
             FCurtokenString:=FCurtokenString+S;
-            Inc(TokenStr);
+            Inc(FTokenStr);
             end;
           end;
       else
-        Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
+        Error(SErrInvalidCharacter, [CurRow,CurCOlumn,FTokenStr[0]]);
       end;
       Result:=tkComment;
       end;
@@ -439,11 +491,11 @@ begin
       begin
         tstart:=CurRow;
         Tcol:=CurColumn;
-        TokenStart := TokenStr;
+        TokenStart := FTokenStr;
         repeat
-          Inc(TokenStr);
-        until not (TokenStr[0] in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
-        SectionLength := TokenStr - TokenStart;
+          Inc(FTokenStr);
+        until not (FTokenStr[0] in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
+        SectionLength := FTokenStr - TokenStart;
         FCurTokenString:='';
         SetString(FCurTokenString, TokenStart, SectionLength);
         for it := tkTrue to tkNull do
@@ -459,7 +511,7 @@ begin
           Result:=tkIdentifier;
       end;
   else
-    Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
+    Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
   end;
 
   FCurToken := Result;
@@ -467,7 +519,7 @@ end;
 
 function TJSONScanner.GetCurColumn: Integer;
 begin
-  Result := TokenStr - PChar(CurLine);
+  Result := FTokenStr - PChar(CurLine);
 end;
 
 function TJSONScanner.GetO(AIndex: TJSONOption): Boolean;

packages/fcl-json/tests/testjson.lpi

@@ -15,20 +15,17 @@
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
-      <IgnoreBinaries Value="False"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
     </PublishOptions>
     <RunParams>
       <local>
-        <CommandLineParams Value="--suite=TTestParser.TestArray"/>
+        <CommandLineParams Value="--suite=TTestJSONString.TestJSONStringToString"/>
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
       <FormatVersion Value="2"/>
       <Modes Count="1">
         <Mode0 Name="default">
           <local>
-            <CommandLineParams Value="--suite=TTestParser.TestArray"/>
+            <CommandLineParams Value="--suite=TTestJSONString.TestJSONStringToString"/>
             <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
           </local>
         </Mode0>

packages/fcl-json/tests/testjson.pp

@@ -17,6 +17,9 @@
 program testjson;
 
 uses
+  {$ifdef unix}
+  cwstring,
+  {$endif}
   Classes, testjsondata, testjsonparser, testjsonrtti, consoletestrunner, testjsonreader;
 
 type

packages/fcl-json/tests/testjsondata.pp

@@ -3412,12 +3412,13 @@ begin
     TestJSON(O,'{ "x" : 1, "y" : 2 }');
     AssertEquals('Format equals JSON',O.AsJSON,O.FormatJSON([foSingleLineObject]));
     AssertEquals('Format using SkipWhiteSpace','{"x":1,"y":2}',O.FormatJSON([foSingleLineObject,foSkipWhiteSpace]));
+    AssertEquals('Format using SkipWhiteSpace,foSkipWhiteSpaceOnlyLeading','{"x": 1,"y": 2}',O.FormatJSON([foSingleLineObject,foSkipWhiteSpace,foSkipWhiteSpaceOnlyLeading]));
     AssertEquals('Format using SkipWhiteSpace,unquotednames','{x:1,y:2}',O.FormatJSON([foSingleLineObject,foSkipWhiteSpace,foDoNotQuoteMembers]));
-    AssertEquals('Format 1','{'+sLineBreak+'  "x" : 1,'+sLineBreak+'  "y" : 2'+sLineBreak+'}',O.FormatJSON([]));
-    AssertEquals('Format 1','{'+sLineBreak+'  x : 1,'+sLineBreak+'  y : 2'+sLineBreak+'}',O.FormatJSON([foDoNotQuoteMembers]));
-    AssertEquals('Format 1','{'+sLineBreak+#9'x : 1,'+sLineBreak+#9'y : 2'+sLineBreak+'}',O.FormatJSON([foUseTabChar,foDoNotQuoteMembers],1));
+    AssertEquals('Format []','{'+sLineBreak+'  "x" : 1,'+sLineBreak+'  "y" : 2'+sLineBreak+'}',O.FormatJSON([]));
+    AssertEquals('Format [foDoNotQuoteMembers]','{'+sLineBreak+'  x : 1,'+sLineBreak+'  y : 2'+sLineBreak+'}',O.FormatJSON([foDoNotQuoteMembers]));
+    AssertEquals('Format [foUseTabChar,foDoNotQuoteMembers]','{'+sLineBreak+#9'x : 1,'+sLineBreak+#9'y : 2'+sLineBreak+'}',O.FormatJSON([foUseTabChar,foDoNotQuoteMembers],1));
     O.Add('s',TJSONObject.Create(['w',10,'h',20]));
-    AssertEquals('Format 1','{'+sLineBreak+#9'x : 1,'+sLineBreak+#9'y : 2,'+sLineBreak+#9's : {'+sLineBreak+#9#9'w : 10,'+sLineBreak+#9#9'h : 20'+sLineBreak+#9'}'+sLineBreak+'}',O.FormatJSON([foUseTabChar,foDoNotQuoteMembers],1));
+    AssertEquals('Format [foUseTabChar,foDoNotQuoteMembers] 2','{'+sLineBreak+#9'x : 1,'+sLineBreak+#9'y : 2,'+sLineBreak+#9's : {'+sLineBreak+#9#9'w : 10,'+sLineBreak+#9#9'h : 20'+sLineBreak+#9'}'+sLineBreak+'}',O.FormatJSON([foUseTabChar,foDoNotQuoteMembers],1));
   finally
     O.Free;
   end;
@@ -3992,6 +3993,11 @@ begin
 end;
 
 procedure TTestJSONString.TestJSONStringToString;
+
+Const
+  // Glowing star in UTF8
+  GlowingStar = #$F0#$9F#$8C#$9F;
+
 begin
   TestFrom('','');
   TestFrom('A','A');
@@ -4028,6 +4034,9 @@ begin
   TestFrom('\n\n',#10#10);
   TestFrom('\f\f',#12#12);
   TestFrom('\r\r',#13#13);
+  TestFrom('\u00f8','ø'); // this is ø
+  TestFrom('\u00f8\"','ø"'); // this is ø"
+  TestFrom('\ud83c\udf1f',GlowingStar);
 end;
 
 procedure TTestJSONString.TestStringToJSONString;

packages/fcl-json/tests/testjsonparser.pp

@@ -37,6 +37,7 @@ type
     procedure DoTestFloat(F: TJSONFloat); overload;
     procedure DoTestFloat(F: TJSONFloat; S: String); overload;
     procedure DoTestObject(S: String; const ElNames: array of String; DoJSONTest : Boolean = True);
+    procedure DoTestString(S : String; AResult : String);
     procedure DoTestString(S : String);
     procedure DoTestArray(S: String; ACount: Integer; IgnoreJSON: Boolean=False);
     Procedure DoTestClass(S : String; AClass : TJSONDataClass);
@@ -79,7 +80,7 @@ Var
   J : TJSONData;
   
 begin
-  P:=TJSONParser.Create('');
+  P:=TJSONParser.Create('',[joUTF8]);
   Try
     J:=P.Parse;
     If (J<>Nil) then
@@ -97,7 +98,7 @@ Var
   J : TJSONData;
 
 begin
-  P:=TJSONParser.Create('1');
+  P:=TJSONParser.Create('1',[joUTF8]);
   Try
     J:=P.Parse;
     If (J=Nil) then
@@ -117,7 +118,7 @@ Var
   J : TJSONData;
 
 begin
-  P:=TJSONParser.Create('123456789012345');
+  P:=TJSONParser.Create('123456789012345',[joUTF8]);
   Try
     J:=P.Parse;
     If (J=Nil) then
@@ -137,7 +138,7 @@ Var
   J : TJSONData;
 
 begin
-  P:=TJSONParser.Create('null');
+  P:=TJSONParser.Create('null',[joUTF8]);
   Try
     J:=P.Parse;
     If (J=Nil) then
@@ -156,7 +157,7 @@ Var
   J : TJSONData;
 
 begin
-  P:=TJSONParser.Create('true');
+  P:=TJSONParser.Create('true',[joUTF8]);
   Try
     J:=P.Parse;
     If (J=Nil) then
@@ -176,7 +177,7 @@ Var
   J : TJSONData;
 
 begin
-  P:=TJSONParser.Create('false');
+  P:=TJSONParser.Create('false',[joUTF8]);
   Try
     J:=P.Parse;
     If (J=Nil) then
@@ -206,10 +207,18 @@ end;
 
 procedure TTestParser.TestString;
 
+Const
+  // Glowing star in UTF8
+  GlowingStar = #$F0#$9F#$8C#$9F;
+
 begin
   DoTestString('A string');
   DoTestString('');
   DoTestString('\"');
+  DoTestString('\u00f8','ø'); // this is ø
+  DoTestString('\u00f8\"','ø"'); // this is ø"
+//  Writeln(GlowingStar);
+  DoTestString('\ud83c\udf1f',GlowingStar);
 end;
 
 
@@ -348,7 +357,7 @@ Var
 
 begin
   J:=Nil;
-  P:=TJSONParser.Create(S);
+  P:=TJSONParser.Create(S,[joUTF8]);
   Try
     P.Options:=FOptions;
     J:=P.Parse;
@@ -400,7 +409,7 @@ Var
   D : TJSONData;
 
 begin
-  P:=TJSONParser.Create(S);
+  P:=TJSONParser.Create(S,[joUTF8]);
   try
     D:=P.Parse;
     try
@@ -536,7 +545,7 @@ Var
 
 begin
   ParseOK:=False;
-  P:=TJSONParser.Create(S);
+  P:=TJSONParser.Create(S,[joUTF8]);
   P.OPtions:=Options;
   J:=Nil;
   Try
@@ -561,24 +570,30 @@ end;
 
 procedure TTestParser.DoTestString(S: String);
 
+begin
+  DoTestString(S,JSONStringToString(S));
+end;
+
+procedure TTestParser.DoTestString(S: String; AResult : String);
+
 Var
   P : TJSONParser;
   J : TJSONData;
 
 begin
-  P:=TJSONParser.Create('"'+S+'"');
+  P:=TJSONParser.Create('"'+S+'"',[joUTF8]);
   Try
     J:=P.Parse;
     If (J=Nil) then
       Fail('Parse of string "'+S+'" fails');
     TestJSONType(J,jtString);
-    TestAsString(J,JSONStringToString(S));
-    TestJSON(J,'"'+S+'"');
+    TestAsString(J,aResult);
+    if Pos('\u',S)=0 then
+      TestJSON(J,'"'+S+'"');
   Finally
     FreeAndNil(J);
     FreeAndNil(P);
   end;
-
 end;
 
 procedure TTestParser.DoTestFloat(F : TJSONFloat);
@@ -598,7 +613,7 @@ Var
   J : TJSONData;
 
 begin
-  P:=TJSONParser.Create(S);
+  P:=TJSONParser.Create(S,[joUTF8]);
   Try
     J:=P.Parse;
     If (J=Nil) then

packages/fcl-passrc/src/pastree.pp

@@ -135,8 +135,12 @@ type
     FParent: TPasElement;
     FHints : TPasMemberHints;
     FHintMessage : String;
+    {$ifdef pas2js}
+    FPasElementId: NativeInt;
+    class var FLastPasElementId: NativeInt;
+    {$endif}
     {$ifdef EnablePasTreeGlobalRefCount}
-    class var FGlobalRefCount: int64;
+    class var FGlobalRefCount: NativeInt;
     {$endif}
   protected
     procedure ProcessHints(const ASemiColonPrefix: boolean; var AResult: string); virtual;
@@ -175,11 +179,14 @@ type
     property RefCount: LongWord read FRefCount;
     property Name: string read FName write FName;
     property Parent: TPasElement read FParent Write SetParent;
-    Property Hints : TPasMemberHints Read FHints Write FHints;
-    Property HintMessage : String Read FHintMessage Write FHintMessage;
-    Property DocComment : String Read FDocComment Write FDocComment;
+    property Hints : TPasMemberHints Read FHints Write FHints;
+    property HintMessage : String Read FHintMessage Write FHintMessage;
+    property DocComment : String Read FDocComment Write FDocComment;
+    {$ifdef pas2js}
+    property PasElementId: NativeInt read FPasElementId; // global unique id
+    {$endif}
     {$ifdef EnablePasTreeGlobalRefCount}
-    class property GlobalRefCount: int64 read FGlobalRefCount write FGlobalRefCount;
+    class property GlobalRefCount: NativeInt read FGlobalRefCount write FGlobalRefCount;
     {$endif}
   end;
 
@@ -234,8 +241,8 @@ type
   { TPrimitiveExpr }
 
   TPrimitiveExpr = class(TPasExpr)
-    Value     : AnsiString;
-    constructor Create(AParent : TPasElement; AKind: TPasExprKind; const AValue : Ansistring); overload;
+    Value     : String;
+    constructor Create(AParent : TPasElement; AKind: TPasExprKind; const AValue : string); overload;
     function GetDeclaration(full : Boolean) : string; override;
   end;
   
@@ -1524,7 +1531,7 @@ Type
 
   TPasImplLabelMark = class(TPasImplElement)
   public
-    LabelId: AnsiString;
+    LabelId: String;
   end;
 
   { TPassTreeVisitor }
@@ -1535,8 +1542,8 @@ Type
   end;
 
 const
-  AccessNames: array[TArgumentAccess] of string[9] = ('', 'const ', 'var ', 'out ','constref ');
-  AccessDescriptions: array[TArgumentAccess] of string[9] = ('default', 'const', 'var', 'out','constref');
+  AccessNames: array[TArgumentAccess] of string{$ifdef fpc}[9]{$endif} = ('', 'const ', 'var ', 'out ','constref ');
+  AccessDescriptions: array[TArgumentAccess] of string{$ifdef fpc}[9]{$endif} = ('default', 'const', 'var', 'out','constref');
   AllVisibilities: TPasMemberVisibilities =
      [visDefault, visPrivate, visProtected, visPublic,
       visPublished, visAutomated];
@@ -2031,16 +2038,7 @@ begin
   Result:=SPasTreeUnit;
 end;
 
-{ TPasStringType }
-
-
-{$IFNDEF FPC}
-  const
-    LineEnding = sLineBreak;
-{$ENDIF}
-
 { Parse tree element type name functions }
-
 function TPasElement.ElementTypeName: string; begin Result := SPasTreeElement end;
 
 function TPasElement.HintsString: String;
@@ -2308,6 +2306,11 @@ begin
   inherited Create;
   FName := AName;
   FParent := AParent;
+  {$ifdef pas2js}
+  inc(FLastPasElementId);
+  FPasElementId:=FLastPasElementId;
+  //writeln('TPasElement.Create ',Name,':',ClassName,' ID=[',FPasElementId,']');
+  {$endif}
   {$ifdef EnablePasTreeGlobalRefCount}
   Inc(FGlobalRefCount);
   {$endif}
@@ -2407,7 +2410,11 @@ begin
   if FRefCount = 0 then
     begin
     FRefCount:=High(FRefCount);
+    {$ifdef pas2js}
+    Destroy;
+    {$else}
     Free;
+    {$endif}
     end
   else if FRefCount=High(FRefCount) then
     begin
@@ -4912,7 +4919,7 @@ begin
   if full then ;
 end;
 
-constructor TPrimitiveExpr.Create(AParent : TPasElement; AKind: TPasExprKind; const AValue : Ansistring);
+constructor TPrimitiveExpr.Create(AParent : TPasElement; AKind: TPasExprKind; const AValue : string);
 begin
   inherited Create(AParent,AKind, eopNone);
   Value:=AValue;

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -39,12 +39,23 @@ Working:
 }
 unit PasUseAnalyzer;
 
-{$mode objfpc}{$H+}{$inline on}
+{$mode objfpc}{$H+}
+{$inline on}
+
+{$ifdef fpc}
+  {$define UsePChar}
+  {$define HasInt64}
+{$endif}
 
 interface
 
 uses
-  Classes, SysUtils, Types, AVL_Tree,
+  {$ifdef pas2js}
+  js,
+  {$else}
+  AVL_Tree,
+  {$endif}
+  Classes, SysUtils, Types,
   PasTree, PScanner, PasResolveEval, PasResolver;
 
 const
@@ -88,7 +99,7 @@ type
   private
     FRefCount: integer;
   public
-    Id: int64;
+    Id: TMaxPrecInt;
     MsgType: TMessageType;
     MsgNumber: integer;
     MsgText: string;
@@ -148,6 +159,43 @@ type
     property Overrides[Index: integer]: TPasElement read GetOverrides; default;
   end;
 
+  {$ifdef pas2js}
+  TPASItemToNameProc = function(Item: Pointer): String;
+  {$endif}
+
+  { TPasAnalyzerKeySet - set of items, each item has a key, no duplicate keys }
+
+  TPasAnalyzerKeySet = class
+  private
+    {$ifdef pas2js}
+    FItems: TJSObject;
+    FCount: integer;
+    FItemToName: TPASItemToNameProc;
+    FKeyToName: TPASItemToNameProc;
+    {$else}
+    FTree: TAVLTree; // tree of pointers, sorted for keys given by OnItemToKey, no duplicate keys
+    FCompareKeyWithData: TListSortCompare;
+    {$endif}
+  public
+    {$ifdef pas2js}
+    constructor Create(const OnItemToName, OnKeyToName: TPASItemToNameProc); reintroduce;
+    {$else}
+    constructor Create(const OnCompareMethod: TListSortCompare;
+      const OnCompareKeyWithData: TListSortCompare);
+    {$endif}
+    destructor Destroy; override;
+    procedure Clear;
+    procedure FreeItems;
+    procedure Add(Item: Pointer; CheckDuplicates: boolean = true);
+    procedure Remove(Item: Pointer);
+    function ContainsItem(Item: Pointer): boolean;
+    function ContainsKey(Key: Pointer): boolean;
+    function FindItem(Item: Pointer): Pointer;
+    function FindKey(Key: Pointer): Pointer;
+    function Count: integer;
+    function GetList: TFPList; // list of items
+  end;
+
   TPasAnalyzerOption = (
     paoOnlyExports, // default: use all class members accessible from outside (protected, but not private)
     paoImplReferences // collect references of top lvl proc implementations, initializationa dn finalization sections
@@ -175,29 +223,26 @@ type
 
   TPasAnalyzer = class
   private
-    FChecked: array[TPAUseMode] of TAVLTree; // tree of TElement
+    FChecked: array[TPAUseMode] of TPasAnalyzerKeySet; // tree of TElement
     FOnMessage: TPAMessageEvent;
     FOptions: TPasAnalyzerOptions;
-    FOverrideLists: TAVLTree; // tree of TPAOverrideList sorted for Element
+    FOverrideLists: TPasAnalyzerKeySet; // tree of TPAOverrideList sorted for Element
     FResolver: TPasResolver;
     FScopeModule: TPasModule;
-    FUsedElements: TAVLTree; // tree of TPAElement sorted for Element
+    FUsedElements: TPasAnalyzerKeySet; // tree of TPAElement sorted for Element
     procedure UseElType(El: TPasElement; aType: TPasType; Mode: TPAUseMode); inline;
     function AddOverride(OverriddenEl, OverrideEl: TPasElement): boolean;
-    function FindOverrideNode(El: TPasElement): TAVLTreeNode;
-    function FindOverrideList(El: TPasElement): TPAOverrideList;
     procedure SetOptions(AValue: TPasAnalyzerOptions);
     procedure UpdateAccess(IsWrite: Boolean; IsRead: Boolean; Usage: TPAElement);
     procedure OnUseScopeRef(Data, DeclScope: pointer);
   protected
-    procedure RaiseInconsistency(const Id: int64; Msg: string);
-    procedure RaiseNotSupported(const Id: int64; El: TPasElement; const Msg: string = '');
+    procedure RaiseInconsistency(const Id: TMaxPrecInt; Msg: string);
+    procedure RaiseNotSupported(const Id: TMaxPrecInt; El: TPasElement; const Msg: string = '');
     function FindTopImplScope(El: TPasElement): TPasScope;
     // mark used elements
     function Add(El: TPasElement; CheckDuplicate: boolean = true;
       aClass: TPAElementClass = nil): TPAElement;
-    function FindNode(El: TPasElement): TAVLTreeNode; inline;
-    function FindPAElement(El: TPasElement): TPAElement; inline;
+    function PAElementExists(El: TPasElement): boolean; inline;
     procedure CreateTree; virtual;
     function MarkElementAsUsed(El: TPasElement; aClass: TPAElementClass = nil): boolean; // true if new
     function ElementVisited(El: TPasElement; Mode: TPAUseMode): boolean;
@@ -238,7 +283,7 @@ type
     procedure AnalyzeModule(aModule: TPasModule);
     procedure AnalyzeWholeProgram(aStartModule: TPasProgram);
     procedure EmitModuleHints(aModule: TPasModule); virtual;
-    function FindElement(El: TPasElement): TPAElement;
+    function FindElement(El: TPasElement): TPAElement; inline;
     function FindUsedElement(El: TPasElement): TPAElement;
     // utility
     function IsUsed(El: TPasElement): boolean; // valid after calling Analyze*
@@ -247,8 +292,10 @@ type
     function IsExport(El: TPasElement): boolean;
     function IsIdentifier(El: TPasElement): boolean;
     function IsImplBlockEmpty(El: TPasImplBlock): boolean;
-    procedure EmitMessage(Id: int64; MsgType: TMessageType;
-      MsgNumber: integer; Fmt: String; const Args: array of const; PosEl: TPasElement);
+    procedure EmitMessage(Id: TMaxPrecInt; MsgType: TMessageType;
+      MsgNumber: integer; Fmt: String;
+      const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
+      PosEl: TPasElement);
     procedure EmitMessage(Msg: TPAMessage);
     class function GetWarnIdentifierNumbers(Identifier: string;
       out MsgNumbers: TIntegerDynArray): boolean; virtual;
@@ -259,15 +306,43 @@ type
     property ScopeModule: TPasModule read FScopeModule write FScopeModule;
   end;
 
+{$ifdef pas2js}
+function PasElementToHashName(Item: Pointer): String;
+function PAElement_ElToHashName(Item: Pointer): String;
+function PAOverrideList_ElToHashName(Item: Pointer): String;
+{$else}
 function ComparePAElements(Identifier1, Identifier2: Pointer): integer;
 function CompareElementWithPAElement(El, Id: Pointer): integer;
 function ComparePAOverrideLists(List1, List2: Pointer): integer;
 function CompareElementWithPAOverrideList(El, List: Pointer): integer;
+{$endif}
 function GetElModName(El: TPasElement): string;
 function dbgs(a: TPAIdentifierAccess): string; overload;
 
 implementation
 
+{$ifdef pas2js}
+function PasElementToHashName(Item: Pointer): String;
+var
+  El: TPasElement absolute Item;
+begin
+  Result:=string(jsvalue(El.PasElementId));
+end;
+
+function PAElement_ElToHashName(Item: Pointer): String;
+var
+  El: TPAElement absolute Item;
+begin
+  Result:=string(jsvalue(El.Element.PasElementId));
+end;
+
+function PAOverrideList_ElToHashName(Item: Pointer): String;
+var
+  List: TPAOverrideList absolute Item;
+begin
+  Result:=string(jsvalue(List.Element.PasElementId));
+end;
+{$else}
 function ComparePointer(Data1, Data2: Pointer): integer;
 begin
   if Data1>Data2 then Result:=-1
@@ -304,13 +379,14 @@ var
 begin
   Result:=ComparePointer(El,OvList.Element);
 end;
+{$endif}
 
 function GetElModName(El: TPasElement): string;
 var
   aModule: TPasModule;
 begin
   if El=nil then exit('nil');
-  Result:=El.FullName+':'+El.ClassName;
+  Result:=El.PathName+':'+El.ClassName;
   aModule:=El.GetModule;
   if aModule=El then exit;
   if aModule=nil then
@@ -324,6 +400,194 @@ begin
   str(a,Result);
 end;
 
+{ TPasAnalyzerKeySet }
+
+{$ifdef pas2js}
+constructor TPasAnalyzerKeySet.Create(const OnItemToName,
+  OnKeyToName: TPASItemToNameProc);
+begin
+  FItemToName:=OnItemToName;
+  FKeyToName:=OnKeyToName;
+  FItems:=TJSObject.new;
+end;
+{$else}
+constructor TPasAnalyzerKeySet.Create(const OnCompareMethod: TListSortCompare;
+  const OnCompareKeyWithData: TListSortCompare);
+begin
+  FTree:=TAVLTree.Create(OnCompareMethod);
+  FCompareKeyWithData:=OnCompareKeyWithData;
+end;
+{$endif}
+
+destructor TPasAnalyzerKeySet.Destroy;
+begin
+  {$ifdef pas2js}
+  FItems:=nil;
+  {$else}
+  FreeAndNil(FTree);
+  {$endif}
+  inherited Destroy;
+end;
+
+procedure TPasAnalyzerKeySet.Clear;
+begin
+  {$ifdef pas2js}
+  FItems:=TJSObject.new;
+  FCount:=0;
+  {$else}
+  FTree.Clear;
+  {$endif}
+end;
+
+procedure TPasAnalyzerKeySet.FreeItems;
+{$ifdef pas2js}
+var
+  List: TStringDynArray;
+  i: Integer;
+begin
+  List:=TJSObject.getOwnPropertyNames(FItems);
+  for i:=0 to length(List)-1 do
+    TObject(FItems[List[i]]).Destroy;
+  FItems:=TJSObject.new;
+  FCount:=0;
+end;
+{$else}
+begin
+  FTree.FreeAndClear;
+end;
+{$endif}
+
+procedure TPasAnalyzerKeySet.Add(Item: Pointer; CheckDuplicates: boolean);
+begin
+  if CheckDuplicates {$IFDEF VerbosePasAnalyzer}or true{$endif} then
+    if ContainsItem(Item) then
+      raise Exception.Create('[20181101151755] TPasAnalyzerSet.Add duplicate');
+  {$ifdef pas2js}
+  FItems['%'+FItemToName(Item)]:=Item;
+  inc(FCount);
+  {$else}
+  FTree.Add(Item);
+  {$endif}
+  {$ifdef VerbosePasAnalyzer}
+  if not ContainsItem(Item) then
+    raise Exception.Create('[20181101151811] TPasAnalyzerSet.Add failed');
+  {$endif}
+end;
+
+procedure TPasAnalyzerKeySet.Remove(Item: Pointer);
+{$ifdef pas2js}
+var
+  aName: string;
+begin
+  aName:='%'+FItemToName(Item);
+  if not FItems.hasOwnProperty(aName) then exit;
+  JSDelete(FItems,aName);
+  dec(FCount);
+end;
+{$else}
+begin
+  FTree.Remove(Item);
+end;
+{$endif}
+
+function TPasAnalyzerKeySet.ContainsItem(Item: Pointer): boolean;
+begin
+  {$ifdef pas2js}
+  Result:=FItems.hasOwnProperty('%'+FItemToName(Item));
+  {$else}
+  Result:=FTree.Find(Item)<>nil;
+  {$endif}
+end;
+
+function TPasAnalyzerKeySet.ContainsKey(Key: Pointer): boolean;
+begin
+  {$ifdef pas2js}
+  Result:=FItems.hasOwnProperty('%'+FKeyToName(Key));
+  {$else}
+  Result:=FTree.FindKey(Key,FCompareKeyWithData)<>nil;
+  {$endif}
+end;
+
+function TPasAnalyzerKeySet.FindItem(Item: Pointer): Pointer;
+{$ifdef pas2js}
+var
+  aName: string;
+begin
+  aName:='%'+FItemToName(Item);
+  if not FItems.hasOwnProperty(aName) then
+    exit(nil)
+  else
+    Result:=Pointer(FItems[aName]);
+end;
+{$else}
+var
+  Node: TAVLTreeNode;
+begin
+  Node:=FTree.Find(Item);
+  if Node<>nil then
+    Result:=Node.Data
+  else
+    Result:=nil;
+end;
+{$endif}
+
+function TPasAnalyzerKeySet.FindKey(Key: Pointer): Pointer;
+{$ifdef pas2js}
+var
+  aName: string;
+begin
+  aName:='%'+FKeyToName(Key);
+  if not FItems.hasOwnProperty(aName) then
+    exit(nil)
+  else
+    Result:=Pointer(FItems[aName]);
+end;
+{$else}
+var
+  Node: TAVLTreeNode;
+begin
+  Node:=FTree.FindKey(Key,FCompareKeyWithData);
+  if Node<>nil then
+    Result:=Node.Data
+  else
+    Result:=nil;
+end;
+{$endif}
+
+function TPasAnalyzerKeySet.Count: integer;
+begin
+  {$ifdef pas2js}
+  Result:=FCount;
+  {$else}
+  Result:=FTree.Count;
+  {$endif}
+end;
+
+function TPasAnalyzerKeySet.GetList: TFPList;
+{$ifdef pas2js}
+var
+  List: TStringDynArray;
+  i: Integer;
+begin
+  List:=TJSObject.getOwnPropertyNames(FItems);
+  Result:=TFPList.Create;
+  for i:=0 to length(List)-1 do
+    Result.Add(FItems[List[i]]);
+end;
+{$else}
+var
+  Node: TAVLTreeNode;
+begin
+  Result:=TFPList.Create;
+  Node:=FTree.FindLowest;
+  while Node<>nil do
+    begin
+    Result.Add(Node.Data);
+    Node:=FTree.FindSuccessor(Node);
+    end;
+end;
+{$endif}
+
 { TPAMessage }
 
 constructor TPAMessage.Create;
@@ -342,7 +606,11 @@ begin
     raise Exception.Create('');
   dec(FRefCount);
   if FRefCount=0 then
+    {$ifdef pas2js}
+    Destroy;
+    {$else}
     Free;
+    {$endif}
 end;
 
 { TPAOverrideList }
@@ -417,21 +685,9 @@ end;
 { TPasAnalyzer }
 
 // inline
-function TPasAnalyzer.FindNode(El: TPasElement): TAVLTreeNode;
+function TPasAnalyzer.PAElementExists(El: TPasElement): boolean;
 begin
-  Result:=FUsedElements.FindKey(El,@CompareElementWithPAElement);
-end;
-
-// inline
-function TPasAnalyzer.FindPAElement(El: TPasElement): TPAElement;
-var
-  Node: TAVLTreeNode;
-begin
-  Node:=FindNode(El);
-  if Node=nil then
-    Result:=nil
-  else
-    Result:=TPAElement(Node.Data);
+  Result:=FUsedElements.ContainsKey(El);
 end;
 
 // inline
@@ -443,33 +699,22 @@ begin
   UseType(aType,Mode);
 end;
 
-procedure TPasAnalyzer.SetOptions(AValue: TPasAnalyzerOptions);
-begin
-  if FOptions=AValue then Exit;
-  FOptions:=AValue;
-end;
-
-function TPasAnalyzer.FindOverrideNode(El: TPasElement): TAVLTreeNode;
+// inline
+function TPasAnalyzer.FindElement(El: TPasElement): TPAElement;
 begin
-  Result:=FOverrideLists.FindKey(El,@CompareElementWithPAOverrideList);
+  Result:=TPAElement(FUsedElements.FindKey(El));
 end;
 
-function TPasAnalyzer.FindOverrideList(El: TPasElement): TPAOverrideList;
-var
-  Node: TAVLTreeNode;
+procedure TPasAnalyzer.SetOptions(AValue: TPasAnalyzerOptions);
 begin
-  Node:=FindOverrideNode(El);
-  if Node=nil then
-    Result:=nil
-  else
-    Result:=TPAOverrideList(Node.Data);
+  if FOptions=AValue then Exit;
+  FOptions:=AValue;
 end;
 
 function TPasAnalyzer.AddOverride(OverriddenEl, OverrideEl: TPasElement): boolean;
 // OverrideEl overrides OverriddenEl
 // returns true if new override
 var
-  Node: TAVLTreeNode;
   Item: TPAOverrideList;
   OverriddenPAEl: TPAElement;
   TypeEl: TPasType;
@@ -477,16 +722,15 @@ begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.AddOverride OverriddenEl=',GetElModName(OverriddenEl),' OverrideEl=',GetElModName(OverrideEl));
   {$ENDIF}
-  Node:=FindOverrideNode(OverriddenEl);
-  if Node=nil then
+  Item:=TPAOverrideList(FOverrideLists.FindKey(OverriddenEl));
+  if Item=nil then
     begin
     Item:=TPAOverrideList.Create;
     Item.Element:=OverriddenEl;
-    FOverrideLists.Add(Item);
+    FOverrideLists.Add(Item,false);
     end
   else
     begin
-    Item:=TPAOverrideList(Node.Data);
     if Item.IndexOf(OverrideEl)>=0 then
       exit(false);
     end;
@@ -494,7 +738,7 @@ begin
   Item.Add(OverrideEl);
   Result:=true;
 
-  OverriddenPAEl:=FindPAElement(OverriddenEl);
+  OverriddenPAEl:=FindElement(OverriddenEl);
   if OverriddenPAEl<>nil then
     begin
     // OverriddenEl was already used -> use OverrideEl
@@ -567,7 +811,7 @@ begin
     end;
 end;
 
-procedure TPasAnalyzer.RaiseInconsistency(const Id: int64; Msg: string);
+procedure TPasAnalyzer.RaiseInconsistency(const Id: TMaxPrecInt; Msg: string);
 begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.RaiseInconsistency ['+IntToStr(Id)+']: '+Msg);
@@ -575,7 +819,7 @@ begin
   raise EPasAnalyzer.Create('['+IntToStr(Id)+']: '+Msg);
 end;
 
-procedure TPasAnalyzer.RaiseNotSupported(const Id: int64; El: TPasElement;
+procedure TPasAnalyzer.RaiseNotSupported(const Id: TMaxPrecInt; El: TPasElement;
   const Msg: string);
 var
   s: String;
@@ -626,9 +870,10 @@ begin
   if El=nil then
     RaiseInconsistency(20170308093407,'');
   {$IFDEF VerbosePasAnalyzer}
-  writeln('TPasAnalyzer.Add ',GetElModName(El),' New=',FindNode(El)=nil);
+  writeln('TPasAnalyzer.Add ',GetElModName(El),' New=',not PAElementExists(El){$IFDEF Pas2js},' ID=[',El.PasElementId,']'{$ENDIF});
   {$ENDIF}
-  if CheckDuplicate and (FindNode(El)<>nil) then
+  {$IFDEF VerbosePasAnalyzer}CheckDuplicate:=true;{$ENDIF}
+  if CheckDuplicate and PAElementExists(El) then
     RaiseInconsistency(20170304201318,'');
   if aClass=nil then
     aClass:=TPAElement;
@@ -636,13 +881,18 @@ begin
   Result.Element:=El;
   FUsedElements.Add(Result);
   {$IFDEF VerbosePasAnalyzer}
-  //writeln('TPasAnalyzer.Add END ',GetElModName(El),' Success=',FindNode(El)<>nil,' ',ptruint(pointer(El)));
+  writeln('TPasAnalyzer.Add END ',GetElModName(El),' Success=',PAElementExists(El),' ',{$Ifdef pas2js}El.PasElementId{$else}ptruint(pointer(El)){$endif});
   {$ENDIF}
 end;
 
 procedure TPasAnalyzer.CreateTree;
 begin
-  FUsedElements:=TAVLTree.Create(@ComparePAElements);
+  FUsedElements:=TPasAnalyzerKeySet.Create(
+    {$ifdef pas2js}
+    @PAElement_ElToHashName,@PasElementToHashName
+    {$else}
+    @ComparePAElements,@CompareElementWithPAElement
+    {$endif});
 end;
 
 function TPasAnalyzer.MarkElementAsUsed(El: TPasElement; aClass: TPAElementClass
@@ -650,7 +900,7 @@ function TPasAnalyzer.MarkElementAsUsed(El: TPasElement; aClass: TPAElementClass
 
   function MarkModule(CurModule: TPasModule): boolean;
   begin
-    if FindNode(CurModule)<>nil then
+    if PAElementExists(CurModule) then
       exit(false);
     {$IFDEF VerbosePasAnalyzer}
     writeln('TPasAnalyzer.MarkElement.MarkModule mark "',GetElModName(CurModule),'"');
@@ -686,7 +936,7 @@ begin
     end;
 
   // mark element
-  if FindNode(El)<>nil then exit(false);
+  if PAElementExists(El) then exit(false);
   Add(El,false,aClass);
   Result:=true;
 
@@ -705,9 +955,9 @@ function TPasAnalyzer.ElementVisited(El: TPasElement; Mode: TPAUseMode
 begin
   if El=nil then
     exit(true);
-  if FChecked[Mode].Find(El)<>nil then exit(true);
+  if FChecked[Mode].ContainsItem(El) then exit(true);
   Result:=false;
-  FChecked[Mode].Add(El);
+  FChecked[Mode].Add(El,false);
 end;
 
 procedure TPasAnalyzer.MarkImplScopeRef(El, RefEl: TPasElement;
@@ -900,7 +1150,7 @@ procedure TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode);
     UseScopeReferences(Scope.References);
     if (Scope.References=nil) and IsImplBlockEmpty(ImplBlock) then exit;
     // this module has an initialization section -> mark module
-    if FindNode(aModule)=nil then
+    if not PAElementExists(aModule) then
       Add(aModule);
     UseImplBlock(ImplBlock,true);
   end;
@@ -911,7 +1161,7 @@ begin
   if ElementVisited(aModule,Mode) then exit;
 
   {$IFDEF VerbosePasAnalyzer}
-  writeln('TPasAnalyzer.UseModule ',GetElModName(aModule),' Mode=',Mode);
+  writeln('TPasAnalyzer.UseModule ',GetElModName(aModule),' Mode=',Mode{$IFDEF pas2js},' ',aModule.PasElementId{$ENDIF});
   {$ENDIF}
   if Mode in [paumAllExports,paumAllPasUsable] then
     begin
@@ -936,7 +1186,7 @@ begin
 
   if Mode=paumElement then
     // e.g. a reference: unitname.identifier
-    if FindNode(aModule)=nil then
+    if not PAElementExists(aModule) then
       Add(aModule);
 end;
 
@@ -979,7 +1229,7 @@ begin
         if IsImplBlockEmpty(UsedModule.InitializationSection)
             and IsImplBlockEmpty(UsedModule.FinalizationSection) then
           continue;
-        if FindNode(UsedModule)=nil then
+        if not PAElementExists(UsedModule) then
           Add(UsedModule);
         UseImplBlock(UsedModule.InitializationSection,true);
         UseImplBlock(UsedModule.FinalizationSection,true);
@@ -1112,6 +1362,8 @@ begin
     UseImplElement(TPasImplIfElse(El).IfBranch);
     UseImplElement(TPasImplIfElse(El).ElseBranch);
     end
+  else if C=TPasImplCommand then
+    // used for if-then <empty> -> nothing to do
   else if C=TPasImplLabelMark then
     // label mark
   else if C=TPasImplRepeatUntil then
@@ -1295,6 +1547,11 @@ begin
     for i:=0 to length(Params)-1 do
       UseExpr(Params[i]);
     end
+  else if C=TRecordValues then
+    begin
+    for i:=0 to length(TRecordValues(El).Fields)-1 do
+      UseExpr(TRecordValues(El).Fields[i].ValueExp);
+    end
   else if C=TInheritedExpr then
     UseInheritedExpr(TInheritedExpr(El))
   else
@@ -1309,6 +1566,7 @@ var
   Bin: TBinaryExpr;
   Params: TParamsExpr;
   ValueResolved: TPasResolverResult;
+  Unary: TUnaryExpr;
 begin
   C:=Expr.ClassType;
   if C=TBinaryExpr then
@@ -1346,6 +1604,14 @@ begin
       UseElement(Ref.Declaration,Access,UseFull);
       end;
     end
+  else if C=TUnaryExpr then
+    begin
+    Unary:=TUnaryExpr(Expr);
+    if Unary.OpCode in [eopAdd,eopSubtract,eopAddress,eopDeref,eopMemAddress] then
+      UseExprRef(El,Unary.Operand,rraRead,false)
+    else
+      RaiseNotSupported(20181015193334,Expr,OpcodeStrings[Unary.OpCode]);
+    end
   else if (Access=rraRead)
       and ((C=TPrimitiveExpr) // Kind<>pekIdent
         or (C=TNilExpr)
@@ -1357,7 +1623,7 @@ begin
     {$IFDEF VerbosePasResolver}
     writeln('TPasResolver.UseExprRef Expr=',GetObjName(Expr),' Access=',Access,' Declaration="',Expr.GetDeclaration(false),'"');
     {$ENDIF}
-    RaiseNotSupported(20170306102158,Expr);
+    RaiseNotSupported(20170306102159,Expr);
     end;
 end;
 
@@ -1411,7 +1677,7 @@ procedure TPasAnalyzer.UseProcedure(Proc: TPasProcedure);
     i: Integer;
     OverrideProc: TPasProcedure;
   begin
-    OverrideList:=FindOverrideList(CurProc);
+    OverrideList:=TPAOverrideList(FOverrideLists.FindKey(CurProc));
     if OverrideList=nil then exit;
     // Note: while traversing the OverrideList it may grow
     i:=0;
@@ -1621,7 +1887,7 @@ procedure TPasAnalyzer.UseClassType(El: TPasClassType; Mode: TPAUseMode);
     i: Integer;
     Prop: TPasProperty;
   begin
-    OverrideList:=FindOverrideList(El);
+    OverrideList:=TPAOverrideList(FOverrideLists.FindKey(El));
     if OverrideList=nil then exit;
     // Note: while traversing the OverrideList it may grow
     i:=0;
@@ -2083,7 +2349,7 @@ begin
       begin
       UsedModule:=TPasModule(Use.Module);
       if CompareText(UsedModule.Name,'system')=0 then continue;
-      if FindNode(UsedModule)=nil then
+      if not PAElementExists(UsedModule) then
         EmitMessage(20170311191725,mtHint,nPAUnitNotUsed,sPAUnitNotUsed,
           [UsedModule.Name,aModule.Name],Use.Expr);
       end;
@@ -2112,7 +2378,7 @@ begin
       EmitProcedureHints(TPasProcedure(Decl))
     else
       begin
-      Usage:=FindPAElement(Decl);
+      Usage:=FindElement(Decl);
       if Usage=nil then
         begin
         // declaration was never used
@@ -2133,7 +2399,7 @@ begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitTypeHints ',GetElModName(El));
   {$ENDIF}
-  Usage:=FindPAElement(El);
+  Usage:=FindElement(El);
   if Usage=nil then
     begin
     // the whole type was never used
@@ -2175,7 +2441,7 @@ begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitVariableHints ',GetElModName(El));
   {$ENDIF}
-  Usage:=FindPAElement(El);
+  Usage:=FindElement(El);
   if Usage=nil then
     begin
     // not used
@@ -2235,7 +2501,7 @@ begin
     ImplProc:=El
   else
     ImplProc:=ProcScope.ImplProc;
-  if FindNode(DeclProc)=nil then
+  if not PAElementExists(DeclProc) then
     begin
     // procedure never used
     if ProcScope.DeclarationProc=nil then
@@ -2266,7 +2532,7 @@ begin
     for i:=0 to Args.Count-1 do
       begin
       Arg:=TPasArgument(Args[i]);
-      Usage:=FindPAElement(Arg);
+      Usage:=FindElement(Arg);
       if (Usage=nil) or (Usage.Access=paiaNone) then
         begin
         // parameter was never used
@@ -2292,7 +2558,7 @@ begin
       PosEl:=TPasFunction(El).FuncType.ResultEl;
       if (ProcScope.ImplProc<>nil) and (TPasFunction(ProcScope.ImplProc).FuncType.ResultEl<>nil) then
         PosEl:=TPasFunction(ProcScope.ImplProc).FuncType.ResultEl;
-      Usage:=FindPAElement(TPasFunction(El).FuncType.ResultEl);
+      Usage:=FindElement(TPasFunction(El).FuncType.ResultEl);
       if (Usage=nil) or (Usage.Access in [paiaNone,paiaRead]) then
         // result was never used
         EmitMessage(20170313214038,mtHint,nPAFunctionResultDoesNotSeemToBeSet,
@@ -2318,8 +2584,20 @@ var
 begin
   CreateTree;
   for m in TPAUseMode do
-    FChecked[m]:=TAVLTree.Create;
-  FOverrideLists:=TAVLTree.Create(@ComparePAOverrideLists);
+    FChecked[m]:=TPasAnalyzerKeySet.Create(
+      {$ifdef pas2js}
+      @PasElementToHashName
+      {$else}
+      @ComparePointer
+      {$endif}
+      ,nil
+      );
+  FOverrideLists:=TPasAnalyzerKeySet.Create(
+    {$ifdef pas2js}
+    @PAOverrideList_ElToHashName,@PasElementToHashName
+    {$else}
+    @ComparePAOverrideLists,@CompareElementWithPAOverrideList
+    {$endif});
 end;
 
 destructor TPasAnalyzer.Destroy;
@@ -2338,8 +2616,8 @@ procedure TPasAnalyzer.Clear;
 var
   m: TPAUseMode;
 begin
-  FOverrideLists.FreeAndClear;
-  FUsedElements.FreeAndClear;
+  FOverrideLists.FreeItems;
+  FUsedElements.FreeItems;
   for m in TPAUseMode do
     FChecked[m].Clear;
 end;
@@ -2402,17 +2680,6 @@ begin
   //EmitBlockHints(aModule.FinalizationSection);
 end;
 
-function TPasAnalyzer.FindElement(El: TPasElement): TPAElement;
-var
-  Node: TAVLTreeNode;
-begin
-  Node:=FindNode(El);
-  if Node=nil then
-    Result:=nil
-  else
-    Result:=TPAElement(Node.Data);
-end;
-
 function TPasAnalyzer.FindUsedElement(El: TPasElement): TPAElement;
 var
   ProcScope: TPasProcedureScope;
@@ -2434,7 +2701,7 @@ end;
 
 function TPasAnalyzer.IsTypeInfoUsed(El: TPasElement): boolean;
 begin
-  Result:=FChecked[paumTypeInfo].Find(El)<>nil;
+  Result:=FChecked[paumTypeInfo].ContainsItem(El);
 end;
 
 function TPasAnalyzer.IsModuleInternal(El: TPasElement): boolean;
@@ -2481,8 +2748,9 @@ begin
   Result:=false;
 end;
 
-procedure TPasAnalyzer.EmitMessage(Id: int64; MsgType: TMessageType;
-  MsgNumber: integer; Fmt: String; const Args: array of const;
+procedure TPasAnalyzer.EmitMessage(Id: TMaxPrecInt; MsgType: TMessageType;
+  MsgNumber: integer; Fmt: String;
+  const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
   PosEl: TPasElement);
 var
   Msg: TPAMessage;
@@ -2601,16 +2869,8 @@ begin
 end;
 
 function TPasAnalyzer.GetUsedElements: TFPList;
-var
-  Node: TAVLTreeNode;
 begin
-  Result:=TFPList.Create;
-  Node:=FUsedElements.FindLowest;
-  while Node<>nil do
-    begin
-    Result.Add(Node.Data);
-    Node:=FUsedElements.FindSuccessor(Node);
-    end;
+  Result:=FUsedElements.GetList;
 end;
 
 end.

packages/fcl-passrc/src/pparser.pp

@@ -17,11 +17,24 @@
 {$mode objfpc}
 {$h+}
 
+{$ifdef fpc}
+  {$define UsePChar}
+  {$define UseAnsiStrings}
+  {$define HasStreams}
+  {$IF FPC_FULLVERSION<30101}
+    {$define EmulateArrayInsert}
+  {$endif}
+{$endif}
+
 unit PParser;
 
 interface
 
-uses SysUtils, Classes, PasTree, PScanner;
+uses
+  {$ifdef pas2js}
+  NodeJSFS,
+  {$endif}
+  SysUtils, Classes, PasTree, PScanner;
 
 // message numbers
 const
@@ -215,7 +228,7 @@ type
     FRow, FColumn: Integer;
   public
     constructor Create(const AReason, AFilename: String;
-      ARow, AColumn: Integer);
+      ARow, AColumn: Integer); reintroduce;
     property Filename: String read FFilename;
     property Row: Integer read FRow;
     property Column: Integer read FColumn;
@@ -260,10 +273,12 @@ type
     FTokenRingCur: Integer; // index of current token in FTokenBuffer
     FTokenRingStart: Integer; // first valid ring index in FTokenBuffer, if FTokenRingStart=FTokenRingEnd the ring is empty
     FTokenRingEnd: Integer; // first invalid ring index in FTokenBuffer
+    {$ifdef VerbosePasParser}
     FDumpIndent : String;
+    procedure DumpCurToken(Const Msg : String; IndentAction : TIndentAction = iaNone);
+    {$endif}
     function CheckOverloadList(AList: TFPList; AName: String; out OldMember: TPasElement): TPasOverloadedProc;
     function DoCheckHint(Element: TPasElement): Boolean;
-    procedure DumpCurToken(Const Msg : String; IndentAction : TIndentAction = iaNone);
     function GetCurrentModeSwitches: TModeSwitches;
     Procedure SetCurrentModeSwitches(AValue: TModeSwitches);
     function GetVariableModifiers(Parent: TPasElement;
@@ -283,7 +298,7 @@ type
     Function SaveComments(Const AValue : String) : String;
     function LogEvent(E : TPParserLogEvent) : Boolean; inline;
     Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Msg : String; SkipSourceInfo : Boolean = False);overload;
-    Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of const;SkipSourceInfo : Boolean = False);overload;
+    Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif};SkipSourceInfo : Boolean = False);overload;
     function GetProcTypeFromToken(tk: TToken; IsClass: Boolean=False ): TProcType;
     procedure ParseAsmBlock(AsmBlock: TPasImplAsmStatement); virtual;
     procedure ParseRecordFieldList(ARec: TPasRecordType; AEndToken: TToken; AllowMethods : Boolean);
@@ -300,7 +315,7 @@ type
       Mandatory: Boolean): boolean;
     function CheckVisibility(S: String; var AVisibility: TPasMemberVisibility): Boolean;
     procedure ParseExc(MsgNumber: integer; const Msg: String);
-    procedure ParseExc(MsgNumber: integer; const Fmt: String; Args : Array of const);
+    procedure ParseExc(MsgNumber: integer; const Fmt: String; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif});
     procedure ParseExcExpectedIdentifier;
     procedure ParseExcSyntaxError;
     procedure ParseExcTokenError(const Arg: string);
@@ -352,7 +367,7 @@ type
   public
     constructor Create(AScanner: TPascalScanner; AFileResolver: TBaseFileResolver;  AEngine: TPasTreeContainer);
     Destructor Destroy; override;
-    procedure SetLastMsg(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of const);
+    procedure SetLastMsg(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif});
     // General parsing routines
     function CurTokenName: String;
     function CurTokenText: String;
@@ -451,13 +466,19 @@ type
   end;
 
 Type
-  TParseSourceOption = (poUseStreams,poSkipDefaultDefs);
+  TParseSourceOption = (
+    {$ifdef HasStreams}
+    poUseStreams,
+    {$endif}
+    poSkipDefaultDefs);
   TParseSourceOptions = set of TParseSourceOption;
 function ParseSource(AEngine: TPasTreeContainer;
                      const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
+{$ifdef HasStreams}
 function ParseSource(AEngine: TPasTreeContainer;
                      const FPCCommandLine, OSTarget, CPUTarget: String;
                      UseStreams  : Boolean): TPasModule; deprecated;
+{$endif}
 function ParseSource(AEngine: TPasTreeContainer;
                      const FPCCommandLine, OSTarget, CPUTarget: String;
                      Options : TParseSourceOptions): TPasModule;
@@ -561,6 +582,7 @@ begin
   Result:=ParseSource(AEngine,FPCCommandLine, OSTarget, CPUTarget,[]);
 end;
 
+{$ifdef HasStreams}
 function ParseSource(AEngine: TPasTreeContainer;
   const FPCCommandLine, OSTarget, CPUTarget: String; UseStreams : Boolean): TPasModule;
 
@@ -570,6 +592,7 @@ begin
   else
     Result:=ParseSource(AEngine,FPCCommandLine, OSTarget, CPUTarget,[]);
 end;
+{$endif}
 
 function ParseSource(AEngine: TPasTreeContainer;
   const FPCCommandLine, OSTarget, CPUTarget: String;
@@ -577,7 +600,7 @@ function ParseSource(AEngine: TPasTreeContainer;
 var
   FileResolver: TFileResolver;
   Parser: TPasParser;
-  Start, CurPos: PChar;
+  Start, CurPos: integer; // in FPCCommandLine
   Filename: String;
   Scanner: TPascalScanner;
 
@@ -587,12 +610,9 @@ var
     s: String;
   begin
     l := CurPos - Start;
-    s:='';
-    SetLength(s, l);
-    if l > 0 then
-      Move(Start^, s[1], l)
-    else
+    if l <= 0 then
       exit;
+    s:=copy(FPCCommandLine,Start,l);
     if (s[1] = '-') and (length(s)>1) then
     begin
       case s[2] of
@@ -642,10 +662,12 @@ begin
   Parser := nil;
   try
     FileResolver := TFileResolver.Create;
+    {$ifdef HasStreams}
     FileResolver.UseStreams:=poUseStreams in Options;
+    {$endif}
     Scanner := TPascalScanner.Create(FileResolver);
-    SCanner.LogEvents:=AEngine.ScannerLogEvents;
-    SCanner.OnLog:=AEngine.Onlog;
+    Scanner.LogEvents:=AEngine.ScannerLogEvents;
+    Scanner.OnLog:=AEngine.Onlog;
     if not (poSkipDefaultDefs in Options) then
       begin
       Scanner.AddDefine('FPK');
@@ -695,18 +717,18 @@ begin
 
     if FPCCommandLine<>'' then
       begin
-        Start := @FPCCommandLine[1];
-        CurPos := Start;
-        while CurPos[0] <> #0 do
+      Start:=1;
+      CurPos := Start;
+      while CurPos<length(FPCCommandLine) do
         begin
-          if CurPos[0] = ' ' then
+        if (FPCCommandLine[CurPos] = ' ') and (FPCCommandLine[CurPos+1]<>' ') then
           begin
-            ProcessCmdLinePart;
-            Start := CurPos + 1;
+          ProcessCmdLinePart;
+          Start := CurPos + 1;
           end;
-          Inc(CurPos);
+        Inc(CurPos);
         end;
-        ProcessCmdLinePart;
+      ProcessCmdLinePart;
       end;
 
     if Filename = '' then
@@ -845,7 +867,7 @@ begin
 end;
 
 procedure TPasParser.ParseExc(MsgNumber: integer; const Fmt: String;
-  Args: array of const);
+  Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});
 var
   p: TPasSourcePos;
 begin
@@ -1809,13 +1831,13 @@ begin
         end;
       tkOf:
         begin
-          NextToken;
-          if CurToken = tkConst then
-          else
+        NextToken;
+        if CurToken = tkConst then
+        else
           begin
-            UngetToken;
-            Result.ElType := ParseType(Result,CurSourcePos);
-          end
+          UngetToken;
+          Result.ElType := ParseType(Result,CurSourcePos);
+          end;
         end
       else
         ParseExc(nParserArrayTypeSyntaxError,SParserArrayTypeSyntaxError);
@@ -2405,7 +2427,9 @@ begin
   AllowedBinaryOps:=BinaryOP;
   if Not AllowEqual then
     Exclude(AllowedBinaryOps,tkEqual);
+  {$ifdef VerbosePasParser}
   //DumpCurToken('Entry',iaIndent);
+  {$endif}
   Result:=nil;
   ExpStack := TFPList.Create;
   SetLength(OpStack,4);
@@ -2523,10 +2547,12 @@ begin
     Result.Parent:=AParent;
 
   finally
-    {if Not Assigned(Result) then
+    {$ifdef VerbosePasParser}
+    if Not Assigned(Result) then
       DumpCurToken('Exiting (no result)',iaUndent)
     else
-      DumpCurtoken('Exiting (Result: "'+Result.GetDeclaration(true)+'") ',iaUndent);}
+      DumpCurtoken('Exiting (Result: "'+Result.GetDeclaration(true)+'") ',iaUndent);
+    {$endif}
     if not Assigned(Result) then begin
       // expression error!
       for i:=0 to ExpStack.Count-1 do
@@ -2594,7 +2620,7 @@ function TPasParser.DoParseConstValueExpression(AParent: TPasElement): TPasExpr;
 
 var
   x , v: TPasExpr;
-  n : AnsiString;
+  n : String;
   r : TRecordValues;
 begin
   if CurToken <> tkBraceOpen then
@@ -4360,7 +4386,7 @@ begin
 end;
 
 procedure TPasParser.SetLastMsg(MsgType: TMessageType; MsgNumber: integer;
-  const Fmt: String; Args: array of const);
+  const Fmt: String; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});
 begin
   FLastMsgType := MsgType;
   FLastMsgNumber := MsgNumber;
@@ -4376,7 +4402,8 @@ begin
 end;
 
 procedure TPasParser.DoLog(MsgType: TMessageType; MsgNumber: integer;
-  const Fmt: String; Args: array of const; SkipSourceInfo: Boolean);
+  const Fmt: String; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
+  SkipSourceInfo: Boolean);
 
 Var
   Msg : String;
@@ -4937,7 +4964,9 @@ begin
                   IsCurTokenHint() or
                   TokenIsCallingConvention(CurTokenString,cc) or
                   (CurToken=tkIdentifier) and (CompareText(CurTokenText,'alias')=0));
-//      DumpCurToken('Done '+IntToStr(Ord(Done)));
+      {$ifdef VerbosePasParser}
+      DumpCurToken('Done '+IntToStr(Ord(Done)));
+      {$endif}
       UngetToken;
       end;
 
@@ -5743,7 +5772,7 @@ begin
             NextToken;
             ImplRaise.ExceptAddr:=DoParseExpression(ImplRaise);
             end;
-          if Curtoken in [tkSemicolon,tkEnd] then
+          if Curtoken in [tkElse,tkEnd,tkSemicolon] then
             UngetToken
           end;
         end;
@@ -6077,6 +6106,7 @@ begin
   Until Done;
 end;
 
+{$ifdef VerbosePasParser}
 procedure TPasParser.DumpCurToken(const Msg: String; IndentAction: TIndentAction
   );
 begin
@@ -6086,9 +6116,14 @@ begin
   Writeln(FDumpIndent,Msg,' : ',TokenInfos[CurToken],' "',CurTokenString,'", Position: ',Scanner.CurFilename,'(',Scanner.CurRow,',',SCanner.CurColumn,') : ',Scanner.CurLine);
   if IndentAction=iaIndent then
     FDumpIndent:=FDumpIndent+'  ';
+  {$ifdef pas2js}
+  // ToDo
+  {$else}
   Flush(output);
+  {$endif}
   {AllowWriteln-}
 end;
+{$endif}
 
 function TPasParser.GetCurrentModeSwitches: TModeSwitches;
 begin
@@ -6691,9 +6726,9 @@ begin
     PCT.HelperForType:=FT;
     PCT.IsExternal:=(AExternalName<>'');
     if AExternalName<>'' then
-      PCT.ExternalName:=AnsiDequotedStr(AExternalName,'''');
+      PCT.ExternalName:={$ifdef pas2js}DeQuoteString{$else}AnsiDequotedStr{$endif}(AExternalName,'''');
     if AExternalNameSpace<>'' then
-    PCT.ExternalNameSpace:=AnsiDequotedStr(AExternalNameSpace,'''');
+    PCT.ExternalNameSpace:={$ifdef pas2js}DeQuoteString{$else}AnsiDequotedStr{$endif}(AExternalNameSpace,'''');
     PCT.ObjKind := AObjKind;
     PCT.PackMode:=PackMode;
     if AObjKind=okInterface then

packages/fcl-passrc/tests/tcresolver.pas

@@ -254,7 +254,7 @@ type
     Procedure TestCharAssignStringFail;
     Procedure TestChar_ForIn;
 
-    // enums
+    // enums and sets
     Procedure TestEnums;
     Procedure TestEnumRangeFail;
     Procedure TestSets;
@@ -340,6 +340,7 @@ type
     Procedure TestStatementsRefs;
     Procedure TestRepeatUntilNonBoolFail;
     Procedure TestWhileDoNonBoolFail;
+    Procedure TestIfThen;
     Procedure TestIfThenNonBoolFail;
     Procedure TestIfAssignMissingSemicolonFail;
     Procedure TestForLoopVarNonVarFail;
@@ -391,6 +392,7 @@ type
     Procedure TestProcOverloadWithBaseTypes2;
     Procedure TestProcOverloadWithDefaultArgs;
     Procedure TestProcOverloadNearestHigherPrecision;
+    Procedure TestProcOverloadForLoopIntDouble;
     Procedure TestProcOverloadStringArgCount;
     Procedure TestProcCallLowPrecision;
     Procedure TestProcOverloadUntyped;
@@ -637,6 +639,7 @@ type
     Procedure TestPropertyArgs1;
     Procedure TestPropertyArgs2;
     Procedure TestPropertyArgsWithDefaultsFail;
+    Procedure TestPropertyArgs_StringConstDefault;
     Procedure TestProperty_Index;
     Procedure TestProperty_WrongTypeAsIndexFail;
     Procedure TestProperty_Option_ClassPropertyNonStatic;
@@ -916,9 +919,7 @@ procedure TCustomTestResolver.TearDown;
 {$IFDEF CheckPasTreeRefCount}
 var El: TPasElement;
 {$ENDIF}
-{$IF defined(VerbosePasResolver) or defined(VerbosePasResolverMem)}
 var i: Integer;
-{$ENDIF}
 begin
   FResolverMsgs.Clear;
   FResolverGoodMsgs.Clear;
@@ -2725,9 +2726,18 @@ procedure TTestResolver.TestConstExternal;
 begin
   Parser.Options:=Parser.Options+[po_ExtConstWithoutExpr];
   StartProgram(false);
-  Add('const NaN: double; external name ''Global.Nan'';');
-  Add('begin');
+  Add([
+  'const',
+  '  PI: double; external name ''Global.PI'';',
+  '  Tau = 2*PI;',
+  '  TauD: double = 2*PI;',
+  'var',
+  '  d: double = PI;',
+  '  e: double = PI+Tau;',
+  'begin',
+  '  d:=pi+tau;']);
   ParseProgram;
+  // ToDo: fail on const Tau = 2*Var
 end;
 
 procedure TTestResolver.TestIntegerTypeCast;
@@ -2791,7 +2801,10 @@ begin
   '  c=double(currency(-123456890123456));',
   '  d=currency(-1);',
   '  e=currency(word(-1));',
+  'var',
   '  i: longint = 1;',
+  '  i64: int64;',
+  '  f: double;',
   'begin',
   '  a:=i;',
   '  a:=i+a;',
@@ -2807,6 +2820,14 @@ begin
   '  a:=i*a;',
   '  a:=a/i;',
   '  a:=i/a;',
+  '  a:=i64;',
+  '  a:=currency(i64);',
+  //'  i64:=a;', not allowed
+  '  i64:=int64(a);', // truncates a
+  '  a:=f;',
+  '  a:=currency(f);',
+  '  f:=a;',
+  '  f:=double(a);',
   '']);
   ParseProgram;
   CheckResolverUnexpectedHints;
@@ -3017,8 +3038,12 @@ begin
   '  MaxInt = +10;',
   'type',
   '  {#TMyInt}TMyInt = MinInt..MaxInt;',
-  'const a = low(TMyInt)+High(TMyInt);',
-  'begin']);
+  'const',
+  '  a = low(TMyInt)+High(TMyInt);',
+  'var',
+  '  i: TMyInt;',
+  'begin',
+  '  i:=low(i)+high(i);']);
   ParseProgram;
   CheckResolverUnexpectedHints;
 end;
@@ -3170,18 +3195,22 @@ end;
 procedure TTestResolver.TestString_Element;
 begin
   StartProgram(false);
-  Add('var');
-  Add('  s: string;');
-  Add('  c: char;');
-  Add('begin');
-  Add('  if s[1]=s then ;');
-  Add('  if s=s[2] then ;');
-  Add('  if s[3+4]=c then ;');
-  Add('  if c=s[5] then ;');
-  Add('  c:=s[6];');
-  Add('  s[7]:=c;');
-  Add('  s[8]:=''a'';');
-  Add('  s[9+1]:=''b'';');
+  Add([
+  'var',
+  '  s: string;',
+  '  c: char;',
+  'begin',
+  '  if s[1]=s then ;',
+  '  if s=s[2] then ;',
+  '  if s[3+4]=c then ;',
+  '  if c=s[5] then ;',
+  '  c:=s[6];',
+  '  s[7]:=c;',
+  '  s[8]:=''a'';',
+  '  s[9+1]:=''b'';',
+  '  s[10]:='''''''';',
+  '  s[11]:=^g;',
+  '  s[12]:=^H;']);
   ParseProgram;
 end;
 
@@ -3565,9 +3594,12 @@ begin
   Add('function {#A1}FuncA: TFlags;');
   Add('begin');
   Add('  Result:=[red];');
+  Add('  Include(Result,green);');
+  Add('  Exclude(Result,blue);');
   Add('end;');
   Add('function {#A2}FuncA(f: TFlags): TFlags;');
   Add('begin');
+  Add('  Include(f,green);');
   Add('  Result:=f;');
   Add('end;');
   Add('var');
@@ -4272,9 +4304,12 @@ begin
   '  k:=''a'';',
   '  k:='''''''';',
   '  k:=j[1];',
+  '  k:=char(#10);',
   '  w:=k;',
   '  w:=#66;',
   '  w:=#6666;',
+  '  w:=widechar(#10);',
+  '  w:=widechar(#$E0000);',
   '']);
   ParseProgram;
 end;
@@ -5073,6 +5108,17 @@ begin
   CheckResolverException('Boolean expected, but Longint found',nXExpectedButYFound);
 end;
 
+procedure TTestResolver.TestIfThen;
+begin
+  StartProgram(false);
+  Add([
+  'var b: boolean;',
+  'begin',
+  '  if b then ;',
+  '  if b then else ;']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestIfThenNonBoolFail;
 begin
   StartProgram(false);
@@ -5996,6 +6042,21 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProcOverloadForLoopIntDouble;
+begin
+  StartProgram(false);
+  Add([
+  'function {#int}Max(a,b: longint): longint; external; overload;',
+  'function {#double}Max(a,b: double): double; external; overload;',
+  'var',
+  '  i: longint;',
+  '  S: string;',
+  'begin',
+  '  for i:=0 to Max(length(s),1) do ;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestProcOverloadStringArgCount;
 begin
   StartProgram(false);
@@ -7238,6 +7299,13 @@ begin
   'type',
   '  TPoint = record x, y: longint; end;',
   'const r: TPoint = (x:1; y:2);',
+  'type',
+  '  TPasSourcePos = Record',
+  '    FileName: String;',
+  '    Row, Column: LongWord;',
+  '  end;',
+  'const',
+  '  DefPasSourcePos: TPasSourcePos = (Filename:''''; Row:0; Column:0);',
   'begin',
   '']);
   ParseProgram;
@@ -10869,6 +10937,20 @@ begin
     PParser.nParserPropertyArgumentsCanNotHaveDefaultValues);
 end;
 
+procedure TTestResolver.TestPropertyArgs_StringConstDefault;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    function GetItems(const s: string): byte; virtual; abstract;',
+  '    procedure SetItems(const s: string; b: byte); virtual; abstract;',
+  '    property Items[s: string]: byte read GetItems write SetItems;',
+  '  end;',
+  'begin']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestProperty_Index;
 begin
   StartProgram(false);
@@ -12323,11 +12405,11 @@ begin
   '  TArrStr = array of string;',
   'const',
   '  Ints: TArrInt = (1,2,3);',
-  '  Names: array of string = (''a'',''foo'');',
   '  Aliases: TarrStr = (''foo'',''b'');',
   '  OneInt: TArrInt = (7);',
   '  OneInt2: array of integer = (7);',
   '  Chars: array of char = ''aoc'';',
+  '  Names: array of string = (''a'',''foo'');',
   '  NameCount = low(Names)+high(Names)+length(Names);',
   'procedure DoIt(Ints: TArrInt);',
   'begin',
@@ -12365,11 +12447,11 @@ begin
   '  TArrOfSet = array of TSetOfEnum;',
   'const',
   '  Ints: TArrInt = {#ints_array}[1,2,1];',
-  '  Names: array of string = {#names_array}[''a'',''a''];',
   '  Aliases: TarrStr = {#aliases_array}[''foo'',''b'',''b''];',
   '  OneInt: TArrInt = {#oneint_array}[7];',
   '  TwoInt: array of integer = {#twoint1_array}[7]+{#twoint2_array}[8];',
   '  Chars: array of char = ''aoc'';',
+  '  Names: array of string = {#names_array}[''a'',''a''];',
   '  NameCount = low(Names)+high(Names)+length(Names);',
   'procedure {#DoArrOfSet}DoIt(const s: TArrOfSet); overload; begin end;',
   'procedure {#DoArrOfArrInt}DoIt(const a: TArrInt2); overload; begin end;',
@@ -13906,34 +13988,41 @@ end;
 procedure TTestResolver.TestPointer;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  TObject = class end;');
-  Add('  TClass = class of TObject;');
-  Add('  TMyPtr = pointer;');
-  Add('  TArrInt = array of longint;');
-  Add('  TFunc = function: longint;');
-  Add('procedure DoIt; begin end;');
-  Add('var');
-  Add('  p: TMyPtr;');
-  Add('  Obj: TObject;');
-  Add('  Cl: TClass;');
-  Add('  a: tarrint;');
-  Add('  f: TFunc;');
-  Add('begin');
-  Add('  p:=nil;');
-  Add('  if p=nil then;');
-  Add('  if nil=p then;');
-  Add('  if Assigned(p) then;');
-  Add('  p:=obj;');
-  Add('  p:=cl;');
-  Add('  p:=a;');
-  Add('  p:=Pointer(f);');
-  Add('  p:=@DoIt;');
-  Add('  p:=Pointer(@DoIt);');
-  Add('  obj:=TObject(p);');
-  Add('  cl:=TClass(p);');
-  Add('  a:=TArrInt(p);');
-  Add('  p:=Pointer(a);');
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  TClass = class of TObject;',
+  '  TMyPtr = pointer;',
+  '  TArrInt = array of longint;',
+  '  TFunc = function: longint;',
+  'procedure DoIt; begin end;',
+  'var',
+  '  p: TMyPtr;',
+  '  Obj: TObject;',
+  '  Cl: TClass;',
+  '  a: tarrint;',
+  '  f: TFunc;',
+  '  s: string;',
+  '  u: unicodestring;',
+  'begin',
+  '  p:=nil;',
+  '  if p=nil then;',
+  '  if nil=p then;',
+  '  if Assigned(p) then;',
+  '  p:=obj;',
+  '  p:=cl;',
+  '  p:=a;',
+  '  p:=Pointer(f);',
+  '  p:=@DoIt;',
+  '  p:=Pointer(@DoIt);',
+  '  obj:=TObject(p);',
+  '  cl:=TClass(p);',
+  '  a:=TArrInt(p);',
+  '  p:=Pointer(a);',
+  '  p:=Pointer(s);',
+  '  s:=String(p);',
+  '  p:=pointer(u);',
+  '  u:=UnicodeString(p);']);
   ParseProgram;
 end;
 
@@ -14170,12 +14259,15 @@ begin
   '  r: TRec;',
   '  p: PRec;',
   '  i: longint;',
+  '  Ptr: pointer;',
   'begin',
   '  p:=@r;',
   '  i:=p^.x;',
   '  p^.x:=i;',
   '  if i=p^.x then;',
   '  if p^.x=i then;',
+  '  ptr:=p;',
+  '  p:=PRec(ptr);',
   '']);
   ParseProgram;
 end;

packages/fcl-passrc/tests/tcscanner.pas

@@ -244,6 +244,7 @@ type
     procedure TestIfError;
     Procedure TestModeSwitch;
     Procedure TestOperatorIdentifier;
+    Procedure TestUTF8BOM;
   end;
 
 implementation
@@ -1744,6 +1745,12 @@ begin
   TestToken(tkidentifier,'operator',True);
 end;
 
+procedure TTestScanner.TestUTF8BOM;
+
+begin
+  DoTestToken(tkLineEnding,#$EF+#$BB+#$BF);
+end;
+
 initialization
   RegisterTests([TTestTokenFinder,TTestStreamLineReader,TTestScanner]);
 end.

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -67,6 +67,7 @@ type
     procedure TestM_Const;
     procedure TestM_ResourceString;
     procedure TestM_Record;
+    procedure TestM_PointerTyped_Record;
     procedure TestM_Array;
     procedure TestM_NestedFuncResult;
     procedure TestM_Enums;
@@ -674,6 +675,7 @@ begin
   Add('  {#c_used}c: longint;');
   Add('begin');
   Add('  if a=0 then b:=1 else c:=2;');
+  Add('  if a=0 then else ;');
   Add('end;');
   Add('begin');
   Add('  DoIt;');
@@ -845,23 +847,62 @@ end;
 procedure TTestUseAnalyzer.TestM_Record;
 begin
   StartProgram(false);
-  Add('procedure {#DoIt_used}DoIt;');
-  Add('type');
-  Add('  {#integer_used}integer = longint;');
-  Add('  {#trec_used}TRec = record');
-  Add('    {#a_used}a: integer;');
-  Add('    {#b_notused}b: integer;');
-  Add('    {#c_used}c: integer;');
-  Add('  end;');
-  Add('var');
-  Add('  {#r_used}r: TRec;');
-  Add('begin');
-  Add('  r.a:=3;');
-  Add('  with r do c:=4;');
-  Add('end;');
-  Add('begin');
-  Add('  DoIt;');
+  Add([
+  'procedure {#DoIt_used}DoIt;',
+  'type',
+  '  {#integer_used}integer = longint;',
+  '  {#trec_used}TRec = record',
+  '    {#a_used}a: integer;',
+  '    {#b_notused}b: integer;',
+  '    {#c_used}c: integer;',
+  '  end;',
+  'var',
+  '  {#r_used}r: TRec;',
+  'const',
+  '  ci = 2;',
+  '  cr: TRec = (a:0;b:ci;c:2);',
+  'begin',
+  '  r.a:=3;',
+  '  with r do c:=4;',
+  '  r:=cr;',
+  'end;',
+  'begin',
+  '  DoIt;']);
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_PointerTyped_Record;
+begin
+  StartProgram(false);
+  Add([
+  'procedure {#DoIt_used}DoIt;',
+  'type',
+  '  {#prec_used}PRec = ^TRec;',
+  '  {#trec_used}TRec = record',
+  '    {#a_used}a: longint;',
+  '    {#b_notused}b: longint;',
+  '    {#c_used}c: longint;',
+  '    {#d_used}d: longint;',
+  '    {#e_used}e: longint;',
+  '  end;',
+  'var',
+  '  r: TRec;',
+  '  p: PRec;',
+  '  i: longint;',
+  'begin',
+  '  p:=@r;',
+  '  i:=p^.a;',
+  '  p^.c:=i;',
+  '  if i=p^.d then;',
+  '  if p^.e=i then;',
+  'end;',
+  'begin',
+  '  DoIt;']);
   AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "b" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+    'Local variable "c" is assigned but never used');
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Array;
@@ -2437,18 +2478,21 @@ end;
 procedure TTestUseAnalyzer.TestWP_PublishedRecordType;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  {#trec_used}TRec = record');
-  Add('    {treci_used}i: longint;');
-  Add('  end;');
-  Add('  {#tobject_used}TObject = class');
-  Add('  published');
-  Add('    {#fielda_used}FieldA: TRec;');
-  Add('  end;');
-  Add('var');
-  Add('  {#o_used}o: TObject;');
-  Add('begin');
-  Add('  o:=nil;');
+  Add([
+  'type',
+  '  {#trec_used}TRec = record',
+  '    {treci_used}i: longint;',
+  '  end;',
+  'const c: TRec = (i:1);',
+  'type',
+  '  {#tobject_used}TObject = class',
+  '  published',
+  '    {#fielda_used}FieldA: TRec;',
+  '  end;',
+  'var',
+  '  {#o_used}o: TObject;',
+  'begin',
+  '  o:=nil;']);
   AnalyzeWholeProgram;
 end;
 

packages/pastojs/src/fppjssrcmap.pp

@@ -128,8 +128,7 @@ end;
 procedure TPas2JSMapper.Writing;
 var
   S: TJSString;
-  p: PWideChar;
-  Line: Integer;
+  p, l, Line: Integer;
 begin
   inherited Writing;
   if SrcMap=nil then exit;
@@ -153,15 +152,14 @@ begin
     begin
     // possible multi line value, e.g. asm-block
     S:=TJSLiteral(CurElement).Value.CustomValue;
-    p:=PWideChar(S);
+    l:=length(S);
+    p:=1;
     Line:=0;
-    repeat
-      case p^ of
-      #0:
-        break;
+    while p<=l do
+      case S[p] of
       #10,#13:
         begin
-        if (p[1] in [#10,#13]) and (p^<>p[1]) then
+        if (p<l) and (S[p+1] in [#10,#13]) and (S[p]<>S[p+1]) then
           inc(p,2)
         else
           inc(p);
@@ -175,7 +173,6 @@ begin
       else
         inc(p);
       end;
-    until false;
     end;
 end;
 
@@ -187,33 +184,33 @@ end;
 
 procedure TPas2JSMapper.WriteFile(Src, Filename: string);
 var
-  p, EndP, LineStart: PChar;
+  l, p, LineStart: integer;
 begin
   if Src='' then exit;
   FSrcFilename:=Filename;
   FSrcLine:=1;
   FSrcColumn:=1;
-  p:=PChar(Src);
-  EndP:=p+length(Src);
+  l:=length(Src);
+  p:=1;
   repeat
     LineStart:=p;
-    repeat
-      case p^ of
-      #0: if p=EndP then break;
+    while (p<=l) do
+      case Src[p] of
       #10,#13:
         begin
-        if (p[1] in [#10,#13]) and (p^<>p[1]) then
+        if (p<l) and (Src[p+1] in [#10,#13]) and (Src[p]<>Src[p+1]) then
+          inc(p,2)
+        else
           inc(p);
-        inc(p);
         break;
         end;
+      else
+        inc(p);
       end;
-      inc(p);
-    until false;
     FNeedMapping:=true;
-    Write(copy(Src,LineStart-PChar(Src)+1,p-LineStart));
+    Write(copy(Src,LineStart,p-LineStart));
     inc(FSrcLine);
-  until p>=EndP;
+  until p>l;
 end;
 
 end.

packages/pastojs/src/pas2js_defines.inc

@@ -1,5 +1,6 @@
 
 {$inline on}
+
 {$IFDEF Windows}
   {$define CaseInsensitiveFilenames}
   {$define HasUNCPaths}
@@ -11,6 +12,13 @@
   {$DEFINE NotLiteralFilenames} // e.g. HFS+ normalizes file names
 {$ENDIF}
 
-{$DEFINE UTF8_RTL}
+{$IFDEF FPC}
+  {$DEFINE UsePChar}
+  {$DEFINE HasInt64}
+  {$DEFINE HasStreams}
+  {$DEFINE UTF8_RTL}
+  {$DEFINE HasStdErr}
+  {$DEFINE HasPas2jsFiler}
+{$ENDIF}
 
 

packages/pastojs/src/pas2jsfilecache.pp

@@ -25,9 +25,18 @@ unit Pas2jsFileCache;
 interface
 
 uses
-  Classes, SysUtils, AVL_Tree,
-  PScanner, PasResolver, FPPJsSrcMap,
-  Pas2jsLogger, Pas2jsFileUtils, Pas2JsFiler;
+  {$IFDEF Pas2js}
+    {$IFDEF NodeJS}
+    NodeJSFS,
+    {$ENDIF}
+  {$ENDIF}
+  Classes, SysUtils,
+  fpjson,
+  PScanner, PasUseAnalyzer, PasResolver, FPPJsSrcMap,
+  {$IFDEF HasPas2jsFiler}
+  Pas2JsFiler,
+  {$ENDIF}
+  Pas2jsLogger, Pas2jsFileUtils;
 
 const // Messages
   nIncludeSearch = 201; sIncludeSearch = 'Include file search: %s';
@@ -43,7 +52,7 @@ type
 type
   TPas2jsFileAgeTime = longint;
   TPas2jsFileAttr = longint;
-  TPas2jsFileSize = int64;
+  TPas2jsFileSize = TMaxPrecInt;
   TPas2jsSearchFileCase = (
     sfcDefault,
     sfcCaseSensitive,
@@ -115,7 +124,7 @@ type
   TPas2jsCachedDirectories = class
   private
     FChangeStamp: TChangeStamp;
-    FDirectories: TAVLTree;// tree of TPas2jsCachedDirectory sorted by Directory
+    FDirectories: TPasAnalyzerKeySet;// set of TPas2jsCachedDirectory, key is Directory
     FWorkingDirectory: string;
   private
     FOnReadDirectory: TReadDirectoryEvent;
@@ -202,7 +211,7 @@ type
     FIsEOF: boolean;
     FLineNumber: integer;
     FSource: string;
-    FSrcPos: PChar;
+    FSrcPos: integer;
   public
     constructor Create(const AFilename: string); override;
     constructor Create(aFile: TPas2jsCachedFile); reintroduce;
@@ -211,7 +220,7 @@ type
     property LineNumber: integer read FLineNumber;
     property CachedFile: TPas2jsCachedFile read FCachedFile;
     property Source: string read FSource;
-    property SrcPos: PChar read FSrcPos;
+    property SrcPos: integer read FSrcPos;
   end;
 
   { TPas2jsCachedFile }
@@ -263,7 +272,7 @@ type
     FBaseDirectory: string;
     FDefaultOutputPath: string;
     FDirectoryCache: TPas2jsCachedDirectories;
-    FFiles: TAVLTree; // tree of TPas2jsCachedFile sorted for Filename
+    FFiles: TPasAnalyzerKeySet; // set of TPas2jsCachedFile, key is Filename
     FForeignUnitPaths: TStringList;
     FForeignUnitPathsFromCmdLine: integer;
     FIncludePaths: TStringList;
@@ -279,7 +288,9 @@ type
     FOnReadFile: TPas2jsReadFileEvent;
     FOnWriteFile: TPas2jsWriteFileEvent;
     FOptions: TP2jsFileCacheOptions;
+    {$IFDEF HasPas2jsFiler}
     FPrecompileFormat: TPas2JSPrecompileFormat;
+    {$ENDIF}
     FReadLineCounter: SizeInt;
     FResetStamp: TChangeStamp;
     FSrcMapBaseDir: string;
@@ -329,7 +340,7 @@ type
     procedure GetListing(const aDirectory: string; var Files: TStrings;
                          FullPaths: boolean = true);
     procedure RaiseDuplicateFile(aFilename: string);
-    procedure SaveToFile(ms: TMemoryStream; Filename: string);
+    procedure SaveToFile(ms: TFPJSStream; Filename: string);
     function ExpandDirectory(const Filename, BaseDir: string): string;
   public
     property AllJSIntoMainJS: Boolean read GetAllJSIntoMainJS write SetAllJSIntoMainJS;
@@ -348,7 +359,9 @@ type
     property Namespaces: TStringList read FNamespaces;
     property NamespacesFromCmdLine: integer read FNamespacesFromCmdLine;
     property Options: TP2jsFileCacheOptions read FOptions write SetOptions default DefaultPas2jsFileCacheOptions;
+    {$IFDEF HasPas2jsFiler}
     property PrecompileFormat: TPas2JSPrecompileFormat read FPrecompileFormat write FPrecompileFormat;
+    {$ENDIF}
     property ReadLineCounter: SizeInt read FReadLineCounter write FReadLineCounter;
     property ResetStamp: TChangeStamp read FResetStamp;
     property SearchLikeFPC: boolean read GetSearchLikeFPC write SetSearchLikeFPC;
@@ -362,21 +375,59 @@ type
     property OnWriteFile: TPas2jsWriteFileEvent read FOnWriteFile write FOnWriteFile;
   end;
 
+{$IFDEF Pas2js}
+function PtrStrToStr(StrAsPtr: Pointer): string;
+function PtrFilenameToKeyName(FilenameAsPtr: Pointer): string;
+function Pas2jsCachedFileToKeyName(Item: Pointer): string;
+function Pas2jsCacheDirToKeyName(Item: Pointer): string;
+{$ELSE}
 function CompareFilenameWithCachedFile(Filename, CachedFile: Pointer): integer;
 function CompareCachedFiles(File1, File2: Pointer): integer;
 function ComparePas2jsCacheDirectories(Dir1, Dir2: Pointer): integer;
 function CompareAnsiStringWithDirectoryCache(Path, DirCache: Pointer): integer;
-function ComparePas2jsDirectoryEntries(Entry1, Entry2: Pointer): integer;
+{$ENDIF}
+function ComparePas2jsDirectoryEntries(Entry1, Entry2: {$IFDEF Pas2js}jsvalue{$ELSE}Pointer{$ENDIF}): integer;
 function CompareFirstCaseInsThenSensitive(const s, h: string): integer;
 
+{$IFDEF FPC_HAS_CPSTRING}
 // UTF-8 helper functions
 function ConvertTextToUTF8(const Src: string; var SrcEncoding: string): string;
 function GuessEncoding(const Src: string): string;
 function HasUTF8BOM(const s: string): boolean;
 function RemoveUTFBOM(const s: string): string;
+{$ENDIF}
 
 implementation
 
+{$IFDEF pas2js}
+function PtrStrToStr(StrAsPtr: Pointer): string;
+var
+  S: String absolute StrAsPtr;
+begin
+  Result:=S;
+end;
+
+function PtrFilenameToKeyName(FilenameAsPtr: Pointer): string;
+var
+  Filename: String absolute FilenameAsPtr;
+begin
+  Result:=FilenameToKey(Filename);
+end;
+
+function Pas2jsCachedFileToKeyName(Item: Pointer): string;
+var
+  aFile: TPas2jsCachedFile absolute Item;
+begin
+  Result:=FilenameToKey(aFile.Filename);
+end;
+
+function Pas2jsCacheDirToKeyName(Item: Pointer): string;
+var
+  Dir: TPas2jsCachedDirectory absolute Item;
+begin
+  Result:=FilenameToKey(Dir.Path);
+end;
+{$ELSE}
 function CompareFilenameWithCachedFile(Filename, CachedFile: Pointer): integer;
 var
   Cache: TPas2jsCachedFile absolute CachedFile;
@@ -406,8 +457,9 @@ var
 begin
   Result:=CompareFilenames(AnsiString(Path),Directory.Path);
 end;
+{$ENDIF}
 
-function ComparePas2jsDirectoryEntries(Entry1, Entry2: Pointer): integer;
+function ComparePas2jsDirectoryEntries(Entry1, Entry2: {$IFDEF Pas2js}jsvalue{$ELSE}Pointer{$ENDIF}): integer;
 var
   E1: TPas2jsCachedDirectoryEntry absolute Entry1;
   E2: TPas2jsCachedDirectoryEntry absolute Entry2;
@@ -422,6 +474,7 @@ begin
   Result:=CompareStr(s,h);
 end;
 
+{$IFDEF FPC_HAS_CPSTRING}
 function ConvertTextToUTF8(const Src: string; var SrcEncoding: string): string;
 var
   p: PChar;
@@ -512,6 +565,7 @@ begin
   if not HasUTF8BOM(Result) then exit;
   Delete(Result,1,3);
 end;
+{$ENDIF}
 
 { TPas2jsCachedDirectory }
 
@@ -548,12 +602,18 @@ begin
 end;
 
 procedure TPas2jsCachedDirectory.DoReadDir;
+{$IFDEF Pas2js}
+{$ELSE}
 var
   Info: TUnicodeSearchRec;
+{$ENDIF}
 begin
   if Assigned(Pool.OnReadDirectory) then
     if Pool.OnReadDirectory(Self) then exit;
 
+  {$IFDEF Pas2js}
+  raise Exception.Create('TPas2jsCachedDirectory.DoReadDir TODO');
+  {$ELSE}
   // Note: do not add a 'if not DirectoryExists then exit'.
   // This will not work on automounted directories. You must use FindFirst.
   if FindFirst(UnicodeString(Path+AllFilesMask),faAnyFile,Info)=0 then
@@ -568,6 +628,7 @@ begin
     until FindNext(Info)<>0;
   end;
   FindClose(Info);
+  {$ENDIF}
 end;
 
 constructor TPas2jsCachedDirectory.Create(aPath: string;
@@ -596,7 +657,7 @@ var
   i: Integer;
 begin
   for i:=0 to FEntries.Count-1 do
-    TObject(FEntries[i]).Free;
+    TObject(FEntries[i]).{$IFDEF Pas2js}Destroy{$ELSE}Free{$ENDIF};
   FEntries.Clear;
   FSorted:=true;
 end;
@@ -848,7 +909,12 @@ begin
   writeln('TPas2jsCachedDirectory.WriteDebugReport Count=',Count,' Path="',Path,'"');
   for i:=0 to Count-1 do begin
     Entry:=Entries[i];
+    {$IFDEF Pas2js}
+    writeln(i,' "',Entry.Name,'" Size=',Entry.Size,' Time=',Entry.Time,' Dir=',faDirectory and Entry.Attr>0);
+    raise Exception.Create('TPas2jsCachedDirectory.WriteDebugReport TODO FileDateToDateTime');
+    {$ELSE}
     writeln(i,' "',Entry.Name,'" Size=',Entry.Size,' Time=',DateTimeToStr(FileDateToDateTime(Entry.Time)),' Dir=',faDirectory and Entry.Attr>0);
+    {$ENDIF}
   end;
   {AllowWriteln-}
 end;
@@ -881,7 +947,12 @@ end;
 constructor TPas2jsCachedDirectories.Create;
 begin
   IncreaseChangeStamp(FChangeStamp);
-  FDirectories:=TAVLTree.Create(@ComparePas2jsCacheDirectories);
+  FDirectories:=TPasAnalyzerKeySet.Create(
+    {$IFDEF pas2js}
+    @Pas2jsCacheDirToKeyName,@PtrFilenameToKeyName
+    {$ELSE}
+    @ComparePas2jsCacheDirectories,@CompareAnsiStringWithDirectoryCache
+    {$ENDIF});
 end;
 
 destructor TPas2jsCachedDirectories.Destroy;
@@ -898,17 +969,21 @@ end;
 
 procedure TPas2jsCachedDirectories.Clear;
 var
-  Node: TAVLTreeNode;
   Dir: TPas2jsCachedDirectory;
+  List: TFPList;
+  i: Integer;
 begin
-  Node:=FDirectories.FindLowest;
-  while Node<>nil do begin
-    Dir:=TPas2jsCachedDirectory(Node.Data);
-    if Dir.FRefCount<>1 then
-      raise Exception.Create('TPas2jsCachedDirectories.Clear [20180126090807] "'+Dir.Path+'" '+IntToStr(Dir.FRefCount));
-    Dir.Release;
-    Node.Data:=nil;
-    Node:=FDirectories.FindSuccessor(Node);
+  List:=FDirectories.GetList;
+  try
+    for i:=0 to List.Count-1 do
+    begin
+      Dir:=TPas2jsCachedDirectory(List[i]);
+      if Dir.FRefCount<>1 then
+        raise Exception.Create('TPas2jsCachedDirectories.Clear [20180126090807] "'+Dir.Path+'" '+IntToStr(Dir.FRefCount));
+      Dir.Release;
+    end;
+  finally
+    List.Free;
   end;
   FDirectories.Clear;
 end;
@@ -922,7 +997,7 @@ begin
   if Info.Dir<>nil then
     Result:=(Info.Dir.FileAttr(Info.ShortFilename) and faDirectory)>0
   else
-    Result:=SysUtils.DirectoryExists(Info.Filename);
+    Result:={$IFDEF pas2js}NodeJSFS{$ELSE}SysUtils{$ENDIF}.DirectoryExists(Info.Filename);
 end;
 
 function TPas2jsCachedDirectories.FileExists(Filename: string): boolean;
@@ -934,7 +1009,7 @@ begin
   if Info.Dir<>nil then
     Result:=Info.Dir.IndexOfFile(Info.ShortFilename)>=0
   else
-    Result:=SysUtils.FileExists(Info.Filename);
+    Result:={$IFDEF pas2js}NodeJSFS{$ELSE}SysUtils{$ENDIF}.FileExists(Info.Filename);
 end;
 
 function TPas2jsCachedDirectories.FileExistsI(var Filename: string): integer;
@@ -947,7 +1022,7 @@ begin
   if not GetFileInfo(Info) then exit;
   if Info.Dir=nil then
   begin
-    if SysUtils.FileExists(Info.Filename) then
+    if {$IFDEF pas2js}NodeJSFS{$ELSE}SysUtils{$ENDIF}.FileExists(Info.Filename) then
       Result:=1;
   end
   else
@@ -1032,16 +1107,14 @@ function TPas2jsCachedDirectories.GetDirectory(const Directory: string;
   CreateIfNotExists: boolean; DoReference: boolean): TPas2jsCachedDirectory;
 var
   Dir: String;
-  Node: TAVLTreeNode;
 begin
   Dir:=ResolveDots(Directory);
   if not FilenameIsAbsolute(Dir) then
     Dir:=WorkingDirectory+Dir;
   Dir:=IncludeTrailingPathDelimiter(Dir);
-  Node:=FDirectories.FindKey(Pointer(Dir),@CompareAnsiStringWithDirectoryCache);
-  if Node<>nil then
+  Result:=TPas2jsCachedDirectory(FDirectories.FindKey(Pointer(Dir)));
+  if Result<>nil then
   begin
-    Result:=TPas2jsCachedDirectory(Node.Data);
     if DoReference then
       Result.Reference;
     Result.Update;
@@ -1071,7 +1144,7 @@ begin
   inherited Create(aFile.Filename);
   FCachedFile:=aFile;
   FSource:=aFile.Source;
-  FSrcPos:=PChar(FSource);
+  FSrcPos:=1;
   FIsEOF:=FSource='';
 end;
 
@@ -1082,16 +1155,15 @@ end;
 
 function TPas2jsFileLineReader.ReadLine: string;
 var
-  p: PChar;
+  S: string;
+  p, SrcLen: integer;
 
   procedure GetLine;
   var
     l: SizeInt;
   begin
     l:=p-FSrcPos;
-    SetLength(Result,l);
-    if l>0 then
-      Move(FSrcPos^,Result[1],l);
+    Result:=copy(S,FSrcPos,l);
     FSrcPos:=p;
     inc(FLineNumber);
     if (CachedFile<>nil) and (CachedFile.Cache<>nil) then
@@ -1099,35 +1171,29 @@ var
     //writeln('GetLine "',Result,'"');
   end;
 
-var
-  c: Char;
 begin
   if FIsEOF then exit('');
+  S:=Source;
+  SrcLen:=length(S);
   p:=FSrcPos;
-  repeat
-    c:=p^;
-    case c of
-    #0:
-      if p-PChar(FSource)=length(FSource) then
-      begin
-        FIsEOF:=true;
-        GetLine;
-        exit;
-      end;
+  while p<=SrcLen do
+    case S[p] of
     #10,#13:
       begin
         GetLine;
         inc(p);
-        if (p^ in [#10,#13]) and (p^<>c) then inc(p);
-        if (p^=#0) and (p-PChar(FSource)=length(FSource)) then
+        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;
-    inc(p);
-  until false;
-  Result:='';
+  FIsEOF:=true;
+  GetLine;
 end;
 
 { TPas2jsCachedFile }
@@ -1152,6 +1218,9 @@ function TPas2jsCachedFile.Load(RaiseOnError: boolean; Binary: boolean
 
   procedure Err(const ErrorMsg: string);
   begin
+    {$IFDEF VerboseFileCache}
+    writeln('TPas2jsCachedFile.Load.Err ErrorMsg="',ErrorMsg,'"');
+    {$ENDIF}
     FLastErrorMsg:=ErrorMsg;
     if RaiseOnError then
       raise EPas2jsFileCache.Create(FLastErrorMsg);
@@ -1159,6 +1228,7 @@ function TPas2jsCachedFile.Load(RaiseOnError: boolean; Binary: boolean
 
 var
   NewSource: string;
+  b: Boolean;
 begin
   {$IFDEF VerboseFileCache}
   writeln('TPas2jsCachedFile.Load START "',Filename,'" Loaded=',Loaded);
@@ -1196,7 +1266,18 @@ begin
     exit;
   end;
   NewSource:='';
-  if not Cache.ReadFile(Filename,NewSource) then exit;
+  if RaiseOnError then
+    b:=Cache.ReadFile(Filename,NewSource)
+  else
+    try
+      b:=Cache.ReadFile(Filename,NewSource);
+    except
+    end;
+  if not b then begin
+    Err('Read error "'+Filename+'"');
+    exit;
+  end;
+
   {$IFDEF VerboseFileCache}
   writeln('TPas2jsCachedFile.Load ENCODE ',Filename,' FFileEncoding=',FFileEncoding);
   {$ENDIF}
@@ -1205,7 +1286,13 @@ begin
     FSource:=NewSource;
     FFileEncoding:=EncodingBinary;
   end else
+  begin
+    {$IFDEF FPC_HAS_CPSTRING}
     FSource:=ConvertTextToUTF8(NewSource,FFileEncoding);
+    {$ELSE}
+    FSource:=NewSource;
+    {$ENDIF}
+  end;
   FLoaded:=true;
   FCacheStamp:=Cache.ResetStamp;
   FLoadedFileAge:=Cache.DirectoryCache.FileAge(Filename);
@@ -1238,7 +1325,7 @@ begin
   Filename:=FindIncludeFileName(aFilename);
   if Filename='' then exit;
   try
-    Result := TFileLineReader.Create(Filename);
+    Result:=FindSourceFile(Filename);
   except
     // error is shown in the scanner, which has the context information
   end;
@@ -1425,7 +1512,7 @@ begin
 
   if ExtractFilePath(aFilename)<>'' then
     begin
-    Result:=ExpandFileNameUTF8(aFilename,BaseDirectory);
+    Result:=ExpandFileNamePJ(aFilename,BaseDirectory);
     if not FileExistsLogged(Result) then
       Result:='';
     exit;
@@ -1721,8 +1808,11 @@ end;
 
 function TPas2jsFilesCache.ReadFile(Filename: string; var Source: string
   ): boolean;
+{$IFDEF Pas2js}
+{$ELSE}
 var
   ms: TMemoryStream;
+{$ENDIF}
 begin
   Result:=false;
   try
@@ -1730,6 +1820,10 @@ begin
       Result:=OnReadFile(Filename,Source);
     if Result then
       Exit;
+    {$IFDEF Pas2js}
+    raise Exception.Create('TPas2jsFilesCache.ReadFile TODO');
+    Result:=true;
+    {$ELSE}
     ms:=TMemoryStream.Create;
     try
       ms.LoadFromFile(Filename);
@@ -1741,6 +1835,7 @@ begin
     finally
       ms.Free;
     end;
+    {$ENDIF}
   except
     on E: Exception do begin
       EPas2jsFileCache.Create('Error reading file "'+Filename+'": '+E.Message);
@@ -1751,7 +1846,7 @@ end;
 procedure TPas2jsFilesCache.FindMatchingFiles(Mask: string; MaxCount: integer;
   Files: TStrings);
 
-  procedure TooMany(id: int64);
+  procedure TooMany(id: TMaxPrecInt);
   begin
     raise EListError.Create('found too many files "'+Mask+'". Max='+IntToStr(MaxCount)+' ['+IntToStr(id)+']');
   end;
@@ -1817,7 +1912,12 @@ begin
   FForeignUnitPaths:=TStringList.Create;
   FNamespaces:=TStringList.Create;
   FUnitPaths:=TStringList.Create;
-  FFiles:=TAVLTree.Create(@CompareCachedFiles);
+  FFiles:=TPasAnalyzerKeySet.Create(
+    {$IFDEF Pas2js}
+    @Pas2jsCachedFileToKeyName,@PtrFilenameToKeyName
+    {$ELSE}
+    @CompareCachedFiles,@CompareFilenameWithCachedFile
+    {$ENDIF});
   FDirectoryCache:=TPas2jsCachedDirectories.Create;
   RegisterMessages;
 end;
@@ -1825,7 +1925,7 @@ end;
 destructor TPas2jsFilesCache.Destroy;
 begin
   FLog:=nil;
-  FFiles.FreeAndClear;
+  FFiles.FreeItems;
   FreeAndNil(FDirectoryCache);
   FreeAndNil(FFiles);
   FreeAndNil(FInsertFilenames);
@@ -1840,7 +1940,7 @@ procedure TPas2jsFilesCache.Reset;
 begin
   IncreaseChangeStamp(FResetStamp);
   FDirectoryCache.Invalidate;
-  // FFiles: TAVLTree; keep data, files are checked against LoadedFileAge
+  // FFiles: keep data, files are checked against LoadedFileAge
   FOptions:=DefaultPas2jsFileCacheOptions;
   FMainJSFile:='';
   FMainJSFileResolved:='';
@@ -1859,7 +1959,9 @@ begin
   FStates:=FStates-[cfsMainJSFileResolved];
   FNamespaces.Clear;
   FNamespacesFromCmdLine:=0;
+  {$IFDEF HasPas2jsFiler}
   FPrecompileFormat:=nil;
+  {$ENDIF}
   FSrcMapBaseDir:='';
   // FOnReadFile: TPas2jsReadFileEvent; keep
   // FOnWriteFile: TPas2jsWriteFileEvent; keep
@@ -1896,7 +1998,9 @@ end;
 function TPas2jsFilesCache.CreateResolver: TPas2jsFileResolver;
 begin
   Result := TPas2jsFileResolver.Create(Self);
+  {$IFDEF HasStreams}
   Result.UseStreams:=false;
+  {$ENDIF}
   Result.BaseDirectory:=BaseDirectory; // beware: will be changed by Scanner.OpenFile
 end;
 
@@ -1958,30 +2062,21 @@ begin
 end;
 
 function TPas2jsFilesCache.FindFile(Filename: string): TPas2jsCachedFile;
-var
-  Node: TAVLTreeNode;
 begin
   Filename:=NormalizeFilename(Filename,true);
-  Node:=FFiles.FindKey(Pointer(Filename),@CompareFilenameWithCachedFile);
-  if Node=nil then
-    exit(nil);
-  Result:=TPas2jsCachedFile(Node.Data);
+  Result:=TPas2jsCachedFile(FFiles.FindKey(Pointer(Filename)));
 end;
 
 function TPas2jsFilesCache.LoadFile(Filename: string; Binary: boolean
   ): TPas2jsCachedFile;
-var
-  Node: TAVLTreeNode;
 begin
   Filename:=NormalizeFilename(Filename,true);
-  Node:=FFiles.FindKey(Pointer(Filename),@CompareFilenameWithCachedFile);
-  if Node=nil then
+  Result:=TPas2jsCachedFile(FFiles.FindKey(Pointer(Filename)));
+  if Result=nil then
   begin
     // new file
     Result:=TPas2jsCachedFile.Create(Self,Filename);
     FFiles.Add(Result);
-  end else begin
-    Result:=TPas2jsCachedFile(Node.Data);
   end;
   Result.Load(true,Binary);
 end;
@@ -1993,7 +2088,7 @@ begin
   if ExtractFilename(Result)='' then
     if RaiseOnError then
       raise EFileNotFoundError.Create('invalid file name "'+Filename+'"');
-  Result:=ExpandFileNameUTF8(Result,BaseDirectory);
+  Result:=ExpandFileNamePJ(Result,BaseDirectory);
   if (ExtractFilename(Result)='') or not FilenameIsAbsolute(Result) then
     if RaiseOnError then
       raise EFileNotFoundError.Create('invalid file name "'+Filename+'"');
@@ -2086,14 +2181,19 @@ begin
   end;
 end;
 
-procedure TPas2jsFilesCache.SaveToFile(ms: TMemoryStream; Filename: string);
+procedure TPas2jsFilesCache.SaveToFile(ms: TFPJSStream; Filename: string);
 var
   s: string;
-  l: Int64;
   i: Integer;
+  {$IFDEF FPC}
+  l: TMaxPrecInt;
+  {$ENDIF}
 begin
   if Assigned(OnWriteFile) then
   begin
+    {$IFDEF Pas2js}
+    s:=ms.join('');
+    {$ELSE}
     l:=ms.Size-ms.Position;
     if l>0 then
     begin
@@ -2103,9 +2203,13 @@ begin
     end
     else
       s:='';
+    {$ENDIF}
     OnWriteFile(Filename,s);
   end else
   begin
+    {$IFDEF Pas2js}
+    raise Exception.Create('TPas2jsFilesCache.SaveToFile TODO '+Filename);
+    {$ELSE}
     try
       ms.SaveToFile(Filename);
     except
@@ -2120,6 +2224,7 @@ begin
         raise;
       end;
     end;
+    {$ENDIF}
   end;
 end;
 
@@ -2128,9 +2233,9 @@ function TPas2jsFilesCache.ExpandDirectory(const Filename, BaseDir: string
 begin
   if Filename='' then exit('');
   if BaseDir<>'' then
-    Result:=ExpandFileNameUTF8(Filename,BaseDir)
+    Result:=ExpandFileNamePJ(Filename,BaseDir)
   else
-    Result:=ExpandFileNameUTF8(Filename,BaseDirectory);
+    Result:=ExpandFileNamePJ(Filename,BaseDirectory);
   if Result='' then exit;
   Result:=IncludeTrailingPathDelimiter(Result);
 end;

packages/pastojs/src/pas2jsfiler.pp

@@ -60,7 +60,11 @@ unit Pas2JsFiler;
 interface
 
 uses
-  Classes, Types, SysUtils, contnrs, zstream, AVL_Tree,
+  Classes, Types, SysUtils, contnrs,
+  {$ifdef pas2js}
+  {$else}
+  zstream, AVL_Tree,
+  {$endif}
   fpjson, jsonparser, jsonscanner,
   PasTree, PScanner, PParser, PasResolveEval, PasResolver,
   Pas2jsFileUtils, FPPas2Js;
@@ -211,7 +215,10 @@ const
     'UseStrict',
     'NoTypeInfo',
     'EliminateDeadCode',
-    'StoreImplJS'
+    'StoreImplJS',
+    'RTLVersionCheckMain',
+    'RTLVersionCheckSystem',
+    'RTLVersionCheckUnit'
     );
 
   PCUDefaultTargetPlatform = PlatformBrowser;
@@ -1032,10 +1039,10 @@ function ComparePCUSrcFiles(File1, File2: Pointer): integer;
 function ComparePCUFilerElementRef(Ref1, Ref2: Pointer): integer;
 function CompareElWithPCUFilerElementRef(El, Ref: Pointer): integer;
 
-function EncodeVLQ(i: MaxPrecInt): string; overload;
-function EncodeVLQ(i: MaxPrecUInt): string; overload;
-function DecodeVLQ(const s: string): MaxPrecInt; // base256 Variable Length Quantity
-function DecodeVLQ(var p: PByte): MaxPrecInt; // base256 Variable Length Quantity
+function EncodeVLQ(i: TMaxPrecInt): string; overload;
+function EncodeVLQ(i: TMaxPrecUInt): string; overload;
+function DecodeVLQ(const s: string): TMaxPrecInt; // base256 Variable Length Quantity
+function DecodeVLQ(var p: PByte): TMaxPrecInt; // base256 Variable Length Quantity
 
 function ComputeChecksum(p: PChar; Cnt: integer): TPCUSourceFileChecksum;
 function crc32(crc: cardinal; buf: Pbyte; len: cardinal): cardinal;
@@ -1083,7 +1090,7 @@ begin
   Result:=ComparePointer(Element,Reference.Element);
 end;
 
-function EncodeVLQ(i: MaxPrecInt): string;
+function EncodeVLQ(i: TMaxPrecInt): string;
 { Convert signed number to base256-VLQ:
   Each byte has 8bit, where the least significant bit is the continuation bit
   (1=there is a next byte).
@@ -1101,9 +1108,9 @@ begin
   digits:=0;
   if i<0 then
     begin
-    if i=Low(MaxPrecInt) then
+    if i=Low(TMaxPrecInt) then
       begin
-      Result:=EncodeVLQ(High(MaxPrecInt)+1);
+      Result:=EncodeVLQ(High(TMaxPrecInt)+1);
       Result[1]:=chr(ord(Result[1]) or 1);
       exit;
       end;
@@ -1125,7 +1132,7 @@ begin
     end;
 end;
 
-function EncodeVLQ(i: MaxPrecUInt): string;
+function EncodeVLQ(i: TMaxPrecUInt): string;
 var
   digits: integer;
 begin
@@ -1144,7 +1151,7 @@ begin
     end;
 end;
 
-function DecodeVLQ(const s: string): MaxPrecInt;
+function DecodeVLQ(const s: string): TMaxPrecInt;
 var
   p: PByte;
 begin
@@ -1156,7 +1163,7 @@ begin
     raise EConvertError.Create('DecodeVLQ waste');
 end;
 
-function DecodeVLQ(var p: PByte): MaxPrecInt;
+function DecodeVLQ(var p: PByte): TMaxPrecInt;
 { Convert base256-VLQ to signed number,
   For the fomat see EncodeVLQ
 }
@@ -1167,7 +1174,7 @@ function DecodeVLQ(var p: PByte): MaxPrecInt;
   end;
 
 const
-  MaxShift = 63; // actually log2(High(MaxPrecInt))
+  MaxShift = 63; // actually log2(High(TMaxPrecInt))
 var
   digit, Shift: Integer;
   Negated: Boolean;
@@ -1183,7 +1190,7 @@ begin
     inc(p);
     if Shift>MaxShift then
       RaiseInvalid;
-    inc(Result,MaxPrecInt(digit and %1111111) shl Shift);
+    inc(Result,TMaxPrecInt(digit and %1111111) shl Shift);
     inc(Shift,7);
     end;
   if Negated then

packages/pastojs/src/pas2jsfileutils.pp

@@ -28,6 +28,9 @@ uses
   {$IFDEF Unix}
   BaseUnix,
   {$ENDIF}
+  {$IFDEF Pas2JS}
+  NodeJSFS,
+  {$ENDIF}
   SysUtils, Classes;
 
 function FilenameIsAbsolute(const aFilename: string):boolean;
@@ -35,7 +38,7 @@ function FilenameIsWinAbsolute(const aFilename: string):boolean;
 function FilenameIsUnixAbsolute(const aFilename: string):boolean;
 function FileIsInPath(const Filename, Path: string): boolean;
 function ChompPathDelim(const Path: string): string;
-function ExpandFileNameUTF8(const FileName: string; {const} BaseDir: string = ''): string;
+function ExpandFileNamePJ(const FileName: string; {const} BaseDir: string = ''): string;
 function ExpandDirectory(const aDirectory: string): string;
 function TryCreateRelativePath(const Filename, BaseDirectory: String;
   UsePointDirectory: boolean; out RelPath: String): Boolean;
@@ -43,8 +46,11 @@ function ResolveDots(const AFilename: string): string;
 procedure ForcePathDelims(Var FileName: string);
 function GetForcedPathDelims(Const FileName: string): String;
 function ExtractFilenameOnly(const aFilename: string): string;
-function GetCurrentDirUTF8: String;
+function GetCurrentDirPJ: String;
 function CompareFilenames(const File1, File2: string): integer;
+{$IFDEF Pas2js}
+function FilenameToKey(const Filename: string): string;
+{$ENDIF}
 
 function GetPhysicalFilename(const Filename: string;
         ExceptionOnError: boolean): string;
@@ -53,9 +59,9 @@ function ResolveSymLinks(const Filename: string;
 function MatchGlobbing(Mask, Name: string): boolean;
 function FileIsWritable(const AFilename: string): boolean;
 
-function GetEnvironmentVariableCountUTF8: Integer;
-function GetEnvironmentStringUTF8(Index: Integer): string;
-function GetEnvironmentVariableUTF8(const EnvVar: string): String;
+function GetEnvironmentVariableCountPJ: Integer;
+function GetEnvironmentStringPJ(Index: Integer): string;
+function GetEnvironmentVariablePJ(const EnvVar: string): String;
 
 function GetNextDelimitedItem(const List: string; Delimiter: char;
                               var Position: integer): string;
@@ -65,12 +71,10 @@ const InvalidChangeStamp = low(TChangeStamp);
 procedure IncreaseChangeStamp(var Stamp: TChangeStamp);
 
 const
-  UTF8BOM = #$EF#$BB#$BF;
   EncodingUTF8 = 'UTF-8';
   EncodingSystem = 'System';
 function NormalizeEncoding(const Encoding: string): string;
 function IsNonUTF8System: boolean;// true if system encoding is not UTF-8
-function UTF8CharacterStrictLength(P: PChar): integer;
 function GetDefaultTextEncoding: string;
 function GetConsoleTextEncoding: string;
 {$IFDEF Windows}
@@ -83,6 +87,11 @@ function GetUnixEncoding: string;
 {$ENDIF}
 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;
 
@@ -92,6 +101,7 @@ function SystemCPToUTF8(const s: string): string;
 function ConsoleToUTF8(const s: string): string;
 // converts UTF8 string to console encoding (used by Write, WriteLn)
 function UTF8ToConsole(const s: string): string;
+{$ENDIF FPC_HAS_CPSTRING}
 
 implementation
 
@@ -107,12 +117,12 @@ var
   Lang: string = '';
   {$ENDIF}
   {$ENDIF}
-  NonUTF8System: boolean = false;
+  NonUTF8System: boolean = {$IFDEF FPC_HAS_CPSTRING}false{$ELSE}true{$ENDIF};
 
 function FilenameIsWinAbsolute(const aFilename: string): boolean;
 begin
   Result:=((length(aFilename)>=3) and
-           (aFilename[1] in ['A'..'Z','a'..'z']) and (aFilename[2]=':')  and (aFilename[3]in AllowDirectorySeparators))
+           (aFilename[1] in ['A'..'Z','a'..'z']) and (aFilename[2]=':') and (aFilename[3]in AllowDirectorySeparators))
       or ((length(aFilename)>=2) and (aFilename[1] in AllowDirectorySeparators) and (aFilename[2] in AllowDirectorySeparators));
 end;
 
@@ -136,7 +146,7 @@ begin
   ExpPath:=IncludeTrailingPathDelimiter(Path);
   l:=length(ExpPath);
   Result:=(l>0) and (length(ExpFile)>l) and (ExpFile[l]=PathDelim)
-          and (AnsiCompareFileName(ExpPath,LeftStr(ExpFile,l))=0);
+          and (CompareFileNames(ExpPath,LeftStr(ExpFile,l))=0);
 end;
 
 function ChompPathDelim(const Path: string): string;
@@ -174,7 +184,7 @@ function ExpandDirectory(const aDirectory: string): string;
 begin
   Result:=aDirectory;
   if Result='' then exit;
-  Result:=ExpandFileNameUTF8(Result);
+  Result:=ExpandFileNamePJ(Result);
   if Result='' then exit;
   Result:=IncludeTrailingPathDelimiter(Result);
 end;
@@ -207,7 +217,16 @@ function TryCreateRelativePath(const Filename, BaseDirectory: String;
   - Filename = foo/bar BaseDirectory = bar/foo Result = False (no shared base directory)
   - Filename = /foo BaseDirectory = bar Result = False (mixed absolute and relative)
 }
-
+{$IFDEF Pas2js}
+begin
+  Result:=false;
+  RelPath:=Filename;
+  if (BaseDirectory='') or (Filename='') then exit;
+  {AllowWriteln}
+  writeln('TryCreateRelativePath ToDo: ',Filename,' Base=',BaseDirectory,' UsePointDirectory=',UsePointDirectory);
+  {AllowWriteln-}
+end;
+{$ELSE}
   function IsNameChar(c: char): boolean; inline;
   begin
     Result:=(c<>#0) and not (c in AllowDirectorySeparators);
@@ -296,10 +315,23 @@ begin
     Move(FileP^,RelPath[ResultPos],FileNameRestLen);
   Result:=true;
 end;
+{$ENDIF}
 
 function ResolveDots(const AFilename: string): string;
 //trim double path delims and expand special dirs like .. and .
 //on Windows change also '/' to '\' except for filenames starting with '\\?\'
+{$IFDEF Pas2js}
+var
+  Len: Integer;
+begin
+  Len:=length(AFilename);
+  if Len=0 then exit('');
+  Result:=AFilename;
+  {AllowWriteln}
+  writeln('ResolveDots ToDo ',AFilename);
+  {AllowWriteln-}
+end;
+{$ELSE}
 
   {$ifdef windows}
   function IsDriveDelim(const Path: string; p: integer): boolean; inline;
@@ -511,25 +543,34 @@ begin
     else
       SetLength(Result,DestPos-1);
 end;
+{$ENDIF}
 
 procedure ForcePathDelims(Var FileName: string);
-var
-  i: Integer;
 begin
-  for i:=1 to length(FileName) do
-    {$IFDEF Windows}
-    if Filename[i]='/' then
-      Filename[i]:='\';
-    {$ELSE}
-    if Filename[i]='\' then
-      Filename[i]:='/';
-    {$ENDIF}
+  Filename:=GetForcedPathDelims(Filename);
 end;
 
 function GetForcedPathDelims(const FileName: string): String;
+var
+  i: Integer;
+  c: Char;
 begin
-  Result:=FileName;
-  ForcePathDelims(Result);
+  Result:=Filename;
+  {$IFDEF Pas2js}
+  if PathDelim='/' then
+    c:='\'
+  else
+    c:='/';
+  {$ELSE}
+  {$IFDEF Windows}
+  c:='/';
+  {$ELSE}
+  c:='/';
+  {$ENDIF}
+  {$ENDIF}
+  for i:=1 to length(Result) do
+    if Result[i]=c then
+      Result[i]:=PathDelim;
 end;
 
 function ExtractFilenameOnly(const aFilename: string): string;
@@ -552,11 +593,49 @@ end;
 
 function CompareFilenames(const File1, File2: string): integer;
 begin
+  {$IFDEF Pas2js}
+  {AllowWriteln}
+  writeln('CompareFilenames ToDo ',File1,' ',File2);
+  {AllowWriteln-}
+  raise Exception.Create('CompareFilenames ToDo');
+  Result:=0;
+  {$ELSE}
   Result:=AnsiCompareFileName(File1,File2);
+  {$ENDIF}
 end;
 
+{$IFDEF Pas2js}
+function FilenameToKey(const Filename: string): string;
+begin
+  {$IFDEF Pas2js}
+  Result:=Filename;
+  // ToDo lowercase on windows, normalize on darwin
+  {$ELSE}
+    {$IFDEF Windows}
+    Result:=AnsiLowerCase(Filename);
+    {$ELSE}
+      {$IFDEF Darwin}
+      todo
+      {$ELSE}
+      Result:=Filename;
+      {$ENDIF}
+    {$ENDIF}
+  {$ENDIF}
+end;
+{$ENDIF}
+
 function MatchGlobbing(Mask, Name: string): boolean;
 // match * and ?
+{$IFDEF Pas2js}
+begin
+  if Mask='' then exit(Name='');
+  {AllowWriteln}
+  writeln('MatchGlobbing ToDo ',Mask,' Name=',Name);
+  {AllowWriteln-}
+  raise Exception.Create('MatchGlobbing ToDo');
+  Result:=false;
+end;
+{$ELSE}
 
   function IsNameEnd(NameP: PChar): boolean; inline;
   begin
@@ -620,6 +699,7 @@ begin
     exit(false);
   Result:=Check(MaskP,PChar(Name));
 end;
+{$ENDIF}
 
 function GetNextDelimitedItem(const List: string; Delimiter: char;
   var Position: integer): string;
@@ -646,6 +726,76 @@ begin
   Result:=NonUTF8System;
 end;
 
+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;
+
+function NormalizeEncoding(const Encoding: string): string;
+var
+  i: Integer;
+begin
+  Result:=LowerCase(Encoding);
+  for i:=length(Result) downto 1 do
+    if Result[i]='-' then Delete(Result,i,1);
+end;
+
+function IsASCII(const s: string): boolean; inline;
+{$IFDEF Pas2js}
+var
+  i: Integer;
+begin
+  for i:=1 to length(s) do
+    if s[i]>#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);
@@ -689,60 +839,6 @@ begin
     exit(0);
 end;
 
-function GetDefaultTextEncoding: string;
-begin
-  if EncodingValid then
-  begin
-    Result:=DefaultTextEncoding;
-    exit;
-  end;
-
-  {$IFDEF Windows}
-  Result:=GetWindowsEncoding;
-  {$ELSE}
-  {$IFDEF Darwin}
-  Result:=EncodingUTF8;
-  {$ELSE}
-  Lang := GetEnvironmentVariable('LC_ALL');
-  if Lang='' then
-  begin
-    Lang := GetEnvironmentVariable('LC_MESSAGES');
-    if Lang='' then
-      Lang := GetEnvironmentVariable('LANG');
-  end;
-  Result:=GetUnixEncoding;
-  {$ENDIF}
-  {$ENDIF}
-  Result:=NormalizeEncoding(Result);
-
-  DefaultTextEncoding:=Result;
-  EncodingValid:=true;
-end;
-
-function NormalizeEncoding(const Encoding: string): string;
-var
-  i: Integer;
-begin
-  Result:=LowerCase(Encoding);
-  for i:=length(Result) downto 1 do
-    if Result[i]='-' then Delete(Result,i,1);
-end;
-
-function IsASCII(const s: string): boolean; inline;
-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;
-
 function UTF8ToUTF16(const s: string): UnicodeString;
 begin
   Result:=UTF8Decode(s);
@@ -756,6 +852,7 @@ begin
   // conversion magic
   SetCodePage(RawByteString(Result), CP_ACP, False);
 end;
+{$ENDIF}
 
 {$IFDEF Unix}
   {$I pas2jsfileutilsunix.inc}
@@ -763,9 +860,13 @@ end;
 {$IFDEF Windows}
   {$I pas2jsfileutilswin.inc}
 {$ENDIF}
+{$IFDEF NodeJS}
+  {$I pas2jsfileutilsnodejs.inc}
+{$ENDIF}
 
 procedure InternalInit;
 begin
+  {$IFDEF FPC_HAS_CPSTRING}
   SetMultiByteConversionCodePage(CP_UTF8);
   // SetMultiByteFileSystemCodePage(CP_UTF8); not needed, this is the default under Windows
   SetMultiByteRTLFileSystemCodePage(CP_UTF8);
@@ -776,12 +877,16 @@ begin
   {$ELSE}
   NonUTF8System:=SysUtils.CompareText(DefaultTextEncoding,'UTF8')<>0;
   {$ENDIF}
+  {$ENDIF}
+
   InitPlatform;
 end;
 
 initialization
   InternalInit;
+{$IFDEF FPC}
 finalization
   FinalizePlatform;
+{$ENDIF}
 end.
 

packages/pastojs/src/pas2jsfileutilsnodejs.inc

@@ -0,0 +1,147 @@
+{%MainUnit pas2jsfileutils.pas}
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2018  Mattias Gaertner  [email protected]
+
+    NodeJS backend of pas2jsfileutils
+
+    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.
+
+ **********************************************************************
+}
+
+function FilenameIsAbsolute(const aFilename: string): boolean;
+begin
+  {AllowWriteln}
+  writeln('FilenameIsAbsolute ToDo ',aFilename);
+  {AllowWriteln-}
+  Result:=FilenameIsUnixAbsolute(aFilename);
+  raise Exception.Create('FilenameIsAbsolute ToDo');
+end;
+
+function ExpandFileNamePJ(const FileName: string; BaseDir: string): string;
+var
+  IsAbs: Boolean;
+  HomeDir, Fn: String;
+begin
+  Fn := FileName;
+  ForcePathDelims(Fn);
+  IsAbs := FileNameIsUnixAbsolute(Fn);
+  if (not IsAbs) then
+  begin
+    if ((Length(Fn) > 1) and (Fn[1] = '~') and (Fn[2] = '/')) or (Fn = '~') then
+    begin
+      HomeDir := GetEnvironmentVariablePJ('HOME');
+      if not FileNameIsUnixAbsolute(HomeDir) then
+        HomeDir := ExpandFileNamePJ(HomeDir,'');
+      Fn := HomeDir + Copy(Fn,2,length(Fn));
+      IsAbs := True;
+    end;
+  end;
+  if IsAbs then
+  begin
+    Result := ResolveDots(Fn);
+  end
+  else
+  begin
+    if (BaseDir = '') then
+      Fn := IncludeTrailingPathDelimiter(GetCurrentDirPJ) + Fn
+    else
+      Fn := IncludeTrailingPathDelimiter(BaseDir) + Fn;
+    Fn := ResolveDots(Fn);
+    //if BaseDir is not absolute then this needs to be expanded as well
+    if not FileNameIsUnixAbsolute(Fn) then
+      Fn := ExpandFileNamePJ(Fn, '');
+    Result := Fn;
+  end;
+end;
+
+function GetCurrentDirPJ: String;
+begin
+  {AllowWriteln}
+  writeln('GetCurrentDirPJ ToDo');
+  {AllowWriteln-}
+  Result:='';
+  raise Exception.Create('GetCurrentDirPJ ToDo');
+end;
+
+function GetPhysicalFilename(const Filename: string; ExceptionOnError: boolean
+  ): string;
+var
+  OldPath, NewPath: String;
+  p, l: integer;
+begin
+  Result:=Filename;
+  p:=1;
+  l:=length(Result);
+  while p<=l do
+  begin
+    while (p<=l) and (Result[p]='/') do
+      inc(p);
+    if p>l then exit;
+    if Result[p]<>'/' then
+    begin
+      repeat
+        inc(p);
+      until (p>l) or (Result[p]='/');
+      OldPath:=LeftStr(Result,p-1);
+      NewPath:=ResolveSymLinks(OldPath,ExceptionOnError);
+      if NewPath='' then exit('');
+      if OldPath<>NewPath then
+      begin
+        Result:=NewPath+copy(Result,length(OldPath)+1,length(Result));
+        p:=length(NewPath)+1;
+      end;
+    end;
+  end;
+end;
+
+function ResolveSymLinks(const Filename: string; ExceptionOnError: boolean
+  ): string;
+begin
+  {AllowWriteln}
+  writeln('ResolveSymLinks ToDo ',Filename,' ',ExceptionOnError);
+  {AllowWriteln-}
+  Result:=Filename;
+  raise Exception.Create('ResolveSymLinks ToDo');
+end;
+
+function FileIsWritable(const AFilename: string): boolean;
+begin
+  {AllowWriteln}
+  writeln('FileIsWritable ToDo ',AFilename);
+  {AllowWriteln-}
+  Result := false;
+  raise Exception.Create('FileIsWritable ToDo');
+end;
+
+function GetEnvironmentVariableCountPJ: Integer;
+begin
+  Result:=GetEnvironmentVariableCount;
+end;
+
+function GetEnvironmentStringPJ(Index: Integer): string;
+begin
+  Result:=GetEnvironmentString(Index);
+end;
+
+function GetEnvironmentVariablePJ(const EnvVar: string): String;
+begin
+  Result:=GetEnvironmentVariable(EnvVar);
+end;
+
+function GetConsoleTextEncoding: string;
+begin
+  Result:=GetDefaultTextEncoding;
+end;
+
+procedure InitPlatform;
+begin
+
+end;
+

packages/pastojs/src/pas2jsfileutilsunix.inc

@@ -3,7 +3,7 @@
     This file is part of the Free Component Library (FCL)
     Copyright (c) 2018  Mattias Gaertner  [email protected]
 
-    Pascal to Javascript converter class.
+    Unix backend of pas2jsfileutils
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -20,7 +20,7 @@ begin
   Result:=FilenameIsUnixAbsolute(aFilename);
 end;
 
-function ExpandFileNameUTF8(const FileName: string; BaseDir: string): string;
+function ExpandFileNamePJ(const FileName: string; BaseDir: string): string;
 var
   IsAbs: Boolean;
   HomeDir, Fn: String;
@@ -32,9 +32,9 @@ begin
   begin
     if ((Length(Fn) > 1) and (Fn[1] = '~') and (Fn[2] = '/')) or (Fn = '~') then
     begin
-      HomeDir := GetEnvironmentVariableUTF8('HOME');
+      HomeDir := GetEnvironmentVariablePJ('HOME');
       if not FileNameIsUnixAbsolute(HomeDir) then
-        HomeDir := ExpandFileNameUtf8(HomeDir,'');
+        HomeDir := ExpandFileNamePJ(HomeDir,'');
       Fn := HomeDir + Copy(Fn,2,length(Fn));
       IsAbs := True;
     end;
@@ -46,18 +46,18 @@ begin
   else
   begin
     if (BaseDir = '') then
-      Fn := IncludeTrailingPathDelimiter(GetCurrentDirUtf8) + Fn
+      Fn := IncludeTrailingPathDelimiter(GetCurrentDirPJ) + Fn
     else
       Fn := IncludeTrailingPathDelimiter(BaseDir) + Fn;
     Fn := ResolveDots(Fn);
     //if BaseDir is not absolute then this needs to be expanded as well
     if not FileNameIsUnixAbsolute(Fn) then
-      Fn := ExpandFileNameUtf8(Fn, '');
+      Fn := ExpandFileNamePJ(Fn, '');
     Result := Fn;
   end;
 end;
 
-function GetCurrentDirUTF8: String;
+function GetCurrentDirPJ: String;
 begin
   Result:=GetCurrentDir;
 end;
@@ -148,17 +148,17 @@ begin
   Result := BaseUnix.FpAccess(AFilename, BaseUnix.W_OK) = 0;
 end;
 
-function GetEnvironmentVariableCountUTF8: Integer;
+function GetEnvironmentVariableCountPJ: Integer;
 begin
   Result:=GetEnvironmentVariableCount;
 end;
 
-function GetEnvironmentStringUTF8(Index: Integer): string;
+function GetEnvironmentStringPJ(Index: Integer): string;
 begin
   Result:=ConsoleToUTF8(GetEnvironmentString(Index));
 end;
 
-function GetEnvironmentVariableUTF8(const EnvVar: string): String;
+function GetEnvironmentVariablePJ(const EnvVar: string): String;
 begin
   Result:=ConsoleToUTF8(GetEnvironmentVariable(EnvVar));
 end;
@@ -225,3 +225,4 @@ procedure FinalizePlatform;
 begin
 
 end;
+

packages/pastojs/src/pas2jsfileutilswin.inc

@@ -268,7 +268,7 @@ begin
   {$endif}
 end;
 
-function ExpandFileNameUtf8(const FileName: string; {const} BaseDir: String = ''): String;
+function ExpandFileNamePJ(const FileName: string; {const} BaseDir: String = ''): String;
 var
   IsAbs, StartsWithRoot, CanUseBaseDir : Boolean;
   {$ifndef WinCE}
@@ -277,7 +277,7 @@ var
   {$endif}
   CurDir, Fn: String;
 begin
-  //writeln('LazFileUtils.ExpandFileNameUtf8');
+  //writeln('LazFileUtils.ExpandFileNamePJ');
   //writeln('FileName = "',FileName,'"');
   //writeln('BaseDir  = "',BaseDir,'"');
 
@@ -287,7 +287,7 @@ begin
   //See: http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247%28v=vs.85%29.aspx
   if (Length(Fn) > 3) and (Fn[1] = PathDelim) and (Fn[2] = PathDelim) and
      (Fn[3] = '?') and (Fn[4] = PathDelim) //Do NOT use AllowDirectorySeparators here!
-     then Exit;
+     then Exit(FN);
   ForcePathDelims(Fn);
   IsAbs := FileNameIsWinAbsolute(Fn);
   if not IsAbs then
@@ -305,11 +305,11 @@ begin
     begin
       FnDrive := UpCase(Fn[1]);
       GetDirUtf8(Byte(FnDrive)-64, CurDir{%H-});
-      CurDrive := UpCase(GetCurrentDirUtf8[1]);
+      CurDrive := UpCase(GetCurrentDirPJ[1]);
     end
     else
     begin
-      CurDir := GetCurrentDirUtf8;
+      CurDir := GetCurrentDirPJ;
       FnDrive := UpCase(CurDir[1]);
       CurDrive := FnDrive;
     end;
@@ -372,12 +372,12 @@ begin
     Fn := ResolveDots(Fn);
     //if BaseDir is something like 'z:foo\' or '\' then this needs to be expanded as well
     if not FileNameIsAbsolute(Fn) then
-      Fn := ExpandFileNameUtf8(Fn, '');
+      Fn := ExpandFileNamePJ(Fn, '');
     Result := Fn;
   end;
 end;
 
-function GetCurrentDirUtf8: String;
+function GetCurrentDirPJ: String;
 {$ifndef WinCE}
 var
   w   : UnicodeString;
@@ -421,7 +421,7 @@ begin
   Result:=((FileGetAttrUTF8(AFilename) and faReadOnly) = 0);
 end;
 
-function GetEnvironmentVariableCountUTF8: Integer;
+function GetEnvironmentVariableCountPJ: Integer;
 var
   hp,p : PWideChar;
 begin
@@ -437,7 +437,7 @@ begin
   FreeEnvironmentStringsW(p);
 end;
 
-function GetEnvironmentStringUTF8(Index: Integer): string;
+function GetEnvironmentStringPJ(Index: Integer): string;
 var
   hp,p : PWideChar;
 begin
@@ -455,7 +455,7 @@ begin
   FreeEnvironmentStringsW(p);
 end;
 
-function GetEnvironmentVariableUTF8(const EnvVar: string): String;
+function GetEnvironmentVariablePJ(const EnvVar: string): String;
 begin
   Result:=UTF16ToUTF8(SysUtils.GetEnvironmentVariable(UTF8ToUTF16(EnvVar)));
 end;

packages/pastojs/src/pas2jslogger.pp

@@ -21,11 +21,15 @@
 unit Pas2jsLogger;
 
 {$mode objfpc}{$H+}
-{$inline on}
+
+{$i pas2js_defines.inc}
 
 interface
 
 uses
+  {$IFDEF Pas2JS}
+  JS, NodeJSFS,
+  {$ENDIF}
   Classes, SysUtils, PasTree, PScanner, jstree, jsbase, jswriter, fpjson,
   Pas2jsFileUtils;
 
@@ -42,6 +46,41 @@ const
 const
   DefaultLogMsgTypes = [mtFatal..mtDebug]; // by default show everything
 
+type
+  {$IFDEF Pas2JS}
+
+  { TPas2jsStream }
+
+  TPas2jsStream = class
+  public
+    procedure Write(const s: string); virtual; abstract;
+  end;
+
+  { TPas2jsFileStream }
+
+  TPas2jsFileStream = class(TPas2JSStream)
+  public
+    constructor Create(Filename: string; Mode: cardinal);
+    destructor Destroy; override;
+    procedure Write(const s: string); override;
+  end;
+const
+  fmCreate        = $FF00;
+  fmOpenRead      = 0;
+  //fmOpenWrite     = 1;
+  //fmOpenReadWrite = 2;
+  { Share modes}
+  //fmShareCompat    = $0000;
+  //fmShareExclusive = $0010;
+  //fmShareDenyWrite = $0020;
+  //fmShareDenyRead  = $0030;
+  fmShareDenyNone  = $0040;
+
+  {$ELSE}
+  TPas2jsStream = TStream;
+  TPas2jsFileStream = TFileStream;
+  {$ENDIF}
+
 type
 
   { TPas2jsMessage }
@@ -59,7 +98,7 @@ type
 
   TPas2jsLogger = class
   private
-    FDebugLog: TStream;
+    FDebugLog: TPas2JSStream;
     FEncoding: string;
     FLastMsgCol: integer;
     FLastMsgFile: string;
@@ -67,8 +106,7 @@ type
     FLastMsgNumber: integer;
     FLastMsgTxt: string;
     FLastMsgType: TMessageType;
-    FMsgNumberDisabled: PInteger;// sorted ascending
-    FMsgNumberDisabledCount: integer;
+    FMsgNumberDisabled: array of Integer;// sorted ascending
     FMsg: TFPList; // list of TPas2jsMessage
     FOnFormatPath: TPScannerFormatPathEvent;
     FOnLog: TPas2jsLogEvent;
@@ -77,7 +115,9 @@ type
     FShowMsgNumbers: boolean;
     FShowMsgTypes: TMessageTypes;
     FSorted: boolean;
+    {$IFDEF HasStdErr}
     FWriteMsgToStdErr: boolean;
+    {$ENDIF}
     function GetMsgCount: integer;
     function GetMsgNumberDisabled(MsgNumber: integer): boolean;
     function GetMsgs(Index: integer): TPas2jsMessage; inline;
@@ -87,7 +127,7 @@ type
     procedure SetOutputFilename(AValue: string);
     procedure SetSorted(AValue: boolean);
     procedure DoLogRaw(const Msg: string; SkipEncoding : Boolean);
-    function Concatenate(Args: array of const): string;
+    function Concatenate(Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF}): string;
   public
     constructor Create;
     destructor Destroy; override;
@@ -95,20 +135,25 @@ type
     function FindMsg(MsgNumber: integer; ExceptionOnNotFound: boolean): TPas2jsMessage;
     procedure Sort;
     procedure LogRaw(const Msg: string); overload;
-    procedure LogRaw(Args: array of const); overload;
+    procedure LogRaw(Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF}); overload;
     procedure LogLn;
     procedure LogPlain(const Msg: string); overload;
-    procedure LogPlain(Args: array of const); overload;
-    procedure LogMsg(MsgNumber: integer; Args: array of const;
+    procedure LogPlain(Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF}); overload;
+    procedure LogMsg(MsgNumber: integer;
+      Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF};
       const Filename: string = ''; Line: integer = 0; Col: integer = 0;
       UseFilter: boolean = true);
     procedure Log(MsgType: TMessageType; Msg: string; MsgNumber: integer = 0;
       const Filename: string = ''; Line: integer = 0; Col: integer = 0;
       UseFilter: boolean = true);
-    procedure LogMsgIgnoreFilter(MsgNumber: integer; Args: array of const);
+    procedure LogMsgIgnoreFilter(MsgNumber: integer;
+      Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF});
+    {$IFDEF FPC}
     procedure LogExceptionBackTrace;
+    {$ENDIF}
     function MsgTypeToStr(MsgType: TMessageType): string;
-    function GetMsgText(MsgNumber: integer; Args: array of const): string;
+    function GetMsgText(MsgNumber: integer;
+      Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF}): string;
     function FormatMsg(MsgType: TMessageType; Msg: string; MsgNumber: integer = 0;
       const Filename: string = ''; Line: integer = 0; Col: integer = 0): string;
     function FormatJSONMsg(MsgType: TMessageType; Msg: string; MsgNumber: integer = 0;
@@ -131,7 +176,9 @@ type
     property OutputFilename: string read FOutputFilename write SetOutputFilename;
     property ShowMsgNumbers: boolean read FShowMsgNumbers write FShowMsgNumbers;
     property ShowMsgTypes: TMessageTypes read FShowMsgTypes write FShowMsgTypes;
+    {$IFDEF HasStdErr}
     property WriteMsgToStdErr: boolean read FWriteMsgToStdErr write FWriteMsgToStdErr;
+    {$ENDIF}
     property Sorted: boolean read FSorted write SetSorted;
     property OnLog: TPas2jsLogEvent read FOnLog write FOnLog;
     property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
@@ -140,13 +187,13 @@ type
     property LastMsgCol: integer read FLastMsgCol write FLastMsgCol;
     property LastMsgTxt: string read FLastMsgTxt write FLastMsgTxt;
     property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
-    property DebugLog: TStream read FDebugLog write FDebugLog;
+    property DebugLog: TPas2jsStream read FDebugLog write FDebugLog;
   end;
 
-function CompareP2JMessage(Item1, Item2: Pointer): Integer;
+function CompareP2JMessage(Item1, Item2: {$IFDEF Pas2JS}JSValue{$ELSE}Pointer{$ENDIF}): Integer;
 
-function QuoteStr(const s: string): string;
-function DeQuoteStr(const s: string): string;
+function QuoteStr(const s: string; Quote: char = '"'): string;
+function DeQuoteStr(const s: string; Quote: char = '"'): string;
 function AsString(Element: TPasElement; Full: boolean = true): string; overload;
 function AsString(Element: TJSElement): string; overload;
 function DbgString(Element: TJSElement; Indent: integer): string; overload;
@@ -154,12 +201,14 @@ function DbgAsString(Element: TJSValue; Indent: integer): string; overload;
 function DbgAsString(Element: TJSArrayLiteralElements; Indent: integer): string; overload;
 function DbgAsString(Element: TJSObjectLiteralElements; Indent: integer): string; overload;
 function DbgAsString(Element: TJSObjectLiteralElement; Indent: integer): string; overload;
+{$IFDEF UsePChar}
 function DbgHexMem(p: Pointer; Count: integer): string;
+{$ENDIF}
 function DbgStr(const s: string): string;
 
 implementation
 
-function CompareP2JMessage(Item1, Item2: Pointer): Integer;
+function CompareP2JMessage(Item1, Item2: {$IFDEF Pas2JS}JSValue{$ELSE}Pointer{$ENDIF}): Integer;
 var
   Msg1: TPas2jsMessage absolute Item1;
   Msg2: TPas2jsMessage absolute Item2;
@@ -167,14 +216,14 @@ begin
   Result:=Msg1.Number-Msg2.Number;
 end;
 
-function QuoteStr(const s: string): string;
+function QuoteStr(const s: string; Quote: char): string;
 begin
-  Result:=AnsiQuotedStr(S,'"');
+  Result:={$IFDEF Pas2JS}SysUtils.QuotedStr{$ELSE}AnsiQuotedStr{$ENDIF}(S,Quote);
 end;
 
-function DeQuoteStr(const s: string): string;
+function DeQuoteStr(const s: string; Quote: char): string;
 begin
-  Result:=AnsiDequotedStr(S,'"');
+  Result:={$IFDEF Pas2JS}SysUtils.DeQuoteString{$ELSE}AnsiDequotedStr{$ENDIF}(S,Quote);
 end;
 
 function AsString(Element: TPasElement; Full: boolean): string;
@@ -194,7 +243,7 @@ begin
   aTextWriter:=TBufferWriter.Create(120);
   aWriter:=TJSWriter.Create(aTextWriter);
   aWriter.WriteJS(Element);
-  Result:=aTextWriter.AsAnsistring;
+  Result:=aTextWriter.AsString;
   aWriter.Free;
   aTextWriter.Free;
 end;
@@ -252,16 +301,16 @@ begin
     if Element is TJSStatementList then
     begin
       Result:=DbgString(TJSBinaryExpression(Element).A,Indent+2)+';'+LineEnding
-             +Space(Indent)+DbgString(TJSBinaryExpression(Element).B,Indent);
+             +StringOfChar(' ',Indent)+DbgString(TJSBinaryExpression(Element).B,Indent);
     end else if Element is TJSVariableDeclarationList then
     begin
       Result:=DbgString(TJSBinaryExpression(Element).A,Indent+2)+';'+LineEnding
-             +Space(Indent)+DbgString(TJSBinaryExpression(Element).B,Indent);
+             +StringOfChar(' ',Indent)+DbgString(TJSBinaryExpression(Element).B,Indent);
     end else if Element is TJSWithStatement then
     begin
       Result:='with ('+DbgString(TJSBinaryExpression(Element).A,Indent+2)+'){'+LineEnding
-             +Space(Indent)+DbgString(TJSBinaryExpression(Element).B,Indent+2)+LineEnding
-             +Space(Indent)+'}';
+             +StringOfChar(' ',Indent)+DbgString(TJSBinaryExpression(Element).B,Indent+2)+LineEnding
+             +StringOfChar(' ',Indent)+'}';
     end else if Element is TJSBinaryExpression then
     begin
       Result:=DbgString(TJSBinaryExpression(Element).A,Indent+2);
@@ -299,12 +348,12 @@ begin
   end else if Element is TJSIfStatement then
   begin
     Result:='if('+DbgString(TJSIfStatement(Element).Cond,Indent+2)+'){'+LineEnding
-       +Space(Indent+2)+DbgString(TJSIfStatement(Element).BTrue,Indent+2)+LineEnding
-       +Space(Indent);
+       +StringOfChar(' ',Indent+2)+DbgString(TJSIfStatement(Element).BTrue,Indent+2)+LineEnding
+       +StringOfChar(' ',Indent);
     if TJSIfStatement(Element).BFalse<>nil then
       Result+=' else {'+LineEnding
-         +Space(Indent+2)+DbgString(TJSIfStatement(Element).BFalse,Indent+2)+LineEnding
-         +Space(Indent)+'}';
+         +StringOfChar(' ',Indent+2)+DbgString(TJSIfStatement(Element).BFalse,Indent+2)+LineEnding
+         +StringOfChar(' ',Indent)+'}';
 
   // body
   end else if Element is TJSBodyStatement then
@@ -351,8 +400,8 @@ begin
     end else begin
       if TJSBodyStatement(Element).Body<>nil then
         Result+='{'+LineEnding
-          +Space(Indent+2)+DbgString(TJSBodyStatement(Element).Body,Indent+2)+LineEnding
-          +Space(Indent)+'}'
+          +StringOfChar(' ',Indent+2)+DbgString(TJSBodyStatement(Element).Body,Indent+2)+LineEnding
+          +StringOfChar(' ',Indent)+'}'
       else
         Result+='{}';
     end;
@@ -372,14 +421,14 @@ begin
     jstNull: Result:='null';
     jstBoolean: Result:=BoolToStr(Element.AsBoolean,'true','false');
     jstNumber: str(Element.AsNumber,Result);
-    jstString: Result:=AnsiQuotedStr(Element.AsString{%H-},'''');
+    jstString: Result:=QuoteStr(Element.AsString{%H-},'''');
     jstObject: Result:='{:OBJECT:}';
     jstReference: Result:='{:REFERENCE:}';
     JSTCompletion: Result:='{:COMPLETION:}';
     else Result:='{:Unknown ValueType '+IntToStr(ord(Element.ValueType))+':}';
     end;
   end;
-  Result:=Space(Indent)+Result;
+  Result:=StringOfChar(' ',Indent)+Result;
 end;
 
 function DbgAsString(Element: TJSArrayLiteralElements; Indent: integer): string;
@@ -410,6 +459,7 @@ begin
           +':'+DbgString(TJSObjectLiteralElement(Element).Expr,Indent+2);
 end;
 
+{$IFDEF UsePChar}
 function DbgHexMem(p: Pointer; Count: integer): string;
 var
   i: Integer;
@@ -418,6 +468,7 @@ begin
   for i:=0 to Count-1 do
     Result:=Result+HexStr(ord(PChar(p)[i]),2);
 end;
+{$ENDIF}
 
 function DbgStr(const s: string): string;
 var
@@ -434,6 +485,35 @@ begin
   end;
 end;
 
+{$IFDEF Pas2JS}
+{ TPas2jsFileStream }
+
+constructor TPas2jsFileStream.Create(Filename: string; Mode: cardinal);
+begin
+  {AllowWriteln}
+  writeln('TPas2JSFileStream.Create TODO ',Filename,' Mode=',Mode);
+  {AllowWriteln-}
+  raise Exception.Create('TPas2JSFileStream.Create');
+end;
+
+destructor TPas2jsFileStream.Destroy;
+begin
+  {AllowWriteln}
+  writeln('TPas2JSFileStream.Destroy TODO');
+  {AllowWriteln-}
+  raise Exception.Create('TPas2JSFileStream.Destroy');
+  inherited Destroy;
+end;
+
+procedure TPas2jsFileStream.Write(const s: string);
+begin
+  {AllowWriteln}
+  writeln('TPas2JSFileStream.Write TODO s="',s,'"');
+  {AllowWriteln-}
+  raise Exception.Create('TPas2JSFileStream.Write');
+end;
+{$ENDIF}
+
 { TPas2jsLogger }
 
 function TPas2jsLogger.GetMsgs(Index: integer): TPas2jsMessage;
@@ -447,7 +527,7 @@ var
   l, r, m, CurMsgNumber: Integer;
 begin
   l:=0;
-  r:=FMsgNumberDisabledCount-1;
+  r:=length(FMsgNumberDisabled)-1;
   m:=0;
   while l<=r do begin
     m:=(l+r) div 2;
@@ -472,7 +552,11 @@ procedure TPas2jsLogger.SetEncoding(const AValue: string);
 var
   NewValue: String;
 begin
+  {$IFDEF Pas2JS}
+  NewValue:=Trim(lowercase(AValue));
+  {$ELSE}
   NewValue:=NormalizeEncoding(AValue);
+  {$ENDIF}
   if FEncoding=NewValue then Exit;
   //LogPlain(ClassName+': Encoding changed from "'+FEncoding+'" to "'+NewValue+'"');
   FEncoding:=NewValue;
@@ -488,28 +572,33 @@ procedure TPas2jsLogger.SetMsgNumberDisabled(MsgNumber: integer; AValue: boolean
 var
   InsertPos, OldCount: Integer;
 begin
-  OldCount:=FMsgNumberDisabledCount;
+  OldCount:=length(FMsgNumberDisabled);
   if AValue then
   begin
     // enable
     InsertPos:=FindMsgNumberDisabled(MsgNumber,true);
     if (InsertPos<OldCount) and (FMsgNumberDisabled[InsertPos]=MsgNumber) then
       exit; // already disabled
-    inc(FMsgNumberDisabledCount);
-    ReAllocMem(FMsgNumberDisabled,SizeOf(Integer)*FMsgNumberDisabledCount);
-    if InsertPos<OldCount then
-      Move(FMsgNumberDisabled[InsertPos],FMsgNumberDisabled[InsertPos+1],
-           SizeOf(Integer)*(OldCount-InsertPos));
+    // insert into array
+    {$IF defined(FPC) and (FPC_FULLVERSION<30101)}
+    SetLength(FMsgNumberDisabled,OldCount+1);
     FMsgNumberDisabled[InsertPos]:=MsgNumber;
+    {$ELSE}
+    Insert(MsgNumber,FMsgNumberDisabled,InsertPos);
+    {$ENDIF}
   end else begin
     // disable
     InsertPos:=FindMsgNumberDisabled(MsgNumber,false);
     if InsertPos<0 then exit;
+    // delete from array
+    {$IF defined(FPC) and (FPC_FULLVERSION<30101)}
     if InsertPos+1<OldCount then
       Move(FMsgNumberDisabled[InsertPos+1],FMsgNumberDisabled[InsertPos],
            SizeOf(Integer)*(OldCount-InsertPos-1));
-    dec(FMsgNumberDisabledCount);
-    ReAllocMem(FMsgNumberDisabled,SizeOf(Integer)*FMsgNumberDisabledCount);
+    SetLength(FMsgNumberDisabled,OldCount-1);
+    {$ELSE}
+    Delete(FMsgNumberDisabled,InsertPos,1);
+    {$ENDIF}
   end;
 end;
 
@@ -536,6 +625,7 @@ begin
   if SkipEncoding then
     S:=Msg
   else begin
+    {$IFDEF FPC_HAS_CPSTRING}
     if (Encoding='utf8') or (Encoding='json') then
       S:=Msg
     else if Encoding='console' then
@@ -547,6 +637,9 @@ begin
       if FOutputFile=nil then
         S:=UTF8ToConsole(Msg);
     end;
+    {$ELSE}
+    S:=Msg;
+    {$ENDIF}
   end;
   //writeln('TPas2jsLogger.LogPlain "',Encoding,'" "',DbgStr(S),'"');
   if DebugLog<>nil then
@@ -556,48 +649,74 @@ begin
   else if FOutputFile<>nil then
     FOutputFile.Write(S+LineEnding)
   else begin
+    {$IFDEF FPC_HAS_CPSTRING}
     // prevent codepage conversion magic
     SetCodePage(RawByteString(S), CP_OEMCP, False);
+    {$ENDIF}
     {AllowWriteln}
+    {$IFDEF HasStdErr}
     if WriteMsgToStdErr then
       writeln(StdErr,S)
     else
+    {$ENDIF}
       writeln(S);
     {AllowWriteln-}
   end;
 end;
 
-function TPas2jsLogger.Concatenate(Args: array of const): string;
+function TPas2jsLogger.Concatenate(
+  Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF}): string;
 var
   s: String;
   i: Integer;
+  {$IFDEF Pas2JS}
+  V: JSValue;
+  {$ELSE}
+  V: TVarRec;
+  {$ENDIF}
 begin
   s:='';
   for i:=Low(Args) to High(Args) do
   begin
-    case Args[i].VType of
-      vtInteger:      s += IntToStr(Args[i].VInteger);
-      vtBoolean:      s += BoolToStr(Args[i].VBoolean);
-      vtChar:         s += Args[i].VChar;
+    V:=Args[i];
+    {$IFDEF Pas2JS}
+    case jsTypeOf(V) of
+    'boolean':
+      if V then s+='true' else s+='false';
+    'number':
+      if isInteger(V) then
+        s+=str(NativeInt(V))
+      else
+        s+=str(Double(V));
+    'string':
+      s+=String(V);
+    else continue;
+    end;
+    {$ELSE}
+    case V.VType of
+      vtInteger:      s += IntToStr(V.VInteger);
+      vtBoolean:      s += BoolToStr(V.VBoolean);
+      vtChar:         s += V.VChar;
       {$ifndef FPUNONE}
-      vtExtended:     ; //  Args[i].VExtended^;
+      vtExtended:     ; //  V.VExtended^;
       {$ENDIF}
-      vtString:       s += Args[i].VString^;
-      vtPointer:      ; //  Args[i].VPointer;
-      vtPChar:        s += Args[i].VPChar;
-      vtObject:       ; //  Args[i].VObject;
-      vtClass:        ; //  Args[i].VClass;
-      vtWideChar:     s += AnsiString(Args[i].VWideChar);
-      vtPWideChar:    s += AnsiString(Args[i].VPWideChar);
-      vtAnsiString:   s += AnsiString(Args[i].VAnsiString);
-      vtCurrency:     ; //  Args[i].VCurrency^);
-      vtVariant:      ; //  Args[i].VVariant^);
-      vtInterface:    ; //  Args[i].VInterface^);
-      vtWidestring:   s += AnsiString(WideString(Args[i].VWideString));
-      vtInt64:        s += IntToStr(Args[i].VInt64^);
-      vtQWord:        s += IntToStr(Args[i].VQWord^);
-      vtUnicodeString:s += AnsiString(UnicodeString(Args[i].VUnicodeString));
+      vtString:       s += V.VString^;
+      vtPointer:      ; //  V.VPointer;
+      vtPChar:        s += V.VPChar;
+      vtObject:       ; //  V.VObject;
+      vtClass:        ; //  V.VClass;
+      vtWideChar:     s += AnsiString(V.VWideChar);
+      vtPWideChar:    s += AnsiString(V.VPWideChar);
+      vtAnsiString:   s += AnsiString(V.VAnsiString);
+      vtCurrency:     ; //  V.VCurrency^);
+      vtVariant:      ; //  V.VVariant^);
+      vtInterface:    ; //  V.VInterface^);
+      vtWidestring:   s += AnsiString(WideString(V.VWideString));
+      vtInt64:        s += IntToStr(V.VInt64^);
+      vtQWord:        s += IntToStr(V.VQWord^);
+      vtUnicodeString:s += AnsiString(UnicodeString(V.VUnicodeString));
     end;
+    {$ENDIF}
   end;
   Result:=s;
 end;
@@ -615,10 +734,9 @@ begin
   CloseOutputFile;
   CloseDebugLog;
   for i:=0 to FMsg.Count-1 do
-    TObject(FMsg[i]).Free;
+    TObject(FMsg[i]).{$IFDEF Pas2JS}Destroy{$ELSE}Free{$ENDIF};
   FreeAndNil(FMsg);
-  ReAllocMem(FMsgNumberDisabled,0);
-  FMsgNumberDisabledCount:=0;
+  FMsgNumberDisabled:=nil;
   inherited Destroy;
 end;
 
@@ -688,7 +806,7 @@ begin
 end;
 
 function TPas2jsLogger.GetMsgText(MsgNumber: integer;
-  Args: array of const): string;
+  Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF}): string;
 var
   Msg: TPas2jsMessage;
 begin
@@ -702,7 +820,8 @@ begin
   DoLogRaw(Msg,False);
 end;
 
-procedure TPas2jsLogger.LogRaw(Args: array of const);
+procedure TPas2jsLogger.LogRaw(
+  Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF});
 begin
   LogRaw(Concatenate(Args));
 end;
@@ -716,7 +835,11 @@ procedure TPas2jsLogger.DebugLogWriteLn(Msg: string);
 begin
   if FDebugLog=nil then exit;
   Msg:=Msg+LineEnding;
+  {$IFDEF Pas2JS}
+  FDebugLog.Write(Msg);
+  {$ELSE}
   FDebugLog.Write(Msg[1],length(Msg));
+  {$ENDIF}
 end;
 
 function TPas2jsLogger.GetEncodingCaption: string;
@@ -724,9 +847,11 @@ begin
   Result:=Encoding;
   if Result='' then
   begin
+    {$IFDEF FPC_HAS_CPSTRING}
     if FOutputFile=nil then
       Result:='console'
     else
+    {$ENDIF}
       Result:='utf-8';
   end;
   if Result='console' then
@@ -753,12 +878,14 @@ begin
     DoLogRaw(Msg,False);
 end;
 
-procedure TPas2jsLogger.LogPlain(Args: array of const);
+procedure TPas2jsLogger.LogPlain(
+  Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF});
 begin
   LogPlain(Concatenate(Args));
 end;
 
-procedure TPas2jsLogger.LogMsg(MsgNumber: integer; Args: array of const;
+procedure TPas2jsLogger.LogMsg(MsgNumber: integer;
+  Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF};
   const Filename: string; Line: integer; Col: integer; UseFilter: boolean);
 var
   Msg: TPas2jsMessage;
@@ -789,11 +916,12 @@ begin
 end;
 
 procedure TPas2jsLogger.LogMsgIgnoreFilter(MsgNumber: integer;
-  Args: array of const);
+  Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF});
 begin
   LogMsg(MsgNumber,Args,'',0,0,false);
 end;
 
+{$IFDEF FPC}
 procedure TPas2jsLogger.LogExceptionBackTrace;
 var
   lErrorAddr: CodePointer;
@@ -808,6 +936,7 @@ begin
   for FrameNumber := 0 to FrameCount-1 do
     Log(mtDebug,BackTraceStrFunc(Frames[FrameNumber]));
 end;
+{$ENDIF}
 
 function TPas2jsLogger.MsgTypeToStr(MsgType: TMessageType): string;
 begin
@@ -887,8 +1016,10 @@ begin
   if DirectoryExists(OutputFilename) then
     raise Exception.Create('Log is directory: "'+OutputFilename+'"');
   FOutputFile:=TFileWriter.Create(OutputFilename);
+  {$IFDEF FPC_HAS_CPSTRING}
   if (Encoding='') or (Encoding='utf8') then
     FOutputFile.Write(UTF8BOM);
+  {$ENDIF}
 end;
 
 procedure TPas2jsLogger.Flush;
@@ -907,11 +1038,7 @@ end;
 procedure TPas2jsLogger.Reset;
 begin
   OutputFilename:='';
-  if FMsgNumberDisabled<>nil then
-  begin
-    ReAllocMem(FMsgNumberDisabled,0);
-    FMsgNumberDisabledCount:=0;
-  end;
+  FMsgNumberDisabled:=nil;
   ShowMsgNumbers:=false;
   FShowMsgTypes:=DefaultLogMsgTypes;
 end;
@@ -930,7 +1057,7 @@ procedure TPas2jsLogger.OpenDebugLog;
 const
   DbgLogFilename = 'pas2jsdebug.log';
 begin
-  FDebugLog:=TFileStream.Create(DbgLogFilename,fmCreate or fmShareDenyNone);
+  FDebugLog:=TPas2jsFileStream.Create(DbgLogFilename,fmCreate or fmShareDenyNone);
 end;
 
 procedure TPas2jsLogger.CloseDebugLog;

packages/pastojs/src/pas2jspparser.pp

@@ -19,7 +19,8 @@
 unit Pas2jsPParser;
 
 {$mode objfpc}{$H+}
-{$inline on}
+
+{$i pas2js_defines.inc}
 
 interface
 
@@ -33,6 +34,23 @@ const // Messages
 
 type
 
+  { TPas2jsPasScanner }
+
+  TPas2jsPasScanner = class(TPascalScanner)
+  private
+    FCompilerVersion: string;
+    FResolver: TPas2JSResolver;
+    FTargetPlatform: TPasToJsPlatform;
+    FTargetProcessor: TPasToJsProcessor;
+  protected
+    function HandleInclude(const Param: String): TToken; override;
+  public
+    property CompilerVersion: string read FCompilerVersion write FCompilerVersion;
+    property Resolver: TPas2JSResolver read FResolver write FResolver;
+    property TargetPlatform: TPasToJsPlatform read FTargetPlatform write FTargetPlatform;
+    property TargetProcessor: TPasToJsProcessor read FTargetProcessor write FTargetProcessor;
+  end;
+
   { TPas2jsPasParser }
 
   TPas2jsPasParser = class(TPasParser)
@@ -40,10 +58,9 @@ type
     FLog: TPas2jsLogger;
   public
     constructor Create(AScanner: TPascalScanner;
-      AFileResolver: TBaseFileResolver; AEngine: TPasTreeContainer);
-    procedure SetLastMsg(MsgType: TMessageType; MsgNumber: integer;
-      Const Fmt : String; Args : Array of const);
-    procedure RaiseParserError(MsgNumber: integer; Args: array of const);
+      AFileResolver: TBaseFileResolver; AEngine: TPasTreeContainer); reintroduce;
+    procedure RaiseParserError(MsgNumber: integer;
+      Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF});
     procedure ParseSubModule(var Module: TPasModule);
     property Log: TPas2jsLogger read FLog write FLog;
   end;
@@ -106,6 +123,81 @@ begin
   r(mtError,nFinalizationNotSupported,sFinalizationNotSupported);
 end;
 
+{ TPas2jsPasScanner }
+
+function TPas2jsPasScanner.HandleInclude(const Param: String): TToken;
+
+  procedure SetStr(const s: string);
+  begin
+    Result:=tkString;
+    SetCurTokenString(''''+s+'''');
+  end;
+
+var
+  Year, Month, Day, Hour, Minute, Second, MilliSecond: word;
+  i: Integer;
+  Scope: TPasScope;
+begin
+  if (Param<>'') and (Param[1]='%') then
+  begin
+    case lowercase(Param) of
+    '%date%':
+      begin
+        DecodeDate(Now,Year,Month,Day);
+        SetStr('['+IntToStr(Year)+'/'+IntToStr(Month)+'/'+IntToStr(Day)+']');
+        exit;
+      end;
+    '%time%':
+      begin
+        DecodeTime(Now,Hour,Minute,Second,MilliSecond);
+        SetStr(Format('%2d:%2d:%2d',[Hour,Minute,Second]));
+        exit;
+      end;
+    '%pas2jstarget%','%fpctarget%',
+    '%pas2jstargetos%','%fpctargetos%':
+      begin
+        SetStr(PasToJsPlatformNames[TargetPlatform]);
+        exit;
+      end;
+    '%pas2jstargetcpu%','%fpctargetcpu%':
+      begin
+        SetStr(PasToJsProcessorNames[TargetProcessor]);
+        exit;
+      end;
+    '%pas2jsversion%','%fpcversion%':
+      begin
+        SetStr(CompilerVersion);
+        exit;
+      end;
+    '%line%':
+      begin
+        SetStr(IntToStr(CurRow));
+        exit;
+      end;
+    '%currentroutine%':
+      begin
+        if Resolver<>nil then
+          for i:=Resolver.ScopeCount-1 downto 0 do
+          begin
+            Scope:=Resolver.Scopes[i];
+            if (Scope.Element is TPasProcedure)
+                and (Scope.Element.Name<>'') then
+            begin
+              SetStr(Scope.Element.Name);
+              exit;
+            end;
+          end;
+        SetStr('<anonymous>');
+        exit;
+      end;
+    else
+      DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,SWarnIllegalCompilerDirectiveX,
+        ['$i '+Param]);
+    end;
+  end;
+  Result:=inherited HandleInclude(Param);
+end;
+
 { TPas2jsPasParser }
 
 constructor TPas2jsPasParser.Create(AScanner: TPascalScanner;
@@ -115,13 +207,8 @@ begin
   Options:=Options+po_pas2js;
 end;
 
-procedure TPas2jsPasParser.SetLastMsg(MsgType: TMessageType;
-  MsgNumber: integer; const Fmt: String; Args: array of const);
-begin
-  inherited SetLastMsg(MsgType,MsgNumber,Fmt,Args);
-end;
-
-procedure TPas2jsPasParser.RaiseParserError(MsgNumber: integer; Args: array of const);
+procedure TPas2jsPasParser.RaiseParserError(MsgNumber: integer;
+  Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF});
 var
   Msg: TPas2jsMessage;
 begin
@@ -154,7 +241,7 @@ function TPas2jsCompilerResolver.CreateElement(AClass: TPTreeElement;
 begin
   if AClass=TFinalizationSection then
     (CurrentParser as TPas2jsPasParser).RaiseParserError(nFinalizationNotSupported,[]);
-  Result:=inherited;
+  Result:=inherited CreateElement(AClass,AName,AParent,AVisibility,ASrcPos);
   if (Result is TPasModule) then
     OnCheckSrcName(Result);
 end;

packages/pastojs/tests/tcfiler.pas

@@ -25,7 +25,7 @@ interface
 uses
   Classes, SysUtils, fpcunit, testregistry,
   PasTree, PScanner, PasResolver, PasResolveEval, PParser, PasUseAnalyzer,
-  FPPas2Js, Pas2JsFiler,
+  FPPas2Js, Pas2JsFiler, Pas2jsPParser,
   tcmodules, jstree;
 
 type
@@ -307,7 +307,7 @@ var
   // restored classes:
   RestResolver: TTestEnginePasResolver;
   RestFileResolver: TFileResolver;
-  RestScanner: TPascalScanner;
+  RestScanner: TPas2jsPasScanner;
   RestParser: TPasParser;
   RestConverter: TPasToJSConverter;
   RestJSModule: TJSSourceElements;
@@ -348,7 +348,7 @@ begin
       writeln('TCustomTestPrecompile.WriteReadUnit PCU END-------');
 
       RestFileResolver:=TFileResolver.Create;
-      RestScanner:=TPascalScanner.Create(RestFileResolver);
+      RestScanner:=TPas2jsPasScanner.Create(RestFileResolver);
       InitScanner(RestScanner);
       RestResolver:=TTestEnginePasResolver.Create;
       RestResolver.Filename:=Engine.Filename;
@@ -1541,11 +1541,11 @@ end;
 
 procedure TTestPrecompile.Test_Base256VLQ;
 
-  procedure Test(i: MaxPrecInt);
+  procedure Test(i: TMaxPrecInt);
   var
     s: String;
     p: PByte;
-    j: MaxPrecInt;
+    j: TMaxPrecInt;
   begin
     s:=EncodeVLQ(i);
     p:=PByte(s);
@@ -1554,7 +1554,7 @@ procedure TTestPrecompile.Test_Base256VLQ;
       Fail('Encode/DecodeVLQ OrigIndex='+IntToStr(i)+' Code="'+s+'" NewIndex='+IntToStr(j));
   end;
 
-  procedure TestStr(i: MaxPrecInt; Expected: string);
+  procedure TestStr(i: TMaxPrecInt; Expected: string);
   var
     Actual: String;
   begin
@@ -1570,11 +1570,11 @@ begin
   TestStr(-1,#3);
   for i:=-8200 to 8200 do
     Test(i);
-  Test(High(MaxPrecInt));
-  Test(High(MaxPrecInt)-1);
-  Test(Low(MaxPrecInt)+2);
-  Test(Low(MaxPrecInt)+1);
-  //Test(Low(MaxPrecInt)); such a high number is not needed by pastojs
+  Test(High(TMaxPrecInt));
+  Test(High(TMaxPrecInt)-1);
+  Test(Low(TMaxPrecInt)+2);
+  Test(Low(TMaxPrecInt)+1);
+  //Test(Low(TMaxPrecInt)); such a high number is not needed by pastojs
 end;
 
 procedure TTestPrecompile.TestPC_EmptyUnit;

packages/pastojs/tests/tcmodules.pas

@@ -27,7 +27,7 @@ uses
   Classes, SysUtils, fpcunit, testregistry, contnrs,
   jstree, jswriter, jsbase,
   PasTree, PScanner, PasResolver, PParser, PasResolveEval,
-  FPPas2Js;
+  Pas2jsPParser, FPPas2Js;
 
 const
   // default parser+scanner options
@@ -76,7 +76,7 @@ type
     FOnFindUnit: TOnFindUnit;
     FParser: TTestPasParser;
     FStreamResolver: TStreamResolver;
-    FScanner: TPascalScanner;
+    FScanner: TPas2jsPasScanner;
     FSource: string;
   public
     destructor Destroy; override;
@@ -86,7 +86,7 @@ type
     property OnFindUnit: TOnFindUnit read FOnFindUnit write FOnFindUnit;
     property Filename: string read FFilename write FFilename;
     property StreamResolver: TStreamResolver read FStreamResolver write FStreamResolver;
-    property Scanner: TPascalScanner read FScanner write FScanner;
+    property Scanner: TPas2jsPasScanner read FScanner write FScanner;
     property Parser: TTestPasParser read FParser write FParser;
     property Source: string read FSource write FSource;
     property Module: TPasModule read FModule;
@@ -119,7 +119,7 @@ type
     FHintMsgs: TObjectList; // list of TTestHintMessage
     FHintMsgsGood: TFPList; // list of TTestHintMessage marked as expected
     FJSRegModuleCall: TJSCallExpression;
-    FScanner: TPascalScanner;
+    FScanner: TPas2jsPasScanner;
     FSkipTests: boolean;
     FSource: TStringList;
     FFirstPasStatement: TPasImplBlock;
@@ -138,7 +138,7 @@ type
     procedure SetUp; override;
     function CreateConverter: TPasToJSConverter; virtual;
     function LoadUnit(const aUnitName: String): TPasModule;
-    procedure InitScanner(aScanner: TPascalScanner); virtual;
+    procedure InitScanner(aScanner: TPas2jsPasScanner); virtual;
     procedure TearDown; override;
     Procedure Add(Line: string); virtual;
     Procedure Add(const Lines: array of string);
@@ -210,7 +210,7 @@ type
     destructor Destroy; override;
     property Source: TStringList read FSource;
     property FileResolver: TStreamResolver read FFileResolver;
-    property Scanner: TPascalScanner read FScanner;
+    property Scanner: TPas2jsPasScanner read FScanner;
     property Parser: TTestPasParser read FParser;
     property MsgCount: integer read GetMsgCount;
     property Msgs[Index: integer]: TTestHintMessage read GetMsgs;
@@ -232,6 +232,7 @@ type
     Procedure Test_ModeSwitchCBlocksFail;
     Procedure TestUnit_UseSystem;
     Procedure TestUnit_Intf1Impl2Intf1;
+    Procedure TestIncludeVersion;
 
     // vars/const
     Procedure TestVarInt;
@@ -361,6 +362,7 @@ type
     Procedure TestBitwiseOperators;
     Procedure TestFunctionInt;
     Procedure TestFunctionString;
+    Procedure TestIfThen;
     Procedure TestForLoop;
     Procedure TestForLoopInsideFunction;
     Procedure TestForLoop_ReadVarAfter;
@@ -371,6 +373,7 @@ type
     Procedure TestTryFinally;
     Procedure TestTryExcept;
     Procedure TestTryExcept_ReservedWords;
+    Procedure TestIfThenRaiseElse;
     Procedure TestCaseOf;
     Procedure TestCaseOf_UseSwitch;
     Procedure TestCaseOfNoElse;
@@ -774,7 +777,7 @@ begin
     aJSWriter:=TJSWriter.Create(aWriter);
     aJSWriter.IndentSize:=2;
     aJSWriter.WriteJS(El);
-    Result:=aWriter.AsAnsistring;
+    Result:=aWriter.AsString;
   finally
     aJSWriter.Free;
     aWriter.Free;
@@ -1071,9 +1074,9 @@ end;
 procedure TCustomTestModule.OnScannerLog(Sender: TObject; const Msg: String);
 var
   Item: TTestHintMessage;
-  aScanner: TPascalScanner;
+  aScanner: TPas2jsPasScanner;
 begin
-  aScanner:=Sender as TPascalScanner;
+  aScanner:=Sender as TPas2jsPasScanner;
   Item:=TTestHintMessage.Create;
   Item.Id:=aScanner.LastMsgNumber;
   Item.MsgType:=aScanner.LastMsgType;
@@ -1114,7 +1117,7 @@ begin
       CurEngine.StreamResolver.OwnsStreams:=True;
       //writeln('TTestModule.FindUnit SOURCE=',CurEngine.Source);
       CurEngine.StreamResolver.AddStream(CurEngine.FileName,TStringStream.Create(CurEngine.Source));
-      CurEngine.Scanner:=TPascalScanner.Create(CurEngine.StreamResolver);
+      CurEngine.Scanner:=TPas2jsPasScanner.Create(CurEngine.StreamResolver);
       InitScanner(CurEngine.Scanner);
       CurEngine.Parser:=TTestPasParser.Create(CurEngine.Scanner,CurEngine.StreamResolver,CurEngine);
       CurEngine.Parser.Options:=po_tcmodules;
@@ -1156,11 +1159,12 @@ begin
   FFileResolver:=TStreamResolver.Create;
   FFileResolver.OwnsStreams:=True;
 
-  FScanner:=TPascalScanner.Create(FFileResolver);
+  FScanner:=TPas2jsPasScanner.Create(FFileResolver);
   InitScanner(FScanner);
 
   FEngine:=AddModule(Filename);
   FEngine.Scanner:=FScanner;
+  FScanner.Resolver:=FEngine;
 
   FParser:=TTestPasParser.Create(FScanner,FFileResolver,FEngine);
   FParser.OnLog:=@OnParserLog;
@@ -1179,7 +1183,7 @@ begin
   Result.Options:=co_tcmodules;
 end;
 
-procedure TCustomTestModule.InitScanner(aScanner: TPascalScanner);
+procedure TCustomTestModule.InitScanner(aScanner: TPas2jsPasScanner);
 begin
   aScanner.AllowedModeSwitches:=msAllPas2jsModeSwitches;
   aScanner.ReadOnlyModeSwitches:=msAllPas2jsModeSwitchesReadOnly;
@@ -1190,6 +1194,8 @@ begin
   aScanner.CurrentBoolSwitches:=msAllPas2jsBoolSwitchesReadOnly+[bsHints,bsNotes,bsWarnings,bsWriteableConst];
 
   aScanner.OnLog:=@OnScannerLog;
+
+  aScanner.CompilerVersion:='Comp.Ver.tcmodules';
 end;
 
 procedure TCustomTestModule.TearDown;
@@ -2247,6 +2253,32 @@ begin
     '']) );
 end;
 
+procedure TTestModule.TestIncludeVersion;
+begin
+  StartProgram(false);
+  Add([
+  'var s: string;',
+  'begin',
+  '  s:={$I %line%};',
+  '  s:={$I %currentroutine%};',
+  '  s:={$I %pas2jsversion%};',
+  '  s:={$I %pas2jstarget%};',
+  '  s:={$I %pas2jstargetos%};',
+  '  s:={$I %pas2jstargetcpu%};',
+  '']);
+  ConvertProgram;
+  CheckSource('TestIncludeVersion',
+    'this.s="";',
+    LinesToStr([
+    '$mod.s = "5";',
+    '$mod.s = "<anonymous>";',
+    '$mod.s = "Comp.Ver.tcmodules";',
+    '$mod.s = "Browser";',
+    '$mod.s = "Browser";',
+    '$mod.s = "ECMAScript5";',
+    '']));
+end;
+
 procedure TTestModule.TestVarInt;
 begin
   StartProgram(false);
@@ -2391,6 +2423,8 @@ begin
   '  c:=char(c);',
   '  c:=char(i);',
   '  c:=char(65);',
+  '  c:=char(#10);',
+  '  c:=char(#$E000);',
   '']);
   ConvertProgram;
   CheckSource('TestAliasTypeRef',
@@ -2413,6 +2447,8 @@ begin
     '$mod.c = $mod.c;',
     '$mod.c = String.fromCharCode($mod.i);',
     '$mod.c = "A";',
+    '$mod.c = "\n";',
+    '$mod.c = "";',
     '']));
 end;
 
@@ -3824,16 +3860,25 @@ begin
   'type',
   '  TObject = class',
   '    Index: longint;',
+  '    procedure DoAbs(Item: pointer);',
   '  end;',
-  'procedure DoIt(i: longint);',
+  'procedure TObject.DoAbs(Item: pointer);',
+  'var',
+  '  o: TObject absolute Item;',
+  'begin',
+  '  if o.Index<o.Index then o.Index:=o.Index;',
+  'end;',
+  'procedure DoIt(i: longint; p: pointer);',
   'var',
   '  d: double absolute i;',
   '  s: string absolute d;',
-  '  o: TObject absolute i;',
+  '  oi: TObject absolute i;',
+  '  op: TObject absolute p;',
   'begin',
   '  if d=d then d:=d;',
   '  if s=s then s:=s;',
-  '  if o.Index<o.Index then o.Index:=o.Index;',
+  '  if oi.Index<oi.Index then oi.Index:=oi.Index;',
+  '  if op.Index=op.Index then op.Index:=op.Index;',
   'end;',
   'begin']);
   ConvertProgram;
@@ -3845,11 +3890,15 @@ begin
     '  };',
     '  this.$final = function () {',
     '  };',
+    '  this.DoAbs = function (Item) {',
+    '    if (Item.Index < Item.Index) Item.Index = Item.Index;',
+    '  };',
     '});',
-    'this.DoIt = function (i) {',
+    'this.DoIt = function (i, p) {',
     '  if (i === i) i = i;',
     '  if (i === i) i = i;',
     '  if (i.Index < i.Index) i.Index = i.Index;',
+    '  if (p.Index === p.Index) p.Index = p.Index;',
     '};'
     ]),
     LinesToStr([
@@ -4499,22 +4548,25 @@ end;
 procedure TTestModule.TestSet_AsParams;
 begin
   StartProgram(false);
-  Add('type TEnum = (Red,Blue);');
-  Add('type TEnums = set of TEnum;');
-  Add('procedure DoIt(vG: TEnums; const vH: TEnums; var vI: TEnums);');
-  Add('var vJ: TEnums;');
-  Add('begin');
-  Add('  vg:=vg;');
-  Add('  vj:=vh;');
-  Add('  vi:=vi;');
-  Add('  doit(vg,vg,vg);');
-  Add('  doit(vh,vh,vj);');
-  Add('  doit(vi,vi,vi);');
-  Add('  doit(vj,vj,vj);');
-  Add('end;');
-  Add('var i: TEnums;');
-  Add('begin');
-  Add('  doit(i,i,i);');
+  Add([
+  'type TEnum = (Red,Blue);',
+  'type TEnums = set of TEnum;',
+  'function DoIt(vG: TEnums; const vH: TEnums; var vI: TEnums): TEnums;',
+  'var vJ: TEnums;',
+  'begin',
+  '  Include(vg,red);',
+  '  Include(result,blue);',
+  '  vg:=vg;',
+  '  vj:=vh;',
+  '  vi:=vi;',
+  '  doit(vg,vg,vg);',
+  '  doit(vh,vh,vj);',
+  '  doit(vi,vi,vi);',
+  '  doit(vj,vj,vj);',
+  'end;',
+  'var i: TEnums;',
+  'begin',
+  '  doit(i,i,i);']);
   ConvertProgram;
   CheckSource('TestSet_AsParams',
     LinesToStr([ // statements
@@ -4525,7 +4577,10 @@ begin
     '  Blue: 1',
     '};',
     'this.DoIt = function (vG,vH,vI) {',
+    '  var Result = {};',
     '  var vJ = {};',
+    '  vG = rtl.includeSet(vG, $mod.TEnum.Red);',
+    '  Result = rtl.includeSet(Result, $mod.TEnum.Blue);',
     '  vG = rtl.refSet(vG);',
     '  vJ = rtl.refSet(vH);',
     '  vI.set(rtl.refSet(vI.get()));',
@@ -4554,6 +4609,7 @@ begin
     '      vJ = v;',
     '    }',
     '  });',
+    '  return Result;',
     '};',
     'this.i = {};'
     ]),
@@ -5165,17 +5221,21 @@ begin
   StartProgram(false);
   Add([
   'const',
-  '  NaN: double; external name ''Global.NaN'';',
+  '  PI: double; external name ''Global.PI'';',
+  '  Tau = 2*pi;',
   'var d: double;',
   'begin',
-  '  d:=NaN;']);
+  '  d:=pi;',
+  '  d:=tau+pi;']);
   ConvertProgram;
   CheckSource('TestConstExternal',
     LinesToStr([
+    'this.Tau = 2*Global.PI;',
     'this.d = 0.0;'
     ]),
     LinesToStr([
-    '$mod.d = Global.NaN;'
+    '$mod.d = Global.PI;',
+    '$mod.d = $mod.Tau + Global.PI;'
     ]));
 end;
 
@@ -5312,7 +5372,9 @@ begin
   '  i: TMyInt;',
   'begin',
   '  i:=-MinInt;',
-  '  i:=default(TMyInt);']);
+  '  i:=default(TMyInt);',
+  '  i:=low(i)+high(i);',
+  '']);
   ConvertProgram;
   CheckSource('TestIntegerRange',
     LinesToStr([
@@ -5324,6 +5386,7 @@ begin
     LinesToStr([
     '$mod.i = - -4503599627370496;',
     '$mod.i = -4503599627370496;',
+    '$mod.i = -4503599627370496 + 4503599627370495;',
     '']));
 end;
 
@@ -5444,8 +5507,13 @@ begin
   '  c:=a;',
   '  d:=c;',
   '  c:=d;',
+  '  c:=currency(c);',
   '  c:=currency(d);',
   '  d:=double(c);',
+  '  c:=i;',
+  '  c:=currency(i);',
+  //'  i:=c;', not allowed
+  '  i:=nativeint(c);',
   '  c:=c+a;',
   '  c:=-c-a;',
   '  c:=d+c;',
@@ -5507,8 +5575,12 @@ begin
     '$mod.c = $mod.a;',
     '$mod.d = $mod.c / 10000;',
     '$mod.c = Math.floor($mod.d * 10000);',
+    '$mod.c = $mod.c;',
     '$mod.c = $mod.d * 10000;',
     '$mod.d = $mod.c / 10000;',
+    '$mod.c = $mod.i * 10000;',
+    '$mod.c = $mod.i * 10000;',
+    '$mod.i = Math.floor($mod.c / 10000);',
     '$mod.c = $mod.c + $mod.a;',
     '$mod.c = -$mod.c - $mod.a;',
     '$mod.c = ($mod.d * 10000) + $mod.c;',
@@ -6298,6 +6370,25 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestIfThen;
+begin
+  StartProgram(false);
+  Add([
+  'var b: boolean;',
+  'begin',
+  '  if b then ;',
+  '  if b then else ;']);
+  ConvertProgram;
+  CheckSource('TestIfThen',
+    LinesToStr([ // statements
+    'this.b = false;',
+    '']),
+    LinesToStr([ // this.$main
+    'if ($mod.b) ;',
+    'if ($mod.b) ;',
+    '']));
+end;
+
 procedure TTestModule.TestForLoop;
 begin
   StartProgram(false);
@@ -6682,6 +6773,44 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestIfThenRaiseElse;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    constructor Create;',
+  '  end;',
+  'constructor TObject.Create;',
+  'begin',
+  'end;',
+  'var b: boolean;',
+  'begin',
+  '  if b then',
+  '    raise TObject.Create',
+  '  else',
+  '    b:=false;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestIfThenRaiseElse',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '  };',
+    '});',
+    'this.b = false;',
+    '']),
+    LinesToStr([ // $mod.$main
+    'if ($mod.b) {',
+    '  throw $mod.TObject.$create("Create")}',
+    ' else $mod.b = false;',
+    '']));
+end;
+
 procedure TTestModule.TestCaseOf;
 begin
   StartProgram(false);
@@ -7943,11 +8072,11 @@ begin
   '  TArrStr = array of string;',
   'const',
   '  Ints: TArrInt = (1,2,3);',
-  '  Names: array of string = (''a'',''foo'');',
   '  Aliases: TarrStr = (''foo'',''b'');',
   '  OneInt: TArrInt = (7);',
   '  OneStr: array of integer = (7);',
   '  Chars: array of char = ''aoc'';',
+  '  Names: array of string = (''a'',''foo'');',
   '  NameCount = low(Names)+high(Names)+length(Names);',
   'var i: integer;',
   'begin',
@@ -7966,11 +8095,11 @@ begin
   CheckSource('TestArray_DynArrayConstObjFPC',
     LinesToStr([ // statements
     'this.Ints = [1, 2, 3];',
-    'this.Names = ["a", "foo"];',
     'this.Aliases = ["foo", "b"];',
     'this.OneInt = [7];',
     'this.OneStr = [7];',
     'this.Chars = ["a", "o", "c"];',
+    'this.Names = ["a", "foo"];',
     'this.NameCount = (0 + (rtl.length($mod.Names) - 1)) + rtl.length($mod.Names);',
     'this.i = 0;',
     '']),
@@ -8000,11 +8129,11 @@ begin
   '  TArrStr = array of string;',
   'const',
   '  Ints: TArrInt = [1,1,2];',
-  '  Names: array of string = [''a'',''a''];',
   '  Aliases: TarrStr = [''foo'',''b''];',
   '  OneInt: TArrInt = [7];',
   '  OneStr: array of integer = [7]+[8];',
   '  Chars: array of char = ''aoc'';',
+  '  Names: array of string = [''a'',''a''];',
   '  NameCount = low(Names)+high(Names)+length(Names);',
   'begin',
   '']);
@@ -8012,11 +8141,11 @@ begin
   CheckSource('TestArray_DynArrayConstDelphi',
     LinesToStr([ // statements
     'this.Ints = [1, 1, 2];',
-    'this.Names = ["a", "a"];',
     'this.Aliases = ["foo", "b"];',
     'this.OneInt = [7];',
     'this.OneStr = rtl.arrayConcatN([7],[8]);',
     'this.Chars = ["a", "o", "c"];',
+    'this.Names = ["a", "a"];',
     'this.NameCount = (0 + (rtl.length($mod.Names) - 1)) + rtl.length($mod.Names);',
     '']),
     LinesToStr([ // $mod.$main
@@ -11733,10 +11862,16 @@ begin
   '  TObject = class',
   '    Obj: tobject;',
   '    procedure Free;',
+  '    procedure Release;',
   '  end;',
   'procedure tobject.free;',
   'begin',
   'end;',
+  'procedure tobject.release;',
+  'begin',
+  '  free;',
+  '  if true then free;',
+  'end;',
   'function DoIt(o: tobject): tobject;',
   'var l: tobject;',
   'begin',
@@ -11770,6 +11905,10 @@ begin
     '  };',
     '  this.Free = function () {',
     '  };',
+    '  this.Release = function () {',
+    '    this.Free();',
+    '    if (true) this.Free();',
+    '  };',
     '});',
     'this.DoIt = function (o) {',
     '  var Result = null;',
@@ -14488,7 +14627,6 @@ begin
     '  };',
     '});',
     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IBird);',
     '});',
     'this.BirdIntf = null;',
@@ -14567,7 +14705,6 @@ begin
     '  };',
     '  this.DoIt$3 = function (b) {',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IBird, {',
     '    DoIt$2: "DoIt$3",',
     '    DoIt: "DoIt$2"',
@@ -14657,7 +14794,6 @@ begin
     '  };',
     '  this.DoIt = function (i) {',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IUnknown);',
     '});',
     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
@@ -14706,7 +14842,6 @@ begin
     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
     '  this.DoIt$1 = function (i) {',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IBird, {',
     '    DoIt: "DoIt$1"',
     '  });',
@@ -14766,7 +14901,6 @@ begin
     '  };',
     '  this.Hop$1 = function (b) {',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IBird, {',
     '    Walk$1: "Hop$1",',
     '    Fly: "Move",',
@@ -14813,7 +14947,6 @@ begin
     '  };',
     '  this.$final = function () {',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IBird);',
     '  rtl.addIntf(this, $mod.IDog);',
     '});',
@@ -14863,7 +14996,6 @@ begin
     '  };',
     '  this.$final = function () {',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IUnknown);',
     '});',
     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
@@ -14935,7 +15067,6 @@ begin
     '  };',
     '});',
     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IBird);',
     '  rtl.addIntf(this, $mod.IEagle);',
     '  rtl.addIntf(this, $mod.IDove);',
@@ -15023,7 +15154,6 @@ begin
     '  };',
     '});',
     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IBird);',
     '  rtl.addIntf(this, $mod.IEagle);',
     '  rtl.addIntf(this, $mod.IDove);',
@@ -15111,7 +15241,6 @@ begin
     '  };',
     '});',
     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IBird);',
     '});',
     'this.IntfVar = null;',
@@ -15187,7 +15316,6 @@ begin
     '  };',
     '});',
     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IBird);',
     '});',
     'this.DoIt = function (u, i, j) {',
@@ -15340,7 +15468,6 @@ begin
     '  };',
     '  this.$final = function () {',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IUnknown);',
     '});',
     'this.i = null;',
@@ -15399,7 +15526,6 @@ begin
     '  };',
     '  this.$final = function () {',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IUnknown);',
     '});',
     'this.DoDefault = function (i, j) {',
@@ -15446,7 +15572,6 @@ begin
     '  };',
     '  this.$final = function () {',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IUnknown);',
     '});',
     'this.DoDefault = function (i) {',
@@ -15514,7 +15639,6 @@ begin
     '    var Result = null;',
     '    return Result;',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IUnknown);',
     '});',
     'rtl.createClass($mod, "TMouse", $mod.TObject, function () {',
@@ -15583,7 +15707,6 @@ begin
     '  };',
     '  this.$final = function () {',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IUnknown);',
     '});',
     'this.DoDefault = function (i, j, o) {',
@@ -15645,7 +15768,6 @@ begin
     '  };',
     '  this.$final = function () {',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IUnknown);',
     '});',
     'this.DoIt = function (v, j, k, l) {',
@@ -15757,7 +15879,6 @@ begin
     '  };',
     '  this.$final = function () {',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IUnknown);',
     '});',
     'this.DoIt = function (i) {',
@@ -15857,7 +15978,6 @@ begin
     '  };',
     '  this.$final = function () {',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IUnknown);',
     '});',
     'this.GetIt = function () {',
@@ -15947,7 +16067,6 @@ begin
     '  this.$final = function () {',
     '    this.FAnt = undefined;',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IUnknown);',
     '});',
     'this.DoIt = function () {',
@@ -16034,7 +16153,6 @@ begin
     '  };',
     '  this.$final = function () {',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IUnknown);',
     '});',
     'this.DoIt = function () {',
@@ -16113,7 +16231,6 @@ begin
     '  };',
     '});',
     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IBird);',
     '  rtl.addIntf(this, $mod.IEagle);',
     '  rtl.addIntf(this, $mod.IDove);',
@@ -16188,7 +16305,6 @@ begin
     '  };',
     '  this.$final = function () {',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $mod.IUnknown);',
     '});',
     'this.DoIt = function () {',
@@ -16349,7 +16465,6 @@ begin
     '    var Result = 0;',
     '    return Result;',
     '  };',
-    '  this.$intfmaps = {};',
     '  rtl.addIntf(this, $impl.IUnknown);',
     '});',
     '$impl.i = null;',
@@ -17919,6 +18034,7 @@ begin
   '  C: tclass;',
   '  a: tarrint;',
   '  p: Pointer = nil;',
+  '  s: string;',
   'begin',
   '  p:=p;',
   '  p:=nil;',
@@ -17935,6 +18051,8 @@ begin
   '  a:=TArrInt(p);',
   '  p:=n;',
   '  p:=Pointer(a);',
+  '  p:=pointer(s);',
+  '  s:=string(p);',
   '']);
   ConvertProgram;
   CheckSource('TestPointer',
@@ -17951,6 +18069,7 @@ begin
     'this.C = null;',
     'this.a = [];',
     'this.p = null;',
+    'this.s = "";',
     '']),
     LinesToStr([ // $mod.$main
     '$mod.p = $mod.p;',
@@ -17968,6 +18087,8 @@ begin
     '$mod.a = $mod.p;',
     '$mod.p = null;',
     '$mod.p = $mod.a;',
+    '$mod.p = $mod.s;',
+    '$mod.s = $mod.p;',
     '']));
 end;
 
@@ -19240,15 +19361,15 @@ begin
     LinesToStr([ // $mod.$main
     '$mod.DoIt($mod.d);',
     '$mod.DoIt($mod.dt);',
-    '$mod.DoIt($mod.i);',
-    '$mod.DoIt($mod.b);',
-    '$mod.DoIt($mod.shi);',
-    '$mod.DoIt($mod.w);',
-    '$mod.DoIt($mod.smi);',
-    '$mod.DoIt($mod.lw);',
-    '$mod.DoIt($mod.li);',
-    '$mod.DoIt($mod.ni);',
-    '$mod.DoIt($mod.nu);',
+    '$mod.DoIt$1($mod.i);',
+    '$mod.DoIt$1($mod.b);',
+    '$mod.DoIt$1($mod.shi);',
+    '$mod.DoIt$1($mod.w);',
+    '$mod.DoIt$1($mod.smi);',
+    '$mod.DoIt$1($mod.lw);',
+    '$mod.DoIt$1($mod.li);',
+    '$mod.DoIt$1($mod.ni);',
+    '$mod.DoIt$1($mod.nu);',
     '']));
 end;
 

packages/pastojs/tests/tcprecompile.pas

@@ -25,7 +25,7 @@ interface
 
 uses
   Classes, SysUtils,
-  fpcunit, testregistry, Pas2jsFileUtils, Pas2JsFiler,
+  fpcunit, testregistry, Pas2jsFileUtils, Pas2JsFiler, Pas2jsCompiler,
   tcunitsearch, tcmodules;
 
 type
@@ -42,6 +42,7 @@ type
       SharedParams: TStringList = nil;
       FirstRunParams: TStringList = nil;
       SecondRunParams: TStringList = nil; ExpExitCode: integer = 0);
+    function GetJSFilename(ModuleName: string): string; virtual;
   public
     constructor Create; override;
     property PCUFormat: TPas2JSPrecompileFormat read FPCUFormat write FPCUFormat;
@@ -62,6 +63,9 @@ type
     procedure TestPCU_ClassConstructor;
     procedure TestPCU_ClassInterface;
     procedure TestPCU_Namespace;
+    procedure TestPCU_CheckVersionMain;
+    procedure TestPCU_CheckVersionMain2;
+    procedure TestPCU_CheckVersionSystem;
   end;
 
 function LinesToList(const Lines: array of string): TStringList;
@@ -98,13 +102,15 @@ begin
     writeln('TTestCLI_Precompile.CheckPrecompile create pcu files=========================');
     {$ENDIF}
     Params.Clear;
+    Params.Add('-Jminclude');
+    Params.Add('-Jc');
     if SharedParams<>nil then
-      Params.Assign(SharedParams);
+      Params.AddStrings(SharedParams);
     if FirstRunParams<>nil then
       Params.AddStrings(FirstRunParams);
-    Compile([MainFile,'-Jc','-Fu'+UnitPaths,'-JU'+PCUFormat.Ext,'-FU'+UnitOutputDir]);
+    Compile([MainFile,'-Fu'+UnitPaths,'-JU'+PCUFormat.Ext,'-FU'+UnitOutputDir]);
     AssertFileExists(UnitOutputDir+'/system.'+PCUFormat.Ext);
-    JSFilename:=UnitOutputDir+PathDelim+ExtractFilenameOnly(MainFile)+'.js';
+    JSFilename:=GetJSFilename(MainFile);
     AssertFileExists(JSFilename);
     JSFile:=FindFile(JSFilename);
     OrigSrc:=JSFile.Source;
@@ -115,19 +121,21 @@ begin
     JSFile.Source:='';
     Compiler.Reset;
     Params.Clear;
+    Params.Add('-Jminclude');
+    Params.Add('-Jc');
     if SharedParams<>nil then
-      Params.Assign(SharedParams);
+      Params.AddStrings(SharedParams);
     if SecondRunParams<>nil then
       Params.AddStrings(SecondRunParams);
-    Compile([MainFile,'-Jc','-FU'+UnitOutputDir],ExpExitCode);
+    Compile([MainFile,'-FU'+UnitOutputDir],ExpExitCode);
     if ExpExitCode=0 then
       begin
       NewSrc:=JSFile.Source;
       if not CheckSrcDiff(OrigSrc,NewSrc,s) then
-      begin
+        begin
         WriteSources;
         Fail('test1.js: '+s);
-      end;
+        end;
       end;
   finally
     SharedParams.Free;
@@ -136,6 +144,11 @@ begin
   end;
 end;
 
+function TCustomTestCLI_Precompile.GetJSFilename(ModuleName: string): string;
+begin
+  Result:=UnitOutputDir+PathDelim+ExtractFilenameOnly(ModuleName)+'.js';
+end;
+
 constructor TCustomTestCLI_Precompile.Create;
 begin
   inherited Create;
@@ -461,6 +474,89 @@ begin
   AssertFileExists(UnitOutputDir+'/Web.Unit1.'+PCUFormat.Ext);
 end;
 
+procedure TTestCLI_Precompile.TestPCU_CheckVersionMain;
+var
+  aFile: TCLIFile;
+  s, JSFilename, ExpectedSrc: string;
+begin
+  AddUnit('src/system.pp',[
+    'type integer = longint;'],
+    ['']);
+  AddFile('test1.pas',[
+    'begin',
+    'end.']);
+  CheckPrecompile('test1.pas','src',LinesToList(['-JoCheckVersion=Main','-Jm-','-Jc-']));
+  JSFilename:=GetJSFilename('test1.js');
+  aFile:=FindFile(JSFilename);
+  AssertNotNull('File not found '+JSFilename,aFile);
+  ExpectedSrc:=LinesToStr([
+    UTF8BOM+'rtl.module("program",["system"],function () {',
+    '  "use strict";',
+    '  var $mod = this;',
+    '  $mod.$main = function () {',
+    '    rtl.checkVersion('+IntToStr((VersionMajor*100+VersionMinor)*100+VersionRelease)+');',
+    '  };',
+    '});']);
+  if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then
+    Fail('TTestCLI_Precompile.TestPCU_CheckVersionMain src diff: '+s);
+end;
+
+procedure TTestCLI_Precompile.TestPCU_CheckVersionMain2;
+var
+  aFile: TCLIFile;
+  s, JSFilename, ExpectedSrc: string;
+begin
+  AddUnit('src/system.pp',[
+    'type integer = longint;',
+    'procedure Writeln; varargs;'],
+    ['procedure Writeln; begin end;']);
+  AddFile('test1.pas',[
+    'begin',
+    '  Writeln;',
+    'end.']);
+  CheckPrecompile('test1.pas','src',LinesToList(['-JoCheckVersion=Main','-Jm-','-Jc-']));
+  JSFilename:=GetJSFilename('test1.js');
+  aFile:=FindFile(JSFilename);
+  AssertNotNull('File not found '+JSFilename,aFile);
+  ExpectedSrc:=LinesToStr([
+    UTF8BOM+'rtl.module("program",["system"],function () {',
+    '  "use strict";',
+    '  var $mod = this;',
+    '  $mod.$main = function () {',
+    '    rtl.checkVersion('+IntToStr((VersionMajor*100+VersionMinor)*100+VersionRelease)+');',
+    '    pas.system.Writeln();',
+    '  };',
+    '});']);
+  if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then
+    Fail('TTestCLI_Precompile.TestPCU_CheckVersionMain src diff: '+s);
+end;
+
+procedure TTestCLI_Precompile.TestPCU_CheckVersionSystem;
+var
+  aFile: TCLIFile;
+  s, JSFilename, ExpectedSrc: string;
+begin
+  AddUnit('src/system.pp',[
+    'type integer = longint;'],
+    ['']);
+  AddFile('test1.pas',[
+    'begin',
+    'end.']);
+  CheckPrecompile('test1.pas','src',LinesToList(['-JoCheckVersion=system','-Jm-','-Jc-']));
+  JSFilename:=GetJSFilename('system.js');
+  aFile:=FindFile(JSFilename);
+  AssertNotNull('File not found '+JSFilename,aFile);
+  writeln('TTestCLI_Precompile.TestPCU_CheckVersionMain ',aFile.Source);
+  ExpectedSrc:=LinesToStr([
+    UTF8BOM+'rtl.module("system",[],function () {',
+    '  "use strict";',
+    '  rtl.checkVersion(10101);',
+    '  var $mod = this;',
+    '});']);
+  if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then
+    Fail('TTestCLI_Precompile.TestPCU_CheckVersionMain src diff: '+s);
+end;
+
 Initialization
   {$IFDEF EnablePas2jsPrecompiled}
   RegisterTests([TTestCLI_Precompile]);

packages/pastojs/tests/tcsrcmap.pas

@@ -92,7 +92,7 @@ function TCustomTestSrcMap.ConvertJSModuleToString(El: TJSElement): string;
 begin
   writeln('TCustomTestSrcMap.JSToStr ',GetObjName(El));
   JS_Writer.WriteJS(El);
-  Result:=Pas2JSMapper.AsAnsistring;
+  Result:=Pas2JSMapper.AsString;
 end;
 
 procedure TCustomTestSrcMap.CheckSrcMap(const aTitle: string;

utils/pas2js/dist/rtl.js

@@ -2,6 +2,8 @@
 
 var rtl = {
 
+  version: 10101,
+
   quiet: false,
   debug_load_units: false,
   debug_rtti: false,
@@ -20,6 +22,10 @@ var rtl = {
     rtl.debug('Warn: ',s);
   },
 
+  checkVersion: function(v){
+    if (rtl.version != v) throw "expected rtl version "+v+", but found "+rtl.version;
+  },
+
   hasString: function(s){
     return rtl.isString(s) && (s.length>0);
   },
@@ -229,6 +235,7 @@ var rtl = {
 
   initClass: function(c,parent,name,initfn){
     parent[name] = c;
+    c.$class = c; // Note: o.$class === Object.getPrototypeOf(o)
     c.$classname = name;
     if ((parent.$module) && (parent.$module.$impl===parent)) parent=parent.$module;
     c.$parent = parent;
@@ -266,21 +273,22 @@ var rtl = {
       c.$create = function(fnname,args){
         if (args == undefined) args = [];
         var o = Object.create(this);
-        o.$class = this; // Note: o.$class === Object.getPrototypeOf(o)
         o.$init();
         try{
           o[fnname].apply(o,args);
           o.AfterConstruction();
         } catch($e){
-          o.$destroy;
+          // do not call BeforeDestruction
+          if (this.Destroy) this.Destroy();
+          this.$final();
           throw $e;
         }
         return o;
       };
       c.$destroy = function(fnname){
         this.BeforeDestruction();
-        this[fnname]();
-        this.$final;
+        if (this[fnname]) this[fnname]();
+        this.$final();
       };
     };
     rtl.initClass(c,parent,name,initfn);
@@ -300,21 +308,22 @@ var rtl = {
       } else {
         o = Object.create(this);
       }
-      o.$class = this; // Note: o.$class === Object.getPrototypeOf(o)
-      o.$init();
+      if (o.$init) o.$init();
       try{
         o[fnname].apply(o,args);
         if (o.AfterConstruction) o.AfterConstruction();
       } catch($e){
-        o.$destroy;
+        // do not call BeforeDestruction
+        if (this.Destroy) this.Destroy();
+        if (this.$final) this.$final();
         throw $e;
       }
       return o;
     };
     c.$destroy = function(fnname){
       if (this.BeforeDestruction) this.BeforeDestruction();
-      this[fnname]();
-      this.$final;
+      if (this[fnname]) this[fnname]();
+      if (this.$final) this.$final();
     };
     rtl.initClass(c,parent,name,initfn);
   },
@@ -482,6 +491,7 @@ var rtl = {
     if(!map) map = {};
     var t = intf;
     var item = Object.create(t);
+    if (!aclass.hasOwnProperty('$intfmaps')) aclass.$intfmaps = {};
     aclass.$intfmaps[intf.$guid] = item;
     do{
       var names = t.$names;

utils/pas2js/docs/translation.html

@@ -2796,6 +2796,17 @@ End.
     <li>{$modeswitch arrayoperators}: allow + operator to concatenate arrays, default in mode delphi</li>
     <li>{$macro on|off} enables macro replacements. Only macros with a value are replaced. Macros are never replaced inside directives.</li>
     <li>{$I filename} or {$include filename} - insert include file</li>
+    <li>{$I %param%}:
+      <ul>
+        <li>%date%: current date as string literal, '[yyyy/mm/dd]'</li>
+        <li>%time%: current time as string literal, 'hh:mm:ss'</li>
+        <li>%line%: current source line number as string literal, e.g. '123'</li>
+        <li>%currentroutine%: name of current routine as string literal</li>
+        <li>%pas2jstarget%, %pas2jstargetos%, %fpctarget%, %fpctargetos%: target os as string literal, e.g. 'Browser'</li>
+        <li>%pas2jstargetcpu%, %fpctargetcpu%: target cpu as string literal, e.g. 'ECMAScript5'</li>
+        <li>%pas2jsversion%, %fpcversion%: compiler version as strnig literal, e.g. '1.0.2'</li>
+      </ul>
+    </li>
     <li>{$Warnings on|off}</li>
     <li>{$Notes on|off}</li>
     <li>{$Hints on|off}</li>
@@ -2843,8 +2854,8 @@ End.
     <ul>
     <li>PASJS</li>
     <li>PAS2JS_FULLVERSION - major*1000+minor*100+release, e.g. 1.2.3 = 10203</li>
-    <li>Target platform: BROWSER, NODEJS</li>
-    <li>Target processor: ECMAScript5, ECMAScript6, ECMAScript=5</li>
+    <li>Target platform: Browser, NodeJS, Pas2JSTargetOS=&lt;value&gt;</li>
+    <li>Target processor: ECMAScript5, ECMAScript6, ECMAScript=5, Pas2JSTargetCPU=&lt;value&gt;</li>
     <li>Mode: DELPHI, OBJFPC</li>
     </ul>
     </div>

utils/pas2js/nodepas2js.lpi

@@ -0,0 +1,90 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <Runnable Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="nodepas2js"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="nodepas2js.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="nodepas2js.js" ApplyConventions="False"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir);../../packages/pastojs/src"/>
+      <OtherUnitFiles Value="../../packages/fcl-js/src;../../packages/fcl-json/src;../../packages/fcl-passrc/src;../../packages/pastojs/src"/>
+      <UnitOutputDirectory Value="js"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <AllowLabel Value="False"/>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <TargetOS Value="nodejs"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="False"/>
+        <UseLineInfoUnit Value="False"/>
+      </Debugging>
+    </Linking>
+    <Other>
+      <CustomOptions Value="-Jeutf-8
+-Jc
+-dVerboseFileCache
+-dVerbosePasResolver
+-dVerbosePas2JS
+-dVerbosePasResEval"/>
+      <OtherDefines Count="4">
+        <Define0 Value="VerboseFileCache"/>
+        <Define1 Value="VerbosePasResolver"/>
+        <Define2 Value="VerbosePas2JS"/>
+        <Define3 Value="VerbosePasResEval"/>
+      </OtherDefines>
+      <CompilerPath Value="$(pas2js)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

utils/pas2js/nodepas2js.pp

@@ -0,0 +1,83 @@
+program nodepas2js;
+
+{$mode objfpc}
+{$I pas2js_defines.inc}
+
+uses
+  JS, NodeJSApp,
+  Classes, SysUtils,
+  Pas2jsFileUtils, Pas2jsLogger, Pas2jsCompiler;
+
+type
+
+  { TPas2jsCLI }
+
+  TPas2jsCLI = class(TNodeJSApplication)
+  private
+    FCompiler: TPas2jsCompiler;
+  protected
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    property Compiler: TPas2jsCompiler read FCompiler;
+  end;
+
+procedure TPas2jsCLI.DoRun;
+var
+  ParamList: TStringList;
+  i: Integer;
+begin
+  ParamList:=TStringList.Create;
+  try
+    for i:=1 to ParamCount do
+      ParamList.Add(Params[i]);
+    try
+      Compiler.Run(ParamStr(0),GetCurrentDirPJ,ParamList);
+    except
+      on E: ECompilerTerminate do ;
+      on E: Exception do
+      begin
+        {AllowWriteln}
+        writeln(E.Message);
+        {AllowWriteln-}
+        if ExitCode=0 then
+          ExitCode:=ExitCodeErrorInternal;
+      end
+      else begin
+        {AllowWriteln}
+        writeln('ERROR value: ',JSExceptValue);
+        {AllowWriteln-}
+        if ExitCode=0 then
+          ExitCode:=ExitCodeErrorInternal;
+      end;
+    end;
+  finally
+    ParamList.Free;
+    Compiler.Log.CloseOutputFile;
+  end;
+
+  // stop program loop
+  Terminate; // Keep ExitCode!
+end;
+
+constructor TPas2jsCLI.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+  FCompiler:=TPas2jsCompiler.Create;
+end;
+
+destructor TPas2jsCLI.Destroy;
+begin
+  FreeAndNil(FCompiler);
+  inherited Destroy;
+end;
+
+var
+  Application: TPas2jsCLI;
+begin
+  Application:=TPas2jsCLI.Create(nil);
+  Application.Run;
+  Application.Free;
+end.

utils/pas2js/pas2js.pp

@@ -41,7 +41,7 @@ begin
     for i:=1 to ParamCount do
       ParamList.Add(Params[i]);
     try
-      Compiler.Run(ParamStr(0),GetCurrentDirUTF8,ParamList);
+      Compiler.Run(ParamStr(0),GetCurrentDirPJ,ParamList);
     except
       on E: ECompilerTerminate do ;
       on E: Exception do