* synchronised with trunk till r40776

git-svn-id: branches/debug_eh@41867 -

.gitattributes

@@ -2738,7 +2738,11 @@ packages/fcl-registry/Makefile svneol=native#text/plain
 packages/fcl-registry/Makefile.fpc svneol=native#text/plain
 packages/fcl-registry/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/fcl-registry/examples/remotereg.pp svneol=native#text/pascal
+packages/fcl-registry/examples/testunicode.lpi svneol=native#text/plain
 packages/fcl-registry/examples/testunicode.pp svneol=native#text/plain
+packages/fcl-registry/examples/testunicode2.lpi svneol=native#text/plain
+packages/fcl-registry/examples/testunicode2.pas svneol=native#text/plain
+packages/fcl-registry/examples/testunicode2.pp svneol=native#text/plain
 packages/fcl-registry/fpmake.pp svneol=native#text/plain
 packages/fcl-registry/src/regdef.inc svneol=native#text/plain
 packages/fcl-registry/src/regini.inc svneol=native#text/plain
@@ -10255,11 +10259,11 @@ rtl/openbsd/errno.inc svneol=native#text/plain
 rtl/openbsd/errnostr.inc svneol=native#text/plain
 rtl/openbsd/i386/bsyscall.inc svneol=native#text/plain
 rtl/openbsd/i386/cprt0.as svneol=native#text/plain
-rtl/openbsd/i386/dllprt0.as svneol=native#text/plain
 rtl/openbsd/i386/openbsd_ident.inc svneol=native#text/plain
 rtl/openbsd/i386/prt0.as svneol=native#text/plain
 rtl/openbsd/i386/si_c.inc svneol=native#text/plain
 rtl/openbsd/i386/si_dll.inc svneol=native#text/plain
+rtl/openbsd/i386/si_g.inc svneol=native#text/plain
 rtl/openbsd/i386/si_prc.inc svneol=native#text/plain
 rtl/openbsd/i386/sighnd.inc svneol=native#text/plain
 rtl/openbsd/osdefs.inc svneol=native#text/plain
@@ -10270,6 +10274,7 @@ rtl/openbsd/rtldefs.inc svneol=native#text/plain
 rtl/openbsd/setsysnr.inc svneol=native#text/plain
 rtl/openbsd/si_c.pp svneol=native#text/plain
 rtl/openbsd/si_dll.pp svneol=native#text/plain
+rtl/openbsd/si_g.pp svneol=native#text/plain
 rtl/openbsd/si_impl.inc svneol=native#text/plain
 rtl/openbsd/si_intf.inc svneol=native#text/plain
 rtl/openbsd/si_prc.pp svneol=native#text/plain
@@ -10289,13 +10294,11 @@ rtl/openbsd/unxfunc.inc svneol=native#text/plain
 rtl/openbsd/unxsysc.inc svneol=native#text/plain
 rtl/openbsd/x86_64/bsyscall.inc svneol=native#text/plain
 rtl/openbsd/x86_64/cprt0.as svneol=native#text/plain
-rtl/openbsd/x86_64/crt0.s svneol=native#text/plain
-rtl/openbsd/x86_64/dllprt0.as svneol=native#text/plain
-rtl/openbsd/x86_64/gprt0.as svneol=native#text/plain
 rtl/openbsd/x86_64/openbsd_ident.inc svneol=native#text/plain
 rtl/openbsd/x86_64/prt0.as svneol=native#text/plain
 rtl/openbsd/x86_64/si_c.inc svneol=native#text/plain
 rtl/openbsd/x86_64/si_dll.inc svneol=native#text/plain
+rtl/openbsd/x86_64/si_g.inc svneol=native#text/plain
 rtl/openbsd/x86_64/si_prc.inc svneol=native#text/plain
 rtl/openbsd/x86_64/sighnd.inc svneol=native#text/plain
 rtl/os2/Makefile svneol=native#text/plain
@@ -11828,6 +11831,7 @@ tests/tbs/tb0652.pp svneol=native#text/pascal
 tests/tbs/tb0653.pp svneol=native#text/plain
 tests/tbs/tb0654.pp svneol=native#text/plain
 tests/tbs/tb0655.pp svneol=native#text/pascal
+tests/tbs/tb0656.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain
@@ -12830,7 +12834,10 @@ tests/test/tarray14.pp svneol=native#text/pascal
 tests/test/tarray15.pp svneol=native#text/pascal
 tests/test/tarray16.pp svneol=native#text/pascal
 tests/test/tarray17.pp svneol=native#text/pascal
+tests/test/tarray18.pp svneol=native#text/pascal
+tests/test/tarray19.pp svneol=native#text/pascal
 tests/test/tarray2.pp svneol=native#text/plain
+tests/test/tarray20.pp svneol=native#text/pascal
 tests/test/tarray3.pp svneol=native#text/plain
 tests/test/tarray4.pp svneol=native#text/plain
 tests/test/tarray5.pp svneol=native#text/plain
@@ -13973,6 +13980,7 @@ tests/test/trtti16.pp svneol=native#text/pascal
 tests/test/trtti17.pp svneol=native#text/pascal
 tests/test/trtti18a.pp svneol=native#text/pascal
 tests/test/trtti18b.pp svneol=native#text/pascal
+tests/test/trtti19.pp svneol=native#text/pascal
 tests/test/trtti2.pp svneol=native#text/plain
 tests/test/trtti3.pp svneol=native#text/plain
 tests/test/trtti4.pp svneol=native#text/plain
@@ -17471,6 +17479,7 @@ utils/h2pas/converu.pas svneol=native#text/plain
 utils/h2pas/fpmake.pp svneol=native#text/plain
 utils/h2pas/h2pas.pas svneol=native#text/plain
 utils/h2pas/h2pas.y svneol=native#text/plain
+utils/h2pas/h2paschk.pas svneol=native#text/plain
 utils/h2pas/h2paspp.pas svneol=native#text/plain
 utils/h2pas/h2plexlib.pas svneol=native#text/plain
 utils/h2pas/h2poptions.pas svneol=native#text/plain

compiler/Makefile

@@ -4250,6 +4250,88 @@ INSTALLEXEFILE=$(PPCROSSNAME)
 else
 INSTALLEXEFILE=$(EXENAME)
 endif
+ifdef DEBUG_CYCLE
+DEBUG_EXENAME=1
+DEBUG_PPEXENAME=1
+DEBUG_TEMPNAME=1
+DEBUG_PPCROSSNAME=1
+DEBUG_TEMPNAME1=1
+DEBUG_TEMPNAME2=1
+DEBUG_TEMPNAME3=1
+DEBUG_TEMPWPONAME1=1
+DEBUG_TEMPWPONAME2=1
+endif
+ifdef DEBUG_EXENAME
+EXENAMEPREFIX=g
+NEED_G_COMPILERS+=g$(EXENAME)
+endif
+ifdef DEBUG_PPEXENAME
+PPEXENAMEPREFIX=g
+NEED_G_COMPILERS+=g$(PPEXENAME)
+endif
+ifdef DEBUG_TEMPNAME
+TEMPNAMEPREFIX=g
+NEED_G_COMPILERS+=g$(TEMPNAME)
+endif
+ifdef DEBUG_PPCROSSNAME
+PPCROSSNAMEPREFIX=g
+NEED_G_COMPILERS+=g$(PPCROSSNAME)
+endif
+ifdef DEBUG_TEMPNAME1
+TEMPNAME1PREFIX=g
+NEED_G_COMPILERS+=g$(TEMPNAME1)
+endif
+ifdef DEBUG_TEMPNAME2
+TEMPNAME2PREFIX=g
+NEED_G_COMPILERS+=g$(TEMPNAME2)
+endif
+ifdef DEBUG_TEMPNAME3
+TEMPNAME3PREFIX=g
+NEED_G_COMPILERS+=g$(TEMPNAME3)
+endif
+ifdef DEBUG_TEMPWPONAME1
+TEMPNAMEWPO1PREFIX=g
+NEED_G_COMPILERS+=g$(TEMPWPONAME1)
+endif
+ifdef DEBUG_TEMPWPONAME2
+TEMPWPONAME2PREFIX=g
+NEED_G_COMPILERS+=g$(TEMPWPONAME2)
+endif
+ALL_G_COMPILERS="g$(EXENAME) g$(PPEXENAME) g$(TEMPNAME) g$(PPCROSSNAME) g$(TEMPNAME1) g$(TEMPNAME2) g$(TEMPNAME3) g$(TEMPWPONAME1) g$(TEMPWPONAME2)"
+g$(COMPILERTEMPNAME): fpcmade.generate_g_compilers
+	$(COPY) ./utils/gppc386 ./g$(COMPILERTEMPNAME)
+fpcmade.generate_g_compilers: utils/gppc386.pp
+	$(MAKE) rtlclean rtl utils
+	$(MAKE) -C utils gppc386$(EXEEXT)
+	$(GECHO) -n "utils/gppc386 generated at " > $@
+	$(GDATE) >> $@
+ifdef EXENAMEPREFIX
+	$(MAKE) g$(EXENAME) COMPILERTEMPNAME=$(EXENAME)
+endif
+ifdef PPEXENAMEPREFIX
+	$(MAKE) g$(PPEXENAME) COMPILERTEMPNAME=$(PPEXENAME)
+endif
+ifdef TEMPNAMEPREFIX
+	$(MAKE) g$(TEMPNAME) COMPILERTEMPNAME=$(TEMPNAME)
+endif
+ifdef PPCROSSNAMEPREFIX
+	$(MAKE) g$(PPCROSSNAME) COMPILERTEMPNAME=$(PPCROSSNAME)
+endif
+ifdef TEMPNAME1PREFIX
+	$(MAKE) g$(TEMPNAME1) COMPILERTEMPNAME=$(TEMPNAME1)
+endif
+ifdef TEMPNAME2PREFIX
+	$(MAKE) g$(TEMPNAME2) COMPILERTEMPNAME=$(TEMPNAME2)
+endif
+ifdef TEMPNAME3PREFIX
+	$(MAKE) g$(TEMPNAME3) COMPILERTEMPNAME=$(TEMPNAME3)
+endif
+ifdef TEMPWPONAME1PREFIX
+	$(MAKE) g$(TEMPWPONAME1) COMPILERTEMPNAME=$(TEMPWPONAME1)
+endif
+ifdef TEMPWPONAME2PREFIX
+	$(MAKE) g$(TEMPWPONAME2) COMPILERTEMPNAME=$(TEMPWPONAME2)
+endif
 PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 mips mipsel avr jvm i8086 aarch64 sparc64 riscv32 riscv64
 PPC_SUFFIXES=386 68k ppc sparc arm armeb x64 ppc64 mips mipsel avr jvm 8086 a64 sparc64 rv32 rv64
 INSTALL_TARGETS=$(addsuffix _exe_install,$(sort $(CYCLETARGETS) $(PPC_TARGETS)))
@@ -4292,7 +4374,8 @@ tempclean:
 execlean :
 	-$(DEL) $(addsuffix $(EXEEXT), $(addprefix ppc, $(PPC_SUFFIXES)))
 	-$(DEL) $(addsuffix $(EXEEXT), $(addprefix ppcross, $(PPC_SUFFIXES)))
-	-$(DEL) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2)
+	-$(DEL) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2) $(ALL_G_COMPILERS)
+	-$(DEL) fpcmade.generate_g_compilers
 $(addsuffix _clean,$(ALLTARGETS)):
 	-$(DELTREE) $(addprefix $(subst _clean,,$@),/units)
 	-$(DELTREE) $(addprefix $(subst _clean,,$@),/bin)
@@ -4392,23 +4475,24 @@ ifeq ($(OS_SOURCE),$(OS_TARGET))
 ifndef NOWPOCYCLE
 ifdef RELEASE
 DOWPOCYCLE=1
+endif
+endif
+ifdef DOWPOCYCLE
 wpocycle:
 	$(RM) $(EXENAME)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTWPOCOLLECT) $(OPTNEW))' compiler
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3PREFIX)$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTWPOCOLLECT) $(OPTNEW))' compiler
 	$(RM) $(EXENAME)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(RTLOPT) $(OPTWPOPERFORM) $(OPTNEW))' rtlclean
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(RTLOPT) $(OPTWPOPERFORM) $(OPTNEW))' rtl
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(OPTWPOPERFORM) $(subst pp1.wpo,pp2.wpo,$(OPTWPOCOLLECT)))' $(addsuffix _clean,$(ALLTARGETS)) 
-		$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(OPTWPOPERFORM) $(subst pp1.wpo,pp2.wpo,$(OPTWPOCOLLECT)))' compiler
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3PREFIX)$(TEMPNAME3)' 'OPT=$(strip $(RTLOPT) $(OPTWPOPERFORM) $(OPTNEW))' rtlclean
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3PREFIX)$(TEMPNAME3)' 'OPT=$(strip $(RTLOPT) $(OPTWPOPERFORM) $(OPTNEW))' rtl
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3PREFIX)$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(OPTWPOPERFORM) $(subst pp1.wpo,pp2.wpo,$(OPTWPOCOLLECT)))' $(addsuffix _clean,$(ALLTARGETS)) 
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3PREFIX)$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(OPTWPOPERFORM) $(subst pp1.wpo,pp2.wpo,$(OPTWPOCOLLECT)))' compiler
 	$(MOVE) $(EXENAME) $(TEMPWPONAME1)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(strip $(RTLOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' rtlclean
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(strip $(RTLOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' rtl
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' $(addsuffix _clean,$(ALLTARGETS))
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' compiler
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1PREFIX)$(TEMPWPONAME1)' 'OPT=$(strip $(RTLOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' rtlclean
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1PREFIX)$(TEMPWPONAME1)' 'OPT=$(strip $(RTLOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' rtl
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1PREFIX)$(TEMPWPONAME1)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' $(addsuffix _clean,$(ALLTARGETS))
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1PREFIX)$(TEMPWPONAME1)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' compiler
 	$(COPY) $(EXENAME) $(TEMPWPONAME2)
-endif
-endif
-ifndef DOWPOCYCLE
+else
 wpocycle:
 endif
 ifdef DIFF
@@ -4441,57 +4525,66 @@ $(TEMPNAME1) :
 	-$(DEL) $(TEMPNAME1)
 	$(MOVE) $(EXENAME) $(TEMPNAME1)
 $(TEMPNAME2) : $(TEMPNAME1)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME1)' 'OLDFPC=' next CYCLELEVEL=2
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME1PREFIX)$(TEMPNAME1)' 'OLDFPC=' next CYCLELEVEL=2
 	-$(DEL) $(TEMPNAME2)
 	$(MOVE) $(EXENAME) $(TEMPNAME2)
 $(TEMPNAME3) : $(TEMPNAME2)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME2)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME1)' next CYCLELEVEL=3
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME2PREFIX)$(TEMPNAME2)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME1)' next CYCLELEVEL=3
 	-$(DEL) $(TEMPNAME3)
 	$(MOVE) $(EXENAME) $(TEMPNAME3)
 cycle:
+ifdef NEED_G_COMPILERS
+	$(MAKE) fpcmade.generate_g_compilers
+endif
 	$(MAKE) tempclean
 	$(MAKE) $(TEMPNAME3)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME2)' next CYCLELEVEL=4
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3PREFIX)$(TEMPNAME3)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME2)' next CYCLELEVEL=4
 	$(DIFF) $(TEMPNAME3) $(EXENAME)
-	$(MAKE) $(addsuffix _all,$(TARGET_DIRS)) 'FPC=$(BASEDIR)/$(EXENAME)'
+	$(MAKE) $(addsuffix _all,$(TARGET_DIRS)) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
 	$(MAKE) wpocycle
 	$(MAKE) echotime
 else
 cycle:
+ifdef NEED_G_COMPILERS
+	$(MAKE) fpcmade.generate_g_compilers
+endif
 	$(MAKE) OS_TARGET=$(OS_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=1 rtlclean
 	$(MAKE) OS_TARGET=$(OS_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=1 rtl
 	$(MAKE) OS_TARGET=$(OS_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=1 cycleclean
 	$(MAKE) OS_TARGET=$(OS_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=1 compiler
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtlclean
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtl
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 cycleclean
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 compiler
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtlclean
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtl
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 cycleclean
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 compiler
 ifndef CROSSINSTALL
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' CYCLELEVEL=3 rtlclean
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' CYCLELEVEL=3 rtl
+	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' CYCLELEVEL=3 rtlclean
+	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' CYCLELEVEL=3 rtl
 ifndef NoNativeBinaries
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' CYCLELEVEL=3 cycleclean
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' CYCLELEVEL=3 compiler
+	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' CYCLELEVEL=3 cycleclean
+	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' CYCLELEVEL=3 compiler
 endif
 endif
 endif
 else
 cycle: override FPC=
 cycle:
+ifdef NEED_G_COMPILERS
+	$(MAKE) fpcmade.generate_g_compilers
+endif
 	$(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=1 rtlclean
 	$(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=1 rtl
 	$(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=1 cycleclean 
 	$(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=1 compiler 
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtlclean 
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtl 
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) PPC_TARGET=$(CPU_TARGET) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 cycleclean 
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) PPC_TARGET=$(CPU_TARGET) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 compiler 
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtlclean 
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtl 
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) PPC_TARGET=$(CPU_TARGET) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 cycleclean 
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) PPC_TARGET=$(CPU_TARGET) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 compiler 
 ifndef CROSSINSTALL
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(RTLOPT) $(CROSSOPT)' CYCLELEVEL=3 rtlclean
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(RTLOPT) $(CROSSOPT)' CYCLELEVEL=3 rtl
+	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' 'OPT=$(RTLOPT) $(CROSSOPT)' CYCLELEVEL=3 rtlclean
+	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' 'OPT=$(RTLOPT) $(CROSSOPT)' CYCLELEVEL=3 rtl
 ifndef NoNativeBinaries
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(strip $(LOCALOPT) $(CROSSOPT))' CYCLELEVEL=3 cycleclean
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(strip $(LOCALOPT) $(CROSSOPT))' CYCLELEVEL=3 compiler
+	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' 'OPT=$(strip $(LOCALOPT) $(CROSSOPT))' CYCLELEVEL=3 cycleclean
+	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' 'OPT=$(strip $(LOCALOPT) $(CROSSOPT))' CYCLELEVEL=3 compiler
 endif
 endif
 endif
@@ -4514,12 +4607,12 @@ fullcycle:
 	$(MAKE) ppuclean
 ifdef DOWPOCYCLE
 	$(MAKE) rtlclean
-	$(MAKE) rtl 'FPC=$(BASEDIR)/$(EXENAME)'
+	$(MAKE) rtl 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
 endif
 ifndef EXCLUDE_80BIT_TARGETS
-	$(MAKE) $(filter-out $(PPC_TARGET),$(CYCLETARGETS)) 'FPC=$(BASEDIR)/$(EXENAME)'
+	$(MAKE) $(filter-out $(PPC_TARGET),$(CYCLETARGETS)) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
 else
-	$(MAKE) $(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))) 'FPC=$(BASEDIR)/$(EXENAME)'
+	$(MAKE) $(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
 endif
 htmldocs:
 	$(PASDOC) -p -h -o html$(PATHSEP)$(PPC_TARGET) -d fpc -d gdb -d $(PPC_TARGET) -u $(PPC_TARGET) $(PPC_TARGET)$(PATHSEP)*.pas systems$(PATHSEP)*.pas *.pas

compiler/Makefile.fpc

@@ -461,7 +461,120 @@ INSTALLEXEFILE=$(EXENAME)
 endif
 
 #####################################################################
-# CPU targets
+# Rules to run the compiler trough GDB using utils/gppc386.pp code
+# inside specific levels of cycle.
+# Simply compile utils and utils/gppc386
+# And move generated utils/gppc386 to ./g$(TEMPNAME)
+#####################################################################
+
+# Use debugger for all compilations
+ifdef DEBUG_CYCLE
+DEBUG_EXENAME=1
+DEBUG_PPEXENAME=1
+DEBUG_TEMPNAME=1
+DEBUG_PPCROSSNAME=1
+DEBUG_TEMPNAME1=1
+DEBUG_TEMPNAME2=1
+DEBUG_TEMPNAME3=1
+DEBUG_TEMPWPONAME1=1
+DEBUG_TEMPWPONAME2=1
+endif
+
+# Or DEBUG_XXX to only start a specific compiler
+# inside GDB
+ifdef DEBUG_EXENAME
+EXENAMEPREFIX=g
+NEED_G_COMPILERS+=g$(EXENAME)
+endif
+
+ifdef DEBUG_PPEXENAME
+PPEXENAMEPREFIX=g
+NEED_G_COMPILERS+=g$(PPEXENAME)
+endif
+
+ifdef DEBUG_TEMPNAME
+TEMPNAMEPREFIX=g
+NEED_G_COMPILERS+=g$(TEMPNAME)
+endif
+
+ifdef DEBUG_PPCROSSNAME
+PPCROSSNAMEPREFIX=g
+NEED_G_COMPILERS+=g$(PPCROSSNAME)
+endif
+
+ifdef DEBUG_TEMPNAME1
+TEMPNAME1PREFIX=g
+NEED_G_COMPILERS+=g$(TEMPNAME1)
+endif
+
+ifdef DEBUG_TEMPNAME2
+TEMPNAME2PREFIX=g
+NEED_G_COMPILERS+=g$(TEMPNAME2)
+endif
+
+ifdef DEBUG_TEMPNAME3
+TEMPNAME3PREFIX=g
+NEED_G_COMPILERS+=g$(TEMPNAME3)
+endif
+
+ifdef DEBUG_TEMPWPONAME1
+TEMPNAMEWPO1PREFIX=g
+NEED_G_COMPILERS+=g$(TEMPWPONAME1)
+endif
+
+ifdef DEBUG_TEMPWPONAME2
+TEMPWPONAME2PREFIX=g
+NEED_G_COMPILERS+=g$(TEMPWPONAME2)
+endif
+
+ALL_G_COMPILERS="g$(EXENAME) g$(PPEXENAME) g$(TEMPNAME) g$(PPCROSSNAME) g$(TEMPNAME1) g$(TEMPNAME2) g$(TEMPNAME3) g$(TEMPWPONAME1) g$(TEMPWPONAME2)"
+
+#####################################################################
+# To start a given compiler $(PP) with gdb, copy utils/gppc386 as g$(PP).
+# Symbolic link is not working, full copy required.
+# Use a file as time stamp to avoid recompiling utils/gppc386
+# unless needed.
+#####################################################################
+g$(COMPILERTEMPNAME): fpcmade.generate_g_compilers
+	$(COPY) ./utils/gppc386 ./g$(COMPILERTEMPNAME)
+
+fpcmade.generate_g_compilers: utils/gppc386.pp
+	$(MAKE) rtlclean rtl utils
+	$(MAKE) -C utils gppc386$(EXEEXT)
+	$(GECHO) -n "utils/gppc386 generated at " > $@
+	$(GDATE) >> $@
+
+ifdef EXENAMEPREFIX
+	$(MAKE) g$(EXENAME) COMPILERTEMPNAME=$(EXENAME)
+endif
+ifdef PPEXENAMEPREFIX
+	$(MAKE) g$(PPEXENAME) COMPILERTEMPNAME=$(PPEXENAME)
+endif
+ifdef TEMPNAMEPREFIX
+	$(MAKE) g$(TEMPNAME) COMPILERTEMPNAME=$(TEMPNAME)
+endif
+ifdef PPCROSSNAMEPREFIX
+	$(MAKE) g$(PPCROSSNAME) COMPILERTEMPNAME=$(PPCROSSNAME)
+endif
+ifdef TEMPNAME1PREFIX
+	$(MAKE) g$(TEMPNAME1) COMPILERTEMPNAME=$(TEMPNAME1)
+endif
+ifdef TEMPNAME2PREFIX
+	$(MAKE) g$(TEMPNAME2) COMPILERTEMPNAME=$(TEMPNAME2)
+endif
+ifdef TEMPNAME3PREFIX
+	$(MAKE) g$(TEMPNAME3) COMPILERTEMPNAME=$(TEMPNAME3)
+endif
+ifdef TEMPWPONAME1PREFIX
+	$(MAKE) g$(TEMPWPONAME1) COMPILERTEMPNAME=$(TEMPWPONAME1)
+endif
+ifdef TEMPWPONAME2PREFIX
+	$(MAKE) g$(TEMPWPONAME2) COMPILERTEMPNAME=$(TEMPWPONAME2)
+endif
+
+
+#####################################################################
+# cpu targets
 #####################################################################
 
 PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 mips mipsel avr jvm i8086 aarch64 sparc64 riscv32 riscv64
@@ -526,7 +639,8 @@ tempclean:
 execlean :
 	-$(DEL) $(addsuffix $(EXEEXT), $(addprefix ppc, $(PPC_SUFFIXES)))
 	-$(DEL) $(addsuffix $(EXEEXT), $(addprefix ppcross, $(PPC_SUFFIXES)))
-	-$(DEL) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2)
+	-$(DEL) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2) $(ALL_G_COMPILERS)
+	-$(DEL) fpcmade.generate_g_compilers
 
 $(addsuffix _clean,$(ALLTARGETS)):
         -$(DELTREE) $(addprefix $(subst _clean,,$@),/units)
@@ -684,26 +798,27 @@ ifeq ($(OS_SOURCE),$(OS_TARGET))
 ifndef NOWPOCYCLE
 ifdef RELEASE
 DOWPOCYCLE=1
+endif
+endif
+
+ifdef DOWPOCYCLE
 # Two WPO cycles in case of RELEASE=1
 wpocycle:
 # don't use cycle_clean, it will delete the compiler utilities again
         $(RM) $(EXENAME)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTWPOCOLLECT) $(OPTNEW))' compiler
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3PREFIX)$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTWPOCOLLECT) $(OPTNEW))' compiler
         $(RM) $(EXENAME)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(RTLOPT) $(OPTWPOPERFORM) $(OPTNEW))' rtlclean
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(RTLOPT) $(OPTWPOPERFORM) $(OPTNEW))' rtl
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(OPTWPOPERFORM) $(subst pp1.wpo,pp2.wpo,$(OPTWPOCOLLECT)))' $(addsuffix _clean,$(ALLTARGETS)) 
-		$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(OPTWPOPERFORM) $(subst pp1.wpo,pp2.wpo,$(OPTWPOCOLLECT)))' compiler
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3PREFIX)$(TEMPNAME3)' 'OPT=$(strip $(RTLOPT) $(OPTWPOPERFORM) $(OPTNEW))' rtlclean
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3PREFIX)$(TEMPNAME3)' 'OPT=$(strip $(RTLOPT) $(OPTWPOPERFORM) $(OPTNEW))' rtl
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3PREFIX)$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(OPTWPOPERFORM) $(subst pp1.wpo,pp2.wpo,$(OPTWPOCOLLECT)))' $(addsuffix _clean,$(ALLTARGETS)) 
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3PREFIX)$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(OPTWPOPERFORM) $(subst pp1.wpo,pp2.wpo,$(OPTWPOCOLLECT)))' compiler
         $(MOVE) $(EXENAME) $(TEMPWPONAME1)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(strip $(RTLOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' rtlclean
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(strip $(RTLOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' rtl
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' $(addsuffix _clean,$(ALLTARGETS))
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' compiler
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1PREFIX)$(TEMPWPONAME1)' 'OPT=$(strip $(RTLOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' rtlclean
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1PREFIX)$(TEMPWPONAME1)' 'OPT=$(strip $(RTLOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' rtl
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1PREFIX)$(TEMPWPONAME1)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' $(addsuffix _clean,$(ALLTARGETS))
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1PREFIX)$(TEMPWPONAME1)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' compiler
         $(COPY) $(EXENAME) $(TEMPWPONAME2)
-endif
-endif
-
-ifndef DOWPOCYCLE
+else
 wpocycle:
 endif
 
@@ -741,21 +856,24 @@ $(TEMPNAME1) :
         $(MOVE) $(EXENAME) $(TEMPNAME1)
 
 $(TEMPNAME2) : $(TEMPNAME1)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME1)' 'OLDFPC=' next CYCLELEVEL=2
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME1PREFIX)$(TEMPNAME1)' 'OLDFPC=' next CYCLELEVEL=2
         -$(DEL) $(TEMPNAME2)
         $(MOVE) $(EXENAME) $(TEMPNAME2)
 
 $(TEMPNAME3) : $(TEMPNAME2)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME2)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME1)' next CYCLELEVEL=3
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME2PREFIX)$(TEMPNAME2)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME1)' next CYCLELEVEL=3
         -$(DEL) $(TEMPNAME3)
         $(MOVE) $(EXENAME) $(TEMPNAME3)
 
 cycle:
+ifdef NEED_G_COMPILERS
+	$(MAKE) fpcmade.generate_g_compilers
+endif
         $(MAKE) tempclean
         $(MAKE) $(TEMPNAME3)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME2)' next CYCLELEVEL=4
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3PREFIX)$(TEMPNAME3)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME2)' next CYCLELEVEL=4
         $(DIFF) $(TEMPNAME3) $(EXENAME)
-        $(MAKE) $(addsuffix _all,$(TARGET_DIRS)) 'FPC=$(BASEDIR)/$(EXENAME)'
+        $(MAKE) $(addsuffix _all,$(TARGET_DIRS)) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
         $(MAKE) wpocycle
         $(MAKE) echotime
 
@@ -766,23 +884,26 @@ else
 #
 
 cycle:
+ifdef NEED_G_COMPILERS
+	$(MAKE) fpcmade.generate_g_compilers
+endif
 # ppc (source native)
         $(MAKE) OS_TARGET=$(OS_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=1 rtlclean
         $(MAKE) OS_TARGET=$(OS_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=1 rtl
         $(MAKE) OS_TARGET=$(OS_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=1 cycleclean
         $(MAKE) OS_TARGET=$(OS_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=1 compiler
 # ppcross<ARCH> (source native)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtlclean
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtl
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 cycleclean
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 compiler
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtlclean
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtl
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 cycleclean
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 compiler
 # ppc<ARCH> (target native)
 ifndef CROSSINSTALL
-        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' CYCLELEVEL=3 rtlclean
-        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' CYCLELEVEL=3 rtl
+        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' CYCLELEVEL=3 rtlclean
+        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' CYCLELEVEL=3 rtl
 ifndef NoNativeBinaries
-        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' CYCLELEVEL=3 cycleclean
-        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' CYCLELEVEL=3 compiler
+        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' CYCLELEVEL=3 cycleclean
+        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' CYCLELEVEL=3 compiler
 endif
 endif
 
@@ -800,6 +921,9 @@ else
 
 cycle: override FPC=
 cycle:
+ifdef NEED_G_COMPILERS
+	$(MAKE) fpcmade.generate_g_compilers
+endif
 # ppc (source native)
 # Clear detected compiler binary, because it can be existing crosscompiler binary, but we need native compiler here
         $(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=1 rtlclean
@@ -807,17 +931,17 @@ cycle:
         $(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=1 cycleclean 
         $(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=1 compiler 
 # ppcross<ARCH> (source native)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtlclean 
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtl 
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) PPC_TARGET=$(CPU_TARGET) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 cycleclean 
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) PPC_TARGET=$(CPU_TARGET) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 compiler 
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtlclean 
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 rtl 
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) PPC_TARGET=$(CPU_TARGET) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 cycleclean 
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAMEPREFIX)$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) PPC_TARGET=$(CPU_TARGET) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 CYCLELEVEL=2 compiler 
 # ppc<ARCH> (target native)
 ifndef CROSSINSTALL
-        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(RTLOPT) $(CROSSOPT)' CYCLELEVEL=3 rtlclean
-        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(RTLOPT) $(CROSSOPT)' CYCLELEVEL=3 rtl
+        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' 'OPT=$(RTLOPT) $(CROSSOPT)' CYCLELEVEL=3 rtlclean
+        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' 'OPT=$(RTLOPT) $(CROSSOPT)' CYCLELEVEL=3 rtl
 ifndef NoNativeBinaries
-        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(strip $(LOCALOPT) $(CROSSOPT))' CYCLELEVEL=3 cycleclean
-        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(strip $(LOCALOPT) $(CROSSOPT))' CYCLELEVEL=3 compiler
+        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' 'OPT=$(strip $(LOCALOPT) $(CROSSOPT))' CYCLELEVEL=3 cycleclean
+        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAMEPREFIX)$(PPCROSSNAME)' 'OPT=$(strip $(LOCALOPT) $(CROSSOPT))' CYCLELEVEL=3 compiler
 endif
 endif
 
@@ -864,12 +988,12 @@ fullcycle:
         $(MAKE) ppuclean
 ifdef DOWPOCYCLE
         $(MAKE) rtlclean
-        $(MAKE) rtl 'FPC=$(BASEDIR)/$(EXENAME)'
+        $(MAKE) rtl 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
 endif
 ifndef EXCLUDE_80BIT_TARGETS
-        $(MAKE) $(filter-out $(PPC_TARGET),$(CYCLETARGETS)) 'FPC=$(BASEDIR)/$(EXENAME)'
+        $(MAKE) $(filter-out $(PPC_TARGET),$(CYCLETARGETS)) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
 else
-        $(MAKE) $(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))) 'FPC=$(BASEDIR)/$(EXENAME)'
+        $(MAKE) $(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
 endif
 
 #####################################################################

compiler/cresstr.pas

@@ -308,7 +308,7 @@ uses
         resstrs.RegisterResourceStrings;
         if not resstrs.List.Empty then
           begin
-            current_module.flags:=current_module.flags or uf_has_resourcestrings;
+            include(current_module.moduleflags,mf_has_resourcestrings);
             resstrs.CreateResourceStringData;
             resstrs.WriteRSJFile;
           end;

compiler/dbgdwarf.pas

@@ -3387,7 +3387,7 @@ implementation
         bind: tasmsymbind;
         lang: tdwarf_source_language;
       begin
-        current_module.flags:=current_module.flags or uf_has_dwarf_debuginfo;
+        include(current_module.moduleflags,mf_has_dwarf_debuginfo);
         storefilepos:=current_filepos;
         current_filepos:=current_module.mainfilepos;
 
@@ -3631,7 +3631,7 @@ implementation
         hp:=tmodule(loaded_units.first);
         while assigned(hp) do
           begin
-            If ((hp.flags and uf_has_dwarf_debuginfo)=uf_has_dwarf_debuginfo) and not assigned(hp.package) then
+            If (mf_has_dwarf_debuginfo in hp.moduleflags) and not assigned(hp.package) then
               begin
                 list.concat(Tai_const.Createname(make_mangledname('DEBUGSTART',hp.localsymtable,''),0));
                 list.concat(Tai_const.Createname(make_mangledname('DEBUGEND',hp.localsymtable,''),0));

compiler/dbgstabs.pas

@@ -1679,7 +1679,7 @@ implementation
 
         { include symbol that will be referenced from the main to be sure to
           include this debuginfo .o file }
-        current_module.flags:=current_module.flags or uf_has_stabs_debuginfo;
+        include(current_module.moduleflags,mf_has_stabs_debuginfo);
         if not(target_info.system in systems_darwin) then
           begin
             new_section(current_asmdata.asmlists[al_stabs],sec_data,GetSymTableName(current_module.localsymtable),sizeof(pint));
@@ -1867,7 +1867,7 @@ implementation
         hp:=tmodule(loaded_units.first);
         while assigned(hp) do
           begin
-            If ((hp.flags and uf_has_stabs_debuginfo)=uf_has_stabs_debuginfo) and not assigned(hp.package) then
+            If (mf_has_stabs_debuginfo in hp.moduleflags) and not assigned(hp.package) then
               begin
                 list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.localsymtable,''),0));
                 list.concat(Tai_const.Createname(make_mangledname('DEBUGSTART',hp.localsymtable,''),0));

compiler/entfile.pas

@@ -38,6 +38,7 @@ const
   subentryid          = 2;
   {special}
   iberror             = 0;
+  ibextraheader       = 242;
   ibpputable          = 243;
   ibstartrequireds    = 244;
   ibendrequireds      = 245;

compiler/fmodule.pas

@@ -128,7 +128,9 @@ interface
         crc,
         interface_crc,
         indirect_crc  : cardinal;
-        flags         : cardinal;  { the PPU flags }
+        headerflags   : cardinal;  { the PPU header flags }
+        longversion   : cardinal;  { longer version than what fits in the ppu header }
+        moduleflags   : tmoduleflags; { ppu flags that do not need to be known by just reading the ppu header }
         islibrary     : boolean;  { if it is a library (win32 dll) }
         IsPackage     : boolean;
         moduleid      : longint;
@@ -574,7 +576,9 @@ implementation
         crc:=0;
         interface_crc:=0;
         indirect_crc:=0;
-        flags:=0;
+        headerflags:=0;
+        longversion:=0;
+        moduleflags:=[];
         scanner:=nil;
         unitmap:=nil;
         unitmapsize:=0;
@@ -886,7 +890,9 @@ implementation
         crc:=0;
         interface_crc:=0;
         indirect_crc:=0;
-        flags:=0;
+        headerflags:=0;
+        longversion:=0;
+        moduleflags:=[];
         mainfilepos.line:=0;
         mainfilepos.column:=0;
         mainfilepos.fileindex:=0;
@@ -1061,7 +1067,7 @@ implementation
                   this is for units with an initialization/finalization }
                 if (unitmap[pu.u.moduleid].refs=0) and
                    pu.in_uses and
-                   ((pu.u.flags and (uf_init or uf_finalize))=0) then
+                   ((pu.u.moduleflags * [mf_init,mf_finalize])=[]) then
                   CGMessagePos2(pu.unitsym.fileinfo,sym_n_unit_not_used,pu.u.realmodulename^,realmodulename^);
               end;
             pu:=tused_unit(pu.next);

compiler/fpcp.pas

@@ -127,8 +127,8 @@ implementation
   {$ifdef cpufpemu}
      { check if floating point emulation is on?
        fpu emulation isn't unit levelwise because it affects calling convention }
-     if ((pcpfile.header.common.flags and uf_fpu_emulation)<>0) xor
-          (cs_fp_emulation in current_settings.moduleswitches) then
+     if ((uf_fpu_emulation and pcpfile.header.common.flags)<>0) <>
+        (cs_fp_emulation in current_settings.moduleswitches) then
        begin
          pcpfile.free;
          pcpfile:=nil;
@@ -137,9 +137,6 @@ implementation
        end;
   {$endif cpufpemu}
 
-    { Load values to be access easier }
-      //flags:=pcpfile.header.common.flags;
-      //crc:=pcpfile.header.checksum;
     { Show Debug info }
       Message1(package_u_pcp_time,filetimestring(pcpfiletime));
       Message1(package_u_pcp_flags,tostr(pcpfile.header.common.flags{flags}));

compiler/fppu.pas

@@ -43,7 +43,6 @@ interface
       symbase,ppu,symtype;
 
     type
-
        { tppumodule }
 
        tppumodule = class(tmodule)
@@ -99,6 +98,7 @@ interface
           procedure writeResources;
           procedure writeunitimportsyms;
           procedure writeasmsyms(kind:tunitasmlisttype;list:tfphashobjectlist);
+          procedure writeextraheader;
           procedure readsourcefiles;
           procedure readloadunit;
           procedure readlinkcontainer(var p:tlinkcontainer);
@@ -109,6 +109,7 @@ interface
           procedure readwpofile;
           procedure readunitimportsyms;
           procedure readasmsyms;
+          procedure readextraheader;
 {$IFDEF MACRO_DIFF_HINT}
           procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
           procedure writeusedmacros;
@@ -244,98 +245,110 @@ var
 
 
     function tppumodule.openppu(ppufiletime:longint):boolean;
-      begin
-        openppu:=false;
-      { check for a valid PPU file }
-        if not ppufile.CheckPPUId then
-         begin
-           ppufile.free;
-           ppufile:=nil;
-           Message(unit_u_ppu_invalid_header);
-           exit;
-         end;
-      { check for allowed PPU versions }
-        if not (ppufile.getversion = CurrentPPUVersion) then
-         begin
-           Message1(unit_u_ppu_invalid_version,tostr(ppufile.getversion),@queuecomment);
-           ppufile.free;
-           ppufile:=nil;
-           exit;
-         end;
-      { check the target processor }
-        if tsystemcpu(ppufile.header.common.cpu)<>target_cpu then
-         begin
-           ppufile.free;
-           ppufile:=nil;
-           Message(unit_u_ppu_invalid_processor,@queuecomment);
-           exit;
-         end;
-      { check target }
-        if tsystem(ppufile.header.common.target)<>target_info.system then
-         begin
-           ppufile.free;
-           ppufile:=nil;
-           Message(unit_u_ppu_invalid_target,@queuecomment);
-           exit;
-         end;
-{$ifdef i8086}
-      { check i8086 memory model flags }
-        if ((ppufile.header.common.flags and uf_i8086_far_code)<>0) xor
-            (current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge]) then
-         begin
-           ppufile.free;
-           ppufile:=nil;
-           Message(unit_u_ppu_invalid_memory_model,@queuecomment);
-           exit;
-         end;
-        if ((ppufile.header.common.flags and uf_i8086_far_data)<>0) xor
-            (current_settings.x86memorymodel in [mm_compact,mm_large]) then
-         begin
-           ppufile.free;
-           ppufile:=nil;
-           Message(unit_u_ppu_invalid_memory_model,@queuecomment);
-           exit;
-         end;
-        if ((ppufile.header.common.flags and uf_i8086_huge_data)<>0) xor
-            (current_settings.x86memorymodel=mm_huge) then
-         begin
-           ppufile.free;
-           ppufile:=nil;
-           Message(unit_u_ppu_invalid_memory_model,@queuecomment);
-           exit;
-         end;
-        if ((ppufile.header.common.flags and uf_i8086_cs_equals_ds)<>0) xor
-            (current_settings.x86memorymodel=mm_tiny) then
-         begin
-           ppufile.free;
-           ppufile:=nil;
-           Message(unit_u_ppu_invalid_memory_model,@queuecomment);
-           exit;
-         end;
-        if ((ppufile.header.common.flags and uf_i8086_ss_equals_ds)<>0) xor
-            (current_settings.x86memorymodel in [mm_tiny,mm_small,mm_medium]) then
-         begin
-           ppufile.free;
-           ppufile:=nil;
-           Message(unit_u_ppu_invalid_memory_model,@queuecomment);
-           exit;
-         end;
-{$endif i8086}
+
+      function checkheader: boolean;
+        begin
+          result:=false;
+          { check for a valid PPU file }
+            if not ppufile.CheckPPUId then
+             begin
+               Message(unit_u_ppu_invalid_header);
+               exit;
+             end;
+          { check for allowed PPU versions }
+            if not (ppufile.getversion = CurrentPPUVersion) then
+             begin
+               Message1(unit_u_ppu_invalid_version,tostr(ppufile.getversion),@queuecomment);
+               exit;
+             end;
+          { check the target processor }
+            if tsystemcpu(ppufile.header.common.cpu)<>target_cpu then
+             begin
+               Message(unit_u_ppu_invalid_processor,@queuecomment);
+               exit;
+             end;
+          { check target }
+            if tsystem(ppufile.header.common.target)<>target_info.system then
+             begin
+               Message(unit_u_ppu_invalid_target,@queuecomment);
+               exit;
+             end;
 {$ifdef cpufpemu}
-       { check if floating point emulation is on?
-         fpu emulation isn't unit levelwise because it affects calling convention }
-       if ((ppufile.header.common.flags and uf_fpu_emulation)<>0) xor
-            (cs_fp_emulation in current_settings.moduleswitches) then
-         begin
-           ppufile.free;
-           ppufile:=nil;
-           Message(unit_u_ppu_invalid_fpumode,@queuecomment);
-           exit;
-         end;
+          { check if floating point emulation is on?
+            fpu emulation isn't unit levelwise because it affects calling convention }
+          if ((ppufile.header.common.flags and uf_fpu_emulation)<>0) <>
+             (cs_fp_emulation in current_settings.moduleswitches) then
+            begin
+              Message(unit_u_ppu_invalid_fpumode,@queuecomment);
+              exit;
+            end;
 {$endif cpufpemu}
+           result:=true;
+        end;
+
+      function checkextraheader: boolean;
+        begin
+          result:=false;
+          if ppufile.readentry<>ibextraheader then
+            begin
+              Message(unit_u_ppu_invalid_header);
+              exit;
+            end;
+          readextraheader;
+          if (longversion<>CurrentPPULongVersion) or
+             not ppufile.EndOfEntry then
+            begin
+              Message(unit_u_ppu_invalid_header);
+              exit;
+            end;
+{$ifdef i8086}
+          { check i8086 memory model flags }
+          if (mf_i8086_far_code in moduleflags) <>
+             (current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge]) then
+            begin
+              Message(unit_u_ppu_invalid_memory_model,@queuecomment);
+              exit;
+            end;
+          if (mf_i8086_far_data in moduleflags) <>
+             (current_settings.x86memorymodel in [mm_compact,mm_large]) then
+            begin
+              Message(unit_u_ppu_invalid_memory_model,@queuecomment);
+              exit;
+            end;
+          if (mf_i8086_huge_data in moduleflags) <>
+             (current_settings.x86memorymodel=mm_huge) then
+            begin
+              Message(unit_u_ppu_invalid_memory_model,@queuecomment);
+              exit;
+            end;
+          if (mf_i8086_cs_equals_ds in moduleflags) <>
+             (current_settings.x86memorymodel=mm_tiny) then
+            begin
+              Message(unit_u_ppu_invalid_memory_model,@queuecomment);
+              exit;
+            end;
+          if (mf_i8086_ss_equals_ds in moduleflags) <>
+             (current_settings.x86memorymodel in [mm_tiny,mm_small,mm_medium]) then
+            begin
+              Message(unit_u_ppu_invalid_memory_model,@queuecomment);
+              exit;
+            end;
+{$endif i8086}
+          result:=true;
+        end;
+
+      begin
+        openppu:=false;
+        if not checkheader or
+           not checkextraheader then
+          begin
+            ppufile.free;
+            ppufile:=nil;
+            exit;
+          end;
 
       { Load values to be access easier }
-        flags:=ppufile.header.common.flags;
+        headerflags:=ppufile.header.common.flags;
         crc:=ppufile.header.checksum;
         interface_crc:=ppufile.header.interface_checksum;
         indirect_crc:=ppufile.header.indirect_checksum;
@@ -344,7 +357,7 @@ var
           Message1(unit_u_ppu_time,filetimestring(ppufiletime))
         else
           Message1(unit_u_ppu_time,'unknown');
-        Message1(unit_u_ppu_flags,tostr(flags));
+        Message1(unit_u_ppu_flags,tostr(headerflags));
         Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8));
         Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
         Message1(unit_u_ppu_crc,hexstr(ppufile.header.indirect_checksum,8)+' (indc)');
@@ -961,6 +974,38 @@ var
         ppufile.writeentry(ibasmsymbols);
       end;
 
+    procedure tppumodule.writeextraheader;
+      var
+        old_docrc: boolean;
+      begin
+        { create unit flags }
+        if do_release then
+          include(moduleflags,mf_release);
+        if assigned(localsymtable) then
+          include(moduleflags,mf_local_symtable);
+        if cs_checkpointer_called in current_settings.moduleswitches then
+          include(moduleflags,mf_checkpointer_called);
+{$ifdef i8086}
+        if current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge] then
+          include(moduleflags,mf_i8086_far_code);
+        if current_settings.x86memorymodel in [mm_compact,mm_large] then
+          include(moduleflags,mf_i8086_far_data);
+        if current_settings.x86memorymodel=mm_huge then
+          include(moduleflags,mf_i8086_huge_data);
+        if current_settings.x86memorymodel=mm_tiny then
+          include(moduleflags,mf_i8086_cs_equals_ds);
+        if current_settings.x86memorymodel in [mm_tiny,mm_small,mm_medium] then
+          include(moduleflags,mf_i8086_ss_equals_ds);
+{$endif i8086}
+
+        old_docrc:=ppufile.do_crc;
+        ppufile.do_crc:=false;
+        ppufile.putlongint(longint(CurrentPPULongVersion));
+        ppufile.putsmallset(moduleflags);
+        ppufile.writeentry(ibextraheader);
+        ppufile.do_crc:=old_docrc;
+      end;
+
 
 {$IFDEF MACRO_DIFF_HINT}
 
@@ -1026,7 +1071,7 @@ var
         source_time   : longint;
         hp            : tinputfile;
       begin
-        sources_avail:=(flags and uf_release) = 0;
+        sources_avail:=not(mf_release in moduleflags);
         is_main:=true;
         main_dir:='';
         while not ppufile.endofentry do
@@ -1037,7 +1082,7 @@ var
            temp_dir:='';
            if sources_avail then
              begin
-               if (flags and uf_in_library)<>0 then
+               if (headerflags and uf_in_library)<>0 then
                 begin
                   sources_avail:=false;
                   temp:=' library';
@@ -1300,6 +1345,13 @@ var
       end;
 
 
+    procedure tppumodule.readextraheader;
+      begin
+        longversion:=cardinal(ppufile.getlongint);
+        ppufile.getsmallset(moduleflags);
+      end;
+
+
     procedure tppumodule.load_interface;
       var
         b : byte;
@@ -1324,6 +1376,10 @@ var
                  modulename:=stringdup(upper(newmodulename));
                  realmodulename:=stringdup(newmodulename);
                end;
+             ibextraheader:
+               begin
+                 readextraheader;
+               end;
              ibfeatures :
                begin
                  ppufile.getsmallset(features);
@@ -1416,27 +1472,9 @@ var
          Message1(unit_u_ppu_write,realmodulename^);
 
          { create unit flags }
-         if do_release then
-          flags:=flags or uf_release;
-         if assigned(localsymtable) then
-           flags:=flags or uf_local_symtable;
-         if (cs_checkpointer_called in current_settings.moduleswitches) then
-           flags:=flags or uf_checkpointer_called;
-{$ifdef i8086}
-         if current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge] then
-           flags:=flags or uf_i8086_far_code;
-         if current_settings.x86memorymodel in [mm_compact,mm_large] then
-           flags:=flags or uf_i8086_far_data;
-         if current_settings.x86memorymodel=mm_huge then
-           flags:=flags or uf_i8086_huge_data;
-         if current_settings.x86memorymodel=mm_tiny then
-           flags:=flags or uf_i8086_cs_equals_ds;
-         if current_settings.x86memorymodel in [mm_tiny,mm_small,mm_medium] then
-           flags:=flags or uf_i8086_ss_equals_ds;
-{$endif i8086}
 {$ifdef cpufpemu}
          if (cs_fp_emulation in current_settings.moduleswitches) then
-           flags:=flags or uf_fpu_emulation;
+           headerflags:=headerflags or uf_fpu_emulation;
 {$endif cpufpemu}
 {$ifdef Test_Double_checksum_write}
          Assign(CRCFile,s+'.IMP');
@@ -1448,6 +1486,9 @@ var
          if not ppufile.createfile then
           Message(unit_f_ppu_cannot_write);
 
+         { extra header (sub version, module flags) }
+         writeextraheader;
+
          { first the (JVM) namespace }
          if assigned(namespace) then
            begin
@@ -1532,7 +1573,7 @@ var
               tstoredsymtable(globalmacrosymtable).buildderefimpl;
             end;
 
-         if (flags and uf_local_symtable)<>0 then
+         if mf_local_symtable in moduleflags then
            tstoredsymtable(localsymtable).buildderef_registered;
          buildderefunitimportsyms;
          writederefmap;
@@ -1575,7 +1616,7 @@ var
 
          { write static symtable
            needed for local debugging of unit functions }
-         if (flags and uf_local_symtable)<>0 then
+         if mf_local_symtable in moduleflags then
            tstoredsymtable(localsymtable).ppuwrite(ppufile);
 
          { write whole program optimisation-related information }
@@ -1593,7 +1634,7 @@ var
          ppufile.header.common.compiler:=wordversion;
          ppufile.header.common.cpu:=word(target_cpu);
          ppufile.header.common.target:=word(target_info.system);
-         ppufile.header.common.flags:=flags;
+         ppufile.header.common.flags:=headerflags;
          ppufile.header.deflistsize:=current_module.deflist.count;
          ppufile.header.symlistsize:=current_module.symlist.count;
          ppufile.writeheader;
@@ -1636,6 +1677,9 @@ var
          ppufile.putstring(realmodulename^);
          ppufile.writeentry(ibmodulename);
 
+         { extra header (sub version, module flags) }
+         writeextraheader;
+
          ppufile.putsmallset(moduleoptions);
          if mo_has_deprecated_msg in moduleoptions then
            ppufile.putstring(deprecatedmsg^);
@@ -1699,7 +1743,7 @@ var
          ppufile.header.common.compiler:=wordversion;
          ppufile.header.common.cpu:=word(target_cpu);
          ppufile.header.common.target:=word(target_info.system);
-         ppufile.header.common.flags:=flags;
+         ppufile.header.common.flags:=headerflags;
          ppufile.writeheader;
 
          ppufile.closefile;
@@ -1734,7 +1778,7 @@ var
               if (pu.u.interface_crc<>pu.interface_checksum) or
                  (pu.u.indirect_crc<>pu.indirect_checksum) or
                  (
-                  ((ppufile.header.common.flags and uf_release)=0) and
+                  (not(mf_release in moduleflags)) and
                   (pu.u.crc<>pu.checksum)
                  ) then
                begin
@@ -1810,7 +1854,7 @@ var
          end;
 
         { load implementation symtable }
-        if (flags and uf_local_symtable)<>0 then
+        if mf_local_symtable in moduleflags then
           begin
             localsymtable:=tstaticsymtable.create(modulename^,moduleid);
             tstaticsymtable(localsymtable).ppuload(ppufile);

compiler/globals.pas

@@ -892,6 +892,30 @@ implementation
          end;
 
 {$endif mswindows}
+{$ifdef openbsd}
+       function GetOpenBSDLocalBase: ansistring;
+         var
+           envvalue: pchar;
+         begin
+           envvalue := GetEnvPChar('LOCALBASE');
+           if assigned(envvalue) then
+             Result:=envvalue
+           else
+             Result:='/usr/local';
+           FreeEnvPChar(envvalue);
+         end;
+       function GetOpenBSDX11Base: ansistring;
+         var
+           envvalue: pchar;
+         begin
+           envvalue := GetEnvPChar('X11BASE');
+           if assigned(envvalue) then
+             Result:=envvalue
+           else
+             Result:='/usr/X11R6';
+           FreeEnvPChar(envvalue);
+         end;
+{$endif openbsd}
        var
          envstr: string;
          envvalue: pchar;
@@ -924,6 +948,10 @@ implementation
          ReplaceSpecialFolder('$PROGRAM_FILES_COMMON',CSIDL_PROGRAM_FILES_COMMON);
          ReplaceSpecialFolder('$PROFILE',CSIDL_PROFILE);
 {$endif mswindows}
+{$ifdef openbsd}
+         Replace(s,'$OPENBSD_LOCALBASE',GetOpenBSDLocalBase);
+         Replace(s,'$OPENBSD_X11BASE',GetOpenBSDX11Base);
+{$endif openbsd}
          { Replace environment variables between dollar signs }
          i := pos('$',s);
          while i>0 do

compiler/globtype.pas

@@ -348,6 +348,33 @@ interface
        );
        twpoptimizerswitches = set of twpoptimizerswitch;
 
+       { module flags (extra unit flags not in ppu header) }
+       tmoduleflag = (
+         mf_init,                     { unit has initialization section }
+         mf_finalize,                 { unit has finalization section   }
+         mf_checkpointer_called,      { Unit uses experimental checkpointer test code }
+         mf_has_resourcestrings,      { unit has resource string section }
+         mf_release,                  { unit was compiled with -Ur option }
+         mf_threadvars,               { unit has threadvars }
+         mf_has_stabs_debuginfo,      { this unit has stabs debuginfo generated }
+         mf_local_symtable,           { this unit has a local symtable stored }
+         mf_uses_variants,            { this unit uses variants }
+         mf_has_resourcefiles,        { this unit has external resources (using $R directive)}
+         mf_has_exports,              { this module or a used unit has exports }
+         mf_has_dwarf_debuginfo,      { this unit has dwarf debuginfo generated }
+         mf_wideinits,                { this unit has winlike widestring typed constants }
+         mf_classinits,               { this unit has class constructors/destructors }
+         mf_resstrinits,              { this unit has string consts referencing resourcestrings }
+         mf_i8086_far_code,           { this unit uses an i8086 memory model with far code (i.e. medium, large or huge) }
+         mf_i8086_far_data,           { this unit uses an i8086 memory model with far data (i.e. compact or large) }
+         mf_i8086_huge_data,          { this unit uses an i8086 memory model with huge data (i.e. huge) }
+         mf_i8086_cs_equals_ds,       { this unit uses an i8086 memory model with CS=DS (i.e. tiny) }
+         mf_i8086_ss_equals_ds,       { this unit uses an i8086 memory model with SS=DS (i.e. tiny, small or medium) }
+         mf_package_deny,             { this unit must not be part of a package }
+         mf_package_weak              { this unit may be completely contained in a package }
+       );
+       tmoduleflags = set of tmoduleflag;
+
     type
        ttargetswitchinfo = record
           name: string[22];

compiler/htypechk.pas

@@ -192,6 +192,7 @@ interface
     procedure set_unique(p : tnode);
 
     function  valid_for_formal_var(p : tnode; report_errors: boolean) : boolean;
+    function  valid_for_formal_constref(p : tnode; report_errors: boolean) : boolean;
     function  valid_for_formal_const(p : tnode; report_errors: boolean) : boolean;
     function  valid_for_var(p:tnode; report_errors: boolean):boolean;
     function  valid_for_assignment(p:tnode; report_errors: boolean):boolean;
@@ -1943,6 +1944,13 @@ implementation
       end;
 
 
+    function  valid_for_formal_constref(p : tnode; report_errors: boolean) : boolean;
+      begin
+        valid_for_formal_constref:=(p.resultdef.typ=formaldef) or
+          valid_for_assign(p,[valid_void,valid_range],report_errors);
+      end;
+
+
     function  valid_for_formal_const(p : tnode; report_errors: boolean) : boolean;
       begin
         valid_for_formal_const:=(p.resultdef.typ=formaldef) or

compiler/i386/cpupara.pas

@@ -447,7 +447,8 @@ unit cpupara;
             { syscall for AROS can have already a paraloc set }
             if (vo_has_explicit_paraloc in hp.varoptions) then
               begin
-                if not(vo_is_syscall_lib in hp.varoptions) then
+                { on AROS-i386, only the libbase can have explicit paraloc }
+                if not (vo_is_syscall_lib in hp.varoptions) then
                   internalerror(2016090105);
                 if p.proccalloption in pushleftright_pocalls then
                   dec(i)

compiler/jvm/njvmutil.pas

@@ -404,7 +404,7 @@ implementation
           { class constructors are automatically handled by the JVM }
 
           { call the unit init code and make it external }
-          if (hp.u.flags and (uf_init or uf_finalize))<>0 then
+          if (hp.u.moduleflags*[mf_init,mf_finalize])<>[] then
             begin
               { trigger init code by referencing the class representing the
                 unit; if necessary, it will register the fini code to run on

compiler/link.pas

@@ -374,22 +374,22 @@ Implementation
       begin
         with hp do
          begin
-           if (flags and uf_has_resourcefiles)<>0 then
+           if mf_has_resourcefiles in moduleflags then
              HasResources:=true;
-           if (flags and uf_has_exports)<>0 then
+           if mf_has_exports in moduleflags then
              HasExports:=true;
          { link unit files }
-           if (flags and uf_no_link)=0 then
+           if (headerflags and uf_no_link)=0 then
             begin
               { create mask which unit files need linking }
               mask:=link_always;
               { static linking ? }
               if (cs_link_static in current_settings.globalswitches) then
                begin
-                 if (flags and uf_static_linked)=0 then
+                 if (headerflags and uf_static_linked)=0 then
                   begin
                     { if smart not avail then try static linking }
-                    if (flags and uf_smart_linked)<>0 then
+                    if (headerflags and uf_smart_linked)<>0 then
                      begin
                        Message1(exec_t_unit_not_static_linkable_switch_to_smart,modulename^);
                        mask:=mask or link_smart;
@@ -404,10 +404,10 @@ Implementation
 
               if (cs_link_smart in current_settings.globalswitches) then
                begin
-                 if (flags and uf_smart_linked)=0 then
+                 if (headerflags and uf_smart_linked)=0 then
                   begin
                     { if smart not avail then try static linking }
-                    if (flags and uf_static_linked)<>0 then
+                    if (headerflags and uf_static_linked)<>0 then
                      begin
                        { if not create_smartlink_library, then smart linking happens using the
                          regular object files
@@ -425,10 +425,10 @@ Implementation
               { shared linking }
               if (cs_link_shared in current_settings.globalswitches) then
                begin
-                 if (flags and uf_shared_linked)=0 then
+                 if (headerflags and uf_shared_linked)=0 then
                   begin
                     { if shared not avail then try static linking }
-                    if (flags and uf_static_linked)<>0 then
+                    if (headerflags and uf_static_linked)<>0 then
                      begin
                        Message1(exec_t_unit_not_shared_linkable_switch_to_static,modulename^);
                        mask:=mask or link_static;

compiler/m68k/cpupara.pas

@@ -336,11 +336,8 @@ unit cpupara;
 
             { syscall for AmigaOS can have already a paraloc set }
             if (vo_has_explicit_paraloc in hp.varoptions) then
-              begin
-                if not(vo_is_syscall_lib in hp.varoptions) then
-                  internalerror(200506051);
-                continue;
-              end;
+              continue;
+
             hp.paraloc[side].reset;
 
             { currently only support C-style array of const }

compiler/ncal.pas

@@ -1321,12 +1321,16 @@ implementation
 
                      case parasym.varspez of
                        vs_var,
-                       vs_constref,
                        vs_out :
                          begin
                            if not valid_for_formal_var(left,true) then
                             CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list);
                          end;
+                       vs_constref:
+                         begin
+                           if not valid_for_formal_constref(left,true) then
+                            CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list);
+                         end;
                        vs_const :
                          begin
                            if not valid_for_formal_const(left,true) then

compiler/ncgrtti.pas

@@ -256,6 +256,8 @@ implementation
 
                           if is_open_array(para.vardef) or is_array_of_const(para.vardef) then
                             write_rtti_reference(tcb,tarraydef(para.vardef).elementdef,fullrtti)
+                          else if para.vardef=cformaltype then
+                            write_rtti_reference(tcb,nil,fullrtti)
                           else
                             write_rtti_reference(tcb,para.vardef,fullrtti);
                           write_param_flag(tcb,para);
@@ -1395,6 +1397,8 @@ implementation
                { write param type }
                if is_open_array(parasym.vardef) or is_array_of_const(parasym.vardef) then
                  write_rtti_reference(tcb,tarraydef(parasym.vardef).elementdef,fullrtti)
+               else if parasym.vardef=cformaltype then
+                 write_rtti_reference(tcb,nil,fullrtti)
                else
                  write_rtti_reference(tcb,parasym.vardef,fullrtti);
                { write name of current parameter }
@@ -1442,6 +1446,8 @@ implementation
                  begin
                    if is_open_array(tparavarsym(def.paras[i]).vardef) or is_array_of_const(tparavarsym(def.paras[i]).vardef) then
                      write_rtti_reference(tcb,tarraydef(tparavarsym(def.paras[i]).vardef).elementdef,fullrtti)
+                   else if tparavarsym(def.paras[i]).vardef=cformaltype then
+                     write_rtti_reference(tcb,nil,fullrtti)
                    else
                      write_rtti_reference(tcb,tparavarsym(def.paras[i]).vardef,fullrtti);
                  end;

compiler/ncnv.pas

@@ -1653,7 +1653,25 @@ implementation
         left:=nil;
         { create a set constructor tree }
         arrayconstructor_to_set(hp);
-        result:=hp;
+        if is_emptyset(hp) then
+          begin
+            { enforce the result type for an empty set }
+            hp.resultdef:=resultdef;
+            result:=hp;
+          end
+        else if hp.resultdef<>resultdef then
+          begin
+            { the set might contain a subrange element (e.g. through a variable),
+              thus we need to insert another type conversion }
+            if nf_explicit in flags then
+              result:=ctypeconvnode.create_explicit(hp,totypedef)
+            else if nf_internal in flags then
+              result:=ctypeconvnode.create_internal(hp,totypedef)
+            else
+              result:=ctypeconvnode.create(hp,totypedef);
+          end
+        else
+          result:=hp;
       end;
 
 
@@ -2383,15 +2401,6 @@ implementation
            not(resultdef.typ in [procvardef,recorddef,setdef]) then
           maybe_call_procvar(left,true);
 
-        { convert array constructors to sets, because there is no conversion
-          possible for array constructors }
-        if (resultdef.typ<>arraydef) and
-           is_array_constructor(left.resultdef) then
-          begin
-            arrayconstructor_to_set(left);
-            typecheckpass(left);
-          end;
-
         if target_specific_general_typeconv then
           exit;
 
@@ -2480,6 +2489,16 @@ implementation
 
               te_incompatible :
                 begin
+                  { convert an array constructor to a set so that we still get
+                    the error "set of Y incompatible to Z" instead of "array of
+                    X incompatible to Z" }
+                  if (resultdef.typ<>arraydef) and
+                     is_array_constructor(left.resultdef) then
+                    begin
+                      arrayconstructor_to_set(left);
+                      typecheckpass(left);
+                    end;
+
                   { Procedures have a resultdef of voiddef and functions of their
                     own resultdef. They will therefore always be incompatible with
                     a procvar. Because isconvertable cannot check for procedures we

compiler/ngenutil.pas

@@ -114,8 +114,8 @@ interface
       class function create_main_procdef(const name: string; potype:tproctypeoption; ps: tprocsym):tdef; virtual;
       class procedure InsertInitFinalTable;
      protected
-      class procedure InsertRuntimeInits(const prefix:string;list:TLinkedList;unitflag:cardinal); virtual;
-      class procedure InsertRuntimeInitsTablesTable(const prefix,tablename:string;unitflag:cardinal); virtual;
+      class procedure InsertRuntimeInits(const prefix:string;list:TLinkedList;unitflag:tmoduleflag); virtual;
+      class procedure InsertRuntimeInitsTablesTable(const prefix,tablename:string;unitflag:tmoduleflag); virtual;
 
       class procedure insert_init_final_table(entries:tfplist); virtual;
 
@@ -482,7 +482,7 @@ implementation
                TSymtable(current_module.globalsymtable).SymList.ForEachCall(@sym_maybe_initialize,@stat);
              TSymtable(current_module.localsymtable).SymList.ForEachCall(@sym_maybe_initialize,@stat);
              { insert class constructors  }
-             if (current_module.flags and uf_classinits) <> 0 then
+             if mf_classinits in current_module.moduleflags then
                append_struct_initfinis(current_module, potype_class_constructor, stat);
            end;
          { units have seperate code for initilization and finalization }
@@ -506,7 +506,7 @@ implementation
          potype_unitfinalize:
            begin
              { insert class destructors  }
-             if (current_module.flags and uf_classinits) <> 0 then
+             if mf_classinits in current_module.moduleflags then
                append_struct_initfinis(current_module, potype_class_destructor, stat);
              { this is also used for initialization of variables in a
                program which does not have a globalsymtable }
@@ -959,17 +959,17 @@ implementation
       hp:=tused_unit(usedunits.first);
       while assigned(hp) do
        begin
-         if (hp.u.flags and (uf_init or uf_finalize))<>0 then
+         if (hp.u.moduleflags * [mf_init,mf_finalize])<>[] then
            begin
              new(entry);
              entry^.module:=hp.u;
              entry^.initpd:=nil;
              entry^.finipd:=nil;
-             if (hp.u.flags and uf_init)<>0 then
+             if mf_init in hp.u.moduleflags then
                entry^.initfunc:=make_mangledname('INIT$',hp.u.globalsymtable,'')
              else
                entry^.initfunc:='';
-             if (hp.u.flags and uf_finalize)<>0 then
+             if mf_finalize in hp.u.moduleflags then
                entry^.finifunc:=make_mangledname('FINALIZE$',hp.u.globalsymtable,'')
              else
                entry^.finifunc:='';
@@ -979,17 +979,17 @@ implementation
        end;
 
       { Insert initialization/finalization of the program }
-      if (current_module.flags and (uf_init or uf_finalize))<>0 then
+      if (current_module.moduleflags * [mf_init,mf_finalize])<>[] then
         begin
           new(entry);
           entry^.module:=current_module;
           entry^.initpd:=nil;
           entry^.finipd:=nil;
-          if (current_module.flags and uf_init)<>0 then
+          if mf_init in current_module.moduleflags then
             entry^.initfunc:=make_mangledname('INIT$',current_module.localsymtable,'')
           else
             entry^.initfunc:='';
-          if (current_module.flags and uf_finalize)<>0 then
+          if mf_finalize in current_module.moduleflags then
             entry^.finifunc:=make_mangledname('FINALIZE$',current_module.localsymtable,'')
           else
             entry^.finifunc:='';
@@ -1165,7 +1165,7 @@ implementation
       hp:=tused_unit(usedunits.first);
       while assigned(hp) do
        begin
-         if (hp.u.flags and uf_threadvars)=uf_threadvars then
+         if mf_threadvars in hp.u.moduleflags then
            begin
              sym:=current_asmdata.RefAsmSymbol(make_mangledname('THREADVARLIST',hp.u.globalsymtable,''),AT_DATA,true);
              tcb.emit_tai(
@@ -1177,7 +1177,7 @@ implementation
          hp:=tused_unit(hp.next);
        end;
       { Add program threadvars, if any }
-      if (current_module.flags and uf_threadvars)=uf_threadvars then
+      if mf_threadvars in current_module.moduleflags then
         begin
           sym:=current_asmdata.RefAsmSymbol(make_mangledname('THREADVARLIST',current_module.localsymtable,''),AT_DATA,true);
           tcb.emit_tai(
@@ -1250,7 +1250,7 @@ implementation
            sym:=current_asmdata.DefineAsmSymbol(s,AB_GLOBAL,AT_DATA_FORCEINDIRECT,tabledef);
            current_asmdata.asmlists[al_globals].concatlist(
              tcb.get_final_asmlist(sym,tabledef,sec_data,s,sizeof(pint)));
-           current_module.flags:=current_module.flags or uf_threadvars;
+           include(current_module.moduleflags,mf_threadvars);
            current_module.add_public_asmsym(sym);
          end
        else
@@ -1259,7 +1259,7 @@ implementation
     end;
 
 
-  class procedure tnodeutils.InsertRuntimeInitsTablesTable(const prefix,tablename:string;unitflag:cardinal);
+  class procedure tnodeutils.InsertRuntimeInitsTablesTable(const prefix,tablename:string;unitflag:tmoduleflag);
     var
       hp: tused_unit;
       tcb: ttai_typedconstbuilder;
@@ -1278,7 +1278,7 @@ implementation
       hp:=tused_unit(usedunits.first);
       while assigned(hp) do
        begin
-         if (hp.u.flags and unitflag)=unitflag then
+         if unitflag in hp.u.moduleflags then
           begin
             tcb.emit_tai(
               Tai_const.Createname(make_mangledname(prefix,hp.u.globalsymtable,''),0),
@@ -1288,7 +1288,7 @@ implementation
          hp:=tused_unit(hp.next);
        end;
       { Add items from program, if any }
-      if (current_module.flags and unitflag)=unitflag then
+      if unitflag in current_module.moduleflags then
        begin
          tcb.emit_tai(
            Tai_const.Createname(make_mangledname(prefix,current_module.localsymtable,''),0),
@@ -1311,7 +1311,7 @@ implementation
     end;
 
 
-  class procedure tnodeutils.InsertRuntimeInits(const prefix:string;list:TLinkedList;unitflag:cardinal);
+  class procedure tnodeutils.InsertRuntimeInits(const prefix:string;list:TLinkedList;unitflag:tmoduleflag);
     var
       s: string;
       item: TTCInitItem;
@@ -1349,31 +1349,31 @@ implementation
           current_asmdata.DefineAsmSymbol(s,AB_GLOBAL,AT_DATA,rawdatadef),
           rawdatadef,sec_data,s,sizeof(pint)));
       tcb.free;
-      current_module.flags:=current_module.flags or unitflag;
+      include(current_module.moduleflags,unitflag);
     end;
 
 
   class procedure tnodeutils.InsertWideInits;
     begin
-      InsertRuntimeInits('WIDEINITS',current_asmdata.WideInits,uf_wideinits);
+      InsertRuntimeInits('WIDEINITS',current_asmdata.WideInits,mf_wideinits);
     end;
 
 
   class procedure tnodeutils.InsertResStrInits;
     begin
-      InsertRuntimeInits('RESSTRINITS',current_asmdata.ResStrInits,uf_resstrinits);
+      InsertRuntimeInits('RESSTRINITS',current_asmdata.ResStrInits,mf_resstrinits);
     end;
 
 
   class procedure tnodeutils.InsertWideInitsTablesTable;
     begin
-      InsertRuntimeInitsTablesTable('WIDEINITS','FPC_WIDEINITTABLES',uf_wideinits);
+      InsertRuntimeInitsTablesTable('WIDEINITS','FPC_WIDEINITTABLES',mf_wideinits);
     end;
 
 
   class procedure tnodeutils.InsertResStrTablesTable;
     begin
-      InsertRuntimeInitsTablesTable('RESSTRINITS','FPC_RESSTRINITTABLES',uf_resstrinits);
+      InsertRuntimeInitsTablesTable('RESSTRINITS','FPC_RESSTRINITTABLES',mf_resstrinits);
     end;
 
 
@@ -1394,7 +1394,7 @@ implementation
       countplaceholder:=tcb.emit_placeholder(sizesinttype);
       while assigned(hp) do
         begin
-          If (hp.flags and uf_has_resourcestrings)=uf_has_resourcestrings then
+          if mf_has_resourcestrings in hp.moduleflags then
             begin
               tcb.emit_tai(Tai_const.Create_sym(
                 ctai_typedconstbuilder.get_vectorized_dead_strip_section_symbol_start('RESSTR',hp.localsymtable,[tcdssso_register_asmsym,tcdssso_use_indirect])),

compiler/pcp.pas

@@ -31,18 +31,13 @@ interface
   const
     CurrentPCPVersion=3;
 
-  { unit flags }
-    //uf_init                = $000001; { unit has initialization section }
-    //uf_finalize            = $000002; { unit has finalization section   }
+    { unit flags }
     pf_big_endian          = $000004;
-  //uf_has_browser         = $000010;
     //uf_in_library          = $000020; { is the file in another file than <ppufile>.* ? }
     //uf_smart_linked        = $000040; { the ppu can be smartlinked }
     //uf_static_linked       = $000080; { the ppu can be linked static }
     //uf_shared_linked       = $000100; { the ppu can be linked shared }
-  //uf_local_browser       = $000200;
     //uf_no_link             = $000400; { unit has no .o generated, but can still have external linking! }
-    //uf_has_resourcestrings = $000800; { unit has resource string section }
     pf_little_endian       = $001000;
 
 

compiler/pdecobj.pas

@@ -116,7 +116,7 @@ implementation
           Message(parser_e_no_paras_for_class_constructor);
         consume(_SEMICOLON);
         include(astruct.objectoptions,oo_has_class_constructor);
-        current_module.flags:=current_module.flags or uf_classinits;
+        include(current_module.moduleflags,mf_classinits);
         { no return value }
         pd.returndef:=voidtype;
         constr_destr_finish_head(pd,astruct);
@@ -238,7 +238,7 @@ implementation
           Message(parser_e_no_paras_for_class_destructor);
         consume(_SEMICOLON);
         include(astruct.objectoptions,oo_has_class_destructor);
-        current_module.flags:=current_module.flags or uf_classinits;
+        include(current_module.moduleflags,mf_classinits);
         { no return value }
         pd.returndef:=voidtype;
         constr_destr_finish_head(pd,astruct);

compiler/pdecsub.pas

@@ -512,10 +512,8 @@ implementation
         until not try_to_consume(_SEMICOLON);
 
         if explicit_paraloc then
-          begin
-            pd.has_paraloc_info:=callerside;
-            include(pd.procoptions,po_explicitparaloc);
-          end;
+          include(pd.procoptions,po_explicitparaloc);
+
         { remove parasymtable from stack }
         sc.free;
         { reset object options }
@@ -1323,7 +1321,7 @@ implementation
 {
             if ((pd.returndef=cvarianttype) or (pd.returndef=colevarianttype)) and
                not(cs_compilesystem in current_settings.moduleswitches) then
-              current_module.flags:=current_module.flags or uf_uses_variants;
+              include(current_module.moduleflags,mf_uses_variants);
 }
             if is_dispinterface(pd.struct) and not is_automatable(pd.returndef) then
               Message1(type_e_not_automatable,pd.returndef.typename);

compiler/pexports.pas

@@ -82,7 +82,7 @@ implementation
         end;
 
       begin
-         current_module.flags:=current_module.flags or uf_has_exports;
+         include(current_module.moduleflags,mf_has_exports);
          DefString:='';
          InternalProcName:='';
          consume(_EXPORTS);

compiler/pexpr.pas

@@ -3174,7 +3174,7 @@ implementation
                            { We need to know if this unit uses Variants }
                            if ((hdef=cvarianttype) or (hdef=colevarianttype)) and
                               not(cs_compilesystem in current_settings.moduleswitches) then
-                             current_module.flags:=current_module.flags or uf_uses_variants;
+                             include(current_module.moduleflags,mf_uses_variants);
                            p1:=handle_factor_typenode(hdef,getaddr,again,srsym,ef_type_only in flags);
                          end;
                      end;

compiler/pkgutil.pas

@@ -235,13 +235,13 @@ implementation
       u.localsymtable.symlist.ForEachCall(@insert_export,u.localsymtable);
 
       { create special exports }
-      if (u.flags and uf_init)<>0 then
+      if mf_init in u.moduleflags then
         procexport(make_mangledname('INIT$',u.globalsymtable,''));
-      if (u.flags and uf_finalize)<>0 then
+      if mf_finalize in u.moduleflags then
         procexport(make_mangledname('FINALIZE$',u.globalsymtable,''));
-      if (u.flags and uf_threadvars)=uf_threadvars then
+      if mf_threadvars in u.moduleflags then
         varexport(make_mangledname('THREADVARLIST',u.globalsymtable,''));
-      if (u.flags and uf_has_resourcestrings)<>0 then
+      if mf_has_resourcestrings in u.moduleflags then
         begin
           varexport(ctai_typedconstbuilder.get_vectorized_dead_strip_section_symbol_start('RESSTR',u.localsymtable,[]).name);
           varexport(ctai_typedconstbuilder.get_vectorized_dead_strip_section_symbol_end('RESSTR',u.localsymtable,[]).name);
@@ -778,7 +778,7 @@ implementation
               end;
             if not assigned(module) then
               internalerror(2014101001);
-            if (uf_in_library and module.flags)=0 then
+            if (uf_in_library and module.headerflags)=0 then
               { unit is not part of a package, so no need to handle it }
               continue;
             { loaded by a package? }

compiler/pmodules.pas

@@ -123,12 +123,12 @@ implementation
     { Insert the used object file for this unit in the used list for this unit }
       begin
         current_module.linkunitofiles.add(current_module.objfilename,link_static);
-        current_module.flags:=current_module.flags or uf_static_linked;
+        current_module.headerflags:=current_module.headerflags or uf_static_linked;
 
         if create_smartlink_library then
          begin
            current_module.linkunitstaticlibs.add(current_module.staticlibfilename ,link_smart);
-           current_module.flags:=current_module.flags or uf_smart_linked;
+           current_module.headerflags:=current_module.headerflags or uf_smart_linked;
          end;
       end;
 
@@ -163,13 +163,12 @@ implementation
         if not CheckResourcesUsed then exit;
 
         hp:=tused_unit(usedunits.first);
-        found:=((current_module.flags and uf_has_resourcefiles)=uf_has_resourcefiles);
-        If not found then
-          While Assigned(hp) and not found do
-            begin
-            Found:=((hp.u.flags and uf_has_resourcefiles)=uf_has_resourcefiles);
+        found:=mf_has_resourcefiles in current_module.moduleflags;
+        while Assigned(hp) and not found do
+          begin
+            found:=mf_has_resourcefiles in hp.u.moduleflags;
             hp:=tused_unit(hp.next);
-            end;
+          end;
         CheckResourcesUsed:=found;
       end;
 
@@ -210,7 +209,7 @@ implementation
       begin
         { Do we need the variants unit? Skip this
           for VarUtils unit for bootstrapping }
-        if (current_module.flags and uf_uses_variants=0) or
+        if not(mf_uses_variants in current_module.moduleflags) or
            (current_module.modulename^='VARUTILS') then
           exit;
         { Variants unit already loaded? }
@@ -722,16 +721,16 @@ implementation
 {$endif i386 or sparcgen}
       end;
 
-    function gen_implicit_initfinal(flag:word;st:TSymtable):tcgprocinfo;
+    function gen_implicit_initfinal(flag:tmoduleflag;st:TSymtable):tcgprocinfo;
       begin
         { create procdef }
         case flag of
-          uf_init :
+          mf_init :
             begin
               result:=create_main_proc(make_mangledname('',current_module.localsymtable,'init_implicit$'),potype_unitinit,st);
               result.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
             end;
-          uf_finalize :
+          mf_finalize :
             begin
               result:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize_implicit$'),potype_unitfinalize,st);
               result.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
@@ -1227,7 +1226,7 @@ type
                  release_proc_symbol(init_procinfo.procdef);
                  release_main_proc(init_procinfo);
                end;
-             init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable);
+             init_procinfo:=gen_implicit_initfinal(mf_init,current_module.localsymtable);
            end;
          if (force_init_final or cnodeutils.force_final) and
             (
@@ -1241,7 +1240,7 @@ type
                  release_proc_symbol(finalize_procinfo.procdef);
                  release_main_proc(finalize_procinfo);
                end;
-             finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
+             finalize_procinfo:=gen_implicit_initfinal(mf_finalize,current_module.localsymtable);
            end;
 
          { Now both init and finalize bodies are read and it is known
@@ -1255,7 +1254,7 @@ type
                begin
                  init_procinfo.code:=cnodeutils.wrap_proc_body(init_procinfo.procdef,init_procinfo.code);
                  init_procinfo.generate_code;
-                 current_module.flags:=current_module.flags or uf_init;
+                 include(current_module.moduleflags,mf_init);
                end
              else
                release_proc_symbol(init_procinfo.procdef);
@@ -1270,7 +1269,7 @@ type
                begin
                  finalize_procinfo.code:=cnodeutils.wrap_proc_body(finalize_procinfo.procdef,finalize_procinfo.code);
                  finalize_procinfo.generate_code;
-                 current_module.flags:=current_module.flags or uf_finalize;
+                 include(current_module.moduleflags,mf_finalize);
                end
              else
                release_proc_symbol(finalize_procinfo.procdef);
@@ -1352,8 +1351,9 @@ type
            insertobjectfile
          else
            begin
-             current_module.flags:=current_module.flags or uf_no_link;
-             current_module.flags:=current_module.flags and not (uf_has_stabs_debuginfo or uf_has_dwarf_debuginfo);
+             current_module.headerflags:=current_module.headerflags or uf_no_link;
+             exclude(current_module.moduleflags,mf_has_stabs_debuginfo);
+             exclude(current_module.moduleflags,mf_has_dwarf_debuginfo);
            end;
 
          if ag then
@@ -1643,7 +1643,7 @@ type
            begin
              if (hp<>current_module) and not assigned(hp.package) then
                begin
-                 if (hp.flags and uf_package_deny) <> 0 then
+                 if mf_package_deny in hp.moduleflags then
                    message1(package_e_unit_deny_package,hp.realmodulename^);
                  { part of the package's used, aka contained units? }
                  uu:=tused_unit(current_module.used_units.first);
@@ -1686,13 +1686,13 @@ type
          { should we force unit initialization? }
          force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final;
          if force_init_final or cnodeutils.force_init then
-           {init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable)};
+           {init_procinfo:=gen_implicit_initfinal(mf_init,current_module.localsymtable)};
 
          { Add symbol to the exports section for win32 so smartlinking a
            DLL will include the edata section }
          if assigned(exportlib) and
             (target_info.system in [system_i386_win32,system_i386_wdosx]) and
-            ((current_module.flags and uf_has_exports)<>0) then
+            (mf_has_exports in current_module.moduleflags) then
            current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',current_module.localsymtable,''),0));
 
          { all labels must be defined before generating code }
@@ -2191,13 +2191,13 @@ type
          { should we force unit initialization? }
          force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final;
          if force_init_final or cnodeutils.force_init then
-           init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable);
+           init_procinfo:=gen_implicit_initfinal(mf_init,current_module.localsymtable);
 
          { Add symbol to the exports section for win32 so smartlinking a
            DLL will include the edata section }
          if assigned(exportlib) and
             (target_info.system in [system_i386_win32,system_i386_wdosx]) and
-            ((current_module.flags and uf_has_exports)<>0) then
+            (mf_has_exports in current_module.moduleflags) then
            current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',current_module.localsymtable,''),0));
 
          if (force_init_final or cnodeutils.force_final) and
@@ -2212,7 +2212,7 @@ type
                  release_proc_symbol(finalize_procinfo.procdef);
                  release_main_proc(finalize_procinfo);
                end;
-             finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
+             finalize_procinfo:=gen_implicit_initfinal(mf_finalize,current_module.localsymtable);
            end;
 
           { the finalization routine of libraries is generic (and all libraries need to }
@@ -2233,7 +2233,7 @@ type
          if assigned(init_procinfo) then
            begin
              { initialization can be implicit only }
-             current_module.flags:=current_module.flags or uf_init;
+             include(current_module.moduleflags,mf_init);
              init_procinfo.code:=cnodeutils.wrap_proc_body(init_procinfo.procdef,init_procinfo.code);
              init_procinfo.generate_code;
              init_procinfo.resetprocdef;
@@ -2247,7 +2247,7 @@ type
                begin
                  finalize_procinfo.code:=cnodeutils.wrap_proc_body(finalize_procinfo.procdef,finalize_procinfo.code);
                  finalize_procinfo.generate_code;
-                 current_module.flags:=current_module.flags or uf_finalize;
+                 include(current_module.moduleflags,mf_finalize);
                end;
              finalize_procinfo.resetprocdef;
              release_main_proc(finalize_procinfo);
@@ -2414,10 +2414,10 @@ type
                  hp:=tmodule(loaded_units.first);
                  while assigned(hp) do
                   begin
-                    if (hp<>sysinitmod) and (hp.flags and uf_in_library=0) then
+                    if (hp<>sysinitmod) and ((hp.headerflags and uf_in_library)=0) then
                       begin
                         linker.AddModuleFiles(hp);
-                        if (hp.flags and uf_checkpointer_called)<>0 then
+                        if mf_checkpointer_called in hp.moduleflags then
                           program_uses_checkpointer:=true;
                       end;
                     hp2:=tmodule(hp.next);

compiler/powerpc/cpupara.pas

@@ -381,11 +381,8 @@ unit cpupara;
               paradef := hp.vardef;
               { Syscall for Morphos can have already a paraloc set }
               if (vo_has_explicit_paraloc in hp.varoptions) then
-                begin
-                  if not(vo_is_syscall_lib in hp.varoptions) then
-                    internalerror(200412153);
-                  continue;
-                end;
+                continue;
+
               hp.paraloc[side].reset;
               { currently only support C-style array of const }
               if (p.proccalloption in cstylearrayofconst) and

compiler/ppu.pas

@@ -43,41 +43,24 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 206;
+  { only update this version if something change in the tppuheader:
+     * the unit flags listed below
+     * the format of the header itslf
+    This number cannot become bigger than 255 (it's stored in a byte) }
+  CurrentPPUVersion = 207;
+  { for any other changes to the ppu format, increase this version number
+    (it's a cardinal) }
+  CurrentPPULongVersion = 1;
 
 { unit flags }
-  uf_init                = $000001; { unit has initialization section }
-  uf_finalize            = $000002; { unit has finalization section   }
   uf_big_endian          = $000004;
-//uf_has_browser         = $000010;
   uf_in_library          = $000020; { is the file in another file than <ppufile>.* ? }
   uf_smart_linked        = $000040; { the ppu can be smartlinked }
   uf_static_linked       = $000080; { the ppu can be linked static }
   uf_shared_linked       = $000100; { the ppu can be linked shared }
-//uf_local_browser       = $000200;
-  uf_checkpointer_called = $000200; { Unit uses experimental checkpointer test code }
   uf_no_link             = $000400; { unit has no .o generated, but can still have external linking! }
-  uf_has_resourcestrings = $000800; { unit has resource string section }
   uf_little_endian       = $001000;
-  uf_release             = $002000; { unit was compiled with -Ur option }
-  uf_threadvars          = $004000; { unit has threadvars }
   uf_fpu_emulation       = $008000; { this unit was compiled with fpu emulation on }
-  uf_has_stabs_debuginfo = $010000; { this unit has stabs debuginfo generated }
-  uf_local_symtable      = $020000; { this unit has a local symtable stored }
-  uf_uses_variants       = $040000; { this unit uses variants }
-  uf_has_resourcefiles   = $080000; { this unit has external resources (using $R directive)}
-  uf_has_exports         = $100000; { this module or a used unit has exports }
-  uf_has_dwarf_debuginfo = $200000; { this unit has dwarf debuginfo generated }
-  uf_wideinits           = $400000; { this unit has winlike widestring typed constants }
-  uf_classinits          = $800000; { this unit has class constructors/destructors }
-  uf_resstrinits        = $1000000; { this unit has string consts referencing resourcestrings }
-  uf_i8086_far_code     = $2000000; { this unit uses an i8086 memory model with far code (i.e. medium, large or huge) }
-  uf_i8086_far_data     = $4000000; { this unit uses an i8086 memory model with far data (i.e. compact or large) }
-  uf_i8086_huge_data    = $8000000; { this unit uses an i8086 memory model with huge data (i.e. huge) }
-  uf_i8086_cs_equals_ds = $10000000; { this unit uses an i8086 memory model with CS=DS (i.e. tiny) }
-  uf_package_deny       = $20000000; { this unit must not be part of a package }
-  uf_package_weak       = $40000000; { this unit may be completely contained in a package }
-  uf_i8086_ss_equals_ds = $80000000; { this unit uses an i8086 memory model with SS=DS (i.e. tiny, small or medium) }
 
 type
   { bestreal is defined based on the target architecture }

compiler/riscv32/cpupara.pas

@@ -329,13 +329,7 @@ unit cpupara;
             begin
               hp:=tparavarsym(paras[i]);
               paradef := hp.vardef;
-              { Syscall for Morphos can have already a paraloc set }
-              if (vo_has_explicit_paraloc in hp.varoptions) then
-                begin
-                  if not(vo_is_syscall_lib in hp.varoptions) then
-                    internalerror(200412153);
-                  continue;
-                end;
+
               hp.paraloc[side].reset;
               { currently only support C-style array of const }
               if (p.proccalloption in cstylearrayofconst) and

compiler/scandir.pas

@@ -124,7 +124,7 @@ unit scandir;
       end;
 
 
-    procedure do_moduleflagswitch(flag:cardinal;optional:boolean);
+    procedure do_moduleflagswitch(flag:tmoduleflag;optional:boolean);
       var
         state : char;
       begin
@@ -133,9 +133,9 @@ unit scandir;
         else
           state:=current_scanner.readstate;
         if state='-' then
-          current_module.flags:=current_module.flags and not flag
+          exclude(current_module.moduleflags,flag)
         else
-          current_module.flags:=current_module.flags or flag;
+          include(current_module.moduleflags,flag);
       end;
 
 
@@ -472,7 +472,7 @@ unit scandir;
 
     procedure dir_denypackageunit;
       begin
-        do_moduleflagswitch(uf_package_deny,true);
+        do_moduleflagswitch(mf_package_deny,true);
       end;
 
     procedure dir_description;
@@ -1278,12 +1278,12 @@ unit scandir;
           s:=ChangeFileExt(s,target_info.resext);
         if target_info.res<>res_none then
           begin
-          current_module.flags:=current_module.flags or uf_has_resourcefiles;
-          if (res_single_file in target_res.resflags) and
-                                 not (Current_module.ResourceFiles.Empty) then
-            Message(scan_w_only_one_resourcefile_supported)
-          else
-            current_module.resourcefiles.insert(FixFileName(s));
+            include(current_module.moduleflags,mf_has_resourcefiles);
+            if (res_single_file in target_res.resflags) and
+                                   not (Current_module.ResourceFiles.Empty) then
+              Message(scan_w_only_one_resourcefile_supported)
+            else
+              current_module.resourcefiles.insert(FixFileName(s));
           end
         else
           Message(scan_e_resourcefiles_not_supported);
@@ -1727,7 +1727,7 @@ unit scandir;
       begin
         { old Delphi versions seem to use merely $WEAKPACKAGEUNIT while newer
           Delphis have $WEAPACKAGEUNIT ON... :/ }
-        do_moduleflagswitch(uf_package_weak, true);
+        do_moduleflagswitch(mf_package_weak, true);
       end;
 
     procedure dir_writeableconst;

compiler/systems.pas

@@ -350,13 +350,13 @@ interface
        systems_indirect_entry_information = systems_darwin+[system_i386_win32,system_x86_64_win64,system_x86_64_linux];
 
        { all systems for which weak linking has been tested/is supported }
-       systems_weak_linking = systems_darwin + systems_solaris + systems_linux + systems_android;
+       systems_weak_linking = systems_darwin + systems_solaris + systems_linux + systems_android + systems_openbsd;
 
        systems_internal_sysinit = [system_i386_win32,system_x86_64_win64,
                                    system_i386_linux,system_powerpc64_linux,system_sparc64_linux,system_x86_64_linux,
                                    system_m68k_atari,system_m68k_palmos,
                                    system_i386_haiku,system_x86_64_haiku,
-                                   system_x86_64_openbsd
+                                   system_i386_openbsd,system_x86_64_openbsd
                                   ]+systems_darwin+systems_amigalike;
 
        { all systems that use garbage collection for reference-counted types }

compiler/systems/t_bsd.pas

@@ -154,7 +154,7 @@ begin
      { Mac OS X doesn't have a /lib }
      LibrarySearchPath.AddPath(sysrootpath,'/usr/lib',true)
    else if target_info.system in systems_openbsd then
-     LibrarySearchPath.AddPath(sysrootpath,'/usr/lib;${X11BASE}/lib;${LOCALBASE}/lib',true)
+     LibrarySearchPath.AddPath(sysrootpath,'/usr/lib;$OPENBSD_X11BASE/lib;$OPENBSD_LOCALBASE/lib',true)
    else
      LibrarySearchPath.AddPath(sysrootpath,'/lib;/usr/lib;/usr/X11R6/lib',true);
 end;
@@ -173,8 +173,8 @@ begin
        begin
          if not(target_info.system in systems_darwin) then
            begin
-             ExeCmd[1]:='ld $TARGET $EMUL $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE $CATRES $FILELIST';
-             DllCmd[1]:='ld $TARGET $EMUL $OPT -shared -L. -o $EXE $CATRES $FILELIST'
+             ExeCmd[1]:='ld $TARGET $EMUL $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP $MAP -L. -o $EXE $CATRES $FILELIST';
+             DllCmd[1]:='ld $TARGET $EMUL $OPT $MAP -shared -L. -o $EXE $CATRES $FILELIST'
            end
          else
            begin
@@ -193,22 +193,22 @@ begin
                programs with problems that require Valgrind will have more
                than 60KB of data (first 4KB of address space is always invalid)
              }
-               ExeCmd[1]:='ld $PRTOBJ $TARGET $EMUL $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -multiply_defined suppress -L. -o $EXE $CATRES $FILELIST';
+               ExeCmd[1]:='ld $PRTOBJ $TARGET $EMUL $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP $MAP -multiply_defined suppress -L. -o $EXE $CATRES $FILELIST';
              if not(cs_gdb_valgrind in current_settings.globalswitches) then
                ExeCmd[1]:=ExeCmd[1]+' -pagezero_size 0x10000';
 {$else ndef cpu64bitaddr}
-             ExeCmd[1]:='ld $PRTOBJ $TARGET $EMUL $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -multiply_defined suppress -L. -o $EXE $CATRES $FILELIST';
+             ExeCmd[1]:='ld $PRTOBJ $TARGET $EMUL $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP $MAP -multiply_defined suppress -L. -o $EXE $CATRES $FILELIST';
 {$endif ndef cpu64bitaddr}
              if (apptype<>app_bundle) then
-               DllCmd[1]:='ld $PRTOBJ $TARGET $EMUL $OPT $GCSECTIONS -dynamic -dylib -multiply_defined suppress -L. -o $EXE $CATRES $FILELIST'
+               DllCmd[1]:='ld $PRTOBJ $TARGET $EMUL $OPT $GCSECTIONS $MAP -dynamic -dylib -multiply_defined suppress -L. -o $EXE $CATRES $FILELIST'
              else
-               DllCmd[1]:='ld $PRTOBJ $TARGET $EMUL $OPT $GCSECTIONS -dynamic -bundle -multiply_defined suppress -L. -o $EXE $CATRES $FILELIST'
+               DllCmd[1]:='ld $PRTOBJ $TARGET $EMUL $OPT $GCSECTIONS $MAP -dynamic -bundle -multiply_defined suppress -L. -o $EXE $CATRES $FILELIST'
            end
        end
      else
        begin
-         ExeCmd[1]:='ld $TARGET $EMUL $OPT $DYNLINK $STATIC  $GCSECTIONS $STRIP -L. -o $EXE $RES';
-         DllCmd[1]:='ld $TARGET $EMUL $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $RES';
+         ExeCmd[1]:='ld $TARGET $EMUL $OPT $DYNLINK $STATIC  $GCSECTIONS $STRIP $MAP -L. -o $EXE $RES';
+         DllCmd[1]:='ld $TARGET $EMUL $OPT $INIT $FINI $SONAME $MAP -shared -L. -o $EXE $RES';
        end;
      if not(target_info.system in systems_darwin) then
        DllCmd[2]:='strip --strip-unneeded $EXE'
@@ -616,7 +616,10 @@ begin
    begin
      if librarysearchpath.FindFile('crti.o',false,s) then
       LinkRes.AddFileName(s);
-     if cs_create_pic in current_settings.moduleswitches then
+     if ((cs_create_pic in current_settings.moduleswitches) and
+         not (target_info.system in systems_openbsd)) or
+        (current_module.islibrary and
+         (target_info.system in systems_openbsd)) then
        begin
          if librarysearchpath.FindFile('crtbeginS.o',false,s) then
            LinkRes.AddFileName(s);
@@ -740,7 +743,10 @@ begin
   if linklibc and
      not IsDarwin Then
    begin
-     if cs_create_pic in current_settings.moduleswitches then
+     if ((cs_create_pic in current_settings.moduleswitches) and
+         not (target_info.system in systems_openbsd)) or
+        (current_module.islibrary and
+         (target_info.system in systems_openbsd)) then
        Fl1:=librarysearchpath.FindFile('crtendS.o',false,s1)
      else
        Fl1:=librarysearchpath.FindFile('crtend.o',false,s1);
@@ -767,6 +773,7 @@ function TLinkerBSD.MakeExecutable:boolean;
 var
   binstr,
   cmdstr,
+  mapstr,
   targetstr,
   emulstr,
   extdbgbinstr,
@@ -788,6 +795,9 @@ begin
   DynLinkStr:='';
   GCSectionsStr:='';
   linkscript:=nil;
+  mapstr:='';
+  if (cs_link_map in current_settings.globalswitches) then
+    mapstr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename,'.map'));
   { i386_freebsd needs -b elf32-i386-freebsd and -m elf_i386_fbsd
     to avoid creation of a i386:x86_64 arch binary }
 
@@ -857,6 +867,7 @@ begin
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
   Replace(cmdstr,'$TARGET',targetstr);
   Replace(cmdstr,'$EMUL',EmulStr);
+  Replace(cmdstr,'$MAP',mapstr);
   Replace(cmdstr,'$CATRES',CatFileContent(outputexedir+Info.ResName));
   Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
   if (LdSupportsNoResponseFile) and (source_info.system in systems_all_windows) then
@@ -934,6 +945,7 @@ var
   linkscript: TAsmScript;
   binstr,
   cmdstr,
+  mapstr,
   targetstr,
   emulstr,
   extdbgbinstr,
@@ -944,6 +956,7 @@ var
 begin
   MakeSharedLibrary:=false;
   GCSectionsStr:='';
+  mapstr:='';
   linkscript:=nil;
   if not(cs_link_nolink in current_settings.globalswitches) then
    Message1(exec_i_linking,current_module.sharedlibfilename);
@@ -959,6 +972,9 @@ begin
     else
       GCSectionsStr:='-dead_strip -no_dead_strip_inits_and_terms';
 
+  if (cs_link_map in current_settings.globalswitches) then
+    mapstr:='-Map '+maybequoted(ChangeFileExt(current_module.sharedlibfilename,'.map'));
+
   { i386_freebsd needs -b elf32-i386-freebsd and -m elf_i386_fbsd
     to avoid creation of a i386:x86_64 arch binary }
 
@@ -997,6 +1013,7 @@ begin
   Replace(cmdstr,'$FINI',FiniStr);
   Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
   Replace(cmdstr,'$SONAME',SoNameStr);
+  Replace(cmdstr,'$MAP',mapstr);
   if (target_info.system in systems_darwin) then
     Replace(cmdstr,'$PRTOBJ',GetDarwinPrtobjName(true));
   BinStr:=FindUtil(utilsprefix+BinStr);

compiler/utils/ppumove.pp

@@ -247,7 +247,8 @@ Var
   f      : file;
   ext,
   s      : string;
-  ppuversion : dword;
+  ppuversion,
+  ppulongversion: dword;
 begin
   DoPPU:=false;
   If Not Quiet then
@@ -328,6 +329,18 @@ begin
      end;
     if b<>untilb then
      begin
+       if b=ibextraheader then
+         begin
+           ppulongversion:=cardinal(inppu.getlongint);
+           if ppulongversion<>CurrentPPULongVersion then
+             begin
+               inppu.free;
+               outppu.free;
+               Error('Error: Wrong PPU Long Version '+tostr(ppulongversion)+' in '+PPUFn,false);
+               Exit;
+             end;
+           outppu.putlongint(longint(ppulongversion));
+         end;
        repeat
          inppu.getdatabuf(buffer^,bufsize,l);
          outppu.putdata(buffer^,l);

compiler/utils/ppuutils/ppudump.pp

@@ -211,6 +211,9 @@ type
     ST_FILEINDEX,
     ST_LOADMESSAGES);
 
+  TPpuModuleDef = class(TPpuUnitDef)
+    ModuleFlags: tmoduleflags;
+  end;
 
 var
   ppufile     : tppufile;
@@ -222,7 +225,7 @@ var
   pout: TPpuOutput;
   nostdout: boolean;
   UnitList: TPpuContainerDef;
-  CurUnit: TPpuUnitDef;
+  CurUnit: TPpuModuleDef;
   SkipVersionCheck: boolean;
 
 
@@ -553,41 +556,17 @@ type
     str  : string[30];
   end;
 const
-  flagopts=32;
+  flagopts=8;
   flagopt : array[1..flagopts] of tflagopt=(
-    (mask: $1    ;str:'init'),
-    (mask: $2    ;str:'final'),
     (mask: $4    ;str:'big_endian'),
-    (mask: $8    ;str:'dbx'),
 //    (mask: $10   ;str:'browser'),
     (mask: $20   ;str:'in_library'),
     (mask: $40   ;str:'smart_linked'),
     (mask: $80   ;str:'static_linked'),
     (mask: $100  ;str:'shared_linked'),
-    (mask: $200  ;str:'uses_checkpointer'),
     (mask: $400  ;str:'no_link'),
-    (mask: $800  ;str:'has_resources'),
     (mask: $1000  ;str:'little_endian'),
-    (mask: $2000  ;str:'release'),
-    (mask: $4000  ;str:'local_threadvars'),
-    (mask: $8000  ;str:'fpu_emulation_on'),
-    (mask: $210000  ;str:'has_debug_info'),
-    (mask: $10000  ;str:'stabs_debug_info'),
-    (mask: $200000  ;str:'dwarf_debug_info'),
-    (mask: $20000  ;str:'local_symtable'),
-    (mask: $40000  ;str:'uses_variants'),
-    (mask: $80000  ;str:'has_resourcefiles'),
-    (mask: $100000  ;str:'has_exports'),
-    (mask: $400000  ;str:'has_wideinits'),
-    (mask: $800000  ;str:'has_classinits'),
-    (mask: $1000000 ;str:'has_resstrinits'),
-    (mask: $2000000 ;str:'i8086_far_code'),
-    (mask: $4000000 ;str:'i8086_far_data'),
-    (mask: $8000000 ;str:'i8086_huge_data'),
-    (mask: $10000000;str:'i8086_cs_equals_ds'),
-    (mask: $20000000;str:'package_deny'),
-    (mask: $40000000;str:'package_weak'),
-    (mask: dword($80000000);str:'i8086_ss_equals_ds')
+    (mask: $8000  ;str:'fpu_emulation_on')
   );
 var
   i : longint;
@@ -3728,6 +3707,13 @@ begin
        b:=readentry;
        case b of
 
+         ibextraheader:
+           begin
+             CurUnit.LongVersion:=cardinal(getlongint);
+             Writeln(['LongVersion: ',CurUnit.LongVersion]);
+             getsmallset(CurUnit.ModuleFlags);
+           end;
+
          ibmodulename :
            begin
              CurUnit.Name:=getstring;
@@ -3903,6 +3889,24 @@ begin
 end;
 
 
+function parseextraheader(module: TPpuModuleDef; ppufile: tppufile): boolean;
+var
+  b: byte;
+begin
+  result:=true;
+  if ppuversion>=207 then
+    begin
+      result:=false;
+      b:=ppufile.readentry;
+      if b<>ibextraheader then
+        exit;
+      CurUnit.LongVersion:=cardinal(ppufile.getlongint);
+      Writeln(['LongVersion: ',CurUnit.LongVersion]);
+      ppufile.getsmallset(CurUnit.ModuleFlags);
+      result:=ppufile.EndOfEntry;
+    end;
+end;
+
 procedure dofile (filename : string);
 begin
 { reset }
@@ -3938,9 +3942,14 @@ begin
      exit;
    end;
 
-  CurUnit:=TPpuUnitDef.Create(UnitList);
+  CurUnit:=TPpuModuleDef.Create(UnitList);
   CurUnit.Version:=ppuversion;
 
+  if not parseextraheader(CurUnit, ppufile) then
+    begin
+      WriteError(Format('Unsupported PPU sub-version %d. Expecting PPU sub-version %d.', [CurUnit.LongVersion, CurrentPPULongVersion]));
+    end;
+
 { Write PPU Header Information }
   if (verbose and v_header)<>0 then
    begin
@@ -4051,7 +4060,7 @@ begin
   Writeln('Implementation symtable');
   Writeln('----------------------');
   readsymtableoptions('implementation');
-  if (ppufile.header.common.flags and uf_local_symtable)<>0 then
+  if (mf_local_symtable in CurUnit.ModuleFlags) then
    begin
      if (verbose and v_defs)<>0 then
       begin

compiler/utils/ppuutils/ppuout.pp

@@ -177,6 +177,7 @@ type
     UsedUnits: TPpuContainerDef;
     RefUnits: array of string;
     SourceFiles: TPpuContainerDef;
+    LongVersion: Cardinal;
 
     constructor Create(AParent: TPpuContainerDef); override;
     destructor Destroy; override;

compiler/x86/cgx86.pas

@@ -3229,13 +3229,11 @@ unit cgx86;
         {$endif}
            system_i386_freebsd,
            system_i386_netbsd,
-//         system_i386_openbsd,
            system_i386_wdosx :
              begin
                 Case target_info.system Of
                  system_i386_freebsd : mcountprefix:='.';
                  system_i386_netbsd : mcountprefix:='__';
-//               system_i386_openbsd : mcountprefix:='.';
                 else
                  mcountPrefix:='';
                 end;
@@ -3263,6 +3261,11 @@ unit cgx86;
              begin
                a_call_name(list,'mcount',false);
              end;
+           system_i386_openbsd,
+           system_x86_64_openbsd:
+             begin
+               a_call_name(list,'__mcount',false);
+             end;
         end;
       end;
 

packages/arosunits/src/asl.pas

@@ -497,34 +497,28 @@ const
 var
   ASLBase: PLibrary;
 
-function AllocAslRequestA(ReqType: LongWord; TagList: PTagItem): Pointer; syscall ASLBase 8;
+function AllocAslRequest(ReqType: LongWord; TagList: PTagItem): Pointer; syscall ASLBase 8;
 function AllocFileRequest: PFileRequester; syscall ASLBase 5;
-function AslRequestA(Requester: Pointer; TagList: PTagItem): LongBool; syscall ASLBase 10;
+function AslRequest(Requester: Pointer; TagList: PTagItem): LongBool; syscall ASLBase 10;
 procedure FreeAslRequest(Requester: Pointer); syscall ASLBase 9;
 procedure FreeFileRequest(FileReq: PFileRequester); syscall ASLBase 6;
 function RequestFile(FileReq: PFileRequester): LongBool; syscall ASLBase 7;
 procedure AbortAslRequest(Requester: Pointer); syscall ASLBase 13;
 procedure ActivateAslRequest(Requester: Pointer); syscall ASLBase 14;
 
-function AllocAslRequest(ReqType: LongWord; const Tags: array of PtrUInt): Pointer;
-function AslRequest(Requester: Pointer; const Tags: array of PtrUInt): LongBool;
-function AslRequestTags(Requester: Pointer; const Tags: array of PtrUInt): LongBool;
+function AllocAslRequestTags(ReqType: LongWord; const Tags: array of PtrUInt): Pointer; inline;
+function AslRequestTags(Requester: Pointer; const Tags: array of PtrUInt): LongBool; inline;
 
 implementation
 
-function AllocAslRequest(ReqType: LongWord; const Tags: array of PtrUInt): Pointer; inline;
-begin
-  AllocAslRequest := AllocAslRequestA(reqType, @Tags);
-end;
-
-function AslRequest(Requester: Pointer; const Tags: array of PtrUInt): LongBool; inline;
+function AllocAslRequestTags(ReqType: LongWord; const Tags: array of PtrUInt): Pointer; inline;
 begin
-  AslRequest := AslRequestA(Requester, @Tags);
+  AllocAslRequestTags := AllocAslRequest(ReqType, @Tags);
 end;
 
 function AslRequestTags(Requester: Pointer; const Tags: array of PtrUInt): LongBool; inline;
 begin
-  AslRequestTags := AslRequestA(Requester, @Tags);
+  AslRequestTags := AslRequest(Requester, @Tags);
 end;
 
 initialization

packages/fcl-db/src/base/dsparams.inc

@@ -428,7 +428,7 @@ begin
     for i:=0 to High(ParamPart) do
     begin
       CopyLen:=ParamPart[i].Start-BufIndex;
-      Move(SQL[BufIndex],NewQuery[NewQueryIndex],CopyLen);
+      System.Move(SQL[BufIndex],NewQuery[NewQueryIndex],CopyLen);
       Inc(NewQueryIndex,CopyLen);
       case ParameterStyle of
         psInterbase : begin
@@ -454,7 +454,7 @@ begin
     end;
     CopyLen:=Length(SQL)+1-BufIndex;
     if CopyLen > 0 then
-      Move(SQL[BufIndex],NewQuery[NewQueryIndex],CopyLen);
+      System.Move(SQL[BufIndex],NewQuery[NewQueryIndex],CopyLen);
   end
   else
     NewQuery:=SQL;

packages/fcl-db/src/base/sqlscript.pp

@@ -641,28 +641,33 @@ begin
 end;
 
 procedure TCustomSQLScript.DefaultDirectives;
+
+  Procedure Add(S : String);
+  
+  begin
+    if FDirectives.IndexOf(S)=-1 then
+      FDirectives.Add(S);
+  end;
+
 begin
-  With FDirectives do
-    begin
-    // Insertion order matters as testing for directives will be done with StartsWith
-    if FUseSetTerm then
-      Add('SET TERM');
-    if FUseCommit then
+  // Insertion order matters as testing for directives will be done with StartsWith
+  if FUseSetTerm then
+    Add('SET TERM');
+  if FUseCommit then
+  begin
+    Add('COMMIT WORK'); {SQL Standard, equivalent to commit}
+    Add('COMMIT RETAIN'); {Firebird/Interbase; probably won't hurt on other dbs}
+    Add('COMMIT'); {Shorthand used in many dbs, e.g. Firebird}
+  end;
+  if FUseDefines then
     begin
-      Add('COMMIT WORK'); {SQL Standard, equivalent to commit}
-      Add('COMMIT RETAIN'); {Firebird/Interbase; probably won't hurt on other dbs}
-      Add('COMMIT'); {Shorthand used in many dbs, e.g. Firebird}
-    end;
-    if FUseDefines then
-      begin
-      Add('#IFDEF');
-      Add('#IFNDEF');
-      Add('#ELSE');
-      Add('#ENDIF');
-      Add('#DEFINE');
-      Add('#UNDEF');
-      Add('#UNDEFINE');
-      end;
+    Add('#IFDEF');
+    Add('#IFNDEF');
+    Add('#ELSE');
+    Add('#ENDIF');
+    Add('#DEFINE');
+    Add('#UNDEF');
+    Add('#UNDEFINE');
     end;
 end;
 

packages/fcl-image/examples/imgconv.pp

@@ -17,7 +17,7 @@ program ImgConv;
 
 {_$define UseFile}
 
-uses FPWriteXPM, FPWritePNG, FPWriteBMP,fpreadgif,
+uses FPWriteXPM, FPWritePNG, FPWriteBMP,fpreadgif,fptiffcmn,
      FPReadXPM, FPReadPNG, FPReadBMP, fpreadjpeg,fpwritejpeg,
      fpreadtga,fpwritetga,fpreadpnm,fpwritepnm, fpreadtiff, fpwritetiff,
      {$ifndef UseFile}classes,{$endif}
@@ -132,6 +132,19 @@ begin
       writeln ('Grayscale ',Grayscale, ' - Indexed ',Indexed,
                ' - WordSized ',WordSized,' - UseAlpha ',UseAlpha);
       end
+  else if (t[1] = 'F') then
+    with (Writer as TFPWriterTiff) do
+      begin
+      if pos ('G', t) > 0 then
+         begin
+         Img.Extra[TiffPhotoMetric]:='0';
+         if Pos('8',T)>0 then
+           Img.Extra[TiffGrayBits]:='8'
+         else if Pos('16',T)>0 then
+           Img.Extra[TiffGrayBits]:='16';
+         Writeln(TiffPhotoMetric,': 0 ',TiffGrayBits,': ',Img.Extra[TiffGrayBits]);
+         end;
+      end
   else if (t[1] = 'X') then
     begin
     if length(t) > 1 then
@@ -162,6 +175,8 @@ begin
     writeln ('Options for');
     writeln ('  PNG :  G : grayscale, A : use alpha, ');
     writeln ('         I : Indexed in palette, W : Word sized.');
+    writeln ('  TIFF :  G16 write grayscale 16 bits/pixel');
+    writeln ('          G8 write grayscale 16 bits/pixel');
     writeln ('  XPM :  Number of chars to use for 1 pixel');
     writeln ('  The color size of an XPM can be set after the X as 1,2,3 or 4');
     writeln ('example: imgconv hello.xpm PIA hello.png');

packages/fcl-passrc/src/pasresolver.pp

@@ -2,7 +2,7 @@
     This file is part of the Free Component Library
 
     Pascal resolver
-    Copyright (c) 2018  Mattias Gaertner  [email protected]
+    Copyright (c) 2019  Mattias Gaertner  [email protected]
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.

packages/fcl-pdf/src/fppdf.pp

@@ -1026,6 +1026,7 @@ type
     procedure SetFonts(AValue: TPDFFontDefs);
     procedure SetInfos(AValue: TPDFInfos);
     procedure SetLineStyles(AValue: TPDFLineStyleDefs);
+    Procedure SetOptions(aValue : TPDFOptions);
   protected
     // Create all kinds of things, virtual so they can be overridden to create descendents instead
     function CreatePDFPages: TPDFPages; virtual;
@@ -1126,7 +1127,7 @@ type
     Property ObjectCount : Integer Read FObjectCount;
     Property LineCapStyle: TPDFLineCapStyle Read FLineCapStyle Write FLineCapStyle;
   Published
-    Property Options : TPDFOptions Read FOptions Write FOPtions;
+    Property Options : TPDFOptions Read FOptions Write SetOptions;
     Property LineStyles : TPDFLineStyleDefs Read FLineStyleDefs Write SetLineStyles;
     property PageLayout: TPDFPageLayout read FPageLayout write FPageLayout default lSingle;
     Property Infos : TPDFInfos Read FInfos Write SetInfos;
@@ -1686,14 +1687,30 @@ var
   s: string;
   lst: TTextMappingList;
   lFont: TTFFileInfo;
+  lWidthIndex: integer;
 begin
   s := '';
   lst := Document.Fonts[EmbeddedFontNum].TextMapping;
   lst.Sort;
   lFont := Document.Fonts[EmbeddedFontNum].FTrueTypeFile;
-  // use decimal values for the output
+
+  {$IFDEF gdebug}
+  System.WriteLn('****** isFixedPitch = ', BoolToStr(lFont.PostScript.isFixedPitch > 0, True));
+  System.WriteLn('****** Head.UnitsPerEm := ', lFont.Head.UnitsPerEm );
+  System.WriteLn('****** HHead.numberOfHMetrics := ', lFont.HHead.numberOfHMetrics );
+  {$ENDIF}
+
+  { NOTE: Monospaced fonts may not have a width for every glyph
+          the last one is for subsequent glyphs.  }
   for i := 0 to lst.Count-1 do
-    s :=  s + Format(' %d [%d]', [ lst[i].GlyphID, TTTFFriendClass(lFont).ToNatural(lFont.Widths[lst[i].GlyphID].AdvanceWidth)]);
+  begin
+    if lst[i].GlyphID < lFont.HHead.numberOfHMetrics then
+      lWidthIndex := lst[i].GlyphID
+    else
+      lWidthIndex := lFont.HHead.numberOfHMetrics-1;
+    s :=  s + Format(' %d [%d]', [lst[i].GlyphID, TTTFFriendClass(lFont).ToNatural(lFont.Widths[lWidthIndex].AdvanceWidth)])
+  end;
+
   WriteString(s, AStream);
 end;
 
@@ -4488,6 +4505,14 @@ begin
   FInfos.Assign(AValue);
 end;
 
+procedure TPDFDocument.SetOptions(AValue: TPDFOptions);
+begin
+  if FOptions=AValue then Exit;
+  if (poNoEmbeddedFonts in  aValue) then
+    Exclude(aValue,poSubsetFont);
+  FOptions:=aValue;
+end;
+
 procedure TPDFDocument.SetLineStyles(AValue: TPDFLineStyleDefs);
 begin
   if FLineStyleDefs=AValue then Exit;

packages/fcl-pdf/utils/ttfdump.lpr

@@ -37,6 +37,21 @@ type
 { TMyApplication }
 
 procedure TMyApplication.DumpGlyphIndex;
+
+  procedure PrintGlyphWidth(const aIndex: UInt32);
+  var
+    lWidthIndex: integer;
+  begin
+    { NOTE: Monospaced fonts may not have a width for every glyph
+            the last one is for subsequent glyphs.  }
+    if aIndex < FFontFile.HHead.numberOfHMetrics then
+      lWidthIndex := FFontFile.Chars[aIndex]
+    else
+      lWidthIndex := FFontFile.HHead.numberOfHMetrics-1;
+
+    Writeln(Format('  %3d = %d', [FFontFile.Chars[aIndex], TFriendClass(FFontFile).ToNatural(FFontFile.Widths[lWidthIndex].AdvanceWidth)]));
+  end;
+
 begin
   Writeln('FHHead.numberOfHMetrics = ', FFontFile.HHead.numberOfHMetrics);
   Writeln('Length(Chars[]) = ', Length(FFontFile.Chars));
@@ -47,9 +62,9 @@ begin
   Writeln('  U+0048 (H) = ', Format('%d  (%0:4.4x)', [FFontFile.Chars[$0048]]));
   writeln;
   Writeln('Glyph widths:');
-  Writeln('  3 = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0020]].AdvanceWidth));
-  Writeln('  4 = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0021]].AdvanceWidth));
-  Writeln('  H = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0048]].AdvanceWidth));
+  PrintGlyphWidth($0020);
+  PrintGlyphWidth($0021);
+  PrintGlyphWidth($0048);
 end;
 
 function TMyApplication.GetGlyphIndices(const AText: UnicodeString): TTextMappingList;
@@ -121,6 +136,7 @@ begin
   end;
 
   FFontFile.LoadFromFile(self.GetOptionValue('f'));
+  Writeln('Postscript.IsFixedPitch = ', BoolToStr(FFontFile.PostScript.isFixedPitch > 0, True));
   DumpGlyphIndex;
 
   // test #1

packages/fcl-registry/examples/testunicode.lpi

@@ -0,0 +1,58 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="testunicode"/>
+      <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="testunicode.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="testunicode"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-registry/examples/testunicode.pp

@@ -1,11 +1,16 @@
 program testunicode;
 
+{ Unicode test program using UTF8String }
+
 {$mode objfpc}{$H+}
 {$codepage utf8}
 {$IFNDEF UNIX}
 {$APPTYPE CONSOLE}
 {$ENDIF}
 uses
+{$ifdef unix}
+  cwstring,
+{$endif}
   sysutils, classes, registry;
 
 Var

packages/fcl-registry/examples/testunicode2.lpi

@@ -0,0 +1,60 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="testunicode2"/>
+      <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="testunicode2.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="testunicode2"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-registry/examples/testunicode2.pas

@@ -0,0 +1,262 @@
+program testunicode2;
+
+{ Unicode test program, using unicode strings }
+
+{$mode objfpc}{$H+}
+{$codepage utf8}
+{$IFNDEF UNIX}
+{$APPTYPE CONSOLE}
+{$ENDIF}
+uses
+{$ifdef unix}
+  cwstring,
+{$endif}
+  sysutils, classes, registry;
+
+Var
+  EditKey : Unicodestring = 'ASCII;这是一个测试';
+  labeledEditName : Unicodestring = 'ASCII;പേര് ഇതാണ്ASCII;这是一个测试';
+  labeledEditValue : Unicodestring = 'これは値です;ASCII';
+  labelkeycaption : UnicodeString = 'HKCU\Software\zzz_test\';
+  reg: TRegistry;
+  Results : TStrings;
+
+
+
+function TestKey (const AKey: UnicodeString): boolean;
+begin
+  Result:=false;
+  try
+    reg.CloseKey;
+    if reg.KeyExists(AKey) then
+      reg.DeleteKey(AKey);
+    if reg.KeyExists(AKey) then
+    begin
+      Results.Add('TestKey-01 failed: DeleteKey(%s);',[AKey]);
+      exit;
+    end;
+    if not reg.OpenKey(AKey,true) then
+    begin
+      Results.Add('TestKey-02 failed: OpenKey(%s,true)',[AKey]);
+      exit;
+    end;
+    reg.CloseKey;
+    if not reg.KeyExists(AKey) then
+    begin
+      Results.Add('TestKey-03 failed: OpenKey(%s,true)',[AKey]);
+      exit;
+    end;
+    reg.DeleteKey(AKey);
+    if not reg.CreateKey(AKey) then
+    begin
+      Results.Add('TestKey-04 failed: CreateKey(%s)',[AKey]);
+      exit;
+    end;
+    if not reg.KeyExists(AKey) then
+    begin
+      Results.Add('TestKey-05 failed: CreateKey(%s,true)',[AKey]);
+      exit;
+    end;
+    if not reg.OpenKeyReadOnly(AKey) then
+    begin
+      Results.Add('TestKey-06 failed: OpenKeyReadOnly(%s)',[AKey]);
+      exit;
+    end;
+    reg.CloseKey;
+    if not reg.OpenKey(AKey,false) then
+    begin
+      Results.Add('TestKey-07 failed: OpenKey(%s,false)',[AKey]);
+      exit;
+    end;
+
+    Results.Add('TestKey           passed: %s',[AKey]);
+
+  except
+    on e:Exception do
+      Results.Add('TestKey-08 failed: %s; %s;',[AKey,e.Message]);
+  end;
+
+  Result:=true;
+
+end;
+
+procedure TestValue (const AName, AValue: Unicodestring);
+var
+  wrong,s: unicodestring;
+begin
+  try
+    wrong:=AName+'_wrong';
+    if reg.ValueExists(wrong) then
+      reg.DeleteValue(wrong);
+    if reg.ValueExists(wrong) then
+    begin
+      Results.Add('TestValue-01 failed: DeleteValue(%s)',[wrong]);
+      exit;
+    end;
+    reg.WriteString(wrong,AValue);
+    s:=reg.ReadString(wrong);
+    if s<>AValue then
+    begin
+      Results.Add('TestValue-02 failed: WriteString(%s,%s)',[wrong,AValue]);
+      exit;
+    end;
+
+    if reg.ValueExists(AName) then
+      reg.DeleteValue(AName);
+    if reg.ValueExists(AName) then
+    begin
+      Results.Add('TestValue-03 failed: DeleteValue(%s)',[AName]);
+      exit;
+    end;
+
+    reg.RenameValue(wrong,AName);
+    s:=reg.ReadString(AName);
+    if s<>AValue then
+    begin
+      Results.Add('TestValue-04 failed: RenameValue(%s,%s)',[wrong,AName]);
+      exit;
+    end;
+
+    Results.Add('TestValue         passed: %s; %s;',[AName,AValue]);
+
+  except
+    on e:Exception do
+      Results.Add('TestValue-08 failed: %s; %s; %s;',[AName,AValue,e.Message]);
+  end;
+end;
+
+procedure TestGetKeyNames (const AKey, AExpected: Unicodestring);
+var
+  sl: TStringList;
+begin
+  sl:=TStringList.Create;
+  sl.Delimiter:=';';
+  reg.CloseKey;
+  try
+    if not reg.OpenKeyReadOnly(AKey) then
+    begin
+      Results.Add('TestGetKeyNames-01 failed: Key "%s";',[AKey]);
+      exit;
+    end;
+    reg.GetKeyNames(sl);
+    if Utf8Decode(sl.DelimitedText)=AExpected then
+      Results.Add('TestGetKeyNames   passed: Key: "%s"; Expected: "%s";',[AKey,AExpected])
+    else
+      Results.Add('TestGetKeyNames-02 failed: Key: "%s"; got: "%s"; expected: "%s";',
+                           [AKey,sl.DelimitedText,AExpected]);
+  except
+    on e:Exception do
+      Results.Add('TestGetKeyNames-03 failed exception: Key: "%s"; Got: "%s"; Expected: "%s"; Exception: "%s";',
+                           [AKey,sl.DelimitedText,AExpected,e.Message]);
+  end;
+  sl.Free;
+end;
+
+procedure TestGetValueNames (const AKey, AExpected: Unicodestring);
+var
+  sl: TStringList;
+begin
+  sl:=TStringList.Create;
+  sl.Delimiter:=';';
+  try
+    reg.GetValueNames(sl);
+    if Utf8Decode(sl.DelimitedText)=AExpected then
+      Results.Add('TestGetValueNames passed: Key: "%s"; Expected "%s";',[AKey,AExpected])
+    else
+      Results.Add('TestGetValueNames-01 failed: Key "%s"; Got: "%s"; Expected: "%s";',
+                           [AKey,sl.DelimitedText,AExpected]);
+  except
+    on e:Exception do
+      Results.Add('TestGetValueNames-02 failed exception: Key: "%s"; Got: "%s"; expected: "%s"; exception: "%s";',
+                           [AKey,sl.DelimitedText,AExpected,e.Message]);
+  end;
+  sl.Free;
+end;
+
+procedure Test;
+var
+  sKey:        Unicodestring;
+  slKeys,
+  slNames,
+  slValues:    TStringList;
+  sValueNames,
+  s:           Unicodestring;
+  k,n,v:       integer;
+  l:           longint;
+begin
+  sKey:=LabelKeyCaption;
+  l:=pos('\',LabelKeyCaption);
+  if l>0 then
+    delete(sKey,1,l);
+  if sKey[Length(sKey)]='\' then
+    SetLength(sKey,Length(sKey)-1);
+
+  slKeys:=TStringList.Create;
+  slKeys.Delimiter:=';';
+  slKeys.DelimitedText:=Utf8Encode(EditKey);
+
+  slNames:=TStringList.Create;
+  slNames.Delimiter:=';';
+  slNames.DelimitedText:=Utf8Encode(LabeledEditName);
+
+  slValues:=TStringList.Create;
+  slValues.Delimiter:=';';
+  slValues.DelimitedText:=Utf8Encode(LabeledEditValue);
+  
+  for k:=0 to slKeys.Count-1 do
+    if TestKey(sKey+'\'+Utf8Decode(slKeys[k])) then
+    begin
+      sValueNames:='';
+      for n:=0 to slNames.Count-1 do
+        for v:=0 to slValues.Count-1 do
+        begin
+          s:=UnicodeFormat('%d%d%d_%s',[k,n,v,Utf8Decode(slNames[n])]);
+          if sValueNames='' then
+            sValueNames:=s
+          else
+            sValueNames:=sValueNames+Utf8Decode(slNames.Delimiter)+s;
+          TestValue(s,Utf8Decode(slValues[v]));
+        end;
+      TestGetValueNames(reg.CurrentPath,sValueNames);
+    end;
+
+  TestGetKeyNames(sKey,Utf8Decode(slKeys.DelimitedText));
+
+  reg.CloseKey;
+
+  slKeys.Free;
+  slNames.Free;
+  slValues.Free;
+end;
+
+Procedure WN;
+Var
+  F : Text;
+
+
+begin
+  Assign(F,'names.txt');
+  Rewrite(F);
+  Writeln(F,EditKey);
+  Writeln(F,labeledEditName);
+  Writeln(F,LabeledEditValue);
+  Writeln(F,LabelKeyCaption);
+  Close(F);
+end;
+
+begin
+  defaultsystemcodepage:=CP_UTF8;
+  if (ParamStr(1)='-s') then
+    WN;
+  reg:=TRegistry.Create;
+  reg.lazywrite:=false;
+  Results:=TStringList.Create;
+  Test;
+  Reg.Free;
+  if (ParamStr(1)='-s') then
+    Results.SaveToFile('result.txt');
+  Writeln(Results.Text);
+  Results.Free;
+  {$IFDEF WINDOWS}Readln;{$ENDIF}
+end.
+

packages/fcl-registry/examples/testunicode2.pp

@@ -0,0 +1,262 @@
+program testunicode2;
+
+{ Unicode test program, using unicode strings }
+
+{$mode objfpc}{$H+}
+{$codepage utf8}
+{$IFNDEF UNIX}
+{$APPTYPE CONSOLE}
+{$ENDIF}
+uses
+{$ifdef unix}
+  cwstring,
+{$endif}
+  sysutils, classes, registry;
+
+Var
+  EditKey : Unicodestring = 'ASCII;这是一个测试';
+  labeledEditName : Unicodestring = 'ASCII;പേര് ഇതാണ്ASCII;这是一个测试';
+  labeledEditValue : Unicodestring = 'これは値です;ASCII';
+  labelkeycaption : UnicodeString = 'HKCU\Software\zzz_test\';
+  reg: TRegistry;
+  Results : TStrings;
+
+
+
+function TestKey (const AKey: UnicodeString): boolean;
+begin
+  Result:=false;
+  try
+    reg.CloseKey;
+    if reg.KeyExists(AKey) then
+      reg.DeleteKey(AKey);
+    if reg.KeyExists(AKey) then
+    begin
+      Results.Add('TestKey-01 failed: DeleteKey(%s);',[AKey]);
+      exit;
+    end;
+    if not reg.OpenKey(AKey,true) then
+    begin
+      Results.Add('TestKey-02 failed: OpenKey(%s,true)',[AKey]);
+      exit;
+    end;
+    reg.CloseKey;
+    if not reg.KeyExists(AKey) then
+    begin
+      Results.Add('TestKey-03 failed: OpenKey(%s,true)',[AKey]);
+      exit;
+    end;
+    reg.DeleteKey(AKey);
+    if not reg.CreateKey(AKey) then
+    begin
+      Results.Add('TestKey-04 failed: CreateKey(%s)',[AKey]);
+      exit;
+    end;
+    if not reg.KeyExists(AKey) then
+    begin
+      Results.Add('TestKey-05 failed: CreateKey(%s,true)',[AKey]);
+      exit;
+    end;
+    if not reg.OpenKeyReadOnly(AKey) then
+    begin
+      Results.Add('TestKey-06 failed: OpenKeyReadOnly(%s)',[AKey]);
+      exit;
+    end;
+    reg.CloseKey;
+    if not reg.OpenKey(AKey,false) then
+    begin
+      Results.Add('TestKey-07 failed: OpenKey(%s,false)',[AKey]);
+      exit;
+    end;
+
+    Results.Add('TestKey           passed: %s',[AKey]);
+
+  except
+    on e:Exception do
+      Results.Add('TestKey-08 failed: %s; %s;',[AKey,e.Message]);
+  end;
+
+  Result:=true;
+
+end;
+
+procedure TestValue (const AName, AValue: Unicodestring);
+var
+  wrong,s: unicodestring;
+begin
+  try
+    wrong:=AName+'_wrong';
+    if reg.ValueExists(wrong) then
+      reg.DeleteValue(wrong);
+    if reg.ValueExists(wrong) then
+    begin
+      Results.Add('TestValue-01 failed: DeleteValue(%s)',[wrong]);
+      exit;
+    end;
+    reg.WriteString(wrong,AValue);
+    s:=reg.ReadString(wrong);
+    if s<>AValue then
+    begin
+      Results.Add('TestValue-02 failed: WriteString(%s,%s)',[wrong,AValue]);
+      exit;
+    end;
+
+    if reg.ValueExists(AName) then
+      reg.DeleteValue(AName);
+    if reg.ValueExists(AName) then
+    begin
+      Results.Add('TestValue-03 failed: DeleteValue(%s)',[AName]);
+      exit;
+    end;
+
+    reg.RenameValue(wrong,AName);
+    s:=reg.ReadString(AName);
+    if s<>AValue then
+    begin
+      Results.Add('TestValue-04 failed: RenameValue(%s,%s)',[wrong,AName]);
+      exit;
+    end;
+
+    Results.Add('TestValue         passed: %s; %s;',[AName,AValue]);
+
+  except
+    on e:Exception do
+      Results.Add('TestValue-08 failed: %s; %s; %s;',[AName,AValue,e.Message]);
+  end;
+end;
+
+procedure TestGetKeyNames (const AKey, AExpected: Unicodestring);
+var
+  sl: TStringList;
+begin
+  sl:=TStringList.Create;
+  sl.Delimiter:=';';
+  reg.CloseKey;
+  try
+    if not reg.OpenKeyReadOnly(AKey) then
+    begin
+      Results.Add('TestGetKeyNames-01 failed: Key "%s";',[AKey]);
+      exit;
+    end;
+    reg.GetKeyNames(sl);
+    if Utf8Decode(sl.DelimitedText)=AExpected then
+      Results.Add('TestGetKeyNames   passed: Key: "%s"; Expected: "%s";',[AKey,AExpected])
+    else
+      Results.Add('TestGetKeyNames-02 failed: Key: "%s"; got: "%s"; expected: "%s";',
+                           [AKey,sl.DelimitedText,AExpected]);
+  except
+    on e:Exception do
+      Results.Add('TestGetKeyNames-03 failed exception: Key: "%s"; Got: "%s"; Expected: "%s"; Exception: "%s";',
+                           [AKey,sl.DelimitedText,AExpected,e.Message]);
+  end;
+  sl.Free;
+end;
+
+procedure TestGetValueNames (const AKey, AExpected: Unicodestring);
+var
+  sl: TStringList;
+begin
+  sl:=TStringList.Create;
+  sl.Delimiter:=';';
+  try
+    reg.GetValueNames(sl);
+    if Utf8Decode(sl.DelimitedText)=AExpected then
+      Results.Add('TestGetValueNames passed: Key: "%s"; Expected "%s";',[AKey,AExpected])
+    else
+      Results.Add('TestGetValueNames-01 failed: Key "%s"; Got: "%s"; Expected: "%s";',
+                           [AKey,sl.DelimitedText,AExpected]);
+  except
+    on e:Exception do
+      Results.Add('TestGetValueNames-02 failed exception: Key: "%s"; Got: "%s"; expected: "%s"; exception: "%s";',
+                           [AKey,sl.DelimitedText,AExpected,e.Message]);
+  end;
+  sl.Free;
+end;
+
+procedure Test;
+var
+  sKey:        Unicodestring;
+  slKeys,
+  slNames,
+  slValues:    TStringList;
+  sValueNames,
+  s:           Unicodestring;
+  k,n,v:       integer;
+  l:           longint;
+begin
+  sKey:=LabelKeyCaption;
+  l:=pos('\',LabelKeyCaption);
+  if l>0 then
+    delete(sKey,1,l);
+  if sKey[Length(sKey)]='\' then
+    SetLength(sKey,Length(sKey)-1);
+
+  slKeys:=TStringList.Create;
+  slKeys.Delimiter:=';';
+  slKeys.DelimitedText:=Utf8Encode(EditKey);
+
+  slNames:=TStringList.Create;
+  slNames.Delimiter:=';';
+  slNames.DelimitedText:=Utf8Encode(LabeledEditName);
+
+  slValues:=TStringList.Create;
+  slValues.Delimiter:=';';
+  slValues.DelimitedText:=Utf8Encode(LabeledEditValue);
+  
+  for k:=0 to slKeys.Count-1 do
+    if TestKey(sKey+'\'+Utf8Decode(slKeys[k])) then
+    begin
+      sValueNames:='';
+      for n:=0 to slNames.Count-1 do
+        for v:=0 to slValues.Count-1 do
+        begin
+          s:=UnicodeFormat('%d%d%d_%s',[k,n,v,Utf8Decode(slNames[n])]);
+          if sValueNames='' then
+            sValueNames:=s
+          else
+            sValueNames:=sValueNames+Utf8Decode(slNames.Delimiter)+s;
+          TestValue(s,Utf8Decode(slValues[v]));
+        end;
+      TestGetValueNames(reg.CurrentPath,sValueNames);
+    end;
+
+  TestGetKeyNames(sKey,Utf8Decode(slKeys.DelimitedText));
+
+  reg.CloseKey;
+
+  slKeys.Free;
+  slNames.Free;
+  slValues.Free;
+end;
+
+Procedure WN;
+Var
+  F : Text;
+
+
+begin
+  Assign(F,'names.txt');
+  Rewrite(F);
+  Writeln(F,EditKey);
+  Writeln(F,labeledEditName);
+  Writeln(F,LabeledEditValue);
+  Writeln(F,LabelKeyCaption);
+  Close(F);
+end;
+
+begin
+  defaultsystemcodepage:=CP_UTF8;
+  if (ParamStr(1)='-s') then
+    WN;
+  reg:=TRegistry.Create;
+  reg.lazywrite:=false;
+  Results:=TStringList.Create;
+  Test;
+  Reg.Free;
+  if (ParamStr(1)='-s') then
+    Results.SaveToFile('result.txt');
+  Writeln(Results.Text);
+  Results.Free;
+  {$IFDEF WINDOWS}Readln;{$ENDIF}
+end.
+

packages/fcl-registry/src/regdef.inc

@@ -2,7 +2,7 @@ Type
   HKEY = THandle;
   PHKEY = ^HKEY;
   
-{$ifdef windows}
+{$if defined(windows) and not defined(XMLREG)}
 
 { Direct mapping to constants in Windows unit }
 

packages/fcl-registry/src/registry.pp

@@ -39,6 +39,8 @@ type
     DataSize: Integer;
   end;
 
+  TUnicodeStringArray = Array of UnicodeString;
+
 { ---------------------------------------------------------------------
     TRegistry
   ---------------------------------------------------------------------}
@@ -54,21 +56,30 @@ type
     fCurrentKey: HKEY;
     fRootKey: HKEY;
     fLazyWrite: Boolean;
-    fCurrentPath: string;
+    fCurrentPath: UnicodeString;
     function GetLastErrorMsg: string;
+    function RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray;
+    function ListToArray(List: TStrings; IsUtf8: Boolean): TUnicodeStringArray;
+    procedure ArrayToList(const Arr: TUnicodeStringArray; List: TStrings; ForceUtf8: Boolean);
     procedure SetRootKey(Value: HKEY);
     Procedure SysRegCreate;
     Procedure SysRegFree;
-    Function  SysGetData(const Name: String; Buffer: Pointer; BufSize: Integer; Out RegData: TRegDataType): Integer;
-    Function  SysPutData(const Name: string; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType) : Boolean;
-    Function  SysCreateKey(const Key: String): Boolean;
+    Function  SysGetData(const Name: UnicodeString; Buffer: Pointer; BufSize: Integer; Out RegData: TRegDataType): Integer;
+    Function  SysPutData(const Name: UnicodeString; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType) : Boolean;
+    Function  SysCreateKey(Key: UnicodeString): Boolean;
   protected
     function GetBaseKey(Relative: Boolean): HKey;
-    function GetData(const Name: string; Buffer: Pointer;
+    function GetData(const Name: UnicodeString; Buffer: Pointer;
+                  BufSize: Integer; Out RegData: TRegDataType): Integer;
+    function GetData(const Name: String; Buffer: Pointer;
                   BufSize: Integer; Out RegData: TRegDataType): Integer;
-    function GetKey(const Key: string): HKEY;
-    procedure ChangeKey(Value: HKey; const Path: string);
-    procedure PutData(const Name: string; Buffer: Pointer;
+    function GetKey(Key: UnicodeString): HKEY;
+    function GetKey(Key: String): HKEY;
+    procedure ChangeKey(Value: HKey; const Path: UnicodeString);
+    procedure ChangeKey(Value: HKey; const Path: String);
+    procedure PutData(const Name: UnicodeString; Buffer: Pointer;
+                  BufSize: Integer; RegData: TRegDataType);
+    procedure PutData(const Name: String; Buffer: Pointer;
                   BufSize: Integer; RegData: TRegDataType);
     procedure SetCurrentKey(Value: HKEY);
   public
@@ -76,58 +87,105 @@ type
     constructor Create(aaccess:longword); overload;
     destructor Destroy; override;
 
-    function CreateKey(const Key: string): Boolean;
-    function DeleteKey(const Key: string): Boolean;
-    function DeleteValue(const Name: string): Boolean;
-    function GetDataInfo(const ValueName: string; Out Value: TRegDataInfo): Boolean;
-    function GetDataSize(const ValueName: string): Integer;
-    function GetDataType(const ValueName: string): TRegDataType;
+    function CreateKey(const Key: UnicodeString): Boolean;
+    function CreateKey(const Key: String): Boolean;
+    function DeleteKey(const Key: UnicodeString): Boolean;
+    function DeleteKey(const Key: String): Boolean;
+    function DeleteValue(const Name: UnicodeString): Boolean;
+    function DeleteValue(const Name: String): Boolean;
+    function GetDataInfo(const ValueName: UnicodeString; Out Value: TRegDataInfo): Boolean;
+    function GetDataInfo(const ValueName: String; Out Value: TRegDataInfo): Boolean;
+    function GetDataSize(const ValueName: UnicodeString): Integer;
+    function GetDataSize(const ValueName: String): Integer;
+    function GetDataType(const ValueName: UnicodeString): TRegDataType;
+    function GetDataType(const ValueName: String): TRegDataType;
     function GetKeyInfo(Out Value: TRegKeyInfo): Boolean;
     function HasSubKeys: Boolean;
-    function KeyExists(const Key: string): Boolean;
-    function LoadKey(const Key, FileName: string): Boolean;
-    function OpenKey(const Key: string; CanCreate: Boolean): Boolean;
-    function OpenKeyReadOnly(const Key: string): Boolean;
-    function ReadCurrency(const Name: string): Currency;
-    function ReadBinaryData(const Name: string; var Buffer; BufSize: Integer): Integer;
-    function ReadBool(const Name: string): Boolean;
-    function ReadDate(const Name: string): TDateTime;
-    function ReadDateTime(const Name: string): TDateTime;
-    function ReadFloat(const Name: string): Double;
-    function ReadInteger(const Name: string): Integer;
-    function ReadInt64(const Name: string): Int64;
-    function ReadString(const Name: string): string;
-    procedure ReadStringList(const Name: string; AList: TStrings);
-    function ReadTime(const Name: string): TDateTime;
-    function RegistryConnect(const UNCName: string): Boolean;
-    function ReplaceKey(const Key, FileName, BackUpFileName: string): Boolean;
-    function RestoreKey(const Key, FileName: string): Boolean;
-    function SaveKey(const Key, FileName: string): Boolean;
-    function UnLoadKey(const Key: string): Boolean;
-    function ValueExists(const Name: string): Boolean;
+    function KeyExists(const Key: UnicodeString): Boolean;
+    function KeyExists(const Key: String): Boolean;
+    function LoadKey(const Key, FileName: UnicodeString): Boolean;
+    function LoadKey(const Key, FileName: String): Boolean;
+    function OpenKey(const Key: UnicodeString; CanCreate: Boolean): Boolean;
+    function OpenKey(const Key: String; CanCreate: Boolean): Boolean;
+    function OpenKeyReadOnly(const Key: UnicodeString): Boolean;
+    function OpenKeyReadOnly(const Key: String): Boolean;
+    function ReadCurrency(const Name: UnicodeString): Currency;
+    function ReadCurrency(const Name: String): Currency;
+    function ReadBinaryData(const Name: UnicodeString; var Buffer; BufSize: Integer): Integer;
+    function ReadBinaryData(const Name: String; var Buffer; BufSize: Integer): Integer;
+    function ReadBool(const Name: UnicodeString): Boolean;
+    function ReadBool(const Name: String): Boolean;
+    function ReadDate(const Name: UnicodeString): TDateTime;
+    function ReadDate(const Name: String): TDateTime;
+    function ReadDateTime(const Name: UnicodeString): TDateTime;
+    function ReadDateTime(const Name: String): TDateTime;
+    function ReadFloat(const Name: UnicodeString): Double;
+    function ReadFloat(const Name: String): Double;
+    function ReadInteger(const Name: UnicodeString): Integer;
+    function ReadInteger(const Name: String): Integer;
+    function ReadInt64(const Name: UnicodeString): Int64;
+    function ReadInt64(const Name: String): Int64;
+    function ReadString(const Name: UnicodeString): UnicodeString;
+    function ReadString(const Name: String): string;
+    procedure ReadStringList(const Name: UnicodeString; AList: TStrings; ForceUtf8: Boolean=False);
+    procedure ReadStringList(const Name: String; AList: TStrings);
+    function ReadStringArray(const Name: UnicodeString): TUnicodeStringArray;
+    function ReadStringArray(const Name: String): TStringArray;
+    function ReadTime(const Name: UnicodeString): TDateTime;
+    function ReadTime(const Name: String): TDateTime;
+    function RegistryConnect(const UNCName: UnicodeString): Boolean;
+    function RegistryConnect(const UNCName: String): Boolean;
+    function ReplaceKey(const Key, FileName, BackUpFileName: UnicodeString): Boolean;
+    function ReplaceKey(const Key, FileName, BackUpFileName: String): Boolean;
+    function RestoreKey(const Key, FileName: UnicodeString): Boolean;
+    function RestoreKey(const Key, FileName: String): Boolean;
+    function SaveKey(const Key, FileName: UnicodeString): Boolean;
+    function SaveKey(const Key, FileName: String): Boolean;
+    function UnLoadKey(const Key: UnicodeString): Boolean;
+    function UnLoadKey(const Key: String): Boolean;
+    function ValueExists(const Name: UnicodeString): Boolean;
+    function ValueExists(const Name: String): Boolean;
 
     procedure CloseKey;
     procedure CloseKey(key:HKEY);
     procedure GetKeyNames(Strings: TStrings);
+    function GetKeyNames: TUnicodeStringArray;
     procedure GetValueNames(Strings: TStrings);
-    procedure MoveKey(const OldName, NewName: string; Delete: Boolean);
-    procedure RenameValue(const OldName, NewName: string);
-    procedure WriteCurrency(const Name: string; Value: Currency);
-    procedure WriteBinaryData(const Name: string; var Buffer; BufSize: Integer);
-    procedure WriteBool(const Name: string; Value: Boolean);
-    procedure WriteDate(const Name: string; Value: TDateTime);
-    procedure WriteDateTime(const Name: string; Value: TDateTime);
-    procedure WriteFloat(const Name: string; Value: Double);
-    procedure WriteInteger(const Name: string; Value: Integer);
-    procedure WriteInt64(const Name: string; Value: Int64);
-    procedure WriteString(const Name, Value: string);
-    procedure WriteExpandString(const Name, Value: string);
-    procedure WriteStringList(const Name: string; List: TStrings);
-    procedure WriteTime(const Name: string; Value: TDateTime);
+    //ToDo
+    function GetValueNames: TUnicodeStringArray;
+    procedure MoveKey(const OldName, NewName: UnicodeString; Delete: Boolean);
+    procedure MoveKey(const OldName, NewName: String; Delete: Boolean);
+    procedure RenameValue(const OldName, NewName: UnicodeString);
+    procedure RenameValue(const OldName, NewName: String);
+    procedure WriteCurrency(const Name: UnicodeString; Value: Currency);
+    procedure WriteCurrency(const Name: String; Value: Currency);
+    procedure WriteBinaryData(const Name: UnicodeString; var Buffer; BufSize: Integer);
+    procedure WriteBinaryData(const Name: String; var Buffer; BufSize: Integer);
+    procedure WriteBool(const Name: UnicodeString; Value: Boolean);
+    procedure WriteBool(const Name: String; Value: Boolean);
+    procedure WriteDate(const Name: UnicodeString; Value: TDateTime);
+    procedure WriteDate(const Name: String; Value: TDateTime);
+    procedure WriteDateTime(const Name: UnicodeString; Value: TDateTime);
+    procedure WriteDateTime(const Name: String; Value: TDateTime);
+    procedure WriteFloat(const Name: UnicodeString; Value: Double);
+    procedure WriteFloat(const Name: String; Value: Double);
+    procedure WriteInteger(const Name: UnicodeString; Value: Integer);
+    procedure WriteInteger(const Name: String; Value: Integer);
+    procedure WriteInt64(const Name: UnicodeString; Value: Int64);
+    procedure WriteInt64(const Name: String; Value: Int64);
+    procedure WriteString(const Name, Value: UnicodeString);
+    procedure WriteString(const Name, Value: String);
+    procedure WriteExpandString(const Name, Value: UnicodeString);
+    procedure WriteExpandString(const Name, Value: String);
+    procedure WriteStringList(const Name: UnicodeString; List: TStrings; IsUtf8: Boolean=False);
+    procedure WriteStringArray(const Name: UnicodeString; const Arr: TUnicodeStringArray);
+    procedure WriteStringArray(const Name: String; const Arr: TStringArray);
+    procedure WriteTime(const Name: UnicodeString; Value: TDateTime);
+    procedure WriteTime(const Name: String; Value: TDateTime);
 
     property Access: LongWord read fAccess write fAccess;
     property CurrentKey: HKEY read fCurrentKey;
-    property CurrentPath: string read fCurrentPath;
+    property CurrentPath: UnicodeString read fCurrentPath;
     property LazyWrite: Boolean read fLazyWrite write fLazyWrite;
     property RootKey: HKEY read fRootKey write SetRootKey;
     Property StringSizeIncludesNull : Boolean read FStringSizeIncludesNull;
@@ -172,7 +230,7 @@ type
     property FileName: String read fFileName;
     property PreferStringValues: Boolean read fPreferStringValues
                 write fPreferStringValues;
-  end;
+  end{$ifdef XMLREG}deprecated 'Use TRegistry instead. Will be removed in 4.0'{$endif} platform; 
 
 { ---------------------------------------------------------------------
     TRegIniFile
@@ -207,7 +265,7 @@ type
     procedure UpdateFile; override;
     function ValueExists(const Section, Ident: string): Boolean; override;
     property RegIniFile: TRegIniFile read FRegIniFile;
-  end;
+  end{$ifdef XMLREG}deprecated 'Use TRegistry instead. Will be removed in 4.0'{$endif} platform; 
 
 ResourceString
   SInvalidRegType   = 'Invalid registry data type: "%s"';
@@ -235,6 +293,16 @@ implementation
     Generic, implementation-independent code.
   ---------------------------------------------------------------------}
 
+{$ifdef DebugRegistry}
+function DbgS(const S: UnicodeString): String;
+var
+  C: WideChar;
+begin
+  Result := '';
+  for C in S do Result := Result + IntToHex(Word(C),4) + #32;
+  Result := TrimRight(Result);
+end;
+{$endif}
 
 constructor TRegistry.Create;
 
@@ -261,7 +329,7 @@ begin
   inherited Destroy;
 end;
 
-function TRegistry.CreateKey(const Key: string): Boolean;
+function TRegistry.CreateKey(const Key: UnicodeString): Boolean;
 
 begin
   Result:=SysCreateKey(Key);
@@ -269,6 +337,27 @@ begin
     Raise ERegistryException.CreateFmt(SRegCreateFailed, [Key]);
 end;
 
+function TRegistry.CreateKey(const Key: String): Boolean;
+begin
+  Result:=CreateKey(UnicodeString(Key));
+end;
+
+function TRegistry.DeleteKey(const Key: String): Boolean;
+begin
+  Result:=DeleteKey(UnicodeString(Key));
+end;
+
+function TRegistry.DeleteValue(const Name: String): Boolean;
+begin
+  Result:=DeleteValue(UnicodeString(Name));
+end;
+
+function TRegistry.GetDataInfo(const ValueName: String; out Value: TRegDataInfo
+  ): Boolean;
+begin
+  Result:=GetDataInfo(UnicodeString(ValueName), Value);
+end;
+
 function TRegistry.GetBaseKey(Relative: Boolean): HKey;
 begin
   If Relative and (CurrentKey<>0) Then
@@ -277,14 +366,31 @@ begin
     Result := RootKey;
 end;
 
-function TRegistry.GetData(const Name: string; Buffer: Pointer; BufSize: Integer; out RegData: TRegDataType): Integer;
+function TRegistry.GetData(const Name: UnicodeString; Buffer: Pointer; BufSize: Integer; out RegData: TRegDataType): Integer;
 begin
   Result:=SysGetData(Name,Buffer,BufSize,RegData);
   If (Result=-1) then
     Raise ERegistryException.CreateFmt(SRegGetDataFailed, [Name]);
 end;
 
-procedure TRegistry.PutData(const Name: string; Buffer: Pointer;
+function TRegistry.GetData(const Name: String; Buffer: Pointer;
+  BufSize: Integer; out RegData: TRegDataType): Integer;
+begin
+  Result:=GetData(UnicodeString(Name), Buffer, BufSize, RegData);
+end;
+
+function TRegistry.GetKey(Key: String): HKEY;
+begin
+  Result:=GetKey(UnicodeString(Key));
+end;
+
+procedure TRegistry.ChangeKey(Value: HKey; const Path: String);
+begin
+  ChangeKey(Value, UnicodeString(Path));
+end;
+
+
+procedure TRegistry.PutData(const Name: UnicodeString; Buffer: Pointer;
   BufSize: Integer; RegData: TRegDataType);
 
 begin
@@ -292,8 +398,14 @@ begin
     Raise ERegistryException.CreateFmt(SRegSetDataFailed, [Name]);
 end;
 
+procedure TRegistry.PutData(const Name: String; Buffer: Pointer;
+  BufSize: Integer; RegData: TRegDataType);
+begin
+  PutData(UnicodeString(Name), Buffer, BufSize, RegData);
+end;
+
 
-function TRegistry.GetDataSize(const ValueName: string): Integer;
+function TRegistry.GetDataSize(const ValueName: UnicodeString): Integer;
 
 Var
   Info: TRegDataInfo;
@@ -305,7 +417,12 @@ begin
     Result := -1;
 end;
 
-function TRegistry.GetDataType(const ValueName: string): TRegDataType;
+function TRegistry.GetDataSize(const ValueName: String): Integer;
+begin
+  Result:=GetDataSize(UnicodeString(ValueName));
+end;
+
+function TRegistry.GetDataType(const ValueName: UnicodeString): TRegDataType;
 
 Var
   Info: TRegDataInfo;
@@ -315,6 +432,32 @@ begin
   Result:=Info.RegData;
 end;
 
+function TRegistry.GetDataType(const ValueName: String): TRegDataType;
+begin
+  Result:=GetDataType(UnicodeString(ValueName));
+end;
+
+
+function TRegistry.KeyExists(const Key: String): Boolean;
+begin
+  Result:=KeyExists(UnicodeString(Key));
+end;
+
+function TRegistry.LoadKey(const Key, FileName: String): Boolean;
+begin
+  Result:=LoadKey(UnicodeString(Key), UnicodeString(FileName));
+end;
+
+function TRegistry.OpenKey(const Key: String; CanCreate: Boolean): Boolean;
+begin
+  Result:=OpenKey(UnicodeString(Key), CanCreate);
+end;
+
+function TRegistry.OpenKeyReadOnly(const Key: String): Boolean;
+begin
+  Result:=OpenKeyReadOnly(UnicodeString(Key));
+end;
+
 function TRegistry.HasSubKeys: Boolean;
 
 Var
@@ -326,7 +469,7 @@ begin
     Result:=(Info.NumSubKeys>0);
 end;
 
-function TRegistry.ReadBinaryData(const Name: string; var Buffer; BufSize: Integer): Integer;
+function TRegistry.ReadBinaryData(const Name: UnicodeString; var Buffer; BufSize: Integer): Integer;
 
 Var
   RegDataType: TRegDataType;
@@ -337,7 +480,13 @@ begin
     Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
 end;
 
-function TRegistry.ReadInteger(const Name: string): Integer;
+function TRegistry.ReadBinaryData(const Name: String; var Buffer;
+  BufSize: Integer): Integer;
+begin
+  Result:=ReadBinaryData(UnicodeString(Name), Buffer, BufSize);
+end;
+
+function TRegistry.ReadInteger(const Name: UnicodeString): Integer;
 
 Var
   RegDataType: TRegDataType;
@@ -348,7 +497,12 @@ begin
     Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
 end;
 
-function TRegistry.ReadInt64(const Name: string): Int64;
+function TRegistry.ReadInteger(const Name: String): Integer;
+begin
+  Result:=ReadInteger(UnicodeString(Name));
+end;
+
+function TRegistry.ReadInt64(const Name: UnicodeString): Int64;
 
 Var
   RegDataType: TRegDataType;
@@ -359,20 +513,35 @@ begin
     Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
 end;
 
-function TRegistry.ReadBool(const Name: string): Boolean;
+function TRegistry.ReadInt64(const Name: String): Int64;
+begin
+  Result:=ReadInt64(UnicodeString(Name));
+end;
+
+function TRegistry.ReadBool(const Name: UnicodeString): Boolean;
 
 begin
   Result:=ReadInteger(Name)<>0;
 end;
 
-function TRegistry.ReadCurrency(const Name: string): Currency;
+function TRegistry.ReadBool(const Name: String): Boolean;
+begin
+  Result:=ReadBool(UnicodeString(Name));
+end;
+
+function TRegistry.ReadCurrency(const Name: UnicodeString): Currency;
 
 begin
   Result:=Default(Currency);
   ReadBinaryData(Name, Result, SizeOf(Currency));
 end;
 
-function TRegistry.ReadDate(const Name: string): TDateTime;
+function TRegistry.ReadCurrency(const Name: String): Currency;
+begin
+  Result:=ReadCurrency(UnicodeString(Name));
+end;
+
+function TRegistry.ReadDate(const Name: UnicodeString): TDateTime;
 
 begin
   Result:=Default(TDateTime);
@@ -380,21 +549,36 @@ begin
   Result:=Trunc(Result);
 end;
 
-function TRegistry.ReadDateTime(const Name: string): TDateTime;
+function TRegistry.ReadDate(const Name: String): TDateTime;
+begin
+  Result:=ReadDate(UnicodeString(Name));
+end;
+
+function TRegistry.ReadDateTime(const Name: UnicodeString): TDateTime;
 
 begin
   Result:=Default(TDateTime);
   ReadBinaryData(Name, Result, SizeOf(TDateTime));
 end;
 
-function TRegistry.ReadFloat(const Name: string): Double;
+function TRegistry.ReadDateTime(const Name: String): TDateTime;
+begin
+  Result:=ReadDateTime(UnicodeString(Name));
+end;
+
+function TRegistry.ReadFloat(const Name: UnicodeString): Double;
 
 begin
   Result:=Default(Double);
   ReadBinaryData(Name,Result,SizeOf(Double));
 end;
 
-function TRegistry.ReadString(const Name: string): string;
+function TRegistry.ReadFloat(const Name: String): Double;
+begin
+  Result:=ReadFloat(UnicodeString(Name));
+end;
+
+function TRegistry.ReadString(const Name: UnicodeString): UnicodeString;
 
 Var
   Info : TRegDataInfo;
@@ -421,46 +605,138 @@ begin
       if StringSizeIncludesNull and
          (u[Length(u)] = WideChar(0)) then
         SetLength(u,Length(u)-1);
-      Result:=UTF8Encode(u);
+      Result:=u;
     end;
   end;
 end;
 
-procedure TRegistry.ReadStringList(const Name: string; AList: TStrings);
+function TRegistry.ReadString(const Name: String): string;
+begin
+  Result:=ReadString(UnicodeString(Name));
+end;
+
+
+procedure TRegistry.ReadStringList(const Name: UnicodeString; AList: TStrings; ForceUtf8: Boolean=False);
+
+Var
+  UArr: TUnicodeStringArray;
+
+begin
+  UArr := ReadStringArray(Name);
+  ArrayToList(UArr, AList, ForceUtf8);
+end;
+
+procedure TRegistry.ReadStringList(const Name: String; AList: TStrings);
+begin
+  ReadStringList(UnicodeString(Name), AList);
+end;
+
+function TRegistry.RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray;
+var
+  Len, i, p: Integer;
+  Sub: UnicodeString;
+begin
+  Result := nil;
+  if (U = '') then Exit;
+  Len := 1;
+  for i := 1 to Length(U) do if (U[i] = #0) then Inc(Len);
+  SetLength(Result, Len);
+  i := 0;
+
+  while (U <> '') and (i < Length(Result)) do
+  begin
+    p := Pos(#0, U);
+    if (p = 0) then p := Length(U) + 1;
+    Sub := Copy(U, 1, p - 1);
+    Result[i] := Sub;
+    System.Delete(U, 1, p);
+    Inc(i);
+  end;
+end;
+
+function TRegistry.ListToArray(List: TStrings; IsUtf8: Boolean): TUnicodeStringArray;
+var
+  i, curr, Len: Integer;
+  u: UnicodeString;
+begin
+  Result := nil;
+  Len := List.Count;
+  SetLength(Result, Len);
+  //REG_MULTI_SZ data cannot contain empty strings
+  curr := 0;
+  for i := 0 to List.Count - 1 do
+  begin
+    if IsUtf8 then
+      u := Utf8Decode(List[i])
+    else
+      u := List[i];
+    if (u>'') then
+    begin
+      Result[curr] := u;
+      inc(curr);
+    end
+    else
+      Dec(Len);
+  end;
+  if (Len <> List.Count) then SetLength(Result, Len);
+end;
+
+procedure TRegistry.ArrayToList(const Arr: TUnicodeStringArray; List: TStrings; ForceUtf8: Boolean);
+var
+  i: Integer;
+begin
+  List.Clear;
+  for i := Low(Arr) to High(Arr) do
+  begin
+    if ForceUtf8 then
+      List.Add(Utf8Encode(Arr[i]))
+    else
+      List.Add(String(Arr[i]));
+  end;
+end;
 
+function TRegistry.ReadStringArray(const Name: UnicodeString): TUnicodeStringArray;
 Var
   Info : TRegDataInfo;
   ReadDataSize: Integer;
-  Data: string;
+  Data: UnicodeString;
 
 begin
-  AList.Clear;
+  Result := nil;
   GetDataInfo(Name,Info);
+  //writeln('TRegistry.ReadStringArray: datasize=',info.datasize);
   if info.datasize>0 then
     begin
      If Not (Info.RegData in [rdMultiString]) then
        Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
      SetLength(Data,Info.DataSize);
-     ReadDataSize := GetData(Name,PChar(Data),Info.DataSize,Info.RegData);
+     ReadDataSize := GetData(Name,PWideChar(Data),Info.DataSize,Info.RegData) div SizeOf(WideChar);
+     //writeln('TRegistry.ReadStringArray: ReadDataSize=',ReadDataSize);
      if ReadDataSize > 0 then
      begin
-       // If the data has the REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ type,
-       // the size includes any terminating null character or characters
-       // unless the data was stored without them! (RegQueryValueEx @ MSDN)
-       if StringSizeIncludesNull then begin
-         if Data[ReadDataSize] = #0 then
-           Dec(ReadDataSize);
-         if Data[ReadDataSize] = #0 then
-           Dec(ReadDataSize);
-       end;
+       // Windows returns the data with or without trailing zero's, so just strip all trailing null characters
+        while (Data[ReadDataSize] = #0) do Dec(ReadDataSize);
        SetLength(Data, ReadDataSize);
-       Data := StringReplace(Data, #0, LineEnding, [rfReplaceAll]);
-       AList.Text := Data;
+       //writeln('Data=',dbgs(data));
+       //Data := UnicodeStringReplace(Data, #0, AList.LineBreak, [rfReplaceAll]);
+       //AList.Text := Data;
+       Result := RegMultiSzDataToUnicodeStringArray(Data);
      end
    end
 end;
 
-function TRegistry.ReadTime(const Name: string): TDateTime;
+function TRegistry.ReadStringArray(const Name: String): TStringArray;
+var
+  UArr: TUnicodeStringArray;
+  i: Integer;
+begin
+  Result := nil;
+  UArr := ReadStringArray(UnicodeString(Name));
+  SetLength(Result, Length(UArr));
+  for i := Low(UArr) to High(UArr) do Result[i] := UArr[i];
+end;
+
+function TRegistry.ReadTime(const Name: UnicodeString): TDateTime;
 
 begin
   Result:=Default(TDateTime);
@@ -468,83 +744,228 @@ begin
   Result:=Frac(Result);
 end;
 
-procedure TRegistry.WriteBinaryData(const Name: string; var Buffer; BufSize: Integer);
+function TRegistry.ReadTime(const Name: String): TDateTime;
+begin
+  Result:=ReadTime(UnicodeString(Name));
+end;
+
+function TRegistry.RegistryConnect(const UNCName: String): Boolean;
+begin
+  Result:=RegistryConnect(UnicodeString(UNCName));
+end;
+
+function TRegistry.ReplaceKey(const Key, FileName, BackUpFileName: String): Boolean;
+begin
+  Result:=ReplaceKey(UnicodeString(Key), UnicodeString(FileName), UnicodeString(BackUpFileName))
+end;
+
+function TRegistry.RestoreKey(const Key, FileName: String): Boolean;
+begin
+  Result:=RestoreKey(UnicodeString(Key), UnicodeString(FileName));
+end;
+
+function TRegistry.SaveKey(const Key, FileName: String): Boolean;
+begin
+  Result:=SaveKey(UnicodeString(Key), UnicodeString(FileName));
+end;
+
+function TRegistry.UnLoadKey(const Key: String): Boolean;
+begin
+  Result:=UnloadKey(UnicodeString(Key));
+end;
+
+function TRegistry.ValueExists(const Name: String): Boolean;
+begin
+  Result:=ValueExists(UnicodeString(Name));
+end;
+
+procedure TRegistry.WriteBinaryData(const Name: UnicodeString; var Buffer; BufSize: Integer);
 begin
   PutData(Name, @Buffer, BufSize, rdBinary);
 end;
 
-procedure TRegistry.WriteBool(const Name: string; Value: Boolean);
+procedure TRegistry.WriteBinaryData(const Name: String; var Buffer;
+  BufSize: Integer);
+begin
+  WriteBinaryData(UnicodeString(Name), Buffer, BufSize);
+end;
+
+procedure TRegistry.WriteBool(const Name: UnicodeString; Value: Boolean);
 
 begin
   WriteInteger(Name,Ord(Value));
 end;
 
-procedure TRegistry.WriteCurrency(const Name: string; Value: Currency);
+procedure TRegistry.WriteBool(const Name: String; Value: Boolean);
+begin
+  WriteBool(UnicodeString(Name), Value);
+end;
+
+procedure TRegistry.WriteCurrency(const Name: UnicodeString; Value: Currency);
 begin
   WriteBinaryData(Name, Value, SizeOf(Currency));
 end;
 
-procedure TRegistry.WriteDate(const Name: string; Value: TDateTime);
+procedure TRegistry.WriteCurrency(const Name: String; Value: Currency);
+begin
+  WriteCurrency(UnicodeString(Name), Value);
+end;
+
+procedure TRegistry.WriteDate(const Name: UnicodeString; Value: TDateTime);
 begin
   WriteBinarydata(Name, Value, SizeOf(TDateTime));
 end;
 
-procedure TRegistry.WriteTime(const Name: string; Value: TDateTime);
+procedure TRegistry.WriteDate(const Name: String; Value: TDateTime);
+begin
+  WriteDate(UnicodeString(Name), Value);
+end;
+
+procedure TRegistry.WriteTime(const Name: UnicodeString; Value: TDateTime);
 begin
   WriteBinaryData(Name, Value, SizeOf(TDateTime));
 end;
 
-procedure TRegistry.WriteDateTime(const Name: string; Value: TDateTime);
+procedure TRegistry.WriteTime(const Name: String; Value: TDateTime);
+begin
+  WriteTime(UnicodeString(Name), Value);
+end;
+
+procedure TRegistry.WriteDateTime(const Name: UnicodeString; Value: TDateTime);
 begin
   WriteBinaryData(Name, Value, SizeOf(TDateTime));
 end;
 
-procedure TRegistry.WriteExpandString(const Name, Value: string);
-var
-  u: UnicodeString;
+procedure TRegistry.WriteDateTime(const Name: String; Value: TDateTime);
+begin
+  WriteDateTime(UnicodeString(Name), Value);
+end;
+
+procedure TRegistry.WriteExpandString(const Name, Value: UnicodeString);
+begin
+  PutData(Name, PWideChar(Value), ByteLength(Value), rdExpandString);
+end;
 
+procedure TRegistry.WriteExpandString(const Name, Value: String);
 begin
-  u:=Value;
-  PutData(Name, PWideChar(u), ByteLength(u), rdExpandString);
+  WriteExpandString(UnicodeString(Name), UnicodeString(Value));
 end;
 
-procedure TRegistry.WriteStringList(const Name: string; List: TStrings);
+
+procedure TRegistry.WriteStringList(const Name: UnicodeString; List: TStrings; IsUtf8: Boolean=False);
 
 Var
-  Data: string;
+  UArr: TUnicodeStringArray;
+begin
+  UArr := ListToArray(List, IsUtf8);
+  WriteStringArray(Name, UArr);
+end;
+
+procedure TRegistry.WriteStringArray(const Name: UnicodeString; const Arr: TUnicodeStringArray);
+Var
+  Data: UnicodeString;
+  u: UnicodeString;
+  i: Integer;
+begin
+  Data := '';
+  //REG_MULTI_SZ data cannot contain empty strings
+  for i := Low(Arr) to High(Arr) do
+  begin
+    u := Arr[i];
+    if (u>'') then
+    begin
+      if (Data>'') then
+        Data := Data + #0 + u
+      else
+        Data := Data + u;
+    end;
+  end;
+  if StringSizeIncludesNull then
+    Data := Data + #0#0;
+  //writeln('Data=',Dbgs(Data));
+  PutData(Name, PWideChar(Data), ByteLength(Data), rdMultiString);
+end;
 
+procedure TRegistry.WriteStringArray(const Name: String; const Arr: TStringArray);
+var
+  UArr: TUnicodeStringArray;
+  i: Integer;
 begin
-  Data := StringReplace(List.Text, LineEnding, #0, [rfReplaceAll]) + #0#0;
-  PutData(Name, PChar(Data), Length(Data),rdMultiString);
+  UArr := nil;
+  SetLength(UArr, Length(Arr));
+  for i := Low(Arr) to High(Arr) do UArr[i] := Arr[i];
+  WriteStringArray(UnicodeString(Name), UArr);
 end;
 
-procedure TRegistry.WriteFloat(const Name: string; Value: Double);
+procedure TRegistry.WriteFloat(const Name: UnicodeString; Value: Double);
 begin
   WriteBinaryData(Name, Value, SizeOf(Double));
 end;
 
-procedure TRegistry.WriteInteger(const Name: string; Value: Integer);
+procedure TRegistry.WriteFloat(const Name: String; Value: Double);
+begin
+  WriteFloat(UnicodeString(Name), Value);
+end;
+
+procedure TRegistry.WriteInteger(const Name: UnicodeString; Value: Integer);
 begin
   PutData(Name, @Value, SizeOf(Integer), rdInteger);
 end;
 
-procedure TRegistry.WriteInt64(const Name: string; Value: Int64);
+procedure TRegistry.WriteInteger(const Name: String; Value: Integer);
+begin
+  WriteInteger(UnicodeString(Name), Value);
+end;
+
+procedure TRegistry.WriteInt64(const Name: UnicodeString; Value: Int64);
 begin
   PutData(Name, @Value, SizeOf(Int64), rdInt64);
 end;
 
-procedure TRegistry.WriteString(const Name, Value: string);
+procedure TRegistry.WriteInt64(const Name: String; Value: Int64);
+begin
+  WriteInt64(UnicodeString(Name), Value);
+end;
+
+procedure TRegistry.WriteString(const Name, Value: UnicodeString);
+begin
+  PutData(Name, PWideChar(Value), ByteLength(Value), rdString);
+end;
+
+procedure TRegistry.WriteString(const Name, Value: String);
+begin
+  WriteString(UnicodeString(Name), UnicodeString(Value));
+end;
+
+procedure TRegistry.GetKeyNames(Strings: TStrings);
 var
-  u: UnicodeString;
+  UArr: TUnicodeStringArray;
+begin
+  UArr := GetKeyNames;
+  ArrayToList(UArr, Strings, True);
+end;
+
+procedure TRegistry.GetValueNames(Strings: TStrings);
+var
+  UArr: TUnicodeStringArray;
+begin
+  UArr := GetValueNames;
+  ArrayToList(UArr, Strings, True);
+end;
 
+procedure TRegistry.MoveKey(const OldName, NewName: UnicodeString; Delete: Boolean);
 begin
-  u:=Value;
-  PutData(Name, PWideChar(u), ByteLength(u), rdString);
+
 end;
 
-procedure TRegistry.MoveKey(const OldName, NewName: string; Delete: Boolean);
+procedure TRegistry.MoveKey(const OldName, NewName: String; Delete: Boolean);
 begin
+  MoveKey(UnicodeString(OldName), UnicodeString(NewName), Delete);
+end;
 
+procedure TRegistry.RenameValue(const OldName, NewName: String);
+begin
+  RenameValue(UnicodeString(OldName), UnicodeString(NewName));
 end;
 
 { ---------------------------------------------------------------------
@@ -583,7 +1004,7 @@ function TRegistryIniFile.ReadBinaryStream(const Section, Name: string;
   Value: TStream): Integer;
 begin
   result:=-1; // unimplemented
- // 
+ //
 end;
 
 function TRegistryIniFile.ReadDate(const Section, Name: string;

packages/fcl-registry/src/winreg.inc

@@ -28,7 +28,7 @@ begin
   Dispose(PWinRegData(FSysData));
 end;
 
-Function PrepKey(Const S : String) : String;
+Function PrepKey(Const S : UnicodeString) : UnicodeString;
 
 begin
   Result := S;
@@ -36,25 +36,24 @@ begin
     System.Delete(Result, 1, 1);
 end;
 
-Function RelativeKey(Const S : String) : Boolean;
+Function RelativeKey(Const S : UnicodeString) : Boolean;
 
 begin
   Result:=(S='') or (S[1]<>'\')
 end;
 
 
-function TRegistry.sysCreateKey(const Key: String): Boolean;
+function TRegistry.sysCreateKey(Key: UnicodeString): Boolean;
 Var
-  u: UnicodeString;
   Disposition: Dword;
   Handle: HKEY;
   SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
 
 begin
   SecurityAttributes := Nil;
-  u:=PrepKey(Key);
+  Key:=PrepKey(Key);
   FLastError:=RegCreateKeyExW(GetBaseKey(RelativeKey(Key)),
-                              PWideChar(u),
+                              PWideChar(Key),
                               0,
                               '',
                               REG_OPTION_NON_VOLATILE,
@@ -66,7 +65,7 @@ begin
   RegCloseKey(Handle);
 end;
 
-function TRegistry.DeleteKey(const Key: String): Boolean;
+function TRegistry.DeleteKey(const Key: UnicodeString): Boolean;
 
 Var
   u: UnicodeString;
@@ -76,21 +75,21 @@ begin
   Result:=FLastError=ERROR_SUCCESS;
 end;
 
-function TRegistry.DeleteValue(const Name: String): Boolean;
+
+function TRegistry.DeleteValue(const Name: UnicodeString): Boolean;
 begin
-  FLastError:= RegDeleteValueW(fCurrentKey, PWideChar(UnicodeString(Name)));
+  FLastError:= RegDeleteValueW(fCurrentKey, PWideChar(Name));
   Result:=FLastError=ERROR_SUCCESS;
 end;
 
-function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
+
+function TRegistry.SysGetData(const Name: UnicodeString; Buffer: Pointer;
           BufSize: Integer; Out RegData: TRegDataType): Integer;
 Var
-  u: UnicodeString;
   RD : DWord;
 
 begin
-  u := Name;
-  FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,
+  FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(Name),Nil,
                       @RD,Buffer,lpdword(@BufSize));
   if (FLastError<>ERROR_SUCCESS) Then
     Result:=-1
@@ -103,17 +102,15 @@ begin
     end;
 end;
 
-function TRegistry.GetDataInfo(const ValueName: String; out Value: TRegDataInfo): Boolean;
+function TRegistry.GetDataInfo(const ValueName: UnicodeString; out Value: TRegDataInfo): Boolean;
 
 Var
-  u: UnicodeString;
   RD : DWord;
 
 begin
-  u:=ValueName;
   With Value do
     begin
-    FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,lpdword(@RegData),Nil,lpdword(@DataSize));
+    FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(ValueName),Nil,lpdword(@RegData),Nil,lpdword(@DataSize));
     Result:=FLastError=ERROR_SUCCESS;
     if Result then
       begin
@@ -131,24 +128,18 @@ begin
 end;
 
 
-function TRegistry.GetKey(const Key: String): HKEY;
+function TRegistry.GetKey(Key: UnicodeString): HKEY;
 var
-  S : string;
-{$ifndef WinCE}
-  u : UnicodeString;
-{$endif}
   Rel : Boolean;
 begin
   Result:=0;
-  S:=Key;
-  Rel:=RelativeKey(S);
+  Rel:=RelativeKey(Key);
   if not(Rel) then
-    Delete(S,1,1);
+    Delete(Key,1,1);
 {$ifdef WinCE}
-  FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PWideChar(WideString(S)),0,FAccess,Result);
+  FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PWideChar(Key),0,FAccess,Result);
 {$else WinCE}
-  u:=UnicodeString(S);
-  FLastError:=RegOpenKeyExW(GetBaseKey(Rel),PWideChar(u),0,FAccess,Result);
+  FLastError:=RegOpenKeyExW(GetBaseKey(Rel),PWideChar(Key),0,FAccess,Result);
 {$endif WinCE}
 end;
 
@@ -157,6 +148,7 @@ function TRegistry.GetKeyInfo(out Value: TRegKeyInfo): Boolean;
 var
   winFileTime: Windows.FILETIME;
   sysTime: TSystemTime;
+  LocalFileTime: Windows.FILETIME;
 begin
   FillChar(Value, SizeOf(Value), 0);
   With Value do
@@ -166,15 +158,15 @@ begin
               lpdword(@MaxDataLen),nil,@winFileTime);
     Result:=FLastError=ERROR_SUCCESS;          
     end;          
-  if Result then
+  if Result and FileTimeToLocalFileTime(@winFileTime, @LocalFileTime) and
+    FileTimeToSystemTime(@LocalFileTime, @sysTime) then
   begin
-    FileTimeToSystemTime(@winFileTime, @sysTime);
     Value.FileTime := SystemTimeToDateTime(sysTime);
   end;
 end;
 
 
-function TRegistry.KeyExists(const Key: string): Boolean;
+function TRegistry.KeyExists(const Key: UnicodeString): Boolean;
 var
   KeyHandle : HKEY;
   OldAccess : LONG;
@@ -196,20 +188,20 @@ begin
 end;
 
 
-function TRegistry.LoadKey(const Key, FileName: string): Boolean;
+function TRegistry.LoadKey(const Key, FileName: UnicodeString): Boolean;
 begin
   Result := False;
 end;
 
 
-function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
+
+function TRegistry.OpenKey(const Key: UnicodeString; CanCreate: Boolean): Boolean;
 
 Var
-  u: UnicodeString;
+  u, S: UnicodeString;
   Handle: HKEY;
   Disposition: Integer;
   SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
-  S: string;
 begin
   SecurityAttributes := Nil;
   u:=PrepKey(Key);
@@ -232,12 +224,13 @@ begin
     if RelativeKey(Key) then
       S:=CurrentPath + Key
     else
-      S:=UTF8Encode(u);
+      S:=u;
     ChangeKey(Handle, S);
   end;
 end;
 
-function TRegistry.OpenKeyReadOnly(const Key: string): Boolean;
+
+function TRegistry.OpenKeyReadOnly(const Key: UnicodeString): Boolean;
 
 Var
   OldAccess: LongWord;
@@ -251,7 +244,8 @@ begin
   end;
 end;
 
-function TRegistry.RegistryConnect(const UNCName: string): Boolean;
+
+function TRegistry.RegistryConnect(const UNCName: UnicodeString): Boolean;
 {$ifndef WinCE}
 var
   newroot: HKEY;
@@ -260,7 +254,7 @@ begin
 {$ifdef WinCE}
   Result:=False;
 {$else}
-  FLastError:=RegConnectRegistryW(PWideChar(UnicodeString(UNCName)),RootKey,newroot);
+  FLastError:=RegConnectRegistryW(PWideChar(UNCName),RootKey,newroot);
   Result:=FLastError=ERROR_SUCCESS;
   if Result then begin
     RootKey:=newroot;
@@ -269,27 +263,32 @@ begin
 {$endif}
 end;
 
-function TRegistry.ReplaceKey(const Key, FileName, BackUpFileName: string): Boolean;
+
+function TRegistry.ReplaceKey(const Key, FileName, BackUpFileName: UnicodeString): Boolean;
 begin
   Result := False;
 end;
 
-function TRegistry.RestoreKey(const Key, FileName: string): Boolean;
+
+function TRegistry.RestoreKey(const Key, FileName: UnicodeString): Boolean;
 begin
   Result := False;
 end;
 
-function TRegistry.SaveKey(const Key, FileName: string): Boolean;
+
+function TRegistry.SaveKey(const Key, FileName: UnicodeString): Boolean;
 begin
   Result := False;
 end;
 
-function TRegistry.UnLoadKey(const Key: string): Boolean;
+
+function TRegistry.UnLoadKey(const Key: UnicodeString): Boolean;
 begin
   Result := false;
 end;
 
-function TRegistry.ValueExists(const Name: string): Boolean;
+
+function TRegistry.ValueExists(const Name: UnicodeString): Boolean;
 
 var
   Info : TRegDataInfo;
@@ -298,6 +297,7 @@ begin
   Result:=GetDataInfo(Name,Info);
 end;
 
+
 procedure TRegistry.CloseKey;
 begin
   If (CurrentKey<>0) then
@@ -316,14 +316,15 @@ begin
   RegCloseKey(key);
 end;
 
-procedure TRegistry.ChangeKey(Value: HKey; const Path: String);
+procedure TRegistry.ChangeKey(Value: HKey; const Path: UnicodeString);
 begin
   CloseKey;
   FCurrentKey:=Value;
   FCurrentPath:=Path;
 end;
 
-procedure TRegistry.GetKeyNames(Strings: TStrings);
+
+function TRegistry.GetKeyNames: TUnicodeStringArray;
 
 var
   Info:    TRegKeyInfo;
@@ -331,15 +332,17 @@ var
   lpName:  LPWSTR;
   dwIndex: DWORD;
   lResult: LONGINT;
-  s:       string;
+  u:       UnicodeString;
 
 begin
-  Strings.Clear;
+  Result:=nil;
   if GetKeyInfo(Info) then
   begin
     dwLen:=Info.MaxSubKeyLen+1;
     GetMem(lpName,dwLen*SizeOf(WideChar));
     try
+      //writeln('TRegistry.GetKeyNames: Info.NumSubKeys=',Info.NumSubKeys);
+      SetLength(Result, Info.NumSubKeys);
       for dwIndex:=0 to Info.NumSubKeys-1 do
       begin
         dwLen:=Info.MaxSubKeyLen+1;
@@ -347,26 +350,21 @@ begin
         if lResult<>ERROR_SUCCESS then
           raise ERegistryException.Create(SysErrorMessage(lResult));
         if dwLen=0 then
-          s:=''
+          u:=''
         else
         begin           // dwLen>0
-          SetLength(s,dwLen*3);
-          dwLen:=UnicodeToUTF8(PChar(s),Length(s)+1,lpName,dwLen);
-          if dwLen<=1 then
-            s:=''
-          else          // dwLen>1
-            SetLength(s,dwLen-1);
+          u:=lpName;
         end;            // if dwLen=0
-        Strings.Add(s);
+        Result[dwIndex]:=u;
       end;              // for dwIndex:=0 ...
-
     finally
       FreeMem(lpName);
     end;
   end;
 end;
 
-procedure TRegistry.GetValueNames(Strings: TStrings);
+
+Function TRegistry.GetValueNames: TUnicodeStringArray;
 
 var
   Info:    TRegKeyInfo;
@@ -374,15 +372,16 @@ var
   lpName:  LPWSTR;
   dwIndex: DWORD;
   lResult: LONGINT;
-  s:       string;
+  u:       UnicodeString;
 
 begin
-   Strings.Clear;
+  Result:=nil;
   if GetKeyInfo(Info) then
   begin
     dwLen:=Info.MaxValueLen+1;
     GetMem(lpName,dwLen*SizeOf(WideChar));
     try
+      SetLength(Result, Info.NumValues);
       for dwIndex:=0 to Info.NumValues-1 do
       begin
         dwLen:=Info.MaxValueLen+1;
@@ -390,17 +389,12 @@ begin
         if lResult<>ERROR_SUCCESS then
           raise ERegistryException.Create(SysErrorMessage(lResult));
         if dwLen=0 then
-          s:=''
+          u:=''
         else
         begin           // dwLen>0
-          SetLength(s,dwLen*3);
-          dwLen:=UnicodeToUTF8(PChar(s),Length(s)+1,lpName,dwLen);
-          if dwLen<=1 then
-            s:=''
-          else          // dwLen>1
-            SetLength(s,dwLen-1);
+          u:=lpName;
         end;            // if dwLen=0
-        Strings.Add(s);
+        Result[dwIndex]:=u;
       end;              // for dwIndex:=0 ...
 
     finally
@@ -410,24 +404,22 @@ begin
 end;
 
 
-Function TRegistry.SysPutData(const Name: string; Buffer: Pointer;
+Function TRegistry.SysPutData(const Name: UnicodeString; Buffer: Pointer;
   BufSize: Integer; RegData: TRegDataType) : Boolean;
 
 
 Var
-  u: UnicodeString;
   RegDataType: DWORD;
   B : Pchar;
   S : String;
 
 begin
   RegDataType:=RegDataWords[RegData];
-  u:=UnicodeString(Name);
-  FLastError:=RegSetValueExW(fCurrentKey,PWideChar(u),0,RegDataType,Buffer,BufSize);
+  FLastError:=RegSetValueExW(fCurrentKey,PWideChar(Name),0,RegDataType,Buffer,BufSize);
   Result:=FLastError=ERROR_SUCCESS;
 end;
 
-procedure TRegistry.RenameValue(const OldName, NewName: string);
+procedure TRegistry.RenameValue(const OldName, NewName: UnicodeString);
 
 var
   L: Integer;

packages/fcl-registry/src/xmlreg.pp

@@ -10,7 +10,7 @@ uses
 
 Type
 
-  TDataType = (dtUnknown,dtDWORD,dtString,dtBinary,dtStrings);
+  TDataType = (dtUnknown,dtDWORD,dtString,dtBinary,dtStrings,dtQWord);
   TDataInfo = record
     DataType : TDataType;
     DataSize : Integer;
@@ -25,6 +25,7 @@ Type
     FTime     : TDateTime;
   end;
 
+  TUnicodeStringArray = Array of UnicodeString;
 
   { TXmlRegistry }
 
@@ -33,53 +34,55 @@ Type
     FAutoFlush,
     FDirty : Boolean;
     FFileName : String;
-    FRootKey : String;
+    FRootKey : UnicodeString;
     FDocument : TXMLDocument;
     FCurrentElement : TDomElement;
-    FCurrentKey : String;
+    FCurrentKey : UnicodeString;
     Procedure SetFileName(Value : String);
   Protected
-    function DoGetValueData(Name: String; out DataType: TDataType; Var Data; Var DataSize: Integer; IsUnicode: Boolean): Boolean; virtual;
-    function DoSetValueData(Name: String; DataType: TDataType; const Data; DataSize: Integer; IsUnicode: Boolean): Boolean; virtual;
+    function DoGetValueData(Name: UnicodeString; out DataType: TDataType; Var Data; Var DataSize: Integer; IsUnicode: Boolean): Boolean; virtual;
+    function DoSetValueData(Name: UnicodeString; DataType: TDataType; const Data; DataSize: Integer; IsUnicode: Boolean): Boolean; virtual;
     Procedure LoadFromStream(S : TStream);
-    Function  NormalizeKey(KeyPath : String) : String;
+    Function  NormalizeKey(KeyPath : UnicodeString) : UnicodeString;
     Procedure CreateEmptyDoc;
-    Function  FindKey (S : String) : TDomElement;
-    Function  FindSubKey (S : String; N : TDomElement) : TDomElement;
-    Function  CreateSubKey (S : String; N : TDomElement) : TDomElement;
-    Function  FindValueKey (S : String) : TDomElement;
-    Function  CreateValueKey (S : String) : TDomElement;
+    Function  FindKey (S : UnicodeString) : TDomElement;
+    Function  FindSubKey (S : UnicodeString; N : TDomElement) : TDomElement;
+    Function  CreateSubKey (S : UnicodeString; N : TDomElement) : TDomElement;
+    Function  FindValueKey (S : UnicodeString) : TDomElement;
+    Function  CreateValueKey (S : UnicodeString) : TDomElement;
     Function  BufToHex(Const Buf; Len : Integer) : String;
-    Function  hexToBuf(Const Str : String; Var Buf; Var Len : Integer ) : Integer;
+    Function  HexToBuf(Const Str : UnicodeString; Var Buf; Var Len : Integer ) : Integer;
     Procedure MaybeFlush;
     Property  Document : TXMLDocument Read FDocument;
     Property  Dirty : Boolean Read FDirty write FDirty;
   Public
     Constructor Create(AFileName : String);
     Destructor  Destroy;override;
-    Function  SetKey(KeyPath : String; AllowCreate : Boolean) : Boolean ;
-    Procedure SetRootKey(Value : String);
-    Function  DeleteKey(KeyPath : String) : Boolean;
-    Function  CreateKey(KeyPath : String) : Boolean;
-    Function  GetValueSize(Name : String) : Integer;
-    Function  GetValueType(Name : String) : TDataType;
-    Function  GetValueInfo(Name : String; Out Info : TDataInfo; AsUnicode : Boolean = False) : Boolean;
+    Function  SetKey(KeyPath : UnicodeString; AllowCreate : Boolean) : Boolean ;
+    Procedure SetRootKey(Value : UnicodeString);
+    Function  DeleteKey(KeyPath : UnicodeString) : Boolean;
+    Function  CreateKey(KeyPath : UnicodeString) : Boolean;
+    Function  GetValueSize(Name : UnicodeString) : Integer;
+    Function  GetValueType(Name : UnicodeString) : TDataType;
+    Function  GetValueInfo(Name : UnicodeString; Out Info : TDataInfo; AsUnicode : Boolean = False) : Boolean;
     Function  GetKeyInfo(Out Info : TKeyInfo) : Boolean;
     Function  EnumSubKeys(List : TStrings) : Integer;
+    Function  EnumSubKeys: TUnicodeStringArray;
     Function  EnumValues(List : TStrings) : Integer;
-    Function  KeyExists(KeyPath : String) : Boolean;
-    Function  ValueExists(ValueName : String) : Boolean;
-    Function  RenameValue(Const OldName,NewName : String) : Boolean;
-    Function  DeleteValue(S : String) : Boolean;
+    Function  EnumValues: TUnicodeStringArray;
+    Function  KeyExists(KeyPath : UnicodeString) : Boolean;
+    Function  ValueExists(ValueName : UnicodeString) : Boolean;
+    Function  RenameValue(Const OldName,NewName : UnicodeString) : Boolean;
+    Function  DeleteValue(S : UnicodeString) : Boolean;
     Procedure Flush;
     Procedure Load;
-    Function GetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
-    Function SetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
+    Function GetValueData(Name : UnicodeString; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
+    Function SetValueData(Name : UnicodeString; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
     // These interpret the Data buffer as unicode data
-    Function GetValueDataUnicode(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
-    Function SetValueDataUnicode(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
+    Function GetValueDataUnicode(Name : UnicodeString; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
+    Function SetValueDataUnicode(Name : UnicodeString; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
     Property FileName : String Read FFileName Write SetFileName;
-    Property RootKey : String Read FRootKey Write SetRootkey;
+    Property RootKey : UnicodeString Read FRootKey Write SetRootkey;
     Property AutoFlush : Boolean Read FAutoFlush Write FAutoFlush;
   end;
 
@@ -143,13 +146,13 @@ begin
   end;
 end;
 
-Function TXmlRegistry.NormalizeKey(KeyPath : String) : String;
+Function TXmlRegistry.NormalizeKey(KeyPath : UnicodeString) : UnicodeString;
 
 Var
   L : Integer;
 
 begin
-  Result:=StringReplace(KeyPath,'\','/',[rfReplaceAll]);
+  Result:=UnicodeStringReplace(KeyPath,'\','/',[rfReplaceAll]);
   L:=Length(Result);
   If (L>0) and (Result[L]<>'/') then
     Result:=Result+'/';
@@ -157,10 +160,10 @@ begin
     Result:='/' + Result;
 end;
 
-Function TXmlRegistry.SetKey(KeyPath : String; AllowCreate : Boolean) : boolean;
+Function TXmlRegistry.SetKey(KeyPath : UnicodeString; AllowCreate : Boolean) : boolean;
 
 Var
-  SubKey,ResultKey : String;
+  SubKey,ResultKey : UnicodeString;
   P : Integer;
   Node,Node2 : TDomElement;
 
@@ -218,7 +221,7 @@ begin
   MaybeFlush;
 end;
 
-Procedure TXmlRegistry.SetRootKey(Value : String);
+Procedure TXmlRegistry.SetRootKey(Value : UnicodeString);
 
 begin
   FRootKey:=NormalizeKey(Value);
@@ -228,26 +231,36 @@ begin
   FCurrentElement:=Nil;
 end;
 
-Function TXmlRegistry.DeleteKey(KeyPath : String) : Boolean;
+Function TXmlRegistry.DeleteKey(KeyPath : UnicodeString) : Boolean;
 
 Var
-  N : TDomElement;
+  N, Curr : TDomElement;
+  Node: TDOMNode;
 
 begin
  N:=FindKey(KeyPath);
  Result:=(N<>Nil);
  If Result then
    begin
+   //if a key has subkeys, result shall be false and nothing shall be deleted
+   Curr:=N;
+   Node:=Curr.FirstChild;
+   While Assigned(Node) do
+     begin
+     If (Node.NodeType=ELEMENT_NODE) and (Node.NodeName=SKey) then
+       Exit(False);
+     Node:=Node.NextSibling;
+     end;
    (N.ParentNode as TDomElement).RemoveChild(N);
    FDirty:=True;
    MaybeFlush;
    end;
 end;
 
-Function TXmlRegistry.CreateKey(KeyPath : String) : Boolean;
+Function TXmlRegistry.CreateKey(KeyPath : UnicodeString) : Boolean;
 
 Var
-  SubKey : String;
+  SubKey : UnicodeString;
   P : Integer;
   Node,Node2 : TDomElement;
 
@@ -290,7 +303,7 @@ begin
   MaybeFlush;
 end;
 
-Function TXmlRegistry.DoGetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer; IsUnicode : Boolean) : Boolean;
+Function TXmlRegistry.DoGetValueData(Name : UnicodeString; Out DataType : TDataType; Var Data; Var DataSize : Integer; IsUnicode : Boolean) : Boolean;
 
 Type
   PCardinal = ^Cardinal;
@@ -303,33 +316,45 @@ Var
   U : UnicodeString;
   HasData: Boolean;
   D : DWord;
+  Q : QWord;
   
 begin
+  //writeln('TXmlRegistry.DoGetValueData: Name=',Name,' IsUnicode=',IsUnicode);
   Node:=FindValueKey(Name);
   Result:=Node<>Nil;
   If Result then
     begin
+    //writeln('TXmlRegistry.DoGetValueData: Node<>nil');
     DataNode:=Node.FirstChild;
     HasData:=Assigned(DataNode) and (DataNode.NodeType=TEXT_NODE);
-    ND:=StrToIntDef(Node[Stype],0);
+    //writeln('TXmlRegistry.DoGetValueData: HasData=',hasdata);
+    ND:=StrToIntDef(String(Node[Stype]),0);
+    //writeln('TXmlRegistry.DoGetValueData: ND=',ND);
     Result:=ND<=Ord(High(TDataType));
     If Result then
       begin
       DataType:=TDataType(ND);
+      //writeln('TXmlRegistry.DoGetValueData: DataType=',DataType);
       NS:=0; // Initialize, for optional nodes.
       Case DataType of
         dtDWORD : begin   // DataNode is required
                   NS:=SizeOf(Cardinal);
-                  Result:=HasData and TryStrToDWord(DataNode.NodeValue,D) and (DataSize>=NS);
+                  Result:=HasData and TryStrToDWord(String(DataNode.NodeValue),D) and (DataSize>=NS);
                   if Result then
                     PCardinal(@Data)^:=D;
                   end;
+        dtQWORD : begin   // DataNode is required
+                  NS:=SizeOf(QWORD);
+                  Result:=HasData and TryStrToQWord(String(DataNode.NodeValue),Q) and (DataSize>=NS);
+                  if Result then
+                    PUInt64(@Data)^:=Q;
+                  end;
         dtString : // DataNode is optional
                    if HasData then
                      begin
                      if not IsUnicode then
                        begin
-                       S:=UTF8Encode(DataNode.NodeValue); // Convert to ansistring
+                       S:=DataNode.NodeValue; // Convert to ansistring
                        NS:=Length(S);
                        Result:=(DataSize>=NS);
                        if Result then
@@ -350,8 +375,10 @@ begin
                    if HasData then
                      begin
                      BL:=Length(DataNode.NodeValue);
+                     //writeln('TXmlRegistry.DoGetValueData: BL=',BL);
                      NS:=BL div 2;
                      Result:=DataSize>=NS;
+                     //writeln('TXmlRegistry.DoGetValueData: Result=',Result);
                      If Result then
                        // No need to check for -1, We checked NS before calling.
                        NS:=HexToBuf(DataNode.NodeValue,Data,BL);
@@ -363,7 +390,7 @@ begin
     end;
 end;
 
-Function TXmlRegistry.DoSetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer; IsUnicode : Boolean) : Boolean;
+Function TXmlRegistry.DoSetValueData(Name : UnicodeString; DataType : TDataType; Const Data; DataSize : Integer; IsUnicode : Boolean) : Boolean;
 
 Type
   PCardinal = ^Cardinal;
@@ -374,26 +401,28 @@ Var
   SW : UnicodeString;
 
 begin
+  //writeln('TXmlRegistry.DoSetValueData A: Name=',Name,', DataType=',DataType,', DataSize=',DataSize,', IsUnicode=',IsUnicode);
   Node:=FindValueKey(Name);
   If Node=Nil then
     Node:=CreateValueKey(Name);
   Result:=(Node<>Nil);
   If Result then
     begin
-    Node[SType]:=IntToStr(Ord(DataType));
+    Node[SType]:=UnicodeString(IntToStr(Ord(DataType)));
     DataNode:=Node.FirstChild;
 
     Case DataType of
-      dtDWORD : SW:=IntToStr(PCardinal(@Data)^);
+      dtDWORD : SW:=UnicodeString(IntToStr(PCardinal(@Data)^));
+      dtQWORD : SW:=UnicodeString(IntToStr(PUInt64(@Data)^));
       dtString : begin
                  if IsUnicode then
                    SW:=UnicodeString(PUnicodeChar(@Data))
                  else
                    SW:=UnicodeString(PAnsiChar(@Data));
-                   //S:=UTF8Encode(SW);
+                   //S:=SW;
                  end;
-      dtBinary : SW:=BufToHex(Data,DataSize);
-      dtStrings : SW:=BufToHex(Data,DataSize);
+      dtBinary : SW:=UnicodeString(BufToHex(Data,DataSize));
+      dtStrings : SW:=UnicodeString(BufToHex(Data,DataSize));
     else
       sw:='';
     end;
@@ -416,29 +445,29 @@ begin
     end;
 end;
 
-Function TXmlRegistry.SetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
+Function TXmlRegistry.SetValueData(Name : UnicodeString; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
 
 begin
   Result:=DoSetValueData(Name,DataType,Data,DataSize,False);
 end;
 
-Function TXmlRegistry.GetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
+Function TXmlRegistry.GetValueData(Name : UnicodeString; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
 
 begin
   Result:=DoGetValueData(Name,DataType,Data,DataSize,False);
 end;
 
-function TXmlRegistry.GetValueDataUnicode(Name: String; out DataType: TDataType; Var Data; Var DataSize: Integer): Boolean;
+function TXmlRegistry.GetValueDataUnicode(Name: UnicodeString; out DataType: TDataType; Var Data; Var DataSize: Integer): Boolean;
 begin
   Result:=DoGetValueData(Name,DataType,Data,DataSize,True);
 end;
 
-function TXmlRegistry.SetValueDataUnicode(Name: String; DataType: TDataType; const Data; DataSize: Integer): Boolean;
+function TXmlRegistry.SetValueDataUnicode(Name: UnicodeString; DataType: TDataType; const Data; DataSize: Integer): Boolean;
 begin
   Result:=DoSetValueData(Name,DataType,Data,DataSize,True)
 end;
 
-Function TXmlRegistry.FindSubKey (S : String; N : TDomElement) : TDomElement;
+Function TXmlRegistry.FindSubKey (S : UnicodeString; N : TDomElement) : TDomElement;
 
 Var
   Node : TDOMNode;
@@ -451,14 +480,14 @@ begin
     While (Result=Nil) and (Assigned(Node)) do
       begin
       If (Node.NodeType=ELEMENT_NODE) and (Node.NodeName=SKey) then
-        If CompareText(TDomElement(Node)[SName],S)=0 then
+        If UnicodeCompareText(TDomElement(Node)[SName],S)=0 then
           Result:=TDomElement(Node);
       Node:=Node.NextSibling;
       end;
     end;
 end;
 
-Function TXmlRegistry.CreateSubKey (S : String; N : TDomElement) : TDomElement;
+Function TXmlRegistry.CreateSubKey (S : UnicodeString; N : TDomElement) : TDomElement;
 
 begin
   Result:=FDocument.CreateElement(SKey);
@@ -468,7 +497,7 @@ begin
   FDirty:=True;
 end;
 
-Function  TXmlRegistry.FindValueKey (S : String) : TDomElement;
+Function  TXmlRegistry.FindValueKey (S : UnicodeString) : TDomElement;
 
 Var
   Node : TDOMNode;
@@ -481,14 +510,14 @@ begin
     While (Result=Nil) and (Assigned(Node)) do
       begin
       If (Node.NodeType=ELEMENT_NODE) and (Node.NodeName=SValue) then
-        If CompareText(TDomElement(Node)[SName],S)=0 then
+        If UnicodeCompareText(TDomElement(Node)[SName],S)=0 then
           Result:=TDomElement(Node);
       Node:=Node.NextSibling;
       end;
     end;
 end;
 
-Function  TXmlRegistry.CreateValueKey (S : String) : TDomElement;
+Function  TXmlRegistry.CreateValueKey (S : UnicodeString) : TDomElement;
 
 begin
   If Assigned(FCurrentElement) then
@@ -581,38 +610,47 @@ begin
     end;
 end;
 
-Function TXMLRegistry.hexToBuf(Const Str : String; Var Buf; Var Len : Integer ) : Integer;
+Function TXMLRegistry.HexToBuf(Const Str : UnicodeString; Var Buf; Var Len : Integer ) : Integer;
 
 Var
   NLeN,I : Integer;
   P : PByte;
-  S : String;
+  S : UnicodeString;
   B : Byte;
   Code : Integer;
 
 begin
+  //writeln('TXMLRegistry.HexToBuf A: Str=',Str,', Len=',Len);
   Result:=0;
   P:=@Buf;
+  //writeln('TXMLRegistry.HexToBuf B: (p=nil)=',p=nil);
   NLen:= Length(Str) div 2;
+  //writeln('TXMLRegistry.HexToBuf C: NLen=',NLen,', SizeOf(TDateTime)=',SizeOf(TDateTime));
   If (NLen>Len) then
     begin
     Len:=NLen;
     Exit(-1);
     end;
-  For I:=0 to Len-1 do
+  For I:=0 to NLen-1 do
     begin
+    //write('TXMLRegistry.HexToBuf: i=',i);
     S:='$'+Copy(Str,(I*2)+1,2);
+    //write(', S=',S);
     Val(S,B,Code);
+    //writeln(', Code=',Code);
     If Code<>0 then
-      begin
-      Inc(Result);
-      B:=0;
+      begin    //This means invalid data in the registry, why continue and increment result? Why not Exit(-1)?
+      //Inc(Result);   //the whole function only worked because this was called as often as when Code=0, so by change
+      //B:=0;          //it causes AV's
+      Exit(-1);
       end;
+    Inc(Result);
     P[I]:=B;
     end;
+  //writeln('TXMLRegistry.HexToBuf End: Result=',Result);
 end;
 
-Function TXMLRegistry.DeleteValue(S : String) : Boolean;
+Function TXMLRegistry.DeleteValue(S : UnicodeString) : Boolean;
 
 Var
   N : TDomElement;
@@ -628,31 +666,31 @@ begin
     end;
 end;
 
-Function TXMLRegistry.GetValueSize(Name : String) : Integer;
+Function TXMLRegistry.GetValueSize(Name : UnicodeString) : Integer;
 
 Var
   Info : TDataInfo;
 
 begin
-  If GetValueInfo(Name,Info) then
+  If GetValueInfo(Name,Info,True) then
     Result:=Info.DataSize
   else
     Result:=-1;
 end;
 
-Function TXMLRegistry.GetValueType(Name : String) : TDataType;
+Function TXMLRegistry.GetValueType(Name : UnicodeString) : TDataType;
 
 Var
   Info : TDataInfo;
 
 begin
-  If GetValueInfo(Name,Info) then
+  If GetValueInfo(Name,Info,True) then
     Result:=Info.DataType
   else
     Result:=dtUnknown;
 end;
 
-function TXmlRegistry.GetValueInfo(Name: String; out Info: TDataInfo; AsUnicode: Boolean): Boolean;
+function TXmlRegistry.GetValueInfo(Name: UnicodeString; out Info: TDataInfo; AsUnicode: Boolean): Boolean;
 
 Var
   N  : TDomElement;
@@ -671,7 +709,7 @@ begin
         L:=Length(DN.NodeValue)*SizeOf(UnicodeChar)
       else
         begin
-        S := UTF8Encode(DN.NodeValue);
+        S := DN.NodeValue;
         L:=Length(S);
         end
       end
@@ -679,7 +717,7 @@ begin
       L:=0;
     With Info do
       begin
-      DataType:=TDataType(StrToIntDef(N[SType],0));
+      DataType:=TDataType(StrToIntDef(String(N[SType]),0));
       Case DataType of
         dtUnknown : DataSize:=0;
         dtDword   : Datasize:=SizeOf(Cardinal);
@@ -724,10 +762,10 @@ begin
               ValueLen:=L;
             DataNode:=TDomElement(Node).FirstChild;
             If (DataNode<>Nil) and (DataNode is TDomText) then
-              Case TDataType(StrToIntDef(TDomElement(Node)[SType],0)) of
+              Case TDataType(StrToIntDef(String(TDomElement(Node)[SType]),0)) of
                 dtUnknown : L:=0;
                 dtDWord   : L:=4;
-                DtString  : L:=Length(UTF8Encode(DataNode.NodeValue));
+                DtString  : L:=Length(String(DataNode.NodeValue));
                 dtBinary  : L:=Length(DataNode.NodeValue) div 2;
               end
             else
@@ -761,6 +799,37 @@ begin
     end;
 end;
 
+function TXmlRegistry.EnumSubKeys: TUnicodeStringArray;
+
+Var
+  Node : TDOMNode;
+  Len, Count: Integer;
+
+begin
+  Result:=nil;
+  If FCurrentElement<>Nil then
+    begin
+    Node:=FCurrentElement.FirstChild;
+    Len:=0;
+    Count:=0;
+    While Assigned(Node) do
+      begin
+      If (Node.NodeType=ELEMENT_NODE) and (Node.NodeName=SKey) then
+        begin
+        Inc(Count);
+        if (Count>Len) then
+          begin
+          Inc(Len,10); //avoid calling SetLength on each addition
+          SetLength(Result,Len);
+          end;
+        Result[Count-1]:=TDomElement(Node)[SName];
+        end;
+      Node:=Node.NextSibling;
+      end;
+    SetLength(Result,Count);
+    end;
+end;
+
 Function TXMLRegistry.EnumValues(List : TStrings) : Integer;
 
 Var
@@ -775,20 +844,52 @@ begin
     While Assigned(Node) do
       begin
       If (Node.NodeType=ELEMENT_NODE) and (Node.NodeName=SValue) then
-        List.Add(TDomElement(Node)[SName]);
+        If (Node.NodeType=ELEMENT_NODE) and (Node.NodeName=SValue) then
+          List.Add(TDomElement(Node)[SName]);
       Node:=Node.NextSibling;
       end;
     Result:=List.Count;
     end;
 end;
 
-Function TXMLRegistry.KeyExists(KeyPath : String) : Boolean;
+Function TXMLRegistry.EnumValues: TUnicodeStringArray;
+
+Var
+  Node : TDOMNode;
+  Len, Count: Integer;
+begin
+  Result:=nil;
+  If FCurrentElement<>Nil then
+    begin
+    Node:=FCurrentElement.FirstChild;
+    Count:=0;
+    Len:=0;
+    While Assigned(Node) do
+      begin
+      If (Node.NodeType=ELEMENT_NODE) and (Node.NodeName=SValue) then
+        begin
+        Inc(Count);
+        if (Count>Len) then
+          begin
+          Inc(Len,10); //avoid calling SetLength on each addition
+          SetLength(Result,Len);
+          end;
+        Result[Count-1]:=TDomElement(Node)[SName];
+        end;
+      Node:=Node.NextSibling;
+      end;
+    SetLength(Result,Count);
+    end;
+end;
+
+
+Function TXMLRegistry.KeyExists(KeyPath : UnicodeString) : Boolean;
 
 begin
   Result:=FindKey(KeyPath)<>Nil;
 end;
 
-Function TXMLRegistry.RenameValue(Const OldName,NewName : String) : Boolean;
+Function TXMLRegistry.RenameValue(Const OldName,NewName : UnicodeString) : Boolean;
 
 Var
   N : TDomElement;
@@ -804,10 +905,10 @@ begin
     end;
 end;
 
-Function TXMLRegistry.FindKey (S : String) : TDomElement;
+Function TXMLRegistry.FindKey (S : UnicodeString) : TDomElement;
 
 Var
-  SubKey : String;
+  SubKey : UnicodeString;
   P : Integer;
   Node : TDomElement;
 
@@ -840,7 +941,7 @@ begin
   Until (Result=Nil) or (Length(S)=0);
 end;
 
-Function  TXmlRegistry.ValueExists(ValueName : String) : Boolean;
+Function  TXmlRegistry.ValueExists(ValueName : UnicodeString) : Boolean;
 
 begin
   Result:=FindValueKey(ValueName)<>Nil;

packages/fcl-registry/src/xregreg.inc

@@ -20,6 +20,7 @@ begin
     rdInteger               : Result := dtDword;
     rdBinary                : Result := dtBinary;
     rdMultiString           : Result := dtStrings;
+    rdInt64                 : Result := dtQword;
   else
     Raise ERegistryException.CreateFmt(SErrTypeNotSupported,[GetEnumName(TypeInfo(TRegDataType),Ord(RegData))]);
   end;
@@ -31,6 +32,7 @@ begin
   Case DataType of
     dtUnknown: Result:=rdUnknown;
     dtDword  : Result:=rdInteger;
+    dtQword  : Result:=rdInt64;
     dtString : Result:=rdString;
     dtBinary : Result:=rdBinary;
     dtStrings : Result:=rdMultiString;
@@ -116,7 +118,11 @@ end;
 procedure TRegistry.SysRegCreate;
 var s : string;
 begin
+  FStringSizeIncludesNull:=False;
   s:=includetrailingpathdelimiter(GetAppConfigDir(GlobalXMLFile));
+  {$ifdef XMLRegfile_in_CurDir}
+  s:='.' + PathDelim;
+  {$endif}
   ForceDirectories(s);
   FSysData:=TXMLRegistryInstance.GetXMLRegistry(s+XFileName);
   TXmlRegistry(FSysData).AutoFlush:=False;
@@ -130,24 +136,24 @@ begin
   TXMLRegistryInstance.FreeXMLRegistry(TXMLRegistry(FSysData));
 end;
 
-function TRegistry.SysCreateKey(const Key: String): Boolean;
+function TRegistry.SysCreateKey(Key: UnicodeString): Boolean;
 
 begin
   Result:=TXmlRegistry(FSysData).CreateKey(Key);
 end;
 
-function TRegistry.DeleteKey(const Key: string): Boolean;
+function TRegistry.DeleteKey(const Key: UnicodeString): Boolean;
 
 begin
   Result:=TXMLRegistry(FSysData).DeleteKey(Key);
 end;
 
-function TRegistry.DeleteValue(const Name: string): Boolean;
+function TRegistry.DeleteValue(const Name: UnicodeString): Boolean;
 begin
   Result:=TXmlRegistry(FSysData).DeleteValue(Name);
 end;
 
-function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
+function TRegistry.SysGetData(const Name: UnicodeString; Buffer: Pointer;
           BufSize: Integer; Out RegData: TRegDataType): Integer;
 
 Var
@@ -160,7 +166,7 @@ begin
     Result:=-1;
 end;
 
-function TRegistry.GetDataInfo(const ValueName: string; out Value: TRegDataInfo): Boolean;
+function TRegistry.GetDataInfo(const ValueName: UnicodeString; out Value: TRegDataInfo): Boolean;
 
 Var
   Info : TDataInfo;
@@ -181,7 +187,7 @@ begin
       end;
 end;
 
-function TRegistry.GetKey(const Key: string): HKEY;
+function TRegistry.GetKey(Key: UnicodeString): HKEY;
 begin
   Result := 0;
 end;
@@ -205,91 +211,94 @@ begin
       end;
 end;
 
-function TRegistry.KeyExists(const Key: string): Boolean;
+function TRegistry.KeyExists(const Key: UnicodeString): Boolean;
 begin
   Result:=TXmlRegistry(FSysData).KeyExists(Key);
 end;
 
-function TRegistry.LoadKey(const Key, FileName: string): Boolean;
+function TRegistry.LoadKey(const Key, FileName: UnicodeString): Boolean;
 begin
   Result := False;
 end;
 
-function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
+function TRegistry.OpenKey(const Key: UnicodeString; CanCreate: Boolean): Boolean;
 
 begin
   Result:=TXmlRegistry(FSysData).SetKey(Key,CanCreate);
   FCurrentKey:=1;
 end;
 
-function TRegistry.OpenKeyReadOnly(const Key: string): Boolean;
+function TRegistry.OpenKeyReadOnly(const Key: UnicodeString): Boolean;
 
 begin
   Result:=TXmlRegistry(FSysData).SetKey(Key,False);
 end;
 
-function TRegistry.RegistryConnect(const UNCName: string): Boolean;
+function TRegistry.RegistryConnect(const UNCName: UnicodeString): Boolean;
 begin
   Result := True;
 end;
 
-function TRegistry.ReplaceKey(const Key, FileName, BackUpFileName: string): Boolean;
+function TRegistry.ReplaceKey(const Key, FileName, BackUpFileName: UnicodeString): Boolean;
 begin
   Result := False;
 end;
 
-function TRegistry.RestoreKey(const Key, FileName: string): Boolean;
+function TRegistry.RestoreKey(const Key, FileName: UnicodeString): Boolean;
 begin
   Result := False;
 end;
 
-function TRegistry.SaveKey(const Key, FileName: string): Boolean;
+function TRegistry.SaveKey(const Key, FileName: UnicodeString): Boolean;
 begin
   Result := False;
 end;
 
-function TRegistry.UnLoadKey(const Key: string): Boolean;
+function TRegistry.UnLoadKey(const Key: UnicodeString): Boolean;
 begin
   Result := False;
 end;
 
-function TRegistry.ValueExists(const Name: string): Boolean;
+function TRegistry.ValueExists(const Name: UnicodeString): Boolean;
 begin
   Result := TXmlRegistry(FSysData).ValueExists(Name);
 end;
 
-procedure TRegistry.ChangeKey(Value: HKey; const Path: string);
+procedure TRegistry.ChangeKey(Value: HKey; const Path: UnicodeString);
 begin
 
 end;
 
-procedure TRegistry.GetKeyNames(Strings: TStrings);
+function TRegistry.GetKeyNames: TUnicodeStringArray;
 begin
-  TXmlRegistry(FSysData).EnumSubKeys(Strings);
+  Result:=TXmlRegistry(FSysData).EnumSubKeys;
 end;
 
-procedure TRegistry.GetValueNames(Strings: TStrings);
+function TRegistry.GetValueNames: TUnicodeStringArray;
 begin
-  TXmlRegistry(FSysData).EnumValues(Strings);
+  Result := TXmlRegistry(FSysData).EnumValues;
 end;
 
 
-function TRegistry.SysPutData(const Name: string; Buffer: Pointer;
+function TRegistry.SysPutData(const Name: UnicodeString; Buffer: Pointer;
   BufSize: Integer; RegData: TRegDataType): Boolean;
 
 Var
   DataType : TDataType;
 
 begin
+  //writeln('TRegistry.SysPutData: Name=',Name,', RegData=',RegData,', BufSize=',BufSize);
   DataType:=RegDataTypeToXmlDataType(RegData);
+
   Result:=TXMLRegistry(FSysData).SetValueDataUnicode(Name,DataType,Buffer^,BufSize);
 end;
 
-procedure TRegistry.RenameValue(const OldName, NewName: string);
+procedure TRegistry.RenameValue(const OldName, NewName: UnicodeString);
 begin
   TXMLRegistry(FSysData).RenameValue(OldName,NewName);
 end;
 
+
 procedure TRegistry.SetCurrentKey(Value: HKEY);
 begin
   fCurrentKey := Value;
@@ -298,7 +307,7 @@ end;
 procedure TRegistry.SetRootKey(Value: HKEY);
 
 Var
-  S: String;
+  S: UnicodeString;
 
 begin
   If (Value=HKEY_CLASSES_ROOT) then
@@ -347,3 +356,5 @@ begin
     TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
   end;
 end;
+
+

packages/fcl-registry/tests/regtestframework.pp

@@ -9,11 +9,14 @@ program regtestframework;
 {$ENDIF}
 
 uses
+  {$ifdef unix}
+  cwstring,
+  {$endif}
   SysUtils,
-  fpcunit,  testreport, testregistry,
+  fpcunit,  testreport, testregistry, consoletestrunner,
 // Units wich contains the tests
   tcxmlreg,
-  testbasics, consoletestrunner;
+  testbasics;
 
 Var
   A : TTestRunner;

packages/fcl-registry/tests/tcxmlreg.pp

@@ -66,7 +66,6 @@ procedure TTestXMLRegistry.TestReadBufDataString;
 
 Var
   S1,S2 : String;
-  I : Smallint;
   DS : Integer;
   dt : TDataType;
 

packages/fcl-registry/tests/testbasics.pp

@@ -22,6 +22,9 @@ type
     procedure TestDoubleWrite;
     procedure bug16395;
     procedure TestAdv;
+    procedure TestStringList;
+    Procedure TestInt64;
+    Procedure TestDeleteSubkey;
   end;
 
 implementation
@@ -171,6 +174,118 @@ begin
 {$endif windows}
 end;
 
+Procedure TTestBasics.TestStringList;
+
+Var
+  SL : TStringList;
+  I : Integer;
+
+begin
+  With TRegistry.Create do
+    try
+      RootKey:=HKEY_CURRENT_USER;
+      OpenKey('Software/Test',True);
+      SL:=TstringList.Create;
+      For I:=0 to 10 do
+        SL.Add(IntToStr(I));
+      WriteStringList('me',SL);
+      SL.Clear;
+      ReadStringList('me',SL);
+      For I:=0 to 10 do
+        AssertEquals('String '+IntToStr(i),IntToStr(I),SL[I]);
+    finally
+      Free;
+    end;
+end;
+
+
+procedure TTestBasics.TestInt64;
+
+  
+
+Var
+  Def,I64 : Int64;
+    
+begin
+  def:=MaxInt*1024; 
+  With TRegistry.Create do
+    try
+      RootKey:=HKEY_CURRENT_USER;
+      OpenKey('Software/Test',True);
+      WriteInt64('you',Def);
+      I64:=ReadInt64('you');
+      AssertEquals('Value written and read',Def,I64);
+    finally
+      Free;
+    end;  
+end;
+
+procedure TTestBasics.TestDeleteSubKey;
+
+const
+  BugID = 'Bug35132';
+  Base = 'Software\' + BugID;
+  One = 'One';
+  OneFull = Base + '\' + One;
+  Two = 'Two';
+  TwoFull = OneFull + '\' + Two;
+
+
+procedure CleanUp(AssertionFailed: Boolean);
+var
+  R: TRegistry;
+  B: Boolean;
+begin
+  R := TRegistry.Create(KEY_ALL_ACCESS);
+  try
+  R.RootKey := HKEY_CURRENT_USER;
+  if R.KeyExists(TwoFull) then
+  begin
+    B := R. DeleteKey(TwoFull);
+    if B then B := R.DeleteKey(OneFull);
+    if B then B := R.DeleteKey(Base);
+    AssertTrue('cleanup OK',B);
+  end;
+  finally
+    R.Free;
+  end;
+end;
+
+var
+  R: TRegistry;
+  B: Boolean;
+begin
+  R := TRegistry.Create(KEY_ALL_ACCESS);
+  try
+    R.RootKey := HKEY_CURRENT_USER;
+
+    B := R.OpenKey(Base, True);
+    AssertTrue(format('OpenKey(''%s'') failed.',[Base]),B);
+
+    B := R.OpenKey('One',True);
+    AssertTrue(format('OpenKey(''%s'') failed.',[OneFull]),B);
+
+    B := R.OpenKey('Two',True);
+    AssertTrue(format('OpenKey(''%s'') failed.',[TwoFull]),B);
+
+    R.CloseKey;
+
+    B := R.KeyExists(TwoFull);
+    AssertTrue(format('KeyExists(''%s'') failed.',[TwoFull]),B);
+
+    R.CloseKey;
+    B := R.OpenKey(Base,False);
+    AssertTrue(format('OpenKey(''%s'') failed.',[Base]),B);
+
+    B := R.DeleteKey('One');
+    AssertFalse(format('DeleteKey(''%s'') should have failed, but it succeeded.',[OneFull]),B);
+  finally
+    R.Free;
+    CleanUp(ExceptObject <> nil);
+  end;
+end;
+
+
 initialization
   RegisterTest(TTestBasics);
 end.

packages/fcl-report/src/fpreport.pp

@@ -2062,7 +2062,8 @@ type
     property    ShapeType;
     property    Orientation;
     property    CornerRadius;
-    property    Color;
+    property    Color; 
+    property    StretchMode;
   end;
 
 
@@ -5176,8 +5177,13 @@ begin
 end;
 
 procedure TFPReportCustomShape.RecalcLayout;
+var
+  h: TFPReportUnits;
 begin
-  // Do nothing
+  if StretchMode = smDontStretch then
+    exit;
+  h := Layout.Height;
+  ApplyStretchMode(h);
 end;
 
 procedure TFPReportCustomShape.DoWriteLocalProperties(AWriter: TFPReportStreamer; AOriginal: TFPReportElement);
@@ -8601,6 +8607,7 @@ begin
     // local properties
     AWriter.WriteString('Title', Title);
     AWriter.WriteString('Author', Author);
+    AWriter.WriteBoolean('TwoPass',TwoPass);
     AWriter.WriteDateTime('DateCreated', DateCreated);
     // now the design-time images
     AWriter.PushElement('Images');
@@ -8669,6 +8676,7 @@ begin
       inherited ReadElement(AReader);
       FTitle := AReader.ReadString('Title', Title);
       FAuthor := AReader.ReadString('Author', Author);
+      FTwoPass := AReader.ReadBoolean('TwoPass',TwoPass);
       FDateCreated := AReader.ReadDateTime('DateCreated', Now);
 
       E := AReader.FindChild('Images');

packages/fcl-report/src/fpreportstreamer.pp

@@ -133,6 +133,7 @@ type
     function    StreamToHex(S: TStream): String;
     function    StreamsEqual(S1, S2: TStream): Boolean;
     function    HexToStringStream(S: String): TStringStream;
+    function    HexToMemoryStream(S: String): TMemoryStream;
     property    JSON: TJSONObject read Fjson write SetJSON;
     Property    OwnsJSON : Boolean Read FOwnsJSON Write SetOwnsJSON;
     property    CurrentElement: TJSONObject read FCurrentElement write SetCurrentElement;
@@ -447,17 +448,17 @@ end;
 function TFPReportJSONStreamer.ReadStream(AName: String; AValue: TStream): Boolean;
 var
   S: string;
-  SS: TStringStream;
+  MS : TMemoryStream;
 begin
   S := ReadString(AName, '');
   Result := (S <> '');
   if Result then
   begin
-    SS := HexToStringStream(S);
+    MS := HexToMemoryStream(S);
     try
-      AValue.CopyFrom(SS, 0);
+      AValue.CopyFrom(MS, 0);
     finally
-      SS.Free;
+      MS.Free();
     end;
   end;
 end;
@@ -698,4 +699,37 @@ begin
   end;
 end;
 
+function TFPReportJSONStreamer.HexToMemoryStream(S: String): TMemoryStream;
+var
+  T: array of Byte;
+  I, J: integer;
+  B: byte;
+  P: PByte;
+  H: string[3];
+begin
+  Result := nil;
+  SetLength(H, 3);
+  H[1] := '$';
+  if (S <> '') then
+  begin
+    SetLength(T, Length(S) div 2);
+    P := @T[0];
+    I := 1;
+    while I < Length(S) do
+    begin
+      H[2] := S[i];
+      Inc(I);
+      H[3] := S[i];
+      Inc(I);
+      Val(H, B, J);
+      if (J = 0) then
+        P^ := B
+      else
+        P^ := 0;
+      Inc(P);
+    end;
+    Result := TBytesStream.Create(T);
+  end;
+end;
+
 end.

packages/fcl-web/src/restbridge/sqldbrestauth.pp

@@ -65,6 +65,7 @@ Type
     Constructor Create(AOwner :TComponent); override;
     Destructor Destroy; override;
     class function ExtractUserNamePassword(Req: TRequest; out UN, PW: UTF8String): Boolean;
+    class function ExtractUserName(Req: TRequest) : UTF8String;
     Function NeedConnection : Boolean; override;
     function DoAuthenticateRequest(IO : TRestIO) : Boolean; override;
   Published
@@ -133,13 +134,14 @@ begin
   Result:=HaveAuthSQL and (AuthConnection=Nil);
 end;
 
-Function TRestBasicAuthenticator.HaveAuthSQL : Boolean;
+function TRestBasicAuthenticator.HaveAuthSQL: Boolean;
 
 begin
   Result:=(FAuthSQL.Count>0) and (Trim(FAuthSQL.Text)<>'');
 end;
 
-function TRestBasicAuthenticator.AuthenticateUserUsingSQl(IO : TRestIO; Const UN,PW : UTF8String; Out UID : UTF8String) : Boolean;
+function TRestBasicAuthenticator.AuthenticateUserUsingSQl(IO: TRestIO;
+  const UN, PW: UTF8String; out UID: UTF8String): Boolean;
 
 Var
   Conn : TSQLConnection;
@@ -179,7 +181,8 @@ begin
   end;
 end;
 
-Class Function TRestBasicAuthenticator.ExtractUserNamePassword(Req : TRequest; Out UN,PW : UTF8String) : Boolean;
+class function TRestBasicAuthenticator.ExtractUserNamePassword(Req: TRequest;
+  out UN, PW: UTF8String): Boolean;
 
 Var
   S,A : String;
@@ -204,7 +207,17 @@ begin
     end;
 end;
 
-function TRestBasicAuthenticator.DoAuthenticateRequest(io: TRestIO): Boolean;
+class function TRestBasicAuthenticator.ExtractUserName(Req: TRequest): UTF8String;
+
+Var
+  PW : UTF8String;
+
+begin
+  if not ExtractUserNamePassword(Req,Result,PW) then
+    Result:='?';
+end;
+
+function TRestBasicAuthenticator.DoAuthenticateRequest(IO: TRestIO): Boolean;
 
 Var
   UID,UN,PW : UTF8String;

packages/fcl-web/src/restbridge/sqldbrestbridge.pp

@@ -19,14 +19,34 @@ unit sqldbrestbridge;
 interface
 
 uses
-  Classes, SysUtils, DB, SQLDB, httpdefs, httproute, fpjson, sqldbrestschema, sqldbrestio, sqldbrestdata, sqldbrestauth;
+  Classes, SysUtils, DB, SqlTypes, SQLDB, httpdefs, httproute, fpjson, sqldbrestschema, sqldbrestio, sqldbrestdata, sqldbrestauth;
 
 Type
-  TRestDispatcherOption = (rdoConnectionInURL,rdoExposeMetadata,rdoCustomView,rdoHandleCORS,rdoAccessCheckNeedsDB);
+  TRestDispatcherOption = (rdoConnectionInURL,     // Route includes connection :Connection/:Resource[/:ID]
+                           rdoExposeMetadata,      // expose metadata resource /metadata[/:Resource]
+                           rdoCustomView,          // Expose custom view /customview
+                           rdoHandleCORS,          // Handle CORS requests
+                           rdoAccessCheckNeedsDB,  // Authenticate after connection to database was made.
+                           rdoConnectionResource   // Enable connection managament through /_connection[/:Conn] resource
+                           // rdoServerInfo        // Enable querying server info through /_serverinfo  resource
+                           );
+
   TRestDispatcherOptions = set of TRestDispatcherOption;
+  TRestDispatcherLogOption = (rloUser,           // Include username in log messages, when available
+                              rtloHTTP,          // Log HTTP request (remote, URL)
+                              rloResource,       // Log resource requests (operation, resource)
+                              rloConnection,     // Log database connections (connect to database)
+                              rloAuthentication, // Log authentication attempt
+                              rloSQL,            // Log SQL statements. (not on user-supplied connection)
+                              rloResultStatus    // Log result status.
+                             );
+  TRestDispatcherLogOptions = Set of TRestDispatcherLogOption;
 
 Const
   DefaultDispatcherOptions = [rdoExposeMetadata];
+  AllDispatcherLogOptions = [Low(TRestDispatcherLogOption)..High(TRestDispatcherLogOption)];
+  DefaultDispatcherLogOptions = AllDispatcherLogOptions-[rloSQL];
+  DefaultLogSQLOptions = LogAllEvents;
 
 Type
 
@@ -45,6 +65,7 @@ Type
     FPassword: UTF8String;
     FPort: Word;
     FRole: UTF8String;
+    FSchemaName: UTF8String;
     FUserName: UTF8String;
     FNotifier : TComponent;
     function GetName: UTF8String;
@@ -52,6 +73,8 @@ Type
     procedure SetParams(AValue: TStrings);
   Protected
     Function GetDisplayName: string; override;
+    // For use in the REST Connection resource
+    Property SchemaName : UTF8String Read FSchemaName Write FSchemaName;
   Public
     constructor Create(ACollection: TCollection); override;
     Destructor Destroy; override;
@@ -92,9 +115,9 @@ Type
     procedure SetConn(aIndex : integer; AValue: TSQLDBRestConnection);
   Public
     // Index of connection by name (case insensitive)
-    Function IndexOfConnection(const aName : string) : Integer;
+    Function IndexOfConnection(const aName : UTF8string) : Integer;
     // Find connection by name (case insensitive), nil if none found
-    Function FindConnection(const aName : string) :  TSQLDBRestConnection;
+    Function FindConnection(const aName : UTF8string) :  TSQLDBRestConnection;
     // Add new instance, setting basic properties. Return new instance
     Function AddConnection(Const AType,aHostName,aDatabaseName,aUserName,aPassword : UTF8String) : TSQLDBRestConnection;
     // Save connection definitions to JSON file.
@@ -142,6 +165,7 @@ Type
     procedure SetSchema(aIndex : Integer; AValue: TSQLDBRestSchemaRef);
   Public
     Function AddSchema (aSchema : TSQLDBRestSchema) : TSQLDBRestSchemaRef;
+    Function IndexOfSchema(aSchemaName : String) : Integer;
     Property Schemas[aIndex :Integer] : TSQLDBRestSchemaRef Read GetSchema Write SetSchema;default;
   end;
 
@@ -155,20 +179,25 @@ Type
   TRestExceptionEvent = Procedure(Sender : TObject; aRequest : TRequest; Const AResource : string; E : Exception) of object;
   TRestOperationEvent = Procedure(Sender : TObject; aConn: TSQLConnection; aResource : TSQLDBRestResource) of object;
   TRestGetFormatEvent = Procedure(Sender : TObject; aRest : TRequest; var aFormat : String) of object;
+  TRestLogEvent = Procedure(Sender : TObject; aType : TRestDispatcherLogOption; Const aMessage : UTF8String) of object;
 
   TSQLDBRestDispatcher = Class(TComponent)
   Private
     Class Var FIOClass : TRestIOClass;
     Class Var FDBHandlerClass : TSQLDBRestDBHandlerClass;
   private
+    FAdminUserIDs: TStrings;
     FCORSAllowCredentials: Boolean;
     FCORSAllowedOrigins: String;
     FCORSMaxAge: Integer;
+    FDBLogOptions: TDBEventTypes;
     FDispatchOptions: TRestDispatcherOptions;
     FInputFormat: String;
     FCustomViewResource : TSQLDBRestResource;
+    FLogOptions: TRestDispatcherLogOptions;
     FMetadataResource : TSQLDBRestResource;
     FMetadataDetailResource : TSQLDBRestResource;
+    FConnectionResource : TSQLDBRestResource;
     FActive: Boolean;
     FAfterDelete: TRestOperationEvent;
     FAfterGet: TRestOperationEvent;
@@ -190,21 +219,35 @@ Type
     FOnGetConnectionName: TGetConnectionNameEvent;
     FOnGetInputFormat: TRestGetFormatEvent;
     FOnGetOutputFormat: TRestGetFormatEvent;
+    FOnLog: TRestLogEvent;
     FOutputFormat: String;
     FOutputOptions: TRestOutputoptions;
     FSchemas: TSQLDBRestSchemaList;
     FListRoute: THTTPRoute;
     FItemRoute: THTTPRoute;
+    FConnectionsRoute: THTTPRoute;
+    FConnectionItemRoute: THTTPRoute;
+    FMetadataRoute: THTTPRoute;
+    FMetadataItemRoute: THTTPRoute;
     FStatus: TRestStatusConfig;
     FStrings: TRestStringsConfig;
     procedure SetActive(AValue: Boolean);
+    procedure SetAdminUserIDS(AValue: TStrings);
     procedure SetAuthenticator(AValue: TRestAuthenticator);
     procedure SetConnections(AValue: TSQLDBRestConnectionList);
+    procedure SetDispatchOptions(AValue: TRestDispatcherOptions);
     procedure SetSchemas(AValue: TSQLDBRestSchemaList);
     procedure SetStatus(AValue: TRestStatusConfig);
     procedure SetStrings(AValue: TRestStringsConfig);
   Protected
+    // Logging
+    Function MustLog(aLog : TRestDispatcherLogOption) : Boolean; inline;
+    procedure DoSQLLog(Sender: TObject; EventType: TDBEventType;  const Msg: String); virtual;
+    procedure DoLog(aLog: TRestDispatcherLogOption; IO : TRestIO; const aMessage: UTF8String);  virtual;
+    procedure DoLog(aLog: TRestDispatcherLogOption; IO : TRestIO; const Fmt: UTF8String;
+      Args: array of const);
     // Auxiliary methods.
+    Procedure Loaded; override;
     Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     function FindConnection(IO: TRestIO): TSQLDBRestConnection;
     // Factory methods. Override these to customize various helper classes.
@@ -222,6 +265,13 @@ Type
     function GetConnectionName(IO: TRestIO): UTF8String;
     function GetSQLConnection(aConnection: TSQLDBRestConnection; Out aTransaction : TSQLTransaction): TSQLConnection; virtual;
     procedure DoneSQLConnection(aConnection: TSQLDBRestConnection; AConn: TSQLConnection; aTransaction : TSQLTransaction); virtual;
+    // Connections dataset API
+    procedure ConnectionsToDataset(D: TDataset); virtual;
+    procedure DoConnectionDelete(DataSet: TDataSet); virtual;
+    procedure DoConnectionPost(DataSet: TDataSet);virtual;
+    procedure DatasetToConnection(D: TDataset; C: TSQLDBRestConnection); virtual;
+    procedure ConnectionToDataset(C: TSQLDBRestConnection; D: TDataset); virtual;
+    procedure DoConnectionResourceAllowed(aSender: TObject; aContext: TBaseRestContext; var allowResource: Boolean);
     // Error handling
     procedure CreateErrorContent(IO: TRestIO; aCode: Integer; AExtraMessage: UTF8String); virtual;
     procedure HandleException(E: Exception; IO: TRestIO); virtual;
@@ -245,8 +295,10 @@ Type
     // Special resources for Metadata handling
     function CreateMetadataDataset(IO: TRestIO; AOwner: TComponent): TDataset; virtual;
     function CreateMetadataDetailDataset(IO: TRestIO; Const aResourceName : String; AOwner: TComponent): TDataset; virtual;
+    function CreateConnectionDataset(IO: TRestIO; AOwner: TComponent): TDataset; virtual;
     function CreateMetadataDetailResource: TSQLDBRestResource;  virtual;
     function CreateMetadataResource: TSQLDBRestResource; virtual;
+    Function CreateConnectionResource : TSQLDBRestResource; virtual;
     // Custom view handling
     function CreateCustomViewResource: TSQLDBRestResource; virtual;
     function CreateCustomViewDataset(IO: TRestIO; const aSQL: String; AOwner: TComponent): TDataset;
@@ -266,6 +318,8 @@ Type
     Destructor Destroy; override;
     procedure RegisterRoutes;
     procedure UnRegisterRoutes;
+    procedure HandleMetadataRequest(aRequest : TRequest; aResponse : TResponse);
+    procedure HandleConnRequest(aRequest : TRequest; aResponse : TResponse);
     procedure HandleRequest(aRequest : TRequest; aResponse : TResponse);
     Function ExposeDatabase(Const aType,aHostName,aDatabaseName,aUserName,aPassword : String; aTables : Array of String; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestConnection;
     Function ExposeDatabase(Const aType,aHostName,aDatabaseName,aUserName,aPassword : String; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestConnection;
@@ -281,6 +335,8 @@ Type
     // Base URL
     property BasePath : UTF8String Read FBaseURL Write FBaseURL;
     // Default connection to use if none is detected from request/schema
+    // This connection will also be used to authenticate the user for connection API,
+    // so it must be set if you use SQL to authenticate the user.
     Property DefaultConnection : UTF8String Read FDefaultConnection Write FDefaultConnection;
     // Input/Output strings configuration
     Property Strings : TRestStringsConfig Read FStrings Write SetStrings;
@@ -293,7 +349,7 @@ Type
     // Set this to allow only this output format.
     Property OutputFormat : String Read FOutputFormat Write FOutputFormat;
     // Dispatcher options
-    Property DispatchOptions : TRestDispatcherOptions Read FDispatchOptions Write FDispatchOptions default DefaultDispatcherOptions;
+    Property DispatchOptions : TRestDispatcherOptions Read FDispatchOptions Write SetDispatchOptions default DefaultDispatcherOptions;
     // Authenticator for requests
     Property Authenticator : TRestAuthenticator Read FAuthenticator Write SetAuthenticator;
     // If >0, Enforce a limit on output results.
@@ -304,6 +360,12 @@ Type
     Property CORSMaxAge : Integer Read FCORSMaxAge Write FCORSMaxAge;
     // Access-Control-Allow-Credentials header value. Set to zero not to send the header
     Property CORSAllowCredentials : Boolean Read FCORSAllowCredentials Write FCORSAllowCredentials;
+    // UserIDs of the user(s) that are allowed to see and modify the connection resource.
+    Property AdminUserIDs : TStrings Read FAdminUserIDs Write SetAdminUserIDS;
+    // Logging options
+    Property LogOptions : TRestDispatcherLogOptions Read FLogOptions write FLogOptions default DefaultDispatcherLogOptions;
+    // SQL Log options. Only for connections managed by RestDispatcher
+    Property LogSQLOptions : TDBEventTypes Read FDBLogOptions write FDBLogOptions default DefaultLogSQLOptions;
     // Called when Basic authentication is sufficient.
     Property OnBasicAuthentication : TBasicAuthenticationEvent Read FOnBasicAuthentication Write FOnBasicAuthentication;
     // Allow a particular resource or not.
@@ -334,9 +396,14 @@ Type
     Property BeforeDelete : TRestOperationEvent Read FBeforeDelete Write FBeforeDelete;
     // Called After a DELETE request.
     Property AfterDelete : TRestOperationEvent Read FAfterDelete Write FAfterDelete;
+    // Called when logging
+    Property OnLog : TRestLogEvent Read FOnLog Write FOnLog;
   end;
 
-
+Const
+  LogNames : Array[TRestDispatcherLogOption] of string = (
+    'User','HTTP','Resource','Connection','Authentication','SQL','Result'
+  );
 
 implementation
 
@@ -406,6 +473,13 @@ begin
   Result.Enabled:=True;
 end;
 
+function TSQLDBRestSchemaList.IndexOfSchema(aSchemaName: String): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and Not (Assigned(GetSchema(Result).Schema) and SameText(GetSchema(Result).Schema.Name,aSchemaName)) do
+    Dec(Result);
+end;
+
 { TSQLDBRestDispatcher }
 
 procedure TSQLDBRestDispatcher.SetConnections(AValue: TSQLDBRestConnectionList);
@@ -414,15 +488,40 @@ begin
   FConnections.Assign(AValue);
 end;
 
+procedure TSQLDBRestDispatcher.SetDispatchOptions(AValue: TRestDispatcherOptions);
+
+begin
+  if (rdoConnectionResource in aValue) then
+    Include(aValue,rdoConnectionInURL);
+  if FDispatchOptions=AValue then Exit;
+  FDispatchOptions:=AValue;
+end;
+
+procedure TSQLDBRestDispatcher.DoConnectionResourceAllowed(aSender: TObject;
+  aContext: TBaseRestContext; var allowResource: Boolean);
+begin
+  AllowResource:=(AdminUserIDs.Count=0) or  (AdminUserIDs.IndexOf(aContext.UserID)<>-1);
+end;
+
+
 procedure TSQLDBRestDispatcher.SetActive(AValue: Boolean);
 begin
-  if FActive=AValue then Exit;
-  if AValue then
-    DoRegisterRoutes
-  else
-    UnRegisterRoutes;
+  if FActive=AValue then
+    Exit;
+  if Not (csLoading in ComponentState) then
+    begin
+    if AValue then
+      DoRegisterRoutes
+    else
+      UnRegisterRoutes;
+    end;
   FActive:=AValue;
+end;
 
+procedure TSQLDBRestDispatcher.SetAdminUserIDS(AValue: TStrings);
+begin
+  if FAdminUserIDs=AValue then Exit;
+  FAdminUserIDs.Assign(AValue);
 end;
 
 procedure TSQLDBRestDispatcher.SetAuthenticator(AValue: TRestAuthenticator);
@@ -453,18 +552,133 @@ begin
   FStrings.Assign(AValue);
 end;
 
+function TSQLDBRestDispatcher.MustLog(aLog: TRestDispatcherLogOption): Boolean;
+begin
+  Result:=aLog in FLogOptions;
+end;
+
+procedure TSQLDBRestDispatcher.DoSQLLog(Sender: TObject;  EventType: TDBEventType; const Msg: String);
+
+Const
+  EventNames : Array [TDBEventType] of string =
+    ('Custom','Prepare', 'Execute', 'Fetch', 'Commit', 'RollBack', 'ParamValue', 'ActualSQL');
+
+Var
+  aMsg : UTF8String;
+
+begin
+  if not MustLog(rloSQl) then // avoid string ops
+    exit;
+  aMsg:=EventNames[EventType]+': '+Msg;
+  if Sender is TRestIO then
+    DoLog(rloSQL,TRestIO(Sender),aMsg)
+  else
+    DoLog(rloSQL,Nil,aMsg)
+end;
+
+procedure TSQLDBRestDispatcher.DoLog(aLog: TRestDispatcherLogOption; IO: TRestIO; const aMessage: UTF8String);
+
+Var
+  aMsg : UTF8String;
+
+begin
+  aMsg:='';
+  if MustLog(aLog) and Assigned(FOnLog) then
+     begin
+     if MustLog(rloUser) and Assigned(IO) then
+       begin
+       if IO.UserID='' then
+         aMsg:='(User: ?) '
+       else
+         aMsg:=Format('(User: %s) ',[IO.UserID]);
+       end;
+     aMsg:=aMsg+aMessage;
+     FOnLog(Self,aLog,aMsg);
+     end;
+end;
+
+procedure TSQLDBRestDispatcher.DoLog(aLog: TRestDispatcherLogOption;IO: TRestIO;
+  const Fmt: UTF8String; Args: array of const);
+
+Var
+  S : UTF8string;
+
+begin
+  if not MustLog(aLog) then exit; // avoid expensive format
+  try
+    S:=Format(fmt,Args); // Encode ?
+  except
+    on E : exception do
+      S:=Format('Error "%s" formatting "%s" with %d arguments: %s',[E.ClassName,Fmt,Length(Args),E.Message])
+  end;
+  DoLog(aLog,IO,S);
+end;
+
+procedure TSQLDBRestDispatcher.Loaded;
+begin
+  inherited Loaded;
+  if FActive then
+    RegisterRoutes;
+end;
+
+procedure TSQLDBRestDispatcher.HandleConnRequest(aRequest : TRequest; aResponse : TResponse);
+
+begin
+  aRequest.RouteParams['resource']:=Strings.ConnectionResourceName;
+  HandleRequest(aRequest,aResponse);
+end;
+
+procedure TSQLDBRestDispatcher.HandleMetadataRequest(aRequest: TRequest;aResponse: TResponse);
+
+Var
+  LogMsg,UN : UTF8String;
+
+begin
+  if MustLog(rtloHTTP) then
+    begin
+    LogMsg:='';
+    With aRequest do
+      begin
+      UN:=RemoteHost;
+      if (UN='') then
+        UN:=RemoteAddr;
+      if (UN<>'') then
+        LogMsg:='From: '+UN+'; ';
+      LogMsg:=LogMsg+'URL: '+URL;
+      end;
+    UN:=TRestBasicAuthenticator.ExtractUserName(aRequest);
+    if (UN<>'?') then
+      LogMsg:='User: '+UN+LogMsg;
+    DoLog(rtloHTTP,Nil,LogMsg);
+    end;
+  aRequest.RouteParams['resource']:=Strings.MetadataResourceName;
+  HandleRequest(aRequest,aResponse);
+end;
+
 procedure TSQLDBRestDispatcher.DoRegisterRoutes;
 
 Var
-  Res : String;
+  Res,C : UTF8String;
 
 begin
   Res:=IncludeHTTPPathDelimiter(BasePath);
-  if rdoConnectionInURL in DispatchOptions then
+  if (rdoConnectionResource in DispatchOptions) then
+    begin
+    C:=Strings.GetRestString(rpConnectionResourceName);
+    FConnectionsRoute:=HTTPRouter.RegisterRoute(res+C,@HandleConnRequest);
+    FConnectionItemRoute:=HTTPRouter.RegisterRoute(res+C+'/:id',@HandleConnRequest);
+    end;
+  if (rdoConnectionInURL in DispatchOptions) then
+    begin
+    C:=Strings.GetRestString(rpMetadataResourceName);
+    FMetadataRoute:=HTTPRouter.RegisterRoute(res+C,@HandleMetaDataRequest);
+    FMetadataItemRoute:=HTTPRouter.RegisterRoute(res+C+'/:id',@HandleMetaDataRequest);
     Res:=Res+':connection/';
+    end;
   Res:=Res+':resource';
   FListRoute:=HTTPRouter.RegisterRoute(res,@HandleRequest);
   FItemRoute:=HTTPRouter.RegisterRoute(Res+'/:id',@HandleRequest);
+
 end;
 
 function TSQLDBRestDispatcher.GetInputFormat(IO : TRestIO) : String;
@@ -630,17 +844,22 @@ begin
   FSchemas:=CreateSchemaList;
   FOutputOptions:=allOutputOptions;
   FDispatchOptions:=DefaultDispatcherOptions;
+  FLogOptions:=DefaultDispatcherLogOptions;
+  FDBLogOptions:=DefaultLogSQLOptions;
   FStatus:=CreateRestStatusConfig;
   FCORSMaxAge:=SecsPerDay;
   FCORSAllowCredentials:=True;
+  FAdminUserIDs:=TStringList.Create;
 end;
 
 destructor TSQLDBRestDispatcher.Destroy;
 begin
   Authenticator:=Nil;
+  FreeAndNil(FAdminUserIDs);
   FreeAndNil(FCustomViewResource);
   FreeAndNil(FMetadataResource);
   FreeAndNil(FMetadataDetailResource);
+  FreeAndNil(FConnectionResource);
   FreeAndNil(FSchemas);
   FreeAndNil(FConnections);
   FreeAndNil(FStrings);
@@ -681,7 +900,10 @@ function TSQLDBRestDispatcher.CreateCustomViewResource: TSQLDBRestResource;
 begin
   Result:=TCustomViewResource.Create(Nil);
   Result.ResourceName:=FStrings.GetRestString(rpCustomViewResourceName);
-  Result.AllowedOperations:=[roGet];
+  if rdoHandleCORS in DispatchOptions then
+    Result.AllowedOperations:=[roGet,roOptions,roHead]
+  else
+    Result.AllowedOperations:=[roGet,roHead];
 end;
 
 function TSQLDBRestDispatcher.CreateMetadataResource: TSQLDBRestResource;
@@ -692,13 +914,13 @@ Var
 
 begin
   Result:=TSQLDBRestResource.Create(Nil);
-  Result.ResourceName:='metaData';
+  Result.ResourceName:=Strings.GetRestString(rpMetadataResourceName);
   if rdoHandleCORS in DispatchOptions then
     Result.AllowedOperations:=[roGet,roOptions,roHead]
   else
     Result.AllowedOperations:=[roGet,roHead];
-  Result.Fields.AddField('name',rftString,[foRequired]);
-  Result.Fields.AddField('schemaName',rftString,[foRequired]);
+  Result.Fields.AddField('name',rftString,[foRequired]).MaxLen:=255;
+  Result.Fields.AddField('schemaName',rftString,[foRequired]).MaxLen:=255;
   for O in TRestOperation do
     if O<>roUnknown then
       begin
@@ -708,6 +930,32 @@ begin
       end;
 end;
 
+function TSQLDBRestDispatcher.CreateConnectionResource: TSQLDBRestResource;
+Var
+  Def : TRestFieldOptions;
+
+begin
+  Def:=[foInInsert,foInUpdate,foFilter];
+  Result:=TSQLDBRestResource.Create(Nil);
+  Result.ResourceName:=Strings.GetRestString(rpConnectionResourceName);
+  Result.AllowedOperations:=[roGet,roPut,roPost,roDelete];
+  if rdoHandleCORS in DispatchOptions then
+    Result.AllowedOperations:=Result.AllowedOperations+[roOptions,roHead];
+  Result.Fields.AddField('name',rftString,Def+[foInKey,foRequired]);
+  Result.Fields.AddField('dbType',rftString,Def+[foRequired]);
+  Result.Fields.AddField('dbName',rftString,Def+[foRequired]);
+  Result.Fields.AddField('dbHostName',rftString,Def);
+  Result.Fields.AddField('dbUserName',rftString,Def);
+  Result.Fields.AddField('dbPassword',rftString,Def);
+  Result.Fields.AddField('dbCharSet',rftString,Def);
+  Result.Fields.AddField('dbRole',rftString,Def);
+  Result.Fields.AddField('dbPort',rftInteger,Def);
+  Result.Fields.AddField('enabled',rftBoolean,Def);
+  Result.Fields.AddField('expose',rftBoolean,Def);
+  Result.Fields.AddField('exposeSchemaName',rftString,Def);
+  Result.OnResourceAllowed:=@DoConnectionResourceAllowed;
+end;
+
 function TSQLDBRestDispatcher.CreateMetadataDetailResource: TSQLDBRestResource;
 
 Var
@@ -721,10 +969,10 @@ begin
     Result.AllowedOperations:=[roGet,roOptions,roHead]
   else
     Result.AllowedOperations:=[roGet,roHead];
-  Result.Fields.AddField('name',rftString,[]);
-  Result.Fields.AddField('type',rftString,[]);
+  Result.Fields.AddField('name',rftString,[]).MaxLen:=255;
+  Result.Fields.AddField('type',rftString,[]).MaxLen:=20;
   Result.Fields.AddField('maxlen',rftInteger,[]);
-  Result.Fields.AddField('format',rftString,[]);
+  Result.Fields.AddField('format',rftString,[]).MaxLen:=50;
   for O in TRestFieldOption do
     begin
     Str(O,S);
@@ -741,6 +989,7 @@ function TSQLDBRestDispatcher.FindSpecialResource(IO : TRestIO; aResource: UTF8S
     Result:=(rdoCustomView in DispatchOptions)
             and SameText(aResource,Strings.GetRestString(rpCustomViewResourceName));
   end;
+
   Function IsMetadata : Boolean;inline;
 
   begin
@@ -748,6 +997,13 @@ function TSQLDBRestDispatcher.FindSpecialResource(IO : TRestIO; aResource: UTF8S
             and SameText(aResource,Strings.GetRestString(rpMetaDataResourceName));
   end;
 
+  Function IsConnection : Boolean;inline;
+
+  begin
+    Result:=(rdoConnectionResource in DispatchOptions)
+            and SameText(aResource,Strings.GetRestString(rpConnectionResourceName));
+  end;
+
 Var
   N : UTF8String;
 
@@ -759,6 +1015,12 @@ begin
       FCustomViewResource:=CreateCustomViewResource;
     Result:=FCustomViewResource;
     end
+  else if IsConnection then
+    begin
+    if FConnectionResource=Nil then
+      FConnectionResource:=CreateConnectionResource;
+    Result:=FConnectionResource;
+    end
   else If isMetadata then
     if (IO.GetVariable('ID',N,[vsRoute,vsQuery])=vsNone) then
       begin
@@ -775,7 +1037,6 @@ begin
         Result:=FMetadataDetailResource;
         end;
       end
-
 end;
 
 function TSQLDBRestDispatcher.FindRestResource(aResource: UTF8String): TSQLDBRestResource;
@@ -872,6 +1133,10 @@ function TSQLDBRestDispatcher.GetSQLConnection(
   ): TSQLConnection;
 
 begin
+  Result:=Nil;
+  aTransaction:=Nil;
+  if aConnection=Nil then
+    exit;
   Result:=aConnection.SingleConnection;
   if (Result=Nil) then
     begin
@@ -973,6 +1238,7 @@ begin
   if not Result then exit;
   Result:=(aResource=FMetadataResource) or
           (aResource=FMetadataDetailResource) or
+          (aResource=FConnectionResource) or
           (aResource=FCustomViewResource);
 end;
 
@@ -1124,6 +1390,165 @@ begin
   end;
 end;
 
+procedure TSQLDBRestDispatcher.DatasetToConnection(D: TDataset; C : TSQLDBRestConnection);
+
+begin
+  C.Name:=UTF8Encode(D.FieldByName('name').AsWideString);
+  C.ConnectionType:=D.FieldByName('dbType').AsString;
+  C.DatabaseName:=UTF8Encode(D.FieldByName('dbName').AsWideString);
+  C.HostName:=D.FieldByName('dbHostName').AsString;
+  C.UserName:=UTF8Encode(D.FieldByName('dbUserName').AsWideString);
+  C.Password:=UTF8Encode(D.FieldByName('dbPassword').AsWideString);
+  C.CharSet:=D.FieldByName('dbCharSet').AsString;
+  C.Role:=D.FieldByName('dbRole').AsString;
+  C.Port:=D.FieldByName('dbPort').AsInteger;
+  C.Enabled:=D.FieldByName('enabled').AsBoolean;
+  if D.FieldByName('expose').AsBoolean then
+    C.SchemaName:=D.FieldByName('exposeSchemaName').AsString;
+end;
+
+procedure TSQLDBRestDispatcher.ConnectionToDataset(C : TSQLDBRestConnection;D: TDataset);
+
+begin
+  D.FieldByName('key').AsWideString:=UTF8Decode(C.Name);
+  D.FieldByName('name').AsWideString:=UTF8Decode(C.Name);
+  D.FieldByName('dbType').AsString:=C.ConnectionType;
+  D.FieldByName('dbName').AsWideString:=UTF8Decode(C.DatabaseName);
+  D.FieldByName('dbHostName').AsString:=C.HostName;
+  D.FieldByName('dbUserName').AsWideString:=UTF8Decode(C.UserName);
+  D.FieldByName('dbPassword').AsWideString:=UTF8Decode(C.Password);
+  D.FieldByName('dbCharSet').AsString:=C.CharSet;
+  D.FieldByName('dbRole').AsString:=C.Role;
+  D.FieldByName('dbPort').AsInteger:=C.Port;
+  D.FieldByName('enabled').AsBoolean:=C.Enabled;
+  D.FieldByName('expose').AsBoolean:=(C.SchemaName<>'');
+  D.FieldByName('exposeSchemaName').AsString:=C.SchemaName;
+end;
+
+procedure TSQLDBRestDispatcher.ConnectionsToDataset(D: TDataset);
+
+Var
+  C : TSQLDBRestConnection;
+  I : Integer;
+
+begin
+  For I:=0 to Connections.Count-1 do
+    begin
+    C:=Connections[i];
+    D.Append;
+    ConnectionToDataset(C,D);
+    D.Post;
+    end;
+end;
+
+procedure TSQLDBRestDispatcher.DoConnectionDelete(DataSet: TDataSet);
+
+Var
+  I,J : Integer;
+  C : TSQLDBRestConnection;
+
+
+begin
+  I:=Connections.IndexOfConnection(UTF8Encode(Dataset.FieldByName('name').AsWideString));
+  if I<>-1 then
+    begin
+    C:=Connections[i];
+    if C.SingleConnection<>Nil then
+      DoneSQLConnection(C,C.SingleConnection,Nil);
+    if C.SchemaName<>'' then
+      begin
+      J:=Schemas.IndexOfSchema(C.SchemaName);
+      if J<>-1 then
+        begin
+        Schemas[J].Schema.Free;
+        Schemas[J].Schema:=Nil;
+        end;
+      Schemas.Delete(J);
+      end;
+    Connections.Delete(I);
+    end
+  else
+    Raise ESQLDBRest.Create(404,'NOT FOUND');
+end;
+
+procedure TSQLDBRestDispatcher.DoConnectionPost(DataSet: TDataSet);
+
+Var
+  isNew : Boolean;
+  C : TSQLDBRestConnection;
+  N : UTF8String;
+  UN : UnicodeString;
+  S : TSQLDBRestSchema;
+
+begin
+  IsNew:=Dataset.State=dsInsert;
+  if IsNew then
+    C:=Connections.Add as TSQLDBRestConnection
+  else
+    begin
+    UN:=UTF8Decode(Dataset.FieldByName('key').AsString);
+//    C:=Connections[Dataset.RecNo-1];
+    C:=Connections.FindConnection(Utf8Encode(UN));
+    if (C=Nil) then
+      Raise ESQLDBRest.Create(404,'NOT FOUND');
+    end;
+  if Assigned(C.SingleConnection) then
+    DoneSQLConnection(C,C.SingleConnection,Nil);
+  DatasetToConnection(Dataset,C);
+  if (Dataset.FieldByName('expose').AsBoolean) and isNew then
+    begin
+    N:=C.SchemaName;
+    if N='' then
+      N:=C.Name+'schema';
+    if (Schemas.IndexOfSchema(N)<>-1) then
+      Raise ESQLDBRest.Create(400,'DUPLICATE SCHEMA');
+    try
+      S:=ExposeConnection(C,Nil);
+    except
+      if IsNew then
+        C.Free;
+      Raise;
+    end;
+    S.Name:=N;
+    end;
+end;
+
+function TSQLDBRestDispatcher.CreateConnectionDataset(IO: TRestIO; AOwner: TComponent): TDataset;
+Var
+  BD :  TRestBufDataset;
+
+begin
+  if IO=Nil then exit;
+  BD:=TRestBufDataset.Create(aOwner);
+  try
+    Result:=BD;
+    // Key field is not exposed
+    Result.FieldDefs.add('key',ftWidestring,255);
+    Result.FieldDefs.add('name',ftWidestring,255);
+    Result.FieldDefs.add('dbType',ftString,20);
+    Result.FieldDefs.add('dbName',ftWideString,255);
+    Result.FieldDefs.add('dbHostName',ftString,255);
+    Result.FieldDefs.add('dbUserName',ftWideString,255);
+    Result.FieldDefs.add('dbPassword',ftWideString,255);
+    Result.FieldDefs.add('dbCharSet',ftString,50);
+    Result.FieldDefs.add('dbRole',ftString,255);
+    Result.FieldDefs.add('dbPort',ftInteger,0);
+    Result.FieldDefs.add('enabled',ftBoolean,0);
+    Result.FieldDefs.add('expose',ftBoolean,0);
+    Result.FieldDefs.add('exposeSchemaName',ftWideString,255);
+    BD.CreateDataset;
+    ConnectionsToDataset(BD);
+    BD.IndexDefs.Add('uName','name',[ixUnique]);
+    BD.IndexName:='uName';
+    BD.First;
+    BD.BeforePost:=@DoConnectionPost;
+    BD.BeforeDelete:=@DoConnectionDelete;
+  except
+    BD.Free;
+    Raise;
+  end;
+end;
+
 function TSQLDBRestDispatcher.CreateCustomViewDataset(IO: TRestIO;
   const aSQL: String; AOwner: TComponent): TDataset;
 
@@ -1159,6 +1584,8 @@ begin
   Result:=Nil;
   if (IO.Resource=FMetadataResource) then
     Result:=CreateMetadataDataset(IO,AOwner)
+  else if (IO.Resource=FConnectionResource) then
+    Result:=CreateConnectionDataset(IO,AOwner)
   else if (IO.Resource=FMetadataDetailResource) then
     begin
     if IO.GetVariable('ID',RN,[vsRoute,vsQuery])=vsNone then
@@ -1220,12 +1647,25 @@ Var
   H : TSQLDBRestDBHandler;
   l,o : Int64;
 
+
 begin
+  if MustLog(rloResource) then
+    DoLog(rloResource,IO,'Resource: %s; Operation: %s',[IO.ResourceName,RestMethods[IO.Operation]]);
   H:=Nil;
   Conn:=GetSQLConnection(aConnection,Tr);
   try
     IO.SetConn(Conn,TR);
     Try
+      if MustLog(rloConnection) then
+         if Assigned(Conn)  then
+           DoLog(rloConnection,IO,'Using connection to Host: %s; Database: %s',[Conn.HostName,Conn.DatabaseName])
+         else
+           DoLog(rloConnection,IO,'Resource %s does not require connection',[IO.ResourceName]);
+      if assigned(Conn) and MustLog(rloSQL) then
+        begin
+        Conn.LogEvents:=LogSQLOptions;
+        Conn.OnLog:[email protected];
+        end;
       if (rdoHandleCORS in DispatchOptions) then
         IO.Response.SetCustomHeader('Access-Control-Allow-Origin',ResolvedCORSAllowedOrigins);
       if not AuthenticateRequest(IO,True) then
@@ -1243,7 +1683,8 @@ begin
         end;
       H.ExecuteOperation;
       DoHandleEvent(False,IO);
-      tr.Commit;
+      if Assigned(TR) then
+        TR.Commit;
       SetDefaultResponseCode(IO);
     except
       TR.RollBack;
@@ -1365,7 +1806,7 @@ begin
         begin
         IO.SetResource(Resource);
         Connection:=FindConnection(IO);
-        if Connection=Nil then
+        if (Connection=Nil) and not IsSpecialResource(Resource) then
           begin
           if (rdoConnectionInURL in DispatchOptions) then
             CreateErrorContent(IO,FStatus.GetStatusCode(rsNoConnectionSpecified),Format(SErrNoconnection,[GetConnectionName(IO)]))
@@ -1396,8 +1837,13 @@ procedure TSQLDBRestDispatcher.UnRegisterRoutes;
 begin
   Un(FListRoute);
   Un(FItemRoute);
+  Un(FConnectionItemRoute);
+  Un(FConnectionsRoute);
+  Un(FMetadataItemRoute);
+  Un(FMetadataRoute);
 end;
 
+
 procedure TSQLDBRestDispatcher.RegisterRoutes;
 begin
   if (FListRoute<>Nil) then
@@ -1456,6 +1902,7 @@ Var
   B : TRestBasicAuthenticator;
   A : TRestAuthenticator;
 
+
 begin
   A:=Nil;
   B:=Nil;
@@ -1473,7 +1920,14 @@ begin
       begin
       Result:=(A.NeedConnection<>Delayed);
       If Not Result then
-        Result:=A.AuthenticateRequest(IO)
+        begin
+        Result:=A.AuthenticateRequest(IO);
+        if MustLog(rloAuthentication) then
+          if Result then
+            DoLog(rloAuthentication,IO,'Authenticated user: %s',[IO.UserID])
+          else
+            DoLog(rloAuthentication,IO,'Authentication failed for user: %s',[TRestBasicAuthenticator.ExtractUserName(IO.Request)]);
+        end;
       end;
   finally
     if Assigned(B) then
@@ -1506,6 +1960,7 @@ begin
       // First output, then input
       IO.RestOutput.InitStreaming;
       IO.RestInput.InitStreaming;
+      IO.OnSQLLog:[email protected];
       if AuthenticateRequest(IO,False) then
         DoHandleRequest(IO)
     except
@@ -1513,12 +1968,19 @@ begin
         HandleException(E,IO);
     end;
   Finally
+    // Make sure there is a document in case of error
+    if (aResponse.ContentStream.Size=0) and Not ((aResponse.Code div 100)=2) then
+      IO.RESTOutput.CreateErrorContent(aResponse.Code,aResponse.CodeText);
     if Not (IO.Operation in [roOptions,roHEAD]) then
       IO.RestOutput.FinalizeOutput;
     aResponse.ContentStream.Position:=0;
     aResponse.ContentLength:=aResponse.ContentStream.Size;
+
     if not aResponse.ContentSent then
       aResponse.SendContent;
+    if MustLog(rloResultStatus) then
+        DoLog(rloResultStatus,IO,'Resource: %s; Operation: %s; Status: %d; Text: %s',[IO.ResourceName,RestMethods[IO.Operation],aResponse.Code,aResponse.CodeText]);
+
     IO.Free;
   end;
 end;
@@ -1651,7 +2113,7 @@ begin
   Items[aIndex]:=aValue;
 end;
 
-function TSQLDBRestConnectionList.IndexOfConnection(const aName: string
+function TSQLDBRestConnectionList.IndexOfConnection(const aName: UTF8string
   ): Integer;
 begin
   Result:=Count-1;
@@ -1659,7 +2121,7 @@ begin
     Dec(Result);
 end;
 
-function TSQLDBRestConnectionList.FindConnection(const aName: string): TSQLDBRestConnection;
+function TSQLDBRestConnectionList.FindConnection(const aName: UTF8string): TSQLDBRestConnection;
 Var
   Idx : Integer;
 
@@ -1849,6 +2311,8 @@ begin
     Role:=C.Role;
     DatabaseName:=C.DatabaseName;
     ConnectionType:=C.ConnectionType;
+    Port:=C.Port;
+    SchemaName:=C.SchemaName;
     Params.Assign(C.Params);
     end
   else

packages/fcl-web/src/restbridge/sqldbrestdata.pp

@@ -47,11 +47,14 @@ Type
     FResource : TSQLDBRestResource;
     FOwnsResource : Boolean;
     procedure SetExternalDataset(AValue: TDataset);
-    function StreamRecord(O: TRestOutputStreamer; D: TDataset; FieldList: TRestFieldPairArray): Boolean;
   Protected
+    function StreamRecord(O: TRestOutputStreamer; D: TDataset; FieldList: TRestFieldPairArray): Boolean; virtual;
+    function FindExistingRecord(D: TDataset): Boolean;
     procedure CreateResourceFromDataset(D: TDataset); virtual;
     procedure DoNotFound; virtual;
     procedure SetPostParams(aParams: TParams; Old : TFields = Nil);virtual;
+    procedure SetPostFields(aFields: TFields);virtual;
+    procedure SetFieldFromData(DataField: TField; ResField: TSQLDBRestField; D: TJSONData); virtual;
     procedure InsertNewRecord; virtual;
     procedure UpdateExistingRecord(OldData: TDataset); virtual;
     Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
@@ -81,7 +84,7 @@ Type
     Function GetLimitOffset(out aLimit, aOffset: Int64) : Boolean; virtual;
     Procedure Init(aIO: TRestIO; aStrings : TRestStringsConfig;AQueryClass : TSQLQueryClass); virtual;
     Procedure ExecuteOperation;
-    Function StreamDataset(O: TRestOutputStreamer; D: TDataset; FieldList: TRestFieldPairArray) : Int64;
+    Function StreamDataset(O: TRestOutputStreamer; D: TDataset; FieldList: TRestFieldPairArray; CurrentOnly : Boolean = False) : Int64;
     procedure SetParamFromData(P: TParam; F: TSQLDBRestField; D: TJSONData); virtual;
     function GetDataForParam(P: TParam; F: TSQLDBRestField; Sources : TVariableSources = AllVariableSources): TJSONData; virtual;
     Function GetString(aString : TRestStringProperty) : UTF8String;
@@ -98,7 +101,7 @@ Type
 
 implementation
 
-uses strutils, dateutils, base64, sqldbrestconst;
+uses strutils, variants, dateutils, base64, sqldbrestconst;
 
 
 Const
@@ -170,7 +173,8 @@ begin
     end;
 end;
 
-function TSQLDBRestDBHandler.GetWhere(Out FilteredFields : TRestFilterPairArray): UTF8String;
+function TSQLDBRestDBHandler.GetWhere(out FilteredFields: TRestFilterPairArray
+  ): UTF8String;
 
 Const
   MaxFilterCount = 1+ Ord(High(TRestFieldFilter)) - Ord(Low(TRestFieldFilter));
@@ -350,7 +354,8 @@ begin
   end;
 end;
 
-Function TSQLDBRestDBHandler.GetDataForParam(P : TParam; F : TSQLDBRestField; Sources : TVariableSources = AllVariableSources) : TJSONData;
+function TSQLDBRestDBHandler.GetDataForParam(P: TParam; F: TSQLDBRestField;
+  Sources: TVariableSources): TJSONData;
 
 Var
   vs : TVariableSource;
@@ -380,7 +385,8 @@ begin
     end;
 end;
 
-Procedure TSQLDBRestDBHandler.SetParamFromData(P : TParam; F : TSQLDBRestField; D : TJSONData);
+procedure TSQLDBRestDBHandler.SetParamFromData(P: TParam; F: TSQLDBRestField;
+  D: TJSONData);
 
 begin
   if not Assigned(D) then
@@ -408,7 +414,8 @@ begin
     P.AsString:=D.AsString;
 end;
 
-Function TSQLDBRestDBHandler.FindFieldForParam(aOperation : TRestOperation; P : TParam) : TSQLDBRestField;
+function TSQLDBRestDBHandler.FindFieldForParam(aOperation: TRestOperation;
+  P: TParam): TSQLDBRestField;
 
 Var
   N : UTF8String;
@@ -490,13 +497,14 @@ begin
     end;
 end;
 
-Function TSQLDBRestDBHandler.GetLimitOffset(Out aLimit,aOffset : Int64) : Boolean;
+function TSQLDBRestDBHandler.GetLimitOffset(out aLimit, aOffset: Int64
+  ): Boolean;
 
 begin
   Result:=IO.GetLimitOffset(EnforceLimit,aLimit,aoffset);
 end;
 
-Function TSQLDBRestDBHandler.GetLimit : UTF8String;
+function TSQLDBRestDBHandler.GetLimit: UTF8String;
 
 var
   aOffset, aLimit : Int64;
@@ -526,7 +534,8 @@ begin
 end;
 
 
-Function TSQLDBRestDBHandler.StreamRecord(O : TRestOutputStreamer; D : TDataset; FieldList : TRestFieldPairArray) : Boolean;
+function TSQLDBRestDBHandler.StreamRecord(O: TRestOutputStreamer; D: TDataset;
+  FieldList: TRestFieldPairArray): Boolean;
 
 Var
   i : Integer;
@@ -541,7 +550,8 @@ begin
   O.EndRow;
 end;
 
-Function TSQLDBRestDBHandler.StreamDataset(O : TRestOutputStreamer; D : TDataset; FieldList : TRestFieldPairArray) : Int64;
+function TSQLDBRestDBHandler.StreamDataset(O: TRestOutputStreamer; D: TDataset;
+  FieldList: TRestFieldPairArray; CurrentOnly : Boolean = False): Int64;
 
 Var
   aLimit,aOffset : Int64;
@@ -569,25 +579,31 @@ begin
   if O.HasOption(ooMetadata) then
     O.WriteMetadata(FieldList);
   O.StartData;
-  if EmulateOffsetLimit then
-    While (aOffset>0) and not D.EOF do
-      begin
-      D.Next;
-      Dec(aOffset);
-      end;
-  While not (D.EOF or LimitReached) do
+  if CurrentOnly then
+    StreamRecord(O,D,FieldList)
+  else
     begin
-    If StreamRecord(O,D,FieldList) then
+    if EmulateOffsetLimit then
+      While (aOffset>0) and not D.EOF do
+        begin
+        D.Next;
+        Dec(aOffset);
+        end;
+    While not (D.EOF or LimitReached) do
       begin
-      Dec(aLimit);
-      inc(Result);
+      If StreamRecord(O,D,FieldList) then
+        begin
+        Dec(aLimit);
+        inc(Result);
+        end;
+      D.Next;
       end;
-    D.Next;
     end;
   O.EndData;
 end;
 
-Function TSQLDBRestDBHandler.GetSpecialDatasetForResource(aFieldList : TRestFieldPairArray) :  TDataset;
+function TSQLDBRestDBHandler.GetSpecialDatasetForResource(
+  aFieldList: TRestFieldPairArray): TDataset;
 
 
 Var
@@ -612,7 +628,7 @@ begin
     FExternalDataset.FreeNotification(Self);
 end;
 
-Function TSQLDBRestDBHandler.SpecialResource : Boolean;
+function TSQLDBRestDBHandler.SpecialResource: Boolean;
 
 begin
   Result:=(ExternalDataset<>Nil) or Assigned(FResource.OnGetDataset);
@@ -637,6 +653,7 @@ begin
   SQL:=FResource.GetResolvedSQl(skSelect,aWhere,aOrderBy,aLimit);
   Q:=CreateQuery(SQL);
   Try
+    Q.UsePrimaryKeyAsKey:=False;
     FillParams(roGet,Q,WhereFilterList);
     Result:=Q;
   except
@@ -689,12 +706,76 @@ begin
   end;
 end;
 
-Function TSQLDBRestDBHandler.GetGeneratorValue(Const aGeneratorName : String) : Int64;
+function TSQLDBRestDBHandler.GetGeneratorValue(const aGeneratorName: String
+  ): Int64;
 
 begin
   Result:=IO.Connection.GetNextValue(aGeneratorName,1);
 end;
 
+procedure TSQLDBRestDBHandler.SetPostFields(aFields : TFields);
+
+Var
+  I : Integer;
+  FData : TField;
+  D : TJSONData;
+  RF : TSQLDBRestField;
+  V : UTF8string;
+
+begin
+  // Another approach would be to create params for all fields,
+  // call setPostParams, and copy field data from all set params
+  // That would allow the use of checkparams...
+  For I:=0 to aFields.Count-1 do
+    try
+      D:=Nil;
+      FData:=aFields[i];
+      RF:=FResource.Fields.FindByFieldName(FData.FieldName);
+      if (RF<>Nil) then
+        begin
+        if (RF.GeneratorName<>'')  then // Only when doing POST
+          D:=TJSONInt64Number.Create(GetGeneratorValue(RF.GeneratorName))
+        else
+          D:=IO.RESTInput.GetContentField(RF.PublicName);
+        end
+      else if IO.GetVariable(FData.Name,V,[vsContent,vsQuery])<>vsNone then
+        D:=TJSONString.Create(V);
+      if (D<>Nil) then
+        SetFieldFromData(FData,RF,D); // Use new value, if any
+    finally
+      D.Free;
+    end;
+end;
+
+procedure TSQLDBRestDBHandler.SetFieldFromData(DataField: TField; ResField: TSQLDBRestField; D: TJSONData);
+
+begin
+  if not Assigned(D) then
+    DataField.Clear
+  else if Assigned(ResField) then
+    Case ResField.FieldType of
+      rftInteger : DataField.AsInteger:=D.AsInteger;
+      rftLargeInt : DataField.AsLargeInt:=D.AsInt64;
+      rftFloat : DataField.AsFloat:=D.AsFloat;
+      rftDate : DataField.AsDateTime:=ScanDateTime(GetString(rpDateFormat),D.AsString);
+      rftTime : DataField.AsDateTime:=ScanDateTime(GetString(rpTimeFormat),D.AsString);
+      rftDateTime : DataField.AsDateTime:=ScanDateTime(GetString(rpDateTimeFormat),D.AsString);
+      rftString : DataField.AsString:=D.AsString;
+      rftBoolean : DataField.AsBoolean:=D.AsBoolean;
+      rftBlob :
+{$IFNDEF VER3_0}
+         DataField.AsBytes:=BytesOf(DecodeStringBase64(D.AsString));
+{$ELSE}
+         DataField.AsString:=DecodeStringBase64(D.AsString);
+{$ENDIF}
+    else
+      DataField.AsString:=D.AsString;
+    end
+  else
+    DataField.AsString:=D.AsString;
+end;
+
+
 procedure TSQLDBRestDBHandler.SetPostParams(aParams : TParams; Old : TFields = Nil);
 
 Var
@@ -712,7 +793,7 @@ begin
       FOld:=Nil;
       P:=aParams[i];
       F:=FResource.Fields.FindByFieldName(P.Name);
-      If Assigned(Fold) then
+      If Assigned(Old) then
         Fold:=Old.FindField(P.Name);
       if (F<>Nil) then
         begin
@@ -744,19 +825,33 @@ Var
   SQL : UTF8String;
 
 begin
-  SQL:=FResource.GetResolvedSQl(skInsert,'','','');
-  S:=TSQLStatement.Create(Self);
-  try
-    S.Database:=IO.Connection;
-    S.Transaction:=IO.Transaction;
-    S.SQL.Text:=SQL;
-    SetPostParams(S.Params);
-    S.Execute;
-    PostParams.Assign(S.Params);
-    S.Transaction.Commit;
-  Finally
-    S.Free;
-  end;
+  if Assigned(ExternalDataset) then
+    begin
+    ExternalDataset.Append;
+    SetPostFields(ExternalDataset.Fields);
+    try
+      ExternalDataset.Post;
+    except
+      ExternalDataset.Cancel;
+      Raise;
+    end
+    end
+  else
+    begin
+    SQL:=FResource.GetResolvedSQl(skInsert,'','','');
+    S:=TSQLStatement.Create(Self);
+    try
+      S.Database:=IO.Connection;
+      S.Transaction:=IO.Transaction;
+      S.SQL.Text:=SQL;
+      SetPostParams(S.Params);
+      S.Execute;
+      PostParams.Assign(S.Params);
+      S.Transaction.Commit;
+    Finally
+      S.Free;
+    end;
+    end;
 end;
 
 procedure TSQLDBRestDBHandler.DoHandlePost;
@@ -789,20 +884,68 @@ Var
   SQl : String;
 
 begin
-  SQL:=FResource.GetResolvedSQl(skUpdate,'','','');
-  S:=TSQLStatement.Create(Self);
-  try
-    S.Database:=IO.Connection;
-    S.Transaction:=IO.Transaction;
-    S.SQL.Text:=SQL;
-    SetPostParams(S.Params,OldData.Fields);
-    // Give user a chance to look at it.
-    FResource.CheckParams(io.RestContext,roPut,S.Params);
-    S.Execute;
-    S.Transaction.Commit;
-  finally
-    S.Free;
-  end;
+  if (OldData=ExternalDataset) then
+    begin
+    ExternalDataset.Edit;
+    try
+      SetPostFields(ExternalDataset.Fields);
+      ExternalDataset.Post;
+    except
+      ExternalDataset.Cancel;
+      Raise;
+    end
+    end
+  else
+    begin
+    SQL:=FResource.GetResolvedSQl(skUpdate,'','','');
+    S:=TSQLStatement.Create(Self);
+    try
+      S.Database:=IO.Connection;
+      S.Transaction:=IO.Transaction;
+      S.SQL.Text:=SQL;
+      SetPostParams(S.Params,OldData.Fields);
+      // Give user a chance to look at it.
+      FResource.CheckParams(io.RestContext,roPut,S.Params);
+      S.Execute;
+      S.Transaction.Commit;
+    finally
+      S.Free;
+    end;
+    end;
+end;
+
+Function TSQLDBRestDBHandler.FindExistingRecord(D : TDataset) : Boolean;
+
+Var
+  KeyFields : String;
+  FieldList : TRestFilterPairArray;
+  FP : TRestFilterPair;
+  V : Variant;
+  I : Integer;
+
+begin
+  D.Open;
+  if D<>ExternalDataset then
+    Result:=Not (D.BOF and D.EOF)
+  else
+    begin
+    GetIDWhere(FieldList);
+    V:=VarArrayCreate([0,Length(FieldList)-1],varVariant);
+    KeyFields:='';
+    I:=0;
+    For FP in FieldList do
+      begin
+      if KeyFields<>'' then
+        KeyFields:=KeyFields+';';
+      KeyFields:=KeyFields+FP.Field.FieldName;
+      if Assigned(FP.ValueParam) then
+        V[i]:=FP.ValueParam.Value
+      else
+        V[i]:=FP.Value;
+      Inc(i);
+      end;
+    Result:=D.Locate(KeyFields,V,[loCaseInsensitive]);
+    end;
 end;
 
 procedure TSQLDBRestDBHandler.DoHandlePut;
@@ -819,18 +962,20 @@ begin
   FieldList:=BuildFieldList(True);
   D:=GetDatasetForResource(FieldList,True);
   try
-    D.Open;
-    if (D.BOF and D.EOF) then
+    if not FindExistingRecord(D) then
       begin
       DoNotFound;
       exit;
       end;
     UpdateExistingRecord(D);
     // Now build response
-    FreeAndNil(D);
-    FieldList:=BuildFieldList(False);
-    D:=GetDatasetForResource(FieldList,True);
-    D.Open;
+    if D<>ExternalDataset then
+      begin;
+      FreeAndNil(D);
+      D:=GetDatasetForResource(FieldList,True);
+      FieldList:=BuildFieldList(False);
+      D.Open;
+      end;
     IO.RESTOutput.OutputOptions:=IO.RESTOutput.OutputOptions-[ooMetadata];
     StreamDataset(IO.RESTOutput,D,FieldList);
   finally
@@ -863,17 +1008,27 @@ Var
   FilteredFields : TRestFilterPairArray;
 
 begin
-  aWhere:=GetIDWhere(FilteredFields);
-  SQL:=FResource.GetResolvedSQl(skDelete,aWhere,'');
-  Q:=CreateQuery(SQL);
-  try
-    FillParams(roDelete,Q,FilteredFields);
-    Q.ExecSQL;
-    if Q.RowsAffected<>1 then
+  if Assigned(ExternalDataset) then
+    begin
+    If FindExistingRecord(ExternalDataset) then
+      ExternalDataset.Delete
+    else
       DoNotFound;
-  finally
-    Q.Free;
-  end;
+    end
+  else
+    begin
+    aWhere:=GetIDWhere(FilteredFields);
+    SQL:=FResource.GetResolvedSQl(skDelete,aWhere,'');
+    Q:=CreateQuery(SQL);
+    try
+      FillParams(roDelete,Q,FilteredFields);
+      Q.ExecSQL;
+      if Q.RowsAffected<>1 then
+        DoNotFound;
+    finally
+      Q.Free;
+    end;
+    end;
 end;
 
 end.

packages/fcl-web/src/restbridge/sqldbrestio.pp

@@ -73,7 +73,8 @@ Type
                          rpOutputFormat,
                          rpCustomViewResourceName,
                          rpCustomViewSQLParam,
-                         rpXMLDocumentRoot
+                         rpXMLDocumentRoot,
+                         rpConnectionResourceName
                          );
   TRestStringProperties = Set of TRestStringProperty;
 
@@ -131,6 +132,7 @@ Type
     Property CustomViewResourceName : UTF8string Index ord(rpCustomViewResourceName) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
     Property CustomViewSQLParam : UTF8string Index ord(rpCustomViewSQLParam) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
     Property XMLDocumentRoot : UTF8string Index ord(rpXMLDocumentRoot) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+    Property ConnectionResourceName : UTF8string Index ord(rpConnectionResourceName) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
   end;
 
   TRestStatus = (rsError,                   // Internal logic/unexpected error (500)
@@ -275,17 +277,18 @@ Type
   end;
 
   { TRestIO }
+  TSQLLogNotifyEvent = Procedure (Sender : TObject; EventType : TDBEventType; Const Msg : String) of object;
 
   TRestIO = Class
   private
     FConn: TSQLConnection;
     FCOnnection: UTF8String;
     FInput: TRestInputStreamer;
+    FOnSQLLog: TSQLLogNotifyEvent;
     FOperation: TRestOperation;
     FOutput: TRestOutputStreamer;
     FRequest: TRequest;
     FResource: TSQLDBRestResource;
-    FResourceName: UTF8String;
     FResponse: TResponse;
     FRestContext: TRestContext;
     FRestStatuses: TRestStatusConfig;
@@ -293,12 +296,15 @@ Type
     FSchema: UTF8String;
     FTrans: TSQLTransaction;
     FContentStream : TStream;
+    function GetResourceName: UTF8String;
     function GetUserID: String;
     procedure SetUserID(AValue: String);
   Protected
   Public
     Constructor Create(aRequest : TRequest; aResponse : TResponse); virtual;
     Destructor Destroy; override;
+    // Log callback for SQL. Rerouted here, because we need IO
+    procedure DoSQLLog(Sender: TSQLConnection;  EventType: TDBEventType; const Msg: String);
     // Set things.
     Procedure SetIO(aInput : TRestInputStreamer;aOutput : TRestOutputStreamer);
     Procedure SetConn(aConn : TSQLConnection; ATrans : TSQLTransaction);
@@ -332,10 +338,12 @@ Type
     Property RequestContentStream : TStream Read FContentStream;
     Property RestContext : TRestContext Read FRestContext;
     // For informative purposes
-    Property ResourceName : UTF8String Read FResourceName;
+    Property ResourceName : UTF8String Read GetResourceName;
     Property Schema : UTF8String Read FSchema;
     Property ConnectionName : UTF8String Read FCOnnection;
     Property UserID : String Read GetUserID Write SetUserID;
+    // For logging
+    Property OnSQLLog :TSQLLogNotifyEvent Read FOnSQLLog Write FOnSQLLog;
   end;
   TRestIOClass = Class of TRestIO;
 
@@ -430,7 +438,8 @@ Const
     'fmt',             { rpOutputFormat }
     'customview',      { rpCustomViewResourceName }
     'sql',             { rpCustomViewSQLParam }
-    'datapacket'       { rpXMLDocumentRoot}
+    'datapacket',      { rpXMLDocumentRoot}
+    '_connection'      { rpConnectionResourceName }
   );
   DefaultStatuses : Array[TRestStatus] of Word = (
     500, { rsError }
@@ -895,6 +904,14 @@ begin
   Result:=FRestContext.UserID;
 end;
 
+function TRestIO.GetResourceName: UTF8String;
+begin
+  if Assigned(FResource) then
+    Result:=FResource.ResourceName
+  else
+    Result:='?';
+end;
+
 constructor TRestIO.Create(aRequest: TRequest; aResponse: TResponse);
 begin
   FRequest:=aRequest;
@@ -917,6 +934,13 @@ begin
   inherited Destroy;
 end;
 
+procedure TRestIO.DoSQLLog(Sender: TSQLConnection; EventType: TDBEventType;  const Msg: String);
+
+begin
+  If Assigned(OnSQLLog) then
+    FOnSQLLog(Self,EventType,Msg);
+end;
+
 function TRestIO.CreateRestContext : TRestContext;
 
 begin

packages/fcl-web/src/restbridge/sqldbrestjson.pp

@@ -192,7 +192,7 @@ begin
   if FRow=Nil then
     Raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsError),SErrFieldWithoutRow,[N]);
   D:=FieldToJSON(aPair);
-  if (D=Nil) and ((not HasOption(ooSparse)) or (FRow is TJSONArray)) then
+  if (D=Nil) and ((FRow is TJSONArray) or not HasOption(ooSparse)) then
     D:=TJSONNull.Create;
   if D<>Nil then
     If FRow is TJSONArray then

packages/fcl-web/src/restbridge/sqldbrestschema.pp

@@ -197,7 +197,7 @@ Type
     Function AllowResource(aContext : TBaseRestContext) : Boolean;
     Function GetAllowedOperations(aContext : TBaseRestContext) : TRestOperations;
     Function GetHTTPAllow : String; virtual;
-    function GetFieldList(aListKind: TFieldListKind): UTF8String;
+    function GetFieldList(aListKind: TFieldListKind; ASep : String = ''): UTF8String;
     function GetFieldArray(aListKind: TFieldListKind): TSQLDBRestFieldArray;
     Function GetResolvedSQl(aKind : TSQLKind; Const AWhere : UTF8String; Const aOrderBy : UTF8String = ''; aLimit : UTF8String = '') : UTF8String;
     Procedure PopulateFieldsFromFieldDefs(Defs : TFieldDefs; aIndexFields : TStringArray; aProcessIdentifier : TProcessIdentifier; aMinFieldOpts : TRestFieldOptions);
@@ -332,6 +332,7 @@ Type
 
 Const
   TypeNames : Array[TRestFieldType] of string = ('?','int','bigint','float','date','time','datetime','string','bool','blob');
+  RestMethods : Array[TRestOperation] of string = ('','GET','POST','PUT','DELETE','OPTIONS','HEAD');
 
 implementation
 
@@ -1051,8 +1052,6 @@ function TSQLDBRestResource.GetHTTPAllow: String;
     Result:=Result+S;
   end;
 
-Const
-  Methods : Array[TRestOperation] of string = ('','GET','POST','PUT','DELETE','OPTIONS','HEAD');
 
 Var
   O : TRestOperation;
@@ -1061,10 +1060,10 @@ begin
   Result:='';
   For O in TRestOperation do
     if (O<>roUnknown) and (O in AllowedOperations) then
-      AddR(Methods[O]);
+      AddR(RestMethods[O]);
 end;
 
-function TSQLDBRestResource.GetFieldList(aListKind : TFieldListKind) : UTF8String;
+function TSQLDBRestResource.GetFieldList(aListKind : TFieldListKind; ASep : String = '') : UTF8String;
 
 Const
   SepComma = ', ';
@@ -1072,7 +1071,7 @@ Const
   SepSpace = ' ';
 
 Const
-  Seps : Array[TFieldListKind] of string = (sepComma,sepComma,sepComma,sepComma,sepAnd,sepSpace,sepComma);
+  DefaultSeps : Array[TFieldListKind] of string = (sepComma,sepComma,sepComma,sepComma,sepAnd,sepSpace,sepComma);
 
 Const
   Wheres = [flWhereKey];
@@ -1080,15 +1079,20 @@ Const
   UseEqual = Wheres+[flUpdate];
 
 Var
-  Term,Res,Prefix : UTF8String;
+  Sep,Term,Res,Prefix : UTF8String;
   I : Integer;
   F : TSQLDBRestField;
 
 begin
   Prefix:='';
+  Sep:=aSep;
+  if Sep='' then
+    begin
+    Sep:=DefaultSeps[aListKind];
+    If aListKind in Colons then
+      Prefix:=':';
+    end;
   Res:='';
-  If aListKind in Colons then
-    Prefix:=':';
   For I:=0 to Fields.Count-1 do
     begin
     Term:='';
@@ -1096,7 +1100,7 @@ begin
     if F.UseInFieldList(aListKind) then
       begin
       Term:=Prefix+F.FieldName;
-      if aListKind in UseEqual then
+      if (aSep='') and (aListKind in UseEqual) then
         begin
         Term := F.FieldName+' = '+Term;
         if (aListKind in Wheres) then
@@ -1106,7 +1110,7 @@ begin
     if (Term<>'') then
       begin
       If (Res<>'') then
-        Res:=Res+Seps[aListKind];
+        Res:=Res+Sep;
       Res:=Res+Term;
       end;
     end;

packages/fppkg/src/pkgfppkg.pp

@@ -30,6 +30,7 @@ type
     FCompilerOptions: TCompilerOptions;
     FFpmakeCompilerOptions: TCompilerOptions;
     FCurrentRemoteRepositoryURL: String;
+    FConfigurationFilename: string;
     function IncludeRepositoryTypeForPackageKind(ARepositoryType: TFPRepositoryType;
       APackageKind: TpkgPackageKind): Boolean;
     procedure ScanPackagesOnDisk(ACompilerOptions: TCompilerOptions; APackageKind: TpkgPackageKind; ARepositoryList: TComponentList);
@@ -42,6 +43,7 @@ type
     procedure LeaveFindBrokenpackages;
 
     procedure ClearRepositories(ARepositoryList: TComponentList);
+    function GetConfigurationFilename: string;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -78,6 +80,7 @@ type
     property FpmakeCompilerOptions: TCompilerOptions read FFpmakeCompilerOptions;
     property FPMakeRepositoryList: TComponentList read FFPMakeRepositoryList;
     property RepositoryList: TComponentList read FRepositoryList;
+    property ConfigurationFilename: string read GetConfigurationFilename;
   public
 
   end;
@@ -197,6 +200,7 @@ begin
     pkgglobals.Log(llDebug,SLogGeneratingGlobalConfig,[cfgfile])
   else
     pkgglobals.Log(llDebug,SLogLoadingGlobalConfig,[cfgfile]);
+  FConfigurationFilename := CfgFile;
   // Log configuration
   FOptions.LogValues(llDebug);
 end;
@@ -779,5 +783,10 @@ begin
     Result:=GetRemoteRepositoryURL(APackage.FileName);
 end;
 
+function TpkgFPpkg.GetConfigurationFilename: string;
+begin
+  Result := FConfigurationFilename;
+end;
+
 end.
 

packages/libffi/src/ffi.manager.pp

@@ -220,12 +220,9 @@ begin
               Result := @ffi_type_double;
             ftExtended:
               Result := @ffi_type_longdouble;
+            { Comp and Currency are passed as Int64 (ToDo: on all platforms?) }
             ftComp:
-  {$ifndef FPC_HAS_TYPE_EXTENDED}
               Result := @ffi_type_sint64;
-  {$else}
-              Result := @ffi_type_longdouble;
-  {$endif}
             ftCurr:
               Result := @ffi_type_sint64;
           end;
@@ -279,7 +276,8 @@ begin
         else
           raise EInvocationError.CreateFmt(SErrTypeKindNotSupported, [TypeKindName]);
       end;
-  end;
+  end else if aFlags * [pfOut, pfVar, pfConst, pfConstRef] <> [] then
+    Result := @ffi_type_pointer;
 end;
 
 function ValueToFFIValue(constref aValue: Pointer; aKind: TTypeKind; aFlags: TParamFlags; aIsResult: Boolean): Pointer;
@@ -295,7 +293,8 @@ begin
   Result := aValue;
   if (aKind = tkSString) or
       (aIsResult and (aKind in ResultTypeNeedsIndirection)) or
-      (aFlags * [pfArray, pfOut, pfVar, pfConstRef] <> []) then
+      (aFlags * [pfArray, pfOut, pfVar, pfConstRef] <> []) or
+      ((aKind = tkUnknown) and (pfConst in aFlags)) then
     Result := @aValue;
 end;
 
@@ -400,15 +399,26 @@ procedure FFIInvoke(aCodeAddress: Pointer; const aArgs: TFunctionCallParameterAr
     WriteStr(Result, aCallConv);
   end;
 
+{ on X86 platforms Currency and Comp results are passed by the X87 if the
+  Extended type is available }
+{$if (defined(CPUI8086) or defined(CPUI386) or defined(CPUX86_64)) and defined(FPC_HAS_TYPE_EXTENDED) and (not defined(FPC_COMP_IS_INT64) or not defined(FPC_CURRENCY_IS_INT64))}
+{$define USE_EXTENDED_AS_COMP_CURRENCY_RES}
+{$endif}
+
 var
   abi: ffi_abi;
   argtypes: array of pffi_type;
   argvalues: array of Pointer;
   rtype: pffi_type;
-  rvalue: ffi_arg;
+  rvalue: Pointer;
   i, arglen, argoffset, retidx, argstart: LongInt;
   cif: ffi_cif;
   retparam: Boolean;
+  kind: TTypeKind;
+{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
+  restypedata: PTypeData;
+  resextended: Extended;
+{$endif}
 begin
   if Assigned(aResultType) and not Assigned(aResultValue) then
     raise EInvocationError.Create(SErrInvokeResultTypeNoValue);
@@ -466,7 +476,11 @@ begin
 
   if not (fcfStatic in aFlags) and retparam then begin
     argtypes[0] := TypeInfoToFFIType(aArgs[0].Info.ParamType, aArgs[0].Info.ParamFlags);
-    argvalues[0] := ValueToFFIValue(aArgs[0].ValueRef, aArgs[0].Info.ParamType^.Kind, aArgs[0].Info.ParamFlags, False);
+    if Assigned(aArgs[0].Info.ParamType) then
+      kind := aArgs[0].Info.ParamType^.Kind
+    else
+      kind := tkUnknown;
+    argvalues[0] := ValueToFFIValue(aArgs[0].ValueRef, kind, aArgs[0].Info.ParamFlags, False);
     if retparam then
       Inc(retidx);
     argstart := 1;
@@ -475,24 +489,73 @@ begin
 
   for i := Low(aArgs) + argstart to High(aArgs) do begin
     argtypes[i - Low(aArgs) + Low(argtypes) + argoffset] := TypeInfoToFFIType(aArgs[i].Info.ParamType, aArgs[i].Info.ParamFlags);
-    argvalues[i - Low(aArgs) + Low(argtypes) + argoffset] := ValueToFFIValue(aArgs[i].ValueRef, aArgs[i].Info.ParamType^.Kind, aArgs[i].Info.ParamFlags, False);
+    if Assigned(aArgs[i].Info.ParamType) then
+      kind := aArgs[i].Info.ParamType^.Kind
+    else
+      kind := tkUnknown;
+    argvalues[i - Low(aArgs) + Low(argtypes) + argoffset] := ValueToFFIValue(aArgs[i].ValueRef, kind, aArgs[i].Info.ParamFlags, False);
   end;
 
   if retparam then begin
     argtypes[retidx] := TypeInfoToFFIType(aResultType, []);
     argvalues[retidx] := ValueToFFIValue(aResultValue, aResultType^.Kind, [], True);
     rtype := @ffi_type_void;
+    rvalue := Nil;
+{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
+    restypedata := Nil;
+{$endif}
   end else begin
-    rtype := TypeInfoToFFIType(aResultType, []);
+    rvalue := Nil;
+{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
+    { special case for Comp/Currency as such arguments are passed as Int64,
+      but the result is handled through the X87 }
+    if Assigned(aResultType) and (aResultType^.Kind = tkFloat) then begin
+      restypedata := GetTypeData(aResultType);
+      case restypedata^.FloatType of
+{$ifndef FPC_CURRENCY_IS_INT64}
+        ftCurr: begin
+          rtype := @ffi_type_longdouble;
+          rvalue := @resextended;
+        end;
+{$endif}
+{$ifndef FPC_COMP_IS_INT64}
+        ftComp: begin
+          rtype := @ffi_type_longdouble;
+          rvalue := @resextended;
+        end;
+{$endif}
+      end;
+    end else
+      restypedata := Nil;
+{$endif}
+    if not Assigned(rvalue) then begin
+      rtype := TypeInfoToFFIType(aResultType, []);
+      if Assigned(aResultType) then
+        rvalue := aResultValue
+      else
+        rvalue := Nil;
+    end;
   end;
 
   if ffi_prep_cif(@cif, abi, arglen, rtype, @argtypes[0]) <> FFI_OK then
     raise EInvocationError.Create(SErrInvokeFailed);
 
-  ffi_call(@cif, ffi_fn(aCodeAddress), @rvalue, @argvalues[0]);
+  ffi_call(@cif, ffi_fn(aCodeAddress), rvalue, @argvalues[0]);
 
-  if Assigned(aResultType) and not retparam then
-    FFIValueToValue(@rvalue, aResultValue, aResultType);
+{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
+  if Assigned(restypedata) then begin
+    case restypedata^.FloatType of
+{$ifndef FPC_CURRENCY_IS_INT64}
+      ftCurr:
+        PCurrency(aResultValue)^ := Currency(resextended) / 10000;
+{$endif}
+{$ifndef FPC_COMP_IS_INT64}
+      ftComp:
+        PComp(aResultValue)^ := Comp(resextended);
+{$endif}
+    end;
+  end;
+{$endif}
 end;
 
 const

packages/libffi/src/ffi.pp

@@ -269,7 +269,7 @@ const
 const
   ffilibrary = 'ffi';
 
-{$if defined(CPUX86) and not defined(WIN64)}
+{$if defined(CPUI8086) or defined(CPUI386) or (defined(CPUX86_64) and not defined(WIN64))}
   { Note: we can not use FPC_HAS_TYPE_EXTENDED here as libffi won't have the
           corresponding type no matter what }
   {$define HAVE_LONG_DOUBLE}

packages/os4units/src/asl.pas

@@ -506,10 +506,10 @@ function ASLClone(): PInterface; syscall IDos 72;
 function AllocFileRequest: PFileRequester; syscall IASL 76;
 procedure FreeFileRequest(FileReq: PFileRequester); syscall IASL 80;
 function RequestFile(FileReq: PFileRequester): LongBool; syscall IASL 84;
-function AllocAslRequestA(ReqType: LongWord; TagList: PTagItem): Pointer; syscall IASL 88;
+function AllocAslRequest(ReqType: LongWord; TagList: PTagItem): Pointer; syscall IASL 88;
 // 92 AllocAslRequestTags
 procedure FreeAslRequest(Requester: Pointer); syscall IASL 96;
-function AslRequestA(Requester: Pointer; TagList: PTagItem): LongBool; syscall IASL 100;
+function AslRequest(Requester: Pointer; TagList: PTagItem): LongBool; syscall IASL 100;
 // 104 AslRequestTags
 procedure AslFreeVec(Memory: APTR); syscall IASL 108;
 function AslAllocVec(ByteSize: LongWord; Attributes: LongWord): APTR; syscall IASL 112;
@@ -518,25 +518,25 @@ procedure ActivateAslRequest(Requester: APTR); syscall IASL 120;
 function AslControl(const Tags: PTagItem): LongWord; syscall IASL 124;
 // 128 AslControlTags
 
-function AllocAslRequest(ReqType: LongWord; const Tags: array of PtrUInt): Pointer;
-function AslRequest(Requester: Pointer; const Tags: array of PtrUInt): LongBool;
-function AslRequestTags(Requester: Pointer; const Tags: array of PtrUInt): LongBool;
+function AllocAslRequestTags(ReqType: LongWord; const Tags: array of PtrUInt): Pointer; inline;
+function AslRequestTags(Requester: Pointer; const Tags: array of PtrUInt): LongBool; inline;
+function AslControlTags(const Tags: array of PtrUInt): LongWord; inline;
 
 implementation
 
-function AllocAslRequest(ReqType: LongWord; const Tags: array of PtrUInt): Pointer; inline;
+function AllocAslRequestTags(ReqType: LongWord; const Tags: array of PtrUInt): Pointer; inline;
 begin
-  AllocAslRequest := AllocAslRequestA(reqType, @Tags);
+  AllocAslRequestTags := AllocAslRequest(ReqType, @Tags);
 end;
 
-function AslRequest(Requester: Pointer; const Tags: array of PtrUInt): LongBool; inline;
+function AslRequestTags(Requester: Pointer; const Tags: array of PtrUInt): LongBool; inline;
 begin
-  AslRequest := AslRequestA(Requester, @Tags);
+  AslRequestTags := AslRequest(Requester, @Tags);
 end;
 
-function AslRequestTags(Requester: Pointer; const Tags: array of PtrUInt): LongBool; inline;
+function AslControlTags(const Tags: array of PtrUInt): LongWord; inline;
 begin
-  AslRequestTags := AslRequestA(Requester, @Tags);
+  AslControlTags := AslControl(@Tags);
 end;
 
 initialization

packages/pastojs/src/fppas2js.pp

@@ -1,6 +1,6 @@
 {
     This file is part of the Free Component Library (FCL)
-    Copyright (c) 2018 by Michael Van Canneyt
+    Copyright (c) 2019 by Michael Van Canneyt
 
     Pascal to Javascript converter class.
 
@@ -3191,6 +3191,13 @@ end;
 procedure TPas2JSResolver.AddRecordType(El: TPasRecordType);
 begin
   inherited;
+  if (El.Name='') and (El.Parent.ClassType<>TPasVariant) then
+    begin
+    {$IFDEF VerbosePas2JS}
+    writeln('TPas2JSResolver.AddRecordType ',GetObjName(El.Parent));
+    {$ENDIF}
+    RaiseNotYetImplemented(20190408224556,El,'anonymous record type');
+    end;
   if El.Parent is TProcedureBody then
     // local record
     AddElevatedLocal(El);
@@ -6583,15 +6590,17 @@ end;
 
 function TPasToJSConverter.CreateFreeOrNewInstanceExpr(Ref: TResolvedReference;
   AContext: TConvertContext): TJSCallExpression;
-// create "$create("funcname");"
+// class: create "$create("ProcName")"
+// record: create "$new().ProcName()"
 var
-  C: TJSCallExpression;
+  C, SubCall: TJSCallExpression;
   Proc: TPasProcedure;
   ProcScope: TPasProcedureScope;
   ClassRecScope: TPasClassOrRecordScope;
   ClassOrRec: TPasElement;
   ArgEx: TJSLiteral;
-  FunName: String;
+  FunName, ProcName: String;
+  DotExpr: TJSDotMemberExpression;
 begin
   Result:=nil;
   //writeln('TPasToJSConverter.CreateFreeOrNewInstanceExpr Ref.Declaration=',GetObjName(Ref.Declaration));
@@ -6607,16 +6616,33 @@ begin
     RaiseInconsistency(20170125191923,ClassOrRec);
   C:=CreateCallExpression(Ref.Element);
   try
-    // add "$create()"
-    if rrfNewInstance in Ref.Flags then
-      FunName:=GetBIName(pbifnClassInstanceNew)
+    ProcName:=TransformVariableName(Proc,AContext);
+    if ClassOrRec.ClassType=TPasRecordType then
+      begin
+      // create "path.$new()"
+      FunName:=CreateReferencePath(Proc,AContext,rpkPathWithDot,false,Ref)+GetBIName(pbifnRecordNew);
+      SubCall:=CreateCallExpression(Ref.Element);
+      SubCall.Expr:=CreatePrimitiveDotExpr(FunName,Ref.Element);
+      // append ".ProcName"
+      DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,Ref.Element));
+      DotExpr.MExpr:=SubCall;
+      DotExpr.Name:=TJSString(ProcName);
+      // as call: "path.$new().ProcName()"
+      C.Expr:=DotExpr;
+      end
     else
-      FunName:=GetBIName(pbifnClassInstanceFree);
-    FunName:=CreateReferencePath(Proc,AContext,rpkPathWithDot,false,Ref)+FunName;
-    C.Expr:=CreatePrimitiveDotExpr(FunName,Ref.Element);
-    // parameter: "funcname"
-    ArgEx := CreateLiteralString(Ref.Element,TransformVariableName(Proc,AContext));
-    C.AddArg(ArgEx);
+      begin
+      // add "$create()"
+      if rrfNewInstance in Ref.Flags then
+        FunName:=GetBIName(pbifnClassInstanceNew)
+      else
+        FunName:=GetBIName(pbifnClassInstanceFree);
+      FunName:=CreateReferencePath(Proc,AContext,rpkPathWithDot,false,Ref)+FunName;
+      C.Expr:=CreatePrimitiveDotExpr(FunName,Ref.Element);
+      // parameter: "ProcName"
+      ArgEx := CreateLiteralString(Ref.Element,ProcName);
+      C.AddArg(ArgEx);
+      end;
     Result:=C;
   finally
     if Result=nil then
@@ -7849,7 +7875,7 @@ begin
   else if aResolver.IsExternalClassConstructor(RightRefDecl) then
     begin
     // e.g. mod.ExtClass.new;
-    if El.Parent is TParamsExpr then
+    if (El.Parent is TParamsExpr) and (TParamsExpr(El.Parent).Value=El) then
       // Note: ExtClass.new() is handled in ConvertFuncParams
       RaiseNotSupported(El,AContext,20190116135818);
     Result:=ConvertExternalConstructor(El.left,RightRef,nil,AContext);
@@ -8286,10 +8312,16 @@ begin
     if TargetProcType.Args.Count>0 then
       begin
       // add default parameters:
-      // insert array parameter [], e.g. this.TObject.$create("create",[])
-      ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
-      CreateProcedureCallArgs(ArrLit.Elements,nil,TargetProcType,AContext);
-      Call.AddArg(ArrLit);
+      if Decl.Parent.ClassType=TPasRecordType then
+        // insert default parameters, e.g. TRecord.$new().create(1,2,3)
+        CreateProcedureCallArgs(Call.Args.Elements,nil,TargetProcType,AContext)
+      else
+        begin
+        // insert array parameter [], e.g. TObject.$create("create",[])
+        ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
+        CreateProcedureCallArgs(ArrLit.Elements,nil,TargetProcType,AContext);
+        Call.AddArg(ArrLit);
+        end;
       end;
     exit;
     end;
@@ -9651,7 +9683,8 @@ var
       end;
     if Call=nil then
       Call:=CreateFreeOrNewInstanceExpr(Ref,AContext);
-    if rrfNewInstance in Ref.Flags then
+    if (rrfNewInstance in Ref.Flags)
+        and (Ref.Declaration.Parent.ClassType=TPasClassType) then
       begin
       // insert array parameter [], e.g. this.TObject.$create("create",[])
       JsArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));

packages/pastojs/src/pas2jscompiler.pp

@@ -1,4 +1,4 @@
-{ Author: Mattias Gaertner  2018  [email protected]
+{ Author: Mattias Gaertner  2019  [email protected]
 
 Abstract:
   TPas2jsCompiler is the wheel boss of the pas2js compiler.
@@ -88,7 +88,7 @@ const
   nSrcMapBaseDirIs = 135; sSrcMapBaseDirIs = 'source map "local base directory" is %s';
   nUnitFileNotFound = 136; sUnitFileNotFound = 'unit file not found %s';
   nClassInterfaceStyleIs = 137; sClassInterfaceStyleIs = 'Class interface style is %s';
-  // was nMacroXSetToY = 138
+  nHandlingEnvOpts = 138; sHandlingEnvOpts = 'handling environment options %s';
   nPostProcessorInfoX = 139; sPostProcessorInfoX = 'Post processor: %s';
   nPostProcessorRunX = 140; sPostProcessorRunX = 'Run post processor: %s';
   nPostProcessorFailX = 141; sPostProcessorFailX = 'Post processor failed: %s';
@@ -549,6 +549,7 @@ type
     // params, cfg files
     FCurParam: string;
     procedure LoadConfig(CfgFilename: string);
+    procedure ReadEnvironment;
     procedure ReadParam(Param: string; Quick, FromCmdLine: boolean);
     procedure ReadSingleLetterOptions(const Param: string; p: integer;
       const Allowed: string; out Enabled, Disabled: string);
@@ -1673,30 +1674,211 @@ begin
   // if Result=nil resolver will give a nice error position, so don't do it here
 end;
 
-{ TPas2jsCompiler }
+{ TPas2JSConfigSupport }
 
-procedure TPas2jsCompiler.SetFS(AValue: TPas2jsFS);
+procedure TPas2JSConfigSupport.CfgSyntaxError(const Msg: string);
 begin
-  if FFS=AValue then Exit;
-  FOwnsFS:=false;
-  FFS:=AValue;
+  Compiler.Log.Log(mtError,Msg,0,CurrentCfgFilename,CurrentCfgLineNumber,0);
+  Compiler.Terminate(ExitCodeErrorInConfig);
 end;
 
-function TPas2jsCompiler.GetFileCount: integer;
+procedure TPas2JSConfigSupport.LoadConfig(Const aFileName: String);
+type
+  TSkip = (
+    skipNone,
+    skipIf,
+    skipElse
+  );
+const
+  IdentChars = ['a'..'z','A'..'Z','_','0'..'9'];
+var
+  Line: String;
+  l, p, StartP: integer;
+
+  function GetWord: String;
+  begin
+    StartP:=p;
+    while (p<=l) and ((Line[p] in IdentChars) or (Line[p]>#127)) do inc(p);
+    Result:=copy(Line,StartP,p-StartP);
+    while (p<=l) and (Line[p] in [' ',#9]) do inc(p);
+  end;
+
+  procedure DebugCfgDirective(const s: string);
+  begin
+    Compiler.Log.LogMsg(nCfgDirective,[QuoteStr(Line),s],CurrentCfgFilename,CurrentCfgLineNumber,1,false);
+  end;
+
+var
+  OldCfgFilename, Directive, aName, Expr: String;
+  aFile: TSourceLineReader;
+  IfLvl, SkipLvl, OldCfgLineNumber: Integer;
+  Skip: TSkip;
 begin
-  Result:=FFiles.Count;
+  if Compiler.ShowDebug or Compiler.ShowTriedUsedFiles then
+    Compiler.Log.LogMsgIgnoreFilter(nReadingOptionsFromFile,[QuoteStr(aFilename)]);
+  IfLvl:=0;
+  SkipLvl:=0;
+  Skip:=skipNone;
+  aFile:=nil;
+  try
+    OldCfgFilename:=FCurrentCfgFilename;
+    FCurrentCfgFilename:=aFilename;
+    OldCfgLineNumber:=FCurrentCfgLineNumber;
+    aFile:=GetReader(aFileName);
+    while not aFile.IsEOF do begin
+      Line:=aFile.ReadLine;
+      FCurrentCfgLineNumber:=aFile.LineNumber;
+      if Compiler.ShowDebug then
+        Compiler.Log.LogMsgIgnoreFilter(nInterpretingFileOption,[QuoteStr(Line)]);
+      if Line='' then continue;
+      l:=length(Line);
+      p:=1;
+      while (p<=l) and (Line[p] in [' ',#9]) do inc(p);
+      if p>l then continue; // empty line
+
+      if (p<=l) and (Line[p]='#') then
+      begin
+        // cfg directive
+        inc(p);
+        if (p>l) or (Line[p] in [#0,#9,' ','-']) then continue; // comment
+        Directive:=lowercase(GetWord);
+        case Directive of
+        'ifdef','ifndef':
+          begin
+            inc(IfLvl);
+            if Skip=skipNone then
+            begin
+              aName:=GetWord;
+              if Compiler.IsDefined(aName)=(Directive='ifdef') then
+              begin
+                // execute block
+                if Compiler.ShowDebug then
+                  DebugCfgDirective('true -> execute');
+              end else begin
+                // skip block
+                if Compiler.ShowDebug then
+                  DebugCfgDirective('false -> skip');
+                SkipLvl:=IfLvl;
+                Skip:=skipIf;
+              end;
+            end;
+          end;
+        'if':
+          begin
+            inc(IfLvl);
+            if Skip=skipNone then
+            begin
+              Expr:=copy(Line,p,length(Line));
+              if ConditionEvaluator.Eval(Expr) then
+              begin
+                // execute block
+                if Compiler.ShowDebug then
+                  DebugCfgDirective('true -> execute');
+              end else begin
+                // skip block
+                if Compiler.ShowDebug then
+                  DebugCfgDirective('false -> skip');
+                SkipLvl:=IfLvl;
+                Skip:=skipIf;
+              end;
+            end;
+          end;
+        'else':
+          begin
+            if IfLvl=0 then
+              CfgSyntaxError('"'+Directive+'" without #ifdef');
+            if (Skip=skipElse) and (IfLvl=SkipLvl) then
+              CfgSyntaxError('"there was already an #else');
+            if (Skip=skipIf) and (IfLvl=SkipLvl) then
+            begin
+              // if-block was skipped -> execute else block
+              if Compiler.ShowDebug then
+                DebugCfgDirective('execute');
+              SkipLvl:=0;
+              Skip:=skipNone;
+            end else if Skip=skipNone then
+            begin
+              // if-block was executed -> skip else block
+              if Compiler.ShowDebug then
+                DebugCfgDirective('skip');
+              Skip:=skipElse;
+              SkipLvl:=IfLvl;
+            end;
+          end;
+        'elseif':
+          begin
+            if IfLvl=0 then
+              CfgSyntaxError('"'+Directive+'" without #ifdef');
+            if (Skip=skipIf) and (IfLvl=SkipLvl) then
+            begin
+              // if-block was skipped -> try this elseif
+              Expr:=copy(Line,p,length(Line));
+              if ConditionEvaluator.Eval(Expr) then
+              begin
+                // execute elseif block
+                if Compiler.ShowDebug then
+                  DebugCfgDirective('true -> execute');
+                SkipLvl:=0;
+                Skip:=skipNone;
+              end else begin
+                // skip elseif block
+                if Compiler.ShowDebug then
+                  DebugCfgDirective('false -> skip');
+              end;
+            end else if Skip=skipNone then
+            begin
+              // if-block was executed -> skip without test
+              if Compiler.ShowDebug then
+                DebugCfgDirective('no test -> skip');
+              Skip:=skipIf;
+            end;
+          end;
+        'endif':
+          begin
+            if IfLvl=0 then
+              CfgSyntaxError('"'+Directive+'" without #ifdef');
+            dec(IfLvl);
+            if IfLvl<SkipLvl then
+            begin
+              // end block
+              if Compiler.ShowDebug then
+                DebugCfgDirective('end block');
+              SkipLvl:=0;
+              Skip:=skipNone;
+            end;
+          end;
+        'error':
+          Compiler.ParamFatal('user defined: '+copy(Line,p,length(Line)))
+        else
+          if Skip=skipNone then
+            CfgSyntaxError('unknown directive "#'+Directive+'"')
+          else
+            DebugCfgDirective('skipping unknown directive');
+        end;
+      end else if Skip=skipNone then
+      begin
+        // option line
+        Line:=copy(Line,p,length(Line));
+        Compiler.ReadParam(Line,false,false);
+      end;
+    end;
+  finally
+    FCurrentCfgFilename:=OldCfgFilename;
+    FCurrentCfgLineNumber:=OldCfgLineNumber;
+    aFile.Free;
+  end;
+  if Compiler.ShowDebug or Compiler.ShowTriedUsedFiles then
+    Compiler.Log.LogMsgIgnoreFilter(nEndOfReadingConfigFile,[QuoteStr(aFilename)]);
 end;
 
-function TPas2jsCompiler.GetDefaultNamespace: String;
+procedure TPas2JSConfigSupport.LoadDefaultConfig;
 var
-  C: TClass;
+  aFileName: string;
+
 begin
-  Result:='';
-  if FMainFile=nil then exit;
-  if FMainFile.PasModule=nil then exit;
-  C:=FMainFile.PasModule.ClassType;
-  if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
-    Result:=FMainFile.PascalResolver.DefaultNameSpace;
+  aFileName:=FindDefaultConfig;
+  if aFileName<>'' then
+    LoadConfig(aFilename);
 end;
 
 procedure TPas2JSConfigSupport.ConditionEvalLog(Sender: TCondDirectiveEvaluator;
@@ -1736,6 +1918,32 @@ begin
   Result:=false;
 end;
 
+{ TPas2jsCompiler }
+
+procedure TPas2jsCompiler.SetFS(AValue: TPas2jsFS);
+begin
+  if FFS=AValue then Exit;
+  FOwnsFS:=false;
+  FFS:=AValue;
+end;
+
+function TPas2jsCompiler.GetFileCount: integer;
+begin
+  Result:=FFiles.Count;
+end;
+
+function TPas2jsCompiler.GetDefaultNamespace: String;
+var
+  C: TClass;
+begin
+  Result:='';
+  if FMainFile=nil then exit;
+  if FMainFile.PasModule=nil then exit;
+  C:=FMainFile.PasModule.ClassType;
+  if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
+    Result:=FMainFile.PascalResolver.DefaultNameSpace;
+end;
+
 procedure TPas2jsCompiler.Compile(StartTime: TDateTime);
 var
   Checked: TPasAnalyzerKeySet;
@@ -2752,7 +2960,7 @@ begin
   r(mtInfo,nSrcMapBaseDirIs,sSrcMapBaseDirIs);
   r(mtFatal,nUnitFileNotFound,sUnitFileNotFound);
   r(mtInfo,nClassInterfaceStyleIs,sClassInterfaceStyleIs);
-  LastMsgNumber:=-1; ;// was nMacroXSetToY 138
+  r(mtInfo,nHandlingEnvOpts,sHandlingEnvOpts);
   r(mtInfo,nPostProcessorInfoX,sPostProcessorInfoX);
   r(mtInfo,nPostProcessorRunX,sPostProcessorRunX);
   r(mtError,nPostProcessorFailX,sPostProcessorFailX);
@@ -2762,215 +2970,29 @@ begin
   Pas2jsPParser.RegisterMessages(Log);
 end;
 
-procedure TPas2JSConfigSupport.CfgSyntaxError(const Msg: string);
-begin
-  Compiler.Log.Log(mtError,Msg,0,CurrentCfgFilename,CurrentCfgLineNumber,0);
-  Compiler.Terminate(ExitCodeErrorInConfig);
-end;
-
 procedure TPas2jsCompiler.LoadConfig(CfgFilename: string);
 begin
   ConfigSupport.LoadConfig(CfgFileName);
 end;
 
-procedure TPas2JSConfigSupport.LoadConfig(Const aFileName: String);
-type
-  TSkip = (
-    skipNone,
-    skipIf,
-    skipElse
-  );
-const
-  IdentChars = ['a'..'z','A'..'Z','_','0'..'9'];
+procedure TPas2jsCompiler.ReadEnvironment;
 var
-  Line: String;
-  l, p, StartP: integer;
-
-  function GetWord: String;
-  begin
-    StartP:=p;
-    while (p<=l) and ((Line[p] in IdentChars) or (Line[p]>#127)) do inc(p);
-    Result:=copy(Line,StartP,p-StartP);
-    while (p<=l) and (Line[p] in [' ',#9]) do inc(p);
-  end;
-
-  procedure DebugCfgDirective(const s: string);
-  begin
-    Compiler.Log.LogMsg(nCfgDirective,[QuoteStr(Line),s],CurrentCfgFilename,CurrentCfgLineNumber,1,false);
-  end;
-
-var
-  OldCfgFilename, Directive, aName, Expr: String;
-  aFile: TSourceLineReader;
-  IfLvl, SkipLvl, OldCfgLineNumber: Integer;
-  Skip: TSkip;
+  s: String;
+  List: TStrings;
 begin
-  if Compiler.ShowDebug or Compiler.ShowTriedUsedFiles then
-    Compiler.Log.LogMsgIgnoreFilter(nReadingOptionsFromFile,[QuoteStr(aFilename)]);
-  IfLvl:=0;
-  SkipLvl:=0;
-  Skip:=skipNone;
-  aFile:=nil;
+  s:=GetEnvironmentVariable('PAS2JS_OPTS');
+  if s='' then exit;
+  if ShowDebug then
+    Log.LogMsgIgnoreFilter(nHandlingEnvOpts,['PAS2JS_OPTS=['+s+']']);
+  List:=TStringList.Create;
   try
-    OldCfgFilename:=FCurrentCfgFilename;
-    FCurrentCfgFilename:=aFilename;
-    OldCfgLineNumber:=FCurrentCfgLineNumber;
-    aFile:=GetReader(aFileName);
-    while not aFile.IsEOF do begin
-      Line:=aFile.ReadLine;
-      FCurrentCfgLineNumber:=aFile.LineNumber;
-      if Compiler.ShowDebug then
-        Compiler.Log.LogMsgIgnoreFilter(nInterpretingFileOption,[QuoteStr(Line)]);
-      if Line='' then continue;
-      l:=length(Line);
-      p:=1;
-      while (p<=l) and (Line[p] in [' ',#9]) do inc(p);
-      if p>l then continue; // empty line
-
-      if (p<=l) and (Line[p]='#') then
-      begin
-        // cfg directive
-        inc(p);
-        if (p>l) or (Line[p] in [#0,#9,' ','-']) then continue; // comment
-        Directive:=lowercase(GetWord);
-        case Directive of
-        'ifdef','ifndef':
-          begin
-            inc(IfLvl);
-            if Skip=skipNone then
-            begin
-              aName:=GetWord;
-              if Compiler.IsDefined(aName)=(Directive='ifdef') then
-              begin
-                // execute block
-                if Compiler.ShowDebug then
-                  DebugCfgDirective('true -> execute');
-              end else begin
-                // skip block
-                if Compiler.ShowDebug then
-                  DebugCfgDirective('false -> skip');
-                SkipLvl:=IfLvl;
-                Skip:=skipIf;
-              end;
-            end;
-          end;
-        'if':
-          begin
-            inc(IfLvl);
-            if Skip=skipNone then
-            begin
-              Expr:=copy(Line,p,length(Line));
-              if ConditionEvaluator.Eval(Expr) then
-              begin
-                // execute block
-                if Compiler.ShowDebug then
-                  DebugCfgDirective('true -> execute');
-              end else begin
-                // skip block
-                if Compiler.ShowDebug then
-                  DebugCfgDirective('false -> skip');
-                SkipLvl:=IfLvl;
-                Skip:=skipIf;
-              end;
-            end;
-          end;
-        'else':
-          begin
-            if IfLvl=0 then
-              CfgSyntaxError('"'+Directive+'" without #ifdef');
-            if (Skip=skipElse) and (IfLvl=SkipLvl) then
-              CfgSyntaxError('"there was already an #else');
-            if (Skip=skipIf) and (IfLvl=SkipLvl) then
-            begin
-              // if-block was skipped -> execute else block
-              if Compiler.ShowDebug then
-                DebugCfgDirective('execute');
-              SkipLvl:=0;
-              Skip:=skipNone;
-            end else if Skip=skipNone then
-            begin
-              // if-block was executed -> skip else block
-              if Compiler.ShowDebug then
-                DebugCfgDirective('skip');
-              Skip:=skipElse;
-              SkipLvl:=IfLvl;
-            end;
-          end;
-        'elseif':
-          begin
-            if IfLvl=0 then
-              CfgSyntaxError('"'+Directive+'" without #ifdef');
-            if (Skip=skipIf) and (IfLvl=SkipLvl) then
-            begin
-              // if-block was skipped -> try this elseif
-              Expr:=copy(Line,p,length(Line));
-              if ConditionEvaluator.Eval(Expr) then
-              begin
-                // execute elseif block
-                if Compiler.ShowDebug then
-                  DebugCfgDirective('true -> execute');
-                SkipLvl:=0;
-                Skip:=skipNone;
-              end else begin
-                // skip elseif block
-                if Compiler.ShowDebug then
-                  DebugCfgDirective('false -> skip');
-              end;
-            end else if Skip=skipNone then
-            begin
-              // if-block was executed -> skip without test
-              if Compiler.ShowDebug then
-                DebugCfgDirective('no test -> skip');
-              Skip:=skipIf;
-            end;
-          end;
-        'endif':
-          begin
-            if IfLvl=0 then
-              CfgSyntaxError('"'+Directive+'" without #ifdef');
-            dec(IfLvl);
-            if IfLvl<SkipLvl then
-            begin
-              // end block
-              if Compiler.ShowDebug then
-                DebugCfgDirective('end block');
-              SkipLvl:=0;
-              Skip:=skipNone;
-            end;
-          end;
-        'error':
-          Compiler.ParamFatal('user defined: '+copy(Line,p,length(Line)))
-        else
-          if Skip=skipNone then
-            CfgSyntaxError('unknown directive "#'+Directive+'"')
-          else
-            DebugCfgDirective('skipping unknown directive');
-        end;
-      end else if Skip=skipNone then
-      begin
-        // option line
-        Line:=copy(Line,p,length(Line));
-        Compiler.ReadParam(Line,false,false);
-      end;
-    end;
+    SplitCmdLineParams(s,List);
+    for s in List do
+      if s<>'' then
+        ReadParam(s,false,false);
   finally
-    FCurrentCfgFilename:=OldCfgFilename;
-    FCurrentCfgLineNumber:=OldCfgLineNumber;
-    aFile.Free;
+    List.Free;
   end;
-  if Compiler.ShowDebug or Compiler.ShowTriedUsedFiles then
-    Compiler.Log.LogMsgIgnoreFilter(nEndOfReadingConfigFile,[QuoteStr(aFilename)]);
-end;
-
-procedure TPas2JSConfigSupport.LoadDefaultConfig;
-
-var
-  aFileName: string;
-
-begin
-  aFileName:=FindDefaultConfig;
-  if aFileName<>'' then
-    LoadConfig(aFilename);
 end;
 
 procedure TPas2jsCompiler.ParamFatal(Msg: string);
@@ -4068,6 +4090,9 @@ begin
     if Assigned(ConfigSupport) and not SkipDefaultConfig then
       ConfigSupport.LoadDefaultConfig;
 
+    // read env PAS2JS_OPTS
+    ReadEnvironment;
+
     // read command line parameters
     for i:=0 to ParamList.Count-1 do
       ReadParam(ParamList[i],false,true);
@@ -4313,6 +4338,8 @@ begin
   w('  -?     : Show this help');
   w('  -h     : Show this help');
   Log.LogLn;
+  w('Environment variable PAS2JS_OPTS is parsed after default config and before command line parameters.');
+  Log.LogLn;
   w('Macros: Format is $Name, $Name$ or $Name()');
   for i:=0 to ParamMacros.Count-1 do begin
     ParamMacro:=ParamMacros[i];

packages/pastojs/src/pas2jsfilecache.pp

@@ -1494,7 +1494,7 @@ procedure TPas2jsFilesCache.WriteFoldersAndSearchPaths;
 var
   i: Integer;
 begin
-  WriteFolder('working directory',GetCurrentDirPJ);
+  WriteFolder('working directory',BaseDirectory);
   for i:=0 to ForeignUnitPaths.Count-1 do
     WriteFolder('foreign unit path',ForeignUnitPaths[i]);
   for i:=0 to UnitPaths.Count-1 do
@@ -1915,6 +1915,7 @@ var
   i: Integer;
   aFilename: String;
 begin
+  //writeln('TPas2jsFilesCache.FindUnitFileName "',aUnitname,'" ModuleDir="',ModuleDir,'"');
   Result:='';
   IsForeign:=false;
   SearchedDirs:=TStringList.Create;

packages/pastojs/src/pas2jsfiler.pp

@@ -3465,7 +3465,7 @@ begin
   // AncestorScope can be derived from DirectAncestor
   // CanonicalClassOf is autogenerated
   CanonicalClassOf:=Scope.CanonicalClassOf;
-  if aClass.ObjKind=okClass then
+  if aClass.ObjKind in ([okClass]+okAllHelpers) then
     begin
     if CanonicalClassOf=nil then
       RaiseMsg(20180217143821,aClass);

packages/pastojs/src/pas2jsfs.pp

@@ -31,14 +31,15 @@ uses
   Classes, SysUtils, PScanner, fpjson;
 
 const // Messages
+  nUsingPath = 104; sUsingPath = 'Using %s: "%s"';
+  nFolderNotFound = 105; sFolderNotFound = '%s not found: %s';
+
   nIncludeSearch = 201; sIncludeSearch = 'Include file search: %s';
   nUnitSearch = 202; sUnitSearch = 'Unitsearch: %s';
   nSearchingFileFound = 203; sSearchingFileFound = 'Searching file: %s... found';
   nSearchingFileNotFound = 204; sSearchingFileNotFound = 'Searching file: %s... not found';
   nDuplicateFileFound = 205; sDuplicateFileFound = 'Duplicate file found: "%s" and "%s"';
   nCustomJSFileNotFound = 206; sCustomJSFileNotFound = 'custom JS file not found: "%s"';
-  nUsingPath = 104; sUsingPath = 'Using %s: "%s"';
-  nFolderNotFound = 105; sFolderNotFound = '%s not found: %s';
 
 Type
   // Forward definitions

packages/pastojs/src/pas2jsuseanalyzer.pp

@@ -13,8 +13,13 @@
 
  **********************************************************************
 
-  Abstract:
-    Extends the FCL Pascal use analyzer for the language subset of pas2js.
+Abstract:
+  Extends the FCL Pascal use analyzer for the language subset of pas2js.
+
+Works:
+- Array of Const marks function System.VarRecs()
+- TPascalDescendantOfExt.Create marks class method NewInstance
+
 }
 unit Pas2jsUseAnalyzer;
 
@@ -35,6 +40,7 @@ type
   TPas2JSAnalyzer = class(TPasAnalyzer)
   public
     procedure UseExpr(El: TPasExpr); override;
+    procedure UseConstructor(Proc: TPasConstructor; PosEl: TPasElement); virtual;
   end;
 
 implementation
@@ -86,11 +92,35 @@ begin
     Ref:=TResolvedReference(El.CustomData);
     Decl:=Ref.Declaration;
     if Decl is TPasProcedure then
-      CheckArgs(TPasProcedure(Decl).ProcType.Args)
+      begin
+      CheckArgs(TPasProcedure(Decl).ProcType.Args);
+      if Decl.ClassType=TPasConstructor then
+        UseConstructor(TPasConstructor(Decl),El);
+      end
     else if Decl.ClassType=TPasProperty then
       CheckArgs(Resolver.GetPasPropertyArgs(TPasProperty(Decl)));
     end;
 end;
 
+procedure TPas2JSAnalyzer.UseConstructor(Proc: TPasConstructor;
+  PosEl: TPasElement);
+var
+  ClassScope: TPas2JSClassScope;
+begin
+  if Proc.Parent.ClassType=TPasClassType then
+    begin
+    ClassScope:=TPasClassType(Proc.Parent).CustomData as TPas2JSClassScope;
+    repeat
+      if ClassScope.NewInstanceFunction<>nil then
+        begin
+        UseProcedure(ClassScope.NewInstanceFunction);
+        break;
+        end;
+      ClassScope:=ClassScope.AncestorScope as TPas2JSClassScope;
+    until ClassScope=nil;
+    end;
+  if PosEl=nil then ;
+end;
+
 end.
 

packages/pastojs/tests/tcmodules.pas

@@ -461,6 +461,7 @@ type
     Procedure TestRecord_Const;
     Procedure TestRecord_TypecastFail;
     Procedure TestRecord_InFunction;
+    Procedure TestRecord_AnonymousFail;
     // ToDo: RTTI of local record
     // ToDo: pcu local record, name clash and rtti
 
@@ -10601,6 +10602,18 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestRecord_AnonymousFail;
+begin
+  StartProgram(false);
+  Add([
+  'var',
+  '  r: record x: word end;',
+  'begin']);
+  SetExpectedPasResolverError('not yet implemented: :TPasRecordType [20190408224556] anonymous record type',
+    nNotYetImplemented);
+  ConvertProgram;
+end;
+
 procedure TTestModule.TestAdvRecord_Function;
 begin
   StartProgram(false);
@@ -11208,6 +11221,7 @@ begin
   'var r: TPoint;',
   'begin',
   '  r:=TPoint.Create(1,2);',
+  '  with TPoint do r:=Create(1,2);',
   '  r.Create(3);',
   '  r:=r.Create(4);',
   '']);
@@ -11234,7 +11248,9 @@ begin
     'this.r = $mod.TPoint.$new();',
     '']),
     LinesToStr([ // $mod.$main
-    '$mod.r.$assign($mod.TPoint.$create("Create", [1, 2]));',
+    '$mod.r.$assign($mod.TPoint.$new().Create(1, 2));',
+    'var $with1 = $mod.TPoint;',
+    '$mod.r.$assign($with1.$new().Create(1, 2));',
     '$mod.r.Create(3, -1);',
     '$mod.r.$assign($mod.r.Create(4, -1));',
     '']));
@@ -16019,6 +16035,7 @@ begin
   Add('  A: texta;');
   Add('begin');
   Add('  a:=texta.new;');
+  Add('  a:=texta(texta.new);');
   Add('  a:=texta.new();');
   Add('  a:=texta.new(1);');
   Add('  with texta do begin');
@@ -16037,6 +16054,7 @@ begin
     LinesToStr([ // $mod.$main
     '$mod.A = new ExtA();',
     '$mod.A = new ExtA();',
+    '$mod.A = new ExtA();',
     '$mod.A = new ExtA(1,2);',
     '$mod.A = new ExtA();',
     '$mod.A = new ExtA();',
@@ -21545,7 +21563,7 @@ begin
     'rtl.createHelper($mod, "THelper", null, function () {',
     '  this.NewHlp = function (w) {',
     '    this.Create(2);',
-    '    $mod.TRec.$create("Create", [3]);',
+    '    $mod.TRec.$new().Create(3);',
     '    $mod.THelper.NewHlp.call(this, 4);',
     '    $mod.THelper.$new("NewHlp", [5]);',
     '    return this;',

packages/pastojs/tests/tcoptimizations.pas

@@ -76,6 +76,7 @@ type
     procedure TestWPO_Class_OmitPropertyGetter2;
     procedure TestWPO_Class_OmitPropertySetter1;
     procedure TestWPO_Class_OmitPropertySetter2;
+    procedure TestWPO_Class_KeepNewInstance;
     procedure TestWPO_CallInherited;
     procedure TestWPO_UseUnit;
     procedure TestWPO_ArrayOfConst_Use;
@@ -724,6 +725,56 @@ begin
     '']));
 end;
 
+procedure TTestOptimizations.TestWPO_Class_KeepNewInstance;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExt = class external name ''Object''',
+  '  end;',
+  '  TBird = class(TExt)',
+  '  protected',
+  '    class function NewInstance(fnname: string; const paramarray): TBird; virtual;',
+  '  public',
+  '    constructor Create;',
+  '  end;',
+  'class function TBird.NewInstance(fnname: string; const paramarray): TBird;',
+  'begin',
+  '  asm',
+  '  Result = Object.create();',
+  '  end;',
+  'end;',
+  'constructor TBird.Create;',
+  'begin',
+  '  inherited;',
+  'end;',
+  'begin',
+  '  TBird.Create;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestWPO_Class_KeepNewInstance',
+    LinesToStr([
+    'rtl.createClassExt($mod, "TBird", Object, "NewInstance", function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.NewInstance = function (fnname, paramarray) {',
+    '    var Result = null;',
+    '    Result = Object.create();',
+    '    return Result;',
+    '  };',
+    '  this.Create = function () {',
+    '    return this;',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([
+    '$mod.TBird.$create("Create");',
+    '']));
+end;
+
 procedure TTestOptimizations.TestWPO_CallInherited;
 begin
   StartProgram(false);

packages/pastojs/tests/testpas2js.lpi

@@ -1,6 +1,6 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
-  <ProjectOptions BuildModesCount="1">
+  <ProjectOptions>
     <Version Value="12"/>
     <General>
       <Flags>
@@ -17,8 +17,8 @@
     <i18n>
       <EnableI18N LFM="False"/>
     </i18n>
-    <BuildModes>
-      <Item1 Name="Default" Default="True"/>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>

packages/paszlib/src/zipper.pp

@@ -633,16 +633,33 @@ Type
 
 
   constructor TFileStream.Create(const AFileName: rawbytestring; Mode: Word; Rights: Cardinal);
+    {$ifdef Windows}
+    function FixLongFilename(const Fn: RawByteString): RawByteString;
+    begin
+      Result := Fn;
+      if (Length(Fn)>MAX_PATH) and not ((Pos('\\?\', Fn)=1) or (Pos('\\.\', Fn)=1) or (Pos('\\?\UNC\', Fn)=1)) then
+        begin
+          if (Pos('\\', Fn)=1) and (length(FN)>2) then
+            Insert('?\UNC\',Result,3)
+          else
+            Result:='\\?\'+Fn;
+        end;
+    end;
+    {$endif}
 
   Var
     H : Thandle;
 
   begin
+    {$ifdef Windows}
+    FFileName:=FixLongFilename(AFileName);
+    {$else}
     FFileName:=AFileName;
+    {$endif}
     If (Mode and fmCreate) > 0 then
-      H:=FileCreate(AFileName,Mode,Rights)
+      H:=FileCreate(FFileName,Mode,Rights)
     else
-      H:=FileOpen(AFileName,Mode);
+      H:=FileOpen(FFileName,Mode);
 
     If (THandle(H)=feInvalidHandle) then
       If Mode=fmcreate then

packages/rtl-objpas/src/i386/invoke.inc

@@ -195,6 +195,8 @@ begin
       AddRegArg(PtrUInt(aArgs[i].ValueRef))
     else if aArgs[i].Info.ParamFlags * [pfOut, pfVar, pfConstRef] <> [] then
       AddRegArg(PtrUInt(aArgs[i].ValueRef))
+    else if (pfConst in aArgs[i].Info.ParamFlags) and not Assigned(aArgs[i].Info.ParamType) then
+      AddRegArg(PtrUInt(aArgs[i].ValueRef))
     else begin
       td := GetTypeData(aArgs[i].Info.ParamType);
       case aArgs[i].Info.ParamType^.Kind of
@@ -296,6 +298,8 @@ begin
         AddStackArg(PtrUInt(aArgs[stackargs[i]].ValueRef))
       else if aArgs[stackargs[i]].Info.ParamFlags * [pfOut, pfVar, pfConstRef] <> [] then
         AddStackArg(PtrUInt(aArgs[stackargs[i]].ValueRef))
+      else if (pfConst in aArgs[stackargs[i]].Info.ParamFlags) and not Assigned(aArgs[stackargs[i]].Info.ParamType) then
+        AddStackArg(PtrUInt(aArgs[stackargs[i]].ValueRef))
       else begin
         td := GetTypeData(aArgs[stackargs[i]].Info.ParamType);
         case aArgs[stackargs[i]].Info.ParamType^.Kind of

packages/rtl-objpas/src/inc/rtti.pp

@@ -399,6 +399,7 @@ type
   TRttiMethod = class(TRttiMember)
   private
     FString: String;
+    function GetFlags: TFunctionCallFlags;
   protected
     function GetCallingConvention: TCallConv; virtual; abstract;
     function GetCodeAddress: CodePointer; virtual; abstract;
@@ -429,6 +430,9 @@ type
     function Invoke(aInstance: TObject; const aArgs: array of TValue): TValue;
     function Invoke(aInstance: TClass; const aArgs: array of TValue): TValue;
     function Invoke(aInstance: TValue; const aArgs: array of TValue): TValue;
+    { Note: once "reference to" is supported these will be replaced by a single method }
+    function CreateImplementation(aUserData: Pointer; aCallback: TMethodImplementationCallbackMethod): TMethodImplementation;
+    function CreateImplementation(aUserData: Pointer; aCallback: TMethodImplementationCallbackProc): TMethodImplementation;
   end;
 
   TRttiStructuredType = class(TRttiType)
@@ -481,9 +485,10 @@ type
     property DeclaringUnitName: string read GetDeclaringUnitName;
   end;
 
-  EInsufficientRtti = class(Exception);
-  EInvocationError = class(Exception);
-  ENonPublicType = class(Exception);
+  ERtti = class(Exception);
+  EInsufficientRtti = class(ERtti);
+  EInvocationError = class(ERtti);
+  ENonPublicType = class(ERtti);
 
   TFunctionCallParameter = record
     ValueRef: Pointer;
@@ -1332,13 +1337,13 @@ begin
                  end;
     tkBool     : begin
                    case GetTypeData(ATypeInfo)^.OrdType of
-                     otUByte: result.FData.FAsSByte := ShortInt(System.PBoolean(ABuffer)^);
-                     otUWord: result.FData.FAsUWord := Byte(PBoolean16(ABuffer)^);
-                     otULong: result.FData.FAsULong := SmallInt(PBoolean32(ABuffer)^);
+                     otUByte: result.FData.FAsUByte := Byte(System.PBoolean(ABuffer)^);
+                     otUWord: result.FData.FAsUWord := Word(PBoolean16(ABuffer)^);
+                     otULong: result.FData.FAsULong := DWord(PBoolean32(ABuffer)^);
                      otUQWord: result.FData.FAsUInt64 := QWord(PBoolean64(ABuffer)^);
-                     otSByte: result.FData.FAsSByte := Word(PByteBool(ABuffer)^);
-                     otSWord: result.FData.FAsSWord := LongInt(PWordBool(ABuffer)^);
-                     otSLong: result.FData.FAsSLong := LongWord(PLongBool(ABuffer)^);
+                     otSByte: result.FData.FAsSByte := ShortInt(PByteBool(ABuffer)^);
+                     otSWord: result.FData.FAsSWord := SmallInt(PWordBool(ABuffer)^);
+                     otSLong: result.FData.FAsSLong := LongInt(PLongBool(ABuffer)^);
                      otSQWord: result.FData.FAsSInt64 := Int64(PQWordBool(ABuffer)^);
                    end;
                  end;
@@ -1642,6 +1647,9 @@ begin
     tkQWord   : result := IntToStr(AsUInt64);
     tkInt64   : result := IntToStr(AsInt64);
     tkBool    : result := BoolToStr(AsBoolean, True);
+    tkPointer : result := '(pointer @ ' + HexStr(FData.FAsPointer) + ')';
+    tkInterface : result := '(interface @ ' + HexStr(PPointer(FData.FValueData.GetReferenceToRawData)^) + ')';
+    tkInterfaceRaw : result := '(raw interface @ ' + HexStr(FData.FAsPointer) + ')';
   else
     result := '';
   end;
@@ -1984,7 +1992,7 @@ begin
         if Assigned(aArgs[unhidden].TypeInfo) and not aArgs[unhidden].IsArray and (aArgs[unhidden].Kind <> param.ParamType.TypeKind) then
           raise EInvocationError.CreateFmt(SErrInvokeArrayArgExpected, [param.Name, aName]);
       end else if not (pfHidden in param.Flags) then begin
-        if aArgs[unhidden].Kind <> param.ParamType.TypeKind then
+        if Assigned(param.ParamType) and (aArgs[unhidden].Kind <> param.ParamType.TypeKind) then
           raise EInvocationError.CreateFmt(SErrInvokeArgInvalidType, [param.Name, aName]);
       end;
     end;
@@ -2014,7 +2022,10 @@ begin
 
   for i := 0 to High(aParams) do begin
     param := aParams[i];
-    args[i].Info.ParamType := param.ParamType.FTypeInfo;
+    if Assigned(param.ParamType) then
+      args[i].Info.ParamType := param.ParamType.FTypeInfo
+    else
+      args[i].Info.ParamType := Nil;
     args[i].Info.ParamFlags := param.Flags;
     args[i].Info.ParaLocs := Nil;
 
@@ -2535,7 +2546,10 @@ begin
       Assert((i < Length(fArgs)) and (pfHigh in fArgs[i].ParamFlags), 'Expected high parameter after open array parameter');
       TValue.MakeOpenArray(aArgs[i - 1], SizeInt(aArgs[i]), fArgs[i].ParamType, args[argidx]);
     end else if not (pfHidden in fArgs[i].ParamFlags) or (pfSelf in fArgs[i].ParamFlags) then begin
-      TValue.Make(aArgs[i], fArgs[i].ParamType, args[argidx]);
+      if Assigned(fArgs[i].ParamType) then
+        TValue.Make(aArgs[i], fArgs[i].ParamType, args[argidx])
+      else
+        TValue.Make(@aArgs[i], TypeInfo(Pointer), args[argidx]);
     end;
 
     Inc(i);
@@ -2600,6 +2614,13 @@ begin
   Result := False;
 end;
 
+function TRttiMethod.GetFlags: TFunctionCallFlags;
+begin
+  Result := [];
+  if IsStatic then
+    Include(Result, fcfStatic);
+end;
+
 function TRttiMethod.GetParameters: specialize TArray<TRttiParameter>;
 begin
   Result := GetParameters(False);
@@ -2704,6 +2725,76 @@ begin
   Result := Rtti.Invoke(Name, addr, CallingConvention, IsStatic, aInstance, aArgs, GetParameters(True), ReturnType);
 end;
 
+function TRttiMethod.CreateImplementation(aUserData: Pointer; aCallback: TMethodImplementationCallbackMethod): TMethodImplementation;
+var
+  params: specialize TArray<TRttiParameter>;
+  args: specialize TArray<TFunctionCallParameterInfo>;
+  res: PTypeInfo;
+  restype: TRttiType;
+  resinparam: Boolean;
+  i: SizeInt;
+begin
+  if not Assigned(aCallback) then
+    raise EArgumentNilException.Create(SErrMethodImplNoCallback);
+
+  resinparam := False;
+  params := GetParameters(True);
+  SetLength(args, Length(params));
+  for i := 0 to High(params) do begin
+    if Assigned(params[i].ParamType) then
+      args[i].ParamType := params[i].ParamType.FTypeInfo
+    else
+      args[i].ParamType := Nil;
+    args[i].ParamFlags := params[i].Flags;
+    args[i].ParaLocs := Nil;
+    if pfResult in params[i].Flags then
+      resinparam := True;
+  end;
+
+  restype := GetReturnType;
+  if Assigned(restype) and not resinparam then
+    res := restype.FTypeInfo
+  else
+    res := Nil;
+
+  Result := TMethodImplementation.Create(GetCallingConvention, args, res, GetFlags, aUserData, aCallback);
+end;
+
+function TRttiMethod.CreateImplementation(aUserData: Pointer; aCallback: TMethodImplementationCallbackProc): TMethodImplementation;
+var
+  params: specialize TArray<TRttiParameter>;
+  args: specialize TArray<TFunctionCallParameterInfo>;
+  res: PTypeInfo;
+  restype: TRttiType;
+  resinparam: Boolean;
+  i: SizeInt;
+begin
+  if not Assigned(aCallback) then
+    raise EArgumentNilException.Create(SErrMethodImplNoCallback);
+
+  resinparam := False;
+  params := GetParameters(True);
+  SetLength(args, Length(params));
+  for i := 0 to High(params) do begin
+    if Assigned(params[i].ParamType) then
+      args[i].ParamType := params[i].ParamType.FTypeInfo
+    else
+      args[i].ParamType := Nil;
+    args[i].ParamFlags := params[i].Flags;
+    args[i].ParaLocs := Nil;
+    if pfResult in params[i].Flags then
+      resinparam := True;
+  end;
+
+  restype := GetReturnType;
+  if Assigned(restype) and not resinparam then
+    res := restype.FTypeInfo
+  else
+    res := Nil;
+
+  Result := TMethodImplementation.Create(GetCallingConvention, args, res, GetFlags, aUserData, aCallback);
+end;
+
 { TRttiInvokableType }
 
 function TRttiInvokableType.GetParameters: specialize TArray<TRttiParameter>;
@@ -2727,7 +2818,10 @@ begin
   params := GetParameters(True);
   SetLength(args, Length(params));
   for i := 0 to High(params) do begin
-    args[i].ParamType := params[i].ParamType.FTypeInfo;
+    if Assigned(params[i].ParamType) then
+      args[i].ParamType := params[i].ParamType.FTypeInfo
+    else
+      args[i].ParamType := Nil;
     args[i].ParamFlags := params[i].Flags;
     args[i].ParaLocs := Nil;
     if pfResult in params[i].Flags then
@@ -2759,7 +2853,10 @@ begin
   params := GetParameters(True);
   SetLength(args, Length(params));
   for i := 0 to High(params) do begin
-    args[i].ParamType := params[i].ParamType.FTypeInfo;
+    if Assigned(params[i].ParamType) then
+      args[i].ParamType := params[i].ParamType.FTypeInfo
+    else
+      args[i].ParamType := Nil;
     args[i].ParamFlags := params[i].Flags;
     args[i].ParaLocs := Nil;
     if pfResult in params[i].Flags then
@@ -2794,6 +2891,7 @@ var
   total, visible, i: SizeInt;
   ptr: PByte;
   paramtypes: PPPTypeInfo;
+  paramtype: PTypeInfo;
   context: TRttiContext;
   obj: TRttiObject;
 begin
@@ -2850,7 +2948,11 @@ begin
         if Assigned(obj) then
           FParamsAll[i] := obj as TRttiMethodTypeParameter
         else begin
-          FParamsAll[i] := TRttiMethodTypeParameter.Create(infos[i].Handle, infos[i].Name, infos[i].Flags, paramtypes[i]^);
+          if Assigned(paramtypes[i]) then
+            paramtype := paramtypes[i]^
+          else
+            paramtype := Nil;
+          FParamsAll[i] := TRttiMethodTypeParameter.Create(infos[i].Handle, infos[i].Name, infos[i].Flags, paramtype);
           context.AddObject(FParamsAll[i]);
         end;
 

packages/rtl-objpas/src/x86_64/invoke.inc

@@ -165,6 +165,8 @@ begin
       val := PtrUInt(aArgs[i].ValueRef)
     else if aArgs[i].Info.ParamFlags * [pfOut, pfVar, pfConstRef] <> [] then
       val := PtrUInt(aArgs[i].ValueRef)
+    else if (pfConst in aArgs[i].Info.ParamFlags) and not Assigned(aArgs[i].Info.ParamType) then
+      val := PtrUInt(aArgs[i].ValueRef)
     else begin
       td := GetTypeData(aArgs[i].Info.ParamType);
       case aArgs[i].Info.ParamType^.Kind of
@@ -523,19 +525,14 @@ type
   PByteBool = ^ByteBool;
   PQWordBool = ^QWordBool;
 var
-  stackarea: array of PtrUInt;
-  stackptr: Pointer;
-  regs: array[0..3] of PtrUInt;
   i, argidx, ofs: LongInt;
-  val: PtrUInt;
   td: PTypeData;
-  argcount, resreg, refargs: SizeInt;
+  argcount: SizeInt;
 begin
   fResultInParam := ReturnResultInParam(fResultType);
 
   ofs := 0;
   argidx := 0;
-  refargs := 0;
   argcount := Length(fArgs);
   if fResultInParam then begin
     if fcfStatic in fFlags then
@@ -564,6 +561,8 @@ begin
       fArgInfos[argidx].Deref := True
     else if fArgs[i].ParamFlags * [pfOut, pfVar, pfConstRef] <> [] then
       fArgInfos[argidx].Deref := True
+    else if (pfConst in fArgs[i].ParamFlags) and not Assigned(fArgs[i].ParamType) then
+      fArgInfos[argidx].Deref := True
     else begin
       td := GetTypeData(fArgs[i].ParamType);
       case fArgs[i].ParamType^.Kind of

packages/rtl-objpas/tests/testrunner.rtlobjpas.pp

@@ -8,6 +8,7 @@ program testrunner.rtlobjpas;
 {.$define useffi}
 {$if defined(CPUX64) and defined(WINDOWS)}
 {$define testinvoke}
+{$define testimpl}
 {$elseif defined(CPUI386)}
 {$define testinvoke}
 {$else}

packages/rtl-objpas/tests/tests.rtti.impl.pas

@@ -27,6 +27,7 @@ type
     OutputArgs: array of TValue;
     ResultValue: TValue;
     InOutMapping: array of SizeInt;
+    InputUntypedTypes: array of PTypeInfo;
 
 {$ifdef fpc}
     procedure OnHandleInvokable(aInvokable: TRttiInvokableType; const aArgs: TValueArray; out aResult: TValue);
@@ -71,6 +72,7 @@ type
   TTestMethod18 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended of object;
   TTestMethod19 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp of object;
   TTestMethod20 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency of object;
+  TTestMethod21 = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4) of object;
 
   TTestProc1 = procedure;
   TTestProc2 = function(aArg1: SizeInt): SizeInt;
@@ -92,6 +94,7 @@ type
   TTestProc18 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
   TTestProc19 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
   TTestProc20 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
+  TTestProc21 = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
 
 const
   SingleArg1: Single = 1.23;
@@ -227,7 +230,10 @@ begin
   SetLength(InputArgs, Length(aArgs));
   for i := 0 to High(aArgs) do begin
     Status('Arg %d: %p %p', [i, aArgs[i].GetReferenceToRawData, PPointer(aArgs[i].GetReferenceToRawData)^]);
-    InputArgs[i] := CopyValue(aArgs[i]);
+    if Assigned(InputUntypedTypes[i]) then
+      TValue.Make(PPointer(aArgs[i].GetReferenceToRawData)^, InputUntypedTypes[i], InputArgs[i])
+    else
+      InputArgs[i] := CopyValue(aArgs[i]);
   end;
   Status('Setting output args');
   { Note: account for Self }
@@ -251,6 +257,7 @@ var
   impl: TMethodImplementation;
   mrec: TMethod;
   name: String;
+  params: array of TRttiParameter;
 begin
   name := aTypeInfo^.Name;
 
@@ -266,12 +273,21 @@ begin
     CheckEquals(Length(aOutputArgs), Length(aInOutMapping), 'Invalid in/out mapping');
     Check(Length(aOutputArgs) <= Length(aInputArgs), 'Output args not part of input args');
 
+    params := method.GetParameters;
+
     { arguments might be modified by Invoke (Note: Copy() does not uniquify the
       IValueData of managed types) }
     SetLength(input, Length(aInputArgs) + 1);
+    SetLength(InputUntypedTypes, Length(aInputArgs) + 1);
     input[0] := GetPointerValue(Self);
-    for i := 0 to High(aInputArgs) do
+    InputUntypedTypes[0] := Nil;
+    for i := 0 to High(aInputArgs) do begin
       input[i + 1] := CopyValue(aInputArgs[i]);
+      if not Assigned(params[i].ParamType) then
+        InputUntypedTypes[i + 1] := aInputArgs[i].TypeInfo
+      else
+        InputUntypedTypes[i + 1] := Nil;
+    end;
 
     impl := method.CreateImplementation({$ifdef fpc}@{$endif}OnHandleInvokable);
     CheckNotNull(impl, 'Method implementation is Nil');
@@ -318,6 +334,7 @@ var
   impl: TMethodImplementation;
   name: String;
   cp: CodePointer;
+  params: array of TRttiParameter;
 begin
   name := aTypeInfo^.Name;
 
@@ -333,11 +350,19 @@ begin
     CheckEquals(Length(aOutputArgs), Length(aInOutMapping), 'Invalid in/out mapping');
     Check(Length(aOutputArgs) <= Length(aInputArgs), 'Output args not part of input args');
 
+    params := proc.GetParameters;
+
     { arguments might be modified by Invoke (Note: Copy() does not uniquify the
       IValueData of managed types) }
     SetLength(input, Length(aInputArgs));
-    for i := 0 to High(aInputArgs) do
+    SetLength(InputUntypedTypes, Length(aInputArgs));
+    for i := 0 to High(aInputArgs) do begin
       input[i] := CopyValue(aInputArgs[i]);
+      if not Assigned(params[i].ParamType) then
+        InputUntypedTypes[i] := aInputArgs[i].TypeInfo
+      else
+        InputUntypedTypes[i] := Nil;
+    end;
 
     impl := proc.CreateImplementation({$ifdef fpc}@{$endif}OnHandleInvokable);
     CheckNotNull(impl, 'Method implementation is Nil');
@@ -476,6 +501,25 @@ begin
     GetCurrencyValue(CurrencyAddArg1), GetCurrencyValue(CurrencyAddArg2), GetCurrencyValue(CurrencyAddArg3), GetCurrencyValue(CurrencyAddArg4), GetCurrencyValue(CurrencyAddArg5),
     GetCurrencyValue(CurrencyAddArg6), GetCurrencyValue(CurrencyAddArg7), GetCurrencyValue(CurrencyAddArg8), GetCurrencyValue(CurrencyAddArg9), GetCurrencyValue(CurrencyAddArg10)
   ], [], [], GetCurrencyValue(CurrencyAddRes));
+
+  {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod21>([
+    GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876)
+  ], [
+    GetIntValue(5678), GetIntValue(6789)
+  ], [0, 1], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod21>([
+    GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
+  ], [
+    GetAnsiString('Gamma'), GetAnsiString('Epsilon')
+  ], [0, 1], TValue.Empty);
+
+  { for some reason this fails, though it fails in Delphi as well :/ }
+  {{$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod21>([
+    GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
+  ], [
+    GetShortString('Gamma'), GetShortString('Epsilon')
+  ], [0, 1], TValue.Empty);}
 end;
 
 procedure TTestImpl.TestProcVars;
@@ -569,6 +613,25 @@ begin
     GetCurrencyValue(CurrencyAddArg1), GetCurrencyValue(CurrencyAddArg2), GetCurrencyValue(CurrencyAddArg3), GetCurrencyValue(CurrencyAddArg4), GetCurrencyValue(CurrencyAddArg5),
     GetCurrencyValue(CurrencyAddArg6), GetCurrencyValue(CurrencyAddArg7), GetCurrencyValue(CurrencyAddArg8), GetCurrencyValue(CurrencyAddArg9), GetCurrencyValue(CurrencyAddArg10)
   ], [], [], GetCurrencyValue(CurrencyAddRes));
+
+  {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc21>([
+    GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876)
+  ], [
+    GetIntValue(5678), GetIntValue(6789)
+  ], [0, 1], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc21>([
+    GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
+  ], [
+    GetAnsiString('Gamma'), GetAnsiString('Epsilon')
+  ], [0, 1], TValue.Empty);
+
+  { for some reason this fails, though it fails in Delphi as well :/ }
+  {{$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc21>([
+    GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
+  ], [
+    GetShortString('Gamma'), GetShortString('Epsilon')
+  ], [0, 1], TValue.Empty);}
 end;
 {$endif}
 

packages/rtl-objpas/tests/tests.rtti.invoke.pas

@@ -34,6 +34,7 @@ type
     procedure DoMethodInvoke(aInst: TObject; aMethod: TMethod; aTypeInfo: PTypeInfo; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
     procedure DoProcVarInvoke(aInst: TObject; aProc: CodePointer; aTypeInfo: PTypeInfo; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
     procedure DoProcInvoke(aInst: TObject; aProc: CodePointer; aTypeInfo: PTypeInfo; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
+    procedure DoUntypedInvoke(aInst: TObject; aProc: CodePointer; aMethod: TMethod; aTypeInfo: PTypeInfo; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
 {$ifndef InLazIDE}
     {$ifdef fpc}generic{$endif} procedure GenDoMethodInvoke<T>(aInst: TObject; aMethod: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
     {$ifdef fpc}generic{$endif} procedure GenDoProcvarInvoke<T>(aInst: TObject; aProc: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
@@ -65,6 +66,8 @@ type
 
     procedure TestProc;
     procedure TestProcRecs;
+
+    procedure TestUntyped;
   end;
 
 implementation
@@ -697,6 +700,8 @@ type
     function TestRecSize8(aArg1: TTestRecord8): TTestRecord8;
     function TestRecSize9(aArg1: TTestRecord9): TTestRecord9;
     function TestRecSize10(aArg1: TTestRecord10): TTestRecord10;
+
+    procedure TestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
   end;
   {$M-}
 
@@ -735,9 +740,13 @@ type
     function TestRecSize8(aArg1: TTestRecord8): TTestRecord8;
     function TestRecSize9(aArg1: TTestRecord9): TTestRecord9;
     function TestRecSize10(aArg1: TTestRecord10): TTestRecord10;
+
+    procedure TestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
   public
     InputArgs: array of TValue;
     OutputArgs: array of TValue;
+    ExpectedArgs: array of TValue;
+    OutArgs: array of TValue;
     ResultValue: TValue;
     CalledMethod: SizeInt;
     InOutMapping: array of SizeInt;
@@ -783,6 +792,8 @@ type
   TMethodTestRecSize9 = function(aArg1: TTestRecord9): TTestRecord9 of object;
   TMethodTestRecSize10 = function(aArg1: TTestRecord10): TTestRecord10 of object;
 
+  TMethodTestUntyped = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4) of object;
+
   TProcVarTest1 = procedure;
   TProcVarTest2 = function: SizeInt;
   TProcVarTest3 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
@@ -817,6 +828,8 @@ type
   TProcVarTestRecSize9 = function(aArg1: TTestRecord9): TTestRecord9;
   TProcVarTestRecSize10 = function(aArg1: TTestRecord10): TTestRecord10;
 
+  TProcVarTestUntyped = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
+
 procedure TTestInterfaceClass.Test1;
 begin
   SetLength(InputArgs, 0);
@@ -1318,10 +1331,38 @@ begin
   CalledMethod := 10 or RecSizeMarker;
 end;
 
+procedure TTestInterfaceClass.TestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
+begin
+  if Length(ExpectedArgs) <> 4 then
+    Exit;
+  if Length(OutArgs) <> 2 then
+    Exit;
+
+  SetLength(InputArgs, 4);
+  TValue.Make(@aArg1, ExpectedArgs[0].TypeInfo, InputArgs[0]);
+  TValue.Make(@aArg2, ExpectedArgs[1].TypeInfo, InputArgs[1]);
+  TValue.Make(@aArg3, ExpectedArgs[2].TypeInfo, InputArgs[2]);
+  TValue.Make(@aArg4, ExpectedArgs[3].TypeInfo, InputArgs[3]);
+
+  Move(PPointer(OutArgs[0].GetReferenceToRawData)^, aArg1, OutArgs[0].DataSize);
+  Move(PPointer(OutArgs[1].GetReferenceToRawData)^, aArg2, OutArgs[1].DataSize);
+
+  SetLength(OutputArgs, 2);
+  TValue.Make(@aArg1, ExpectedArgs[0].TypeInfo, OutputArgs[0]);
+  TValue.Make(@aArg2, ExpectedArgs[1].TypeInfo, OutputArgs[1]);
+  SetLength(InOutMapping, 2);
+  InOutMapping[0] := 0;
+  InOutMapping[1] := 1;
+
+  CalledMethod := -1;
+end;
+
 procedure TTestInterfaceClass.Reset;
 begin
   InputArgs := Nil;
   OutputArgs := Nil;
+  ExpectedArgs := Nil;
+  OutArgs := Nil;
   InOutMapping := Nil;
   ResultValue := TValue.Empty;
   CalledMethod := 0;
@@ -1487,6 +1528,11 @@ begin
   Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize10(aArg1);
 end;
 
+procedure ProcTestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
+begin
+  TTestInterfaceClass.ProcVarInst.TestUntyped(aArg1, aArg2, aArg3, aArg4);
+end;
+
 procedure TTestInvoke.DoIntfInvoke(aIndex: SizeInt; aInputArgs,
   aOutputArgs: TValueArray; aResult: TValue);
 var
@@ -1718,6 +1764,89 @@ begin
   end;
 end;
 
+procedure TTestInvoke.DoUntypedInvoke(aInst: TObject; aProc: CodePointer;
+  aMethod: TMethod; aTypeInfo: PTypeInfo; aInputArgs, aOutputArgs: TValueArray;
+  aResult: TValue);
+var
+  cls: TTestInterfaceClass;
+  intf: ITestInterface;
+  name: String;
+  context: TRttiContext;
+  t: TRttiType;
+  callable, res: TValue;
+  proc: TRttiInvokableType;
+  method: TRttiMethod;
+  i: SizeInt;
+  input: array of TValue;
+begin
+  cls := aInst as TTestInterfaceClass;
+  cls.Reset;
+
+  name := 'TestUntyped';
+  TTestInterfaceClass.ProcVarInst := cls;
+
+  context := TRttiContext.Create;
+  try
+    method := Nil;
+    proc := Nil;
+    if Assigned(aProc) then begin
+      TValue.Make(@aProc, aTypeInfo, callable);
+
+      t := context.GetType(aTypeInfo);
+      Check(t is TRttiProcedureType, 'Not a procedure variable: ' + aTypeInfo^.Name);
+      proc := t as TRttiProcedureType;
+    end else if Assigned(aMethod.Code) then begin
+      TValue.Make(@aMethod, aTypeInfo, callable);
+
+      t := context.GetType(aTypeInfo);
+      Check(t is TRttiMethodType, 'Not a method variable: ' + aTypeInfo^.Name);
+      proc := t as TRttiMethodType;
+    end else begin
+      intf := cls;
+
+      TValue.Make(@intf, TypeInfo(intf), callable);
+
+      t := context.GetType(TypeInfo(ITestInterface));
+      method := t.GetMethod(name);
+      Check(Assigned(method), 'Method not found: ' + name);
+    end;
+
+    { arguments might be modified by Invoke (Note: Copy() does not uniquify the
+      IValueData of managed types) }
+    SetLength(input, Length(aInputArgs));
+    SetLength(cls.ExpectedArgs, Length(aInputArgs));
+    for i := 0 to High(input) do begin
+      input[i] := CopyValue(aInputArgs[i]);
+      cls.ExpectedArgs[i] := CopyValue(aInputArgs[i]);
+    end;
+    SetLength(cls.OutArgs, Length(aOutputArgs));
+    for i := 0 to High(cls.OutArgs) do begin
+      cls.OutArgs[i] := CopyValue(aOutputArgs[i]);
+    end;
+
+    if Assigned(proc) then
+      res := proc.Invoke(callable, aInputArgs)
+    else
+      res := method.Invoke(callable, aInputArgs);
+
+    CheckEquals(-1, cls.CalledMethod, 'Wrong method called for ' + name);
+    Check(EqualValues(cls.ResultValue, res), 'Reported result value differs from returned for ' + name);
+    Check(EqualValues(aResult, res), 'Expected result value differs from returned for ' + name);
+    CheckEquals(Length(aInputArgs), Length(cls.InputArgs), 'Count of input args differs for ' + name);
+    CheckEquals(Length(cls.OutputArgs), Length(cls.InOutMapping), 'Count of output args and in-out-mapping differs for ' + name);
+    CheckEquals(Length(aOutputArgs), Length(cls.OutputArgs), 'Count of output args differs for ' + name);
+    for i := 0 to High(aInputArgs) do begin
+      Check(EqualValues(input[i], cls.InputArgs[i]), Format('Input argument %d differs for %s', [i + 1, name]));
+    end;
+    for i := 0 to High(aOutputArgs) do begin
+      Check(EqualValues(aOutputArgs[i], cls.OutputArgs[i]), Format('Output argument %d differs for %s', [i + 1, name]));
+      Check(EqualValues(aOutputArgs[i], aInputArgs[cls.InOutMapping[i]]), Format('New output argument %d differs from expected output for %s', [i + 1, name]));
+    end;
+  finally
+    context.Free;
+  end;
+end;
+
 {$ifndef InLazIDE}
 {$ifdef fpc}generic{$endif} procedure TTestInvoke.GenDoMethodInvoke<T>(aInst: TObject; aMethod: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
 begin
@@ -2380,6 +2509,96 @@ begin
   end;
 end;
 
+procedure TTestInvoke.TestUntyped;
+var
+  cls: TTestInterfaceClass;
+begin
+  cls := TTestInterfaceClass.Create;
+  try
+    cls._AddRef;
+
+    DoUntypedInvoke(cls, Nil, Default(TMethod), Nil, [
+      GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678)
+      ], [
+      GetIntValue($4321), GetIntValue($5678)
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, Nil, Default(TMethod), Nil, [
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str1'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str2'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str3'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str4')
+      ], [
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('StrVar'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('StrOut')
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, Nil, Default(TMethod), Nil, [
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str1'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str2'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str3'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str4')
+      ], [
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('StrVar'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('StrOut')
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, Nil, TMethod({$ifdef fpc}@{$endif}cls.TestUntyped), TypeInfo(TMethodTestUntyped), [
+      GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678)
+      ], [
+      GetIntValue($4321), GetIntValue($5678)
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, Nil, TMethod({$ifdef fpc}@{$endif}cls.TestUntyped), TypeInfo(TMethodTestUntyped), [
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str1'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str2'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str3'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str4')
+      ], [
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('StrVar'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('StrOut')
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, Nil, TMethod({$ifdef fpc}@{$endif}cls.TestUntyped), TypeInfo(TMethodTestUntyped), [
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str1'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str2'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str3'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str4')
+      ], [
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('StrVar'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('StrOut')
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, {$ifdef fpc}@{$endif}ProcTestUntyped, Default(TMethod), TypeInfo(TProcVarTestUntyped), [
+      GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678)
+      ], [
+      GetIntValue($4321), GetIntValue($5678)
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, {$ifdef fpc}@{$endif}ProcTestUntyped, Default(TMethod), TypeInfo(TProcVarTestUntyped), [
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str1'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str2'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str3'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str4')
+      ], [
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('StrVar'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('StrOut')
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, {$ifdef fpc}@{$endif}ProcTestUntyped, Default(TMethod), TypeInfo(TProcVarTestUntyped), [
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str1'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str2'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str3'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str4')
+      ], [
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('StrVar'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('StrOut')
+      ], TValue.Empty);
+  finally
+    cls._Release;
+  end;
+end;
+
 begin
 {$ifdef fpc}
   RegisterTest(TTestInvoke);

packages/rtl-objpas/tests/tests.rtti.pas

@@ -1329,61 +1329,85 @@ var
 
   value: TValue;
 begin
+  u8:=245;
   TValue.Make(@u8, TypeInfo(UInt8), value);
   CheckEquals(1, value.DataSize, 'Size of UInt8 differs');
+  u16:=789;
   TValue.Make(@u16, TypeInfo(UInt16), value);
   CheckEquals(2, value.DataSize, 'Size of UInt16 differs');
+  u32:=568789;
   TValue.Make(@u32, TypeInfo(UInt32), value);
   CheckEquals(4, value.DataSize, 'Size of UInt32 differs');
+  u64:=$abdcefadbcef;
   TValue.Make(@u64, TypeInfo(UInt64), value);
   CheckEquals(8, value.DataSize, 'Size of UInt64 differs');
+  s8:=-32;
   TValue.Make(@s8, TypeInfo(Int8), value);
   CheckEquals(1, value.DataSize, 'Size of Int8 differs');
+  s16:=-5345;
   TValue.Make(@s16, TypeInfo(Int16), value);
   CheckEquals(2, value.DataSize, 'Size of Int16 differs');
+  s32:=-234567;
   TValue.Make(@s32, TypeInfo(Int32), value);
   CheckEquals(4, value.DataSize, 'Size of Int32 differs');
+  s64:=23456789012;
   TValue.Make(@s64, TypeInfo(Int64), value);
   CheckEquals(8, value.DataSize, 'Size of Int64 differs');
+  b8:=false;
   TValue.Make(@b8, TypeInfo(Boolean), value);
   CheckEquals(1, value.DataSize, 'Size of Boolean differs');
 {$ifdef fpc}
+  b16:=true;
   TValue.Make(@b16, TypeInfo(Boolean16), value);
   CheckEquals(2, value.DataSize, 'Size of Boolean16 differs');
+  b32:=false;
   TValue.Make(@b32, TypeInfo(Boolean32), value);
   CheckEquals(4, value.DataSize, 'Size of Boolean32 differs');
+  b64:=true;
   TValue.Make(@b64, TypeInfo(Boolean64), value);
   CheckEquals(8, value.DataSize, 'Size of Boolean64 differs');
 {$endif}
+  bl8:=true;
   TValue.Make(@bl8, TypeInfo(ByteBool), value);
   CheckEquals(1, value.DataSize, 'Size of ByteBool differs');
+  bl16:=false;
   TValue.Make(@bl16, TypeInfo(WordBool), value);
   CheckEquals(2, value.DataSize, 'Size of WordBool differs');
+  bl32:=false;
   TValue.Make(@bl32, TypeInfo(LongBool), value);
   CheckEquals(4, value.DataSize, 'Size of LongBool differs');
 {$ifdef fpc}
+  bl64:=true;
   TValue.Make(@bl64, TypeInfo(QWordBool), value);
   CheckEquals(8, value.DataSize, 'Size of QWordBool differs');
 {$endif}
+  f32:=4.567;
   TValue.Make(@f32, TypeInfo(Single), value);
   CheckEquals(4, value.DataSize, 'Size of Single differs');
+  f64:=-3456.678;
   TValue.Make(@f64, TypeInfo(Double), value);
   CheckEquals(8, value.DataSize, 'Size of Double differs');
 {$ifdef FPC_HAS_TYPE_EXTENDED}
+  f80:=-2345.678;
   TValue.Make(@f80, TypeInfo(Extended), value);
   CheckEquals(10, value.DataSize, 'Size of Extended differs');
 {$endif}
+  fcu:=56.78;
   TValue.Make(@fcu, TypeInfo(Currency), value);
   CheckEquals(SizeOf(Currency), value.DataSize, 'Size of Currency differs');
+  fco:=456;
   TValue.Make(@fco, TypeInfo(Comp), value);
   CheckEquals(SizeOf(Comp), value.DataSize, 'Size of Comp differs');
   ss := '';
   TValue.Make(@ss, TypeInfo(ShortString), value);
   CheckEquals(254, value.DataSize, 'Size ofShortString differs');
+  sa:= '';
   TValue.Make(@sa, TypeInfo(AnsiString), value);
   CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of AnsiString differs');
+  sw := '';
   TValue.Make(@sw, TypeInfo(WideString), value);
   CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of WideString differs');
+  su:='';
   TValue.Make(@su, TypeInfo(UnicodeString), value);
   CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of UnicodeString differs');
   o := TTestValueClass.Create;
@@ -1393,6 +1417,7 @@ begin
   c := TObject;
   TValue.Make(@c, TypeInfo(TClass), value);
   CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TClass differs');
+  i := Nil;
   TValue.Make(@i, TypeInfo(IInterface), value);
   CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of IInterface differs');
   TValue.Make(@t, TypeInfo(TTestRecord), value);
@@ -1407,8 +1432,10 @@ begin
   CheckEquals(SizeOf(TArrayOfLongintStatic), value.DataSize, 'Size of TArrayOfLongintStatic differs');
   TValue.Make(@ad, TypeInfo(TArrayOfLongintDyn), value);
   CheckEquals(SizeOf(TArrayOfLongintDyn), value.DataSize, 'Size of TArrayOfLongintDyn differs');
+  e:=low(TTestEnum);
   TValue.Make(@e, TypeInfo(TTestEnum), value);
   CheckEquals(SizeOf(TTestEnum), value.DataSize, 'Size of TTestEnum differs');
+  s:=[low(TTestEnum),high(TTestEnum)];
   TValue.Make(@s, TypeInfo(TTestSet), value);
   CheckEquals(SizeOf(TTestSet), value.DataSize, 'Size of TTestSet differs');
   p := Nil;

packages/webidl/src/webidlparser.pp

@@ -1001,12 +1001,13 @@ begin
   Result:=TIDLDictionaryDefinition(Context.Add(aParent,TIDLDictionaryDefinition,Name));
   Result.ParentName:=ParentName;
   GetToken;
-  Repeat
+  While (CurrentToken<>tkCurlyBraceClose) do
+     begin
      ParseDictionaryMember(Result.Members);
      CheckCurrentTokens([tkSemicolon,tkCurlyBraceClose]);
      if (CurrentToken=tkSemicolon) then
        GetToken;
-  Until (CurrentToken=tkCurlyBraceClose);
+     end;
 end;
 
 function TWebIDLParser.ParseSequenceTypeDef(aParent : TIDLBaseObject): TIDLSequenceTypeDefDefinition;

rtl/bsd/ossysc.inc

@@ -172,22 +172,17 @@ end;
 const DIRBLKSIZ=1024;
 
 
+function Fpfstat(fd : cint; var sb : stat): cint; forward;
+
 function Fpopendir(dirname : pchar): pdir;  [public, alias : 'FPC_SYSC_OPENDIR'];
 
 var
   fd:longint;
   st:stat;
   ptr:pdir;
+  save_errno:cint;
 begin
   Fpopendir:=nil;
-  if Fpstat(dirname,st)<0 then
-   exit;
-{ Is it a dir ? }
-  if not((st.st_mode and $f000)=$4000)then
-   begin
-     errno:=ESysENOTDIR;
-     exit
-   end;
 { Open it}
   fd:=Fpopen(dirname,O_RDONLY,438);
   if fd<0 then
@@ -195,15 +190,35 @@ begin
     Errno:=-1;
     exit;
    End;
+  if FpFStat(fd,st)<0 then
+   begin
+    save_errno:=errno;
+    FpClose(fd);
+    errno:=save_errno;
+    exit;
+   end;
+{ Is it a dir ? }
+  if not((st.st_mode and $f000)=$4000)then
+   begin
+     FpClose(fd);
+     errno:=ESysENOTDIR;
+     exit
+   end;
   new(ptr);
   if ptr=nil then
    Begin
+    FpClose(fd);
     Errno:=1;
     exit;
    End;
   Getmem(ptr^.dd_buf,2*DIRBLKSIZ);
   if ptr^.dd_buf=nil then
-   exit;
+   begin
+    dispose(ptr);
+    FpClose(fd);
+    Errno:=1;
+    exit;
+   end;
   ptr^.dd_fd:=fd;
   ptr^.dd_loc:=-1;
   ptr^.dd_rewind:=ptrint(ptr^.dd_buf);
@@ -220,10 +235,6 @@ begin
   dispose(dirp);
 end;
 
-var
-  use_openbsd_getdirentries_49 : boolean = false;
-  use_getdirentries_syscall : boolean = true;
-
 function Fpreaddir(dirp : pdir) : pdirent; [public, alias : 'FPC_SYSC_READDIR'];
 
 {Different from Linux, Readdir on BSD is based on Getdents, due to the
@@ -235,29 +246,8 @@ with blockmode have this higher?}
 function readbuffer:longint;
 
 var retval :longint;
-{$ifdef FPC_USE_GETDIRENTRIES_SYSCALL}
-    basepp : pointer;
-{$ifdef FPC_USE_GETDIRENTRIES_I49_SYSCALL}
-  { OpenBSD i49 getDirEntries system call uses off_t type for last parameter }
-    basep_off_t : off_t;
-{$endif not FPC_USE_GETDIRENTRIES_I49_SYSCALL}
-    basep : clong;
-{$endif FPC_USE_GETDIRENTRIES_SYSCALL}
-begin
-{$ifdef FPC_USE_GETDIRENTRIES_SYSCALL}
-{$ifdef FPC_USE_GETDIRENTRIES_I49_SYSCALL}
- if use_openbsd_getdirentries_49 then
-   basepp:=@basep_off_t
- else
-{$endif FPC_USE_GETDIRENTRIES_I49_SYSCALL}
-   basepp:=@basep;
- if use_getdirentries_syscall then
-   Retval:=do_syscall(syscall_nr_getdirentries,TSysParam(dirp^.dd_fd),TSysParam(@dirp^.dd_buf^),DIRBLKSIZ {sizeof(getdentsbuffer)},TSysParam(basepp))
- else
- Retval:=do_syscall(syscall_nr_getdents,TSysParam(dirp^.dd_fd),TSysParam(@dirp^.dd_buf^),DIRBLKSIZ {sizeof(getdentsbuffer)});
-{$else not FPC_USE_GETDIRENTRIES_SYSCALL}
+begin
  Retval:=do_syscall(syscall_nr_getdents,TSysParam(dirp^.dd_fd),TSysParam(@dirp^.dd_buf^),DIRBLKSIZ {sizeof(getdentsbuffer)});
-{$endif not FPC_USE_GETDIRENTRIES_SYSCALL}
    dirp^.dd_rewind:=TSysParam(dirp^.dd_buf);
    if retval=0 then
     begin

rtl/bsd/ostypes.inc

@@ -63,7 +63,7 @@ TYPE
 
   { file characteristics services }
    stat    = record { the types are real}
-{$ifdef dragonfly}
+{$if defined(dragonfly)}
         st_ino        : ino_t;             // inode's number
         st_nlink      : nlink_t;           // number of hard links
         st_dev        : dev_t;             // inode's device
@@ -86,28 +86,44 @@ TYPE
         st_lspare     : cint32;
         st_qspare1    : cint64;            // was recursive change detect
         st_qspare2    : cint64;
-{$else dragonfly}
-{$ifdef openbsd}
+{$elseif defined(openbsd)}
         st_mode       : mode_t;            // inode protection mode
-{$endif openbsd}
+        st_dev        : dev_t;             // inode's device
+        st_ino        : ino_t;             // inode's number
+        st_nlink      : nlink_t;           // number of hard links
+        st_uid        : uid_t;             // user ID of the file's owner
+        st_gid        : gid_t;             // group ID of the file's group
+        st_rdev       : dev_t;             // device type
+        st_atime      : time_t;            // time of last access
+        st_atimensec  : clong;             // nsec of last access
+        st_mtime      : time_t;            // time of last data modification
+        st_mtimensec  : clong;             // nsec of last data modification
+        st_ctime      : time_t;            // time of last file status change
+        st_ctimensec  : clong;             // nsec of last file status change
+        st_size       : off_t;             // file size, in bytes
+        st_blocks     : cint64;            // blocks allocated for file
+        st_blksize    : cint32;            // optimal blocksize for I/O
+        st_flags      : cuint32;           // user defined flags for file
+        st_gen        : cuint32;           // file generation number
+        st_birthtime  : time_t;            // File creation time
+        st_birthtimensec : clong;          // nsec of file creation time
+{$else}
         st_dev        : dev_t;             // inode's device
 {$ifdef darwin_new_iostructs}
         st_mode       : mode_t;            // inode protection mode
         st_nlink      : nlink_t;           // number of hard links
         st_ino        : ino_t;             // inode's number
-{$else}
+{$else not darwin_new_iostructs}
 {$ifdef netbsd_use_stat30}
      { order is inverted for better alignment probably }
         st_mode       : mode_t;            // inode protection mode
         st_ino        : ino_t;             // inode's number
 {$else not netbsd}
         st_ino        : ino_t;             // inode's number
-{$ifndef openbsd}
         st_mode       : mode_t;            // inode protection mode
-{$endif not openbsd}
 {$endif not netbsd}
         st_nlink      : nlink_t;           // number of hard links
-{$endif}
+{$endif not darwin_new_iostructs}
         st_uid        : uid_t;             // user ID of the file's owner
         st_gid        : gid_t;             // group ID of the file's group
         st_rdev       : dev_t;             // device type
@@ -134,13 +150,9 @@ TYPE
 {$endif}
 {$ifndef NetBSD}
         st_lspare     : cint32;
-{$endif}
-{$ifdef openbsd}
-        st_birthtime  : time_t;            // File creation time
-        st_birthtimensec : clong;          // nsec of file creation time
 {$endif}
         st_qspare     : array[0..1] Of cint64;
-{$endif dragonfly}
+{$endif}
    end;
    TStat = stat;
    pStat = ^stat;

rtl/bsd/sysctl.pp

@@ -115,6 +115,11 @@ function FPsysctl (Name: pchar; namelen:cuint; oldp:pointer;oldlenp:psize_t; new
 function FPsysctl (Name: pcint; namelen:cuint; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
 {$endif}
 
+{$ifdef OpenBSD}
+const
+  syscall_nr___sysctl = syscall_nr_sysctl;
+{$endif OpenBSD}
+
 Begin
         if (pcint(name)[0] <> CTL_USER) Then
            exit(do_syscall(syscall_nr___sysctl,TSysParam(name), namelen, TSysParam(oldp), TSysParam(oldlenp), TSysParam(newp), TSysParam(newlen)))

rtl/bsd/system.pp

@@ -105,17 +105,25 @@ end;
 procedure normalexit(status: cint); cdecl; external 'c' name 'exit';
 {$endif}
 
+{$if defined(openbsd)}
+procedure haltproc; cdecl; external name '_haltproc';
+{$endif}
+
 procedure System_exit;
-{$ifndef darwin}
-begin
-   Fpexit(cint(ExitCode));
-end;
-{$else darwin}
+{$if defined(darwin)}
 begin
    { make sure the libc atexit handlers are called, needed for e.g. profiling }
    normalexit(cint(ExitCode));
 end;
-{$endif darwin}
+{$elseif defined(openbsd)}
+begin
+   haltproc;
+end;
+{$else}
+begin
+   Fpexit(cint(ExitCode));
+end;
+{$endif}
 
 
 Function ParamCount: Longint;

rtl/objpas/classes/classes.inc

@@ -2496,7 +2496,7 @@ begin
   FindGlobalComponentList:=nil;
   IntConstList := TThreadList.Create;
   ClassList := TThreadList.Create;
-  ClassAliasList := TStringList.Create;
+  ClassAliasList := nil;
   { on unix this maps to a simple rw synchornizer }
   GlobalNameSpace := TMultiReadExclusiveWriteSynchronizer.Create;
   RegisterInitComponentHandler(TComponent,@DefaultInitHandler);

rtl/objpas/classes/classesh.inc

@@ -561,6 +561,7 @@ type
     function Insert(Index: Integer): TCollectionItem;
     function FindItemID(ID: Integer): TCollectionItem;
     procedure Exchange(Const Index1, index2: integer);
+    procedure Move(Const Index1, index2: integer);
     procedure Sort(Const Compare : TCollectionSortCompare);
     property Count: Integer read GetCount;
     property ItemClass: TCollectionItemClass read FItemClass;
@@ -662,8 +663,12 @@ type
     Function GetValueFromIndex(Index: Integer): string;
     Procedure SetValueFromIndex(Index: Integer; const Value: string);
     Procedure CheckSpecialChars;
-    Class Function GetNextLine (Const Value : String; Var S : String; Var P : Integer) : Boolean;
-    Function GetNextLinebreak (Const Value : String; Var S : String; Var P : Integer) : Boolean;
+    Class Function GetNextLine (Const Value : String; Var S : String; Var P : SizeInt) : Boolean;
+    Function GetNextLinebreak (Const Value : String; Var S : String; Var P : SizeInt) : Boolean;
+    {$IF (SizeOf(Integer) < SizeOf(SizeInt)) }
+    class function GetNextLine(const Value: string; var S: string; var P: Integer) : Boolean; deprecated;
+    function GetNextLineBreak(const Value: string; var S: string; var P: Integer) : Boolean; deprecated;
+    {$IFEND}
   public
     constructor Create;
     destructor Destroy; override;

rtl/objpas/classes/collect.inc

@@ -434,6 +434,11 @@ begin
     FPONotifyObservers(Self,ooChange,Nil);
 end;
 
+procedure TCollection.Move(const Index1, index2: integer);
+begin
+  Items[Index1].Index:=Index2;
+end;
+
 
 {****************************************************************************}
 {*                             TOwnedCollection                             *}

rtl/objpas/classes/cregist.inc

@@ -44,9 +44,18 @@ procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
   var
     I : integer;
   begin
-    i := ClassAliasList.IndexOf(Alias);
-    if I = -1 then
-      ClassAliasList.AddObject( Alias, TObject(AClass) );
+    I:=-1;
+    ClassList.LockList;
+    try
+      if ClassAliasList=nil then
+        ClassAliasList := TStringList.Create
+      else
+        i := ClassAliasList.IndexOf(Alias);
+      if I = -1 then
+        ClassAliasList.AddObject( Alias, TObject(AClass) );
+    finally
+      ClassList.UnlockList;
+    end;
   end;
 
 
@@ -96,16 +105,19 @@ begin
         Result := TPersistentClass(Items[I]);
         if Result.ClassNameIs(AClassName) then Exit;
        end;
+    if Assigned(ClassAliasList) then
+       begin
        I := ClassAliasList.Indexof(AClassName);
        if I >= 0 then  //found
           Begin
           Result := TPersistentClass(ClassAliasList.Objects[i]);
           exit;
           end;
+       end;
        Result := nil;
-    finally
-      ClassList.Unlocklist;
-    end;
+   finally
+     ClassList.Unlocklist;
+   end;
 end;
 
 

rtl/objpas/classes/stringl.inc

@@ -325,7 +325,7 @@ end;
 
 
 Procedure TStrings.SetDelimitedText(const AValue: string);
-var i,j:integer;
+var i,j: SizeInt;
     aNotFirst:boolean;
 begin
  CheckSpecialChars;
@@ -542,7 +542,7 @@ end;
 Function TStrings.GetTextStr: string;
 
 Var P : Pchar;
-    I,L,NLS : Longint;
+    I,L,NLS : SizeInt;
     S,NL : String;
 
 begin
@@ -608,66 +608,101 @@ begin
   // Empty.
 end;
 
-Class Function TStrings.GetNextLine (Const Value : String; Var S : String; Var P : Integer) : Boolean;
+Class Function TStrings.GetNextLine (Const Value : String; Var S : String; Var P : SizeInt) : Boolean;
+
+var
+  LengthOfValue: SizeInt;
+  StartPos, FuturePos: SizeInt;
 
-Var 
-  PS : PChar;
-  IP,L : Integer;
-  
 begin
-  L:=Length(Value);
-  S:='';
-  Result:=False;
-  If ((L-P)<0) then 
-    exit;
-  if ((L-P)=0) and (not (value[P] in [#10,#13])) Then
-    Begin
-      s:=value[P];
-      inc(P);
-      Exit(True);
-    End;
-  PS:=PChar(Value)+P-1;
-  IP:=P;
-  While ((L-P)>=0) and (not (PS^ in [#10,#13])) do 
+  LengthOfValue := Length(Value);
+  StartPos := P;
+  if (StartPos <= 0) or (StartPos > LengthOfValue) then // True for LengthOfValue <= 0
     begin
-    P:=P+1;
-    Inc(PS);
+    S := '';
+    Exit(False);
     end;
-  SetLength (S,P-IP);
-  System.Move (Value[IP],Pointer(S)^,P-IP);
-  If (P<=L) and (Value[P]=#13) then 
-    Inc(P);
-  If (P<=L) and (Value[P]=#10) then
-    Inc(P); // Point to character after #10(#13)
-  Result:=True;
+  FuturePos := StartPos;
+  while (FuturePos <= LengthOfValue) and not (Value[FuturePos] in [#10, #13]) do
+    Inc(FuturePos);
+  // If we use S := Copy(Value, StartPos, FuturePos - StartPos); then compiler
+  // generate TempS := Copy(...); S := TempS to eliminate side effects and
+  // implicit "try finally" for TempS finalization
+  // When we use SetString then no TempS, no try finally generated,
+  // but we must check case when Value and S is same (side effects)
+  if Pointer(S) = Pointer(Value) then
+    System.Delete(S, FuturePos, High(FuturePos))
+  else
+    begin
+    SetString(S, @Value[StartPos], FuturePos - StartPos);
+    if (FuturePos <= LengthOfValue) and (Value[FuturePos] = #13) then
+      Inc(FuturePos);
+    if (FuturePos <= LengthOfValue) and (Value[FuturePos] = #10) then
+      Inc(FuturePos);
+    end;
+  P := FuturePos;
+  Result := True;
 end;
 
-Function TStrings.GetNextLineBreak (Const Value : String; Var S : String; Var P : Integer) : Boolean;
+Function TStrings.GetNextLineBreak (Const Value : String; Var S : String; Var P : SizeInt) : Boolean;
 
-Var
-  PS,PC,PP : PChar;
+var
+  StartPos, FuturePos: SizeInt;
+  
+begin
+  StartPos := P;
+  if (StartPos <= 0) or (StartPos > Length(Value)) then // True for Length <= 0
+    begin
+    S := '';
+    Exit(False);
+    end;
+  FuturePos := Pos(FLineBreak, Value, StartPos); // Use PosEx in old RTL
+  // Why we don't use Copy but use SetString read in GetNextLine
+  if FuturePos = 0 then // No line breaks
+    begin
+    FuturePos := Length(Value) + 1;
+    if Pointer(S) = Pointer(Value) then
+      // Nothing to do
+    else
+      SetString(S, @Value[StartPos], FuturePos - StartPos)
+    end
+  else
+    if Pointer(S) = Pointer(Value) then
+      System.Delete(S, FuturePos, High(FuturePos))
+    else
+      begin
+      SetString(S, @Value[StartPos], FuturePos - StartPos);
+      Inc(FuturePos, Length(FLineBreak));
+      end;
+  P := FuturePos;
+  Result := True;
+end;
 
+{$IF (SizeOf(Integer) < SizeOf(SizeInt)) }
+class function TStrings.GetNextLine(const Value: string; var S: string; var P: Integer) : Boolean;
+var
+  LP: SizeInt;
 begin
-  S:='';
-  Result:=False;
-  If ((Length(Value)-P)<0) then
-    exit;
-  PS:=@Value[P];
-  PC:=PS;
-  PP:=AnsiStrPos(PS,PChar(FLineBreak));
-  // Stop on #0.
-  While (PC^<>#0) and (PC<>PP) do
-    Inc(PC);
-  P:=P+(PC-PS)+Length(FLineBreak);
-  SetString(S,PS,PC-PS);
-  Result:=True;
+  LP := P;
+  Result := GetNextLine(Value, S, LP);
+  P := LP;
+end;
+
+function TStrings.GetNextLineBreak(const Value: string; var S: string; var P: Integer) : Boolean;
+var
+  LP: SizeInt;
+begin
+  LP := P;
+  Result := GetNextLineBreak(Value, S, LP);
+  P := LP;
 end;
+{$IFEND}
 
 Procedure TStrings.DoSetTextStr(const Value: string; DoClear : Boolean);
 
 Var
   S : String;
-  P : Integer;
+  P : SizeInt;
 
 begin
   Try
@@ -779,13 +814,16 @@ end;
 
 Procedure TStrings.AddStrings(TheStrings: TStrings; ClearFirst : Boolean);
 
-
+Var Runner : longint;
 begin
   beginupdate;
   try
     if ClearFirst then
       Clear;
-    AddStrings(TheStrings);
+    if Count + TheStrings.Count > Capacity then
+      Capacity := Count + TheStrings.Count;
+    For Runner:=0 to TheStrings.Count-1 do
+      self.AddObject (Thestrings[Runner],TheStrings.Objects[Runner]);
   finally
     EndUpdate;
   end;
@@ -793,31 +831,28 @@ end;
 
 Procedure TStrings.AddStrings(TheStrings: TStrings);
 
-Var Runner : longint;
 begin
-  For Runner:=0 to TheStrings.Count-1 do
-    self.AddObject (Thestrings[Runner],TheStrings.Objects[Runner]);
+  AddStrings(TheStrings, False);
 end;
 
 Procedure TStrings.AddStrings(const TheStrings: array of string);
 
-Var Runner : longint;
 begin
-  if Count + High(TheStrings)+1 > Capacity then
-    Capacity := Count + High(TheStrings)+1;
-  For Runner:=Low(TheStrings) to High(TheStrings) do
-    self.Add(Thestrings[Runner]);
+  AddStrings(TheStrings, False);
 end;
 
 Procedure TStrings.AddStrings(const TheStrings: array of string; ClearFirst : Boolean);
 
-
+Var Runner : longint;
 begin
   beginupdate;
   try
     if ClearFirst then
       Clear;
-    AddStrings(TheStrings);
+    if Count + High(TheStrings)+1 > Capacity then
+      Capacity := Count + High(TheStrings)+1;
+    For Runner:=Low(TheStrings) to High(TheStrings) do
+      self.Add(Thestrings[Runner]);
   finally
     EndUpdate;
   end;
@@ -1037,7 +1072,7 @@ Var
   Buffer     : AnsiString;
   BytesRead,
   BufLen,
-  I,BufDelta     : Longint;
+  I,BufDelta     : SizeInt;
 begin
   if not IgnoreEncoding then
     begin
@@ -1082,7 +1117,7 @@ Var
   T              : string;
   BytesRead,
   BufLen,
-  I,BufDelta,
+  I,BufDelta: SizeInt;
   PreambleLength : Longint;
 begin
   // reread into a buffer

rtl/objpas/sysutils/fmtflt.inc

@@ -369,18 +369,21 @@ begin
       'e', 'E':
         begin
         ToResult(C); // Always needed
-        Inc(I);
-        if I<=Section.Length then
+        if IsScientific then
           begin
-          C:=Section[I];
-          if (C in ['+','-']) then
+          Inc(I);
+          if I<=Section.Length then
             begin
-            AddToResult(FormatExponent(C,FV.Exponent-DecimalPos+1));
-            // Skip rest
-            while (I<SectionLength) and (Section[i+1]='0') do
-              Inc(I);
+            C:=Section[I];
+            if (C in ['+','-']) then
+              begin
+              AddToResult(FormatExponent(C,FV.Exponent-DecimalPos+1));
+              // Skip rest
+              while (I<SectionLength) and (Section[i+1]='0') do
+                Inc(I);
+              end;
             end;
-          end;
+          end;  
         end;
       else
         ToResult(C);

rtl/openbsd/Makefile

@@ -340,29 +340,22 @@ BSDPROCINC=$(BSDINC)/$(CPU_TARGET)
 UNIXINC=$(RTL)/unix
 UNITPREFIX=rtl
 TARGETPROCINC=$(RTL)/openbsd/$(CPU_TARGET)
-ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
 SYSTEMUNIT=system
 LINUXUNIT=
 PRT0=prt0
-else
-SYSTEMUNIT=sysbsd
-LINUXUNIT=
-override FPCOPT+=-dUNIX
-PRT0=prt0_10
-endif
 ifdef RELEASE
 override FPCOPT+=-Ur
 endif
 CPU_UNITS=
 SYSINIT_UNITS=
-LOADERS=prt0 cprt0 dllprt0
+LOADERS=prt0 cprt0
 ifeq ($(ARCH),x86_64)
 CPU_UNITS=x86 ports cpu
-SYSINIT_UNITS=si_prc si_c si_dll
+SYSINIT_UNITS=si_prc si_c si_dll si_g
 endif
 ifeq ($(ARCH),i386)
 CPU_UNITS=x86 ports cpu mmx
-SYSINIT_UNITS=si_prc si_c si_dll
+SYSINIT_UNITS=si_prc si_c si_dll si_g
 endif
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
@@ -370,280 +363,280 @@ ifndef USELIBGGI
 USELIBGGI=NO
 endif
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-nativent)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-iphonesim)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-android)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-aros)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),m68k-macos)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),powerpc-wii)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),powerpc-aix)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),x86_64-haiku)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),x86_64-openbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),x86_64-iphonesim)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),x86_64-android)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),x86_64-aros)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),arm-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),arm-android)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),arm-aros)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),powerpc64-aix)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),mips-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),mipsel-android)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),jvm-java)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),jvm-android)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i8086-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i8086-msdos)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i8086-win16)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),aarch64-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),aarch64-darwin)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),aarch64-android)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),wasm-wasm)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),sparc64-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),riscv32-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),riscv32-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),riscv64-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),riscv64-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
+override TARGET_UNITS+=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix $(LINUXUNIT) unixtype unixutil unix ctypes bsd $(CPU_UNITS) dos rtlconsts sysutils sortbase fgl classes typinfo math charset cpall character getopts heaptrc lineinfo lnfodwrf errors types sysctl sysconst fpintres dynlibs cwstring cmem dl termio cthreads unixcp fpwidestring
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_IMPLICITUNITS+=exeinfo cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 cp1258 cp437 cp646 cp737 cp775 cp850 cp852 cp855 cp856 cp857 cp860 cp861 cp862 cp863 cp864 cp865 cp866 cp869 cp874 cp3021 cp8859_1 cp8859_2 cp8859_3 cp8859_4 cp8859_5 cp8859_6 cp8859_7 cp8859_8 cp8859_9 cp8859_10 cp8859_11 cp8859_13 cp8859_14 cp8859_15 cp8859_16 cpkoi8_r cpkoi8_u unicodedata  unicodenumtable
@@ -3264,14 +3257,14 @@ prt0$(OEXT) : $(CPU_TARGET)/$(PRT0).as
 	$(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/$(PRT0).as
 cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
 	$(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
-dllprt0$(OEXT) : $(CPU_TARGET)/dllprt0.as
-	$(AS) -o $(UNITTARGETDIRPREFIX)dllprt0$(OEXT) $(CPU_TARGET)/dllprt0.as
 si_prc$(PPUEXT) : si_prc.pp si_intf.inc si_impl.inc $(ARCH)/openbsd_ident.inc $(ARCH)/si_prc.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
 si_c$(PPUEXT) : si_c.pp si_intf.inc si_impl.inc $(ARCH)/openbsd_ident.inc $(ARCH)/si_c.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
 si_dll$(PPUEXT) : si_dll.pp si_intf.inc si_impl.inc $(ARCH)/openbsd_ident.inc $(ARCH)/si_dll.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
+si_g$(PPUEXT) : si_g.pp si_intf.inc si_impl.inc $(ARCH)/openbsd_ident.inc $(ARCH)/si_g.inc $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 $(SYSTEMUNIT)$(PPUEXT) : $(BSDINC)/$(SYSTEMUNIT).pp sysconst.inc systypes.inc syscalls.inc $(SYSDEPS)
 	$(COMPILER) $(FPC_SYSTEM_OPT) -Us -Sg $(BSDINC)/$(SYSTEMUNIT).pp
 uuchar$(PPUEXT): $(INC)/uuchar.pp $(SYSTEMUNIT)$(PPUEXT)
@@ -3321,7 +3314,7 @@ math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/math.pp
 types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/types.pp
-ctypes$(PPUEXT) :  $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+ctypes$(PPUEXT) :  $(INC)/ctypes.pp unixtype$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
 dl$(PPUEXT) : $(UNIXINC)/dl.pp ctypes$(PPUEXT) objpas$(PPUEXT)
 	$(COMPILER) $<

rtl/openbsd/Makefile.fpc

@@ -10,8 +10,8 @@ fpcpackage=y
 
 [target]
 loaders=$(LOADERS)
-units=$(SYSTEMUNIT) $(SYSINIT_UNITS) uuchar objpas macpas iso7185 extpas strings syscall baseunix \
-      $(LINUXUNIT) unixtype unixutil unix ctypes bsd initc \
+units=$(SYSTEMUNIT) $(SYSINIT_UNITS) initc uuchar objpas macpas iso7185 extpas strings syscall baseunix \
+      $(LINUXUNIT) unixtype unixutil unix ctypes bsd \
       $(CPU_UNITS) dos rtlconsts \
       sysutils sortbase fgl classes typinfo math \
       charset cpall character getopts heaptrc lineinfo lnfodwrf \
@@ -64,16 +64,9 @@ UNIXINC=$(RTL)/unix
 UNITPREFIX=rtl
 TARGETPROCINC=$(RTL)/openbsd/$(CPU_TARGET)
 
-ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
 SYSTEMUNIT=system
 LINUXUNIT=
 PRT0=prt0
-else
-SYSTEMUNIT=sysbsd
-LINUXUNIT=
-override FPCOPT+=-dUNIX
-PRT0=prt0_10
-endif
 
 # Use new feature from 1.0.5 version
 # that generates release PPU files
@@ -85,15 +78,15 @@ endif
 CPU_UNITS=
 SYSINIT_UNITS=
 
-LOADERS=prt0 cprt0 dllprt0
+LOADERS=prt0 cprt0
 
 ifeq ($(ARCH),x86_64)
 CPU_UNITS=x86 ports cpu
-SYSINIT_UNITS=si_prc si_c si_dll
+SYSINIT_UNITS=si_prc si_c si_dll si_g
 endif
 ifeq ($(ARCH),i386)
 CPU_UNITS=x86 ports cpu mmx
-SYSINIT_UNITS=si_prc si_c si_dll
+SYSINIT_UNITS=si_prc si_c si_dll si_g
 endif
 
 # Paths
@@ -138,9 +131,6 @@ prt0$(OEXT) : $(CPU_TARGET)/$(PRT0).as
 cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
         $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
 
-dllprt0$(OEXT) : $(CPU_TARGET)/dllprt0.as
-        $(AS) -o $(UNITTARGETDIRPREFIX)dllprt0$(OEXT) $(CPU_TARGET)/dllprt0.as
-
 
 #
 # $(SYSINIT_UNITS) Units
@@ -154,6 +144,9 @@ si_c$(PPUEXT) : si_c.pp si_intf.inc si_impl.inc $(ARCH)/openbsd_ident.inc $(ARCH
 si_dll$(PPUEXT) : si_dll.pp si_intf.inc si_impl.inc $(ARCH)/openbsd_ident.inc $(ARCH)/si_dll.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
 
+si_g$(PPUEXT) : si_g.pp si_intf.inc si_impl.inc $(ARCH)/openbsd_ident.inc $(ARCH)/si_g.inc $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
+
 
 #
 # System Units (System, Objpas, Strings)
@@ -244,7 +237,7 @@ math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
 types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) $(OBJPASDIR)/types.pp
 
-ctypes$(PPUEXT) :  $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+ctypes$(PPUEXT) :  $(INC)/ctypes.pp unixtype$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) $<
 
 dl$(PPUEXT) : $(UNIXINC)/dl.pp ctypes$(PPUEXT) objpas$(PPUEXT)