merge from trunk till 33632

git-svn-id: branches/interfacertti@33633 -

.gitattributes

@@ -1158,8 +1158,10 @@ packages/amunits/src/utilunits/doublebuffer.pas svneol=native#text/plain
 packages/amunits/src/utilunits/easyasl.pas svneol=native#text/plain
 packages/amunits/src/utilunits/hisoft.pas svneol=native#text/plain
 packages/amunits/src/utilunits/linklist.pas svneol=native#text/plain
+packages/amunits/src/utilunits/longarray.pas svneol=native#text/plain
 packages/amunits/src/utilunits/pastoc.pas svneol=native#text/plain
 packages/amunits/src/utilunits/pcq.pas svneol=native#text/plain
+packages/amunits/src/utilunits/systemvartags.pas svneol=native#text/plain
 packages/amunits/src/utilunits/tagsarray.pas svneol=native#text/plain
 packages/amunits/src/utilunits/timerutils.pas svneol=native#text/plain
 packages/amunits/src/utilunits/vartags.pas svneol=native#text/plain
@@ -1929,7 +1931,6 @@ packages/fcl-base/examples/b64test2.pp svneol=native#text/plain
 packages/fcl-base/examples/base64decodingtestcase.pas svneol=native#text/plain
 packages/fcl-base/examples/cachetest.pp svneol=native#text/plain
 packages/fcl-base/examples/cfgtest.pp svneol=native#text/plain
-packages/fcl-base/examples/contit.pp svneol=native#text/plain
 packages/fcl-base/examples/crittest.pp svneol=native#text/plain
 packages/fcl-base/examples/dbugsrv.pp svneol=native#text/plain
 packages/fcl-base/examples/debugtest.pp svneol=native#text/plain
@@ -1944,7 +1945,6 @@ packages/fcl-base/examples/fpdoc.dtd -text
 packages/fcl-base/examples/fpexprpars.txt svneol=native#text/plain
 packages/fcl-base/examples/fstream.pp svneol=native#text/plain
 packages/fcl-base/examples/htdump.pp svneol=native#text/plain
-packages/fcl-base/examples/inifmt.pp svneol=native#text/plain
 packages/fcl-base/examples/intl/Makefile svneol=native#text/plain
 packages/fcl-base/examples/intl/README.txt svneol=native#text/plain
 packages/fcl-base/examples/intl/restest.cs.mo -text
@@ -1960,6 +1960,8 @@ packages/fcl-base/examples/intl/restest.pb.po svneol=native#text/plain
 packages/fcl-base/examples/intl/restest.ru.mo -text
 packages/fcl-base/examples/intl/restest.ru.po svneol=native#text/plain
 packages/fcl-base/examples/intl/resttest.po svneol=native#text/plain
+packages/fcl-base/examples/ipcclient.pp svneol=native#text/plain
+packages/fcl-base/examples/ipcserver.pp svneol=native#text/plain
 packages/fcl-base/examples/isockcli.pp svneol=native#text/plain
 packages/fcl-base/examples/isocksvr.pp svneol=native#text/plain
 packages/fcl-base/examples/istream.pp svneol=native#text/plain
@@ -1988,9 +1990,9 @@ packages/fcl-base/examples/testbs.pp svneol=native#text/plain
 packages/fcl-base/examples/testcgi.html -text
 packages/fcl-base/examples/testcgi.pp svneol=native#text/plain
 packages/fcl-base/examples/testcont.pp svneol=native#text/plain
+packages/fcl-base/examples/testexprpars.pp svneol=native#text/plain
 packages/fcl-base/examples/testez.pp svneol=native#text/plain
 packages/fcl-base/examples/testhres.pp svneol=native#text/plain
-packages/fcl-base/examples/testini.pp svneol=native#text/plain
 packages/fcl-base/examples/testipc_client.pp svneol=native#text/plain
 packages/fcl-base/examples/testipc_server.pp svneol=native#text/plain
 packages/fcl-base/examples/testmime.pp svneol=native#text/plain
@@ -2073,7 +2075,6 @@ packages/fcl-base/src/wtex.pp svneol=native#text/plain
 packages/fcl-base/tests/fclbase-unittests.lpi svneol=native#text/plain
 packages/fcl-base/tests/fclbase-unittests.pp svneol=native#text/plain
 packages/fcl-base/tests/tchashlist.pp svneol=native#text/plain
-packages/fcl-base/tests/testexprpars.pp svneol=native#text/plain
 packages/fcl-base/tests/tests_fptemplate.pp svneol=native#text/plain
 packages/fcl-base/texts/fptemplate.txt svneol=native#text/plain
 packages/fcl-db/Makefile svneol=native#text/plain
@@ -2508,7 +2509,6 @@ packages/fcl-json/src/jsonconf.pp svneol=native#text/plain
 packages/fcl-json/src/jsonparser.pp svneol=native#text/plain
 packages/fcl-json/src/jsonscanner.pp svneol=native#text/plain
 packages/fcl-json/tests/jsonconftest.pp svneol=native#text/plain
-packages/fcl-json/tests/testcomps.pp svneol=native#text/plain
 packages/fcl-json/tests/testjson.lpi svneol=native#text/plain
 packages/fcl-json/tests/testjson.pp svneol=native#text/plain
 packages/fcl-json/tests/testjsonconf.lpi svneol=native#text/plain
@@ -2577,48 +2577,9 @@ packages/fcl-passrc/tests/tctypeparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcvarparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/testpassrc.lpi svneol=native#text/plain
 packages/fcl-passrc/tests/testpassrc.lpr svneol=native#text/plain
-packages/fcl-pdf/Makefile svneol=native#text/plain
-packages/fcl-pdf/Makefile.fpc svneol=native#text/plain
-packages/fcl-pdf/examples/poppy.jpg -text
-packages/fcl-pdf/examples/testfppdf.lpi svneol=native#text/plain
-packages/fcl-pdf/examples/testfppdf.lpr svneol=native#text/plain
-packages/fcl-pdf/fpmake.pp svneol=native#text/plain
-packages/fcl-pdf/readme.txt svneol=native#text/plain
-packages/fcl-pdf/src/fpparsettf.pp svneol=native#text/plain
-packages/fcl-pdf/src/fppdf.pp svneol=native#text/plain
-packages/fcl-pdf/src/fpttf.pp svneol=native#text/plain
-packages/fcl-pdf/src/fpttfencodings.pp svneol=native#text/plain
-packages/fcl-pdf/tests/fonts/README.txt svneol=native#text/plain
-packages/fcl-pdf/tests/fpparsettf_test.pas svneol=native#text/plain
-packages/fcl-pdf/tests/fppdf_test.pas svneol=native#text/plain
-packages/fcl-pdf/tests/fpttf_test.pas svneol=native#text/plain
-packages/fcl-pdf/tests/readme.txt svneol=native#text/plain
-packages/fcl-pdf/tests/testunits.inc svneol=native#text/plain
-packages/fcl-pdf/tests/unittests_console.lpi svneol=native#text/plain
-packages/fcl-pdf/tests/unittests_console.lpr svneol=native#text/plain
-packages/fcl-pdf/tests/unittests_gui.lpi svneol=native#text/plain
-packages/fcl-pdf/tests/unittests_gui.lpr svneol=native#text/plain
-packages/fcl-pdf/utils/mkpdffontdef.lpi svneol=native#text/plain
-packages/fcl-pdf/utils/mkpdffontdef.pp svneol=native#text/plain
-packages/fcl-pdf/utils/ttfdump.lpi svneol=native#text/plain
-packages/fcl-pdf/utils/ttfdump.lpr svneol=native#text/plain
 packages/fcl-process/Makefile svneol=native#text/plain
 packages/fcl-process/Makefile.fpc svneol=native#text/plain
 packages/fcl-process/Makefile.fpc.fpcmake svneol=native#text/plain
-packages/fcl-process/examples/demoproject.ico -text
-packages/fcl-process/examples/demoproject.lpi svneol=native#text/plain
-packages/fcl-process/examples/demoproject.pp svneol=native#text/plain
-packages/fcl-process/examples/demoproject.res -text
-packages/fcl-process/examples/demoruncommand.lpi svneol=native#text/plain
-packages/fcl-process/examples/demoruncommand.pp svneol=native#text/plain
-packages/fcl-process/examples/echoparams.pp svneol=native#text/plain
-packages/fcl-process/examples/empty.pp svneol=native#text/pascal
-packages/fcl-process/examples/infinity.pp svneol=native#text/pascal
-packages/fcl-process/examples/ipcclient.lpi svneol=native#text/plain
-packages/fcl-process/examples/ipcclient.pp svneol=native#text/plain
-packages/fcl-process/examples/ipcserver.lpi svneol=native#text/plain
-packages/fcl-process/examples/ipcserver.pp svneol=native#text/plain
-packages/fcl-process/examples/waitonexit.pp svneol=native#text/pascal
 packages/fcl-process/fpmake.pp svneol=native#text/plain
 packages/fcl-process/src/amicommon/pipes.inc svneol=native#text/plain
 packages/fcl-process/src/amicommon/process.inc svneol=native#text/plain
@@ -2640,8 +2601,9 @@ packages/fcl-process/src/unix/process.inc svneol=native#text/plain
 packages/fcl-process/src/unix/simpleipc.inc svneol=native#text/plain
 packages/fcl-process/src/win/pipes.inc svneol=native#text/plain
 packages/fcl-process/src/win/process.inc svneol=native#text/plain
-packages/fcl-process/src/winall/simpleipc.inc svneol=native#text/plain
+packages/fcl-process/src/win/simpleipc.inc svneol=native#text/plain
 packages/fcl-process/src/wince/process.inc svneol=native#text/plain
+packages/fcl-process/src/wince/simpleipc.inc svneol=native#text/plain
 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
@@ -2909,7 +2871,6 @@ packages/fcl-stl/src/garrayutils.pp svneol=native#text/plain
 packages/fcl-stl/src/gdeque.pp svneol=native#text/plain
 packages/fcl-stl/src/ghashmap.pp svneol=native#text/plain
 packages/fcl-stl/src/ghashset.pp svneol=native#text/plain
-packages/fcl-stl/src/glinkedlist.pp svneol=native#text/plain
 packages/fcl-stl/src/gmap.pp svneol=native#text/plain
 packages/fcl-stl/src/gpriorityqueue.pp svneol=native#text/plain
 packages/fcl-stl/src/gqueue.pp svneol=native#text/plain
@@ -2924,7 +2885,6 @@ packages/fcl-stl/tests/gcompositetest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gdequetest.pp svneol=native#text/plain
 packages/fcl-stl/tests/ghashmaptest.pp svneol=native#text/plain
 packages/fcl-stl/tests/ghashsettest.pp svneol=native#text/plain
-packages/fcl-stl/tests/glinkedlisttest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gmaptest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gmaptestzal.pp svneol=native#text/plain
 packages/fcl-stl/tests/gpriorityqueuetest.pp svneol=native#text/plain
@@ -3197,8 +3157,6 @@ packages/fcl-web/src/base/Makefile.fpc svneol=native#text/plain
 packages/fcl-web/src/base/README.txt svneol=native#text/plain
 packages/fcl-web/src/base/cgiapp.pp svneol=native#text/plain
 packages/fcl-web/src/base/cgiprotocol.pp svneol=native#text/plain
-packages/fcl-web/src/base/custapache.pp svneol=native#text/plain
-packages/fcl-web/src/base/custapache24.pp svneol=native#text/plain
 packages/fcl-web/src/base/custcgi.pp svneol=native#text/plain
 packages/fcl-web/src/base/custfcgi.pp svneol=native#text/plain
 packages/fcl-web/src/base/custhttpapp.pp svneol=native#text/plain
@@ -4351,17 +4309,10 @@ packages/hash/src/md5i386.inc svneol=native#text/plain
 packages/hash/src/ntlm.pas svneol=native#text/plain
 packages/hash/src/sha1.pp svneol=native#text/plain
 packages/hash/src/sha1i386.inc svneol=native#text/plain
-packages/hash/src/uhpack.pp svneol=native#text/plain
-packages/hash/src/uhpackimp.pp svneol=native#text/plain
-packages/hash/src/uhpacktables.pp svneol=native#text/plain
 packages/hash/src/unixcrypt.pas svneol=native#text/plain
 packages/hash/src/uuid.pas svneol=native#text/plain
-packages/hash/tests/README.txt svneol=native#text/plain
-packages/hash/tests/fpcunithpack.lpi svneol=native#text/plain
-packages/hash/tests/fpcunithpack.lpr svneol=native#text/plain
 packages/hash/tests/tests.pp svneol=native#text/pascal
 packages/hash/tests/testshmac.pas svneol=native#text/pascal
-packages/hash/tests/uhpacktest1.pas svneol=native#text/plain
 packages/hermes/Makefile svneol=native#text/plain
 packages/hermes/Makefile.fpc svneol=native#text/plain
 packages/hermes/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -5020,6 +4971,36 @@ packages/libgd/examples/gdtest.pp svneol=native#text/plain
 packages/libgd/examples/gdtestcgi.pp svneol=native#text/plain
 packages/libgd/fpmake.pp svneol=native#text/plain
 packages/libgd/src/gd.pas svneol=native#text/plain
+packages/libmicrohttpd/Makefile svneol=native#text/plain
+packages/libmicrohttpd/Makefile.fpc svneol=native#text/plain
+packages/libmicrohttpd/examples/basicauthentication.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/benchmark.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/benchmark_https.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/chunked_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/cutils.pas svneol=native#text/plain
+packages/libmicrohttpd/examples/demo.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/demo_https.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/digest_auth_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/dual_stack_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/fileserver_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/fileserver_example_dirs.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/fileserver_example_external_select.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/hellobrowser.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/https_fileserver_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/largepost.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/logging.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/magic.inc svneol=native#text/plain
+packages/libmicrohttpd/examples/minimal_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/minimal_example_comet.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/post_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/querystring_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/refuse_post_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/responseheaders.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/sessions.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/simplepost.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/tlsauthentication.pp svneol=native#text/plain
+packages/libmicrohttpd/fpmake.pp svneol=native#text/plain
+packages/libmicrohttpd/src/libmicrohttpd.pp svneol=native#text/plain
 packages/libndsfpc/Makefile svneol=native#text/plain
 packages/libndsfpc/Makefile.fpc svneol=native#text/plain
 packages/libndsfpc/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -6289,22 +6270,6 @@ packages/os2units/src/mmio.pas svneol=native#text/plain
 packages/os2units/src/som.pas svneol=native#text/plain
 packages/os2units/src/sw.pas svneol=native#text/plain
 packages/os2units/src/wpstk.pp svneol=native#text/plain
-packages/os4units/Makefile svneol=native#text/plain
-packages/os4units/Makefile.fpc svneol=native#text/plain
-packages/os4units/Makefile.fpc.fpcmake svneol=native#text/plain
-packages/os4units/fpmake.pp svneol=native#text/pascal
-packages/os4units/src/agraphics.pas svneol=native#text/pascal
-packages/os4units/src/amigados.pas svneol=native#text/pascal
-packages/os4units/src/clipboard.pas svneol=native#text/pascal
-packages/os4units/src/exec.pas svneol=native#text/pascal
-packages/os4units/src/iffparse.pas svneol=native#text/pascal
-packages/os4units/src/inputevent.pas svneol=native#text/pascal
-packages/os4units/src/intuition.pas svneol=native#text/pascal
-packages/os4units/src/keymap.pas svneol=native#text/pascal
-packages/os4units/src/layers.pas svneol=native#text/pascal
-packages/os4units/src/mui.pas svneol=native#text/pascal
-packages/os4units/src/timer.pas svneol=native#text/pascal
-packages/os4units/src/utility.pas svneol=native#text/pascal
 packages/palmunits/Makefile svneol=native#text/plain
 packages/palmunits/Makefile.fpc svneol=native#text/plain
 packages/palmunits/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -6525,10 +6490,6 @@ packages/paszlib/examples/Makefile.fpc svneol=native#text/plain
 packages/paszlib/examples/example.pas svneol=native#text/plain
 packages/paszlib/examples/example2.pas svneol=native#text/plain
 packages/paszlib/examples/extractodt.pas svneol=native#text/plain
-packages/paszlib/examples/fpunzipper.lpi svneol=native#text/plain
-packages/paszlib/examples/fpunzipper.lpr svneol=native#text/plain
-packages/paszlib/examples/fpzipper.lpi svneol=native#text/plain
-packages/paszlib/examples/fpzipper.lpr svneol=native#text/plain
 packages/paszlib/examples/minigzip.pas svneol=native#text/plain
 packages/paszlib/examples/miniunz.pas svneol=native#text/plain
 packages/paszlib/examples/minizip.pas svneol=native#text/plain
@@ -6661,8 +6622,6 @@ packages/ptc/src/c_api/capi_surface.inc svneol=native#text/plain
 packages/ptc/src/c_api/capi_surfaced.inc svneol=native#text/plain
 packages/ptc/src/c_api/capi_timer.inc svneol=native#text/plain
 packages/ptc/src/c_api/capi_timerd.inc svneol=native#text/plain
-packages/ptc/src/cocoa/cocoaconsoled.inc svneol=native#text/plain
-packages/ptc/src/cocoa/cocoaconsolei.inc svneol=native#text/plain
 packages/ptc/src/core/aread.inc svneol=native#text/plain
 packages/ptc/src/core/areai.inc svneol=native#text/plain
 packages/ptc/src/core/baseconsoled.inc svneol=native#text/plain
@@ -7010,7 +6969,6 @@ packages/rtl-objpas/src/inc/varerror.inc svneol=native#text/plain
 packages/rtl-objpas/src/inc/variants.pp svneol=native#text/plain
 packages/rtl-objpas/src/inc/varutilh.inc svneol=native#text/plain
 packages/rtl-objpas/src/inc/varutils.inc svneol=native#text/plain
-packages/rtl-objpas/src/inc/widestrutils.pp svneol=native#text/plain
 packages/rtl-objpas/src/morphos/varutils.pp svneol=native#text/plain
 packages/rtl-objpas/src/msdos/varutils.pp svneol=native#text/plain
 packages/rtl-objpas/src/nativent/varutils.pp svneol=native#text/pascal

packages/Makefile

@@ -1,11 +1,11 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-08-12 rev 31317]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-09-05 rev 31523]
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos aarch64-linux aarch64-darwin
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos i8086-win16 aarch64-linux aarch64-darwin
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
-LIMIT83fs = go32v2 os2 emx watcom msdos
+LIMIT83fs = go32v2 os2 emx watcom msdos win16
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
@@ -762,6 +762,12 @@ ifeq ($(OS_TARGET),embedded)
 EXEEXT=.bin
 SHORTSUFFIX=emb
 endif
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -1254,6 +1260,9 @@ endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),i8086-win16)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),aarch64-linux)
 REQUIRE_PACKAGES_RTL=1
 endif

packages/ami-extra/fpmake.pp

@@ -21,10 +21,7 @@ begin
 
     P.Dependencies.Add('morphunits',[morphos]);
     P.Dependencies.Add('arosunits',[aros]);
-    if Defaults.CPU=m68k then
-      P.Dependencies.Add('amunits',[amiga]);
-    if Defaults.CPU=powerpc then
-      P.Dependencies.Add('os4units',[amiga]);
+    P.Dependencies.Add('amunits',[amiga]);
 
 {$ifdef ALLPACKAGES}
     P.Directory:=ADirectory;

packages/amunits/examples/asltest.pas

@@ -1,6 +1,6 @@
 PROGRAM AslTest;
 
-uses Exec, Utility, Asl, amsgbox;
+uses Exec, Utility, Asl, amsgbox, systemvartags;
 
 
 {
@@ -26,13 +26,13 @@ VAR
 BEGIN
 
     fr := AllocAslRequestTags(ASL_FileRequest,[
-                          ASLFR_InitialPattern, AsTag('#?'),
-                          ASLFR_TitleText, AsTag('Test av ASL-Requester by NS'),
-                          ASLFR_DoPatterns, LTrue,
+                          ASLFR_InitialPattern,'#?',
+                          ASLFR_TitleText,'Test av ASL-Requester by NS',
+                          ASLFR_DoPatterns,ltrue,
                           TAG_DONE]);
 
     IF fr <> nil THEN BEGIN
-        dummy := AslRequest(fr,NIL);
+        dummy := AslRequest(fr,NIL) <> LFALSE;
         if dummy then begin
            MessageBox('Test of Asl',
                       ' The path is :' +

packages/amunits/examples/bezier.pas

@@ -35,7 +35,7 @@ Program Bezier;
    [email protected]
 }
 
-uses exec, intuition, agraphics, utility;
+uses exec, intuition, agraphics, utility, systemvartags;
 
 type
     PointRec = packed Record
@@ -221,11 +221,10 @@ end;
 
 begin
 
-   s := OpenScreenTags(nil,[
-      AsTag(SA_Pens), AsTag(@pens),
-      AsTag(SA_Depth),     2,
-      AsTag(SA_DisplayID), HIRES_KEY,
-      AsTag(SA_Title),     AsTag('Simple Bezier Curves'),
+   s := OpenScreenTags(nil,[SA_Pens,@pens,
+      SA_Depth,     2,
+      SA_DisplayID, HIRES_KEY,
+      SA_Title,     'Simple Bezier Curves',
       TAG_END]);
 
     if s = NIL then CleanUpAndDie;
@@ -242,8 +241,8 @@ begin
       WA_ReportMouse,  ltrue,
       WA_SmartRefresh, ltrue,
       WA_Activate,     ltrue,
-      WA_Title,        AsTag('Close the Window to Quit'),
-      WA_CustomScreen, AsTag(s),
+      WA_Title,        'Close the Window to Quit',
+      WA_CustomScreen, s,
       TAG_END]);
 
     IF w=NIL THEN CleanUpAndDie;

packages/amunits/examples/bezier2.pas

@@ -26,7 +26,7 @@ Program Bezier2;
    [email protected]
 }
 
-uses exec, intuition, agraphics, utility;
+uses exec, intuition, agraphics, utility, systemvartags;
 
 type
     PointRec = Record
@@ -242,12 +242,11 @@ begin
 end;
 
 begin
-      s := OpenScreenTags(nil,[
-        SA_Pens, AsTag(@pens),
-        SA_Depth,     2,
-        SA_DisplayID, HIRES_KEY,
-        SA_Title,     AsTag('Simple Bezier Curves'),
-        TAG_END]);
+      s := OpenScreenTags(nil,[SA_Pens, @pens,
+      SA_Depth,     2,
+      SA_DisplayID, HIRES_KEY,
+      SA_Title,     'Simple Bezier Curves',
+      TAG_END]);
 
     if s = NIL then CleanUpAndDie;
 
@@ -263,8 +262,8 @@ begin
       WA_ReportMouse,  ltrue,
       WA_SmartRefresh, ltrue,
       WA_Activate,     ltrue,
-      WA_Title,        AsTag('Close the Window to Quit'),
-      WA_CustomScreen, AsTag(s),
+      WA_Title,        'Close the Window to Quit',
+      WA_CustomScreen, s,
       TAG_END]);
 
     IF w=NIL THEN CleanUpAndDie;

packages/amunits/examples/deviceinfo.pas

@@ -56,7 +56,7 @@ Begin
   If ParamCount = 0 Then AsdaLaVista(' DiskInfo V1.0, © 1992 T.Schmid - Usage : DiskInfo Dfx:',0);
   MyFile := ParamStr(1) + #0;
 
-  Inf:=pInfoData(ExecAllocMem( SizeOf(tInfoData), MEMF_PUBLIC ) );
+  Inf:=pInfoData( AllocMem( SizeOf(tInfoData), MEMF_PUBLIC ) );
   If Inf=Nil Then AsdaLaVista('No memory',5);
 
   s:= 'Writeenabled';

packages/amunits/examples/dirdemo.pas

@@ -10,7 +10,7 @@ PROGRAM DirDemo;
     [email protected]
 }
 
-uses Amigados, exec, strings, linklist, amigalib;
+uses Amigados, exec, strings, linklist,pastoc, amigalib;
 
 CONST BufferSize = 2048;
       CSI      = chr($9b);
@@ -26,7 +26,7 @@ VAR ExData       : pExAllData;
     Buffer       : PChar;
     i,temp       : longint;
     TotalSize    : longint;
-    TheDir       : AnsiString;
+    TheDir       : string;
 
 PROCEDURE CleanUp(TheMsg : STRING; ErrCode : INTEGER);
 BEGIN
@@ -57,11 +57,11 @@ BEGIN
     EAC := AllocDosObject(DOS_EXALLCONTROL,NIL);
     IF EAC = NIL THEN CleanUp('No AllocDosObject',10);
 
-    ExData := ExecAllocMem(BufferSize,0);
+    ExData := AllocMem(BufferSize,0);
     EAC^.eac_LastKey := 0;
     EAC^.eac_MatchString := NIL;
     EAC^.eac_MatchFunc := NIL;
-    MyLock:=Lock(PChar(TheDir),SHARED_LOCK);
+    MyLock:=Lock(pas2c(TheDir),SHARED_LOCK);
     IF MyLock=0 THEN CleanUp('No lock on directory',10);
 
     REPEAT
@@ -88,13 +88,13 @@ BEGIN
     tempnode := GetFirstNode(DirList);
 
     FOR i := 1 TO NodesInList(DirList) DO BEGIN
-        printf('%-30s  <DIR>'#10,[PtrUInt(GetNodeData(tempnode))]);
+        printf('%-30s  <DIR>'#10,[long(GetNodeData(tempnode))]);
         tempnode := GetNextNode(tempnode);
     END;
     Write(CSI, '0m');
     tempnode := GetFirstNode(FileList);
     FOR i := 1 TO NodesInList(FileList) DO BEGIN
-        printf('%-30s%7ld'#10 ,[PtrUInt(GetNodeData(tempnode)),tempnode^.ln_Size]);
+        printf('%-30s%7ld'#10 ,[long(GetNodeData(tempnode)),tempnode^.ln_Size]);
         TotalSize := TotalSize + tempnode^.ln_Size;
         tempnode := GetNextNode(tempnode);
     END;

packages/amunits/examples/easygadtools.pas

@@ -15,7 +15,7 @@ PROGRAM EasyGadtools;
 
 }
 
-USES Intuition, Exec, AGraphics, GadTools, Utility;
+USES Intuition, Exec, AGraphics, GadTools, Utility, pastoc,systemvartags;
 
 CONST
 
@@ -90,16 +90,16 @@ begin
    ButtonGadget := gad;
 end;
 
-function ButtonGadget(id,left,top,width,height:word; txt: AnsiString): pGadget;
+function ButtonGadget(id,left,top,width,height:word; txt: string): pGadget;
 begin
-   ButtonGadget := ButtonGadget(id,left,top,width,height,PChar(txt));
+   ButtonGadget := ButtonGadget(id,left,top,width,height,pas2c(txt));
 end;
 
 function CycleGadget(id,left,top,width,height:word; txt:pchar ; thearr : Pointer): pGadget;
 begin
    ng := NewGadget(left,top,width,height,txt,attr,id,PLACETEXT_LEFT,vi,nil);
    gad := CreateGadget(CYCLE_KIND,gad,@ng,[
-                                         AsTag(GTCY_Labels), AsTag(thearr),
+                                         GTCY_Labels,thearr,
                                          TAG_END]);
    CycleGadget := gad;
 end;
@@ -118,8 +118,8 @@ BEGIN
   gad := ButtonGadget(2,10,HG,200,HGadget,'Screen Requester');
   HG := HG + DistGad + 3;
 
-  //gad := CycleGadget(3,100,HG,100,HGadget,'Cycle me',@strarray);
-  //HG := HG + DistGad+4;
+  gad := CycleGadget(3,100,HG,100,HGadget,'Cycle me',@strarray);
+  HG := HG + DistGad+4;
 
   gad := ButtonGadget(4,10,HG,96,HGadget,'OK');
   gad := ButtonGadget(5,115,HG,96,HGadget,'Cancel');
@@ -129,10 +129,10 @@ BEGIN
   if gad = nil then CleanUp('Can''t create gadgets',20);
 
   wp := OpenWindowTags(NIL,[
-                WA_Gadgets, AsTag(glist),
-                WA_Title,   AsTag('Test of EasyGadtools'),
-                WA_Left,    AsTag(100),
-                WA_Top,     AsTag(100),
+                WA_Gadgets, glist,
+                WA_Title, 'Test of EasyGadtools',
+                WA_Left,100,
+                WA_Top,100,
                 WA_Flags, WFLG_SMART_REFRESH OR WFLG_NOCAREREFRESH OR
                                 WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_CLOSEGADGET OR
                                 WFLG_ACTIVATE,

packages/amunits/examples/getdate.pas

@@ -17,7 +17,7 @@ const template : pchar = 'Format/K,Help/S';
       version : pchar = '$VER: GetDate 1.0 (21.2.95)';
 
 VAR DS : tDateStamp;
-    DT : _tDateTime;
+    DT : tDateTime;
     rda : pRDArgs;
     WeekDay, Date, Time, hours, mins, secs, day, month, year : pchar;
     vec : Array[0..1] of longint;
@@ -46,6 +46,7 @@ Begin
       ('O') : tmp := tmp + strpas(Month);
       ('Y') : tmp := tmp + strpas(Year);
      end;
+     i:=i+1;
     end
    else
     tmp := tmp + Str[i];
@@ -103,7 +104,7 @@ begin
  DT.dat_StrDay:=WeekDay;
  DT.dat_StrDate:=Date;
  DT.dat_StrTime:=Time;
- If DOSDateToStr(@DT) then begin
+ If DateToStr(@DT) then begin
 
  StrlCopy(hours,Time,2);
 

packages/amunits/examples/gtmenu.pas

@@ -16,7 +16,7 @@ Program GadtoolsMenu;
    [email protected]
 }
 
-uses Exec, Intuition, Utility, GadTools;
+uses Exec, Intuition, Utility, GadTools, systemvartags;
 
 
 
@@ -130,7 +130,7 @@ begin
                              WA_Activate,    ltrue,
                              WA_Height, 100,
                              WA_CloseGadget, ltrue,
-                             WA_Title,  AsTag('Menu Test Window'),
+                             WA_Title,  'Menu Test Window',
                              WA_IDCMP,  IDCMP_CLOSEWINDOW or IDCMP_MENUPICK,
                              TAG_END]);
 

packages/amunits/examples/imagegadget.pas

@@ -21,7 +21,7 @@ PROGRAM ImageGadget;
    [email protected]
 }
 
-USES Intuition, Exec, AGraphics, GadTools, Utility;
+USES Intuition, Exec, AGraphics, GadTools, Utility, systemvartags,pastoc;
 
 
 CONST
@@ -361,8 +361,8 @@ BEGIN
   g^.SelectRender := @selecti;
 
   wp := OpenWindowTags(NIL,[
-                WA_Gadgets, AsTag(gl),
-                WA_Title, AsTag('Images in Gadgets'),
+                WA_Gadgets,gl,
+                WA_Title, 'Images in Gadgets',
                 WA_Flags, WFLG_SMART_REFRESH OR WFLG_NOCAREREFRESH OR
                                 WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_CLOSEGADGET OR
                                 WFLG_ACTIVATE,
@@ -391,7 +391,7 @@ BEGIN
         CASE iclass OF
           IDCMP_CLOSEWINDOW : ende := TRUE;
           IDCMP_GADGETUP :
-             i := EasyReq(wp,WIN_TITLE, 'You have clicked on the Gadget!', 'Wheeew!');
+             i := EasyReq(wp,WIN_TITLE,pas2c('You have clicked on the Gadget!'),pas2c('Wheeew!'));
         ELSE END;
        msg := GT_GetIMsg(wp^.UserPort);
      END;

packages/amunits/examples/moire.pas

@@ -21,7 +21,7 @@ Program Moire;
       [email protected]
 }
 
-uses Exec, Intuition, AGraphics, Utility;
+uses Exec, Intuition, AGraphics, Utility, systemvartags;
 
 
 const
@@ -81,10 +81,10 @@ begin
 
 
     s := OpenScreenTags(NIL, [
-    SA_Pens,      AsTag(@pens),
+    SA_Pens,      @pens,
     SA_Depth,     2,
     SA_DisplayID, HIRES_KEY,
-    SA_Title,     AsTag('Close the Window to End This Demonstration'),
+    SA_Title,     'Close the Window to End This Demonstration',
     TAG_END]);
 
     if s <> NIL then begin
@@ -105,8 +105,8 @@ begin
     WA_SizeGadget,   -1,
     WA_SmartRefresh, -1,
     WA_Activate,     -1,
-    WA_Title,        AsTag('Feel Free to Re-Size the Window'),
-    WA_CustomScreen, AsTag(s),
+    WA_Title,        'Feel Free to Re-Size the Window',
+    WA_CustomScreen, s,
     TAG_END]);
 
     IF w <> NIL THEN begin

packages/amunits/examples/otherlibs/amarqueetest.pas

@@ -21,15 +21,11 @@ Var
 const
   errid : longint = 0;
 begin
-  if not Assigned(AMarqueeBase) then
-  begin
-    writeln('cannot open ' + AMARQUEENAME);
-    Halt(5);
-  end;
+
 
     {Connect to localhost}
     session := QNewSessionTags('localhost', 2957, 'pascal test',[QSESSION_ERRORCODEPTR,
-                                                                AsTag(@errid),TAG_DONE]);
+                                                                @errid,TAG_DONE]);
     if session = nil then begin
       writeln('Could not create connection to localhost/2957');
       writeln('the error was ',QErrorName(errid));

packages/amunits/examples/otherlibs/bestmodeid.pas

@@ -47,11 +47,6 @@ Var
     rda         :   pRDArgs;
 
 Begin
-  if not Assigned(P96Base) then
-  begin
-    writeln('Cannot open ', PICASSO96APINAME);
-    Halt(5);
-  end;
 
    width:=640;
    height:=480;

packages/amunits/examples/otherlibs/checkbox.pas

@@ -29,14 +29,10 @@ begin
 end;
 
 begin
-  if not Assigned(TritonBase) then
-  begin
-    writeln('cannot open ' + TRITONNAME);
-    Halt(5);
-  end;
-     App := TR_CreateAppTags([TRCA_Name, AsTag('Triton CheckBox'),
-                              TRCA_Release, AsTag('1.0'),
-                              TRCA_Date, AsTag('03-06-1998'),
+
+     App := TR_CreateAppTags([TRCA_Name,'Triton CheckBox',
+                              TRCA_Release,'1.0',
+                              TRCA_Date,'03-06-1998',
                               TAG_DONE]);
 
      if App = nil then CleanUp('Can''t create application',20);
@@ -69,18 +65,16 @@ begin
                CASE trmsg^.trm_Class OF
                  TRMS_CLOSEWINDOW : begin
                                      if TR_GetCheckBox(Project,10) then
-                                       writeln('CheckBox was on')
-                                     else
-                                       writeln('CheckBox was off');
+writeln('CheckBox was on')
+                                        else writeln('CheckBox was off');
                                      close_me := True;
                                     end;
                  TRMS_ERROR:        WriteLN(TR_GetErrorString(trmsg^.trm_Data));
                  TRMS_NEWVALUE    : begin
                                       IF trmsg^.trm_ID = 10 then begin
-                                        if trmsg^.trm_Data = 0 then
-                                          writeln('CheckBox off')
-                                        else
-                                          writeln('CheckBox on');
+                                          if trmsg^.trm_Data = 0 then
+writeln('CheckBox off')
+                                            else writeln('CheckBox on');
                                       end;
                                     end;
                END;

packages/amunits/examples/otherlibs/demo.pas

@@ -115,7 +115,7 @@ VAR
 
 BEGIN
     ProjectStart;
-    WindowTitle('Groups'); WindowPosition(TRWP_CENTERDISPLAY); WindowUnderscore(string('~')); WindowID(1);
+    WindowTitle('Groups'); WindowPosition(TRWP_CENTERDISPLAY); WindowUnderscore('~'); WindowID(1);
 
     HorizGroupA; Space; VertGroupA;
     Space;
@@ -994,8 +994,8 @@ ProjectStart;
                                          ELSE reqstr := 'Icon(s) dropped into the window.' + #9 + 'Name of first dropped icon:' + #10 + '%3' + strpas(dirname);
                                       END;
                                       TR_EasyRequestTags(App,reqstr,'_Ok',[
-                                                     TREZ_LockProject, AsTag(appwindow_project),
-                                                     TREZ_Title, AsTag('AppWindow report'),
+                                                     TREZ_LockProject, appwindow_project,
+                                                     TREZ_Title,'AppWindow report',
                                                      TREZ_Activate,1,
                                                      TAG_END]);
 
@@ -1103,8 +1103,8 @@ BEGIN
                                                 TR_EasyRequestTags(App,'To get help, move the mouse pointer over' + #10 +
                                                 'any gadget or menu item and press <Help>'+#10+
                                                 'or turn on QuickHelp before.','_Ok',[
-                                                TREZ_LockProject, AsTag(Main_Project),
-                                                TREZ_Title, AsTag('Triton help'),
+                                                TREZ_LockProject,Main_Project,
+                                                TREZ_Title,'Triton help',
                                                 TAG_END]);
                                              end;
                                         103: quit := True;
@@ -1118,8 +1118,8 @@ BEGIN
                                          reqstr := 'No help available for object ' + IntToStr(trmsg^.trm_ID);
                                       END;
                                       TR_EasyRequestTags(App,reqstr,'_Ok',[
-                                                     TREZ_LockProject, AsTag(Main_Project),
-                                                     TREZ_Title, AsTag('Triton help'),
+                                                     TREZ_LockProject,Main_Project,
+                                                     TREZ_Title,'Triton help',
                                                      TAG_END]);
                                     END;
                  TRMS_ERROR:        WriteLN(TR_GetErrorString(trmsg^.trm_Data));
@@ -1136,16 +1136,11 @@ BEGIN
 END;
 
 BEGIN
-  if not Assigned(TritonBase) then
-  begin
-    writeln('cannot open ' + TRITONNAME);
-    Halt(5);
-  end;
 
     App := TR_CreateAppTags([
-              TRCA_Name, AsTag('TritonDemo'),
-              TRCA_LongName, AsTag('Triton Demo'),
-              TRCA_Version, AsTag('2.0'),
+              TRCA_Name,'TritonDemo',
+              TRCA_LongName,'Triton Demo',
+              TRCA_Version,'2.0',
               TAG_DONE]);
 
     if App <> nil then begin

packages/amunits/examples/otherlibs/envprint.pas

@@ -352,15 +352,10 @@ BEGIN
 END;
 
 begin
-  if not Assigned(TritonBase) then
-  begin
-    writeln('cannot open ' + TRITONNAME);
-    Halt(5);
-  end;
   Triton_App := TR_CreateAppTags([
-                TRCA_Name, AsTag('Envprint'),
-                TRCA_LongName, AsTag('EnvPrint GUI demo'),
-                TRCA_Version, AsTag('2.0'),
+                TRCA_Name,'Envprint',
+                TRCA_LongName,'EnvPrint GUI demo',
+                TRCA_Version,'2.0',
                 TAG_END]);
 
   if Triton_App <> nil then begin

packages/amunits/examples/otherlibs/gadgetdemo.pas

@@ -73,23 +73,19 @@ BEGIN
 END;
 
 BEGIN
-  if not Assigned(TritonBase) then
-  begin
-    writeln('cannot open ' + TRITONNAME);
-    Halt(5);
-  end;
+
     CreateList(MyList);
     FOR i := 0 TO NumInList-2 DO BEGIN
         MyNode := AddNewNode(MyList,mxstrings[i]);
     END;
 
     Triton_App := TR_CreateAppTags([
-                     TRCA_Name, AsTag('FPC Pascal Demo'),
-                     TRCA_LongName, AsTag('FPC Pascal Application Demo :)'),
-                     TRCA_Version, AsTag('0.01'),
-                     TRCA_Info, AsTag('Just a test of Triton'),
-                     TRCA_Release, AsTag('1.0'),
-                     TRCA_Date, AsTag('01-05-1996'),
+                     TRCA_Name,'FPC Pascal Demo',
+                     TRCA_LongName,'FPC Pascal Application Demo :)',
+                     TRCA_Version,'0.01',
+                     TRCA_Info,'Just a test of Triton',
+                     TRCA_Release,'1.0',
+                     TRCA_Date,'01-05-1996',
                      TAG_DONE]);
 
     if Triton_App = NIL then CleanExit('Can''t create application',20);

packages/amunits/examples/otherlibs/gttest.pas

@@ -42,11 +42,6 @@ begin
 end;
 
 begin
-  if not Assigned(GTLayoutBase) then
-  begin
-    writeln('cannot open ' + GTLAYOUTNAME);
-    Halt(5);
-  end;
     done := false;
     handle := LT_CreateHandleTags(nil,[
                     LAHN_AutoActivate, lfalse,
@@ -55,26 +50,26 @@ begin
     if handle = nil then CleanUp('Could''t create a handle',20);
 
     LT_New(handle,[LA_Type,VERTICAL_KIND,       { A vertical group. }
-                   LA_LabelText, AsTag('Main Group'),
+                   LA_LabelText,'Main Group',
                    TAG_DONE]);
 
     LT_New(handle,[LA_Type,BUTTON_KIND,         { A plain button. }
-                   LA_LabelText, AsTag('A button'),
+                   LA_LabelText,'A button',
                    LA_ID,11,
                    TAG_DONE]);
 
     LT_New(handle,[LA_Type,XBAR_KIND,TAG_DONE]); { A separator bar. }
 
     LT_New(handle,[LA_Type,BUTTON_KIND,          { A plain button. }
-                   LA_LabelText, AsTag('Another button'),
+                   LA_LabelText,'Another button',
                    LA_ID,22,
                    TAG_DONE]);
 
-    LT_New(handle,[LA_Type,CHECKBOX_KIND,LA_LabelText,AsTag('test'),LA_ID,33,LA_BOOL,1,TAG_DONE]);
+    LT_New(handle,[LA_Type,CHECKBOX_KIND,LA_LabelText,'test',LA_ID,33,LA_BOOL,1,TAG_DONE]);
 
     LT_New(handle,[La_Type,END_KIND,TAG_DONE]);  { This ends the current group. }
 
-    win := LT_Build(handle,[LAWN_Title, AsTag('Window title'),
+    win := LT_Build(handle,[LAWN_Title,'Window title',
                             LAWN_IDCMP, IDCMP_CLOSEWINDOW,
                             WA_CloseGadget, ltrue,
                             TAG_DONE]);

packages/amunits/examples/otherlibs/linklib.pas

@@ -106,8 +106,8 @@ BEGIN
 
    dummy := TR_EasyRequestTags(Triton_App,'Sure you want to delete'+#10+
                             strpas(GetNodeData(mynode)),'_Remove|_Cancel',[
-                            TREZ_LockProject, AsTag(Project),
-                            TREZ_Title, AsTag('Delete this file?'),
+                            TREZ_LockProject,Project,
+                            TREZ_Title,'Delete this file?',
                             TREZ_Activate,1,
                             TAG_END]);
    IF dummy = 1 THEN BEGIN
@@ -124,8 +124,8 @@ VAR
 BEGIN
    dummy := TR_EasyRequestTags(Triton_App,'Sure you want to remove all files?',
                                       '_Remove|_Cancel',[
-                                      TREZ_LockProject, AsTag(Project),
-                                      TREZ_Title, AsTag('Delete all?'),
+                                      TREZ_LockProject,Project,
+                                      TREZ_Title,'Delete all?',
                                       TREZ_Activate,1,
                                       TAG_END]);
    IF dummy = 1 THEN BEGIN
@@ -255,18 +255,13 @@ END;
 
 
 BEGIN  { Main }
-  if not Assigned(TritonBase) then
-  begin
-    writeln('cannot open ' + TRITONNAME);
-    Halt(5);
-  end;
         Triton_App := TR_CreateAppTags([
-                       TRCA_Name, AsTag('Triton ListView Demo'),
-                       TRCA_LongName, AsTag('Demo of ListView in Triton, made in FPC Pascal'),
-                       TRCA_Version, AsTag('0.01'),
-                       TRCA_Info, AsTag('Uses tritonsupport'),
-                       TRCA_Release, AsTag('11'),
-                       TRCA_Date, AsTag('03-02-1998'),
+                       TRCA_Name,'Triton ListView Demo',
+                       TRCA_LongName,'Demo of ListView in Triton, made in FPC Pascal',
+                       TRCA_Version,'0.01',
+                       TRCA_Info,'Uses tritonsupport',
+                       TRCA_Release,'11',
+                       TRCA_Date,'03-02-1998',
                        TAG_END]);
         if Triton_App <> nil then begin
         path := @pdummy;

packages/amunits/examples/otherlibs/listview.pas

@@ -46,15 +46,11 @@ BEGIN
 END;
 
 begin
-  if not Assigned(TritonBase) then
-  begin
-    writeln('cannot open ' + TRITONNAME);
-    Halt(5);
-  end;
+
     Triton_App := TR_CreateAppTags([
-                     TRCA_Name, AsTag('Triton ListView'),
-                     TRCA_Release, AsTag('1.0'),
-                     TRCA_Date, AsTag('03-02-1998'),
+                     TRCA_Name,'Triton ListView',
+                     TRCA_Release,'1.0',
+                     TRCA_Date,'03-02-1998',
                      TAG_DONE]);
 
     if Triton_App = nil then Cleanexit('Can''t create application',20);

packages/amunits/examples/otherlibs/modelist.pas

@@ -31,11 +31,6 @@ Var
     mn          :   pP96Mode;
 
 Begin
-  if not Assigned(P96Base) then
-  begin
-    writeln('Cannot open ', PICASSO96APINAME);
-    Halt(5);
-  end;
   width:=640;
   height:=480;
   depth:=8;

packages/amunits/examples/otherlibs/openpip.pas

@@ -38,11 +38,6 @@ Var
     rda             :   pRDArgs;
 
 Begin
-  if not Assigned(P96Base) then
-  begin
-    writeln('Cannot open ', PICASSO96APINAME);
-    Halt(5);
-  end;
     width := 256;
     height := 256;
     StrCopy(@PubScreenName,WB);
@@ -59,7 +54,7 @@ Begin
     wd := p96PIP_OpenTags([P96PIP_SourceFormat, long(RGBFB_R5G5B5),
                            P96PIP_SourceWidth,256,
                            P96PIP_SourceHeight,256,
-                           WA_Title, AsTag('Picasso96 API PIP Test'),
+                           WA_Title,'Picasso96 API PIP Test',
                            WA_Activate,lTRUE,
                            WA_RMBTrap,lTRUE,
                            WA_Width,Width,
@@ -70,14 +65,14 @@ Begin
                            WA_SizeGadget,lTRUE,
                            WA_CloseGadget,lTRUE,
                            WA_IDCMP,IDCMP_CLOSEWINDOW,
-                           WA_PubScreenName, AsTag(@PubScreenName),
+                           WA_PubScreenName,@PubScreenName,
                            TAG_DONE]);
 
     If wd <> Nil Then Begin
         goahead:=True;
         rp:=Nil;
 
-        p96PIP_GetTags(wd,[P96PIP_SourceRPort, AsTag(@rp), TAG_END]);
+        p96PIP_GetTags(wd,[P96PIP_SourceRPort, @rp, TAG_END]);
         If rp<>Nil Then Begin
             For y:=0 To (Height-1) Do
             For x:=0 To (Width-1) Do

packages/amunits/examples/otherlibs/openscreen.pas

@@ -20,7 +20,7 @@ PROGRAM OpenScreen;
 }
 
 
-uses exec, amigados, agraphics, intuition, picasso96api, utility;
+uses exec, amigados, agraphics, intuition, picasso96api, utility,systemvartags;
 
 Const
 
@@ -61,11 +61,6 @@ begin
 end;
 
 BEGIN
-  if not Assigned(P96Base) then
-  begin
-    writeln('Cannot open ', PICASSO96APINAME);
-    Halt(5);
-  end;
     Width:=640;
     Height:=480;
     Depth:=8;
@@ -82,8 +77,8 @@ BEGIN
                            P96SA_Height, Height,
                            P96SA_Depth, Depth,
                            P96SA_AutoScroll, lTRUE,
-                           P96SA_Pens, AsTag(@Pens),
-                           P96SA_Title, AsTag(ScreenTitle),
+                           P96SA_Pens, @Pens,
+                           P96SA_Title, ScreenTitle,
                            TAG_DONE]);
 
 
@@ -94,11 +89,11 @@ BEGIN
     Dimensions[2]:=sc^.Width;
     Dimensions[3]:=sc^.Height-sc^.BarHeight-1;
 
-    wdp:=OpenWindowTags(NIL,[WA_CustomScreen, AsTag(sc),
-                             WA_Title, AsTag('Writepixel'),
+    wdp:=OpenWindowTags(NIL,[WA_CustomScreen, sc,
+                             WA_Title,'Writepixel',
                              WA_Left, (sc^.Width DIV 2-200) DIV 2+sc^.Width DIV 2,
                              WA_Top, (sc^.Height-sc^.BarHeight-300) DIV 2,
-                             WA_Zoom, AsTag(@Dimensions),
+                             WA_Zoom, @Dimensions,
                              WA_Width, 200,
                              WA_Height, 300,
                              WA_MinWidth, 100,
@@ -114,17 +109,17 @@ BEGIN
                              WA_SizeGadget, lTRUE,
                              WA_SizeBBottom, lTRUE,
                              WA_GimmeZeroZero, lTRUE,
-                             WA_ScreenTitle, AsTag(ScreenTitle),
+                             WA_ScreenTitle,ScreenTitle,
                              WA_IDCMP, IDCMP_RAWKEY + IDCMP_CLOSEWINDOW,
                              TAG_DONE]);
 
     If wdp = Nil Then CleanUp('Unable to open window 1.');
 
-    wdf:=OpenWindowTags(NIL,[WA_CustomScreen, PtrUInt(sc),
-                             WA_Title, PtrUInt(PChar('FillRect')),
+    wdf:=OpenWindowTags(NIL,[WA_CustomScreen,sc,
+                             WA_Title, 'FillRect',
                              WA_Left,(sc^.Width div 2-200) div 2,
                              WA_Top,(sc^.Height-sc^.BarHeight-300)div 2,
-                             WA_Zoom, PtrUInt(@Dimensions),
+                             WA_Zoom, @Dimensions,
                              WA_Width, 200,
                              WA_Height, 300,
                              WA_MinWidth, 100,
@@ -140,7 +135,7 @@ BEGIN
                              WA_SizeGadget, lTRUE,
                              WA_SizeBBottom, lTRUE,
                              WA_GimmeZeroZero, lTRUE,
-                             WA_ScreenTitle, PtrUInt(PChar(ScreenTitle)),
+                             WA_ScreenTitle, ScreenTitle,
                              WA_IDCMP, IDCMP_RAWKEY or IDCMP_CLOSEWINDOW,
                              TAG_DONE]);
 

packages/amunits/examples/otherlibs/p96checkboards.pas

@@ -39,25 +39,20 @@ BEGIN
 END;
 
 begin
-  if not Assigned(P96Base) then
-  begin
-    writeln('Cannot open ', PICASSO96APINAME);
-    Halt(5);
-  end;
    BoardName := @boardtmp;
 
-   tmp := p96GetRTGDataTags([P96RD_NumberOfBoards, AsTag(@NumBoards), TAG_END]);
+   tmp := p96GetRTGDataTags([P96RD_NumberOfBoards, @NumBoards, TAG_END]);
 
    writeln('Looking through all boards installed for Picasso96');
 
    for i := 0 to NumBoards-1 do begin
-       p96GetBoardDataTags(i,[P96BD_BoardName, AsTag(@BoardName),
-                              P96BD_RGBFormats, AsTag(@RGBFormats),
-                              P96BD_TotalMemory, AsTag(@MemorySize),
-                              P96BD_FreeMemory, AsTag(@FreeMemory),
-                              P96BD_LargestFreeMemory, AsTag(@LargestFreeMemory),
-                              P96BD_MemoryClock, AsTag(@MemoryClock),
-                              P96BD_MonitorSwitch, AsTag(@MoniSwitch),
+       p96GetBoardDataTags(i,[P96BD_BoardName, @BoardName,
+                              P96BD_RGBFormats, @RGBFormats,
+                              P96BD_TotalMemory, @MemorySize,
+                              P96BD_FreeMemory, @FreeMemory,
+                              P96BD_LargestFreeMemory, @LargestFreeMemory,
+                              P96BD_MemoryClock, @MemoryClock,
+                              P96BD_MonitorSwitch, @MoniSwitch,
                               TAG_END]);
 
       writeln('--------------------------------------------------');

packages/amunits/examples/otherlibs/palette.pas

@@ -22,15 +22,11 @@ var
 
 
 begin
-  if not Assigned(TritonBase) then
-  begin
-    writeln('cannot open ' + TRITONNAME);
-    Halt(5);
-  end;
+
     Triton_App := TR_CreateAppTags([
-                     TRCA_Name, AsTag('Triton Palette Demo'),
-                     TRCA_Release, AsTag('1.0'),
-                     TRCA_Date, AsTag('03-06-1998'),
+                     TRCA_Name,'Triton Palette Demo',
+                     TRCA_Release,'1.0',
+                     TRCA_Date,'03-06-1998',
                      TAG_DONE]);
 
     if Triton_App <> nil then begin

packages/amunits/examples/otherlibs/progindex.pas

@@ -112,14 +112,9 @@ end;
 (* /////////////////////////////////////////////////////////////////////////////////////////////////////// *)
 
 begin
-  if not Assigned(TritonBase) then
-  begin
-    writeln('cannot open ' + TRITONNAME);
-    Halt(5);
-  end;
   Triton_App := TR_CreateAppTags([
-                TRCA_Name, AsTag('trProgIndDemo'),
-                TRCA_Version, AsTag('1.0'),
+                TRCA_Name,'trProgIndDemo',
+                TRCA_Version,'1.0',
                 TAG_END]);
 
   if Triton_App <> nil then begin

packages/amunits/examples/otherlibs/requestmodeid.pas

@@ -34,11 +34,6 @@ Var
 
 
 Begin
-  if not Assigned(P96Base) then
-  begin
-    writeln('Cannot open ', PICASSO96APINAME);
-    Halt(5);
-  end;
     width:=640;
     height:=480;
     depth:=15;
@@ -54,7 +49,7 @@ Begin
     DisplayID := p96RequestModeIDTags([P96MA_MinWidth, width,
                                        P96MA_MinHeight, height,
                                        P96MA_MinDepth, depth,
-                                       P96MA_WindowTitle, AsTag('RequestModeID Test'),
+                                       P96MA_WindowTitle, 'RequestModeID Test',
                                        P96MA_FormatsAllowed, (RGBFF_CLUT or RGBFF_R5G6B5 or RGBFF_R8G8B8 or RGBFF_A8R8G8B8),
                                        TAG_DONE]);
 

packages/amunits/examples/otherlibs/rtdemo.pas

@@ -24,7 +24,7 @@ PROGRAM RTDemo;
 
 }
 
-uses reqtools, strings, utility, exec, amigados;
+uses reqtools, strings, utility,longarray;
 
 
 
@@ -45,7 +45,6 @@ VAR
     ret             : Longint;
     color           : Longint;
     undertag        : Array [0..1] of tTagItem;
-    Param           : array of PtrUInt;
 
 FUNCTION GetScrollValue(value : INTEGER): STRING;
 BEGIN
@@ -62,11 +61,6 @@ BEGIN
 END;
 
 BEGIN
-  if not Assigned(ReqToolsBase) then
-  begin
-    writeln('Cannot open ', REQTOOLSNAME);
-    Halt(5);
-  end;
     dummy:= StrAlloc(400);
     dummy2 := StrAlloc(200);
 
@@ -94,13 +88,14 @@ BEGIN
     IF (ret=0) THEN
         rtEZRequestA('You entered nothing','I''m sorry', NIL, NIL, NIL)
     ELSE
-        rtEZRequestA('You entered this string:' + #10 + '%s','So I did', NIL, @buffer, NIL);
+        rtEZRequestA('You entered this string:' + #10 + '%s','So I did', NIL,
+        readinlongs([buffer]),NIL);
 
     ret := rtGetString(buffer, 127, 'Enter anything:', NIL,[
-                RTGS_GadFmt, AsTag(' _Ok |New _2.0 feature!|_Cancel'),
-                RTGS_TextFmt, AsTag('These are two new features of ReqTools 2.0:' + #10
-                + 'Text above the entry gadget and more than' + #10 + 'one response gadget.'),
-                TAG_MORE, AsTag(@undertag)]);
+                RTGS_GadFmt, ' _Ok |New _2.0 feature!|_Cancel',
+                RTGS_TextFmt,'These are two new features of ReqTools 2.0:' + #10
+                + 'Text above the entry gadget and more than' + #10 + 'one response gadget.',
+                TAG_MORE, @undertag]);
 
 
 
@@ -109,15 +104,15 @@ BEGIN
                        'Oh boy!',NIL,NIL,NIL);
 
     ret := rtGetString(buffer, 127, 'Enter anything:',NIL,[
-                        RTGS_GadFmt, AsTag(' _Ok | _Abort |_Cancel'),
-                        RTGS_TextFmt, AsTag('New is also the ability to switch off the' + #10 +
+                        RTGS_GadFmt,' _Ok | _Abort |_Cancel',
+                        RTGS_TextFmt,'New is also the ability to switch off the' + #10 +
                         'backfill pattern.  You can also center the' + #10 +
                         'text above the entry gadget.' + #10 +
                         'These new features are also available in' + #10 +
-                        'the rtGetLong() requester.'),
-                        RTGS_BackFill, LFALSE,
+                        'the rtGetLong() requester.',
+                        RTGS_BackFill, FALSE,
                         RTGS_Flags, GSREQF_CENTERTEXT + GSREQF_HIGHLIGHTTEXT,
-                        TAG_MORE, AsTag(@undertag)]);
+                        TAG_MORE, @undertag]);
 
     IF ret = 2 THEN
         rtEZRequestA('What!! You pressed abort!?!' + #10 + 'You must be joking :-)',
@@ -127,7 +122,7 @@ BEGIN
                      'Show me', NIL, NIL, NIL);
 
     ret := rtGetLong(longnum, 'Enter a number:',NIL,[
-                      RTGL_ShowDefault, LFALSE,
+                      RTGL_ShowDefault, FALSE,
                       RTGL_Min, 0,
                       RTGL_Max, 666,
                       TAG_DONE]);
@@ -136,7 +131,7 @@ BEGIN
         rtEZRequestA('You entered nothing','I''m sorry', NIL, NIL, NIL)
     ELSE
         rtEZRequestA('The number You entered was:'  + #10 + '%ld' ,
-                     'So it was', NIL, @longnum, NIL);
+                     'So it was', NIL, readinlongs([longnum]), NIL);
 
     rtEZRequestA ('NUMBER 3:' + #10 + 'Notification requester, the requester' + #10 +
                          'you''ve been using all the time!' + #10 +
@@ -181,7 +176,7 @@ BEGIN
                             RTEZ_DefaultResponse, 4,
                             TAG_DONE]);
 
-    rtEZRequestA('You picked ''%ld''.', 'How true', NIL, @ret, NIL);
+    rtEZRequestA('You picked ''%ld''.', 'How true', NIL, readinlongs([ret]),NIL);
 
     {
       If i used just a string for this text is will be truncated
@@ -207,22 +202,20 @@ BEGIN
     strcat(dummy,dummy2);
 
     rtEZRequestA(dummy,'_Great|_Fantastic|_Swell|Oh _Boy',NIL,NIL,@undertag);
-    SetLength(Param, 2);
-    Param[0] := 5;
-    Param[1] := AsTag('five');
+
     rtEZRequestA('You may also use C-style formatting codes in the body text.' + #10 +
                         'Like this:' + #10 +  #10 +
                         'The number %%ld is written %%s. will give:' + #10 +  #10 +
                         'The number %ld is written %s.' + #10 +  #10 +
                         'if you also pass ''5'' and ''five'' to rtEZRequestA().',
-                        '_Proceed',NIL, @Param, @undertag);
+                        '_Proceed',NIL,readinlongs([5,'five']),@undertag);
 
     ret := rtEZRequest('It is also possible to pass extra IDCMP flags' + #10 +
                         'that will satisfy rtEZRequest(). This requester' + #10 +
                         'has had DISKINSERTED passed to it.' + #10 +
                         '(Try inserting a disk).', '_Continue', NIL,NIL,[
                         RT_IDCMPFlags, DISKINSERTED,
-                        TAG_MORE, AsTag(@undertag)]);
+                        TAG_MORE,@undertag]);
 
     IF ((ret = DISKINSERTED)) THEN
         rtEZRequestA('You inserted a disk.', 'I did', NIL, NIL, NIL)
@@ -236,14 +229,14 @@ BEGIN
                         'This works for all requesters, not just rtEZRequest()!',
                         '_Amazing', NIL,NIL,[
                         RT_ReqPos, REQPOS_TOPLEFTSCR,
-                        TAG_MORE, AsTag(@undertag)]);
+                        TAG_MORE,@undertag]);
 
     rtEZRequest('Alternatively, you can center the' + #10 +
                         'requester on the screen.' + #10 +
                         'Check out ''reqtools.doc'' for all the possibilities.',
                         'I''ll do that', NIL,NIL,[
                         RT_ReqPos, REQPOS_CENTERSCR,
-                        TAG_MORE, AsTag(@undertag)]);
+                        TAG_MORE,@undertag]);
 
 
     ret := rtEZRequestA('NUMBER 4:' + #10 + 'File requester' + #10 + 'function: rtFileRequest()',
@@ -260,11 +253,9 @@ BEGIN
         }
         ret := Longint(rtFileRequestA(filereq, filename, 'Pick a file', NIL));
         IF (ret)<>0 THEN begin
-            SetLength(Param, 2);
-            Param[0] := AsTag(filename);
-            Param[1] := AsTag(filereq^.Dir);
             rtEZRequestA('You picked the file:' + #10 + '%s' + #10 + 'in directory:'
-                                + #10 + '%s', 'Right', NIL, @Param, NIL);
+                                + #10 + '%s', 'Right', NIL, readinlongs([
+                                                          filename,filereq^.Dir]),NIL);
         END
         ELSE
             rtEZRequestA('You didn''t pick a file.', 'No', NIL, NIL, NIL);
@@ -285,7 +276,7 @@ BEGIN
                           '"%s"' + #10 +
                           'All the files are returned as a linked' + #10 +
                           'list (see demo.c and reqtools.h).',
-                          'Aha', NIL, @(filelist^.Name),NIL);
+                          'Aha', NIL, readinlongs([filelist^.Name]),NIL);
             (* Traverse all selected files *)
             (*
             tempflist = flist;
@@ -314,7 +305,7 @@ BEGIN
 
          IF(ret=1) THEN begin
              rtEZRequestA('You picked the directory:' + #10 +'%s',
-                          'Right', NIL, @(filereq^.Dir), NIL);
+                          'Right', NIL, readinlongs([filereq^.Dir]), NIL);
          end ELSE
              rtEZRequestA('You didn''t pick a directory.', 'No', NIL, NIL, NIL);
 
@@ -331,12 +322,10 @@ BEGIN
          fontreq^.Flags := FREQF_STYLE OR FREQF_COLORFONTS;
          ret := rtFontRequestA (fontreq, 'Pick a font', NIL);
          IF(ret<>0) THEN begin
-             SetLength(Param, 2);
-             Param[0] := AsTag(fontreq^.Attr.ta_Name);
-             Param[1] := AsTag(fontreq^.Attr.ta_YSize);
              rtEZRequestA('You picked the font:' + #10 + '%s' + #10 + 'with size:' +
                           #10 + '%ld',
-                         'Right', NIL, @Param, NIL);
+                         'Right', NIL, readinlongs([fontreq^.Attr.ta_Name,
+                                                    fontreq^.Attr.ta_YSize]),NIL);
          end ELSE
              ret := rtEZRequestA('You didn''t pick a font','I know', NIL, NIL, NIL);
          rtFreeRequest(fontreq);
@@ -353,7 +342,7 @@ BEGIN
                          'Nah', NIL, NIL, NIL)
     ELSE begin
         rtEZRequestA('You picked color number %ld.', 'Sure did',
-                         NIL, @color, NIL);
+                         NIL, readinlongs([color]), NIL);
     END;
 
     rtEZRequestA('NUMBER 7: (ReqTools 2.0)' + #10 +
@@ -370,7 +359,7 @@ BEGIN
                                       TAG_END]));
         IF (ret = 1) THEN begin
             rtEZRequestA('You picked the volume:' + #10 + '%s',
-                        'Right',NIL, @filereq^.Dir,NIL);
+                        'Right',NIL,readinlongs([filereq^.Dir]),NIL);
         end
         ELSE
             rtEZRequestA('You didn''t pick a volume.','I did not',NIL,NIL,NIL);
@@ -394,13 +383,6 @@ BEGIN
                                      TAG_END]);
 
         IF(ret=1) THEN BEGIN
-            SetLength(Param, 6);
-            Param[0] := scrnreq^.DisplayID;
-            Param[1] := scrnreq^.DisplayWidth;
-            Param[2] := scrnreq^.DisplayHeight;
-            Param[3] := scrnreq^.DisplayDepth;
-            Param[4] := scrnreq^.OverscanType;
-            Param[5] := AsTag(PChar(AnsiString(GetScrollValue(scrnreq^.AutoScroll))));
             rtEZRequestA('You picked this mode:' + #10 +
                          'ModeID  : 0x%lx' + #10 +
                          'Size    : %ld x %ld' + #10 +
@@ -408,7 +390,12 @@ BEGIN
                          'Overscan: %ld' + #10 +
                          'AutoScroll %s',
                          'Right', NIL,
-                         @Param,NIL);
+                         readinlongs([scrnreq^.DisplayID,
+                                      scrnreq^.DisplayWidth,
+                                      scrnreq^.DisplayHeight,
+                                      scrnreq^.DisplayDepth,
+                                      scrnreq^.OverscanType,
+                                      GetScrollValue(scrnreq^.AutoScroll)]),NIL);
         END
         ELSE
             rtEZRequestA('You didn''t pick a screen mode.', 'Sorry', NIL, NIL, NIL);

packages/amunits/examples/otherlibs/scroller.pas

@@ -20,15 +20,11 @@ VAR
      dummy : longint;
 
 begin
-  if not Assigned(TritonBase) then
-  begin
-    writeln('cannot open ' + TRITONNAME);
-    Halt(5);
-  end;
+
     App := TR_CreateAppTags([
-                     TRCA_Name, AsTag(' Triton Scroller Demo'),
-                     TRCA_Release, AsTag(' 1.0'),
-                     TRCA_Date, AsTag(' 03-08-1998'),
+                     TRCA_Name,' Triton Scroller Demo' ,
+                     TRCA_Release,' 1.0' ,
+                     TRCA_Date,' 03-08-1998' ,
                      TAG_DONE]);
 
     if App <> nil then begin

packages/amunits/examples/otherlibs/slider.pas

@@ -30,15 +30,11 @@ Function IntToStr (I : Longint) : String;
      end;
 
 begin
-  if not Assigned(TritonBase) then
-  begin
-    writeln('cannot open ' + TRITONNAME);
-    Halt(5);
-  end;
+
     Triton_App := TR_CreateAppTags([
-                     TRCA_Name, AsTag(' Triton Slider Demo'),
-                     TRCA_Release, AsTag(' 1.0'),
-                     TRCA_Date, AsTag(' 03-08-1998'),
+                     TRCA_Name,' Triton Slider Demo' ,
+                     TRCA_Release,' 1.0' ,
+                     TRCA_Date,' 03-08-1998' ,
                      TAG_DONE]);
 
     if Triton_App <> nil then begin

packages/amunits/examples/otherlibs/smallplay.pas

@@ -18,25 +18,20 @@ var
     SigBit : shortint;
     SigMask : longint;
 
-procedure CleanUp(why : string; err : integer);
+procedure CleanUp(why : string, err : integer);
 begin
     if why <> '' then writeln(why);
     halt(err);
 end;
 
 begin
-  if not Assigned(PTReplayBase) then
-  begin
-    writeln('cannot open ' + PTREPLAYNAME);
-    Halt(5);
-  end;
     module := nil;
     if ParamCount > 1 then
        CleanUp('Specify one module only',20);
     if ParamCount < 0 then
        CleanUp('Play what module?',20);
 
-    module := PTLoadModule(ParamStr(1));
+    module := PTLoadModule(ParamStr[1]);
     if not assigned(module) then
        CleanUp('Couldn''t open/load module',20);
 
@@ -48,7 +43,7 @@ begin
     PTPlay(module);
 
     SigMask := Wait(SIGBREAKF_CTRL_C or (1 shl SigBit));
-    if (SigMask and SIGBREAKF_CTRL_C) <> 0 then
+    if (SigMask and SIGBREAKF_CTRL_C) then
         PTFade(module,1)
     else
         PTStop(module);

packages/amunits/examples/otherlibs/string.pas

@@ -21,15 +21,11 @@ VAR
      App : pTR_App;
 
 begin
-  if not Assigned(TritonBase) then
-  begin
-    writeln('cannot open ' + TRITONNAME);
-    Halt(5);
-  end;
+
     App := TR_CreateAppTags([
-                     TRCA_Name, AsTag('Triton String Demo'),
-                     TRCA_Release, AsTag('1.0'),
-                     TRCA_Date, AsTag('03-06-1998'),
+                     TRCA_Name,'Triton String Demo',
+                     TRCA_Release,'1.0',
+                     TRCA_Date,'03-06-1998',
                      TAG_DONE]);
     if App <> nil then begin
       ProjectStart;

packages/amunits/examples/otherlibs/toolmanager1.pas

@@ -65,20 +65,15 @@ begin
 end;
 
 begin
-  if not Assigned(TritonBase) then
-  begin
-    writeln('cannot open ' + TRITONNAME);
-    Halt(5);
-  end;
     CreateList(LVList);
     FOR i := 0 TO 8 DO BEGIN
         MyNode := AddNewNode(LVList,liststrings[i]);
     END;
 
     Triton_App := TR_CreateAppTags([
-                               TRCA_Name, AsTag('ToolManagerGUIDemo1'),
-                               TRCA_LongName, AsTag('ToolManager GUI demo 1'),
-                               TRCA_Info, AsTag('Looks like the original ToolManager'),
+                               TRCA_Name,'ToolManagerGUIDemo1',
+                               TRCA_LongName,'ToolManager GUI demo 1',
+                               TRCA_Info,'Looks like the original ToolManager',
                                TAG_END]);
 
     if Triton_App = nil then CleanUp('Can''t create application',20);

packages/amunits/examples/otherlibs/toolmanager2.pas

@@ -66,20 +66,15 @@ begin
 end;
 
 begin
-  if not Assigned(TritonBase) then
-  begin
-    writeln('cannot open ' + TRITONNAME);
-    Halt(5);
-  end;
     CreateList(LVList);
     FOR i := 0 TO 8 DO BEGIN
         MyNode := AddNewNode(LVList, liststrings[i]);
     END;
 
     Triton_App := TR_CreateAppTags([
-                          TRCA_Name, AsTag('ToolManagerGUIDemo2'),
-                          TRCA_LongName, AsTag('ToolManager GUI demo 2'),
-                          TRCA_Info, AsTag('Looks like the ToolManager demo 2 of GUIFront'),
+                          TRCA_Name,'ToolManagerGUIDemo2',
+                          TRCA_LongName,'ToolManager GUI demo 2',
+                          TRCA_Info,'Looks like the ToolManager demo 2 of GUIFront',
                           TAG_END]);
 
     if Triton_App = nil then CleanUp('Can''t create application',20);

packages/amunits/examples/otherlibs/toolmanager3.pas

@@ -67,11 +67,6 @@ begin
 end;
 
 begin
-  if not Assigned(TritonBase) then
-  begin
-    writeln('cannot open ' + TRITONNAME);
-    Halt(5);
-  end;
     CreateList(LVList);
     FOR i := 0 TO 8 DO BEGIN
         MyNode := AddNewNode(LVList,liststrings[i]);
@@ -79,9 +74,9 @@ begin
 
 
     Triton_App := TR_CreateAppTags([
-                               TRCA_Name, AsTag('ToolManagerGUIDemo3'),
-                               TRCA_LongName, AsTag('ToolManager GUI demo 3'),
-                               TRCA_Info, AsTag('My own creation for a ToolManager GUI'),
+                               TRCA_Name,'ToolManagerGUIDemo3',
+                               TRCA_LongName,'ToolManager GUI demo 3',
+                               TRCA_Info,'My own creation for a ToolManager GUI',
                                TAG_END]);
 
     if Triton_App = nil then CleanUp('Can''t create application',20);

packages/amunits/examples/otherlibs/tritongadgets.pas

@@ -57,18 +57,14 @@ END;
 
 
 begin
-  if not Assigned(TritonBase) then
-  begin
-    writeln('cannot open ' + TRITONNAME);
-    Halt(5);
-  end;
+
     Triton_App := TR_CreateAppTags([
-                     TRCA_Name, AsTag('TritonGadtools'),
-                     TRCA_LongName, AsTag('GadToolsDemo in Triton'),
-                     TRCA_Version, AsTag('0.01'),
-                     TRCA_Info, AsTag('Just a test of Triton'),
-                     TRCA_Release, AsTag('1.0'),
-                     TRCA_Date, AsTag('26-05-1998'),
+                     TRCA_Name,'TritonGadtools',
+                     TRCA_LongName,'GadToolsDemo in Triton',
+                     TRCA_Version,'0.01',
+                     TRCA_Info,'Just a test of Triton',
+                     TRCA_Release,'1.0',
+                     TRCA_Date,'26-05-1998',
                      TAG_DONE]);
 
      if Triton_App = nil then CleanExit('Can''t create Application',20);
@@ -88,7 +84,7 @@ begin
                         Space;
                         SliderGadget(SLIDER_MIN,SLIDER_MAX,5,MYGAD_SLIDER);
                         Space;
-                        TextID(string('5'),MYGAD_SLIDERTEXT); SetTRTag(TRAT_MinWidth, 2);
+                        TextID('5',MYGAD_SLIDERTEXT); SetTRTag(TRAT_MinWidth, 2);
                         Space;
                     EndLine;
                     SpaceS;

packages/amunits/examples/otherlibs/writetruecolordata.pas

@@ -17,7 +17,7 @@ Program WriteTrueColorData;
     [email protected]
 }
 
-uses exec, amigados, intuition, agraphics, picasso96api, utility;
+uses exec, amigados, intuition, agraphics, picasso96api, utility,systemvartags;
 
 
 Const
@@ -65,11 +65,7 @@ begin
 end;
 
 Begin
-  if not Assigned(P96Base) then
-  begin
-    writeln('Cannot open ', PICASSO96APINAME);
-    Halt(5);
-  end;
+
  width:=640;
  height:=480;
  depth:=24;
@@ -95,8 +91,8 @@ Begin
                           P96SA_Height, height,
                           P96SA_Depth, depth,
                           P96SA_AutoScroll, lTRUE,
-                          P96SA_Pens, AsTag(@Pens),
-                          P96SA_Title, AsTag('WriteTrueColorData Test'),
+                          P96SA_Pens, @Pens,
+                          P96SA_Title, 'WriteTrueColorData Test',
                           TAG_DONE]);
 
 if sc = nil then CleanUp('Can''t open screen');
@@ -104,7 +100,7 @@ if sc = nil then CleanUp('Can''t open screen');
 
 
 
- win := OpenWindowTags(Nil,[WA_CustomScreen, AsTag(sc),
+ win := OpenWindowTags(Nil,[WA_CustomScreen, sc,
                             WA_Backdrop, lTRUE,
                             WA_Borderless, lTRUE,
                             WA_SimpleRefresh, lTRUE,

packages/amunits/examples/penshare.pas

@@ -32,7 +32,7 @@ Program PenShare;
   [email protected]
 }
 
-uses exec, agraphics, intuition, utility;
+uses exec, agraphics, intuition, utility,systemvartags;
 
 VAR RP : pRastPort;
     Win : pWindow;
@@ -58,7 +58,7 @@ Begin
 
   Win:=OpenWindowTags(nil,[WA_Width,150,
                         WA_Height,100,
-                        WA_Title,AsTag('PenShare'),
+                        WA_Title,'PenShare',
                         WA_Flags,WFLG_CLOSEGADGET+WFLG_DRAGBAR,
                         WA_IDCMP,IDCMP_CLOSEWINDOW,
                         TAG_END]);

packages/amunits/examples/snow.pas

@@ -23,7 +23,7 @@ takes a long time, and frankly doesn't look as good as level 5.  }
 }
 
 
-uses exec,intuition,agraphics,utility;
+uses exec,intuition,agraphics,utility,systemvartags;
 
 
 
@@ -114,10 +114,10 @@ begin
     nc := readcycles();
     initarrays;
 
-    s := OpenScreenTags(nil, [SA_Pens,   AsTag(@pens),
+    s := OpenScreenTags(nil, [SA_Pens,   @pens,
       SA_Depth,     2,
       SA_DisplayID, HIRES_KEY,
-      SA_Title,     AsTag('Simple Fractal SnowFlakes'),
+      SA_Title,     'Simple Fractal SnowFlakes',
       TAG_END]);
 
     if s = NIL then CleanUp('No screen',20);
@@ -134,8 +134,8 @@ begin
          WA_ReportMouse,  ltrue,
          WA_SmartRefresh, ltrue,
          WA_Activate,     ltrue,
-         WA_Title,        AsTag('Close the Window to Quit'),
-         WA_CustomScreen, AsTag(s),
+         WA_Title,        'Close the Window to Quit',
+         WA_CustomScreen, s,
          TAG_END]);
 
     if w = nil then CleanUp('No window',20);

packages/amunits/examples/sortdemo.pas

@@ -38,7 +38,7 @@ PROGRAM SortDemo;
     so you have to wait until it's finished.
 }
 
-uses Exec, Intuition, AGraphics, Utility, GadTools, amsgbox;
+uses Exec, Intuition, AGraphics, Utility, GadTools, amsgbox,systemvartags;
 
 
 CONST
@@ -192,16 +192,16 @@ PROCEDURE setpixel(i: Integer);
 BEGIN
   SetAPen(Rast,1);
   IF needles THEN BEGIN
-    GfxMove(Rast,i,range); Draw(Rast,i,Round((1-sort[i])*range));
+    Move(Rast,i,range); Draw(Rast,i,Round((1-sort[i])*range));
   END ELSE
-    WritePixel(Rast,i,Round((1-sort[i])*range))
+    IF WritePixel(Rast,i,Round((1-sort[i])*range))=0 THEN;
 END;
 
 PROCEDURE clearpixel(i: Integer);
 BEGIN
   SetAPen(Rast,0);
   IF needles THEN BEGIN
-    GfxMove(Rast,i,range); Draw(Rast,i,Round((1-sort[i])*range));
+    Move(Rast,i,range); Draw(Rast,i,Round((1-sort[i])*range));
   END ELSE
     IF WritePixel(Rast,i,Round((1-sort[i])*range))=0 THEN;
 END;
@@ -262,8 +262,7 @@ BEGIN
   range := w^.GZZHeight;
   settitles(-1);
   SetRast(Rast,0);    { clear screen }
-  FOR i := 1 TO num DO
-  BEGIN
+  FOR i := 1 TO num DO BEGIN
     IF rndom THEN sort[i] := Random  { produces 0..1 }
       ELSE sort[i] := (num-i)/num;
     setpixel(i);
@@ -500,7 +499,8 @@ begin
     if vi = nil then CleanUp('No visual info',10);
 
     w := OpenWindowTags(NIL, [
-                WA_IDCMP,         IDCMP_CLOSEWINDOW or IDCMP_MENUPICK or IDCMP_NEWSIZE,
+                WA_IDCMP,         IDCMP_CLOSEWINDOW or IDCMP_MENUPICK or
+IDCMP_NEWSIZE,
                 WA_Left,          0,
                 WA_Top,           s^.BarHeight+1,
                 WA_Width,         224,
@@ -516,14 +516,16 @@ begin
                 WA_Activate,      ltrue,
                 WA_SizeBRight,    ltrue,
                 WA_GimmeZeroZero, ltrue,
-                WA_PubScreen,     AsTag(s),
+                WA_PubScreen,     s,
                 TAG_END]);
+
     IF w=NIL THEN CleanUp('Could not open window',20);
 
     Rast := w^.RPort;
 
     { Here we set the barlabel }
     nm[3].nm_Label := PChar(NM_BARLABEL);
+
     if pExecBase(_ExecBase)^.LibNode.Lib_Version >= 39 then begin
         MenuStrip := CreateMenus(@nm,[
                      GTMN_FrontPen, 1, TAG_END]);
@@ -532,6 +534,7 @@ begin
     if MenuStrip = nil then CleanUp('Could not open Menus',10);
     if LayoutMenusA(MenuStrip,vi,NIL)=false then
         CleanUp('Could not layout Menus',10);
+
     if SetMenuStrip(w, MenuStrip) = false then
         CleanUp('Could not set the Menus',10);
 
@@ -620,16 +623,16 @@ end;
 
 
 begin
-  OpenEverything;
+   OpenEverything;
    QuitStopDie := False;
    modus := 0;
    needles := true;
    rndom := true;
    refresh;
    repeat
-     Msg := WaitPort(w^.UserPort);
-     Msg := GetMsg(w^.UserPort);
-     ProcessIDCMP;
+   Msg := WaitPort(w^.UserPort);
+   Msg := GetMsg(w^.UserPort);
+       ProcessIDCMP;
    until QuitStopDie;
    CleanUp('',0);
 end.

packages/amunits/examples/stars.pas

@@ -1,7 +1,7 @@
 PROGRAM Sterne;
 
 
-uses Exec, AGraphics, Intuition, Utility;
+uses Exec, AGraphics, Intuition, Utility, systemvartags;
 
 
 
@@ -115,7 +115,7 @@ BEGIN
   Win:=OpenWindowTags(Nil, [
                         WA_Flags, WFLG_BORDERLESS,
                         WA_IDCMP, IDCMP_MOUSEBUTTONS,
-                        WA_CustomScreen, AsTag(Scr),
+                        WA_CustomScreen, Scr,
                         TAG_DONE]);
 
   If Win=Nil Then CleanUp('No window',20);

packages/amunits/examples/talk2boopsi.pas

@@ -28,7 +28,7 @@ make them  }
 
 }
 
-uses Exec, Intuition, Utility,amsgbox;
+uses Exec, Intuition, Utility,amsgbox, systemvartags;
 
 
 
@@ -98,7 +98,7 @@ BEGIN
     GA_Left,     (w^.BorderLeft) + 5,
     GA_Width,    PROPGADGETWIDTH,
     GA_Height,   PROPGADGETHEIGHT,
-    ICA_MAP,     AsTag(@prop2intmap),
+    ICA_MAP,     @prop2intmap,
     PGA_Total,   TOTAL,
     PGA_Top,     INITIALVAL,
     PGA_Visible, VISIBLE,
@@ -108,24 +108,24 @@ BEGIN
     IF prop = NIL THEN CleanUp('No propgadget',20);
 
     int := NewObject(NIL, 'strgclass',[
-      GA_ID,      INTGADGET_ID,
-      GA_Top,     (w^.BorderTop) + 5,
-      GA_Left,    (w^.BorderLeft) + PROPGADGETWIDTH + 10,
-      GA_Width,   MINWINDOWWIDTH -
+    GA_ID,      INTGADGET_ID,
+    GA_Top,     (w^.BorderTop) + 5,
+    GA_Left,    (w^.BorderLeft) + PROPGADGETWIDTH + 10,
+    GA_Width,   MINWINDOWWIDTH -
                                   (w^.BorderLeft + w^.BorderRight +
                                   PROPGADGETWIDTH + 15),
-      GA_Height,  INTGADGETHEIGHT,
+    GA_Height,  INTGADGETHEIGHT,
 
-      ICA_MAP,    AsTag(@int2propmap),
-      ICA_TARGET, AsTag(prop),
-      GA_Previous,AsTag(prop),
+    ICA_MAP,    @int2propmap,
+    ICA_TARGET, prop,
+    GA_Previous, prop,
 
     STRINGA_LongVal,  INITIALVAL,
     STRINGA_MaxChars, MAXCHARS,
     TAG_END]);
 
     temp := SetGadgetAttrs(prop, w, NIL,[
-    ICA_TARGET, AsTag(int),
+    ICA_TARGET, int,
     TAG_END]);
 
     IF int = NIL THEN CleanUp('No INTEGER gadget',20);

packages/amunits/fpmake.pp

@@ -39,9 +39,11 @@ begin
     T:=P.Targets.AddUnit('vartags.pas');
     T:=P.Targets.AddUnit('pastoc.pas');
     T:=P.Targets.AddUnit('tagsarray.pas');
+    T:=P.Targets.AddUnit('systemvartags.pas');
     T:=P.Targets.AddUnit('deadkeys.pas');
     T:=P.Targets.AddUnit('consoleio.pas');
     T:=P.Targets.AddUnit('pcq.pas');
+    T:=P.Targets.AddUnit('longarray.pas');
     T:=P.Targets.AddUnit('linklist.pas');
     T:=P.Targets.AddUnit('hisoft.pas');
     T:=P.Targets.AddUnit('timerutils.pas');

packages/amunits/src/coreunits/amigados.pas

@@ -327,8 +327,8 @@ CONST
 
 {--------- String/Date structures etc }
 Type
-       _pDateTime = ^_tDateTime;
-       _tDateTime = record
+       pDateTime = ^tDateTime;
+       tDateTime = record
         dat_Stamp   : tDateStamp;      { DOS DateStamp }
         dat_Format,                    { controls appearance of dat_StrDate }
         dat_Flags   : Byte;           { see BITDEF's below }
@@ -1597,7 +1597,7 @@ FUNCTION CreateNewProcTagList(const tags : pTagItem location 'd1') : pProcess; s
 FUNCTION CreateProc(const name : pCHAR location 'd1'; pri : LONGINT location 'd2'; segList : BPTR location 'd3'; stackSize : LONGINT location 'd4') : pMsgPort; syscall _DOSBase 138;
 FUNCTION CurrentDir(lock : BPTR location 'd1') : BPTR; syscall _DOSBase 126;
 PROCEDURE DateStamp(date : pDateStamp location 'd1'); syscall _DOSBase 192;
-FUNCTION DOSDateToStr(datetime : _PDateTime location 'd1') : LongBool; syscall _DOSBase 744;
+FUNCTION DateToStr(datetime : pDateTime location 'd1') : LongBool; syscall _DOSBase 744;
 FUNCTION DOSDeleteFile(const name : pCHAR location 'd1') : LongBool; syscall _DOSBase 072;
 FUNCTION DeleteVar(const name : pCHAR location 'd1'; flags : ULONG location 'd2') : LongBool; syscall _DOSBase 912;
 FUNCTION DeviceProc(const name : pCHAR location 'd1') : pMsgPort; syscall _DOSBase 174;
@@ -1639,7 +1639,7 @@ FUNCTION FindSegment(const name : pCHAR location 'd1';const seg : pSegment locat
 FUNCTION FindVar(const name : pCHAR location 'd1'; type_ : ULONG location 'd2') : pLocalVar; syscall _DOSBase 918;
 FUNCTION Format(const filesystem : pCHAR location 'd1';const volumename : pCHAR location 'd2'; dostype : ULONG location 'd3') : LongBool; syscall _DOSBase 714;
 FUNCTION FPutC(fh : BPTR location 'd1'; ch : LONGINT location 'd2') : LONGINT; syscall _DOSBase 312;
-FUNCTION FPuts(fh : BPTR location 'd1';const str : pCHAR location 'd2') : LongInt; syscall _DOSBase 342;
+FUNCTION FPuts(fh : BPTR location 'd1';const str : pCHAR location 'd2') : LongBool; syscall _DOSBase 342;
 FUNCTION FRead(fh : BPTR location 'd1'; block : POINTER location 'd2'; blocklen : ULONG location 'd3'; number : ULONG location 'd4') : LONGINT; syscall _DOSBase 324;
 PROCEDURE FreeArgs(args : pRDArgs location 'd1'); syscall _DOSBase 858;
 PROCEDURE FreeDeviceProc(dp : pDevProc location 'd1'); syscall _DOSBase 648;
@@ -1720,7 +1720,7 @@ FUNCTION SetVar(const name : pCHAR location 'd1'; buffer : pCHAR location 'd2';
 FUNCTION SetVBuf(fh : BPTR location 'd1'; buff : pCHAR location 'd2'; type_ : LONGINT location 'd3'; size : LONGINT location 'd4') : LongBool; syscall _DOSBase 366;
 FUNCTION SplitName(const name : pCHAR location 'd1'; seperator : ULONG location 'd2'; buf : pCHAR location 'd3'; oldpos : LONGINT location 'd4'; size : LONGINT location 'd5') : smallint; syscall _DOSBase 414;
 FUNCTION StartNotify(notify : pNotifyRequest location 'd1') : LongBool; syscall _DOSBase 888;
-FUNCTION DOSStrToDate(datetime : _PDateTime location 'd1') : LongBool; syscall _DOSBase 750;
+FUNCTION StrToDate(datetime : pDateTime location 'd1') : LongBool; syscall _DOSBase 750;
 FUNCTION StrToLong(const string_ : pCHAR location 'd1'; VAR value : LONGINT location 'd2') : LONGINT; syscall _DOSBase 816;
 FUNCTION SystemTagList(const command : pCHAR location 'd1';const tags : pTagItem location 'd2') : LONGINT; syscall _DOSBase 606;
 FUNCTION DOSSystem(const command : pCHAR location 'd1';const tags : pTagItem location 'd2') : LONGINT; syscall _DOSBase 606;
@@ -1730,9 +1730,9 @@ PROCEDURE UnLock(lock : BPTR location 'd1'); syscall _DOSBase 090;
 PROCEDURE UnLockDosList(flags : ULONG location 'd1'); syscall _DOSBase 660;
 FUNCTION UnLockRecord(fh : BPTR location 'd1'; offset : ULONG location 'd2'; length : ULONG location 'd3') : LongBool; syscall _DOSBase 282;
 FUNCTION UnLockRecords(recArray : pRecordLock location 'd1') : LongBool; syscall _DOSBase 288;
-FUNCTION VFPrintf(fh : BPTR location 'd1';const format : pCHAR location 'd2';const argarray : PLongInt location 'd3') : LONGINT; syscall _DOSBase 354;
+FUNCTION VFPrintf(fh : BPTR location 'd1';const format : pCHAR location 'd2';const argarray : POINTER location 'd3') : LONGINT; syscall _DOSBase 354;
 PROCEDURE VFWritef(fh : BPTR location 'd1';const format : pCHAR location 'd2';const argarray : pLONGINT location 'd3'); syscall _DOSBase 348;
-FUNCTION VPrintf(const format : pCHAR location 'd1'; const argarray : PLongInt location 'd2') : LONGINT; syscall _DOSBase 954;
+FUNCTION VPrintf(const format : pCHAR location 'd1'; const argarray : POINTER location 'd2') : LONGINT; syscall _DOSBase 954;
 FUNCTION WaitForChar(file_ : BPTR location 'd1'; timeout : LONGINT location 'd2') : LongBool; syscall _DOSBase 204;
 FUNCTION WaitPkt : pDosPacket; syscall _DOSBase 252;
 FUNCTION WriteChars(const buf : pCHAR location 'd1'; buflen : ULONG location 'd2') : LONGINT; syscall _DOSBase 942;
@@ -1740,12 +1740,6 @@ FUNCTION WriteChars(const buf : pCHAR location 'd1'; buflen : ULONG location 'd2
 FUNCTION BADDR(bval :BPTR): POINTER;
 FUNCTION MKBADDR(adr: Pointer): BPTR;
 
-// var args version
-FUNCTION AllocDosObjectTags(type_ : ULONG; Const argv : Array of PtrUInt) : POINTER;
-FUNCTION CreateNewProcTags(Const argv : Array of PtrUInt) : pProcess;
-FUNCTION NewLoadSegTags(file_ : pCHAR; Const argv : Array of PtrUInt) : LONGINT;
-FUNCTION SystemTags(command : pCHAR; Const argv : Array of PtrUInt) : LONGINT;
-
 { overlay function and procedures}
 
 FUNCTION AddBuffers(const name : string; number : LONGINT) : BOOLEAN;
@@ -1778,7 +1772,7 @@ FUNCTION FindVar(const name : string; type_ : ULONG) : pLocalVar;
 FUNCTION Format(const filesystem : string;const volumename : pCHAR; dostype : ULONG) : BOOLEAN;
 FUNCTION Format(const filesystem : pCHAR;const volumename : string; dostype : ULONG) : BOOLEAN;
 FUNCTION Format(const filesystem : string;const volumename : string; dostype : ULONG) : BOOLEAN;
-FUNCTION FPuts(fh : LONGINT;const str : string) : LongInt;
+FUNCTION FPuts(fh : LONGINT;const str : string) : BOOLEAN;
 FUNCTION GetDeviceProc(const name : string; dp : pDevProc) : pDevProc;
 FUNCTION GetVar(const name : string; buffer : pCHAR; size : LONGINT; flags : LONGINT) : LONGINT;
 FUNCTION Inhibit(const name : string; onoff : LONGINT) : BOOLEAN;
@@ -1830,26 +1824,6 @@ BEGIN
     MKBADDR := BPTR( LONGINT(adr) shr 2);
 END;
 
-FUNCTION AllocDosObjectTags(type_ : ULONG; Const argv : Array of PtrUInt) : POINTER;
-begin
-     AllocDosObjectTags := AllocDosObjectTagList(type_, @argv);
-end;
-
-FUNCTION CreateNewProcTags(Const argv : Array of PtrUInt) : pProcess;
-begin
-     CreateNewProcTags := CreateNewProcTagList(@argv);
-end;
-
-FUNCTION NewLoadSegTags(file_ : pCHAR; Const argv : Array of PtrUInt) : LONGINT;
-begin
-     NewLoadSegTags := NewLoadSegTagList(file_, @argv);
-end;
-
-FUNCTION SystemTags(command : pCHAR; Const argv : Array of PtrUInt) : LONGINT;
-begin
-     SystemTags := SystemTagList(command, @argv);
-end;
-
 FUNCTION AddBuffers(const name : string; number : LONGINT) : BOOLEAN;
 begin
      AddBuffers := AddBuffers(PChar(RawByteString(name)), number);
@@ -2000,7 +1974,7 @@ begin
     Format := Format(PChar(RawByteString(filesystem)),PChar(RawByteString(volumename)),dostype);
 end;
 
-FUNCTION FPuts(fh : LONGINT;const str : string) : LongInt;
+FUNCTION FPuts(fh : LONGINT;const str : string) : BOOLEAN;
 begin
     FPuts := FPuts(fh,PChar(RawByteString(str)));
 end;

packages/amunits/src/coreunits/amigalib.pas

@@ -100,8 +100,6 @@ function DoSuperMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong;
 function CoerceMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong;
 function SetSuperAttrsA(cl : pIClass; obj: pObject_; msg : APTR): ulong;
 
-function DoMethod(obj: PObject_; Params: array of DWord): LongWord; inline;
-
 procedure HookEntry;
 
 {
@@ -362,17 +360,15 @@ begin
 end;
 
 function DoMethodA(obj : pObject_; msg : APTR): ulong;
+var
+    o : p_Object;
 begin
     if assigned(obj) then begin
-       DoMethodA := CallHookPkt(@THook(OCLASS(obj)^.cl_Dispatcher), obj, msg);
+       o := p_Object(obj);
+       DoMethodA := CallHookPkt(@o^.o_Class^.cl_Dispatcher, obj,msg);
     end else DoMethodA := 0;
 end;
 
-function DoMethod(obj: PObject_; Params: array of DWord): LongWord;
-begin
-  DoMethod := DoMethodA(obj, @Params);
-end;
-
 function DoSuperMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong;
 begin
     if assigned(obj) and assigned(cl) then

packages/amunits/src/coreunits/expansion.pas

@@ -31,6 +31,11 @@
     [email protected] Nils Sjoholm
 }
 
+{$I useamigasmartlink.inc}
+{$ifdef use_amiga_smartlink}
+   {$smartlink on}
+{$endif use_amiga_smartlink}
+
 UNIT expansion;
 
 INTERFACE
@@ -44,43 +49,389 @@ Const
 
     ADNF_STARTPROC      = 1;
 
-VAR ExpansionBase : pLibrary = nil;
-
-
-FUNCTION AddBootNode(bootPri : LONGINT location 'd0'; flags : ULONG location 'd1'; deviceNode : pDeviceNode location 'a0'; configDev : pConfigDev location 'a1') : wordbool; syscall ExpansionBase 036;
-PROCEDURE AddConfigDev(configDev : pConfigDev location 'a0'); syscall ExpansionBase 030;
-FUNCTION AddDosNode(bootPri : LONGINT location 'd0'; flags : ULONG location 'd1'; deviceNode : pDeviceNode location 'a0') : wordbool; syscall ExpansionBase 150;
-PROCEDURE AllocBoardMem(slotSpec : ULONG location 'd0'); syscall ExpansionBase 042;
-FUNCTION AllocConfigDev : pConfigDev; syscall ExpansionBase 048;
-FUNCTION AllocExpansionMem(numSlots : ULONG location 'd0'; slotAlign : ULONG location 'd1') : POINTER; syscall ExpansionBase 054;
-PROCEDURE ConfigBoard(board : POINTER location 'a0'; configDev : pConfigDev location 'a1'); syscall ExpansionBase 060;
-PROCEDURE ConfigChain(baseAddr : POINTER location 'a0'); syscall ExpansionBase 066;
-FUNCTION FindConfigDev(const oldConfigDev : pConfigDev location 'a0'; manufacturer : LONGINT location 'd0'; product : LONGINT location 'd1') : pConfigDev; syscall ExpansionBase 072;
-PROCEDURE FreeBoardMem(startSlot : ULONG location 'd0'; slotSpec : ULONG location 'd1'); syscall ExpansionBase 078;
-PROCEDURE FreeConfigDev(configDev : pConfigDev location 'a0'); syscall ExpansionBase 084;
-PROCEDURE FreeExpansionMem(startSlot : ULONG location 'd0'; numSlots : ULONG location 'd1'); syscall ExpansionBase 090;
-FUNCTION GetCurrentBinding(const currentBinding : pCurrentBinding location 'a0'; bindingSize : ULONG location 'd0') : ULONG; syscall ExpansionBase 138;
-FUNCTION MakeDosNode(const parmPacket : POINTER location 'a0') : pDeviceNode; syscall ExpansionBase 144;
-PROCEDURE ObtainConfigBinding; syscall ExpansionBase 120;
-FUNCTION ReadExpansionByte(const board : POINTER location 'a0'; offset : ULONG location 'd0') : BYTE; syscall ExpansionBase 096;
-PROCEDURE ReadExpansionRom(const board : POINTER location 'a0'; configDev : pConfigDev location 'a1'); syscall ExpansionBase 102;
-PROCEDURE ReleaseConfigBinding; syscall ExpansionBase 126;
-PROCEDURE RemConfigDev(configDev : pConfigDev location 'a0'); syscall ExpansionBase 108;
-PROCEDURE SetCurrentBinding(currentBinding : pCurrentBinding location 'a0'; bindingSize : ULONG location 'd0'); syscall ExpansionBase 132;
-PROCEDURE WriteExpansionByte(board : POINTER location 'a0'; offset : ULONG location 'd0'; byte : ULONG location 'd1'); syscall ExpansionBase 114;
+VAR ExpansionBase : pLibrary;
+
+FUNCTION AddBootNode(bootPri : LONGINT; flags : ULONG; deviceNode : pDeviceNode; configDev : pConfigDev) : BOOLEAN;
+PROCEDURE AddConfigDev(configDev : pConfigDev);
+FUNCTION AddDosNode(bootPri : LONGINT; flags : ULONG; deviceNode : pDeviceNode) : BOOLEAN;
+PROCEDURE AllocBoardMem(slotSpec : ULONG);
+FUNCTION AllocConfigDev : pConfigDev;
+FUNCTION AllocExpansionMem(numSlots : ULONG; slotAlign : ULONG) : POINTER;
+PROCEDURE ConfigBoard(board : POINTER; configDev : pConfigDev);
+PROCEDURE ConfigChain(baseAddr : POINTER);
+FUNCTION FindConfigDev(const oldConfigDev : pConfigDev; manufacturer : LONGINT; product : LONGINT) : pConfigDev;
+PROCEDURE FreeBoardMem(startSlot : ULONG; slotSpec : ULONG);
+PROCEDURE FreeConfigDev(configDev : pConfigDev);
+PROCEDURE FreeExpansionMem(startSlot : ULONG; numSlots : ULONG);
+FUNCTION GetCurrentBinding(const currentBinding : pCurrentBinding; bindingSize : ULONG) : ULONG;
+FUNCTION MakeDosNode(const parmPacket : POINTER) : pDeviceNode;
+PROCEDURE ObtainConfigBinding;
+FUNCTION ReadExpansionByte(const board : POINTER; offset : ULONG) : BYTE;
+PROCEDURE ReadExpansionRom(const board : POINTER; configDev : pConfigDev);
+PROCEDURE ReleaseConfigBinding;
+PROCEDURE RemConfigDev(configDev : pConfigDev);
+PROCEDURE SetCurrentBinding(currentBinding : pCurrentBinding; bindingSize : ULONG);
+PROCEDURE WriteExpansionByte(board : POINTER; offset : ULONG; byte : ULONG);
+
+{Here we read how to compile this unit}
+{You can remove this include and use a define instead}
+{$I useautoopenlib.inc}
+{$ifdef use_init_openlib}
+procedure InitEXPANSIONLibrary;
+{$endif use_init_openlib}
+
+{This is a variable that knows how the unit is compiled}
+var
+    EXPANSIONIsCompiledHow : longint;
 
 IMPLEMENTATION
 
+uses
+{$ifndef dont_use_openlib}
+amsgbox;
+{$endif dont_use_openlib}
+
+FUNCTION AddBootNode(bootPri : LONGINT; flags : ULONG; deviceNode : pDeviceNode; configDev : pConfigDev) : BOOLEAN;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVE.L  bootPri,D0
+    MOVE.L  flags,D1
+    MOVEA.L deviceNode,A0
+    MOVEA.L configDev,A1
+    MOVEA.L ExpansionBase,A6
+    JSR -036(A6)
+    MOVEA.L (A7)+,A6
+    TST.W   D0
+    BEQ.B   @end
+    MOVEQ   #1,D0
+  @end: MOVE.B  D0,@RESULT
+  END;
+END;
+
+PROCEDURE AddConfigDev(configDev : pConfigDev);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L configDev,A0
+    MOVEA.L ExpansionBase,A6
+    JSR -030(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION AddDosNode(bootPri : LONGINT; flags : ULONG; deviceNode : pDeviceNode) : BOOLEAN;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVE.L  bootPri,D0
+    MOVE.L  flags,D1
+    MOVEA.L deviceNode,A0
+    MOVEA.L ExpansionBase,A6
+    JSR -150(A6)
+    MOVEA.L (A7)+,A6
+    TST.W   D0
+    BEQ.B   @end
+    MOVEQ   #1,D0
+  @end: MOVE.B  D0,@RESULT
+  END;
+END;
+
+PROCEDURE AllocBoardMem(slotSpec : ULONG);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVE.L  slotSpec,D0
+    MOVEA.L ExpansionBase,A6
+    JSR -042(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION AllocConfigDev : pConfigDev;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L ExpansionBase,A6
+    JSR -048(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION AllocExpansionMem(numSlots : ULONG; slotAlign : ULONG) : POINTER;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVE.L  numSlots,D0
+    MOVE.L  slotAlign,D1
+    MOVEA.L ExpansionBase,A6
+    JSR -054(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE ConfigBoard(board : POINTER; configDev : pConfigDev);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L board,A0
+    MOVEA.L configDev,A1
+    MOVEA.L ExpansionBase,A6
+    JSR -060(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE ConfigChain(baseAddr : POINTER);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L baseAddr,A0
+    MOVEA.L ExpansionBase,A6
+    JSR -066(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION FindConfigDev(const oldConfigDev : pConfigDev; manufacturer : LONGINT; product : LONGINT) : pConfigDev;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L oldConfigDev,A0
+    MOVE.L  manufacturer,D0
+    MOVE.L  product,D1
+    MOVEA.L ExpansionBase,A6
+    JSR -072(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE FreeBoardMem(startSlot : ULONG; slotSpec : ULONG);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVE.L  startSlot,D0
+    MOVE.L  slotSpec,D1
+    MOVEA.L ExpansionBase,A6
+    JSR -078(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE FreeConfigDev(configDev : pConfigDev);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L configDev,A0
+    MOVEA.L ExpansionBase,A6
+    JSR -084(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE FreeExpansionMem(startSlot : ULONG; numSlots : ULONG);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVE.L  startSlot,D0
+    MOVE.L  numSlots,D1
+    MOVEA.L ExpansionBase,A6
+    JSR -090(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION GetCurrentBinding(const currentBinding : pCurrentBinding; bindingSize : ULONG) : ULONG;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L currentBinding,A0
+    MOVE.L  bindingSize,D0
+    MOVEA.L ExpansionBase,A6
+    JSR -138(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION MakeDosNode(const parmPacket : POINTER) : pDeviceNode;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L parmPacket,A0
+    MOVEA.L ExpansionBase,A6
+    JSR -144(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE ObtainConfigBinding;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L ExpansionBase,A6
+    JSR -120(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION ReadExpansionByte(const board : POINTER; offset : ULONG) : BYTE;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L board,A0
+    MOVE.L  offset,D0
+    MOVEA.L ExpansionBase,A6
+    JSR -096(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE ReadExpansionRom(const board : POINTER; configDev : pConfigDev);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L board,A0
+    MOVEA.L configDev,A1
+    MOVEA.L ExpansionBase,A6
+    JSR -102(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE ReleaseConfigBinding;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L ExpansionBase,A6
+    JSR -126(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE RemConfigDev(configDev : pConfigDev);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L configDev,A0
+    MOVEA.L ExpansionBase,A6
+    JSR -108(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE SetCurrentBinding(currentBinding : pCurrentBinding; bindingSize : ULONG);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L currentBinding,A0
+    MOVE.L  bindingSize,D0
+    MOVEA.L ExpansionBase,A6
+    JSR -132(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE WriteExpansionByte(board : POINTER; offset : ULONG; byte : ULONG);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L board,A0
+    MOVE.L  offset,D0
+    MOVE.L  byte,D1
+    MOVEA.L ExpansionBase,A6
+    JSR -114(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
 const
     { Change VERSION and LIBVERSION to proper values }
+
     VERSION : string[2] = '0';
     LIBVERSION : longword = 0;
 
-initialization
-  ExpansionBase := OpenLibrary(EXPANSIONNAME,LIBVERSION);
-finalization
-  if Assigned(ExpansionBase) then
-    CloseLibrary(ExpansionBase);
+{$ifdef use_init_openlib}
+  {$Info Compiling initopening of expansion.library}
+  {$Info don't forget to use InitEXPANSIONLibrary in the beginning of your program}
+
+var
+    expansion_exit : Pointer;
+
+procedure CloseexpansionLibrary;
+begin
+    ExitProc := expansion_exit;
+    if ExpansionBase <> nil then begin
+        CloseLibrary(ExpansionBase);
+        ExpansionBase := nil;
+    end;
+end;
+
+procedure InitEXPANSIONLibrary;
+begin
+    ExpansionBase := nil;
+    ExpansionBase := OpenLibrary(EXPANSIONNAME,LIBVERSION);
+    if ExpansionBase <> nil then begin
+        expansion_exit := ExitProc;
+        ExitProc := @CloseexpansionLibrary;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open expansion.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+end;
+
+begin
+    EXPANSIONIsCompiledHow := 2;
+{$endif use_init_openlib}
+
+{$ifdef use_auto_openlib}
+  {$Info Compiling autoopening of expansion.library}
+
+var
+    expansion_exit : Pointer;
+
+procedure CloseexpansionLibrary;
+begin
+    ExitProc := expansion_exit;
+    if ExpansionBase <> nil then begin
+        CloseLibrary(ExpansionBase);
+        ExpansionBase := nil;
+    end;
+end;
+
+begin
+    ExpansionBase := nil;
+    ExpansionBase := OpenLibrary(EXPANSIONNAME,LIBVERSION);
+    if ExpansionBase <> nil then begin
+        expansion_exit := ExitProc;
+        ExitProc := @CloseexpansionLibrary;
+        EXPANSIONIsCompiledHow := 1;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open expansion.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+
+{$endif use_auto_openlib}
+
+{$ifdef dont_use_openlib}
+begin
+    EXPANSIONIsCompiledHow := 3;
+   {$Warning No autoopening of expansion.library compiled}
+   {$Warning Make sure you open expansion.library yourself}
+{$endif dont_use_openlib}
+
+
 END. (* UNIT EXPANSION *)
 
 

packages/amunits/src/coreunits/gadtools.pas

@@ -465,7 +465,7 @@ Type
 
 
 VAR
-    GadToolsBase : pLibrary = nil;
+    GadToolsBase : pLibrary;
 
 FUNCTION CreateContext(glistptr : pGadget location 'a0'): pGadget; syscall GadToolsBase 114;
 FUNCTION CreateGadgetA(kind : ULONG location 'd0'; gad : pGadget location 'a0'; const ng : pNewGadget location 'a1'; const taglist : pTagItem location 'a2') : pGadget; syscall GadToolsBase 030;
@@ -487,80 +487,119 @@ PROCEDURE GT_SetGadgetAttrsA(gad : pGadget location 'a0'; win : pWindow location
 FUNCTION LayoutMenuItemsA(firstitem : pMenuItem location 'a0'; vi : POINTER location 'a1'; const taglist : pTagItem location 'a2') : LongBool; syscall GadToolsBase 060;
 FUNCTION LayoutMenusA(firstmenu : pMenu location 'a0'; vi : POINTER location 'a1'; const taglist : pTagItem location 'a2') : LongBool; syscall GadToolsBase 066;
 
-function CreateGadget(kind : ULONG; gad : pGadget; ng : pNewGadget; Const argv : array of PtrUInt) : pGadget;
-function CreateMenus(newmenu : pNewMenu; Const argv : array of PtrUInt) : pMenu;
-procedure DrawBevelBox(rport : pRastPort; left : LONGINT; top : LONGINT; width : LONGINT; height : LONGINT; Const argv : array of PtrUInt);
-function GetVisualInfo(screen : pScreen; Const argv : array of PtrUInt) : POINTER;
-function GT_GetGadgetAttrs(gad : pGadget; win : pWindow; req : pRequester; Const argv : array of PtrUInt) : LONGINT;
-procedure GT_SetGadgetAttrs(gad : pGadget; win : pWindow; req : pRequester; Const argv : array of PtrUInt);
-function LayoutMenuItems(firstitem : pMenuItem; vi : POINTER; Const argv : array of PtrUInt) : BOOLEAN;
-function LayoutMenus(firstmenu : pMenu; vi : POINTER; Const argv : array of PtrUInt) : BOOLEAN;
-
 function GTMENUITEM_USERDATA(menuitem : pMenuItem): pointer;
 function GTMENU_USERDATA(menu : pMenu): pointer;
 
+{Here we read how to compile this unit}
+{You can remove this include and use a define instead}
+{$I useautoopenlib.inc}
+{$ifdef use_init_openlib}
+procedure InitGADTOOLSLibrary;
+{$endif use_init_openlib}
+
+{This is a variable that knows how the unit is compiled}
+var
+    GADTOOLSIsCompiledHow : longint;
+
 IMPLEMENTATION
 
-function CreateGadget(kind : ULONG; gad : pGadget; ng : pNewGadget; Const argv : array of PtrUInt) : pGadget;
-begin
-    CreateGadget := CreateGadgetA(kind,gad,ng,@argv);
-end;
+uses
+{$ifndef dont_use_openlib}
+amsgbox;
+{$endif dont_use_openlib}
 
-function CreateMenus(newmenu : pNewMenu; Const argv : array of PtrUInt) : pMenu;
+function GTMENUITEM_USERDATA(menuitem : pMenuItem): pointer;
 begin
-    CreateMenus := CreateMenusA(newmenu,@argv);
+    GTMENUITEM_USERDATA := pointer((pMenuItem(menuitem)+1));
 end;
 
-procedure DrawBevelBox(rport : pRastPort; left : LONGINT; top : LONGINT; width : LONGINT; height : LONGINT; Const argv : array of PtrUInt);
+function GTMENU_USERDATA(menu : pMenu): pointer;
 begin
-    DrawBevelBoxA(rport,left,top,width,height,@argv);
+    GTMENU_USERDATA := pointer((pMenu(menu)+1));
 end;
 
-function GetVisualInfo(screen : pScreen; Const argv : array of PtrUInt) : POINTER;
-begin
-    GetVisualInfo := GetVisualInfoA(screen,@argv);
-end;
+const
+    { Change VERSION and LIBVERSION to proper values }
 
-function GT_GetGadgetAttrs(gad : pGadget; win : pWindow; req : pRequester; Const argv : array of PtrUInt) : LONGINT;
-begin
-    GT_GetGadgetAttrs := GT_GetGadgetAttrsA(gad,win,req,@argv);
-end;
+    VERSION : string[2] = '0';
+    LIBVERSION : longword = 0;
+
+{$ifdef use_init_openlib}
+  {$Info Compiling initopening of gadtools.library}
+  {$Info don't forget to use InitGADTOOLSLibrary in the beginning of your program}
 
-procedure GT_SetGadgetAttrs(gad : pGadget; win : pWindow; req : pRequester; Const argv : array of PtrUInt);
+var
+    gadtools_exit : Pointer;
+
+procedure ClosegadtoolsLibrary;
 begin
-    GT_SetGadgetAttrsA(gad,win,req,@argv);
+    ExitProc := gadtools_exit;
+    if GadToolsBase <> nil then begin
+        CloseLibrary(GadToolsBase);
+        GadToolsBase := nil;
+    end;
 end;
 
-function LayoutMenuItems(firstitem : pMenuItem; vi : POINTER; Const argv : array of PtrUInt) : BOOLEAN;
+procedure InitGADTOOLSLibrary;
 begin
-    LayoutMenuItems := LayoutMenuItemsA(firstitem,vi,@argv);
+    GadToolsBase := nil;
+    GadToolsBase := OpenLibrary(GADTOOLSNAME,LIBVERSION);
+    if GadToolsBase <> nil then begin
+        gadtools_exit := ExitProc;
+        ExitProc := @ClosegadtoolsLibrary;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open gadtools.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
 end;
 
-function LayoutMenus(firstmenu : pMenu; vi : POINTER; Const argv : array of PtrUInt) : BOOLEAN;
 begin
-    LayoutMenus := LayoutMenusA(firstmenu,vi,@argv);
-end;
+    GADTOOLSIsCompiledHow := 2;
+{$endif use_init_openlib}
 
-function GTMENUITEM_USERDATA(menuitem : pMenuItem): pointer;
+{$ifdef use_auto_openlib}
+  {$Info Compiling autoopening of gadtools.library}
+
+var
+    gadtools_exit : Pointer;
+
+procedure ClosegadtoolsLibrary;
 begin
-    GTMENUITEM_USERDATA := pointer((pMenuItem(menuitem)+1));
+    ExitProc := gadtools_exit;
+    if GadToolsBase <> nil then begin
+        CloseLibrary(GadToolsBase);
+        GadToolsBase := nil;
+    end;
 end;
 
-function GTMENU_USERDATA(menu : pMenu): pointer;
 begin
-    GTMENU_USERDATA := pointer((pMenu(menu)+1));
-end;
+    GadToolsBase := nil;
+    GadToolsBase := OpenLibrary(GADTOOLSNAME,LIBVERSION);
+    if GadToolsBase <> nil then begin
+        gadtools_exit := ExitProc;
+        ExitProc := @ClosegadtoolsLibrary;
+        GADTOOLSIsCompiledHow := 1;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open gadtools.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+
+{$endif use_auto_openlib}
+
+{$ifdef dont_use_openlib}
+begin
+    GADTOOLSIsCompiledHow := 3;
+   {$Warning No autoopening of gadtools.library compiled}
+   {$Warning Make sure you open gadtools.library yourself}
+{$endif dont_use_openlib}
 
-const
-    { Change VERSION and LIBVERSION to proper values }
-    VERSION : string[2] = '0';
-    LIBVERSION : longword = 0;
 
-initialization
-  GadToolsBase := OpenLibrary(GADTOOLSNAME,LIBVERSION);
-finalization
-  if Assigned(GadToolsBase) then
-    CloseLibrary(GadToolsBase);
 END. (* UNIT GADTOOLS *)
 
 

packages/amunits/src/coreunits/icon.pas

@@ -346,7 +346,7 @@ Const
 
     ICONNAME    : PChar = 'icon.library';
 
-VAR IconBase : pLibrary = nil;
+VAR IconBase : pLibrary;
 
 FUNCTION AddFreeList(freelist : pFreeList location 'a0'; const mem : POINTER location 'a1'; size : ULONG location 'a2') : LongBool; syscall IconBase 072;
 FUNCTION BumpRevision(newname : pCHAR location 'a0'; const oldname : pCHAR location 'a1') : pCHAR; syscall IconBase 108;
@@ -373,96 +373,198 @@ FUNCTION LayoutIconA(icon : pDiskObject location 'a0'; screen : pScreen location
 PROCEDURE ChangeToSelectedIconColor(cr : pColorRegister location 'a0'); syscall IconBase 198;
 
 { overlay }
-FUNCTION BumpRevision(newname : pCHar; const oldname : RawByteString) : pCHAR;
-FUNCTION DeleteDiskObject(const name : RawByteString) : BOOLEAN;
-FUNCTION FindToolType(const toolTypeArray : POINTER;const typeName : RawByteString) : pCHAR;
-FUNCTION GetDiskObject(const name : RawByteString) : pDiskObject;
-FUNCTION GetDiskObjectNew(const name : RawByteString) : pDiskObject;
-FUNCTION MatchToolValue(const typeString : RawByteString;const value : pCHAR) : BOOLEAN;
-FUNCTION MatchToolValue(const typeString : pCHAR;const value : RawByteString) : BOOLEAN;
-FUNCTION MatchToolValue(const typeString : RawByteString;const value : RawByteString) : BOOLEAN;
-FUNCTION PutDiskObject(const name : RawByteString;const diskobj : pDiskObject) : BOOLEAN;
+FUNCTION BumpRevision(newname : string;const oldname : pCHAR) : pCHAR;
+FUNCTION BumpRevision(newname : pCHar;const oldname : string) : pCHAR;
+FUNCTION BumpRevision(newname : string;const oldname : string) : pCHAR;
+FUNCTION DeleteDiskObject(const name : string) : BOOLEAN;
+FUNCTION FindToolType(const toolTypeArray : POINTER;const typeName : string) : pCHAR;
+FUNCTION GetDiskObject(const name : string) : pDiskObject;
+FUNCTION GetDiskObjectNew(const name : string) : pDiskObject;
+FUNCTION MatchToolValue(const typeString :string;const value : pCHAR) : BOOLEAN;
+FUNCTION MatchToolValue(const typeString : pCHAR;const value : string) : BOOLEAN;
+FUNCTION MatchToolValue(const typeString : string;const value : string) : BOOLEAN;
+FUNCTION PutDiskObject(const name : string;const diskobj : pDiskObject) : BOOLEAN;
 
 { version 44 overlay}
-FUNCTION GetIconTagList(CONST name : RawByteString; CONST tags : pTagItem) : pDiskObject;
-FUNCTION PutIconTagList(CONST name : RawByteString; CONST icon : pDiskObject; CONST tags : pTagItem) : BOOLEAN;
+FUNCTION GetIconTagList(CONST name : string; CONST tags : pTagItem) : pDiskObject;
+FUNCTION PutIconTagList(CONST name : string; CONST icon : pDiskObject; CONST tags : pTagItem) : BOOLEAN;
 
 {macros}
 function PACK_ICON_ASPECT_RATIO(num,den : longint) : longint;
 
+
+{Here we read how to compile this unit}
+{You can remove this include and use a define instead}
+{$I useautoopenlib.inc}
+{$ifdef use_init_openlib}
+procedure InitICONLibrary;
+{$endif use_init_openlib}
+
+{This is a variable that knows how the unit is compiled}
+var
+    ICONIsCompiledHow : longint;
+
 IMPLEMENTATION
 
+uses
+{$ifndef dont_use_openlib}
+amsgbox,
+{$endif dont_use_openlib}
+pastoc;
+
 function PACK_ICON_ASPECT_RATIO(num,den : longint) : longint;
 begin
     PACK_ICON_ASPECT_RATIO:=(num shl 4) or den;
 end;
 
 
-FUNCTION BumpRevision(newname : pCHar;const oldname : RawByteString) : pCHAR;
+FUNCTION BumpRevision(newname : string;const oldname : pCHAR) : pCHAR;
 begin
-      BumpRevision := BumpRevision(newname,PChar(oldname));
+      BumpRevision := BumpRevision(pas2c(newname),oldname);
 end;
 
-FUNCTION DeleteDiskObject(const name : RawByteString) : BOOLEAN;
+FUNCTION BumpRevision(newname : pCHar;const oldname : string) : pCHAR;
 begin
-      DeleteDiskObject := DeleteDiskObject(PChar(name));
+      BumpRevision := BumpRevision(newname,pas2c(oldname));
 end;
 
-FUNCTION FindToolType(const toolTypeArray : POINTER;const typeName : RawByteString) : pCHAR;
+FUNCTION BumpRevision(newname : string;const oldname : string) : pCHAR;
 begin
-      FindToolType := FindToolType(toolTypeArray,PChar(typeName));
+      BumpRevision := BumpRevision(pas2c(newname),pas2c(oldname));
 end;
 
-FUNCTION GetDiskObject(const name : RawByteString) : pDiskObject;
+FUNCTION DeleteDiskObject(const name : string) : BOOLEAN;
 begin
-      GetDiskObject := GetDiskObject(PChar(name));
+      DeleteDiskObject := DeleteDiskObject(pas2c(name));
 end;
 
-FUNCTION GetDiskObjectNew(const name : RawByteString) : pDiskObject;
+FUNCTION FindToolType(const toolTypeArray : POINTER;const typeName : string) : pCHAR;
 begin
-      GetDiskObjectNew := GetDiskObjectNew(PChar(name));
+      FindToolType := FindToolType(toolTypeArray,pas2c(typeName));
 end;
 
-FUNCTION MatchToolValue(const typeString : RawByteString;const value : pCHAR) : BOOLEAN;
+FUNCTION GetDiskObject(const name : string) : pDiskObject;
 begin
-       MatchToolValue := MatchToolValue(PChar(typeString),value);
+      GetDiskObject := GetDiskObject(pas2c(name));
 end;
 
-FUNCTION MatchToolValue(const typeString : pCHAR;const value : RawByteString) : BOOLEAN;
+FUNCTION GetDiskObjectNew(const name : string) : pDiskObject;
 begin
-       MatchToolValue := MatchToolValue(typeString,PChar(value));
+      GetDiskObjectNew := GetDiskObjectNew(pas2c(name));
 end;
 
-FUNCTION MatchToolValue(const typeString : RawByteString;const value : RawByteString) : BOOLEAN;
+FUNCTION MatchToolValue(const typeString : string;const value : pCHAR) : BOOLEAN;
 begin
-       MatchToolValue := MatchToolValue(PChar(typeString),PChar(value));
+       MatchToolValue := MatchToolValue(pas2c(typeString),value);
 end;
 
-FUNCTION PutDiskObject(const name : RawByteString;const diskobj : pDiskObject) : BOOLEAN;
+FUNCTION MatchToolValue(const typeString : pCHAR;const value : string) : BOOLEAN;
 begin
-       PutDiskObject := PutDiskObject(PChar(name),diskobj);
+       MatchToolValue := MatchToolValue(typeString,pas2c(value));
 end;
 
-FUNCTION GetIconTagList(CONST name : RawByteString; CONST tags : pTagItem) : pDiskObject;
+FUNCTION MatchToolValue(const typeString : string;const value : string) : BOOLEAN;
 begin
-       GetIconTagList := GetIconTagList(PChar(name),tags);
+       MatchToolValue := MatchToolValue(pas2c(typeString),pas2c(value));
 end;
 
-FUNCTION PutIconTagList(CONST name : RawByteString; CONST icon : pDiskObject; CONST tags : pTagItem) : BOOLEAN;
+FUNCTION PutDiskObject(const name : string;const diskobj : pDiskObject) : BOOLEAN;
 begin
-       PutIconTagList := PutIconTagList(PChar(name),icon,tags);
+       PutDiskObject := PutDiskObject(pas2c(name),diskobj);
+end;
+
+FUNCTION GetIconTagList(CONST name : string; CONST tags : pTagItem) : pDiskObject;
+begin
+       GetIconTagList := GetIconTagList(pas2c(name),tags);
+end;
+
+FUNCTION PutIconTagList(CONST name : string; CONST icon : pDiskObject; CONST tags : pTagItem) : BOOLEAN;
+begin
+       PutIconTagList := PutIconTagList(pas2c(name),icon,tags);
 end;
 
 const
     { Change VERSION and LIBVERSION to proper values }
+
     VERSION : string[2] = '0';
     LIBVERSION : longword = 0;
 
-initialization
-  IconBase := OpenLibrary(ICONNAME,LIBVERSION);
-finalization
-  if Assigned(IconBase) then
-    CloseLibrary(IconBase);
+{$ifdef use_init_openlib}
+  {$Info Compiling initopening of icon.library}
+  {$Info don't forget to use InitICONLibrary in the beginning of your program}
+
+var
+    icon_exit : Pointer;
+
+procedure CloseiconLibrary;
+begin
+    ExitProc := icon_exit;
+    if IconBase <> nil then begin
+        CloseLibrary(IconBase);
+        IconBase := nil;
+    end;
+end;
+
+procedure InitICONLibrary;
+begin
+    IconBase := nil;
+    IconBase := OpenLibrary(ICONNAME,LIBVERSION);
+    if IconBase <> nil then begin
+        icon_exit := ExitProc;
+        ExitProc := @CloseiconLibrary;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open icon.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+end;
+
+begin
+    ICONIsCompiledHow := 2;
+{$endif use_init_openlib}
+
+{$ifdef use_auto_openlib}
+  {$Info Compiling autoopening of icon.library}
+
+var
+    icon_exit : Pointer;
+
+procedure CloseiconLibrary;
+begin
+    ExitProc := icon_exit;
+    if IconBase <> nil then begin
+        CloseLibrary(IconBase);
+        IconBase := nil;
+    end;
+end;
+
+begin
+    IconBase := nil;
+    IconBase := OpenLibrary(ICONNAME,LIBVERSION);
+    if IconBase <> nil then begin
+        icon_exit := ExitProc;
+        ExitProc := @CloseiconLibrary;
+        ICONIsCompiledHow := 1;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open icon.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+
+{$endif use_auto_openlib}
+
+{$ifdef dont_use_openlib}
+begin
+    ICONIsCompiledHow := 3;
+   {$Warning No autoopening of icon.library compiled}
+   {$Warning Make sure you open icon.library yourself}
+{$endif dont_use_openlib}
+
+
 END. (* UNIT ICON *)
 
 

packages/amunits/src/coreunits/keymap.pas

@@ -105,7 +105,7 @@ Const
     DP_2DINDEXMASK      = $0f;  { mask for index for 1st of two dead keys }
     DP_2DFACSHIFT       = 4;    { shift for factor for 1st of two dead keys }
 
-VAR KeymapBase : pLibrary = nil;
+VAR KeymapBase : pLibrary;
 
 const
     KEYMAPNAME : PChar = 'keymap.library';
@@ -117,16 +117,50 @@ PROCEDURE SetKeyMapDefault(keyMap : pKeyMap location 'a0'); syscall KeymapBase 0
 
 IMPLEMENTATION
 
+uses amsgbox;
+
+{$I useautoopenlib.inc}
+{$ifdef use_auto_openlib}
+  {$Info Compiling autoopening of keymap.library}
+
+var
+    keymap_exit : Pointer;
+
+procedure ClosekeymapLibrary;
+begin
+    ExitProc := keymap_exit;
+    if KeymapBase <> nil then begin
+        CloseLibrary(KeymapBase);
+        KeymapBase := nil;
+    end;
+end;
+
 const
     { Change VERSION and LIBVERSION to proper values }
+
     VERSION : string[2] = '0';
     LIBVERSION : longword = 0;
 
-initialization
-  KeymapBase := OpenLibrary(KEYMAPNAME,LIBVERSION);
-finalization
-  if Assigned(KeymapBase) then
-    CloseLibrary(KeymapBase);
+begin
+    KeymapBase := nil;
+    KeymapBase := OpenLibrary(KEYMAPNAME,LIBVERSION);
+    if KeymapBase <> nil then begin
+        keymap_exit := ExitProc;
+        ExitProc := @ClosekeymapLibrary
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open keymap.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+
+{$else}
+   {$Warning No autoopening of keymap.library compiled}
+   {$Info Make sure you open keymap.library yourself}
+{$endif use_auto_openlib}
+
+
 END. (* UNIT KEYMAP *)
 
 

packages/amunits/src/coreunits/layers.pas

@@ -84,7 +84,7 @@ const
 
  LAYERSNAME : PChar = 'layers.library';
 
-VAR LayersBase : pLibrary = nil;
+VAR LayersBase : pLibrary;
 
 FUNCTION BeginUpdate(l : pLayer location 'a0') : LONGINT; syscall LayersBase 078;
 FUNCTION BehindLayer(dummy : LONGINT location 'a0'; layer : pLayer location 'a1') : LONGINT; syscall LayersBase 054;
@@ -119,18 +119,106 @@ PROCEDURE UnlockLayers(li : pLayer_Info location 'a0'); syscall LayersBase 114;
 FUNCTION UpfrontLayer(dummy : LONGINT location 'a0'; layer : pLayer location 'a1') : LONGINT; syscall LayersBase 048;
 FUNCTION WhichLayer(li : pLayer_Info location 'a0'; x : LONGINT location 'd0'; y : LONGINT location 'd1') : pLayer; syscall LayersBase 132;
 
+{Here we read how to compile this unit}
+{You can remove this include and use a define instead}
+{$I useautoopenlib.inc}
+{$ifdef use_init_openlib}
+procedure InitLAYERSLibrary;
+{$endif use_init_openlib}
+
+{This is a variable that knows how the unit is compiled}
+var
+    LAYERSIsCompiledHow : longint;
+
 IMPLEMENTATION
 
+uses
+{$ifndef dont_use_openlib}
+amsgbox;
+{$endif dont_use_openlib}
+
 const
     { Change VERSION and LIBVERSION to proper values }
+
     VERSION : string[2] = '0';
     LIBVERSION : longword = 0;
 
-initialization
-  LayersBase := OpenLibrary(LAYERSNAME,LIBVERSION);
-finalization
-  if Assigned(LayersBase) then
-    CloseLibrary(LayersBase);
+{$ifdef use_init_openlib}
+  {$Info Compiling initopening of layers.library}
+  {$Info don't forget to use InitLAYERSLibrary in the beginning of your program}
+
+var
+    layers_exit : Pointer;
+
+procedure CloselayersLibrary;
+begin
+    ExitProc := layers_exit;
+    if LayersBase <> nil then begin
+        CloseLibrary(LayersBase);
+        LayersBase := nil;
+    end;
+end;
+
+procedure InitLAYERSLibrary;
+begin
+    LayersBase := nil;
+    LayersBase := OpenLibrary(LAYERSNAME,LIBVERSION);
+    if LayersBase <> nil then begin
+        layers_exit := ExitProc;
+        ExitProc := @CloselayersLibrary;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open layers.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+end;
+
+begin
+    LAYERSIsCompiledHow := 2;
+{$endif use_init_openlib}
+
+{$ifdef use_auto_openlib}
+  {$Info Compiling autoopening of layers.library}
+
+var
+    layers_exit : Pointer;
+
+procedure CloselayersLibrary;
+begin
+    ExitProc := layers_exit;
+    if LayersBase <> nil then begin
+        CloseLibrary(LayersBase);
+        LayersBase := nil;
+    end;
+end;
+
+begin
+    LayersBase := nil;
+    LayersBase := OpenLibrary(LAYERSNAME,LIBVERSION);
+    if LayersBase <> nil then begin
+        layers_exit := ExitProc;
+        ExitProc := @CloselayersLibrary;
+        LAYERSIsCompiledHow := 1;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open layers.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+
+{$endif use_auto_openlib}
+
+{$ifdef dont_use_openlib}
+begin
+    LAYERSIsCompiledHow := 3;
+   {$Warning No autoopening of layers.library compiled}
+   {$Warning Make sure you open layers.library yourself}
+{$endif dont_use_openlib}
+
+
 END. (* UNIT LAYERS *)
 
 

packages/amunits/src/coreunits/locale.pas

@@ -262,7 +262,7 @@ Type
 
 { --- functions in V38 or higher (Release 2.1) --- }
 
-VAR LocaleBase : pLocaleBase = nil;
+VAR LocaleBase : pLocaleBase;
 
 const
     LOCALENAME : PChar = 'locale.library';
@@ -292,25 +292,108 @@ FUNCTION ParseDate(locale : pLocale location 'a0'; date : pDateStamp location 'a
 FUNCTION StrConvert(locale : pLocale location 'a0'; string1 : pCHAR location 'a1'; buffer : POINTER location 'a2'; bufferSize : ULONG location 'd0'; typ : ULONG location 'd1') : ULONG; syscall LocaleBase 174;
 FUNCTION StrnCmp(locale : pLocale location 'a0'; string1 : pCHAR location 'a1'; string2 : pCHAR location 'a2'; length : LONGINT location 'd0'; typ : ULONG location 'd1') : LONGINT; syscall LocaleBase 180;
 
-function OpenCatalog(locale : pLocale; name : pCHAR; Const argv : array of PtrUInt) : pCatalog;
+
+{Here we read how to compile this unit}
+{You can remove this include and use a define instead}
+{$I useautoopenlib.inc}
+{$ifdef use_init_openlib}
+procedure InitLOCALELibrary;
+{$endif use_init_openlib}
+
+{This is a variable that knows how the unit is compiled}
+var
+    LOCALEIsCompiledHow : longint;
 
 IMPLEMENTATION
 
-function OpenCatalog(locale : pLocale; name : pCHAR; Const argv : array of PtrUInt) : pCatalog;
-begin
-    OpenCatalog := OpenCatalogA(locale,name,@argv);
-end;
+uses
+{$ifndef dont_use_openlib}
+amsgbox;
+{$endif dont_use_openlib}
+
 
 const
     { Change VERSION and LIBVERSION to proper values }
+
     VERSION : string[2] = '0';
     LIBVERSION : longword = 0;
 
-initialization
-  LocaleBase := pLocaleBase(OpenLibrary(LOCALENAME,LIBVERSION));
-finalization
-  if Assigned(LocaleBase) then
-    CloseLibrary(pLibrary(LocaleBase));
+{$ifdef use_init_openlib}
+  {$Info Compiling initopening of locale.library}
+  {$Info don't forget to use InitLOCALELibrary in the beginning of your program}
+
+var
+    locale_exit : Pointer;
+
+procedure CloselocaleLibrary;
+begin
+    ExitProc := locale_exit;
+    if LocaleBase <> nil then begin
+        CloseLibrary(pLibrary(LocaleBase));
+        LocaleBase := nil;
+    end;
+end;
+
+procedure InitLOCALELibrary;
+begin
+    LocaleBase := nil;
+    LocaleBase := pLocaleBase(OpenLibrary(LOCALENAME,LIBVERSION));
+    if LocaleBase <> nil then begin
+        locale_exit := ExitProc;
+        ExitProc := @CloselocaleLibrary;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open locale.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+end;
+
+begin
+    LOCALEIsCompiledHow := 2;
+{$endif use_init_openlib}
+
+{$ifdef use_auto_openlib}
+  {$Info Compiling autoopening of locale.library}
+
+var
+    locale_exit : Pointer;
+
+procedure CloselocaleLibrary;
+begin
+    ExitProc := locale_exit;
+    if LocaleBase <> nil then begin
+        CloseLibrary(pLibrary(LocaleBase));
+        LocaleBase := nil;
+    end;
+end;
+
+begin
+    LocaleBase := nil;
+    LocaleBase := pLocaleBase(OpenLibrary(LOCALENAME,LIBVERSION));
+    if LocaleBase <> nil then begin
+        locale_exit := ExitProc;
+        ExitProc := @CloselocaleLibrary;
+        LOCALEIsCompiledHow := 1;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open locale.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+
+{$endif use_auto_openlib}
+
+{$ifdef dont_use_openlib}
+begin
+    LOCALEIsCompiledHow := 3;
+   {$Warning No autoopening of locale.library compiled}
+   {$Warning Make sure you open locale.library yourself}
+{$endif dont_use_openlib}
+
+
 END. (* UNIT LOCALE *)
 
 

packages/amunits/src/coreunits/lowlevel.pas

@@ -261,7 +261,7 @@ Const
 
 { --- functions in V40 or higher (Release 3.1) --- }
 
-VAR LowLevelBase : pLibrary = nil;
+VAR LowLevelBase : pLibrary;
 
 FUNCTION AddKBInt(const intRoutine : POINTER location 'a0'; const intData : POINTER location 'a1') : POINTER; syscall LowLevelBase 060;
 FUNCTION AddTimerInt(const intRoutine : POINTER location 'a0'; const  intData : POINTER location 'a1') : POINTER; syscall LowLevelBase 078;
@@ -279,31 +279,104 @@ PROCEDURE StartTimerInt(intHandle : POINTER location 'a1'; timeInterval : ULONG
 PROCEDURE StopTimerInt(intHandle : POINTER location 'a1'); syscall LowLevelBase 090;
 FUNCTION SystemControlA(const tagList : pTagItem location 'a1') : ULONG; syscall LowLevelBase 072;
 
-function SetJoyPortAttrs(portNumber : ULONG; Const argv : array of PtrUInt) : BOOLEAN;
-function SystemControl(Const argv : array of PtrUInt) : ULONG;
+{Here we read how to compile this unit}
+{You can remove this include and use a define instead}
+{$I useautoopenlib.inc}
+{$ifdef use_init_openlib}
+procedure InitLOWLEVELLibrary;
+{$endif use_init_openlib}
+
+{This is a variable that knows how the unit is compiled}
+var
+    LOWLEVELIsCompiledHow : longint;
 
 IMPLEMENTATION
 
-function SetJoyPortAttrs(portNumber : ULONG; Const argv : array of PtrUInt) : BOOLEAN;
+{$ifndef dont_use_openlib}
+uses amsgbox;
+{$endif dont_use_openlib}
+
+const
+    { Change VERSION and LIBVERSION to proper values }
+
+    VERSION : string[2] = '0';
+    LIBVERSION : longword = 0;
+
+{$ifdef use_init_openlib}
+  {$Info Compiling initopening of lowlevel.library}
+  {$Info don't forget to use InitLOWLEVELLibrary in the beginning of your program}
+
+var
+    lowlevel_exit : Pointer;
+
+procedure CloselowlevelLibrary;
 begin
-    SetJoyPortAttrs := SetJoyPortAttrsA(portNumber,@argv);
+    ExitProc := lowlevel_exit;
+    if LowLevelBase <> nil then begin
+        CloseLibrary(LowLevelBase);
+        LowLevelBase := nil;
+    end;
 end;
 
-function SystemControl(Const argv : array of PtrUInt) : ULONG;
+procedure InitLOWLEVELLibrary;
 begin
-    SystemControl := SystemControlA(@argv);
+    LowLevelBase := nil;
+    LowLevelBase := OpenLibrary(LOWLEVELNAME,LIBVERSION);
+    if LowLevelBase <> nil then begin
+        lowlevel_exit := ExitProc;
+        ExitProc := @CloselowlevelLibrary;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open lowlevel.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
 end;
 
-const
-    { Change VERSION and LIBVERSION to proper values }
-    VERSION : string[2] = '0';
-    LIBVERSION : longword = 0;
+begin
+    LOWLEVELIsCompiledHow := 2;
+{$endif use_init_openlib}
+
+{$ifdef use_auto_openlib}
+  {$Info Compiling autoopening of lowlevel.library}
+
+var
+    lowlevel_exit : Pointer;
+
+procedure CloselowlevelLibrary;
+begin
+    ExitProc := lowlevel_exit;
+    if LowLevelBase <> nil then begin
+        CloseLibrary(LowLevelBase);
+        LowLevelBase := nil;
+    end;
+end;
+
+begin
+    LowLevelBase := nil;
+    LowLevelBase := OpenLibrary(LOWLEVELNAME,LIBVERSION);
+    if LowLevelBase <> nil then begin
+        lowlevel_exit := ExitProc;
+        ExitProc := @CloselowlevelLibrary;
+        LOWLEVELIsCompiledHow := 1;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open lowlevel.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+
+{$endif use_auto_openlib}
+
+{$ifdef dont_use_openlib}
+begin
+    LOWLEVELIsCompiledHow := 3;
+   {$Warning No autoopening of lowlevel.library compiled}
+   {$Warning Make sure you open lowlevel.library yourself}
+{$endif dont_use_openlib}
 
-initialization
-  LowLevelBase := OpenLibrary(LOWLEVELNAME,LIBVERSION);
-finalization
-  if Assigned(LowLevelBase) then
-    CloseLibrary(LowLevelBase);
 END. (* UNIT LOWLEVEL *)
 
 

packages/amunits/src/otherlibs/ahi_sub.pas

@@ -136,40 +136,333 @@ USES Exec, ahi, utility;
 
 
 
-VAR AHIsubBase : pLibrary = nil;
+VAR AHIsubBase : pLibrary;
 
 const
     AHI_SUBNAME : PChar = 'ahi_sub.library';
 
 
-FUNCTION AHIsub_AllocAudio(tagList : pTagItem location 'a1'; AudioCtrl : pAHIAudioCtrlDrv location 'a2') : longword; syscall AHIsubBase 30;
-PROCEDURE AHIsub_Disable(AudioCtrl : pAHIAudioCtrlDrv location 'a2'); syscall AHIsubBase 42;
-PROCEDURE AHIsub_Enable(AudioCtrl : pAHIAudioCtrlDrv location 'a2'); syscall AHIsubBase 48;
-PROCEDURE AHIsub_FreeAudio(AudioCtrl : pAHIAudioCtrlDrv location 'a2'); syscall AHIsubBase 36;
-FUNCTION AHIsub_GetAttr(Attribute : longword location 'd0'; Argument : LONGINT location 'd1'; d2arg : LONGINT location 'd2'; tagList : pTagItem location 'a1'; AudioCtrl : pAHIAudioCtrlDrv location 'a2') : LONGINT; syscall AHIsubBase 108;
-FUNCTION AHIsub_HardwareControl(Attribute : longword location 'd0'; Argument : LONGINT location 'd1'; AudioCtrl : pAHIAudioCtrlDrv location 'a2') : LONGINT; syscall AHIsubBase 114;
-FUNCTION AHIsub_LoadSound(Sound : WORD location 'd0'; _Type : longword location 'd1'; Info : POINTER location 'a0'; AudioCtrl : pAHIAudioCtrlDrv location 'a2') : longword; syscall AHIsubBase 96;
-FUNCTION AHIsub_SetEffect(Effect : POINTER location 'a0'; AudioCtrl : pAHIAudioCtrlDrv location 'a2') : longword; syscall AHIsubBase 90;
-FUNCTION AHIsub_SetFreq(Channel : WORD location 'd0'; Freq : longword location 'd1'; AudioCtrl : pAHIAudioCtrlDrv location 'a2'; Flags : longword location 'd2') : longword; syscall AHIsubBase 78;
-FUNCTION AHIsub_SetSound(Channel : WORD location 'd0'; Sound : WORD location 'd1'; Offset : longword location 'd2'; Length : LONGINT location 'd3'; AudioCtrl : pAHIAudioCtrlDrv location 'a2'; Flags : longword location 'd4') : longword; syscall AHIsubBase 84;
-FUNCTION AHIsub_SetVol(Channel : WORD location 'd0'; Volume : LONGINT location 'd1'; Pan : LONGINT location 'd2'; AudioCtrl : pAHIAudioCtrlDrv location 'a2'; Flags : longword location 'd3') : longword; syscall AHIsubBase 72;
-FUNCTION AHIsub_Start(Flags : longword location 'd0'; AudioCtrl : pAHIAudioCtrlDrv location 'a2') : longword; syscall AHIsubBase 54;
-FUNCTION AHIsub_Stop(Flags : longword location 'd0'; AudioCtrl : pAHIAudioCtrlDrv location 'a2') : longword; syscall AHIsubBase 66;
-FUNCTION AHIsub_UnloadSound(Sound : WORD location 'd0'; Audioctrl : pAHIAudioCtrlDrv location 'a2') : longword; syscall AHIsubBase 102;
-FUNCTION AHIsub_Update(Flags : longword location 'd0'; AudioCtrl : pAHIAudioCtrlDrv location 'a2') : longword; syscall AHIsubBase 60;
+FUNCTION AHIsub_AllocAudio(tagList : pTagItem; AudioCtrl : pAHIAudioCtrlDrv) : longword;
+PROCEDURE AHIsub_Disable(AudioCtrl : pAHIAudioCtrlDrv);
+PROCEDURE AHIsub_Enable(AudioCtrl : pAHIAudioCtrlDrv);
+PROCEDURE AHIsub_FreeAudio(AudioCtrl : pAHIAudioCtrlDrv);
+FUNCTION AHIsub_GetAttr(Attribute : longword; Argument : LONGINT; d2arg : LONGINT; tagList : pTagItem; AudioCtrl : pAHIAudioCtrlDrv) : LONGINT;
+FUNCTION AHIsub_HardwareControl(Attribute : longword; Argument : LONGINT; AudioCtrl : pAHIAudioCtrlDrv) : LONGINT;
+FUNCTION AHIsub_LoadSound(Sound : WORD; _Type : longword; Info : POINTER; AudioCtrl : pAHIAudioCtrlDrv) : longword;
+FUNCTION AHIsub_SetEffect(Effect : POINTER; AudioCtrl : pAHIAudioCtrlDrv) : longword;
+FUNCTION AHIsub_SetFreq(Channel : WORD; Freq : longword; AudioCtrl : pAHIAudioCtrlDrv; Flags : longword) : longword;
+FUNCTION AHIsub_SetSound(Channel : WORD; Sound : WORD; Offset : longword; Length : LONGINT; AudioCtrl : pAHIAudioCtrlDrv; Flags : longword) : longword;
+FUNCTION AHIsub_SetVol(Channel : WORD; Volume : LONGINT; Pan : LONGINT; AudioCtrl : pAHIAudioCtrlDrv; Flags : longword) : longword;
+FUNCTION AHIsub_Start(Flags : longword; AudioCtrl : pAHIAudioCtrlDrv) : longword;
+FUNCTION AHIsub_Stop(Flags : longword; AudioCtrl : pAHIAudioCtrlDrv) : longword;
+FUNCTION AHIsub_UnloadSound(Sound : WORD; Audioctrl : pAHIAudioCtrlDrv) : longword;
+FUNCTION AHIsub_Update(Flags : longword; AudioCtrl : pAHIAudioCtrlDrv) : longword;
+
+{You can remove this include and use a define instead}
+{$I useautoopenlib.inc}
+{$ifdef use_init_openlib}
+procedure InitAHI_SUBLibrary;
+{$endif use_init_openlib}
+
+{This is a variable that knows how the unit is compiled}
+var
+    AHI_SUBIsCompiledHow : longint;
 
 IMPLEMENTATION
 
+uses
+{$ifndef dont_use_openlib}
+amsgbox,
+{$endif dont_use_openlib}
+tagsarray;
+
+
+FUNCTION AHIsub_AllocAudio(tagList : pTagItem; AudioCtrl : pAHIAudioCtrlDrv) : longword;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L tagList,A1
+        MOVEA.L AudioCtrl,A2
+        MOVEA.L AHIsubBase,A6
+        JSR     -030(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE AHIsub_Disable(AudioCtrl : pAHIAudioCtrlDrv);
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L AudioCtrl,A2
+        MOVEA.L AHIsubBase,A6
+        JSR     -042(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE AHIsub_Enable(AudioCtrl : pAHIAudioCtrlDrv);
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L AudioCtrl,A2
+        MOVEA.L AHIsubBase,A6
+        JSR     -048(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE AHIsub_FreeAudio(AudioCtrl : pAHIAudioCtrlDrv);
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L AudioCtrl,A2
+        MOVEA.L AHIsubBase,A6
+        JSR     -036(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION AHIsub_GetAttr(Attribute : longword; Argument : LONGINT; d2arg : LONGINT; tagList : pTagItem; AudioCtrl : pAHIAudioCtrlDrv) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  Attribute,D0
+        MOVE.L  Argument,D1
+        MOVE.L  d2arg,D2
+        MOVEA.L tagList,A1
+        MOVEA.L AudioCtrl,A2
+        MOVEA.L AHIsubBase,A6
+        JSR     -108(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION AHIsub_HardwareControl(Attribute : longword; Argument : LONGINT; AudioCtrl : pAHIAudioCtrlDrv) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  Attribute,D0
+        MOVE.L  Argument,D1
+        MOVEA.L AudioCtrl,A2
+        MOVEA.L AHIsubBase,A6
+        JSR     -114(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION AHIsub_LoadSound(Sound : WORD; _Type : longword; Info : POINTER; AudioCtrl : pAHIAudioCtrlDrv) : longword;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  Sound,D0
+        MOVE.L  _Type,D1
+        MOVEA.L Info,A0
+        MOVEA.L AudioCtrl,A2
+        MOVEA.L AHIsubBase,A6
+        JSR     -096(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION AHIsub_SetEffect(Effect : POINTER; AudioCtrl : pAHIAudioCtrlDrv) : longword;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L Effect,A0
+        MOVEA.L AudioCtrl,A2
+        MOVEA.L AHIsubBase,A6
+        JSR     -090(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION AHIsub_SetFreq(Channel : WORD; Freq : longword; AudioCtrl : pAHIAudioCtrlDrv; Flags : longword) : longword;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  Channel,D0
+        MOVE.L  Freq,D1
+        MOVEA.L AudioCtrl,A2
+        MOVE.L  Flags,D2
+        MOVEA.L AHIsubBase,A6
+        JSR     -078(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION AHIsub_SetSound(Channel : WORD; Sound : WORD; Offset : longword; Length : LONGINT; AudioCtrl : pAHIAudioCtrlDrv; Flags : longword) : longword;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  Channel,D0
+        MOVE.L  Sound,D1
+        MOVE.L  Offset,D2
+        MOVE.L  Length,D3
+        MOVEA.L AudioCtrl,A2
+        MOVE.L  Flags,D4
+        MOVEA.L AHIsubBase,A6
+        JSR     -084(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION AHIsub_SetVol(Channel : WORD; Volume : LONGINT; Pan : LONGINT; AudioCtrl : pAHIAudioCtrlDrv; Flags : longword) : longword;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  Channel,D0
+        MOVE.L  Volume,D1
+        MOVE.L  Pan,D2
+        MOVEA.L AudioCtrl,A2
+        MOVE.L  Flags,D3
+        MOVEA.L AHIsubBase,A6
+        JSR     -072(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION AHIsub_Start(Flags : longword; AudioCtrl : pAHIAudioCtrlDrv) : longword;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  Flags,D0
+        MOVEA.L AudioCtrl,A2
+        MOVEA.L AHIsubBase,A6
+        JSR     -054(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION AHIsub_Stop(Flags : longword; AudioCtrl : pAHIAudioCtrlDrv) : longword;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  Flags,D0
+        MOVEA.L AudioCtrl,A2
+        MOVEA.L AHIsubBase,A6
+        JSR     -066(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION AHIsub_UnloadSound(Sound : WORD; Audioctrl : pAHIAudioCtrlDrv) : longword;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  Sound,D0
+        MOVEA.L Audioctrl,A2
+        MOVEA.L AHIsubBase,A6
+        JSR     -102(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION AHIsub_Update(Flags : longword; AudioCtrl : pAHIAudioCtrlDrv) : longword;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  Flags,D0
+        MOVEA.L AudioCtrl,A2
+        MOVEA.L AHIsubBase,A6
+        JSR     -060(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
 const
     { Change VERSION and LIBVERSION to proper values }
+
     VERSION : string[2] = '0';
     LIBVERSION : longword = 0;
 
-initialization
-  AHIsubBase := OpenLibrary(AHI_SUBNAME,LIBVERSION);
-finalization
-  if Assigned(AHIsubBase) then
-    CloseLibrary(AHIsubBase);
+{$ifdef use_init_openlib}
+  {$Info Compiling initopening of ahi_sub.library}
+  {$Info don't forget to use InitAHI_SUBLibrary in the beginning of your program}
+
+var
+    ahi_sub_exit : Pointer;
+
+procedure Closeahi_subLibrary;
+begin
+    ExitProc := ahi_sub_exit;
+    if AHIsubBase <> nil then begin
+        CloseLibrary(AHIsubBase);
+        AHIsubBase := nil;
+    end;
+end;
+
+procedure InitAHI_SUBLibrary;
+begin
+    AHIsubBase := nil;
+    AHIsubBase := OpenLibrary(AHI_SUBNAME,LIBVERSION);
+    if AHIsubBase <> nil then begin
+        ahi_sub_exit := ExitProc;
+        ExitProc := @Closeahi_subLibrary;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open ahi_sub.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+end;
+
+begin
+    AHI_SUBIsCompiledHow := 2;
+{$endif use_init_openlib}
+
+{$ifdef use_auto_openlib}
+  {$Info Compiling autoopening of ahi_sub.library}
+
+var
+    ahi_sub_exit : Pointer;
+
+procedure Closeahi_subLibrary;
+begin
+    ExitProc := ahi_sub_exit;
+    if AHIsubBase <> nil then begin
+        CloseLibrary(AHIsubBase);
+        AHIsubBase := nil;
+    end;
+end;
+
+begin
+    AHIsubBase := nil;
+    AHIsubBase := OpenLibrary(AHI_SUBNAME,LIBVERSION);
+    if AHIsubBase <> nil then begin
+        ahi_sub_exit := ExitProc;
+        ExitProc := @Closeahi_subLibrary;
+        AHI_SUBIsCompiledHow := 1;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open ahi_sub.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+
+{$endif use_auto_openlib}
+
+{$ifdef dont_use_openlib}
+begin
+    AHI_SUBIsCompiledHow := 3;
+   {$Warning No autoopening of ahi_sub.library compiled}
+   {$Warning Make sure you open ahi_sub.library yourself}
+{$endif dont_use_openlib}
+
+
 END. (* UNIT AHI_SUB *)
 
 

packages/amunits/src/otherlibs/amarquee.pas

@@ -22,7 +22,7 @@
   in here. If you find any bugs please let me know.
   25 Aug 2000.
 
-  Added functions and procedures with array of PtrUInt.
+  Added functions and procedures with array of const.
   For use with fpc 1.0.7
   30 Nov 2002.
 
@@ -37,6 +37,7 @@
 
 }
 
+{$mode objfpc}
 {$I useamigasmartlink.inc}
 {$ifdef use_amiga_smartlink}
     {$smartlink on}
@@ -201,64 +202,64 @@ uses exec, utility;
   { (struct QSharedMessagePort  mp) A shared message port created with QCreateSharedMessagePort()  }
      QSESSION_SHAREDMSGPORT = $b0000002;
 
-VAR AMarqueeBase : pLibrary = nil;
-
-FUNCTION QFreeSession(session : pQSession location 'a0') : LONGINT; syscall AMarqueeBase 36;
-FUNCTION QDebugOp(session : pQSession location 'a0'; string_ : pCHar location 'a1') : LONGINT; syscall AMarqueeBase 42;
-FUNCTION QGetOp(session : pQSession location 'a0'; path : pCHar location 'a1'; maxBytes : LONGINT location 'd0') : LONGINT; syscall AMarqueeBase 48;
-FUNCTION QDeleteOp(session : pQSession location 'a0'; path : pCHar location 'a1') : LONGINT; syscall AMarqueeBase 54;
-FUNCTION QRenameOp(session : pQSession location 'a0'; path : pCHar location 'a1'; label_ : pCHar location 'd0') : LONGINT; syscall AMarqueeBase 60;
-FUNCTION QSubscribeOp(session : pQSession location 'a0'; path : pCHar location 'a1'; maxBytes : LONGINT location 'd0') : LONGINT; syscall AMarqueeBase 66;
-FUNCTION QSetOp(session : pQSession location 'a0'; path : pCHar location 'a1'; buf : POINTER location 'd0'; len : ULONG location 'd1') : LONGINT; syscall AMarqueeBase 72;
-FUNCTION QClearSubscriptionsOp(session : pQSession location 'a0'; which : LONGINT location 'd0') : LONGINT; syscall AMarqueeBase 78;
-FUNCTION QPingOp(session : pQSession location 'a0') : LONGINT; syscall AMarqueeBase 84;
-FUNCTION QInfoOp(session : pQSession location 'a0') : LONGINT; syscall AMarqueeBase 90;
-FUNCTION QSetAccessOp(session : pQSession location 'a0'; hosts : pCHar location 'a1') : LONGINT; syscall AMarqueeBase 96;
-PROCEDURE FreeQMessage(session : pQSession location 'a0'; qmsg : pQMessage location 'a1'); syscall AMarqueeBase 102;
-FUNCTION QGo(session : pQSession location 'a0'; sync : ULONG location 'd0') : LONGINT; syscall AMarqueeBase 108;
-FUNCTION QStreamOp(session : pQSession location 'a0'; path : pCHar location 'a1'; buf : POINTER location 'd0'; len : ULONG location 'd1') : LONGINT; syscall AMarqueeBase 120;
-FUNCTION QSetMessageAccessOp(session : pQSession location 'a0'; access : pCHar location 'a1'; maxbytes : LONGINT location 'd0') : LONGINT; syscall AMarqueeBase 132;
-FUNCTION QMessageOp(session : pQSession location 'a0'; hosts : pCHar location 'a1'; buffer : POINTER location 'd0'; len : ULONG location 'd1') : LONGINT; syscall AMarqueeBase 138;
-FUNCTION QNumQueuedPackets(session : pQSession location 'a0') : ULONG; syscall AMarqueeBase 150;
-FUNCTION QNumQueuedBytes(session : pQSession location 'a0') : ULONG; syscall AMarqueeBase 156;
-FUNCTION QErrorName(session : LONGINT location 'd0') : pCHar; syscall AMarqueeBase 162;
-FUNCTION QRequestPrivilegesOp(session : pQSession location 'a0'; privBits : ULONG location 'd0') : LONGINT; syscall AMarqueeBase 168;
-FUNCTION QReleasePrivilegesOp(session : pQSession location 'a0'; privBits : ULONG location 'd0') : LONGINT; syscall AMarqueeBase 174;
-FUNCTION QKillClientsOp(session : pQSession location 'a0'; hosts : pCHar location 'a1') : LONGINT; syscall AMarqueeBase 180;
-FUNCTION QSetParameterOp(session : pQSession location 'a0'; paramName : pCHar location 'a1'; newValue : pCHar location 'd0') : LONGINT; syscall AMarqueeBase 186;
-FUNCTION QGetParameterOp(session : pQSession location 'a0'; paramName : pCHar location 'a1') : LONGINT; syscall AMarqueeBase 192;
-FUNCTION QSysMessageOp(session : pQSession location 'a0'; hosts : pCHar location 'a1'; message : pCHar location 'd0') : LONGINT; syscall AMarqueeBase 198;
-FUNCTION QGetAndSubscribeOp(session : pQSession location 'a0'; path : pCHar location 'a1'; maxBytes : LONGINT location 'd0') : LONGINT; syscall AMarqueeBase 210;
-FUNCTION QDetachSession(session : pQSession location 'a0'; flags : ULONG location 'd0') : BOOLEAN; syscall AMarqueeBase 216;
-FUNCTION QReattachSession(session : pQSession location 'a0'; flags : ULONG location 'd0') : BOOLEAN; syscall AMarqueeBase 222;
-FUNCTION QNewSocketSession(host : pCHar location 'a0'; port : LONGINT location 'd0'; tags : pTagItem location 'a1') : pQSession; syscall AMarqueeBase 228;
-FUNCTION QSendRawOp(session : pQSession location 'a0'; buf : POINTER location 'a1'; len : ULONG location 'd0') : LONGINT; syscall AMarqueeBase 234;
-FUNCTION QNewSocketSessionAsync(host : pCHar location 'a0'; port : LONGINT location 'd0'; tags : pTagItem location 'a1') : pQSession; syscall AMarqueeBase 240;
-FUNCTION QNewSocketServerSession( port : pLONGINT location 'a0'; tags : pTagItem location 'a1') : pQSession; syscall AMarqueeBase 246;
-FUNCTION QSetKeyAccessOp(session : pQSession location 'a0'; path : pCHar location 'a1'; hosts : pCHar location 'd0') : LONGINT; syscall AMarqueeBase 252;
-FUNCTION QGetHostName(session : pQSession location 'a0') : pCHar; syscall AMarqueeBase 258;
-FUNCTION QGetProgName(session : pQSession location 'a0') : pCHar; syscall AMarqueeBase 264;
-PROCEDURE QSetMaxRawBufSize(session : pQSession location 'a0'; maxBufSize : ULONG location 'd0'); syscall AMarqueeBase 270;
-FUNCTION QNewSession(host : pCHar location 'a0'; port : LONGINT location 'd0'; name : pCHar location 'a1'; taglist : pTagItem location 'd1') : pQSession; syscall AMarqueeBase 276;
-FUNCTION QNewSessionAsync(host : pCHar location 'a0'; port : LONGINT location 'd0'; name : pCHar location 'a1'; taglist : pTagItem location 'd1') : pQSession; syscall AMarqueeBase 282;
-FUNCTION QNewHostSession(hostnames : pCHar location 'a0'; port : pLONGINT location 'a1'; names : pCHar location 'd0'; taglist : pTagItem location 'd1') : pQSession; syscall AMarqueeBase 288;
-FUNCTION QNewServerSession(hostNames : pCHar location 'a0'; progNames : pCHar location 'a1'; taglist : pTagItem location 'd0') : pQSession; syscall AMarqueeBase 294;
-FUNCTION QCreateSharedMessagePort : pQSharedMessagePort; syscall AMarqueeBase 300;
-PROCEDURE QDeleteSharedMessagePort(mp : pQSharedMessagePort location 'a0'); syscall AMarqueeBase 306;
-FUNCTION QGetLocalIP(session : pQSession location 'a0') : pCHAR; syscall AMarqueeBase 312;
+VAR AMarqueeBase : pLibrary;
+
+FUNCTION QFreeSession(session : pQSession) : LONGINT;
+FUNCTION QDebugOp(session : pQSession; string_ : pCHar) : LONGINT;
+FUNCTION QGetOp(session : pQSession; path : pCHar; maxBytes : LONGINT) : LONGINT;
+FUNCTION QDeleteOp(session : pQSession; path : pCHar) : LONGINT;
+FUNCTION QRenameOp(session : pQSession; path : pCHar; label_ : pCHar) : LONGINT;
+FUNCTION QSubscribeOp(session : pQSession; path : pCHar; maxBytes : LONGINT) : LONGINT;
+FUNCTION QSetOp(session : pQSession; path : pCHar; buf : POINTER; len : ULONG) : LONGINT;
+FUNCTION QClearSubscriptionsOp(session : pQSession; which : LONGINT) : LONGINT;
+FUNCTION QPingOp(session : pQSession) : LONGINT;
+FUNCTION QInfoOp(session : pQSession) : LONGINT;
+FUNCTION QSetAccessOp(session : pQSession; hosts : pCHar) : LONGINT;
+PROCEDURE FreeQMessage(session : pQSession; qmsg : pQMessage);
+FUNCTION QGo(session : pQSession; sync : ULONG) : LONGINT;
+FUNCTION QStreamOp(session : pQSession; path : pCHar; buf : POINTER; len : ULONG) : LONGINT;
+FUNCTION QSetMessageAccessOp(session : pQSession; access : pCHar; maxbytes : LONGINT) : LONGINT;
+FUNCTION QMessageOp(session : pQSession; hosts : pCHar; buffer : POINTER; len : ULONG) : LONGINT;
+FUNCTION QNumQueuedPackets(session : pQSession) : ULONG;
+FUNCTION QNumQueuedBytes(session : pQSession) : ULONG;
+FUNCTION QErrorName(session : LONGINT) : pCHar;
+FUNCTION QRequestPrivilegesOp(session : pQSession; privBits : ULONG) : LONGINT;
+FUNCTION QReleasePrivilegesOp(session : pQSession; privBits : ULONG) : LONGINT;
+FUNCTION QKillClientsOp(session : pQSession; hosts : pCHar) : LONGINT;
+FUNCTION QSetParameterOp(session : pQSession; paramName : pCHar; newValue : pCHar) : LONGINT;
+FUNCTION QGetParameterOp(session : pQSession; paramName : pCHar) : LONGINT;
+FUNCTION QSysMessageOp(session : pQSession; hosts : pCHar; message : pCHar) : LONGINT;
+FUNCTION QGetAndSubscribeOp(session : pQSession; path : pCHar; maxBytes : LONGINT) : LONGINT;
+FUNCTION QDetachSession(session : pQSession; flags : ULONG) : BOOLEAN;
+FUNCTION QReattachSession(session : pQSession; flags : ULONG) : BOOLEAN;
+FUNCTION QNewSocketSession(host : pCHar; port : LONGINT; tags : pTagItem) : pQSession;
+FUNCTION QSendRawOp(session : pQSession; buf : POINTER; len : ULONG) : LONGINT;
+FUNCTION QNewSocketSessionAsync(host : pCHar; port : LONGINT; tags : pTagItem) : pQSession;
+FUNCTION QNewSocketServerSession( port : pLONGINT; tags : pTagItem) : pQSession;
+FUNCTION QSetKeyAccessOp(session : pQSession; path : pCHar; hosts : pCHar) : LONGINT;
+FUNCTION QGetHostName(session : pQSession) : pCHar;
+FUNCTION QGetProgName(session : pQSession) : pCHar;
+PROCEDURE QSetMaxRawBufSize(session : pQSession; maxBufSize : ULONG);
+FUNCTION QNewSession(host : pCHar; port : LONGINT; name : pCHar; taglist : pTagItem) : pQSession;
+FUNCTION QNewSessionAsync(host : pCHar; port : LONGINT; name : pCHar; taglist : pTagItem) : pQSession;
+FUNCTION QNewHostSession(hostnames : pCHar; port : pLONGINT; names : pCHar; taglist : pTagItem) : pQSession;
+FUNCTION QNewServerSession(hostNames : pCHar; progNames : pCHar; taglist : pTagItem) : pQSession;
+FUNCTION QCreateSharedMessagePort : pQSharedMessagePort;
+PROCEDURE QDeleteSharedMessagePort(mp : pQSharedMessagePort);
+FUNCTION QGetLocalIP(session : pQSession) : pCHAR;
 
 {
-     This is functions and procedures with array of PtrUInt.
+     This is functions and procedures with array of const.
      For use with fpc 1.0 and above.
 
 }
-FUNCTION QNewSocketSessiontags(host : pCHar; port : LONGINT; const argv : array of PtrUInt) : pQSession;
-FUNCTION QNewSocketSessionAsyncTags(host : pCHar; port : LONGINT; const argv : array of PtrUInt) : pQSession;
-FUNCTION QNewSocketServerSessionTags( port : pLONGINT; const argv : array of PtrUInt) : pQSession;
-FUNCTION QNewSessionTags(host : pCHar; port : LONGINT; name : pCHar; const argv : array of PtrUInt) : pQSession;
-FUNCTION QNewSessionAsyncTags(host : pCHar; port : LONGINT; name : pCHar; const argv : array of PtrUInt) : pQSession;
-FUNCTION QNewHostSessionTags(hostnames : pCHar; port : pLONGINT; names : pCHar; const argv : array of PtrUInt) : pQSession;
-FUNCTION QNewServerSessionTags(hostNames : pCHar; progNames : pCHar; const argv : array of PtrUInt) : pQSession;
+FUNCTION QNewSocketSessiontags(host : pCHar; port : LONGINT; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSocketSessionAsyncTags(host : pCHar; port : LONGINT; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSocketServerSessionTags( port : pLONGINT; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSessionTags(host : pCHar; port : LONGINT; name : pCHar; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSessionAsyncTags(host : pCHar; port : LONGINT; name : pCHar; const argv : Array Of Const) : pQSession;
+FUNCTION QNewHostSessionTags(hostnames : pCHar; port : pLONGINT; names : pCHar; const argv : Array Of Const) : pQSession;
+FUNCTION QNewServerSessionTags(hostNames : pCHar; progNames : pCHar; const argv : Array Of Const) : pQSession;
 
 
 FUNCTION QDebugOp(session : pQSession; string_ : string) : LONGINT;
@@ -285,21 +286,611 @@ FUNCTION QNewHostSession(hostnames : string; port : pLONGINT; names : string; ta
 FUNCTION QNewServerSession(hostNames : string; progNames : string; taglist : pTagItem) : pQSession;
 
 {
-     This is functions and procedures with array of PtrUInt.
+     This is functions and procedures with array of const.
      For use with fpc 1.0 and above.
 }
 
-FUNCTION QNewSocketSessionTags(host : string; port : LONGINT; const argv : array of PtrUInt) : pQSession;
-FUNCTION QNewSocketSessionAsyncTags(host : string; port : LONGINT; const argv : array of PtrUInt) : pQSession;
-FUNCTION QNewSessionTags(host : string; port : LONGINT; name : string; const argv : array of PtrUInt) : pQSession;
-FUNCTION QNewSessionAsyncTags(host : string; port : LONGINT; name : string; const argv : array of PtrUInt) : pQSession;
-FUNCTION QNewHostSessionTags(hostnames : string; port : pLONGINT; names : string; const argv : array of PtrUInt) : pQSession;
-FUNCTION QNewServerSessionTags(hostNames : string; progNames : string; const argv : array of PtrUInt) : pQSession;
+FUNCTION QNewSocketSessionTags(host : string; port : LONGINT; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSocketSessionAsyncTags(host : string; port : LONGINT; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSessionTags(host : string; port : LONGINT; name : string; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSessionAsyncTags(host : string; port : LONGINT; name : string; const argv : Array Of Const) : pQSession;
+FUNCTION QNewHostSessionTags(hostnames : string; port : pLONGINT; names : string; const argv : Array Of Const) : pQSession;
+FUNCTION QNewServerSessionTags(hostNames : string; progNames : string; const argv : Array Of Const) : pQSession;
+
+{You can remove this include and use a define instead}
+{$I useautoopenlib.inc}
+{$ifdef use_init_openlib}
+procedure InitAMARQUEELibrary;
+{$endif use_init_openlib}
+
+{This is a variable that knows how the unit is compiled}
+var
+    AMARQUEEIsCompiledHow : longint;
 
 IMPLEMENTATION
 
 uses
-  pastoc;
+{$ifndef dont_use_openlib}
+amsgbox,
+{$endif dont_use_openlib}
+pastoc,tagsarray;
+
+
+FUNCTION QFreeSession(session : pQSession) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -036(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QDebugOp(session : pQSession; string_ : pCHar) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L string_,A1
+        MOVEA.L AMarqueeBase,A6
+        JSR     -042(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QGetOp(session : pQSession; path : pCHar; maxBytes : LONGINT) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L path,A1
+        MOVE.L  maxBytes,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -048(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QDeleteOp(session : pQSession; path : pCHar) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L path,A1
+        MOVEA.L AMarqueeBase,A6
+        JSR     -054(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QRenameOp(session : pQSession; path : pCHar; label_ : pCHar) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L path,A1
+        MOVE.L  label_,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -060(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QSubscribeOp(session : pQSession; path : pCHar; maxBytes : LONGINT) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L path,A1
+        MOVE.L  maxBytes,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -066(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QSetOp(session : pQSession; path : pCHar; buf : POINTER; len : ULONG) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L path,A1
+        MOVE.L  buf,D0
+        MOVE.L  len,D1
+        MOVEA.L AMarqueeBase,A6
+        JSR     -072(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QClearSubscriptionsOp(session : pQSession; which : LONGINT) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVE.L  which,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -078(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QPingOp(session : pQSession) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -084(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QInfoOp(session : pQSession) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -090(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QSetAccessOp(session : pQSession; hosts : pCHar) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L hosts,A1
+        MOVEA.L AMarqueeBase,A6
+        JSR     -096(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE FreeQMessage(session : pQSession; qmsg : pQMessage);
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L qmsg,A1
+        MOVEA.L AMarqueeBase,A6
+        JSR     -102(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION QGo(session : pQSession; sync : ULONG) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVE.L  sync,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -108(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QStreamOp(session : pQSession; path : pCHar; buf : POINTER; len : ULONG) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L path,A1
+        MOVE.L  buf,D0
+        MOVE.L  len,D1
+        MOVEA.L AMarqueeBase,A6
+        JSR     -120(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QSetMessageAccessOp(session : pQSession; access : pCHar; maxbytes : LONGINT) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L access,A1
+        MOVE.L  maxbytes,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -132(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QMessageOp(session : pQSession; hosts : pCHar; buffer : POINTER; len : ULONG) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L hosts,A1
+        MOVE.L  buffer,D0
+        MOVE.L  len,D1
+        MOVEA.L AMarqueeBase,A6
+        JSR     -138(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QNumQueuedPackets(session : pQSession) : ULONG;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -150(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QNumQueuedBytes(session : pQSession) : ULONG;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -156(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QErrorName(session : LONGINT) : pCHar;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  session,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -162(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QRequestPrivilegesOp(session : pQSession; privBits : ULONG) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVE.L  privBits,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -168(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QReleasePrivilegesOp(session : pQSession; privBits : ULONG) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVE.L  privBits,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -174(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QKillClientsOp(session : pQSession; hosts : pCHar) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L hosts,A1
+        MOVEA.L AMarqueeBase,A6
+        JSR     -180(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QSetParameterOp(session : pQSession; paramName : pCHar; newValue : pCHar) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L paramName,A1
+        MOVE.L  newValue,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -186(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QGetParameterOp(session : pQSession; paramName : pCHar) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L paramName,A1
+        MOVEA.L AMarqueeBase,A6
+        JSR     -192(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QSysMessageOp(session : pQSession; hosts : pCHar; message : pCHar) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L hosts,A1
+        MOVE.L  message,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -198(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QGetAndSubscribeOp(session : pQSession; path : pCHar; maxBytes : LONGINT) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L path,A1
+        MOVE.L  maxBytes,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -210(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QDetachSession(session : pQSession; flags : ULONG) : BOOLEAN;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVE.L  flags,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -216(A6)
+        MOVEA.L (A7)+,A6
+        TST.W   D0
+        BEQ.B   @end
+        MOVEQ   #1,D0
+  @end: MOVE.B  D0,@RESULT
+  END;
+END;
+
+FUNCTION QReattachSession(session : pQSession; flags : ULONG) : BOOLEAN;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVE.L  flags,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -222(A6)
+        MOVEA.L (A7)+,A6
+        TST.W   D0
+        BEQ.B   @end
+        MOVEQ   #1,D0
+  @end: MOVE.B  D0,@RESULT
+  END;
+END;
+
+FUNCTION QNewSocketSession(host : pCHar; port : LONGINT; tags : pTagItem) : pQSession;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L host,A0
+        MOVE.L  port,D0
+        MOVEA.L tags,A1
+        MOVEA.L AMarqueeBase,A6
+        JSR     -228(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QSendRawOp(session : pQSession; buf : POINTER; len : ULONG) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L buf,A1
+        MOVE.L  len,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -234(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QNewSocketSessionAsync(host : pCHar; port : LONGINT; tags : pTagItem) : pQSession;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L host,A0
+        MOVE.L  port,D0
+        MOVEA.L tags,A1
+        MOVEA.L AMarqueeBase,A6
+        JSR     -240(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QNewSocketServerSession(port : pLONGINT; tags : pTagItem) : pQSession;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L port,A0
+        MOVEA.L tags,A1
+        MOVEA.L AMarqueeBase,A6
+        JSR     -246(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QSetKeyAccessOp(session : pQSession; path : pCHar; hosts : pCHar) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L path,A1
+        MOVE.L  hosts,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -252(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QGetHostName(session : pQSession) : pCHar;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -258(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QGetProgName(session : pQSession) : pCHar;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -264(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE QSetMaxRawBufSize(session : pQSession; maxBufSize : ULONG);
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVE.L  maxBufSize,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -270(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION QNewSession(host : pCHar; port : LONGINT; name : pCHar; taglist : pTagItem) : pQSession;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L host,A0
+        MOVE.L  port,D0
+        MOVEA.L name,A1
+        MOVE.L  taglist,D1
+        MOVEA.L AMarqueeBase,A6
+        JSR     -276(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QNewSessionAsync(host : pCHar; port : LONGINT; name : pCHar; taglist : pTagItem) : pQSession;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L host,A0
+        MOVE.L  port,D0
+        MOVEA.L name,A1
+        MOVE.L  taglist,D1
+        MOVEA.L AMarqueeBase,A6
+        JSR     -282(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QNewHostSession(hostnames : pCHar; port : pLONGINT; names : pCHar; taglist : pTagItem) : pQSession;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L hostnames,A0
+        MOVEA.L port,A1
+        MOVE.L  names,D0
+        MOVE.L  taglist,D1
+        MOVEA.L AMarqueeBase,A6
+        JSR     -288(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QNewServerSession(hostNames : pCHar; progNames : pCHar; taglist : pTagItem) : pQSession;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L hostNames,A0
+        MOVEA.L progNames,A1
+        MOVE.L  taglist,D0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -294(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION QCreateSharedMessagePort : pQSharedMessagePort;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L AMarqueeBase,A6
+        JSR     -300(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE QDeleteSharedMessagePort(mp : pQSharedMessagePort);
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L mp,A0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -306(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+
+FUNCTION QGetLocalIP(session : pQSession) : pCHAR;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L session,A0
+        MOVEA.L AMarqueeBase,A6
+        JSR     -312(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
 
 FUNCTION QDebugOp(session : pQSession; string_ : string) : LONGINT;
 begin
@@ -411,82 +1002,153 @@ begin
     QNewServerSession := QNewServerSession(pas2c(hostnames),pas2c(prognames),taglist);
 end;
 
-FUNCTION QNewSocketSessiontags(host : pCHar; port : LONGINT; const argv : array of PtrUInt) : pQSession;
+FUNCTION QNewSocketSessiontags(host : pCHar; port : LONGINT; const argv : Array Of Const) : pQSession;
 begin
-    QNewSocketSessiontags := QNewSocketSession(host,port,@argv);
+    QNewSocketSessiontags := QNewSocketSession(host,port,readintags(argv));
 end;
 
-FUNCTION QNewSocketSessionAsyncTags(host : pCHar; port : LONGINT; const argv : array of PtrUInt) : pQSession;
+FUNCTION QNewSocketSessionAsyncTags(host : pCHar; port : LONGINT; const argv : Array Of Const) : pQSession;
 begin
-    QNewSocketSessionAsyncTags := QNewSocketSessionAsync(host,port,@argv);
+    QNewSocketSessionAsyncTags := QNewSocketSessionAsync(host,port,readintags(argv));
 end;
 
-FUNCTION QNewSocketServerSessionTags( port : pLONGINT; const argv : array of PtrUInt) : pQSession;
+FUNCTION QNewSocketServerSessionTags( port : pLONGINT; const argv : Array Of Const) : pQSession;
 begin
-    QNewSocketServerSessionTags := QNewSocketServerSession(port,@argv);
+    QNewSocketServerSessionTags := QNewSocketServerSession(port,readintags(argv));
 end;
 
-FUNCTION QNewSessionTags(host : pCHar; port : LONGINT; name : pCHar; const argv : array of PtrUInt) : pQSession;
+FUNCTION QNewSessionTags(host : pCHar; port : LONGINT; name : pCHar; const argv : Array Of Const) : pQSession;
 begin
-    QNewSessionTags := QNewSession(host,port,name,@argv);
+    QNewSessionTags := QNewSession(host,port,name,readintags(argv));
 end;
 
-FUNCTION QNewSessionAsyncTags(host : pCHar; port : LONGINT; name : pCHar; const argv : array of PtrUInt) : pQSession;
+FUNCTION QNewSessionAsyncTags(host : pCHar; port : LONGINT; name : pCHar; const argv : Array Of Const) : pQSession;
 begin
-    QNewSessionAsyncTags := QNewSessionAsync(host,port,name,@argv);
+    QNewSessionAsyncTags := QNewSessionAsync(host,port,name,readintags(argv));
 end;
 
-FUNCTION QNewHostSessionTags(hostnames : pCHar; port : pLONGINT; names : pCHar; const argv : array of PtrUInt) : pQSession;
+FUNCTION QNewHostSessionTags(hostnames : pCHar; port : pLONGINT; names : pCHar; const argv : Array Of Const) : pQSession;
 begin
-    QNewHostSessionTags := QNewHostSession(hostnames,port,names,@argv);
+    QNewHostSessionTags := QNewHostSession(hostnames,port,names,readintags(argv));
 end;
 
-FUNCTION QNewServerSessionTags(hostNames : pCHar; progNames : pCHar; const argv : array of PtrUInt) : pQSession;
+FUNCTION QNewServerSessionTags(hostNames : pCHar; progNames : pCHar; const argv : Array Of Const) : pQSession;
 begin
-    QNewServerSessionTags := QNewServerSession(hostnames,prognames,@argv);
+    QNewServerSessionTags := QNewServerSession(hostnames,prognames,readintags(argv));
 end;
 
 
-FUNCTION QNewSocketSessionTags(host : string; port : LONGINT; const argv : array of PtrUInt) : pQSession;
+FUNCTION QNewSocketSessionTags(host : string; port : LONGINT; const argv : Array Of Const) : pQSession;
 begin
-    QNewSocketSessionTags := QNewSocketSession(host,port,@argv);
+    QNewSocketSessionTags := QNewSocketSession(host,port,readintags(argv));
 end;
 
-FUNCTION QNewSocketSessionAsyncTags(host : string; port : LONGINT; const argv : array of PtrUInt) : pQSession;
+FUNCTION QNewSocketSessionAsyncTags(host : string; port : LONGINT; const argv : Array Of Const) : pQSession;
 begin
-    QNewSocketSessionAsyncTags := QNewSocketSessionAsync(host,port,@argv);
+    QNewSocketSessionAsyncTags := QNewSocketSessionAsync(host,port,readintags(argv));
 end;
 
-FUNCTION QNewSessionTags(host : string; port : LONGINT; name : string; const argv : array of PtrUInt) : pQSession;
+FUNCTION QNewSessionTags(host : string; port : LONGINT; name : string; const argv : Array Of Const) : pQSession;
 begin
-    QNewSessionTags := QNewSession(host,port,name,@argv);
+    QNewSessionTags := QNewSession(host,port,name,readintags(argv));
 end;
 
-FUNCTION QNewSessionAsyncTags(host : string; port : LONGINT; name : string; const argv : array of PtrUInt) : pQSession;
+FUNCTION QNewSessionAsyncTags(host : string; port : LONGINT; name : string; const argv : Array Of Const) : pQSession;
 begin
-    QNewSessionAsyncTags := QNewSessionAsync(host,port,name,@argv);
+    QNewSessionAsyncTags := QNewSessionAsync(host,port,name,readintags(argv));
 end;
 
-FUNCTION QNewHostSessionTags(hostnames : string; port : pLONGINT; names : string; const argv : array of PtrUInt) : pQSession;
+FUNCTION QNewHostSessionTags(hostnames : string; port : pLONGINT; names : string; const argv : Array Of Const) : pQSession;
 begin
-    QNewHostSessionTags := QNewHostSession(hostnames,port,names,@argv);
+    QNewHostSessionTags := QNewHostSession(hostnames,port,names,readintags(argv));
 end;
 
-FUNCTION QNewServerSessionTags(hostNames : string; progNames : string; const argv : array of PtrUInt) : pQSession;
+FUNCTION QNewServerSessionTags(hostNames : string; progNames : string; const argv : Array Of Const) : pQSession;
 begin
-    QNewServerSessionTags := QNewServerSession(hostnames,prognames,@argv);
+    QNewServerSessionTags := QNewServerSession(hostnames,prognames,readintags(argv));
 end;
 
 const
     { Change VERSION and LIBVERSION to proper values }
+
     VERSION : string[2] = '0';
     LIBVERSION : longword = 0;
 
-initialization
-  AMarqueeBase := OpenLibrary(AMARQUEENAME,LIBVERSION);
-finalization
-  if Assigned(AMarqueeBase) then
-    CloseLibrary(AMarqueeBase);
+{$ifdef use_init_openlib}
+  {$Info Compiling initopening of amarquee.library}
+  {$Info don't forget to use InitAMARQUEELibrary in the beginning of your program}
+
+var
+    amarquee_exit : Pointer;
+
+procedure CloseamarqueeLibrary;
+begin
+    ExitProc := amarquee_exit;
+    if AMarqueeBase <> nil then begin
+        CloseLibrary(AMarqueeBase);
+        AMarqueeBase := nil;
+    end;
+end;
+
+procedure InitAMARQUEELibrary;
+begin
+    AMarqueeBase := nil;
+    AMarqueeBase := OpenLibrary(AMARQUEENAME,LIBVERSION);
+    if AMarqueeBase <> nil then begin
+        amarquee_exit := ExitProc;
+        ExitProc := @CloseamarqueeLibrary;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open amarquee.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+end;
+
+begin
+    AMARQUEEIsCompiledHow := 2;
+{$endif use_init_openlib}
+
+{$ifdef use_auto_openlib}
+  {$Info Compiling autoopening of amarquee.library}
+
+var
+    amarquee_exit : Pointer;
+
+procedure CloseamarqueeLibrary;
+begin
+    ExitProc := amarquee_exit;
+    if AMarqueeBase <> nil then begin
+        CloseLibrary(AMarqueeBase);
+        AMarqueeBase := nil;
+    end;
+end;
+
+begin
+    AMarqueeBase := nil;
+    AMarqueeBase := OpenLibrary(AMARQUEENAME,LIBVERSION);
+    if AMarqueeBase <> nil then begin
+        amarquee_exit := ExitProc;
+        ExitProc := @CloseamarqueeLibrary;
+        AMARQUEEIsCompiledHow := 1;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open amarquee.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+
+{$endif use_auto_openlib}
+
+{$ifdef dont_use_openlib}
+begin
+    AMARQUEEIsCompiledHow := 3;
+   {$Warning No autoopening of amarquee.library compiled}
+   {$Warning Make sure you open amarquee.library yourself}
+{$endif dont_use_openlib}
+
 END. (* UNIT AMARQUEE *)
 
 

packages/amunits/src/otherlibs/lucyplay.pas

@@ -28,12 +28,18 @@
   [email protected] Nils Sjoholm
 }
 
+
+{$I useamigasmartlink.inc}
+{$ifdef use_amiga_smartlink}
+   {$smartlink on}
+{$endif use_amiga_smartlink}
+
 UNIT LUCYPLAY;
 
 INTERFACE
 USES Exec;
 
-VAR LucyPlayBase : pLibrary = nil;
+VAR LucyPlayBase : pLibrary;
 
 const
     LUCYPLAYNAME : PChar = 'lucyplay.library';
@@ -90,33 +96,276 @@ const
      LUC_ERR_READJOYPORT = 9;
      LUC_ERR_DOIO = 10;
 
-PROCEDURE lucAudioFree(smp : pLucyPlaySample location 'a0'); syscall LucyPlayBase 48;
-FUNCTION lucAudioInit : LONGINT; syscall LucyPlayBase 30;
-PROCEDURE lucAudioKill; syscall LucyPlayBase 36;
-FUNCTION lucAudioLoad(fname : pCHAR location 'a0') : pLucyPlaySample; syscall LucyPlayBase 42;
-PROCEDURE lucAudioPlay(smp : pLucyPlaySample location 'a0'); syscall LucyPlayBase 54;
-PROCEDURE lucAudioStop; syscall LucyPlayBase 60;
-PROCEDURE lucAudioWait; syscall LucyPlayBase 66;
-FUNCTION lucBestModeID(w : longword location 'd0'; h : longword location 'd1'; d : longword location 'd2') : longword; syscall LucyPlayBase 96;
-FUNCTION lucError : longword; syscall LucyPlayBase 108;
-FUNCTION lucJoyInit : pLucyPlayJoystick; syscall LucyPlayBase 72;
-FUNCTION lucJoyInitForce : pLucyPlayJoystick; syscall LucyPlayBase 102;
-PROCEDURE lucJoyKill(joy : pLucyPlayJoystick location 'a0'); syscall LucyPlayBase 78;
-PROCEDURE lucJoyRead(joy : pLucyPlayJoystick location 'a0'); syscall LucyPlayBase 84;
-FUNCTION lucJoyReadBool : longword; syscall LucyPlayBase 90;
+
+
+
+PROCEDURE lucAudioFree(smp : pLucyPlaySample);
+FUNCTION lucAudioInit : LONGINT;
+PROCEDURE lucAudioKill;
+FUNCTION lucAudioLoad(fname : pCHAR) : pLucyPlaySample;
+PROCEDURE lucAudioPlay(smp : pLucyPlaySample);
+PROCEDURE lucAudioStop;
+PROCEDURE lucAudioWait;
+FUNCTION lucBestModeID(w : longword; h : longword; d : longword) : longword;
+FUNCTION lucError : longword;
+FUNCTION lucJoyInit : pLucyPlayJoystick;
+FUNCTION lucJoyInitForce : pLucyPlayJoystick;
+PROCEDURE lucJoyKill(joy : pLucyPlayJoystick);
+PROCEDURE lucJoyRead(joy : pLucyPlayJoystick);
+FUNCTION lucJoyReadBool : longword;
+
+{You can remove this include and use a define instead}
+{$I useautoopenlib.inc}
+{$ifdef use_init_openlib}
+procedure InitLUCYPLAYLibrary;
+{$endif use_init_openlib}
+
+{This is a variable that knows how the unit is compiled}
+var
+    LUCYPLAYIsCompiledHow : longint;
 
 IMPLEMENTATION
 
+{$ifndef dont_use_openlib}
+uses amsgbox;
+{$endif dont_use_openlib}
+
+PROCEDURE lucAudioFree(smp : pLucyPlaySample);
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L smp,A0
+        MOVEA.L LucyPlayBase,A6
+        JSR     -048(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION lucAudioInit : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L LucyPlayBase,A6
+        JSR     -030(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE lucAudioKill;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L LucyPlayBase,A6
+        JSR     -036(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION lucAudioLoad(fname : pCHAR) : pLucyPlaySample;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L fname,A0
+        MOVEA.L LucyPlayBase,A6
+        JSR     -042(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE lucAudioPlay(smp : pLucyPlaySample);
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L smp,A0
+        MOVEA.L LucyPlayBase,A6
+        JSR     -054(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE lucAudioStop;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L LucyPlayBase,A6
+        JSR     -060(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE lucAudioWait;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L LucyPlayBase,A6
+        JSR     -066(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION lucBestModeID(w : longword; h : longword; d : longword) : longword;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  w,D0
+        MOVE.L  h,D1
+        MOVE.L  d,D2
+        MOVEA.L LucyPlayBase,A6
+        JSR     -096(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION lucError : longword;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L LucyPlayBase,A6
+        JSR     -108(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION lucJoyInit : pLucyPlayJoystick;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L LucyPlayBase,A6
+        JSR     -072(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION lucJoyInitForce : pLucyPlayJoystick;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L LucyPlayBase,A6
+        JSR     -102(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE lucJoyKill(joy : pLucyPlayJoystick);
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L joy,A0
+        MOVEA.L LucyPlayBase,A6
+        JSR     -078(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE lucJoyRead(joy : pLucyPlayJoystick);
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L joy,A0
+        MOVEA.L LucyPlayBase,A6
+        JSR     -084(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION lucJoyReadBool : longword;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L LucyPlayBase,A6
+        JSR     -090(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
 const
     { Change VERSION and LIBVERSION to proper values }
+
     VERSION : string[2] = '0';
     LIBVERSION : longword = 0;
 
-initialization
-  LucyPlayBase := OpenLibrary(LUCYPLAYNAME,LIBVERSION);
-finalization
-  if Assigned(LucyPlayBase) then
-    CloseLibrary(LucyPlayBase);
+{$ifdef use_init_openlib}
+  {$Info Compiling initopening of lucyplay.library}
+  {$Info don't forget to use InitLUCYPLAYLibrary in the beginning of your program}
+
+var
+    lucyplay_exit : Pointer;
+
+procedure CloselucyplayLibrary;
+begin
+    ExitProc := lucyplay_exit;
+    if LucyPlayBase <> nil then begin
+        CloseLibrary(LucyPlayBase);
+        LucyPlayBase := nil;
+    end;
+end;
+
+procedure InitLUCYPLAYLibrary;
+begin
+    LucyPlayBase := nil;
+    LucyPlayBase := OpenLibrary(LUCYPLAYNAME,LIBVERSION);
+    if LucyPlayBase <> nil then begin
+        lucyplay_exit := ExitProc;
+        ExitProc := @CloselucyplayLibrary;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open lucyplay.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+end;
+
+begin
+    LUCYPLAYIsCompiledHow := 2;
+{$endif use_init_openlib}
+
+{$ifdef use_auto_openlib}
+  {$Info Compiling autoopening of lucyplay.library}
+
+var
+    lucyplay_exit : Pointer;
+
+procedure CloselucyplayLibrary;
+begin
+    ExitProc := lucyplay_exit;
+    if LucyPlayBase <> nil then begin
+        CloseLibrary(LucyPlayBase);
+        LucyPlayBase := nil;
+    end;
+end;
+
+begin
+    LucyPlayBase := nil;
+    LucyPlayBase := OpenLibrary(LUCYPLAYNAME,LIBVERSION);
+    if LucyPlayBase <> nil then begin
+        lucyplay_exit := ExitProc;
+        ExitProc := @CloselucyplayLibrary;
+        LUCYPLAYIsCompiledHow := 1;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open lucyplay.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+
+{$endif use_auto_openlib}
+
+{$ifdef dont_use_openlib}
+begin
+    LUCYPLAYIsCompiledHow := 3;
+   {$Warning No autoopening of lucyplay.library compiled}
+   {$Warning Make sure you open lucyplay.library yourself}
+{$endif dont_use_openlib}
+
 END. (* UNIT LUCYPLAY *)
 
 

packages/amunits/src/otherlibs/triton.pas

@@ -17,7 +17,7 @@
 {
     History
 
-    Updated to triton 2.0. Added function with array of PtrUInt.
+    Updated to triton 2.0. Added function with array of const.
     09 Jan 2003.
 
     Added the defines use_amiga_smartlink and
@@ -33,6 +33,11 @@
 
 }
 
+{$mode objfpc}
+{$I useamigasmartlink.inc}
+{$ifdef use_amiga_smartlink}
+    {$smartlink on}
+{$endif use_amiga_smartlink}
 
 UNIT TRITON;
 
@@ -680,64 +685,78 @@ surrounding array *}
         TRFB_TEXT               = $00000004;     {* A text container *}
 
 
-VAR TritonBase : pLibrary = nil;
-
-FUNCTION TR_AddClass(app : pTR_App location 'a1'; d0arg : longword location 'd0'; supertag : longword location 'd1'; defaultmethod : LONGINT location 'a2'; datasize : longword location 'd2'; tags : pTagItem location 'a0') : BOOLEAN; syscall TritonBase 168;
-PROCEDURE TR_AreaFill(project : pTR_Project location 'a0'; rp : pRastPort location 'a1'; left : ULONG location 'd0'; top :ULONG location 'd1'; right : ULONG location 'd2'; bottom : ULONG location 'd3'; typ : ULONG location 'd4'; dummy : POINTER location 'a2'); syscall TritonBase 228;
-FUNCTION TR_AutoRequest(app : pTR_App location 'a1'; lockproject : pTR_Project location 'a0'; wintags : pTagItem location 'a2'): ULONG; syscall TritonBase 84;
-PROCEDURE TR_CloseProject(project : pTR_Project location 'a0'); syscall TritonBase 36;
-PROCEDURE TR_CloseWindowSafely(window : pWindow location 'a0'); syscall TritonBase 126;
-FUNCTION TR_CreateApp(apptags : pTagItem location 'a1') : pTR_App; syscall TritonBase 96;
-FUNCTION TR_CreateMsg(app : pTR_App location 'a1') : pTR_Message; syscall TritonBase 234;
-PROCEDURE TR_DeleteApp(app : pTR_App location 'a1'); syscall TritonBase 102;
-FUNCTION TR_DoMethod(obj : pTROD_Object location 'a0'; messageid : ULONG location 'd0'; data : POINTER location 'a1') : ULONG; syscall TritonBase 216;
-FUNCTION TR_DoMethodClass(obj : pTROD_Object location 'a0'; messageid : ULONG location 'd0'; data : POINTER location 'a1'; trclass : pTR_Class location 'a2') : ULONG; syscall TritonBase 222;
-PROCEDURE TR_DrawFrame(project : pTR_Project location 'a0'; rp : pRastPort location 'a1'; left : WORD location 'd1'; top : WORD location 'd2'; width : WORD location 'd3'; height : WORD location 'd4'; typ : WORD location 'd0'; inverted : BOOLEAN location 'd5'); syscall TritonBase 174;
-FUNCTION TR_EasyRequest(app : pTR_App location 'a1'; bodyfmt : pCHAR location 'a2'; gadfmt : pCHAR location 'a3'; taglist : pTagItem location 'a0') : ULONG; syscall TritonBase 90;
-FUNCTION TR_EasyRequest(app : pTR_App; bodyfmt : pCHAR; gadfmt : String; taglist : pTagItem) : ULONG;
-FUNCTION TR_EasyRequest(app : pTR_App; bodyfmt : String; gadfmt : pCHAR; taglist : pTagItem) : ULONG;
-FUNCTION TR_EasyRequest(app : pTR_App; bodyfmt : String; gadfmt : String; taglist : pTagItem) : ULONG;
-FUNCTION TR_FirstOccurance(ch : BYTE location 'd0'; str : pCHAR location 'a0') : LONGINT; syscall TritonBase 42;
+VAR TritonBase : pLibrary;
+
+FUNCTION TR_AddClass(app : pTR_App; d0arg : longword; supertag : longword; defaultmethod : LONGINT;
+datasize : longword; tags : pTagItem) : BOOLEAN;
+PROCEDURE TR_AreaFill(project : pTR_Project; rp : pRastPort; left : ULONG; top :
+ULONG; right : ULONG; bottom : ULONG; typ : ULONG; dummy : POINTER);
+FUNCTION TR_AutoRequest(app : pTR_App; lockproject : pTR_Project; wintags : pTagItem)
+: ULONG;
+PROCEDURE TR_CloseProject(project : pTR_Project);
+PROCEDURE TR_CloseWindowSafely(window : pWindow);
+FUNCTION TR_CreateApp(apptags : pTagItem) : pTR_App;
+FUNCTION TR_CreateMsg(app : pTR_App) : pTR_Message;
+PROCEDURE TR_DeleteApp(app : pTR_App);
+FUNCTION TR_DoMethod(obj : pTROD_Object; messageid : ULONG; data : POINTER) : ULONG;
+FUNCTION TR_DoMethodClass(obj : pTROD_Object; messageid : ULONG; data : POINTER;
+trclass : pTR_Class) : ULONG;
+PROCEDURE TR_DrawFrame(project : pTR_Project; rp : pRastPort; left : WORD; top : WORD;
+width : WORD; height : WORD; typ : WORD; inverted : BOOLEAN);
+FUNCTION TR_EasyRequest(app : pTR_App; bodyfmt : pCHAR; gadfmt : pCHAR; taglist :
+pTagItem) : ULONG;
+FUNCTION TR_EasyRequest(app : pTR_App; bodyfmt : pCHAR; gadfmt : String; taglist :
+pTagItem) : ULONG;
+FUNCTION TR_EasyRequest(app : pTR_App; bodyfmt : String; gadfmt : pCHAR; taglist :
+pTagItem) : ULONG;
+FUNCTION TR_EasyRequest(app : pTR_App; bodyfmt : String; gadfmt : String; taglist :
+pTagItem) : ULONG;
+FUNCTION TR_FirstOccurance(ch : BYTE; str : pCHAR) : LONGINT;
 FUNCTION TR_FirstOccurance(ch : BYTE; str : String) : LONGINT;
-FUNCTION TR_FrameBorderHeight(project : pTR_Project location 'a0'; typ : WORD location 'd0') : ULONG; syscall TritonBase 186;
-FUNCTION TR_FrameBorderWidth(project : pTR_Project location 'a0'; typ : WORD location 'd0') : ULONG; syscall TritonBase 180;
-FUNCTION TR_GetAttribute(project : pTR_Project location 'a0'; ID : ULONG location 'd0'; attribute : ULONG location 'd1') : ULONG; syscall TritonBase 66;
-FUNCTION TR_GetErrorString(num : WORD location 'd0') : pCHAR; syscall TritonBase 54;
-FUNCTION TR_GetLastError(app : pTR_App location 'a1') : WORD; syscall TritonBase 132;
-FUNCTION TR_GetMsg(app : pTR_App location 'a1') : pTR_Message; syscall TritonBase 108;
-FUNCTION TR_GetPen(project : pTR_Project location 'a0'; pentype : ULONG location 'd0'; pendata : ULONG location 'd1') : ULONG; syscall TritonBase 210;
-PROCEDURE TR_LockProject(project : pTR_Project location 'a0'); syscall TritonBase 72;
-FUNCTION TR_LockScreen(project : pTR_Project location 'a0') : pScreen; syscall TritonBase 138;
-FUNCTION TR_NumOccurances(ch : BYTE location 'd0'; str : pCHAR location 'a0') : LONGINT; syscall TritonBase 48;
+FUNCTION TR_FrameBorderHeight(project : pTR_Project; typ : WORD) : ULONG;
+FUNCTION TR_FrameBorderWidth(project : pTR_Project; typ : WORD) : ULONG;
+FUNCTION TR_GetAttribute(project : pTR_Project; ID : ULONG; attribute : ULONG) :
+ULONG;
+FUNCTION TR_GetErrorString(num : WORD) : pCHAR;
+FUNCTION TR_GetLastError(app : pTR_App) : WORD;
+FUNCTION TR_GetMsg(app : pTR_App) : pTR_Message;
+FUNCTION TR_GetPen(project : pTR_Project; pentype : ULONG; pendata : ULONG) : ULONG;
+PROCEDURE TR_LockProject(project : pTR_Project);
+FUNCTION TR_LockScreen(project : pTR_Project) : pScreen;
+FUNCTION TR_NumOccurances(ch : BYTE; str : pCHAR) : LONGINT;
 FUNCTION TR_NumOccurances(ch : BYTE; str : String) : LONGINT;
-FUNCTION TR_ObtainWindow(project : pTR_Project location 'a0') : pWindow; syscall TritonBase 150;
-FUNCTION TR_OpenProject(app : pTR_App location 'a1'; taglist : pTagItem location 'a0') : pTR_Project; syscall TritonBase 30;
-PROCEDURE TR_PrintText(project : pTR_Project location 'a0'; rp : pRastPort location 'a1'; txt : pCHAR location 'a2'; x : ULONG location 'd1'; y : ULONG location 'd2'; width : ULONG location 'd3'; flags : ULONG location 'd0'); syscall TritonBase 204;
-PROCEDURE TR_PrintText(project : pTR_Project; rp : pRastPort; txt : String; x : ULONG; y : ULONG; width : ULONG; flags : ULONG);
-PROCEDURE TR_ReleaseWindow(window : pWindow location 'a0'); syscall TritonBase 156;
-PROCEDURE TR_ReplyMsg(message : pTR_Message location 'a1'); syscall TritonBase 114;
-FUNCTION TR_SendMessage(project : pTR_Project location 'a0'; objectid : ULONG location 'd0'; messageid : ULONG location 'd1'; messagedata : POINTER location 'a1') : ULONG; syscall TritonBase 162;
-PROCEDURE TR_SetAttribute(project : pTR_Project location 'a0'; ID : ULONG location 'd0'; attribute : ULONG location 'd1'; value: ULONG location 'd2'); syscall TritonBase 60;
-FUNCTION TR_TextHeight(project : pTR_Project location 'a0'; txt : pCHAR location 'a2'; flags : ULONG location 'd0') : ULONG; syscall TritonBase 198;
+FUNCTION TR_ObtainWindow(project : pTR_Project) : pWindow;
+FUNCTION TR_OpenProject(app : pTR_App; taglist : pTagItem) : pTR_Project;
+PROCEDURE TR_PrintText(project : pTR_Project; rp : pRastPort; txt : pCHAR; x : ULONG;
+y : ULONG; width : ULONG; flags : ULONG);
+PROCEDURE TR_PrintText(project : pTR_Project; rp : pRastPort; txt : String; x : ULONG;
+y : ULONG; width : ULONG; flags : ULONG);
+PROCEDURE TR_ReleaseWindow(window : pWindow);
+PROCEDURE TR_ReplyMsg(message : pTR_Message);
+FUNCTION TR_SendMessage(project : pTR_Project; objectid : ULONG; messageid : ULONG;
+messagedata : POINTER) : ULONG;
+PROCEDURE TR_SetAttribute(project : pTR_Project; ID : ULONG; attribute : ULONG; value
+: ULONG);
+FUNCTION TR_TextHeight(project : pTR_Project; txt : pCHAR; flags : ULONG) : ULONG;
 FUNCTION TR_TextHeight(project : pTR_Project; txt : String; flags : ULONG) : ULONG;
-FUNCTION TR_TextWidth(project : pTR_Project location 'a0'; txt : pCHAR location 'a2'; flags : ULONG location 'd0') : ULONG; syscall TritonBase 192;
+FUNCTION TR_TextWidth(project : pTR_Project; txt : pCHAR; flags : ULONG) : ULONG;
 FUNCTION TR_TextWidth(project : pTR_Project; txt : String; flags : ULONG) : ULONG;
-PROCEDURE TR_UnlockProject(project : pTR_Project location 'a0'); syscall TritonBase 78;
-PROCEDURE TR_UnlockScreen(screen : pScreen location 'a0'); syscall TritonBase 144;
-FUNCTION TR_Wait(app : pTR_App location 'a1'; otherbits : ULONG location 'd0') : ULONG; syscall TritonBase 120;
+PROCEDURE TR_UnlockProject(project : pTR_Project);
+PROCEDURE TR_UnlockScreen(screen : pScreen);
+FUNCTION TR_Wait(app : pTR_App; otherbits : ULONG) : ULONG;
 
 {
-   Functions with array of PtrUInt
+   Functions with array of const
 }
 FUNCTION TR_AddClassTags(app : pTR_App; d0arg : longword; supertag : longword;
-defaultmethod : LONGINT; datasize : longword; const tags : array of PtrUInt) : BOOLEAN;
-FUNCTION TR_OpenProjectTags(app : pTR_App; const taglist : array of PtrUInt) : pTR_Project;
-FUNCTION TR_AutoRequestTags(app : pTR_App; lockproject : pTR_Project; const wintags : array of PtrUInt): ULONG;
-FUNCTION TR_CreateAppTags(const apptags : array of PtrUInt) : pTR_App;
-FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : pCHAR; gadfmt : pCHAR; const taglist : array of PtrUInt) : ULONG;
-FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : pCHAR; gadfmt : String; Const taglist : array of PtrUInt) : ULONG;
-FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : String; gadfmt : pCHAR; Const taglist : array of PtrUInt) : ULONG;
-FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : String; gadfmt : String; Const taglist : array of PtrUInt) : ULONG;
+defaultmethod : LONGINT; datasize : longword; const tags : Array Of Const) : BOOLEAN;
+FUNCTION TR_OpenProjectTags(app : pTR_App; const taglist : Array Of Const) : pTR_Project;
+FUNCTION TR_AutoRequestTags(app : pTR_App; lockproject : pTR_Project; const wintags : Array Of Const): ULONG;
+FUNCTION TR_CreateAppTags(const apptags : Array of Const) : pTR_App;
+FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : pCHAR; gadfmt : pCHAR; const taglist : Array Of Const) : ULONG;
+FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : pCHAR; gadfmt : String; Const taglist : Array Of Const) : ULONG;
+FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : String; gadfmt : pCHAR; Const taglist : Array Of Const) : ULONG;
+FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : String; gadfmt : String; Const taglist : Array Of Const) : ULONG;
 
 {  This are a few support functions for triton.
    Could be handy.
@@ -759,10 +778,23 @@ procedure TR_SetWindowTitle(p : pTR_Project; thetitle : string);
 procedure TR_SetWindowTitle(p : pTR_Project; thetitle : PChar);
 procedure TR_UpdateListView(p : pTR_Project; gadid : Longint; thelist: pList);
 
+{You can remove this include and use a define instead}
+{$I useautoopenlib.inc}
+{$ifdef use_init_openlib}
+procedure InitTRITONLibrary;
+{$endif use_init_openlib}
+
+{This is a variable that knows how the unit is compiled}
+var
+    TRITONIsCompiledHow : longint;
+
 IMPLEMENTATION
 
 uses
-  pastoc;
+{$ifndef dont_use_openlib}
+amsgbox,
+{$endif dont_use_openlib}
+tagsarray,pastoc;
 
 procedure TR_Disable(p : pTR_Project; id : Longint);
 begin
@@ -849,6 +881,182 @@ begin
     TR_SetAttribute(p,gadid,0,Longint(thelist));
 end;
 
+FUNCTION TR_AddClass(app : pTR_App; d0arg : longword; supertag : longword; defaultmethod : LONGINT; datasize : longword; tags : pTagItem) : BOOLEAN;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L app,A1
+        MOVE.L  d0arg,D0
+        MOVE.L  supertag,D1
+        MOVEA.L defaultmethod,A2
+        MOVE.L  datasize,D2
+        MOVEA.L tags,A0
+        MOVEA.L TritonBase,A6
+        JSR     -168(A6)
+        MOVEA.L (A7)+,A6
+        TST.W   D0
+        BEQ.B   @end
+        MOVEQ   #1,D0
+  @end: MOVE.B  D0,@RESULT
+  END;
+END;
+
+
+PROCEDURE TR_AreaFill(project : pTR_Project; rp : pRastPort; left : ULONG; top :
+ULONG; right : ULONG; bottom : ULONG; typ : ULONG; dummy : POINTER);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVEA.L rp,A1
+    MOVE.L  left,D0
+    MOVE.L  top,D1
+    MOVE.L  right,D2
+    MOVE.L  bottom,D3
+    MOVE.L  typ,D4
+    MOVEA.L dummy,A2
+    MOVEA.L TritonBase,A6
+    JSR -228(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION TR_AutoRequest(app : pTR_App; lockproject : pTR_Project; wintags : pTagItem)
+: ULONG;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L app,A1
+    MOVEA.L lockproject,A0
+    MOVEA.L wintags,A2
+    MOVEA.L TritonBase,A6
+    JSR -084(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE TR_CloseProject(project : pTR_Project);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVEA.L TritonBase,A6
+    JSR -036(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE TR_CloseWindowSafely(window : pWindow);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L window,A0
+    MOVEA.L TritonBase,A6
+    JSR -126(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION TR_CreateApp(apptags : pTagItem) : pTR_App;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L apptags,A1
+    MOVEA.L TritonBase,A6
+    JSR -096(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION TR_CreateMsg(app : pTR_App) : pTR_Message;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L app,A1
+    MOVEA.L TritonBase,A6
+    JSR -234(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE TR_DeleteApp(app : pTR_App);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L app,A1
+    MOVEA.L TritonBase,A6
+    JSR -102(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION TR_DoMethod(obj : pTROD_Object; messageid : ULONG; data : POINTER) : ULONG;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L obj,A0
+    MOVE.L  messageid,D0
+    MOVEA.L data,A1
+    MOVEA.L TritonBase,A6
+    JSR -216(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION TR_DoMethodClass(obj : pTROD_Object; messageid : ULONG; data : POINTER;
+trclass : pTR_Class) : ULONG;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L obj,A0
+    MOVE.L  messageid,D0
+    MOVEA.L data,A1
+    MOVEA.L trclass,A2
+    MOVEA.L TritonBase,A6
+    JSR -222(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE TR_DrawFrame(project : pTR_Project; rp : pRastPort; left : WORD; top : WORD;
+width : WORD; height : WORD; typ : WORD; inverted : BOOLEAN);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVEA.L rp,A1
+    MOVE.L  left,D1
+    MOVE.L  top,D2
+    MOVE.L  width,D3
+    MOVE.L  height,D4
+    MOVE.L  typ,D0
+    MOVE.L  inverted,D5
+    MOVEA.L TritonBase,A6
+    JSR -174(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION TR_EasyRequest(app : pTR_App; bodyfmt : pCHAR; gadfmt : pCHAR; taglist :
+pTagItem) : ULONG;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L app,A1
+    MOVEA.L bodyfmt,A2
+    MOVEA.L gadfmt,A3
+    MOVEA.L taglist,A0
+    MOVEA.L TritonBase,A6
+    JSR -090(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
 
 FUNCTION TR_EasyRequest(app : pTR_App; bodyfmt : PChar; gadfmt : String; taglist :
 pTagItem) : ULONG;
@@ -868,88 +1076,459 @@ begin
     TR_EasyRequest := TR_EasyRequest(app,pas2c(bodyfmt),pas2c(gadfmt),taglist);
 end;
 
+FUNCTION TR_FirstOccurance(ch : BYTE; str : pCHAR) : LONGINT;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVE.L  ch,D0
+    MOVEA.L str,A0
+    MOVEA.L TritonBase,A6
+    JSR -042(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
 FUNCTION TR_FirstOccurance(ch : BYTE; str : String) : LONGINT;
 BEGIN
     TR_FirstOccurance := TR_FirstOccurance(ch, pas2c(str));
 END;
 
+FUNCTION TR_FrameBorderHeight(project : pTR_Project; typ : WORD) : ULONG;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVE.L  typ,D0
+    MOVEA.L TritonBase,A6
+    JSR -186(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION TR_FrameBorderWidth(project : pTR_Project; typ : WORD) : ULONG;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVE.L  typ,D0
+    MOVEA.L TritonBase,A6
+    JSR -180(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION TR_GetAttribute(project : pTR_Project; ID : ULONG; attribute : ULONG) :
+ULONG;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVE.L  ID,D0
+    MOVE.L  attribute,D1
+    MOVEA.L TritonBase,A6
+    JSR -066(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION TR_GetErrorString(num : WORD) : pCHAR;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVE.L  num,D0
+    MOVEA.L TritonBase,A6
+    JSR -054(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION TR_GetLastError(app : pTR_App) : WORD;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L app,A1
+    MOVEA.L TritonBase,A6
+    JSR -132(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION TR_GetMsg(app : pTR_App) : pTR_Message;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L app,A1
+    MOVEA.L TritonBase,A6
+    JSR -108(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION TR_GetPen(project : pTR_Project; pentype : ULONG; pendata : ULONG) : ULONG;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVE.L  pentype,D0
+    MOVE.L  pendata,D1
+    MOVEA.L TritonBase,A6
+    JSR -210(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE TR_LockProject(project : pTR_Project);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVEA.L TritonBase,A6
+    JSR -072(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION TR_LockScreen(project : pTR_Project) : pScreen;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVEA.L TritonBase,A6
+    JSR -138(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION TR_NumOccurances(ch : BYTE; str : pCHAR) : LONGINT;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVE.L  ch,D0
+    MOVEA.L str,A0
+    MOVEA.L TritonBase,A6
+    JSR -048(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
 FUNCTION TR_NumOccurances(ch : BYTE; str : String) : LONGINT;
 BEGIN
     TR_NumOccurances := TR_NumOccurances(ch, pas2c(str));
 END;
 
+FUNCTION TR_ObtainWindow(project : pTR_Project) : pWindow;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVEA.L TritonBase,A6
+    JSR -150(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION TR_OpenProject(app : pTR_App; taglist : pTagItem) : pTR_Project;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L app,A1
+    MOVEA.L taglist,A0
+    MOVEA.L TritonBase,A6
+    JSR -030(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE TR_PrintText(project : pTR_Project; rp : pRastPort; txt : pCHAR; x : ULONG;
+y : ULONG; width : ULONG; flags : ULONG);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVEA.L rp,A1
+    MOVEA.L txt,A2
+    MOVE.L  x,D1
+    MOVE.L  y,D2
+    MOVE.L  width,D3
+    MOVE.L  flags,D0
+    MOVEA.L TritonBase,A6
+    JSR -204(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
 PROCEDURE TR_PrintText(project : pTR_Project; rp : pRastPort; txt : String; x : ULONG;
 y : ULONG; width : ULONG; flags : ULONG);
 BEGIN
     TR_PrintText(project,rp,pas2c(txt),x,y,width,flags);
 END;
 
+PROCEDURE TR_ReleaseWindow(window : pWindow);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L window,A0
+    MOVEA.L TritonBase,A6
+    JSR -156(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE TR_ReplyMsg(message : pTR_Message);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L message,A1
+    MOVEA.L TritonBase,A6
+    JSR -114(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION TR_SendMessage(project : pTR_Project; objectid : ULONG; messageid : ULONG;
+messagedata : POINTER) : ULONG;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVE.L  objectid,D0
+    MOVE.L  messageid,D1
+    MOVEA.L messagedata,A1
+    MOVEA.L TritonBase,A6
+    JSR -162(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE TR_SetAttribute(project : pTR_Project; ID : ULONG; attribute : ULONG; value
+: ULONG);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVE.L  ID,D0
+    MOVE.L  attribute,D1
+    MOVE.L  value,D2
+    MOVEA.L TritonBase,A6
+    JSR -060(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION TR_TextHeight(project : pTR_Project; txt : pCHAR; flags : ULONG) : ULONG;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVEA.L txt,A2
+    MOVE.L  flags,D0
+    MOVEA.L TritonBase,A6
+    JSR -198(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
 FUNCTION TR_TextHeight(project : pTR_Project; txt : String; flags : ULONG) : ULONG;
 BEGIN
     TR_TextHeight :=  TR_TextHeight(project,pas2c(txt),flags);
 END;
 
+FUNCTION TR_TextWidth(project : pTR_Project; txt : pCHAR; flags : ULONG) : ULONG;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVEA.L txt,A2
+    MOVE.L  flags,D0
+    MOVEA.L TritonBase,A6
+    JSR -192(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
 FUNCTION TR_TextWidth(project : pTR_Project; txt : String; flags : ULONG) : ULONG;
 BEGIN
     TR_TextWidth := TR_TextWidth(project,pas2c(txt),flags);
 END;
 
+PROCEDURE TR_UnlockProject(project : pTR_Project);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L project,A0
+    MOVEA.L TritonBase,A6
+    JSR -078(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE TR_UnlockScreen(screen : pScreen);
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L screen,A0
+    MOVEA.L TritonBase,A6
+    JSR -144(A6)
+    MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION TR_Wait(app : pTR_App; otherbits : ULONG) : ULONG;
+BEGIN
+  ASM
+    MOVE.L  A6,-(A7)
+    MOVEA.L app,A1
+    MOVE.L  otherbits,D0
+    MOVEA.L TritonBase,A6
+    JSR -120(A6)
+    MOVEA.L (A7)+,A6
+    MOVE.L  D0,@RESULT
+  END;
+END;
+
 {
-   Functions with array of PtrUInt
+   Functions with array of const
 }
 {
- Functions and procedures with array of PtrUInt go here
+ Functions and procedures with array of const go here
 }
-FUNCTION TR_AddClassTags(app : pTR_App; d0arg : longword; supertag : longword; defaultmethod : LONGINT; datasize : longword; const tags : array of PtrUInt) : BOOLEAN;
+FUNCTION TR_AddClassTags(app : pTR_App; d0arg : longword; supertag : longword; defaultmethod : LONGINT; datasize : longword; const tags : Array Of Const) : BOOLEAN;
 begin
-    TR_AddClassTags := TR_AddClass(app , d0arg , supertag , defaultmethod , datasize , @tags);
+    TR_AddClassTags := TR_AddClass(app , d0arg , supertag , defaultmethod , datasize , readintags(tags));
 end;
 
-FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : pCHAR; gadfmt : pCHAR; const taglist : array of PtrUInt) : Ulong;
+FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : pCHAR; gadfmt : pCHAR; const taglist : Array Of Const) : Ulong;
 begin
-    TR_EasyRequestTags := TR_EasyRequest(app , bodyfmt , gadfmt , @taglist);
+    TR_EasyRequestTags := TR_EasyRequest(app , bodyfmt , gadfmt , readintags(taglist));
 end;
 
-FUNCTION TR_OpenProjectTags(app : pTR_App; const taglist : array of PtrUInt) : pTR_Project;
+FUNCTION TR_OpenProjectTags(app : pTR_App; const taglist : Array Of Const) : pTR_Project;
 begin
-    TR_OpenProjectTags := TR_OpenProject(app , @taglist);
+    TR_OpenProjectTags := TR_OpenProject(app , readintags(taglist));
 end;
 
-FUNCTION TR_AutoRequestTags(app : pTR_App; lockproject : pTR_Project; const wintags : array of PtrUInt): ULONG;
+FUNCTION TR_AutoRequestTags(app : pTR_App; lockproject : pTR_Project; const wintags : Array Of Const): ULONG;
 begin
-    TR_AutoRequestTags := TR_AutoRequest(app,lockproject, @wintags);
+    TR_AutoRequestTags := TR_AutoRequest(app,lockproject,readintags(wintags));
 end;
 
-FUNCTION TR_CreateAppTags(const apptags : array of PtrUInt) : pTR_App;
+FUNCTION TR_CreateAppTags(const apptags : Array of Const) : pTR_App;
 begin
-    TR_CreateAppTags := TR_CreateApp(@apptags);
+    TR_CreateAppTags := TR_CreateApp(readintags(apptags));
 end;
 
-FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : pCHAR; gadfmt : String; Const taglist : array of PtrUInt) : ULONG;
+FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : pCHAR; gadfmt : String; Const taglist : Array Of Const) : ULONG;
 begin
-    TR_EasyRequestTags := TR_EasyRequest(app,bodyfmt,pas2c(gadfmt), @taglist);
+    TR_EasyRequestTags := TR_EasyRequest(app,bodyfmt,pas2c(gadfmt),readintags(taglist));
 end;
 
-FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : String; gadfmt : pCHAR; Const taglist : array of PtrUInt) : ULONG;
+FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : String; gadfmt : pCHAR; Const taglist : Array Of Const) : ULONG;
 begin
-    TR_EasyRequestTags := TR_EasyRequest(app,pas2c(bodyfmt),gadfmt, @taglist);
+    TR_EasyRequestTags := TR_EasyRequest(app,pas2c(bodyfmt),gadfmt,readintags(taglist));
 end;
 
-FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : String; gadfmt : String; Const taglist : array of PtrUInt) : ULONG;
+FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : String; gadfmt : String; Const taglist : Array Of Const) : ULONG;
 begin
-    TR_EasyRequestTags := TR_EasyRequest(app,pas2c(bodyfmt),pas2c(gadfmt), @taglist);
+    TR_EasyRequestTags := TR_EasyRequest(app,pas2c(bodyfmt),pas2c(gadfmt),readintags(taglist));
 end;
 
 const
     { Change VERSION and LIBVERSION to proper values }
+
     VERSION : string[2] = '0';
     LIBVERSION : longword = 0;
 
-initialization
-  TritonBase := OpenLibrary(TRITONNAME,LIBVERSION);
-finalization
-  if Assigned(TritonBase) then
-    CloseLibrary(TritonBase);
+{$ifdef use_init_openlib}
+  {$Info Compiling initopening of triton.library}
+  {$Info don't forget to use InitTRITONLibrary in the beginning of your program}
+
+var
+    triton_exit : Pointer;
+
+procedure ClosetritonLibrary;
+begin
+    ExitProc := triton_exit;
+    if TritonBase <> nil then begin
+        CloseLibrary(TritonBase);
+        TritonBase := nil;
+    end;
+end;
+
+procedure InitTRITONLibrary;
+begin
+    TritonBase := nil;
+    TritonBase := OpenLibrary(TRITONNAME,LIBVERSION);
+    if TritonBase <> nil then begin
+        triton_exit := ExitProc;
+        ExitProc := @ClosetritonLibrary;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open triton.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+end;
+
+begin
+    TRITONIsCompiledHow := 2;
+{$endif use_init_openlib}
+
+{$ifdef use_auto_openlib}
+  {$Info Compiling autoopening of triton.library}
+
+var
+    triton_exit : Pointer;
+
+procedure ClosetritonLibrary;
+begin
+    ExitProc := triton_exit;
+    if TritonBase <> nil then begin
+        CloseLibrary(TritonBase);
+        TritonBase := nil;
+    end;
+end;
+
+begin
+    TritonBase := nil;
+    TritonBase := OpenLibrary(TRITONNAME,LIBVERSION);
+    if TritonBase <> nil then begin
+        triton_exit := ExitProc;
+        ExitProc := @ClosetritonLibrary;
+        TRITONIsCompiledHow := 1;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open triton.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+
+{$endif use_auto_openlib}
+
+{$ifdef dont_use_openlib}
+begin
+    TRITONIsCompiledHow := 3;
+   {$Warning No autoopening of triton.library compiled}
+   {$Warning Make sure you open triton.library yourself}
+{$endif dont_use_openlib}
+
+
 END. (* UNIT TRITON *)
 
 

packages/amunits/src/otherlibs/xadmaster.pas

@@ -22,6 +22,11 @@
   [email protected] Nils Sjoholm
 }
 
+{$mode objfpc}
+{$I useamigasmartlink.inc}
+{$ifdef use_amiga_smartlink}
+   {$smartlink on}
+{$endif use_amiga_smartlink}
 
 UNIT XADMASTER;
 
@@ -1177,153 +1182,575 @@ const
      XADCID_DMS = 9000;
      XADCID_DMSSFX = 9001;
 
-VAR xadMasterBase : pxadMasterBase = nil;
-
-
-FUNCTION xadAddDiskEntryA(di : pxadDiskInfo location 'a0'; ai : pxadArchiveInfo location 'a1'; CONST tags : pTagItem location 'a2') : LONGINT; syscall xadMasterBase 162;
-FUNCTION xadAddFileEntryA(fi : pxadFileInfo location 'a0'; ai : pxadArchiveInfo location 'a1'; CONST tags : pTagItem location 'a2') : LONGINT; syscall xadMasterBase 156;
-FUNCTION xadAllocObjectA(_type : LONGINT location 'd0'; CONST tags : pTagItem location 'a0') : POINTER; syscall xadMasterBase 30;
-FUNCTION xadAllocVec(size : longword location 'd0'; flags : longword location 'd1') : POINTER; syscall xadMasterBase 108;
-FUNCTION xadCalcCRC16(id : longword location 'd0'; init : longword location 'd1'; size : longword location 'd2'; buffer : pCHAR location 'a0') : WORD; syscall xadMasterBase 96;
-FUNCTION xadCalcCRC32(id : longword location 'd0'; init : longword location 'd1'; size : longword location 'd2'; buffer : pCHAR location 'a0') : longword; syscall xadMasterBase 102;
-FUNCTION xadConvertDatesA(CONST tags : pTagItem location 'a0') : LONGINT; syscall xadMasterBase 90;
-FUNCTION xadConvertNameA(charset : longword location 'd0'; CONST tags : pTagItem location 'a0') : pCHAR; syscall xadMasterBase 174;
-FUNCTION xadConvertProtectionA(CONST tags : pTagItem location 'a0') : LONGINT; syscall xadMasterBase 126;
-PROCEDURE xadCopyMem(src : POINTER location 'a0'; dest : POINTER location 'a1'; size : longword location 'd0'); syscall xadMasterBase 114;
-FUNCTION xadDiskFileUnArcA(ai : pxadArchiveInfo location 'a0'; CONST tags : pTagItem location 'a1') : LONGINT; syscall xadMasterBase 138;
-FUNCTION xadDiskUnArcA(ai : pxadArchiveInfo location 'a0'; CONST tags : pTagItem location 'a1') : LONGINT; syscall xadMasterBase 66;
-FUNCTION xadFileUnArcA(ai : pxadArchiveInfo location 'a0'; CONST tags : pTagItem location 'a1') : LONGINT; syscall xadMasterBase 60;
-FUNCTION xadFreeHookAccessA(ai : pxadArchiveInfo location 'a0'; CONST tags : pTagItem location 'a1') : LONGINT; syscall xadMasterBase 150;
-PROCEDURE xadFreeInfo(ai : pxadArchiveInfo location 'a0'); syscall xadMasterBase 54;
-PROCEDURE xadFreeObjectA(obj : POINTER location 'a0'; CONST tags : pTagItem location 'a1'); syscall xadMasterBase 36;
-FUNCTION xadGetClientInfo : pxadClient; syscall xadMasterBase 78;
-FUNCTION xadGetDiskInfoA(ai : pxadArchiveInfo location 'a0'; CONST tags : pTagItem location 'a1') : LONGINT; syscall xadMasterBase 132;
-FUNCTION xadGetErrorText(errnum : longword location 'd0') : pCHAR; syscall xadMasterBase 72;
-FUNCTION xadGetFilenameA(buffersize : longword location 'd0'; buffer : pCHAR location 'a0'; path : pCHAR location 'a1'; name : pCHAR location 'a2'; CONST tags : pTagItem location 'a3') : LONGINT; syscall xadMasterBase 168;
-FUNCTION xadGetHookAccessA(ai : pxadArchiveInfo location 'a0'; CONST tags : pTagItem location 'a1') : LONGINT; syscall xadMasterBase 144;
-FUNCTION xadGetInfoA(ai : pxadArchiveInfo location 'a0'; CONST tags : pTagItem location 'a1') : LONGINT; syscall xadMasterBase 48;
-FUNCTION xadHookAccess(command : longword location 'd0'; data : LONGINT location 'd1'; buffer : POINTER location 'a0'; ai : pxadArchiveInfo location 'a1') : LONGINT; syscall xadMasterBase 84;
-FUNCTION xadHookTagAccessA(command : longword location 'd0'; data : LONGINT location 'd1'; buffer : POINTER location 'a0'; ai : pxadArchiveInfo location 'a1'; CONST tags : pTagItem location 'a2') : LONGINT; syscall xadMasterBase 120;
-FUNCTION xadRecogFileA(size : longword location 'd0'; memory : POINTER location 'a0'; CONST tags : pTagItem location 'a1') : pxadClient; syscall xadMasterBase 42;
+VAR xadMasterBase : pxadMasterBase;
+
+
+FUNCTION xadAddDiskEntryA(di : pxadDiskInfo; ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+FUNCTION xadAddFileEntryA(fi : pxadFileInfo; ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+FUNCTION xadAllocObjectA(_type : LONGINT; CONST tags : pTagItem) : POINTER;
+FUNCTION xadAllocVec(size : longword; flags : longword) : POINTER;
+FUNCTION xadCalcCRC16(id : longword; init : longword; size : longword; buffer : pCHAR) : WORD;
+FUNCTION xadCalcCRC32(id : longword; init : longword; size : longword; buffer : pCHAR) : longword;
+FUNCTION xadConvertDatesA(CONST tags : pTagItem) : LONGINT;
+FUNCTION xadConvertNameA(charset : longword; CONST tags : pTagItem) : pCHAR;
+FUNCTION xadConvertProtectionA(CONST tags : pTagItem) : LONGINT;
+PROCEDURE xadCopyMem(src : POINTER; dest : POINTER; size : longword);
+FUNCTION xadDiskFileUnArcA(ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+FUNCTION xadDiskUnArcA(ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+FUNCTION xadFileUnArcA(ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+FUNCTION xadFreeHookAccessA(ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+PROCEDURE xadFreeInfo(ai : pxadArchiveInfo);
+PROCEDURE xadFreeObjectA(obj : POINTER; CONST tags : pTagItem);
+FUNCTION xadGetClientInfo : pxadClient;
+FUNCTION xadGetDiskInfoA(ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+FUNCTION xadGetErrorText(errnum : longword) : pCHAR;
+FUNCTION xadGetFilenameA(buffersize : longword; buffer : pCHAR; path : pCHAR; name : pCHAR; CONST tags : pTagItem) : LONGINT;
+FUNCTION xadGetHookAccessA(ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+FUNCTION xadGetInfoA(ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+FUNCTION xadHookAccess(command : longword; data : LONGINT; buffer : POINTER; ai : pxadArchiveInfo) : LONGINT;
+FUNCTION xadHookTagAccessA(command : longword; data : LONGINT; buffer : POINTER; ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+FUNCTION xadRecogFileA(size : longword; memory : POINTER; CONST tags : pTagItem) : pxadClient;
 {
- Functions and procedures with array of PtrUInt go here
+ Functions and procedures with array of const go here
 }
-FUNCTION xadAddDiskEntry(di : pxadDiskInfo; ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
-FUNCTION xadAddFileEntry(fi : pxadFileInfo; ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
-FUNCTION xadAllocObject(_type : LONGINT; const tags : array of PtrUInt) : POINTER;
-FUNCTION xadConvertDates(const tags : array of PtrUInt) : LONGINT;
-FUNCTION xadConvertName(charset : longword; const tags : array of PtrUInt) : pCHAR;
-FUNCTION xadConvertProtection(const tags : array of PtrUInt) : LONGINT;
-FUNCTION xadDiskFileUnArc(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
-FUNCTION xadDiskUnArc(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
-FUNCTION xadFileUnArc(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
-FUNCTION xadFreeHookAccess(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
-PROCEDURE xadFreeObject(obj : POINTER; const tags : array of PtrUInt);
-FUNCTION xadGetDiskInfo(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
-FUNCTION xadGetFilename(buffersize : longword; buffer : pCHAR; path : pCHAR; name : pCHAR; const tags : array of PtrUInt) : LONGINT;
-FUNCTION xadGetHookAccess(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
-FUNCTION xadGetInfo(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
-FUNCTION xadHookTagAccess(command : longword; data : LONGINT; buffer : POINTER; ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
-FUNCTION xadRecogFile(size : longword; memory : POINTER; const tags : array of PtrUInt) : pxadClient;
+FUNCTION xadAddDiskEntry(di : pxadDiskInfo; ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadAddFileEntry(fi : pxadFileInfo; ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadAllocObject(_type : LONGINT; const tags : Array Of Const) : POINTER;
+FUNCTION xadConvertDates(const tags : Array Of Const) : LONGINT;
+FUNCTION xadConvertName(charset : longword; const tags : Array Of Const) : pCHAR;
+FUNCTION xadConvertProtection(const tags : Array Of Const) : LONGINT;
+FUNCTION xadDiskFileUnArc(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadDiskUnArc(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadFileUnArc(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadFreeHookAccess(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+PROCEDURE xadFreeObject(obj : POINTER; const tags : Array Of Const);
+FUNCTION xadGetDiskInfo(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadGetFilename(buffersize : longword; buffer : pCHAR; path : pCHAR; name : pCHAR; const tags : Array Of Const) : LONGINT;
+FUNCTION xadGetHookAccess(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadGetInfo(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadHookTagAccess(command : longword; data : LONGINT; buffer : POINTER; ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadRecogFile(size : longword; memory : POINTER; const tags : Array Of Const) : pxadClient;
+
+{You can remove this include and use a define instead}
+{$I useautoopenlib.inc}
+{$ifdef use_init_openlib}
+procedure InitXADMASTERLibrary;
+{$endif use_init_openlib}
+
+{This is a variable that knows how the unit is compiled}
+var
+    XADMASTERIsCompiledHow : longint;
 
 IMPLEMENTATION
 
+uses
+{$ifndef dont_use_openlib}
+amsgbox,
+{$endif dont_use_openlib}
+tagsarray;
+
+
+
+FUNCTION xadAddDiskEntryA(di : pxadDiskInfo; ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L di,A0
+        MOVEA.L ai,A1
+        MOVEA.L tags,A2
+        MOVEA.L xadMasterBase,A6
+        JSR     -162(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadAddFileEntryA(fi : pxadFileInfo; ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L fi,A0
+        MOVEA.L ai,A1
+        MOVEA.L tags,A2
+        MOVEA.L xadMasterBase,A6
+        JSR     -156(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadAllocObjectA(_type : LONGINT; CONST tags : pTagItem) : POINTER;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  _type,D0
+        MOVEA.L tags,A0
+        MOVEA.L xadMasterBase,A6
+        JSR     -030(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadAllocVec(size : longword; flags : longword) : POINTER;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  size,D0
+        MOVE.L  flags,D1
+        MOVEA.L xadMasterBase,A6
+        JSR     -108(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadCalcCRC16(id : longword; init : longword; size : longword; buffer : pCHAR) : WORD;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  id,D0
+        MOVE.L  init,D1
+        MOVE.L  size,D2
+        MOVEA.L buffer,A0
+        MOVEA.L xadMasterBase,A6
+        JSR     -096(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadCalcCRC32(id : longword; init : longword; size : longword; buffer : pCHAR) : longword;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  id,D0
+        MOVE.L  init,D1
+        MOVE.L  size,D2
+        MOVEA.L buffer,A0
+        MOVEA.L xadMasterBase,A6
+        JSR     -102(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadConvertDatesA(CONST tags : pTagItem) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L tags,A0
+        MOVEA.L xadMasterBase,A6
+        JSR     -090(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadConvertNameA(charset : longword; CONST tags : pTagItem) : pCHAR;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  charset,D0
+        MOVEA.L tags,A0
+        MOVEA.L xadMasterBase,A6
+        JSR     -174(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadConvertProtectionA(CONST tags : pTagItem) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L tags,A0
+        MOVEA.L xadMasterBase,A6
+        JSR     -126(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE xadCopyMem(src : POINTER; dest : POINTER; size : longword);
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L src,A0
+        MOVEA.L dest,A1
+        MOVE.L  size,D0
+        MOVEA.L xadMasterBase,A6
+        JSR     -114(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION xadDiskFileUnArcA(ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L ai,A0
+        MOVEA.L tags,A1
+        MOVEA.L xadMasterBase,A6
+        JSR     -138(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadDiskUnArcA(ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L ai,A0
+        MOVEA.L tags,A1
+        MOVEA.L xadMasterBase,A6
+        JSR     -066(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadFileUnArcA(ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L ai,A0
+        MOVEA.L tags,A1
+        MOVEA.L xadMasterBase,A6
+        JSR     -060(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadFreeHookAccessA(ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L ai,A0
+        MOVEA.L tags,A1
+        MOVEA.L xadMasterBase,A6
+        JSR     -150(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+PROCEDURE xadFreeInfo(ai : pxadArchiveInfo);
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L ai,A0
+        MOVEA.L xadMasterBase,A6
+        JSR     -054(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+PROCEDURE xadFreeObjectA(obj : POINTER; CONST tags : pTagItem);
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L obj,A0
+        MOVEA.L tags,A1
+        MOVEA.L xadMasterBase,A6
+        JSR     -036(A6)
+        MOVEA.L (A7)+,A6
+  END;
+END;
+
+FUNCTION xadGetClientInfo : pxadClient;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L xadMasterBase,A6
+        JSR     -078(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadGetDiskInfoA(ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L ai,A0
+        MOVEA.L tags,A1
+        MOVEA.L xadMasterBase,A6
+        JSR     -132(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadGetErrorText(errnum : longword) : pCHAR;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  errnum,D0
+        MOVEA.L xadMasterBase,A6
+        JSR     -072(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadGetFilenameA(buffersize : longword; buffer : pCHAR; path : pCHAR; name : pCHAR; CONST tags : pTagItem) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  buffersize,D0
+        MOVEA.L buffer,A0
+        MOVEA.L path,A1
+        MOVEA.L name,A2
+        MOVEA.L tags,A3
+        MOVEA.L xadMasterBase,A6
+        JSR     -168(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadGetHookAccessA(ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L ai,A0
+        MOVEA.L tags,A1
+        MOVEA.L xadMasterBase,A6
+        JSR     -144(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadGetInfoA(ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVEA.L ai,A0
+        MOVEA.L tags,A1
+        MOVEA.L xadMasterBase,A6
+        JSR     -048(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadHookAccess(command : longword; data : LONGINT; buffer : POINTER; ai : pxadArchiveInfo) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  command,D0
+        MOVE.L  data,D1
+        MOVEA.L buffer,A0
+        MOVEA.L ai,A1
+        MOVEA.L xadMasterBase,A6
+        JSR     -084(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadHookTagAccessA(command : longword; data : LONGINT; buffer : POINTER; ai : pxadArchiveInfo; CONST tags : pTagItem) : LONGINT;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  command,D0
+        MOVE.L  data,D1
+        MOVEA.L buffer,A0
+        MOVEA.L ai,A1
+        MOVEA.L tags,A2
+        MOVEA.L xadMasterBase,A6
+        JSR     -120(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
+FUNCTION xadRecogFileA(size : longword; memory : POINTER; CONST tags : pTagItem) : pxadClient;
+BEGIN
+  ASM
+        MOVE.L  A6,-(A7)
+        MOVE.L  size,D0
+        MOVEA.L memory,A0
+        MOVEA.L tags,A1
+        MOVEA.L xadMasterBase,A6
+        JSR     -042(A6)
+        MOVEA.L (A7)+,A6
+        MOVE.L  D0,@RESULT
+  END;
+END;
+
 {
- Functions and procedures with array of PtrUInt go here
+ Functions and procedures with array of const go here
 }
-FUNCTION xadAddDiskEntry(di : pxadDiskInfo; ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
+FUNCTION xadAddDiskEntry(di : pxadDiskInfo; ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
 begin
-    xadAddDiskEntry := xadAddDiskEntryA(di , ai , @tags);
+    xadAddDiskEntry := xadAddDiskEntryA(di , ai , readintags(tags));
 end;
 
-FUNCTION xadAddFileEntry(fi : pxadFileInfo; ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
+FUNCTION xadAddFileEntry(fi : pxadFileInfo; ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
 begin
-    xadAddFileEntry := xadAddFileEntryA(fi , ai , @tags);
+    xadAddFileEntry := xadAddFileEntryA(fi , ai , readintags(tags));
 end;
 
-FUNCTION xadAllocObject(_type : LONGINT; const tags : array of PtrUInt) : POINTER;
+FUNCTION xadAllocObject(_type : LONGINT; const tags : Array Of Const) : POINTER;
 begin
-    xadAllocObject := xadAllocObjectA(_type , @tags);
+    xadAllocObject := xadAllocObjectA(_type , readintags(tags));
 end;
 
-FUNCTION xadConvertDates(const tags : array of PtrUInt) : LONGINT;
+FUNCTION xadConvertDates(const tags : Array Of Const) : LONGINT;
 begin
-    xadConvertDates := xadConvertDatesA(@tags);
+    xadConvertDates := xadConvertDatesA(readintags(tags));
 end;
 
-FUNCTION xadConvertName(charset : longword; const tags : array of PtrUInt) : pCHAR;
+FUNCTION xadConvertName(charset : longword; const tags : Array Of Const) : pCHAR;
 begin
-    xadConvertName := xadConvertNameA(charset , @tags);
+    xadConvertName := xadConvertNameA(charset , readintags(tags));
 end;
 
-FUNCTION xadConvertProtection(const tags : array of PtrUInt) : LONGINT;
+FUNCTION xadConvertProtection(const tags : Array Of Const) : LONGINT;
 begin
-    xadConvertProtection := xadConvertProtectionA(@tags);
+    xadConvertProtection := xadConvertProtectionA(readintags(tags));
 end;
 
-FUNCTION xadDiskFileUnArc(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
+FUNCTION xadDiskFileUnArc(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
 begin
-    xadDiskFileUnArc := xadDiskFileUnArcA(ai , @tags);
+    xadDiskFileUnArc := xadDiskFileUnArcA(ai , readintags(tags));
 end;
 
-FUNCTION xadDiskUnArc(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
+FUNCTION xadDiskUnArc(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
 begin
-    xadDiskUnArc := xadDiskUnArcA(ai , @tags);
+    xadDiskUnArc := xadDiskUnArcA(ai , readintags(tags));
 end;
 
-FUNCTION xadFileUnArc(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
+FUNCTION xadFileUnArc(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
 begin
-    xadFileUnArc := xadFileUnArcA(ai , @tags);
+    xadFileUnArc := xadFileUnArcA(ai , readintags(tags));
 end;
 
-FUNCTION xadFreeHookAccess(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
+FUNCTION xadFreeHookAccess(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
 begin
-    xadFreeHookAccess := xadFreeHookAccessA(ai , @tags);
+    xadFreeHookAccess := xadFreeHookAccessA(ai , readintags(tags));
 end;
 
-PROCEDURE xadFreeObject(obj : POINTER; const tags : array of PtrUInt);
+PROCEDURE xadFreeObject(obj : POINTER; const tags : Array Of Const);
 begin
-    xadFreeObjectA(obj , @tags);
+    xadFreeObjectA(obj , readintags(tags));
 end;
 
-FUNCTION xadGetDiskInfo(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
+FUNCTION xadGetDiskInfo(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
 begin
-    xadGetDiskInfo := xadGetDiskInfoA(ai , @tags);
+    xadGetDiskInfo := xadGetDiskInfoA(ai , readintags(tags));
 end;
 
-FUNCTION xadGetFilename(buffersize : longword; buffer : pCHAR; path : pCHAR; name : pCHAR; const tags : array of PtrUInt) : LONGINT;
+FUNCTION xadGetFilename(buffersize : longword; buffer : pCHAR; path : pCHAR; name : pCHAR; const tags : Array Of Const) : LONGINT;
 begin
-    xadGetFilename := xadGetFilenameA(buffersize , buffer , path , name , @tags);
+    xadGetFilename := xadGetFilenameA(buffersize , buffer , path , name , readintags(tags));
 end;
 
-FUNCTION xadGetHookAccess(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
+FUNCTION xadGetHookAccess(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
 begin
-    xadGetHookAccess := xadGetHookAccessA(ai , @tags);
+    xadGetHookAccess := xadGetHookAccessA(ai , readintags(tags));
 end;
 
-FUNCTION xadGetInfo(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
+FUNCTION xadGetInfo(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
 begin
-    xadGetInfo := xadGetInfoA(ai , @tags);
+    xadGetInfo := xadGetInfoA(ai , readintags(tags));
 end;
 
-FUNCTION xadHookTagAccess(command : longword; data : LONGINT; buffer : POINTER; ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
+FUNCTION xadHookTagAccess(command : longword; data : LONGINT; buffer : POINTER; ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
 begin
-    xadHookTagAccess := xadHookTagAccessA(command , data , buffer , ai , @tags);
+    xadHookTagAccess := xadHookTagAccessA(command , data , buffer , ai , readintags(tags));
 end;
 
-FUNCTION xadRecogFile(size : longword; memory : POINTER; const tags : array of PtrUInt) : pxadClient;
+FUNCTION xadRecogFile(size : longword; memory : POINTER; const tags : Array Of Const) : pxadClient;
 begin
-    xadRecogFile := xadRecogFileA(size , memory , @tags);
+    xadRecogFile := xadRecogFileA(size , memory , readintags(tags));
 end;
 
 const
     { Change VERSION and LIBVERSION to proper values }
+
     VERSION : string[2] = '0';
     LIBVERSION : longword = 0;
 
-initialization
-  xadMasterBase := pxadMasterBase(OpenLibrary(XADMASTERNAME,LIBVERSION));
-finalization
-  if Assigned(xadMasterBase) then
-    CloseLibrary(pLibrary(xadMasterBase));
+{$ifdef use_init_openlib}
+  {$Info Compiling initopening of xadmaster.library}
+  {$Info don't forget to use InitXADMASTERLibrary in the beginning of your program}
+
+var
+    xadmaster_exit : Pointer;
+
+procedure ClosexadmasterLibrary;
+begin
+    ExitProc := xadmaster_exit;
+    if xadMasterBase <> nil then begin
+        CloseLibrary(pLibrary(xadMasterBase));
+        xadMasterBase := nil;
+    end;
+end;
+
+procedure InitXADMASTERLibrary;
+begin
+    xadMasterBase := nil;
+    xadMasterBase := pxadMasterBase(OpenLibrary(XADMASTERNAME,LIBVERSION));
+    if xadMasterBase <> nil then begin
+        xadmaster_exit := ExitProc;
+        ExitProc := @ClosexadmasterLibrary;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open xadmaster.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+end;
+
+begin
+    XADMASTERIsCompiledHow := 2;
+{$endif use_init_openlib}
+
+{$ifdef use_auto_openlib}
+  {$Info Compiling autoopening of xadmaster.library}
+
+var
+    xadmaster_exit : Pointer;
+
+procedure ClosexadmasterLibrary;
+begin
+    ExitProc := xadmaster_exit;
+    if xadMasterBase <> nil then begin
+        CloseLibrary(pLibrary(xadMasterBase));
+        xadMasterBase := nil;
+    end;
+end;
+
+begin
+    xadMasterBase := nil;
+    xadMasterBase := pxadMasterBase(OpenLibrary(XADMASTERNAME,LIBVERSION));
+    if xadMasterBase <> nil then begin
+        xadmaster_exit := ExitProc;
+        ExitProc := @ClosexadmasterLibrary;
+        XADMASTERIsCompiledHow := 1;
+    end else begin
+        MessageBox('FPC Pascal Error',
+        'Can''t open xadmaster.library version ' + VERSION + #10 +
+        'Deallocating resources and closing down',
+        'Oops');
+        halt(20);
+    end;
+
+{$endif use_auto_openlib}
+
+{$ifdef dont_use_openlib}
+begin
+    XADMASTERIsCompiledHow := 3;
+   {$Warning No autoopening of xadmaster.library compiled}
+   {$Warning Make sure you open xadmaster.library yourself}
+{$endif dont_use_openlib}
+
+
 END. (* UNIT XADMASTER *)

packages/amunits/src/utilunits/easyasl.pas

@@ -142,7 +142,7 @@ BEGIN
 
     fr := AllocAslRequest(ASL_FileRequest,@mytags);
     IF fr <> NIL THEN BEGIN
-       IF AslRequest(fr,NIL) THEN BEGIN
+       IF AslRequest(fr,NIL) <> 0 THEN BEGIN
           IF (strlen(fr^.rf_Dir) >0) and (strlen(fr^.rf_File) > 0) THEN begin
              strcopy(path,fr^.rf_Dir);
              strcopy(fname,fr^.rf_File);
@@ -248,7 +248,7 @@ BEGIN
 
     fr := AllocAslRequest(ASL_FontRequest,@mytags);
     IF fr <> NIL THEN BEGIN
-         IF AslRequest(fr,NIL) THEN BEGIN
+         IF AslRequest(fr,NIL) <> 0 THEN BEGIN
               WITH finfo DO BEGIN
                   nfi_Name := strpas(fr^.fo_Attr.ta_Name);
                   nfi_Size       := fr^.fo_Attr.ta_YSize;
@@ -322,7 +322,7 @@ BEGIN
 
         fr := AllocAslRequest(ASL_FileRequest,@mytags);
         IF fr <> NIL THEN BEGIN
-             IF AslRequest(fr,NIL) THEN BEGIN
+             IF AslRequest(fr,NIL) <> 0 THEN BEGIN
                  IF (strlen(fr^.rf_Dir) >0) THEN begin
                     strcopy(path,fr^.rf_Dir);
                     result := true;
@@ -382,7 +382,7 @@ BEGIN
 
     fr := AllocAslRequest(ASL_FileRequest,@mytags);
     IF fr <> NIL THEN BEGIN
-         IF AslRequest(fr,NIL) THEN BEGIN
+         IF AslRequest(fr,NIL) <> 0 THEN BEGIN
              IF (strlen(fr^.rf_Dir) >0) THEN begin
                 strcopy(path,fr^.rf_Dir);
                 result := true;
@@ -445,7 +445,7 @@ BEGIN
 
     fr := AllocAslRequest(ASL_FileRequest,@mytags);
     IF fr <> NIL THEN BEGIN
-         IF AslRequest(fr,NIL) THEN BEGIN
+         IF AslRequest(fr,NIL) <> 0 THEN BEGIN
              IF (strlen(fr^.rf_Dir) >0) and (strlen(fr^.rf_File) > 0) THEN begin
                 strcopy(path,fr^.rf_Dir);
                 strcopy(fname,fr^.rf_File);

packages/amunits/src/utilunits/longarray.pas

@@ -0,0 +1,63 @@
+{
+    This file is part of the Free Pascal run time library.
+
+    A file in Amiga system run time library.
+    Copyright (c) 1998-2002 by Nils Sjoholm
+    member of the Amiga RTL development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+    History:
+
+    A simple unit that helps to build array of longint.
+    Uses array of const so don't forget to use
+    $mode objfpc.
+
+    05 Nov 2002.
+
+    [email protected]
+}
+
+unit longarray;
+
+{$mode objfpc}
+
+interface
+
+function readinlongs(const args : array of const): pointer;
+
+implementation
+
+uses pastoc;
+
+var
+  argarray : array [0..20] of longint;
+
+function readinlongs(const args : array of const): pointer;
+var
+   i : longint;
+
+begin
+
+    for i := 0 to High(args) do begin
+        case args[i].vtype of
+            vtinteger : argarray[i] := longint(args[i].vinteger);
+            vtpchar   : argarray[i] := longint(args[i].vpchar);
+            vtchar    : argarray[i] := longint(args[i].vchar);
+            vtpointer : argarray[i] := longint(args[i].vpointer);
+            vtstring  : argarray[i] := longint(pas2c(args[i].vstring^));
+            vtboolean : argarray[i] := longint(byte(args[i].vboolean));
+        end;
+    end;
+    readinlongs := @argarray;
+end;
+
+end.

packages/amunits/src/utilunits/systemvartags.pas

@@ -0,0 +1,414 @@
+{
+    This file is part of the Free Pascal run time library.
+
+    A file in Amiga system run time library.
+    Copyright (c) 1998-2003 by Nils Sjoholm
+    member of the Amiga RTL development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{$I useamigasmartlink.inc}
+{$ifdef use_amiga_smartlink}
+    {$smartlink on}
+{$endif use_amiga_smartlink}
+
+unit systemvartags;
+
+interface
+
+uses exec,amigados, amigaguide, asl, bullet, intuition, datatypes ,
+     gadtools, agraphics, locale, lowlevel, realtime,
+     workbench, utility, tagsarray;
+
+{    As of today boolean and char doesn't function in
+     array of const. Use ltrue and lfalse instead. You
+     can just cast a char.
+
+     Added the define use_amiga_smartlink.
+     13 Jan 2003.
+
+     Changed integer > smallint.
+     Moved ltrue and lfalse to exec.
+     10 Feb 2003.
+
+     [email protected]
+}
+
+
+{
+     This is functions and procedures with array of const.
+     For use with fpc 1.0 and above.
+}
+
+{ functions from amigados. }
+FUNCTION AllocDosObjectTags(type_ : ULONG; Const argv : Array of Const) : POINTER;
+FUNCTION CreateNewProcTags(Const argv : Array of Const) : pProcess;
+FUNCTION NewLoadSegTags(file_ : pCHAR; Const argv : Array of Const) : LONGINT;
+FUNCTION SystemTags(command : pCHAR; Const argv : Array of Const) : LONGINT;
+   {  This one as well, an overlay function }
+FUNCTION SystemTags(command : string; Const argv : Array of Const) : LONGINT;
+
+{ functions from amigaguide. }
+FUNCTION AddAmigaGuideHost(h : pHook; name : pCHAR; Const argv : Array Of Const) : POINTER;
+FUNCTION OpenAmigaGuide(nag : pNewAmigaGuide; Const argv : Array Of Const) : POINTER;
+FUNCTION OpenAmigaGuideAsync(nag : pNewAmigaGuide; Const argv : Array Of Const) : POINTER;
+FUNCTION RemoveAmigaGuideHost(hh : POINTER; Const argv : Array Of Const) : LONGINT;
+FUNCTION SendAmigaGuideCmd(cl : POINTER; cmd : pCHAR; Const argv : Array Of Const) : LONGINT;
+FUNCTION SendAmigaGuideContext(cl : POINTER; Const argv : Array Of Const) : LONGINT;
+FUNCTION SetAmigaGuideAttrs(cl : POINTER; Const argv : Array Of Const) : LONGINT;
+FUNCTION SetAmigaGuideContext(cl : POINTER; id : ULONG; Const argv : Array Of Const) : LONGINT;
+
+{ functions from asl. }
+FUNCTION AllocAslRequestTags(reqType : ULONG; Const argv : Array Of Const) : POINTER;
+FUNCTION AslRequestTags(requester : POINTER; Const argv : Array Of Const) : BOOLEAN;
+
+{ functions from bullet }
+FUNCTION ObtainInfo(glyphEngine : pGlyphEngine; Const argv : Array Of Const) : ULONG;
+FUNCTION ReleaseInfo(glyphEngine : pGlyphEngine; Const argv : Array Of Const) : ULONG;
+FUNCTION SetInfo(glyphEngine : pGlyphEngine; Const argv : Array Of Const) : ULONG;
+
+{ functions from datatypes }
+FUNCTION GetDTAttrs(o : pObject_; Const argv : Array Of Const) : ULONG;
+FUNCTION NewDTObject(name : POINTER; Const argv : Array Of Const): POINTER;
+FUNCTION ObtainDataType(typ : ULONG; handle : POINTER; Const argv : Array Of Const) : pDataType;
+PROCEDURE RefreshDTObject(o : pObject_; win : pWindow; req : pRequester; Const argv : Array Of Const);
+FUNCTION SetDTAttrs(o : pObject_; win : pWindow; req : pRequester; Const argv : Array Of Const) : ULONG;
+
+{ functions from gadtools }
+FUNCTION CreateGadget(kind : ULONG; gad : pGadget; ng : pNewGadget; Const argv : Array Of Const) : pGadget;
+FUNCTION CreateMenus(newmenu : pNewMenu; Const argv : Array Of Const) : pMenu;
+PROCEDURE DrawBevelBox(rport : pRastPort; left : LONGINT; top : LONGINT; width : LONGINT; height : LONGINT; Const argv : Array Of Const);
+FUNCTION GetVisualInfo(screen : pScreen; Const argv : Array Of Const) : POINTER;
+FUNCTION GT_GetGadgetAttrs(gad : pGadget; win : pWindow; req : pRequester; Const argv : Array Of Const) : LONGINT;
+PROCEDURE GT_SetGadgetAttrs(gad : pGadget; win : pWindow; req : pRequester; Const argv : Array Of Const);
+FUNCTION LayoutMenuItems(firstitem : pMenuItem; vi : POINTER; Const argv : Array Of Const) : BOOLEAN;
+FUNCTION LayoutMenus(firstmenu : pMenu; vi : POINTER; Const argv : Array Of Const) : BOOLEAN;
+
+{ functions from graphics }
+FUNCTION AllocSpriteData(bm : pBitMap; Const argv : Array Of Const) : pExtSprite;
+FUNCTION BestModeID(Const argv : Array Of Const) : ULONG;
+FUNCTION ChangeExtSprite(vp : pViewPort; oldsprite : pExtSprite; newsprite : pExtSprite; Const argv : Array Of Const) : LONGINT;
+FUNCTION ExtendFontTags(font : pTextFont; Const argv : Array Of Const) : ULONG;
+FUNCTION GetExtSprite(ss : pExtSprite; Const argv : Array Of Const) : LONGINT;
+PROCEDURE GetRPAttrs(rp : pRastPort; Const argv : Array Of Const);
+FUNCTION ObtainBestPen(cm : pColorMap; r : ULONG; g : ULONG; b : ULONG; Const argv : Array Of Const) : LONGINT;
+PROCEDURE SetRPAttrs(rp : pRastPort; Const argv : Array Of Const);
+FUNCTION VideoControlTags(colorMap : pColorMap; Const argv : Array Of Const) : BOOLEAN;
+FUNCTION WeighTAMatchTags(reqTextAttr : pTextAttr; targetTextAttr : pTextAttr; Const argv : Array Of Const) : smallint;
+
+{ functions from intuition. }
+FUNCTION OpenScreenTags(newScreen : pNewScreen; tagList : array of const) : pScreen;
+FUNCTION OpenWindowTags(newWindow : pNewWindow; tagList : array of const) : pWindow;
+FUNCTION NewObject(classPtr : pIClass; classID : pCHAR; Const argv : Array Of Const) : POINTER;
+FUNCTION SetGadgetAttrs(gadget : pGadget; window : pWindow; requester : pRequester; Const argv : Array Of Const) : ULONG;
+FUNCTION NewObject(classPtr : pIClass; classID : string; Const argv : array of const ) : POINTER;
+
+{ from locale }
+FUNCTION OpenCatalog(locale : pLocale; name : pCHAR; Const argv : Array Of Const) : pCatalog;
+
+{ functions from lowlevel }
+FUNCTION SetJoyPortAttrs(portNumber : ULONG; Const argv : Array Of Const) : BOOLEAN;
+FUNCTION SystemControl(Const argv : Array Of Const) : ULONG;
+
+{ functions from realtime }
+FUNCTION CreatePlayer(Const argv : Array Of Const) : pPlayer;
+FUNCTION GetPlayerAttrs(player : pPlayer; Const argv : Array Of Const) : ULONG;
+FUNCTION SetPlayerAttrs(player : pPlayer; Const argv : Array Of Const) : BOOLEAN;
+
+{ from utility }
+function AllocNamedObject(name : STRPTR; Const argv : Array Of Const) : pNamedObject;
+
+{ functions from workbench }
+FUNCTION AddAppMenuItem(id : ULONG; userdata : ULONG; text_ : pCHAR; msgport : pMsgPort; Const argv : Array Of Const) : pAppMenuItem;
+FUNCTION AddAppWindow(id : ULONG; userdata : ULONG; window : pWindow; msgport : pMsgPort; Const argv : Array Of Const) : pAppWindow;
+
+implementation
+
+uses pastoc;
+
+FUNCTION AllocDosObjectTags(type_ : ULONG; Const argv : Array of Const) : POINTER;
+begin
+     AllocDosObjectTags := AllocDosObjectTagList(type_, readintags(argv));
+end;
+
+FUNCTION CreateNewProcTags(Const argv : Array of Const) : pProcess;
+begin
+     CreateNewProcTags := CreateNewProcTagList(readintags(argv));
+end;
+
+FUNCTION NewLoadSegTags(file_ : pCHAR; Const argv : Array of Const) : LONGINT;
+begin
+     NewLoadSegTags := NewLoadSegTagList(file_,readintags(argv));
+end;
+
+FUNCTION SystemTags(command : pCHAR; Const argv : Array of Const) : LONGINT;
+begin
+     SystemTags := SystemTagList(command,readintags(argv));
+end;
+
+FUNCTION SystemTags(command : string; Const argv : Array of Const) : LONGINT;
+begin
+     SystemTags := SystemTagList(command,readintags(argv));
+end;
+
+FUNCTION OpenScreenTags(newScreen : pNewScreen; tagList : array of const) : pScreen;
+begin
+    OpenScreenTags := OpenScreenTagList(newScreen, readintags(tagList));
+end;
+
+FUNCTION OpenWindowTags(newWindow : pNewWindow; tagList : array of const) : pWindow;
+begin
+    OpenWindowTags := OpenWindowTagList(newWindow, readintags(tagList));
+end;
+
+FUNCTION NewObject(classPtr : pIClass; classID : pCHAR; Const argv : Array Of Const) : POINTER;
+begin
+    NewObject := NewObjectA(classPtr,classID, readintags(argv));
+end;
+
+FUNCTION NewObject(classPtr : pIClass; classID : string; Const argv : array of const ) : POINTER;
+begin
+      NewObject := NewObjectA(classPtr,pas2c(classID),readintags(argv));
+end;
+
+FUNCTION SetGadgetAttrs(gadget : pGadget; window : pWindow; requester : pRequester; Const argv : Array Of Const) : ULONG;
+begin
+    SetGadgetAttrs := SetGadgetAttrsA(gadget,window,requester,readintags(argv));
+end;
+
+FUNCTION AddAmigaGuideHost(h : pHook; name : pCHAR; Const argv : Array Of Const) : POINTER;
+begin
+    AddAmigaGuideHost := AddAmigaGuideHostA(h,name,readintags(argv));
+end;
+
+FUNCTION OpenAmigaGuide(nag : pNewAmigaGuide; Const argv : Array Of Const) : POINTER;
+begin
+    OpenAmigaGuide := OpenAmigaGuideA(nag,readintags(argv));
+end;
+
+FUNCTION OpenAmigaGuideAsync(nag : pNewAmigaGuide; Const argv : Array Of Const) : POINTER;
+begin
+    OpenAmigaGuideAsync := OpenAmigaGuideAsyncA(nag,readintags(argv));
+end;
+
+FUNCTION RemoveAmigaGuideHost(hh : POINTER; Const argv : Array Of Const) : LONGINT;
+begin
+    RemoveAmigaGuideHost := RemoveAmigaGuideHostA(hh,readintags(argv));
+end;
+
+FUNCTION SendAmigaGuideCmd(cl : POINTER; cmd : pCHAR; Const argv : Array Of Const) : LONGINT;
+begin
+    SendAmigaGuideCmd := SendAmigaGuideCmdA(cl,cmd,readintags(argv));
+end;
+
+FUNCTION SendAmigaGuideContext(cl : POINTER; Const argv : Array Of Const) : LONGINT;
+begin
+    SendAmigaGuideContext := SendAmigaGuideContextA(cl,readintags(argv));
+end;
+
+FUNCTION SetAmigaGuideAttrs(cl : POINTER; Const argv : Array Of Const) : LONGINT;
+begin
+    SetAmigaGuideAttrs := SetAmigaGuideAttrsA(cl,readintags(argv));
+end;
+
+FUNCTION SetAmigaGuideContext(cl : POINTER; id : ULONG; Const argv : Array Of Const) : LONGINT;
+begin
+    SetAmigaGuideContext := SetAmigaGuideContextA(cl,id,readintags(argv));
+end;
+
+FUNCTION AllocAslRequestTags(reqType : ULONG; Const argv : Array Of Const) : POINTER;
+begin
+    AllocAslRequestTags := AllocAslRequest(reqType,readintags(argv));
+end;
+
+FUNCTION AslRequestTags(requester : POINTER; Const argv : Array Of Const) : BOOLEAN;
+begin
+    AslRequestTags := AslRequest(requester,readintags(argv)) <> 0;
+end;
+
+FUNCTION ObtainInfo(glyphEngine : pGlyphEngine; Const argv : Array Of Const) : ULONG;
+begin
+    ObtainInfo := ObtainInfoA(glyphEngine,readintags(argv));
+end;
+
+FUNCTION ReleaseInfo(glyphEngine : pGlyphEngine; Const argv : Array Of Const) : ULONG;
+begin
+    ReleaseInfo := releaseInfoA(glyphEngine,readintags(argv));
+end;
+
+FUNCTION SetInfo(glyphEngine : pGlyphEngine; Const argv : Array Of Const) : ULONG;
+begin
+    SetInfo := SetInfoA(glyphEngine,readintags(argv));
+end;
+
+FUNCTION GetDTAttrs(o : pObject_; Const argv : Array Of Const) : ULONG;
+begin
+    GetDTAttrs := GetDTAttrsA(o,readintags(argv));
+end;
+
+FUNCTION NewDTObject(name : POINTER; Const argv : Array Of Const): POINTER;
+begin
+    NewDTObject := NewDTObjectA(name,readintags(argv));
+end;
+
+FUNCTION ObtainDataType(typ : ULONG; handle : POINTER; Const argv : Array Of Const) : pDataType;
+begin
+    ObtainDataType := ObtainDataTypeA(typ,handle,readintags(argv));
+end;
+PROCEDURE RefreshDTObject(o : pObject_; win : pWindow; req : pRequester; Const argv : Array Of Const);
+begin
+    RefreshDTObjectA(o,win,req,readintags(argv));
+end;
+
+FUNCTION SetDTAttrs(o : pObject_; win : pWindow; req : pRequester; Const argv : Array Of Const) : ULONG;
+begin
+    SetDTAttrs := SetDTAttrsA(o,win,req,readintags(argv));
+end;
+
+FUNCTION CreateGadget(kind : ULONG; gad : pGadget; ng : pNewGadget; Const argv : Array Of Const) : pGadget;
+begin
+    CreateGadget := CreateGadgetA(kind,gad,ng,readintags(argv));
+end;
+
+FUNCTION CreateMenus(newmenu : pNewMenu; Const argv : Array Of Const) : pMenu;
+begin
+    CreateMenus := CreateMenusA(newmenu,readintags(argv));
+end;
+
+PROCEDURE DrawBevelBox(rport : pRastPort; left : LONGINT; top : LONGINT; width : LONGINT; height : LONGINT; Const argv : Array Of Const);
+begin
+    DrawBevelBoxA(rport,left,top,width,height,readintags(argv));
+end;
+
+FUNCTION GetVisualInfo(screen : pScreen; Const argv : Array Of Const) : POINTER;
+begin
+    GetVisualInfo := GetVisualInfoA(screen,readintags(argv));
+end;
+
+FUNCTION GT_GetGadgetAttrs(gad : pGadget; win : pWindow; req : pRequester; Const argv : Array Of Const) : LONGINT;
+begin
+    GT_GetGadgetAttrs := GT_GetGadgetAttrsA(gad,win,req,readintags(argv));
+end;
+
+PROCEDURE GT_SetGadgetAttrs(gad : pGadget; win : pWindow; req : pRequester; Const argv : Array Of Const);
+begin
+    GT_SetGadgetAttrsA(gad,win,req,readintags(argv));
+end;
+
+FUNCTION LayoutMenuItems(firstitem : pMenuItem; vi : POINTER; Const argv : Array Of Const) : BOOLEAN;
+begin
+    LayoutMenuItems := LayoutMenuItemsA(firstitem,vi,readintags(argv));
+end;
+
+FUNCTION LayoutMenus(firstmenu : pMenu; vi : POINTER; Const argv : Array Of Const) : BOOLEAN;
+begin
+    LayoutMenus := LayoutMenusA(firstmenu,vi,readintags(argv));
+end;
+
+FUNCTION AllocSpriteData(bm : pBitMap; Const argv : Array Of Const) : pExtSprite;
+begin
+    AllocSpriteData := AllocSpriteDataA(bm,readintags(argv));
+end;
+
+FUNCTION BestModeID(Const argv : Array Of Const) : ULONG;
+begin
+    BestModeID := BestModeIDA(readintags(argv));
+end;
+
+FUNCTION ChangeExtSprite(vp : pViewPort; oldsprite : pExtSprite; newsprite : pExtSprite; Const argv : Array Of Const) : LONGINT;
+begin
+    ChangeExtSprite := ChangeExtSpriteA(vp,oldsprite,newsprite,readintags(argv));
+end;
+
+FUNCTION ExtendFontTags(font : pTextFont; Const argv : Array Of Const) : ULONG;
+begin
+    ExtendFontTags := ExtendFont(font,readintags(argv));
+end;
+
+FUNCTION GetExtSprite(ss : pExtSprite; Const argv : Array Of Const) : LONGINT;
+begin
+    GetExtSprite := GetExtSpriteA(ss,readintags(argv));
+end;
+
+PROCEDURE GetRPAttrs(rp : pRastPort; Const argv : Array Of Const);
+begin
+    GetRPAttrsA(rp,readintags(argv));
+end;
+
+FUNCTION ObtainBestPen(cm : pColorMap; r : ULONG; g : ULONG; b : ULONG; Const argv : Array Of Const) : LONGINT;
+begin
+    ObtainBestPen := ObtainBestPenA(cm,r,g,b,readintags(argv));
+end;
+
+PROCEDURE SetRPAttrs(rp : pRastPort; Const argv : Array Of Const);
+begin
+    SetRPAttrsA(rp,readintags(argv));
+end;
+
+FUNCTION VideoControlTags(colorMap : pColorMap; Const argv : Array Of Const) : BOOLEAN;
+begin
+    VideoControlTags := VideoControl(colorMap,readintags(argv));
+end;
+
+FUNCTION WeighTAMatchTags(reqTextAttr : pTextAttr; targetTextAttr : pTextAttr; Const argv : Array Of Const) : smallint;
+begin
+    WeighTAMatchTags := WeighTAMatch(reqTextAttr,targetTextAttr,readintags(argv));
+end;
+
+FUNCTION OpenCatalog(locale : pLocale; name : pCHAR; Const argv : Array Of Const) : pCatalog;
+begin
+    OpenCatalog := OpenCatalogA(locale,name,readintags(argv));
+end;
+
+FUNCTION SetJoyPortAttrs(portNumber : ULONG; Const argv : Array Of Const) : BOOLEAN;
+begin
+    SetJoyPortAttrs := SetJoyPortAttrsA(portNumber,readintags(argv));
+end;
+
+FUNCTION SystemControl(Const argv : Array Of Const) : ULONG;
+begin
+    SystemControl := SystemControlA(readintags(argv));
+end;
+
+FUNCTION CreatePlayer(Const argv : Array Of Const) : pPlayer;
+begin
+    CreatePlayer := CreatePlayerA(readintags(argv));
+end;
+
+FUNCTION GetPlayerAttrs(player : pPlayer; Const argv : Array Of Const) : ULONG;
+begin
+    GetPlayerAttrs := GetPlayerAttrsA(player,readintags(argv));
+end;
+
+FUNCTION SetPlayerAttrs(player : pPlayer; Const argv : Array Of Const) : BOOLEAN;
+begin
+    SetPlayerAttrs := SetPlayerAttrsA(player,readintags(argv));
+end;
+
+function AllocNamedObject(name : STRPTR; Const argv : Array Of Const) : pNamedObject;
+begin
+    AllocNamedObject := AllocNamedObjectA(name,readintags(argv));
+end;
+
+FUNCTION AddAppMenuItem(id : ULONG; userdata : ULONG; text_ : pCHAR; msgport : pMsgPort; Const argv : Array Of Const) : pAppMenuItem;
+begin
+    AddAppMenuItem := AddAppMenuItemA(id,userdata,text_,msgport,readintags(argv));
+end;
+
+FUNCTION AddAppWindow(id : ULONG; userdata : ULONG; window : pWindow; msgport : pMsgPort; Const argv : Array Of Const) : pAppWindow;
+begin
+    AddAppWindow := AddAppWindowA(id,userdata,window,msgport,readintags(argv));
+end;
+
+
+
+end.

packages/amunits/src/utilunits/tagsarray.pas

@@ -26,11 +26,16 @@ type
   TTagsList = array of ttagitem;
   PMyTags = ^TTagsList;
 
+
+function ReadInTags(const Args: array of const): PTagItem;
 procedure AddTags(var Taglist: TTagsList; const Args: array of const);
 function GetTagPtr(var TagList: TTagsList): PTagItem;
 
 implementation
 
+var
+  MyTags: PMyTags;
+
 procedure AddTags(var Taglist: TTagsList; const Args: array of const);
 var
   i: PtrInt;
@@ -64,8 +69,43 @@ begin
   GetTagPtr := @(TagList[0]);
 end;
 
-initialization
+function ReadInTags(const Args: array of const): PTagItem;
+var
+  i: PtrInt;
+  ii: PtrInt;
+begin
+  ii := 0;
+  SetLength(MyTags^, (Length(Args) div 2) + 4); // some more at the end
+  for i := 0 to High(Args) do
+  begin
+    if not Odd(i) then
+    begin
+      mytags^[ii].ti_tag := PtrInt(Args[i].vinteger);
+    end else
+    begin
+      case Args[i].vtype of
+        vtinteger: mytags^[ii].ti_data := PtrInt(Args[i].vinteger);
+        vtboolean: mytags^[ii].ti_data := PtrInt(Byte(Args[i].vboolean));
+        vtpchar: mytags^[ii].ti_data := PtrInt(Args[i].vpchar);
+        vtchar: mytags^[ii].ti_data := PtrInt(Args[i].vchar);
+        vtstring: mytags^[ii].ti_data := PtrInt(PChar(string(Args[i].vstring^)));
+        vtpointer: mytags^[ii].ti_data := PtrInt(Args[i].vpointer);
+      end;
+      Inc(ii);
+    end;
+  end;
+  Inc(ii);
+  // Add additional TAG_DONE (if user forget)
+  mytags^[ii].ti_tag := TAG_DONE;
+  mytags^[ii].ti_data := 0;
+  // return the pointer
+  ReadInTags := @(MyTags^[0]);
+end;
 
+initialization
+  New(MyTags);
+  SetLength(MyTags^, 200);
 finalization
-
+  SetLength(MyTags^, 0);
+  Dispose(MyTags);
 end.

packages/bfd/Makefile

@@ -1,11 +1,11 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-07-28 rev 31240]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-09-05 rev 31523]
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos aarch64-linux aarch64-darwin
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos i8086-win16 aarch64-linux aarch64-darwin
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
-LIMIT83fs = go32v2 os2 emx watcom msdos
+LIMIT83fs = go32v2 os2 emx watcom msdos win16
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
@@ -741,6 +741,12 @@ ifeq ($(OS_TARGET),embedded)
 EXEEXT=.bin
 SHORTSUFFIX=emb
 endif
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -1628,6 +1634,14 @@ REQUIRE_PACKAGES_HASH=1
 REQUIRE_PACKAGES_LIBTAR=1
 REQUIRE_PACKAGES_FPMKUNIT=1
 endif
+ifeq ($(FULL_TARGET),i8086-win16)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
 ifeq ($(FULL_TARGET),aarch64-linux)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_PASZLIB=1

packages/cairo/Makefile

@@ -1,11 +1,11 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-07-28 rev 31240]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-09-05 rev 31523]
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos aarch64-linux aarch64-darwin
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos i8086-win16 aarch64-linux aarch64-darwin
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
-LIMIT83fs = go32v2 os2 emx watcom msdos
+LIMIT83fs = go32v2 os2 emx watcom msdos win16
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
@@ -741,6 +741,12 @@ ifeq ($(OS_TARGET),embedded)
 EXEEXT=.bin
 SHORTSUFFIX=emb
 endif
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -1628,6 +1634,14 @@ REQUIRE_PACKAGES_HASH=1
 REQUIRE_PACKAGES_LIBTAR=1
 REQUIRE_PACKAGES_FPMKUNIT=1
 endif
+ifeq ($(FULL_TARGET),i8086-win16)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
 ifeq ($(FULL_TARGET),aarch64-linux)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_PASZLIB=1

packages/cdrom/Makefile

@@ -1,11 +1,11 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-07-28 rev 31240]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-09-05 rev 31523]
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos aarch64-linux aarch64-darwin
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos i8086-win16 aarch64-linux aarch64-darwin
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
-LIMIT83fs = go32v2 os2 emx watcom msdos
+LIMIT83fs = go32v2 os2 emx watcom msdos win16
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
@@ -741,6 +741,12 @@ ifeq ($(OS_TARGET),embedded)
 EXEEXT=.bin
 SHORTSUFFIX=emb
 endif
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -1628,6 +1634,14 @@ REQUIRE_PACKAGES_HASH=1
 REQUIRE_PACKAGES_LIBTAR=1
 REQUIRE_PACKAGES_FPMKUNIT=1
 endif
+ifeq ($(FULL_TARGET),i8086-win16)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
 ifeq ($(FULL_TARGET),aarch64-linux)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_PASZLIB=1

packages/cdrom/examples/Makefile

@@ -1,11 +1,11 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-07-28 rev 31240]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-09-05 rev 31523]
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos aarch64-linux aarch64-darwin
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos i8086-win16 aarch64-linux aarch64-darwin
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
-LIMIT83fs = go32v2 os2 emx watcom msdos
+LIMIT83fs = go32v2 os2 emx watcom msdos win16
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
@@ -568,6 +568,9 @@ endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 override TARGET_PROGRAMS+=getdiscid showcds
 endif
+ifeq ($(FULL_TARGET),i8086-win16)
+override TARGET_PROGRAMS+=getdiscid showcds
+endif
 ifeq ($(FULL_TARGET),aarch64-linux)
 override TARGET_PROGRAMS+=getdiscid showcds
 endif
@@ -974,6 +977,12 @@ ifeq ($(OS_TARGET),embedded)
 EXEEXT=.bin
 SHORTSUFFIX=emb
 endif
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -1940,6 +1949,15 @@ REQUIRE_PACKAGES_LIBTAR=1
 REQUIRE_PACKAGES_FPMKUNIT=1
 REQUIRE_PACKAGES_CDROM=1
 endif
+ifeq ($(FULL_TARGET),i8086-win16)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_CDROM=1
+endif
 ifeq ($(FULL_TARGET),aarch64-linux)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_PASZLIB=1

packages/fcl-base/examples/README.txt

@@ -73,5 +73,3 @@ poolmm2.pp   Test for pooledmm (nonfree) (VS)
 testweb.pp   Test for fpcgi (MVC)
 daemon.pp    Test for daemonapp (MVC)
 testtimer.pp Test for TFPTimer (MVC)
-testini.pp   Test/Demo for inifiles, ReadSectionValues.
-contit.pp    Test/Demo for iterators in contnr.pp

packages/fcl-base/examples/contit.pp

@@ -1,118 +0,0 @@
-{$MODE OBJFPC}
-{$H+}
-{$C+}
-program test;
-
-uses
-  contnrs,
-  sysutils;
-
-const
-  KEYS: array [0..5] of string = (
-    'a',
-    'b',
-    'c',
-    'd',
-    'e',
-    'f'
-    );
-
-  TERMINATE_KEY_ID = 2;
-
-
-procedure DataStaticIterator(Item: Pointer; const Key: string; var Continue: Boolean);
-begin
-  Assert(Key = String(Item^));
-  Continue := TRUE;
-end;
-
-procedure DataStaticIteratorTerminated(Item: Pointer; const Key: string; var Continue: Boolean);
-begin
-  Continue := Key <> KEYS[TERMINATE_KEY_ID];
-end;
-
-
-procedure StringStaticIterator(Item: String; const Key: string; var Continue: Boolean);
-begin
-  Assert(Key = Item);
-  Continue := TRUE;
-end;
-
-procedure StringStaticIteratorTerminated(Item: String; const Key: string; var Continue: Boolean);
-begin
-  Continue := Key <> KEYS[TERMINATE_KEY_ID];
-end;
-
-
-type
-  TTestObject = class
-  private
-    FStr: string;
-  public
-    constructor Create(const S: string);
-    property Str: string read FStr;
-  end;
-
-constructor TTestObject.Create(const S: string);
-begin
-  FStr := S;
-end;
-
-
-procedure ObjectStaticIterator(Item: TObject; const Key: string; var Continue: Boolean);
-begin
-  Assert(Key = TTestObject(Item).Str);
-  Continue := TRUE;
-end;
-
-procedure ObjectStaticIteratorTerminated(Item: TObject; const Key: string; var Continue: Boolean);
-begin
-  Continue := Key <> KEYS[TERMINATE_KEY_ID];
-end;
-
-
-var
-  i: integer;
-  data_hash_table: TFPDataHashTable;
-  last_data: pointer;
-  string_hash_table: TFPStringHashTable;
-  last_string: string;
-  object_hash_table: TFPObjectHashTable;
-  last_object: TTestObject;
-
-begin
-  data_hash_table := TFPDataHashTable.Create;
-  for i := 0 to High(KEYS) do
-    data_hash_table.Add(KEYS[i], @KEYS[i]);
-
-  last_data := data_hash_table.Iterate(@DataStaticIterator);
-  Assert(last_data = NIL);
-  last_data := data_hash_table.Iterate(@DataStaticIteratorTerminated);
-  Assert(last_data = @KEYS[TERMINATE_KEY_ID]);
-
-  data_hash_table.Free;
-
-  string_hash_table := TFPStringHashTable.Create;
-  for i := 0 to High(KEYS) do
-    string_hash_table.Add(KEYS[i], KEYS[i]);
-
-  last_string := string_hash_table.Iterate(@StringStaticIterator);
-  Assert(last_string = '');
-  last_string := string_hash_table.Iterate(@StringStaticIteratorTerminated);
-  Assert(last_string = KEYS[TERMINATE_KEY_ID]);
-
-  string_hash_table.Free;
-
-  object_hash_table := TFPObjectHashTable.Create(TRUE);
-  for i := 0 to High(KEYS) do
-    object_hash_table.Add(KEYS[i], TTestObject.Create(KEYS[i]));
-
-  last_object := TTestObject(object_hash_table.Iterate(@ObjectStaticIterator));
-  Assert(last_object = NIL);
-  last_object := TTestObject(object_hash_table.Iterate(@ObjectStaticIteratorTerminated));
-  Assert(last_object.Str = KEYS[TERMINATE_KEY_ID]);
-
-  object_hash_table.Free;
-
-  WriteLn('All is OK');
-end.

packages/fcl-base/examples/inifmt.pp

@@ -1,71 +0,0 @@
-program inifmt;
-
-{$mode objfpc}{$H+}
-
-uses
-  {$IFDEF UNIX}{$IFDEF UseCThreads}
-  cthreads,
-  {$ENDIF}{$ENDIF}
-  Classes, IniFiles, SysUtils
-  { you can add units after this };
-
-var
-  ini: TCustomIniFile;
-  x: Double;
-  t: TTime;
-  d: TDate;
-  dt: TDateTime;
-  iniName: String = 'test.ini';
-  L: TStringList;
-  i: Integer;
-
-begin
-  x := 1.2345;
-  t := time();
-  d := date();
-  dt := now();
-
-  ini := TMemIniFile.Create(iniName);
-  ini.FormatSettings.DecimalSeparator := '|';
-  ini.FormatSettingsActive := true;
-  ini.WriteFloat('Data', 'float', 1.2345);
-  ini.WriteTime('Data', 'time', t);
-  ini.WriteDate('Data', 'date', d);
-  ini.WriteDateTime('Data', 'datetime', dt);
-  ini.Free;
-
-  WriteLn('-----------------------------------------------------------');
-  WriteLn('Ini file (direct file content)');
-  WriteLn('-----------------------------------------------------------');
-  L := TStringList.Create;
-  L.LoadfromFile(ininame);
-  for i:=0 to L.Count-1 do
-    WriteLn(L[i]);
-  L.Free;
-  WriteLn;
-
-  ini := TMemIniFile.Create(iniName);
-  ini.FormatSettings.DecimalSeparator := '|';
-  ini.FormatSettingsActive := true;
-  x := ini.ReadFloat('Data', 'float', 0);
-  t := ini.ReadTime('Data', 'time', 0);
-  d := ini.ReadDate('Data', 'date', 0);
-  dt := ini.ReadDateTime('Data', 'datetime', 0);
-  ini.Free;
-
-  WriteLn('------------------------------------------------------------------');
-  WriteLn('Read input data from ini file (output using DefaultFormatSettings)');
-  WriteLn('------------------------------------------------------------------');
-  WriteLn('float = ', FloatToStr(x));
-  WriteLn('time = ', TimeToStr(t));
-  WriteLn('date = ', DateToStr(d));
-  WriteLn('date/time = ', DateTimeToStr(dt));
-  WriteLn;
-
-  {$IFDEF MSWINDOWS}
-  WriteLn('Press [ENTER] to quit...');
-  ReadLn;
-  {$ENDIF}
-end.
-
-

packages/fcl-process/examples/ipcserver.pp → packages/fcl-base/examples/ipcserver.pp

@@ -1,6 +1,6 @@
 {$mode objfpc}
 {$h+}
-program ipcserver;
+program ipccerver;
 
 {$APPTYPE CONSOLE}
 

packages/fcl-base/examples/sitest.pp

@@ -40,7 +40,7 @@ begin
     WriteLn('Sending response to client.');
     xStringStream := TStringStream.Create('my response');
     try
-      (Sender as TAdvancedSingleInstance).ServerPostCustomResponse(MsgID, MsgType_Response, xStringStream);
+      Sender.ServerPostCustomResponse(MsgID, MsgType_Response, xStringStream);
     finally
       xStringStream.Free;
     end;
@@ -66,9 +66,9 @@ var
 begin
   xApp := TMyCustomApplication.Create(nil);
   try
-    xApp.SingleInstanceEnabled := True;
+    xApp.SingleInstance.Enabled := True;
     xApp.SingleInstance.OnServerReceivedParams := @xApp.ServerReceivedParams;
-    (xApp.SingleInstance as TAdvancedSingleInstance).OnServerReceivedCustomRequest := @xApp.ServerReceivedCustomRequest;
+    xApp.SingleInstance.OnServerReceivedCustomRequest := @xApp.ServerReceivedCustomRequest;
     xApp.Initialize;
     Writeln(xApp.SingleInstance.StartResult);
     xApp.Run;
@@ -79,15 +79,15 @@ begin
       begin
         xStream := TStringStream.Create('hello');
         try
-          (xApp.SingleInstance as TAdvancedSingleInstance).ClientSendCustomRequest(MsgType_Request_No_Response, xStream);
+          xApp.SingleInstance.ClientSendCustomRequest(MsgType_Request_No_Response, xStream);
         finally
           xStream.Free;
         end;
         xStream := TStringStream.Create('I want a response');
         try
-          (xApp.SingleInstance as TAdvancedSingleInstance).ClientSendCustomRequest(MsgType_Request_With_Response, xStream);
+          xApp.SingleInstance.ClientSendCustomRequest(MsgType_Request_With_Response, xStream);
           xStream.Size := 0;
-          if (xApp.SingleInstance as TAdvancedSingleInstance).ClientPeekCustomResponse(xStream, xMsgType) then
+          if xApp.SingleInstance.ClientPeekCustomResponse(xStream, xMsgType) then
             WriteLn('Response: ', xStream.DataString)
           else
             WriteLn('Error: no response');

packages/fcl-base/examples/testini.pp

@@ -1,61 +0,0 @@
-program testini;
-
-{$mode objfpc}{$H+}
-
-uses
-  inifiles, classes;
-
-var
-  i: Integer;
-  ini: TMemIniFile;
-  lines: TStrings;
-
-begin
-  lines:=TStringList.Create();
-  try
-    lines.Add('[main]');
-    lines.Add('key_a=1');
-    lines.Add(';comment');
-    lines.Add('key_b   =2');
-    lines.Add('not_valid');
-    lines.Add('key_c=   3');
-    lines.Add('key_d="3"');
-    WriteLn('ini file source:');
-    for i:=0 to lines.Count-1 do 
-      WriteLn('  ', lines[i]);
-    ini:=TMemIniFile.Create('');
-    try
-      ini.options:=ini.options+[ifoStripQuotes];
-      ini.SetStrings(lines);
-      lines.Clear();
-      ini.ReadSectionValues('main', lines,[]);
-      WriteLn('ReadSectionValues (no options):');
-      for i:=0 to lines.Count-1 do 
-        WriteLn('  ', lines[i]);
-      lines.Clear();
-      ini.ReadSectionValues('main', lines,[svoIncludeComments]);
-      WriteLn('ReadSectionValues (with comments, no invalid):');
-      for i:=0 to lines.Count-1 do
-        WriteLn('  ', lines[i]);
-      lines.Clear();
-      ini.ReadSectionValues('main', lines,[svoIncludeInvalid]);
-      WriteLn('ReadSectionValues (without comments, with invalid):');
-      for i:=0 to lines.Count-1 do
-        WriteLn('  ', lines[i]);
-      lines.Clear();
-      ini.ReadSectionValues('main', lines,[svoIncludeComments,svoIncludeInvalid]);
-      WriteLn('ReadSectionValues (with comments, with invalid):');
-      for i:=0 to lines.Count-1 do
-        WriteLn('  ', lines[i]);
-      Lines.Clear;
-      ini.ReadSectionValues('main', lines,[svoIncludeQuotes]);
-      WriteLn('ReadSectionValues (with quotes):');
-      for i:=0 to lines.Count-1 do
-        WriteLn('  ', lines[i]);
-    finally
-      ini.Free();
-    end;
-  finally
-    lines.Free();
-  end
-end.

packages/fcl-base/fpmake.pp

@@ -53,8 +53,9 @@ begin
     T:=P.Targets.AddUnit('contnrs.pp');
       T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('singleinstance.pp');
-    T:=P.Targets.AddUnit('custapp.pp');
       T.ResourceStrings:=true;
+    T:=P.Targets.AddUnit('custapp.pp');
+    T.ResourceStrings:=true;
     with T.Dependencies do
       AddUnit('singleinstance');
     T:=P.Targets.AddUnit('eventlog.pp');
@@ -66,9 +67,9 @@ begin
     T:=P.Targets.AddUnit('fptimer.pp',AllWindowsOSes+AllUnixOSes);
     T:=P.Targets.AddUnit('gettext.pp');
     T:=P.Targets.AddUnit('idea.pp');
-
+    
     T:=P.Targets.AddUnit('inicol.pp');
-
+    
       T.ResourceStrings:=true;
       with T.Dependencies do
         begin
@@ -123,7 +124,6 @@ begin
       AddUnit('contnrs');
       end;
     T:=P.Targets.addUnit('advancedipc.pp');
-      T.ResourceStrings:=true;
     // Additional sources
     P.Sources.AddSrcFiles('src/win/fclel.*', P.Directory);
     // Install windows resources

packages/fcl-base/src/advancedipc.pp

@@ -30,7 +30,7 @@ uses
   {$IFDEF UNIX}
   baseunix,
   {$endif}
-  sysutils, Classes, singleinstance;
+  sysutils, Classes;
 
 const
   HEADER_VERSION = 2;
@@ -168,43 +168,6 @@ type
 
   EICPException = class(Exception);
 
-  TSingleInstanceReceivedCustomMessage = procedure(Sender: TBaseSingleInstance; MsgID: Integer; MsgType: Integer; MsgData: TStream) of object;
-
-  TAdvancedSingleInstance = class(TBaseSingleInstance)
-  private
-    FGlobal: Boolean;
-    FID: string;
-    FServer: TIPCServer;
-    FClient: TIPCClient;
-    FOnServerReceivedCustomRequest: TSingleInstanceReceivedCustomMessage;
-    function GetIsClient: Boolean; override;
-    function GetIsServer: Boolean; override;
-    function GetStartResult: TSingleInstanceStart; override;
-    procedure SetGlobal(const aGlobal: Boolean);
-    procedure SetID(const aID: string);
-  protected
-    procedure DoServerReceivedCustomRequest(const aMsgID: Integer; const aMsgType: Integer; const aStream: TStream);
-  public
-    constructor Create(aOwner: TComponent); override;
-  public
-    function Start: TSingleInstanceStart; override;
-    procedure Stop; override;
-
-    procedure ServerCheckMessages; override;
-    procedure ClientPostParams; override;
-  public
-    function ClientPostCustomRequest(const aMsgType: Integer; const aStream: TStream): Integer;
-    function ClientSendCustomRequest(const aMsgType: Integer; const aStream: TStream): Boolean; overload;
-    function ClientSendCustomRequest(const aMsgType: Integer; const aStream: TStream; out outRequestID: Integer): Boolean; overload;
-    procedure ServerPostCustomResponse(const aRequestID: Integer; const aMsgType: Integer; const aStream: TStream);
-    function ClientPeekCustomResponse(const aStream: TStream; out outMsgType: Integer): Boolean;
-  public
-    property ID: string read FID write SetID;
-    property Global: Boolean read FGlobal write SetGlobal;
-
-    property OnServerReceivedCustomRequest: TSingleInstanceReceivedCustomMessage read FOnServerReceivedCustomRequest write FOnServerReceivedCustomRequest;
-  end;
-
 resourcestring
   SErrInvalidServerID = 'Invalid server ID "%s". Please use only alphanumerical characters and underlines.';
   SErrSetGlobalActive = 'You cannot change the global property when the server is active.';
@@ -809,284 +772,8 @@ begin
   FActive := False;
 end;
 
-Resourcestring
-  SErrSetSingleInstanceIDStarted = 'You cannot change the single instance ID when it''s been started.';
-  SErrSetSingleInstanceGlobalStarted = 'You cannot change the single instance global property when it''s been started.';
-  SErrStartSingleInstanceStarted = 'You cannot start single instance when it''s been already started.';
-  SErrSingleInstanceStartResultNotAvailable = 'Single instance hasn''t been started yet.';
-  SErrSingleInstanceNotClient = 'Current instance is not a client.';
-  SErrSingleInstanceNotServer = 'Current instance is not a server.';
-
-Const
-  MSGTYPE_CHECK = -1;
-  MSGTYPE_CHECKRESPONSE = -2;
-  MSGTYPE_PARAMS = -3;
-  MSGTYPE_WAITFORINSTANCES = -4;
-
-{ TAdvancedSingleInstance }
-
-constructor TAdvancedSingleInstance.Create(aOwner: TComponent);
-var
-  xID: RawByteString;
-  I: Integer;
-begin
-  inherited Create(aOwner);
-
-  xID := 'SI_'+ExtractFileName(ParamStr(0));
-  for I := 1 to Length(xID) do
-    case xID[I] of
-      'a'..'z', 'A'..'Z', '0'..'9', '_': begin end;
-    else
-      xID[I] := '_';
-    end;
-  ID := xID;
-end;
-
-function TAdvancedSingleInstance.ClientPeekCustomResponse(
-  const aStream: TStream; out outMsgType: Integer): Boolean;
-begin
-  if not Assigned(FClient) then
-    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
-
-  Result := FClient.PeekResponse(aStream, outMsgType, TimeOutMessages);
-end;
-
-function TAdvancedSingleInstance.ClientPostCustomRequest(
-  const aMsgType: Integer; const aStream: TStream): Integer;
-begin
-  if not Assigned(FClient) then
-    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
-
-  Result := FClient.PostRequest(aMsgType, aStream);
-end;
-
-procedure TAdvancedSingleInstance.ClientPostParams;
-var
-  xSL: TStringList;
-  xStringStream: TStringStream;
-  I: Integer;
-begin
-  if not Assigned(FClient) then
-    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
-
-  xSL := TStringList.Create;
-  try
-    for I := 0 to ParamCount do
-      xSL.Add(ParamStr(I));
-
-    xStringStream := TStringStream.Create(xSL.DelimitedText);
-    try
-      xStringStream.Position := 0;
-      FClient.PostRequest(MSGTYPE_PARAMS, xStringStream);
-    finally
-      xStringStream.Free;
-    end;
-  finally
-    xSL.Free;
-  end;
-end;
-
-function TAdvancedSingleInstance.ClientSendCustomRequest(
-  const aMsgType: Integer; const aStream: TStream): Boolean;
-begin
-  if not Assigned(FClient) then
-    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
-
-  Result := FClient.SendRequest(aMsgType, aStream, TimeOutMessages);
-end;
-
-function TAdvancedSingleInstance.ClientSendCustomRequest(
-  const aMsgType: Integer; const aStream: TStream; out
-  outRequestID: Integer): Boolean;
-begin
-  if not Assigned(FClient) then
-    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
-
-  Result := FClient.SendRequest(aMsgType, aStream, TimeOutMessages, outRequestID);
-end;
-
-procedure TAdvancedSingleInstance.DoServerReceivedCustomRequest(
-  const aMsgID: Integer; const aMsgType: Integer; const aStream: TStream);
-begin
-  if Assigned(FOnServerReceivedCustomRequest) then
-    FOnServerReceivedCustomRequest(Self, aMsgID, aMsgType, aStream);
-end;
-
-function TAdvancedSingleInstance.GetIsClient: Boolean;
-begin
-  Result := Assigned(FClient);
-end;
-
-function TAdvancedSingleInstance.GetIsServer: Boolean;
-begin
-  Result := Assigned(FServer);
-end;
-
-function TAdvancedSingleInstance.GetStartResult: TSingleInstanceStart;
-begin
-  if not(Assigned(FServer) or Assigned(FClient)) then
-    raise ESingleInstance.Create(SErrSingleInstanceStartResultNotAvailable);
-
-  Result := inherited GetStartResult;
-end;
-
-procedure TAdvancedSingleInstance.ServerCheckMessages;
-var
-  xMsgID: Integer;
-  xMsgType: Integer;
-  xStream: TStream;
-  xStringStream: TStringStream;
-begin
-  if not Assigned(FServer) then
-    raise ESingleInstance.Create(SErrSingleInstanceNotServer);
-
-  if not FServer.PeekRequest(xMsgID, xMsgType) then
-    Exit;
-
-  case xMsgType of
-    MSGTYPE_CHECK:
-    begin
-      FServer.DeleteRequest(xMsgID);
-      FServer.PostResponse(xMsgID, MSGTYPE_CHECKRESPONSE, nil);
-    end;
-    MSGTYPE_PARAMS:
-    begin
-      xStringStream := TStringStream.Create('');
-      try
-        FServer.ReadRequest(xMsgID, xStringStream);
-        DoServerReceivedParams(xStringStream.DataString);
-      finally
-        xStringStream.Free;
-      end;
-    end;
-    MSGTYPE_WAITFORINSTANCES:
-      FServer.DeleteRequest(xMsgID);
-  else
-    xStream := TMemoryStream.Create;
-    try
-      FServer.ReadRequest(xMsgID, xStream);
-      DoServerReceivedCustomRequest(xMsgID, xMsgType, xStream);
-    finally
-      xStream.Free;
-    end;
-  end;
-end;
-
-procedure TAdvancedSingleInstance.ServerPostCustomResponse(
-  const aRequestID: Integer; const aMsgType: Integer;
-  const aStream: TStream);
-begin
-  if not Assigned(FServer) then
-    raise ESingleInstance.Create(SErrSingleInstanceNotServer);
-
-  FServer.PostResponse(aRequestID, aMsgType, aStream);
-end;
-
-procedure TAdvancedSingleInstance.SetGlobal(const aGlobal: Boolean);
-begin
-  if FGlobal = aGlobal then Exit;
-  if Assigned(FServer) or Assigned(FClient) then
-    raise ESingleInstance.Create(SErrSetSingleInstanceGlobalStarted);
-  FGlobal := aGlobal;
-end;
-
-procedure TAdvancedSingleInstance.SetID(const aID: string);
-begin
-  if FID = aID then Exit;
-  if Assigned(FServer) or Assigned(FClient) then
-    raise ESingleInstance.Create(SErrSetSingleInstanceIDStarted);
-  FID := aID;
-end;
-
-function TAdvancedSingleInstance.Start: TSingleInstanceStart;
-  {$IFNDEF MSWINDOWS}
-  procedure UnixWorkaround(var bServerStarted: Boolean);
-  var
-    xWaitRequestID, xLastCount, xNewCount: Integer;
-    xClient: TIPCClient;
-  begin
-    //file locking workaround for UNIX systems -> the server can be started twice if 2 processes are started in parallel
-    //wait some time to see other clients
-    FServer.StopServer(False);
-    xClient := TIPCClient.Create(Self);
-    try
-      xClient.ServerID := FID;
-      xClient.Global := FGlobal;
-      xWaitRequestID := xClient.PostRequest(MSGTYPE_WAITFORINSTANCES, nil);
-      xLastCount := -1;
-      xNewCount := FServer.GetPendingRequestCount;
-      while xLastCount <> xNewCount do
-      begin
-        xLastCount := xNewCount;
-        Sleep(TimeOutWaitForInstances);
-        xNewCount := FServer.GetPendingRequestCount;
-      end;
-    finally
-      FreeAndNil(xClient);
-    end;
-
-    //find highest client that will be the server
-    if FServer.FindHighestPendingRequestId = xWaitRequestID then
-    begin
-      bServerStarted := FServer.StartServer(False);
-    end else
-    begin
-      //something went wrong, there are not-deleted waiting requests
-      //use random sleep as workaround and try to restart the server
-      Randomize;
-      Sleep(Random(($3F+PtrInt(GetProcessID)) and $3F));//limit to $3F (63)
-      bServerStarted := FServer.StartServer(False) and (FServer.GetPendingRequestCount > 0);
-    end;
-  end;
-  {$ENDIF}
-var
-  xStream: TStream;
-  xMsgType: Integer;
-  xServerStarted: Boolean;
-begin
-  if Assigned(FServer) or Assigned(FClient) then
-    raise ESingleInstance.Create(SErrStartSingleInstanceStarted);
-
-  FServer := TIPCServer.Create(Self);
-  FServer.ServerID := FID;
-  FServer.Global := FGlobal;
-  xServerStarted := FServer.StartServer(False);
-  if xServerStarted then
-  begin//this is single instance -> be server
-    Result := siServer;
-    {$IFNDEF MSWINDOWS}
-    UnixWorkaround(xServerStarted);
-    {$ENDIF}
-  end;
-  if not xServerStarted then
-  begin//instance found -> be client
-    FreeAndNil(FServer);
-    FClient := TIPCClient.Create(Self);
-    FClient.ServerID := FID;
-    FClient.Global := FGlobal;
-    FClient.PostRequest(MSGTYPE_CHECK, nil);
-    xStream := TMemoryStream.Create;
-    try
-      if FClient.PeekResponse(xStream, xMsgType, TimeOutMessages) then
-        Result := siClient
-      else
-        Result := siNotResponding;
-    finally
-      xStream.Free;
-    end;
-  end;
-  SetStartResult(Result);
-end;
-
-procedure TAdvancedSingleInstance.Stop;
-begin
-  FreeAndNil(FServer);
-  FreeAndNil(FClient);
-end;
-
 initialization
   InitCriticalSection(CreateUniqueRequestCritSec);
-  DefaultSingleInstanceClass:=TAdvancedSingleInstance;
 
 finalization
   DoneCriticalsection(CreateUniqueRequestCritSec);

packages/fcl-base/src/contnrs.pp

@@ -412,15 +412,10 @@ type
   THTNode = THTDataNode;
 
   TDataIteratorMethod = Procedure(Item: Pointer; const Key: string; var Continue: Boolean) of object;
-  TDataIteratorCallBack = Procedure(Item: Pointer; const Key: string; var Continue: Boolean);
-
   // For compatibility
   TIteratorMethod = TDataIteratorMethod;
 
   TFPDataHashTable = Class(TFPCustomHashTable)
-  Private
-    FIteratorCallBack: TDataIteratorCallBack;
-    Procedure CallbackIterator(Item: Pointer; const Key: string; var Continue: Boolean);
   Protected
     Function CreateNewNode(const aKey : String) : THTCustomNode; override;
     Procedure AddNode(ANode : THTCustomNode); override;
@@ -429,7 +424,6 @@ type
     Function ForEachCall(aMethod: TDataIteratorMethod): THTDataNode; virtual;
   Public
     Function Iterate(aMethod: TDataIteratorMethod): Pointer; virtual;
-    Function Iterate(aMethod: TDataIteratorCallBack): Pointer; virtual;
     Procedure Add(const aKey: string; AItem: pointer); virtual;
     property Items[const index: string]: Pointer read GetData write SetData; default;
   end;
@@ -441,14 +435,9 @@ type
   public
     property Data: String read FData write FData;
   end;
-  
   TStringIteratorMethod = Procedure(Item: String; const Key: string; var Continue: Boolean) of object;
-  TStringIteratorCallback = Procedure(Item: String; const Key: string; var Continue: Boolean);
 
   TFPStringHashTable = Class(TFPCustomHashTable)
-  Private
-    FIteratorCallBack: TStringIteratorCallback;
-    Procedure CallbackIterator(Item: String; const Key: string; var Continue: Boolean);
   Protected
     Function CreateNewNode(const aKey : String) : THTCustomNode; override;
     Procedure AddNode(ANode : THTCustomNode); override;
@@ -457,7 +446,6 @@ type
     Function ForEachCall(aMethod: TStringIteratorMethod): THTStringNode; virtual;
   Public
     Function Iterate(aMethod: TStringIteratorMethod): String; virtual;
-    Function Iterate(aMethod: TStringIteratorCallback): String; virtual;
     Procedure Add(const aKey,aItem: string); virtual;
     property Items[const index: string]: String read GetData write SetData; default;
   end;
@@ -476,15 +464,11 @@ type
   public
     destructor Destroy; override;
   end;
-
   TObjectIteratorMethod = Procedure(Item: TObject; const Key: string; var Continue: Boolean) of object;
-  TObjectIteratorCallback = Procedure(Item: TObject; const Key: string; var Continue: Boolean);
 
   TFPObjectHashTable = Class(TFPCustomHashTable)
   Private
     FOwnsObjects : Boolean;
-    FIteratorCallBack: TObjectIteratorCallback;
-    procedure CallbackIterator(Item: TObject; const Key: string; var Continue: Boolean);
   Protected
     Function CreateNewNode(const aKey : String) : THTCustomNode; override;
     Procedure AddNode(ANode : THTCustomNode); override;
@@ -495,7 +479,6 @@ type
     constructor Create(AOwnsObjects : Boolean = True);
     constructor CreateWith(AHashTableSize: Longword; aHashFunc: THashFunction; AOwnsObjects : Boolean = True);
     Function Iterate(aMethod: TObjectIteratorMethod): TObject; virtual;
-    Function Iterate(aMethod: TObjectIteratorCallback): TObject; virtual;
     Procedure Add(const aKey: string; AItem : TObject); virtual;
     property Items[const index: string]: TObject read GetData write SetData; default;
     Property OwnsObjects : Boolean Read FOwnsObjects;
@@ -1956,7 +1939,13 @@ end;
 
 Function THTCustomNode.HasKey(const AKey: string): boolean;
 begin
-  Result:=(AKey=FKey);
+  if Length(AKey) <> Length(FKey) then
+    begin
+    Result:=false;
+    Exit;
+    end
+  else
+    Result:=CompareMem(PChar(FKey), PChar(AKey), Length(AKey));
 end;
 
 { TFPCustomHashTable }
@@ -2064,8 +2053,11 @@ begin
   if Assigned(chn) then
     if chn.count>0 then
       for i:=0 to chn.Count - 1 do
-        if THTCustomNode(chn[i]).Key=aKey then
-          Exit(THTCustomNode(chn[i]));
+        if THTCustomNode(chn[i]).HasKey(aKey) then
+          begin
+          Result:=THTCustomNode(chn[i]);
+          Exit;
+          end;
   Result:=nil;
 end;
 
@@ -2080,7 +2072,7 @@ begin
     begin
     if Result.count>0 then
       for i:=0 to Result.Count - 1 do
-        if (THTCustomNode(Result[i]).Key=aKey) then
+        if THTCustomNode(Result[i]).HasKey(aKey) then
           raise EDuplicate.CreateFmt(DuplicateMsg, [aKey]);
     end
   else
@@ -2103,7 +2095,7 @@ begin
   if Assigned(chn) then
     if chn.count>0 then
       for i:=0 to chn.Count - 1 do
-        if THTCustomNode(chn[i]).Key=aKey then
+        if THTCustomNode(chn[i]).HasKey(aKey) then
           begin
           chn.Delete(i);
           dec(FCount);
@@ -2167,8 +2159,11 @@ begin
     begin
     if chn.count>0 then
       for i:=0 to chn.Count - 1 do
-        if (THTCustomNode(chn[i]).Key=aKey) then
-          Exit(THTNode(chn[i]));
+        if THTCustomNode(chn[i]).HasKey(aKey) then
+          begin
+          Result:=THTNode(chn[i]);
+          Exit;
+          end
     end
   else
     begin
@@ -2247,17 +2242,6 @@ begin
     Result:=nil;
 end;
 
-Procedure TFPDataHashTable.CallbackIterator(Item: Pointer; const Key: string; var Continue: Boolean);
-begin
-  FIteratorCallBack(Item, Key, Continue);
-end;
-
-Function TFPDataHashTable.Iterate(aMethod: TDataIteratorCallBack): Pointer;
-begin
-  FIteratorCallBack := aMethod;
-  Result := Iterate(@CallbackIterator);
-end;
-
 Function TFPDataHashTable.ForEachCall(aMethod: TDataIteratorMethod): THTDataNode;
 var
   i, j: Longword;
@@ -2337,17 +2321,6 @@ begin
     Result:='';
 end;
 
-Procedure TFPStringHashTable.CallbackIterator(Item: String; const Key: string; var Continue: Boolean);
-begin
-  FIteratorCallBack(Item, Key, Continue);
-end;
-
-Function TFPStringHashTable.Iterate(aMethod: TStringIteratorCallback): String;
-begin
-  FIteratorCallBack := aMethod;
-  Result := Iterate(@CallbackIterator);
-end;
-
 Function TFPStringHashTable.ForEachCall(aMethod: TStringIteratorMethod): THTStringNode;
 var
   i, j: Longword;
@@ -2425,17 +2398,6 @@ begin
     Result:=nil;
 end;
 
-Procedure TFPObjectHashTable.CallbackIterator(Item: TObject; const Key: string; var Continue: Boolean);
-begin
-  FIteratorCallBack(Item, Key, Continue);
-end;
-
-Function TFPObjectHashTable.Iterate(aMethod: TObjectIteratorCallback): TObject;
-begin
-  FIteratorCallBack := aMethod;
-  Result := Iterate(@CallbackIterator);
-end;
-
 Function TFPObjectHashTable.ForEachCall(aMethod: TObjectIteratorMethod): THTObjectNode;
 var
   i, j: Longword;

packages/fcl-base/src/custapp.pp

@@ -25,28 +25,25 @@ Type
   TExceptionEvent = Procedure (Sender : TObject; E : Exception) Of Object;
   TEventLogTypes = Set of TEventType;
 
+  TCustomApplication = Class;
+  TCustomSingleInstance = Class;
+
   { TCustomApplication }
 
   TCustomApplication = Class(TComponent)
   Private
     FEventLogFilter: TEventLogTypes;
     FOnException: TExceptionEvent;
-    FSingleInstance: TBaseSingleInstance;
-    FSingleInstanceClass: TBaseSingleInstanceClass; // set before FSingleInstance is created
-    FSingleInstanceEnabled: Boolean; // set before Initialize is called
+    FSingleInstance: TCustomSingleInstance;
     FTerminated : Boolean;
     FHelpFile,
     FTitle : String;
     FOptionChar : Char;
     FCaseSensitiveOptions : Boolean;
     FStopOnException : Boolean;
-    FExceptionExitCode : Integer;
     function GetEnvironmentVar(VarName : String): String;
     function GetExeName: string;
     Function GetLocation : String;
-    function GetSingleInstance: TBaseSingleInstance;
-    procedure SetSingleInstanceClass(
-      const ASingleInstanceClass: TBaseSingleInstanceClass);
     function GetTitle: string;
   Protected
     function GetOptionAtIndex(AIndex: Integer; IsLong: Boolean): String;
@@ -65,7 +62,6 @@ Type
     procedure Run;
     procedure ShowException(E: Exception);virtual;
     procedure Terminate; virtual;
-    procedure Terminate(AExitCode : Integer) ; virtual;
     // Extra methods.
     function FindOptionIndex(Const S : String; Var Longopt : Boolean; StartAt : Integer = -1) : Integer;
     Function GetOptionValue(Const S : String) : String;
@@ -83,7 +79,6 @@ Type
     Procedure GetEnvironmentList(List : TStrings;NamesOnly : Boolean);
     Procedure GetEnvironmentList(List : TStrings);
     Procedure Log(EventType : TEventType; const Msg : String);
-    Procedure Log(EventType : TEventType; const Fmt : String; const Args : array of const);
     // Delphi properties
     property ExeName: string read GetExeName;
     property HelpFile: string read FHelpFile write FHelpFile;
@@ -99,11 +94,16 @@ Type
     Property OptionChar : Char Read FoptionChar Write FOptionChar;
     Property CaseSensitiveOptions : Boolean Read FCaseSensitiveOptions Write FCaseSensitiveOptions;
     Property StopOnException : Boolean Read FStopOnException Write FStopOnException;
-    Property ExceptionExitCode : Longint Read FExceptionExitCode Write FExceptionExitCode;
     Property EventLogFilter : TEventLogTypes Read FEventLogFilter Write FEventLogFilter;
-    Property SingleInstance: TBaseSingleInstance read GetSingleInstance;
-    Property SingleInstanceClass: TBaseSingleInstanceClass read FSingleInstanceClass write SetSingleInstanceClass;
-    Property SingleInstanceEnabled: Boolean read FSingleInstanceEnabled write FSingleInstanceEnabled;
+    Property SingleInstance: TCustomSingleInstance read FSingleInstance;
+  end;
+
+  TCustomSingleInstance = class(TBaseSingleInstance)
+  private
+    FEnabled: Boolean;
+  public
+    //you must set Enabled before CustomApplication.Initialize
+    property Enabled: Boolean read FEnabled write FEnabled;
   end;
 
 var CustomApplication : TCustomApplication = nil;
@@ -234,17 +234,6 @@ begin
   Result:=ParamStr(Index);
 end;
 
-function TCustomApplication.GetSingleInstance: TBaseSingleInstance;
-begin
-  if FSingleInstance = nil then
-    begin
-    if FSingleInstanceClass=Nil then
-      Raise ESingleInstance.Create('No single instance provider class set! Include a single-instance class unit such as advsingleinstance');
-    FSingleInstance := FSingleInstanceClass.Create(Self);
-    end;
-  Result := FSingleInstance;
-end;
-
 procedure TCustomApplication.SetTitle(const AValue: string);
 begin
   FTitle:=AValue;
@@ -257,9 +246,8 @@ end;
 
 procedure TCustomApplication.DoRun;
 begin
-  if Assigned(FSingleInstance) then
-    if FSingleInstance.IsServer then
-      FSingleInstance.ServerCheckMessages;
+  if FSingleInstance.IsServer then
+    FSingleInstance.ServerCheckMessages;
 
   // Override in descendent classes.
 end;
@@ -277,24 +265,13 @@ begin
     DoLog(EventType,Msg);
 end;
 
-procedure TCustomApplication.Log(EventType: TEventType; const Fmt: String;
-  const Args: array of const);
-begin
-  try
-    Log(EventType, Format(Fmt, Args));
-  except
-    On E : Exception do
-      Log(etError,Format('Error formatting message "%s" with %d arguments: %s',[Fmt,Length(Args),E.Message]));
-  end  
-end;
-
 constructor TCustomApplication.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FOptionChar:='-';
   FCaseSensitiveOptions:=True;
   FStopOnException:=False;
-  FSingleInstanceClass := DefaultSingleInstanceClass;
+  FSingleInstance := TCustomSingleInstance.Create(Self);
 end;
 
 destructor TCustomApplication.Destroy;
@@ -314,19 +291,19 @@ begin
       FOnException(Sender,Exception(ExceptObject));
     end;
   If FStopOnException then
-    Terminate(ExceptionExitCode);
+    FTerminated:=True;
 end;
 
 
 procedure TCustomApplication.Initialize;
 begin
   FTerminated:=False;
-  if FSingleInstanceEnabled then
+  if FSingleInstance.Enabled then
   begin
-    case SingleInstance.Start of
+    case FSingleInstance.Start of
       siClient:
       begin
-        SingleInstance.ClientPostParams;
+        FSingleInstance.ClientPostParams;
         FTerminated:=True;
       end;
       siNotResponding:
@@ -347,13 +324,6 @@ begin
   Until FTerminated;
 end;
 
-procedure TCustomApplication.SetSingleInstanceClass(
-  const ASingleInstanceClass: TBaseSingleInstanceClass);
-begin
-  Assert((FSingleInstance = nil) and (ASingleInstanceClass <> nil));
-  FSingleInstanceClass := ASingleInstanceClass;
-end;
-
 procedure TCustomApplication.ShowException(E: Exception);
 
 begin
@@ -361,16 +331,8 @@ begin
 end;
 
 procedure TCustomApplication.Terminate;
-begin
-  Terminate(0);
-end;
-
-procedure TCustomApplication.Terminate(AExitCode : Integer) ;
-
 begin
   FTerminated:=True;
-  If (AExitCode<>0) then
-    ExitCode:=AExitCode;
 end;
 
 function TCustomApplication.GetOptionAtIndex(AIndex : Integer; IsLong: Boolean): String;

packages/fcl-base/src/fptimer.pp

@@ -23,32 +23,12 @@
   
   A nice improvement would be an implementation that works
   in all threads, such as the threadedtimer of IBX for linux.
-
-  Replaced SLEEP with TEvent for those platforms supporting threading:
-           Windows, Linux, BSD.
-  On the other platforms, use sleep. This unfortunately has a high overhead
-     resulting in drift.  A five minute timer could be up to 40 seconds late
-     do to entering and returning (linux x64).  MOdified to check the absolute
-     time every minute, has reduced that lag to about 0.100 second.  This is
-     still greater than TEvent, where the delay is only a few milliseconds (0-3).     
 }
 
-unit fptimer;
+unit fpTimer;
 
 {$mode objfpc}{$H+}
 
-{ 
-  Windows, or any platform that uses Cthreads has TEvent with a timed wait
-  which can include android and embedded.
-  You can force the use of the Sleep() based timer by defining USESLEEP
-}
-
-{$IFNDEF USESLEEP}
-{$if Defined(MSWINDOWS) or (Defined(UNIX) and not Defined(BEOS))}
-{$define Has_EventWait}
-{$endif}
-{$ENDIF}
-
 interface
 
 uses
@@ -56,25 +36,20 @@ uses
 
 type
   TFPTimerDriver = Class;
-
-  { TFPCustomTimer }
-
+  
   TFPCustomTimer = class(TComponent)
   private
+    FInterval: Integer;
     FDriver : TFPTimerDriver;
-    FOnStartTimer : TNotifyEvent;
-    FOnStopTimer : TNotifyEvent;
-    FOnTimer : TNotifyEvent;
-    FInterval : Cardinal;
-    FActive : Boolean;
-    FEnabled : Boolean;
-    FUseTimerThread : Boolean;
-    procedure SetEnabled(const AValue: Boolean );
-    procedure SetInterval(const AValue: Cardinal);
+    FOnTimer: TNotifyEvent;
+    FContinue: Boolean;
+    FRunning: Boolean;
+    FEnabled: Boolean;
+    procedure   SetEnabled(Value: Boolean );
   protected
-    property Active: Boolean read FActive write FActive;
-    Function CreateTimerDriver : TFPTimerDriver;
+    property  Continue: Boolean read FContinue write FContinue;
     procedure Timer; virtual;
+    Function CreateTimerDriver : TFPTimerDriver;
   public
     Constructor Create(AOwner: TComponent); override;
     Destructor Destroy; override;
@@ -82,36 +57,25 @@ type
     procedure StopTimer; virtual;
   protected
     property Enabled: Boolean read FEnabled write SetEnabled;
-    property Interval: Cardinal read FInterval write SetInterval;
-    property UseTimerThread: Boolean read FUseTimerThread write FUseTimerThread;
+    property Interval: Integer read FInterval write FInterval;
     property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
-    property OnStartTimer: TNotifyEvent read FOnStartTimer write FOnStartTimer;
-    property OnStopTimer: TNotifyEvent read FOnStopTimer write FOnStopTimer;
   end;
 
   TFPTimer = Class(TFPCustomTimer)
   Published
     Property Enabled;
     Property Interval;
-    Property UseTimerThread;
     Property OnTimer;
-    Property OnStartTimer;
-    Property OnStopTimer;
-  end;
-
-  { TFPTimerDriver }
+  end;  
 
   TFPTimerDriver = Class(TObject)
   Protected
     FTimer : TFPCustomTimer;
-    FTimerStarted : Boolean;
-    procedure SetInterval(const AValue: Cardinal); virtual;
   Public
     Constructor Create(ATimer : TFPCustomTimer); virtual;
     Procedure StartTimer; virtual; abstract;
     Procedure StopTimer; virtual; abstract;
     Property Timer : TFPCustomTimer Read FTimer;
-    property TimerStarted: Boolean read FTimerStarted;
   end;
   TFPTimerDriverClass = Class of TFPTimerDriver;
 
@@ -136,8 +100,9 @@ end;
 destructor TFPCustomTimer.Destroy;
 
 begin
-  StopTimer;
-  FDriver.FTimer:=Nil;
+  If FEnabled then
+    StopTimer;
+  FDriver.FTimer:=Nil;  
   FreeAndNil(FDriver);
   Inherited;
 end;
@@ -149,59 +114,34 @@ begin
   Result:=DefaultTimerDriverClass.Create(Self);
 end;
 
-procedure TFPCustomTimer.SetEnabled(const AValue: Boolean);
+procedure TFPCustomTimer.SetEnabled(Value: Boolean);
 begin
-  if AValue <> FEnabled then
+  if Value <> FEnabled then
     begin
-    FEnabled := AValue;
-    if FEnabled then
+    if Value then
       StartTimer
     else
       StopTimer;
     end;
 end;
 
-procedure TFPCustomTimer.SetInterval(const AValue: Cardinal);
-begin
-  if FInterval <> AValue then
-    begin
-    fInterval := AValue;
-    if FActive and (fInterval > 0) then
-      FDriver.SetInterval(AValue)  // Allow driver to update Interval
-    else
-      StopTimer;                   // Timer not required
-    end;
-end;
-
 procedure TFPCustomTimer.StartTimer;
-var
-  IsActive: Boolean;
 begin
-  IsActive:=FEnabled and (fInterval > 0) and Assigned(FOnTimer);
-  If IsActive and not fActive and Not (csDesigning in ComponentState) then
-    begin
+  If FEnabled then
+    Exit;
+  FEnabled:=True;
+  FContinue:=True;  
+  If Not (csDesigning in ComponentState) then  
     FDriver.StartTimer;
-    if FDriver.TimerStarted then
-      begin
-      FActive := True;
-      if Assigned(OnStartTimer) then
-        OnStartTimer(Self);
-      end;
-    end;
 end;
 
 procedure TFPCustomTimer.StopTimer;
 begin
-  if FActive then
-    begin
-    FDriver.StopTimer;
-    if not FDriver.TimerStarted then
-      begin
-      FActive:=False;
-      if Assigned(OnStopTimer) then
-        OnStopTimer(Self);
-      end;
-    end;
+  If Not FEnabled then 
+    Exit;
+  FEnabled:=False;
+  FContinue:=False;  
+  FDriver.StopTimer;
 end;
 
 procedure TFPCustomTimer.Timer;
@@ -209,13 +149,14 @@ procedure TFPCustomTimer.Timer;
 begin
   { We check on FEnabled: If by any chance a tick comes in after it was
     set to false, the user won't notice, since no event is triggered.}
-  If FActive and Assigned(FOnTimer) then
+  If FEnabled and Assigned(FOnTimer) then
     FOnTimer(Self);
 end;
 
 { ---------------------------------------------------------------------
   TFPTimerDriver
   ---------------------------------------------------------------------}
+  
 
 Constructor TFPTimerDriver.Create(ATimer : TFPCustomTimer);
 
@@ -223,327 +164,116 @@ begin
   FTimer:=ATimer;
 end;
 
-procedure TFPTimerDriver.SetInterval(const AValue: Cardinal);
-begin
-  // Default implementation is to restart the timer on Interval change
-  if TimerStarted then
-    begin
-    StopTimer;
-    FTimerStarted := (AValue > 0);
-    if FTimerStarted then
-      StartTimer;
-    end;
-end;
-
 
 { ---------------------------------------------------------------------
     Default implementation. Threaded timer, one thread per timer.
   ---------------------------------------------------------------------}
-
-const
-  cMilliSecs: Extended = 60.0 * 60.0 * 24.0 * 1000.0;
   
 Type
-
-  { TFPTimerThread }
-
   TFPTimerThread = class(TThread)
   private
     FTimerDriver: TFPTimerDriver;
-    FStartTime : TDateTime;
-    {$ifdef Has_EventWait}
-    FWaitEvent: PEventState;
-    {$else}
-    fSignaled: Boolean;
-    {$endif}
-    fInterval: Cardinal;
     Function Timer : TFPCustomTimer;
-    Function GetWakeTime(var AInterval,Counter : Int64; Out WakeInterval : Integer; Out WakeTime : TDateTime) : Boolean;
   public
     procedure Execute; override;
     constructor CreateTimerThread(ATimerDriver: TFPTimerDriver);
-    procedure Terminate;
-    procedure SetInterval(const AValue: Cardinal);
   end;
 
-  { TFPThreadedTimerDriver }
-
   TFPThreadedTimerDriver = Class(TFPTimerDriver)
   Private
     FThread : TFPTimerThread;
-  protected
-    Procedure SetInterval(const AValue: cardinal); override;
+    Procedure DoNilTimer(Sender : TObject);
   Public
     Procedure StartTimer; override;
     Procedure StopTimer; override;
   end;
 
+function _GetTickCount: Cardinal;
+begin
+  Result := Cardinal(Trunc(Now * 24 * 60 * 60 * 1000));
+end;
+
 { ---------------------------------------------------------------------
     TFPTimerThread
   ---------------------------------------------------------------------}
-
+  
 constructor TFPTimerThread.CreateTimerThread(ATimerDriver: TFPTimerDriver);
 begin
   inherited Create(True);
   FTimerDriver:=ATimerDriver;
-  {$ifdef Has_EventWait}
-  FWaitEvent := BasicEventCreate(nil,false,false,'');
-  {$else}
-  fSignaled := False;
-  {$endif}
-  fInterval := ATimerDriver.Timer.Interval;
   FreeOnTerminate := True;
 end;
 
-procedure TFPTimerThread.Terminate;
-begin
-  inherited Terminate;
-  {$ifdef Has_EventWait}
-  BasicEventSetEvent(fWaitEvent);
-  {$else}
-  fSignaled := True;
-  {$endif}
-end;
-
-procedure TFPTimerThread.SetInterval(const AValue: Cardinal);
-begin
-  if fInterval <> AValue then
-    begin
-    fInterval := AValue;
-    {$ifdef Has_EventWait}
-    BasicEventSetEvent(fWaitEvent);   // Wake thread
-    {$else}
-    fSignaled := True;
-    {$endif}
-    end;
-end;
-
 Function TFPTimerThread.Timer : TFPCustomTimer;
 
 begin
   If Assigned(FTimerDriver) Then
     Result:=FTimerDriver.FTimer
   else
-    Result:=Nil;
-end;
-
-Function TFPTimerThread.GetWakeTime(var AInterval,Counter : Int64; Out WakeInterval : Longint; Out WakeTime : TDateTime) : Boolean;
-
-
-Var
-  Diff: Extended;
-   
-begin
-    { Use Counter*fInterval to avoid numerical errors resulting from adding
-      small values (AInterval/cMilliSecs) to a large real number (TDateTime),
-      even when using Extended precision }
-  WakeTime := FStartTime + (Counter*AInterval / cMilliSecs);
-  Diff := (WakeTime - Now);
-  if Diff > 0 then
-    begin
-    WakeInterval := Trunc(Diff * cMilliSecs);
-    if WakeInterval < 10 then
-      WakeInterval := 10;    // Provide a minimum wait time
-    end
-  else
-    begin
-    WakeInterval:=MaxInt;
-    // Time has already expired, execute Timer and restart wait loop
-    try
-      if not Timer.UseTimerThread then
-        Synchronize(@Timer.Timer)  // Call user event
-      else
-        Timer.Timer;
-    except
-      // Trap errors to prevent this thread from terminating
-    end;
-    Inc(Counter);
-    Result:=True;
-    end;
+    Result:=Nil;  
 end;
 
-{$ifdef Has_EventWait}
 procedure TFPTimerThread.Execute;
 var
-  WakeTime, StartTime: TDateTime;
-  WakeInterval: Integer;
-  Counter: int64; { use Int64 to avoid overflow with Counter*fInterval (~49 days)}
-  AInterval: int64;
-  Diff: Extended;
-  
-Const
-  wrSignaled = 0;
-  wrTimeout  = 1;
-  wrAbandoned= 2;
-  wrError    = 3;
-  
-begin
-  WakeInterval := MaxInt;
-  Counter := 1;
-  AInterval := fInterval;
-  FStartTime := Now;
-  while not Terminated do
-    begin
-    if GetWakeTime(AInterval,Counter,WakeInterval,WakeTime) then 
-      Continue;
-    if not Terminated then
-      case BasicEventWaitFor(WakeInterval,fWaitEvent) of
-      wrTimeout:
-        begin
-        if Terminated then
-          Break
-        else
-          begin
-          try
-            if not Timer.UseTimerThread then
-              // If terminate is called while here, then the Synchronize will be
-              // queued while the stoptimer is being processed.
-              // StopTimer cannot wait until thread completion as this would deadlock
-              Synchronize(@Timer.Timer)  // Call user event
-            else
-              Timer.Timer;
-          except
-            // Trap errors to prevent this thread from terminating
-          end;
-          Inc(Counter);                // Next interval
-          end;
-        end;
-      wrSignaled:
-        begin
-        if Terminated then
-          Break
-        else 
-          begin                      // Interval has changed
-          Counter := 1;              // Restart timer without creating new thread
-          AInterval := fInterval;
-          FStartTime := Now; 
-          end;
-        end;
-      else
-        Break;
-      end
-    end;
-  BasicEventDestroy(fWaitEvent);
-end;
-
-{$ELSE Has_EventWait}
-
-procedure TFPTimerThread.Execute;
-
-var
-  WakeTime, StartTime: TDateTime;
-  WakeInterval: Integer;
-  Counter: int64; { use Int64 to avoid overflow with Counter*fInterval (~49 days)}
-  AInterval: int64;
-  Diff: Extended;
+  SleepTime: Integer;
   S,Last: Cardinal;
-  RecheckTimeCounter: integer;
-  
-const
-  cSleepTime = 500;           // 0.5 second, better than every 5 milliseconds
-  cRecheckTimeCount = 120;    // Recheck clock every minute, as the sleep loop can loose time
+  T : TFPCustomTimer;
   
 begin
-  WakeInterval := MaxInt;
-  Counter := 1;
-  AInterval := fInterval;
-  FStartTime := Now;
-  while not Terminated do
+  while Not Terminated do
     begin
-    if GetWakeTime(AInterval,Counter,WakeInterval,WakeTime) then
-      Continue;
-    if not Terminated then
+    Last := _GetTickCount;
+    T:=Timer;
+    If Assigned(T) then
       begin
-      RecheckTimeCounter := cRecheckTimeCount;
-      s := cSleepTime;
-      repeat
-        if s > WakeInterval then
-          s := WakeInterval;
-        sleep(s);
-        if fSignaled then            // Terminated or interval has changed
-          begin
-          if not Terminated then
-            begin
-            fSignaled := False;
-            Counter := 1;            // Restart timer
-            AInterval := fInterval;
-            StartTime := Now;
-            end;
-          break;                     // Need to break out of sleep loop
-          end;
-
-        dec(WakeInterval,s);         // Update total wait time
-        dec(RecheckTimeCounter);     // Do we need to recheck current time
-        if (RecheckTimeCounter < 0) and (WakeInterval > 0) then
-          begin
-          Diff := (WakeTime - Now);
-          WakeInterval := Trunc(Diff * cMilliSecs);
-          RecheckTimeCounter := cRecheckTimeCount;
-          s := cSleepTime;
-          end;
-      until (WakeInterval<=0) or Terminated;
-      if WakeInterval <= 0 then
-        try
-          inc(Counter);
-          if not Timer.UseTimerThread then
-            // If terminate is called while here, then the Synchronize will be
-            // queued while the stoptimer is being processed.
-            // StopTimer cannot wait until thread completion as this would deadlock
-            Synchronize(@Timer.Timer)  // Call user event
-          else
-            Timer.Timer;
-        except
-          // Trap errors to prevent this thread from terminating
-        end;
+      SleepTime := T.FInterval - (_GetTickCount - Last);
+      if SleepTime < 10 then
+        SleepTime := 10;
+      Repeat  
+        S:=5;
+        If S>SleepTime then
+          S:=SleepTime;
+        Sleep(S);
+        Dec(Sleeptime,S);
+      until (SleepTime<=0) or Terminated;
+      T:=Timer;
+      If Assigned(T) and not terminated then
+        Synchronize(@T.Timer);
       end
+    else
+      Terminate;  
     end;
 end;
-{$ENDIF Has_EventWait}
+
 { ---------------------------------------------------------------------
     TFPThreadedTimerDriver
   ---------------------------------------------------------------------}
 
-procedure TFPThreadedTimerDriver.SetInterval(const AValue: cardinal);
+Procedure TFPThreadedTimerDriver.DoNilTimer(Sender : TObject);
+
 begin
-  if FThread <> nil then
-    begin
-    if AValue > 0 then
-      FThread.SetInterval(AValue)
-    else
-      StopTimer;
-    end;
+  FThread:=Nil;
 end;
 
-Procedure TFPThreadedTimerDriver.StartTimer;
+Procedure TFPThreadedTimerDriver.StartTimer; 
 
 begin
-  if FThread = nil then
-    begin
-    FThread:=TFPTimerThread.CreateTimerThread(Self);
-    FThread.Start;
-    FTimerStarted := True;
-    end;
+  FThread:=TFPTimerThread.CreateTimerThread(Self);
+  FThread.OnTerminate:=@DoNilTimer;
+  FThread.Start;
 end;
 
 Procedure TFPThreadedTimerDriver.StopTimer;
 begin
-  if FThread <> nil then
-    begin
-    try
-      // Cannot wait on thread in case
-      // 1.  this is called in a Synchonize method and the FThread is
-      //     about to run a synchronize method. In these cases we would have a deadlock
-      // 2.  In a DLL and this is called as part of DLLMain, which never
-      //     returns endthread (hence WaitFor) until DLLMain is exited
-      FThread.Terminate;   // Will call FThread.Wake;
-    finally
-      FThread := nil;
-    end;
-    FTimerStarted := False;
-    end;
+  FThread.FTimerDriver:=Nil;
+  FThread.Terminate; // Will free itself.
+  CheckSynchronize; // make sure thread is not stuck at synchronize call.
+  If Assigned(FThread) then
+    Fthread.WaitFor;  
 end;
 
 
 Initialization
   DefaultTimerDriverClass:=TFPThreadedTimerDriver;
 end.
+

packages/fcl-base/src/inifiles.pp

@@ -134,31 +134,17 @@ type
     property Items[Index: integer]: TIniFileSection read GetItem; default;
   end;
 
-  TIniFileOption = (ifoStripComments,    // Strip comments when reading file
-                    ifoStripInvalid,     // Strip invalid lines when reading file.
-                    ifoEscapeLineFeeds, // Escape linefeeds when reading file.
-                    ifoCaseSensitive,   // Use Case sensitive section/key names
-                    ifoStripQuotes,     // Strip quotes when reading string values.
-                    ifoFormatSettingsActive); // Use format settings when writing date/float etc.
-  TIniFileOptions = Set of TIniFileOption;
-
-  TSectionValuesOption = (svoIncludeComments,svoIncludeInvalid, svoIncludeQuotes);
-  TSectionValuesOptions = set of TSectionValuesOption;
-
   { TCustomIniFile }
 
   TCustomIniFile = class
   Private
     FFileName: string;
-    FOptions: TIniFileOptions;
     FSectionList: TIniFileSectionList;
-    function GetOption(AIndex: TIniFileOption): Boolean;
-    procedure SetOption(AIndex: TIniFileOption; AValue: Boolean);
-    procedure SetOptions(AValue: TIniFileOptions);
+    FEscapeLineFeeds: boolean;
+    FCaseSensitive : Boolean;
+    FStripQuotes : Boolean;
   public
-    FormatSettings: TFormatSettings;
-    constructor Create(const AFileName: string; AOptions : TIniFileOptions = []); virtual;
-    constructor Create(const AFileName: string; AEscapeLineFeeds : Boolean); virtual;
+    constructor Create(const AFileName: string; AEscapeLineFeeds : Boolean = False); virtual;
     destructor Destroy; override;
     function SectionExists(const Section: string): Boolean; virtual;
     function ReadString(const Section, Ident, Default: string): string; virtual; abstract;
@@ -181,18 +167,15 @@ type
     procedure WriteBinaryStream(const Section, Name: string; Value: TStream); virtual;
     procedure ReadSection(const Section: string; Strings: TStrings); virtual; abstract;
     procedure ReadSections(Strings: TStrings); virtual; abstract;
-    procedure ReadSectionValues(const Section: string; Strings: TStrings; Options : TSectionValuesOptions); virtual;    overload;
-    procedure ReadSectionValues(const Section: string; Strings: TStrings); virtual;overload;
+    procedure ReadSectionValues(const Section: string; Strings: TStrings); virtual; abstract;
     procedure EraseSection(const Section: string); virtual; abstract;
     procedure DeleteKey(const Section, Ident: String); virtual; abstract;
     procedure UpdateFile; virtual; abstract;
     function ValueExists(const Section, Ident: string): Boolean; virtual;
     property FileName: string read FFileName;
-    Property Options : TIniFileOptions Read FOptions Write SetOptions;
-    property EscapeLineFeeds: boolean index ifoEscapeLineFeeds Read GetOption ;deprecated 'Use options instead';
-    Property CaseSensitive : Boolean index ifoCaseSensitive Read GetOption Write SetOption; deprecated  'Use options instead';
-    Property StripQuotes : Boolean index ifoStripQuotes Read GetOption Write SetOption; deprecated 'Use options instead';
-    Property FormatSettingsActive : Boolean index ifoFormatSettingsActive Read GetOption Write SetOption;deprecated  'Use options instead';
+    property EscapeLineFeeds: boolean read FEscapeLineFeeds;
+    Property CaseSensitive : Boolean Read FCaseSensitive Write FCaseSensitive;
+    Property StripQuotes : Boolean Read FStripQuotes Write FStripQuotes;
   end;
 
   { TIniFile }
@@ -211,16 +194,15 @@ type
     procedure MaybeUpdateFile;
     property Dirty : Boolean Read FDirty;
   public
-    constructor Create(const AFileName: string; AOptions : TIniFileoptions = []); overload; override;
-    constructor Create(AStream: TStream; AOptions : TIniFileoptions = []); overload;
-    constructor Create(AStream: TStream; AEscapeLineFeeds : Boolean); overload; deprecated 'Use Options argument instead';
+    constructor Create(const AFileName: string; AEscapeLineFeeds : Boolean = False); overload; override;
+    constructor Create(AStream: TStream; AEscapeLineFeeds : Boolean = False); overload;
     destructor Destroy; override;
     function ReadString(const Section, Ident, Default: string): string; override;
     procedure WriteString(const Section, Ident, Value: String); override;
     procedure ReadSection(const Section: string; Strings: TStrings); override;
     procedure ReadSectionRaw(const Section: string; Strings: TStrings);
     procedure ReadSections(Strings: TStrings); override;
-    procedure ReadSectionValues(const Section: string; Strings: TStrings; AOptions : TSectionValuesOptions = []); overload; override;
+    procedure ReadSectionValues(const Section: string; Strings: TStrings); override;
     procedure EraseSection(const Section: string); override;
     procedure DeleteKey(const Section, Ident: String); override;
     procedure UpdateFile; override;
@@ -525,59 +507,11 @@ end;
 
 { TCustomIniFile }
 
-
-function TCustomIniFile.GetOption(AIndex: TIniFileOption): Boolean;
-begin
-  Result:=AIndex in FOptions;
-end;
-
-
-procedure TCustomIniFile.SetOption(AIndex: TIniFileOption; AValue: Boolean);
-begin
-  if AIndex in [ifoStripComments,ifoStripInvalid] then
-    Raise Exception.Create('Flags ifoStripComments or ifoStripInvalid must be set/unset in the constructor');
-  if AValue then
-    Include(FOptions,AIndex)
-  else
-    Exclude(FOptions,AIndex)
-end;
-
-procedure TCustomIniFile.SetOptions(AValue: TIniFileOptions);
-
-Const
-  CreateOnlyOptions = [ifoStripComments,ifoStripInvalid];
-begin
-  if FOptions=AValue then Exit;
-  if (Foptions*CreateOnlyOptions)<>(AValue*CreateOnlyOptions) then
-    Raise Exception.Create('Can only change StripComments or StripInvalid in constructor');
-  FOptions:=AValue;
-end;
-
-constructor TCustomIniFile.Create(const AFileName: string; AOptions : TIniFileOptions = []);
+constructor TCustomIniFile.Create(const AFileName: string; AEscapeLineFeeds : Boolean = False);
 begin
   FFileName := AFileName;
   FSectionList := TIniFileSectionList.Create;
-  FOptions:=AOptions;
-  FormatSettings := DefaultFormatSettings;
-  with FormatSettings do begin
-    DecimalSeparator := '.';
-    ThousandSeparator := ',';
-    ListSeparator := ';';
-    DateSeparator := '/';
-    TimeSeparator := ':';
-    ShortDateFormat := 'yyyy/mm/dd';
-    ShortTimeFormat := 'hh:nn';
-    LongTimeFormat := 'hh:nn:ss';
-  end;
-end;
-
-constructor TCustomIniFile.Create(const AFileName: string;
-  AEscapeLineFeeds: Boolean);
-begin
-  if AEscapeLineFeeds then
-    Create(AFileName,[ifoEscapeLineFeeds])
-  else
-    Create(AFileName,[])
+  FEscapeLineFeeds := AEscapeLineFeeds;
 end;
 
 destructor TCustomIniFile.Destroy;
@@ -636,71 +570,45 @@ end;
 function TCustomIniFile.ReadDate(const Section, Ident: string; Default: TDateTime): TDateTime;
 
 begin
-  if FormatSettingsActive then begin
-    if not TryStrToDate(ReadString(Section, Ident, ''), Result, FormatSettings) then
-      Result := Default;
-  end else
-    Result := StrToDateDef(ReadString(Section, Ident, ''),Default);
+  Result := StrToDateDef(ReadString(Section, Ident, ''),Default);
 end;
 
 function TCustomIniFile.ReadDateTime(const Section, Ident: string; Default: TDateTime): TDateTime;
 
 begin
-  if FormatSettingsActive then begin
-    if not TryStrToDateTime(ReadString(Section, Ident, ''), Result, FormatSettings) then
-      Result := Default;
-  end else
-    Result := StrToDateTimeDef(ReadString(Section, Ident, ''),Default);
+  Result := StrToDateTimeDef(ReadString(Section, Ident, ''),Default);
 end;
 
 function TCustomIniFile.ReadFloat(const Section, Ident: string; Default: Double): Double;
 
 begin
-  if FormatSettingsActive then
-    Result:=StrToFloatDef(ReadString(Section, Ident, ''),Default, FormatSettings)
-  else
-    Result:=StrToFloatDef(ReadString(Section, Ident, ''),Default);
+  Result:=StrToFloatDef(ReadString(Section, Ident, ''),Default);
 end;
 
 function TCustomIniFile.ReadTime(const Section, Ident: string; Default: TDateTime): TDateTime;
 
 begin
-  if FormatSettingsActive then
-    Result := StrToTimeDef(ReadString(Section, Ident, ''),Default, FormatSettings.TimeSeparator)
-  else
-    Result := StrToTimeDef(ReadString(Section, Ident, ''),Default);
+  Result := StrToTimeDef(ReadString(Section, Ident, ''),Default);
 end;
 
 procedure TCustomIniFile.WriteDate(const Section, Ident: string; Value: TDateTime);
 begin
-  if FormatSettingsActive then
-    WriteString(Section, Ident, DateToStr(Value, FormatSettings))
-  else
-    WriteString(Section, Ident, DateToStr(Value));
+  WriteString(Section, Ident, DateToStr(Value));
 end;
 
 procedure TCustomIniFile.WriteDateTime(const Section, Ident: string; Value: TDateTime);
 begin
-  if FormatSettingsActive then
-    WriteString(Section, Ident, DateTimeToStr(Value, FormatSettings))
-  else
-    WriteString(Section, Ident, DateTimeToStr(Value));
+  WriteString(Section, Ident, DateTimeToStr(Value));
 end;
 
 procedure TCustomIniFile.WriteFloat(const Section, Ident: string; Value: Double);
 begin
-  if FormatSettingsActive then
-    WriteString(Section, Ident, FloatToStr(Value, FormatSettings))
-  else
-    WriteString(Section, Ident, FloatToStr(Value));
+  WriteString(Section, Ident, FloatToStr(Value));
 end;
 
 procedure TCustomIniFile.WriteTime(const Section, Ident: string; Value: TDateTime);
 begin
-  if FormatSettingsActive then
-    WriteString(Section, Ident, TimeToStr(Value, FormatSettings))
-  else
-    WriteString(Section, Ident, TimeToStr(Value));
+  WriteString(Section, Ident, TimeToStr(Value));
 end;
 
 function TCustomIniFile.ValueExists(const Section, Ident: string): Boolean;
@@ -750,8 +658,7 @@ begin
     end;
 end;
 
-procedure TCustomIniFile.WriteBinaryStream(const Section, Name: string;
-  Value: TStream);
+procedure TCustomInifile.WriteBinaryStream(const Section, Name: string; Value: TStream);
 
 
 Var
@@ -786,54 +693,16 @@ begin
   end;
 end;
 
-procedure TCustomIniFile.ReadSectionValues(const Section: string; Strings: TStrings; Options: TSectionValuesOptions);
-
-type
-  TOldSectionValues = Procedure (const Section: string; Strings: TStrings) of object;
-
-var
-  CurrSV,
-  TCustomSV: TOldSectionValues;
-  CurrClass   : TClass;
-
-begin
-  if (Options<>[]) then
-    Raise Exception.Create('Options not supported, options must be empty');
-  // Redirect calls to old implementation, if it is overridden.
-  CurrSV:=nil;
-  CurrClass:=Classtype;
-  while (CurrClass<>nil) and (CurrClass<>TCustomIniFile) do
-   CurrClass:=CurrClass.Classparent;
-  if CurrClass<>nil then
-    begin
-    CurrSV:[email protected];
-    TCustomSV:=@TCustomIniFile(@CurrClass).ReadSectionValues;
-    if TMethod(TCustomSV).Code=TMethod(CurrSV).Code then
-      CurrSV:=nil;
-   end;
-  if Assigned(CurrSV) then
-    ReadSectionValues(Section,Strings)
-  else
-    Raise Exception.Create('ReadSectionValues not overridden');
-end;
-
-procedure TCustomIniFile.ReadSectionValues(const Section: string;
-  Strings: TStrings);
-begin
-  ReadSectionValues(Section,Strings,[]);
-end;
-
 { TIniFile }
 
-
-constructor TIniFile.Create(const AFileName: string; AOptions : TIniFileOptions = []);
+constructor TIniFile.Create(const AFileName: string; AEscapeLineFeeds : Boolean = False);
 var
   slLines: TStringList;
 begin
   FBOM := '';
   If Not (self is TMemIniFile) then
     StripQuotes:=True;
-  inherited Create(AFileName,AOptions);
+  inherited Create(AFileName,AEscapeLineFeeds);
   FStream := nil;
   slLines := TStringList.Create;
   try
@@ -848,23 +717,12 @@ begin
   end;
 end;
 
-constructor TIniFile.Create(AStream: TStream; AEscapeLineFeeds : Boolean);
-
-begin
-  if AEscapeLineFeeds then
-    Create(AStream,[ifoEscapeLineFeeds])
-  else
-    Create(AStream,[]);
-end;
-
-constructor TIniFile.Create(AStream: TStream; AOptions : TIniFileOptions = []);
-
+constructor TIniFile.Create(AStream: TStream; AEscapeLineFeeds : Boolean = False);
 var
   slLines: TStringList;
-
 begin
   FBOM := '';
-  inherited Create('',AOptions);
+  inherited Create('',AEscapeLineFeeds);
   FStream := AStream;
   slLines := TStringList.Create;
   try
@@ -920,13 +778,10 @@ var
     end;
   end;
 
-Var
-  addKey : Boolean;
-
 begin
   oSection := nil;
   FSectionList.Clear;
-  if EscapeLineFeeds then
+  if FEscapeLineFeeds then
     RemoveBackslashes;
   if (AStrings.Count > 0) and (copy(AStrings.Strings[0],1,Length(Utf8Bom)) = Utf8Bom) then
   begin
@@ -937,51 +792,37 @@ begin
     sLine := Trim(AStrings[i]);
     if sLine > '' then
       begin
-      if IsComment(sLine) and (oSection = nil) then
-        begin
+      if IsComment(sLine) and (oSection = nil) then begin
         // comment at the beginning of the ini file
-        if Not (ifoStripComments in Options) then
-          begin
-          oSection := TIniFileSection.Create(sLine);
-          FSectionList.Add(oSection);
-          end;
+        oSection := TIniFileSection.Create(sLine);
+        FSectionList.Add(oSection);
         continue;
-        end;
-      if (Copy(sLine, 1, 1) = Brackets[0]) and (Copy(sLine, length(sLine), 1) = Brackets[1]) then
-        begin
+      end;
+      if (Copy(sLine, 1, 1) = Brackets[0]) and (Copy(sLine, length(sLine), 1) = Brackets[1]) then begin
         // regular section
         oSection := TIniFileSection.Create(Copy(sLine, 2, Length(sLine) - 2));
         FSectionList.Add(oSection);
-        end
-      else if oSection <> nil then
-        begin
-        if IsComment(sLine) then
-          begin
-          AddKey:=Not (ifoStripComments in Options);
+      end else if oSection <> nil then begin
+        if IsComment(sLine) then begin
           // comment within a section
           sIdent := sLine;
           sValue := '';
-          end
-        else
-          begin
+        end else begin
           // regular key
           j:=Pos(Separator, sLine);
           if j=0 then
            begin
-           AddKey:=Not (ifoStripInvalid in Options);
-           sIdent:='';
-           sValue:=sLine
+             sIdent:='';
+             sValue:=sLine
            end
           else
            begin
-           AddKey:=True;
-           sIdent:=Trim(Copy(sLine, 1,  j - 1));
-           sValue:=Trim(Copy(sLine, j + 1, Length(sLine) - j));
+             sIdent:=Trim(Copy(sLine, 1,  j - 1));
+             sValue:=Trim(Copy(sLine, j + 1, Length(sLine) - j));
            end;
         end;
-        if AddKey then
-          oSection.KeyList.Add(TIniFileKey.Create(sIdent, sValue));
-        end;
+        oSection.KeyList.Add(TIniFileKey.Create(sIdent, sValue));
+      end;
       end;
   end;
 end;
@@ -1101,49 +942,31 @@ begin
   end;
 end;
 
-procedure TIniFile.ReadSectionValues(const Section: string; Strings: TStrings; AOptions : TSectionValuesOptions = []);
+procedure TIniFile.ReadSectionValues(const Section: string; Strings: TStrings);
 var
   oSection: TIniFileSection;
   s: string;
   i,J: integer;
-  KeyIsComment,IncludeComments,IncludeInvalid,DoStripQuotes : boolean;
-  K : TIniFileKey;
-
 begin
-  IncludeComments:=(svoIncludeComments in AOptions) Or (ifoStripComments in Options);
-  IncludeInvalid:=(svoIncludeInvalid in AOptions) Or (ifoStripInvalid in Options);
-  DoStripQuotes:=StripQuotes and Not (svoIncludeQuotes in AOptions);
   Strings.BeginUpdate;
   try
     Strings.Clear;
     oSection := FSectionList.SectionByName(Section,CaseSensitive);
-    if oSection = nil then
-      Exit;
-    for i := 0 to oSection.KeyList.Count-1 do
-      begin
-      K:=oSection.KeyList.Items[i];
-      if IncludeInvalid or (K.Ident<>'') then
+    if oSection <> nil then with oSection.KeyList do
+      for i := 0 to Count-1 do begin
+        s := Items[i].Value;
+      If StripQuotes then
         begin
-        s := K.Value;
-        KeyIsComment:=IsComment(K.Ident);
-        if IncludeComments Or Not KeyIsComment then
-          begin
-          If DoStripQuotes then
-            begin
-            J:=Length(s);
-            // Joost, 2-jan-2007: The check (J>1) is there for the case that
-            // the value consist of a single double-quote character. (see
-            // mantis bug 6555)
-            If (J>1) and ((s[1] in ['"','''']) and (s[J]=s[1])) then
-               s:=Copy(s,2,J-2);
-            end;
-          if KeyIsComment then
-            S:=K.Ident
-          else if k.ident<>'' then
-            s:=K.Ident+Separator+s;
-          Strings.Add(s);
-          end;
+          J:=Length(s);
+          // Joost, 2-jan-2007: The check (J>1) is there for the case that
+          // the value consist of a single double-quote character. (see
+          // mantis bug 6555)
+          If (J>1) and ((s[1] in ['"','''']) and (s[J]=s[1])) then
+             s:=Copy(s,2,J-2);
         end;
+        if Items[i].Ident<>'' then
+          s:=Items[i].Ident+Separator+s;
+        Strings.Add(s);
       end;
   finally
     Strings.EndUpdate;

packages/fcl-base/src/singleinstance.pp

@@ -19,7 +19,7 @@ unit singleinstance;
 interface
 
 uses
-  SysUtils, Classes;
+  SysUtils, Classes, advancedipc;
 
 type
 
@@ -29,58 +29,187 @@ type
   //siClient: There is another instance running. This instance is used as client.
   //siNotResponding: There is another instance running but it doesn't respond.
   TSingleInstanceStart = (siServer, siClient, siNotResponding);
-  TSingleInstanceParamsEvent = procedure(Sender: TBaseSingleInstance; Params: TStringList) of object;
+  TSingleInstanceParams = procedure(Sender: TBaseSingleInstance; Params: TStringList) of object;
+  TSingleInstanceReceivedCustomMessage = procedure(Sender: TBaseSingleInstance; MsgID: Integer; MsgType: TMessageType; MsgData: TStream) of object;
   TBaseSingleInstance = class(TComponent)
   private
+    FGlobal: Boolean;
+    FID: string;
+    FServer: TIPCServer;
+    FClient: TIPCClient;
     FStartResult: TSingleInstanceStart;
     FTimeOutMessages: Integer;
     FTimeOutWaitForInstances: Integer;
-    FOnServerReceivedParams: TSingleInstanceParamsEvent;
-  Protected  
-    function GetIsClient: Boolean; virtual; abstract;
-    function GetIsServer: Boolean; virtual; abstract;
-    function GetStartResult: TSingleInstanceStart; virtual;
+    FOnServerReceivedCustomRequest: TSingleInstanceReceivedCustomMessage;
+    FOnServerReceivedParams: TSingleInstanceParams;
+    function GetIsClient: Boolean;
+    function GetIsServer: Boolean;
+    function GetStartResult: TSingleInstanceStart;
+    procedure SetGlobal(const aGlobal: Boolean);
+    procedure SetID(const aID: string);
     procedure DoServerReceivedParams(const aParamsDelimitedText: string);
-    Procedure SetStartResult(AValue : TSingleInstanceStart); 
+    procedure DoServerReceivedCustomRequest(const aMsgID: Integer; const aMsgType: TMessageType; const aStream: TStream);
+  protected
+    //call Start when you want to start single instance checking
+    function Start: TSingleInstanceStart;
+    //stop single instance server or client
+    procedure Stop;
+
+    procedure ServerCheckMessages;
+    procedure ClientPostParams;
   public
     constructor Create(aOwner: TComponent); override;
     destructor Destroy; override;
   public
-    //call Start when you want to start single instance checking
-    function Start: TSingleInstanceStart; virtual; abstract;
-    //stop single instance server or client
-    procedure Stop; virtual; abstract;
-
-    //check and handle pending messages on server
-    procedure ServerCheckMessages; virtual; abstract;
-    //post cmd parameters from client to server
-    procedure ClientPostParams; virtual; abstract;
+    function ClientPostCustomRequest(const aMsgType: TMessageType; const aStream: TStream): Integer;
+    function ClientSendCustomRequest(const aMsgType: TMessageType; const aStream: TStream): Boolean; overload;
+    function ClientSendCustomRequest(const aMsgType: TMessageType; const aStream: TStream; out outRequestID: Integer): Boolean; overload;
+    procedure ServerPostCustomResponse(const aRequestID: Integer; const aMsgType: TMessageType; const aStream: TStream);
+    function ClientPeekCustomResponse(const aStream: TStream; out outMsgType: TMessageType): Boolean;
   public
+    property ID: string read FID write SetID;
+    property Global: Boolean read FGlobal write SetGlobal;
     property TimeOutMessages: Integer read FTimeOutMessages write FTimeOutMessages;
     property TimeOutWaitForInstances: Integer read FTimeOutWaitForInstances write FTimeOutWaitForInstances;
-    property OnServerReceivedParams: TSingleInstanceParamsEvent read FOnServerReceivedParams write FOnServerReceivedParams;
+    property OnServerReceivedParams: TSingleInstanceParams read FOnServerReceivedParams write FOnServerReceivedParams;
+    property OnServerReceivedCustomRequest: TSingleInstanceReceivedCustomMessage read FOnServerReceivedCustomRequest write FOnServerReceivedCustomRequest;
   public
     property StartResult: TSingleInstanceStart read GetStartResult;
     property IsServer: Boolean read GetIsServer;
     property IsClient: Boolean read GetIsClient;
   end;
-  TBaseSingleInstanceClass = class of TBaseSingleInstance;
 
-  ESingleInstance = class(Exception);
+  TSingleInstance = class(TBaseSingleInstance)
+  public
+    function Start: TSingleInstanceStart;
+    procedure Stop;
+
+    procedure ServerCheckMessages;
+    procedure ClientPostParams;
+  end;
 
-Var
-  DefaultSingleInstanceClass : TBaseSingleInstanceClass = Nil;
+  ESingleInstance = class(Exception);
 
 implementation
 
+Resourcestring
+  SErrSetSingleInstanceIDStarted = 'You cannot change the single instance ID when it''s been started.';
+  SErrSetSingleInstanceGlobalStarted = 'You cannot change the single instance global property when it''s been started.';
+  SErrStartSingleInstanceStarted = 'You cannot start single instance when it''s been already started.';
+  SErrSingleInstanceStartResultNotAvailable = 'Single instance hasn''t been started yet.';
+  SErrSingleInstanceNotClient = 'Current instance is not a client.';
+  SErrSingleInstanceNotServer = 'Current instance is not a server.';
+
+Const
+  MSGTYPE_CHECK = -1;
+  MSGTYPE_CHECKRESPONSE = -2;
+  MSGTYPE_PARAMS = -3;
+  MSGTYPE_WAITFORINSTANCES = -4;
+
+{ TSingleInstance }
+
+procedure TSingleInstance.ClientPostParams;
+begin
+  inherited ClientPostParams;
+end;
+
+procedure TSingleInstance.ServerCheckMessages;
+begin
+  inherited ServerCheckMessages;
+end;
+
+function TSingleInstance.Start: TSingleInstanceStart;
+begin
+  Result := inherited Start;
+end;
+
+procedure TSingleInstance.Stop;
+begin
+  inherited Stop;
+end;
+
 { TBaseSingleInstance }
 
+function TBaseSingleInstance.ClientPeekCustomResponse(const aStream: TStream; out
+  outMsgType: TMessageType): Boolean;
+begin
+  if not Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
+
+  Result := FClient.PeekResponse(aStream, outMsgType, FTimeOutMessages);
+end;
+
+function TBaseSingleInstance.ClientPostCustomRequest(const aMsgType: TMessageType;
+  const aStream: TStream): Integer;
+begin
+  if not Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
+
+  Result := FClient.PostRequest(aMsgType, aStream);
+end;
+
+procedure TBaseSingleInstance.ClientPostParams;
+var
+  xSL: TStringList;
+  xStringStream: TStringStream;
+  I: Integer;
+begin
+  if not Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
+
+  xSL := TStringList.Create;
+  try
+    for I := 0 to ParamCount do
+      xSL.Add(ParamStr(I));
+
+    xStringStream := TStringStream.Create(xSL.DelimitedText);
+    try
+      xStringStream.Position := 0;
+      FClient.PostRequest(MSGTYPE_PARAMS, xStringStream);
+    finally
+      xStringStream.Free;
+    end;
+  finally
+    xSL.Free;
+  end;
+end;
+
+function TBaseSingleInstance.ClientSendCustomRequest(
+  const aMsgType: TMessageType; const aStream: TStream): Boolean;
+begin
+  if not Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
+
+  Result := FClient.SendRequest(aMsgType, aStream, FTimeOutMessages);
+end;
+
+function TBaseSingleInstance.ClientSendCustomRequest(const aMsgType: TMessageType;
+  const aStream: TStream; out outRequestID: Integer): Boolean;
+begin
+  if not Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
+
+  Result := FClient.SendRequest(aMsgType, aStream, FTimeOutMessages, outRequestID);
+end;
+
 constructor TBaseSingleInstance.Create(aOwner: TComponent);
+var
+  xID: RawByteString;
+  I: Integer;
 begin
   inherited Create(aOwner);
 
   FTimeOutMessages := 1000;
   FTimeOutWaitForInstances := 100;
+
+  xID := 'SI_'+ExtractFileName(ParamStr(0));
+  for I := 1 to Length(xID) do
+    case xID[I] of
+      'a'..'z', 'A'..'Z', '0'..'9', '_': begin end;
+    else
+      xID[I] := '_';
+    end;
+  ID := xID;
 end;
 
 destructor TBaseSingleInstance.Destroy;
@@ -90,6 +219,13 @@ begin
   inherited Destroy;
 end;
 
+procedure TBaseSingleInstance.DoServerReceivedCustomRequest(
+  const aMsgID: Integer; const aMsgType: TMessageType; const aStream: TStream);
+begin
+  if Assigned(FOnServerReceivedCustomRequest) then
+    FOnServerReceivedCustomRequest(Self, aMsgID, aMsgType, aStream);
+end;
+
 procedure TBaseSingleInstance.DoServerReceivedParams(
   const aParamsDelimitedText: string);
 var
@@ -107,16 +243,177 @@ begin
   end;
 end;
 
+function TBaseSingleInstance.GetIsClient: Boolean;
+begin
+  Result := Assigned(FClient);
+end;
+
+function TBaseSingleInstance.GetIsServer: Boolean;
+begin
+  Result := Assigned(FServer);
+end;
+
 function TBaseSingleInstance.GetStartResult: TSingleInstanceStart;
 begin
+  if not(Assigned(FServer) or Assigned(FClient)) then
+    raise ESingleInstance.Create(SErrSingleInstanceStartResultNotAvailable);
+
   Result := FStartResult;
 end;
 
-Procedure TBaseSingleInstance.SetStartResult(AValue : TSingleInstanceStart);
+procedure TBaseSingleInstance.ServerCheckMessages;
+var
+  xMsgID: Integer;
+  xMsgType: TMessageType;
+  xStream: TStream;
+  xStringStream: TStringStream;
+begin
+  if not Assigned(FServer) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotServer);
+
+  if not FServer.PeekRequest(xMsgID, xMsgType) then
+    Exit;
+
+  case xMsgType of
+    MSGTYPE_CHECK:
+    begin
+      FServer.DeleteRequest(xMsgID);
+      FServer.PostResponse(xMsgID, MSGTYPE_CHECKRESPONSE, nil);
+    end;
+    MSGTYPE_PARAMS:
+    begin
+      xStringStream := TStringStream.Create('');
+      try
+        FServer.ReadRequest(xMsgID, xStringStream);
+        DoServerReceivedParams(xStringStream.DataString);
+      finally
+        xStringStream.Free;
+      end;
+    end;
+    MSGTYPE_WAITFORINSTANCES:
+      FServer.DeleteRequest(xMsgID);
+  else
+    xStream := TMemoryStream.Create;
+    try
+      FServer.ReadRequest(xMsgID, xStream);
+      DoServerReceivedCustomRequest(xMsgID, xMsgType, xStream);
+    finally
+      xStream.Free;
+    end;
+  end;
+end;
+
+procedure TBaseSingleInstance.ServerPostCustomResponse(
+  const aRequestID: Integer; const aMsgType: TMessageType;
+  const aStream: TStream);
+begin
+  if not Assigned(FServer) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotServer);
+
+  FServer.PostResponse(aRequestID, aMsgType, aStream);
+end;
+
+procedure TBaseSingleInstance.SetGlobal(const aGlobal: Boolean);
+begin
+  if FGlobal = aGlobal then Exit;
+  if Assigned(FServer) or Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSetSingleInstanceGlobalStarted);
+  FGlobal := aGlobal;
+end;
 
+procedure TBaseSingleInstance.SetID(const aID: string);
 begin
-  FStartResult:=AValue;
-end;   
+  if FID = aID then Exit;
+  if Assigned(FServer) or Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSetSingleInstanceIDStarted);
+  FID := aID;
+end;
+
+procedure TBaseSingleInstance.Stop;
+begin
+  FreeAndNil(FServer);
+  FreeAndNil(FClient);
+end;
+
+function TBaseSingleInstance.Start: TSingleInstanceStart;
+  {$IFNDEF MSWINDOWS}
+  procedure UnixWorkaround(var bServerStarted: Boolean);
+  var
+    xWaitRequestID, xLastCount, xNewCount: Integer;
+    xClient: TIPCClient;
+  begin
+    //file locking workaround for UNIX systems -> the server can be started twice if 2 processes are started in parallel
+    //wait some time to see other clients
+    FServer.StopServer(False);
+    xClient := TIPCClient.Create(Self);
+    try
+      xClient.ServerID := FID;
+      xClient.Global := FGlobal;
+      xWaitRequestID := xClient.PostRequest(MSGTYPE_WAITFORINSTANCES, nil);
+      xLastCount := -1;
+      xNewCount := FServer.GetPendingRequestCount;
+      while xLastCount <> xNewCount do
+      begin
+        xLastCount := xNewCount;
+        Sleep(FTimeOutWaitForInstances);
+        xNewCount := FServer.GetPendingRequestCount;
+      end;
+    finally
+      FreeAndNil(xClient);
+    end;
+
+    //find highest client that will be the server
+    if FServer.FindHighestPendingRequestId = xWaitRequestID then
+    begin
+      bServerStarted := FServer.StartServer(False);
+    end else
+    begin
+      //something went wrong, there are not-deleted waiting requests
+      //use random sleep as workaround and try to restart the server
+      Randomize;
+      Sleep(Random(($3F+PtrInt(GetCurrentThreadId)) and $3F));//limit to $3F (63)
+      bServerStarted := FServer.StartServer(False) and (FServer.GetPendingRequestCount > 0);
+    end;
+  end;
+  {$ENDIF}
+var
+  xStream: TStream;
+  xMsgType: TMessageType;
+  xServerStarted: Boolean;
+begin
+  if Assigned(FServer) or Assigned(FClient) then
+    raise ESingleInstance.Create(SErrStartSingleInstanceStarted);
+
+  FServer := TIPCServer.Create(Self);
+  FServer.ServerID := FID;
+  FServer.Global := FGlobal;
+  xServerStarted := FServer.StartServer(False);
+  if xServerStarted then
+  begin//this is single instance -> be server
+    Result := siServer;
+    {$IFNDEF MSWINDOWS}
+    UnixWorkaround(xServerStarted);
+    {$ENDIF}
+  end;
+  if not xServerStarted then
+  begin//instance found -> be client
+    FreeAndNil(FServer);
+    FClient := TIPCClient.Create(Self);
+    FClient.ServerID := FID;
+    FClient.Global := FGlobal;
+    FClient.PostRequest(MSGTYPE_CHECK, nil);
+    xStream := TMemoryStream.Create;
+    try
+      if FClient.PeekResponse(xStream, xMsgType, FTimeOutMessages) then
+        Result := siClient
+      else
+        Result := siNotResponding;
+    finally
+      xStream.Free;
+    end;
+  end;
+  FStartResult := Result;
+end;
 
 end.
 

packages/fcl-base/src/streamex.pp

@@ -156,30 +156,7 @@ type
      function ReadLine: string; override; overload;
    end;
 
-  { allows you to represent just a small window of a bigger stream as a substream. 
-    also makes sure one is actually at the correct position before clobbering stuff. }
-
-  TWindowedStream = class(TOwnerStream)
-  private
-    fStart : Int64; // in the source.
-    fFrontier : Int64; // in the source.
-    fStartingPositionHere : Int64; // position in this Stream corresponding to Position = fStart in the source.
-    fPositionHere : Int64; // position in this Stream.
-  protected
-     //function  GetPosition() : Int64; override; = Seek(0, soCurrent) already.
-     function  GetSize() : Int64; override;
-     procedure SetSize(const NewSize: Int64); override; overload;
-  public
-    constructor Create(aStream : TStream; const aSize : Int64; const aPositionHere : Int64 = 0);
-    destructor Destroy(); override;
-    function Read(var aBuffer; aCount : longint) : longint; override;
-    function Write(const aBuffer; aCount : Longint): Longint; override;
-    function Seek(const aOffset: Int64; aOrigin: TSeekorigin): Int64; override;
-  end;
-
-
   TStreamHelper = class helper for TStream
-
                      function  ReadWordLE :word;
                      function  ReadDWordLE:dword;
                      function  ReadQWordLE:qword;
@@ -192,11 +169,6 @@ type
                      procedure WriteWordBE (w:word);
   		     procedure WriteDWordBE(dw:dword);
 	             procedure WriteQWordBE(dq:qword);
-                     function  ReadSingle:Single;
-                     function  ReadDouble:Double;
-                     procedure WriteSingle(s:Single);
-                     procedure WriteDouble(d:double);
-
                      {$ifndef FPC}
                       function ReadByte  : Byte;
                       function ReadWord  : Word;
@@ -211,13 +183,6 @@ type
 
 Implementation
 
-ResourceString
-  SErrCannotWriteOutsideWindow = 'Cannot write outside allocated window.';
-  SErrInvalidSeekWindow = 'Cannot seek outside allocated window.';
-  SErrInvalidSeekOrigin = 'Invalid seek origin.';
-  SErrCannotChangeWindowSize  = 'Cannot change the size of a windowed stream';
-
-
 { TBidirBinaryObjectReader }
 
 function TBidirBinaryObjectReader.GetPosition: Longint;
@@ -609,24 +574,6 @@ begin
   WriteQWord(NtoLE(dq));
 end;
 
-function  TStreamHelper.ReadSingle:Single;
-begin
-  self.Read(result,sizeof(result));
-end;
-function  TStreamHelper.ReadDouble:Double;
-begin
-  self.Read(result,sizeof(result));
-end;
-procedure TStreamHelper.WriteSingle(s:Single);
-begin
-  self.Write(s,sizeof(s));
-end;
-procedure TStreamHelper.WriteDouble(d:double);
-begin
-  self.Write(d,sizeof(d));
-end;
-
-
 {$ifndef FPC}
 // there can only be one helper per class, and I use these in Delphi for FPC compatibility.
 function TStreamHelper.ReadByte: Byte;
@@ -660,103 +607,4 @@ begin
 end;
 {$endif}
 
-{ TWindowedStream }
-
-constructor TWindowedStream.Create(aStream : TStream; const aSize : Int64; const aPositionHere : Int64 = 0);
-begin
-  inherited Create(aStream);
-  fStart := aStream.Position;
-  fFrontier := fStart + aSize;
-  fStartingPositionHere := aPositionHere;
-  fPositionHere := aPositionHere;
-end;
-
-destructor TWindowedStream.Destroy();
-begin
-  inherited Destroy();
-end;
-
-function TWindowedStream.Read(var aBuffer; aCount : longint) : longint;
-var
-  vSourcePosition : Int64;
-  vNewSourcePosition : Int64;
-begin
-  vSourcePosition := Source.Position;
-  vNewSourcePosition := fStart + fPositionHere - fStartingPositionHere;
-  if vNewSourcePosition <> vSourcePosition then // someone modified the file position. Bad bad.
-    Source.Seek(vNewSourcePosition, 0);
-
-  if vNewSourcePosition + aCount > fFrontier then // trying to access outside.
-    aCount := fFrontier - vNewSourcePosition;
-    
-  Result := Source.Read(aBuffer, aCount);
-  Inc(fPositionHere, Result);
-end;
-
-
-function TWindowedStream.Write(const aBuffer; aCount : Longint): Longint;
-var
-  vSourcePosition : Int64;
-  vNewSourcePosition : Int64;
-begin
-  vSourcePosition := Source.Position;
-  vNewSourcePosition := fStart + fPositionHere - fStartingPositionHere;
-  if vNewSourcePosition <> vSourcePosition then // someone modified the file position. Bad bad.
-    Source.Seek(vNewSourcePosition, 0);
-
-  if vNewSourcePosition + aCount > fFrontier then // trying to access outside.
-    Raise EWriteError.Create(SErrCannotWriteOutsideWindow);
-    //aCount := fFrontier - vNewSourcePosition;
-    
-  Result := Source.Write(aBuffer, aCount);
-  Inc(fPositionHere, Result);
-end;
-
-function TWindowedStream.Seek(const aOffset: Int64; aOrigin: TSeekOrigin): Int64;
-var
-  vNewPositionHere : Int64;
-  vSourcePosition : Int64;
-begin
-  {
-  here                       there
-  fStartingPositionHere .... fStart
-  fPositionHere............. x
-  }
-  
-  if (aOrigin = soCurrent) and (aOffset = 0) then begin // get position.
-    Result := fPositionHere;
-    Exit;
-  end;
-  
-  if aOrigin = soBeginning then
-    vNewPositionHere := aOffset
-  else if aOrigin = soCurrent then
-    vNewPositionHere := fPositionHere + aOffset
-  else if aOrigin = soEnd then
-    vNewPositionHere := fStartingPositionHere + fFrontier - fStart + aOffset
-  else
-    raise EReadError.Create(SErrInvalidSeekOrigin);
-
-  vSourcePosition := fStart + vNewPositionHere - fStartingPositionHere;
-  if (vSourcePosition < 0) or (vSourcePosition >= fFrontier) then
-    raise EReadError.Create(SErrInvalidSeekWindow);
-    
-  Result := Source.Seek(vSourcePosition, 0);
-  //if Result = -1 ??? can that happen?
-  Result := vNewPositionHere;
-end;
-
-function TWindowedStream.GetSize() : Int64;
-begin
-  Result := fFrontier - fStart;
-end;
-
-procedure TWindowedStream.SetSize(const NewSize: Int64); overload;
-begin
-  if NewSize = Self.GetSize() then
-    Exit;
-  raise EWriteError.Create(SErrCannotChangeWindowSize);
-end;
-
-
 end.

packages/fcl-base/tests/fclbase-unittests.pp

@@ -3,8 +3,7 @@ program fclbase_unittests;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, consoletestrunner, tests_fptemplate, tchashlist,
-  testexprpars;
+  Classes, consoletestrunner, tests_fptemplate, tchashlist;
 
 var
   Application: TTestRunner;

packages/fcl-extra/Makefile

@@ -1,11 +1,11 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-07-28 rev 31240]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-09-05 rev 31523]
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos aarch64-linux aarch64-darwin
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos i8086-win16 aarch64-linux aarch64-darwin
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
-LIMIT83fs = go32v2 os2 emx watcom msdos
+LIMIT83fs = go32v2 os2 emx watcom msdos win16
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
@@ -741,6 +741,12 @@ ifeq ($(OS_TARGET),embedded)
 EXEEXT=.bin
 SHORTSUFFIX=emb
 endif
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -1628,6 +1634,14 @@ REQUIRE_PACKAGES_HASH=1
 REQUIRE_PACKAGES_LIBTAR=1
 REQUIRE_PACKAGES_FPMKUNIT=1
 endif
+ifeq ($(FULL_TARGET),i8086-win16)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
 ifeq ($(FULL_TARGET),aarch64-linux)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_PASZLIB=1

packages/fcl-extra/examples/Makefile

@@ -1,11 +1,11 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-07-28 rev 31240]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-09-05 rev 31523]
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos aarch64-linux aarch64-darwin
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos i8086-win16 aarch64-linux aarch64-darwin
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
-LIMIT83fs = go32v2 os2 emx watcom msdos
+LIMIT83fs = go32v2 os2 emx watcom msdos win16
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
@@ -836,6 +836,12 @@ ifeq ($(OS_TARGET),embedded)
 EXEEXT=.bin
 SHORTSUFFIX=emb
 endif
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -1881,6 +1887,16 @@ REQUIRE_PACKAGES_FPMKUNIT=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-EXTRA=1
 endif
+ifeq ($(FULL_TARGET),i8086-win16)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-BASE=1
+REQUIRE_PACKAGES_FCL-EXTRA=1
+endif
 ifeq ($(FULL_TARGET),aarch64-linux)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_PASZLIB=1

packages/fcl-image/src/fphandler.inc

@@ -252,32 +252,6 @@ begin
   end;
 end;
 
-function TFPCustomImageReader.InternalSize(Str: TStream): TPoint;
-
-begin
-  Result.X:=-1;
-  Result.Y:=-1;
-end;
-
-function TFPCustomImageReader.ImageSize(Str: TStream): TPoint;
-var InRead : boolean;
-    P : Int64;
-begin
-  InRead := assigned(FStream);
-  if not assigned(Str) then
-    raise FPImageException.Create(ErrorText[StrNoStream]);
-  try
-    FStream := Str;
-    P:=Str.Position;
-    result := InternalSize (Str);
-    Str.Position:=P;
-  finally
-    if not InRead then
-      FStream := nil;
-  end;
-end;
-
-
 { TFPCustomImageWriter }
 
 procedure TFPCustomImageWriter.ImageWrite (Str:TStream; Img:TFPCustomImage);

packages/fcl-image/src/fpimage.inc

@@ -71,30 +71,47 @@ begin
   end
 end;
 
-function TFPCustomImage.SaveToFile (const filename:String):boolean;
+procedure TFPCustomImage.SaveToFile (const filename:String);
 
-var h : TFPCustomImageWriterClass;
+var e,s : string;
+    r : integer;
+    f : TFileStream;
+    h : TFPCustomImageWriterClass;
     Writer : TFPCustomImageWriter;
+    d : TIHData;
     Msg : string;
 
 begin
-  Msg := '';
-  try
-    h := FindWriterFromFileName(filename);
-    Result := assigned (h);
-    if Result then
+  e := lowercase (ExtractFileExt(filename));
+  if (e <> '') and (e[1] = '.') then
+    delete (e,1,1);
+  with ImageHandlers do
+    begin
+    r := count-1;
+    s := e + ';';
+    while (r >= 0) do
       begin
-      Writer := h.Create;
-      try
-        SaveTofile (filename, Writer);
-      finally
-        Writer.Free;
-      end;
-      end;
-  except
-    on e : exception do
-      Msg := e.message;
-  end;
+      d := GetData(r);
+      if (pos(s,d.Fextension+';') <> 0) then
+        try
+          h := d.FWriter;
+          if assigned (h) then
+            begin
+            Writer := h.Create;
+            try
+              SaveTofile (filename, Writer);
+            finally
+              Writer.Free;
+            end;
+            break;
+            end;
+        except
+          on e : exception do
+            Msg := e.message;
+        end;
+      dec (r);
+      end
+    end;
   if (Msg<>'') then
     FPImgError (StrWriteWithError, [Msg]);
 end;
@@ -106,9 +123,7 @@ var r : integer;
     reader : TFPCustomImageReader;
     msg : string;
     d : TIHData;
-    startPos: Int64;
 begin
-  startPos := str.Position;
   with ImageHandlers do
     try
       r := count-1;
@@ -124,7 +139,6 @@ begin
             try
               if CheckContents (str) then
                 try
-                  str.Position := startPos;
                   FStream := str;
                   FImage := self;
                   InternalRead (str, self);
@@ -135,7 +149,7 @@ begin
                 end;
             finally
               Free;
-              str.Position := startPos;
+              str.seek (soFromBeginning, 0);
             end;
           end;
         dec (r);
@@ -151,32 +165,48 @@ begin
       FPImgError (StrReadWithError, [Msg]);
 end;
 
-function TFPCustomImage.LoadFromFile (const filename:String):boolean;
-var f : TFileStream;
+procedure TFPCustomImage.LoadFromFile (const filename:String);
+var e,s : string;
+    r : integer;
+    f : TFileStream;
     h : TFPCustomImageReaderClass;
     reader : TFPCustomImageReader;
+    d : TIHData;
     Msg : string;
 begin
-  Msg := '';
-  try
-    h := FindReaderFromFileName(filename);
-    Result := assigned (h);
-    if Result then
-      begin
-      reader := h.Create;
-      try
-        loadfromfile (filename, reader);
-      finally
-        Reader.Free;
-      end;
-      end;
-  except
-    on e : exception do
-      Msg := e.message;
-  end;
+  e := lowercase (ExtractFileExt(filename));
+  if (e <> '') and (e[1] = '.') then
+    delete (e,1,1);
+  with ImageHandlers do
+    begin
+      r := count-1;
+      s := e + ';';
+      while (r >= 0) do
+        begin
+        d := GetData(r);
+        if (pos(s,d.Fextension+';') <> 0) then
+          try
+            h := d.FReader;
+            if assigned (h) then
+              begin
+              reader := h.Create;
+              try
+                loadfromfile (filename, reader);
+              finally
+                Reader.Free;
+              end;
+              break;
+              end;
+          except
+            on e : exception do
+              Msg := e.message;
+          end;
+        dec (r);
+        end
+    end;
   if Msg = '' then
     begin
-    if h = nil then
+    if r < 0 then
       begin
       f := TFileStream.Create (filename, fmOpenRead);
       try
@@ -265,63 +295,6 @@ begin
   result := FExtra.count;
 end;
 
-class function TFPCustomImage.FindHandlerFromExtension(extension: String
-  ): TIHData;
-var s : string;
-    r : integer;
-begin
-  extension := lowercase (extension);
-  if (extension <> '') and (extension[1] = '.') then
-    delete (extension,1,1);
-  with ImageHandlers do
-    begin
-      r := count-1;
-      s := extension + ';';
-      while (r >= 0) do
-        begin
-        Result := GetData(r);
-        if (pos(s,Result.Fextension+';') <> 0) then
-          Exit;
-        dec (r);
-        end;
-    end;
-  Result := nil;
-end;
-
-class function TFPCustomImage.FindReaderFromExtension(const extension: String
-  ): TFPCustomImageReaderClass;
-var d : TIHData;
-begin
-  d := FindHandlerFromExtension(extension);
-  if d<>nil then
-    Result := d.FReader
-  else
-    Result := nil;
-end;
-
-class function TFPCustomImage.FindReaderFromFileName(const filename: String
-  ): TFPCustomImageReaderClass;
-begin
-  Result := FindReaderFromExtension(ExtractFileExt(filename));
-end;
-
-class function TFPCustomImage.FindWriterFromExtension(const extension: String
-  ): TFPCustomImageWriterClass;
-var d : TIHData;
-begin
-  d := FindHandlerFromExtension(extension);
-  if d<>nil then
-    Result := d.FWriter
-  else
-    Result := nil;
-end;
-
-class function TFPCustomImage.FindWriterFromFileName(const filename: String
-  ): TFPCustomImageWriterClass;
-begin
-  Result := FindWriterFromExtension(ExtractFileExt(filename));
-end;
-
 procedure TFPCustomImage.RemoveExtra (const key:string);
 var p : integer;
 begin

packages/fcl-image/src/fpimage.pp

@@ -22,10 +22,7 @@ uses sysutils, classes;
 type
 
   TFPCustomImageReader = class;
-  TFPCustomImageReaderClass = class of TFPCustomImageReader;
   TFPCustomImageWriter = class;
-  TFPCustomImageWriterClass = class of TFPCustomImageWriter;
-  TIHData = class;
   TFPCustomImage = class;
 
   FPImageException = class (exception);
@@ -128,20 +125,14 @@ type
       constructor create (AWidth,AHeight:integer); virtual;
       destructor destroy; override;
       procedure Assign(Source: TPersistent); override;
-      // Image handlers
-      class function FindHandlerFromExtension(extension:String): TIHData;
-      class function FindReaderFromFileName(const filename:String): TFPCustomImageReaderClass;
-      class function FindReaderFromExtension(const extension:String): TFPCustomImageReaderClass;
-      class function FindWriterFromFileName(const filename:String): TFPCustomImageWriterClass;
-      class function FindWriterFromExtension(const extension:String): TFPCustomImageWriterClass;
       // Saving and loading
       procedure LoadFromStream (Str:TStream; Handler:TFPCustomImageReader);
       procedure LoadFromStream (Str:TStream);
       procedure LoadFromFile (const filename:String; Handler:TFPCustomImageReader);
-      function LoadFromFile (const filename:String): Boolean;
+      procedure LoadFromFile (const filename:String);
       procedure SaveToStream (Str:TStream; Handler:TFPCustomImageWriter);
       procedure SaveToFile (const filename:String; Handler:TFPCustomImageWriter);
-      function SaveToFile (const filename:String): Boolean;
+      procedure SaveToFile (const filename:String);
       // Size and data
       procedure SetSize (AWidth, AHeight : integer); virtual;
       property  Height : integer read FHeight write SetHeight;
@@ -173,7 +164,7 @@ type
   PFPIntegerArray = ^TFPIntegerArray;
 
   TFPMemoryImage = class (TFPCustomImage)
-    protected
+    private
       function GetInternalColor(x,y:integer):TFPColor;override;
       procedure SetInternalColor (x,y:integer; const Value:TFPColor);override;
       procedure SetUsePalette (Value:boolean);override;
@@ -208,18 +199,16 @@ type
     protected
       procedure InternalRead  (Str:TStream; Img:TFPCustomImage); virtual; abstract;
       function  InternalCheck (Str:TStream) : boolean; virtual; abstract;
-      function  InternalSize  (Str:TStream): TPoint; virtual; 
     public
       constructor Create; override;
       function ImageRead (Str:TStream; Img:TFPCustomImage) : TFPCustomImage;
       // reads image
       function CheckContents (Str:TStream) : boolean;
-      // Returns true if the content is readable
-      function ImageSize(Str:TStream): TPoint;
-      // returns the size of image in stream without loading it completely. -1,-1 means this is not implemented.
+      // Gives True if contents is readable
       property DefaultImageClass : TFPCustomImageClass read FDefImageClass write FDefImageClass;
       // Image Class to create when no img is given for reading
   end;
+  TFPCustomImageReaderClass = class of TFPCustomImageReader;
 
   TFPCustomImageWriter = class (TFPCustomImageHandler)
     protected
@@ -228,6 +217,7 @@ type
       procedure ImageWrite (Str:TStream; Img:TFPCustomImage);
       // writes given image to stream
   end;
+  TFPCustomImageWriterClass = class of TFPCustomImageWriter;
 
   TIHData = class
     private

packages/fcl-image/src/fpreadbmp.pp

@@ -62,8 +62,6 @@ type
     public
       constructor Create; override;
       destructor Destroy; override;
-      property XPelsPerMeter : integer read BFI.XPelsPerMeter;
-      property YPelsPerMeter : integer read BFI.YPelsPerMeter;
   end;
 
 implementation

packages/fcl-image/src/fpreadjpeg.pas

@@ -64,7 +64,6 @@ type
   protected
     procedure InternalRead(Str: TStream; Img: TFPCustomImage); override;
     function  InternalCheck(Str: TStream): boolean; override;
-    function  InternalSize(Str:TStream): TPoint; override;
   public
     constructor Create; override;
     destructor Destroy; override;
@@ -451,47 +450,12 @@ begin
   end;
 end;
 
-function TFPReaderJPEG.InternalSize(Str: TStream): TPoint;
-var
-  JInfo: jpeg_decompress_struct;
-  JError: jpeg_error_mgr;
-
-  procedure SetSource;
-  begin
-    jpeg_stdio_src(@JInfo, @Str);
-  end;
-
-  procedure ReadHeader;
-  begin
-    jpeg_read_header(@JInfo, TRUE);
-    Result.X := JInfo.image_width;
-    Result.Y := JInfo.image_height;
-  end;
-
-begin
-  FillChar(JInfo,SizeOf(JInfo),0);
-  if Str.Position < Str.Size then begin
-    JError:=jpeg_std_error;
-    JInfo.err := @JError;
-    jpeg_CreateDecompress(@JInfo, JPEG_LIB_VERSION, SizeOf(JInfo));
-    try
-      SetSource;
-      ReadHeader;
-    finally
-      jpeg_Destroy_Decompress(@JInfo);
-    end;
-  end;
-end;
-
 function TFPReaderJPEG.InternalCheck(Str: TStream): boolean;
-var
-  Buf: array[0..1] of Byte = (0, 0);
-  p: Int64;
 begin
-  if Str=nil then exit(false);
-  p:=Str.Position;
-  Result := (Str.Read(Buf, 2)=2) and (Buf[0]=$FF) and (Buf[1]=$D8); // byte sequence FFD8 = start of image
-  Str.Position:=p;
+  // ToDo: read header and check
+  Result:=false;
+  if Str=nil then exit;
+  Result:=true;
 end;
 
 constructor TFPReaderJPEG.Create;

packages/fcl-image/src/fpreadpng.pp

@@ -846,7 +846,7 @@ begin
     for r := 0 to 7 do
     begin
       If SigCheck[r] <> Signature[r] then
-        Exit(false);
+        raise PNGImageException.Create('This is not PNG-data');
     end;
     // Check IHDR
     ReadChunk;

packages/fcl-image/src/fpwritebmp.pp

@@ -17,7 +17,6 @@
    - Removed FBytesPerPixel, BytesPerPixel property is now deprecated, use BitsPerPixel instead.
    - Rewritten a large part of the file, so we can handle all bmp color depths
    - Support for RLE4 and RLE8 encoding
-  03/2015 MvdV finally removed bytesperpixel. 10 years should be enough.
 }
 
 {$mode objfpc}{$h+}
@@ -37,8 +36,6 @@ type
     BFH : TBitMapFileHeader;
     BFI : TBitMapInfoHeader;
     Colinfo : array of TColorRGBA;
-    fXPelsPerMeter,
-    fYPelsPerMeter : integer;
     procedure SetColorSize (AValue : Byte);
     function GetColorSize : byte;
     procedure SetBpp (const abpp : byte);
@@ -56,9 +53,8 @@ type
   public
     constructor Create; override;
     property BitsPerPixel : byte read FBpp write SetBpp;
-    property XPelsPerMeter : integer read fXPelsPerMeter write fXPelsPerMeter;
-    property YPelsPerMeter : integer read fYPelsPerMeter write fYPelsPerMeter;
     property RLECompress : boolean read FRleCompress write FRleCompress;
+    Property BytesPerPixel : Byte Read GetColorSize Write SetColorSize; deprecated;
   end;
 
 
@@ -90,8 +86,6 @@ end;
 constructor TFPWriterBMP.create;
 begin
   inherited create;
-  fXPelsPerMeter:=100;
-  fYPelsPerMeter:=100;
   FBpp:=24;
   FRleCompress:=false;
 end;
@@ -253,8 +247,8 @@ begin
     Planes:=1;
     if FBpp=15 then BitCount:=16
     else BitCount:=FBpp;
-    XPelsPerMeter:=fXPelsPerMeter;
-    YPelsPerMeter:=fYPelsPerMeter;
+    XPelsPerMeter:=100;
+    YPelsPerMeter:=100;
     ClrImportant:=0;
     end;
   with BFH do

packages/fcl-image/src/fpwritepng.pp

@@ -2,7 +2,7 @@
     This file is part of the Free Pascal run time library.
     Copyright (c) 2003 by the Free Pascal development team
 
-    PNG writer class.
+    XPM writer class.
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.

packages/fcl-image/src/freetype.pp

@@ -579,8 +579,6 @@ var g : PMgrGlyph;
     buf : PByteArray;
     reverse : boolean;
     trans : FT_Matrix;
-    FBM : PFontBitmap;
-
 begin
   CurFont := GetFont(FontID);
   if  (Angle = 0) or   // no angle asked, or can't work with angles (not scalable)
@@ -625,8 +623,7 @@ begin
       FTCheck(FT_Glyph_To_Bitmap (gl, CurRenderMode, nil, true),sErrMakingString4);
       // Copy what is needed to record
       bm := PFT_BitmapGlyph(gl);
-      FBM:=result.Bitmaps[r];
-      with FBM^ do
+      with result.Bitmaps[r]^ do
         begin
         with gl^.advance do
           begin
@@ -652,13 +649,8 @@ begin
             begin
             pitch := bitmap.pitch;
             rx := pitch*height;
-            if RX=0 then
-              Data:=Nil
-            else
-              begin
-              getmem (data, rx);
-              move (buf^[0], data^[0], rx);
-              end;
+            getmem (data, rx);
+            move (buf^[0], data^[0], rx);
             end;
           end;
         end;
@@ -841,7 +833,6 @@ begin
   for r := 0 to ACount-1 do
     begin
     new (bm);
-    FillChar(BM^,SizeOf(TFontBitmap),#0);
     FList.Add (bm);
     end;
 end;
@@ -860,43 +851,34 @@ begin
   inherited;
 end;
 
-(*
-Procedure DumpBitmap(BM : PFontBitmap);
-
-begin
-  Writeln('Bitmap h: ',BM^.height,', w: ',BM^.width,', x:',BM^.x,', y: ',bm^.y);
-end;
-*)
-
 procedure TStringBitmaps.CalculateGlobals;
-var
-  l,r : integer;
-
+var r : integer;
 begin
   if count = 0 then
     Exit;
-  l:=0;
-  // Find first non-empty bitmap. Bitmaps can be empty for spaces.
-  While (l<Count) and (BitMaps[l]^.Width=0) and (BitMaps[l]^.Height=0) do
-    Inc(l);
-  if L<Count then
-    with BitMaps[0]^ do
-      begin
-      FBounds.left := x;
-      FBounds.top := y + height;
-      FBounds.bottom := y;
-      FBounds.right := x + width;
-      end;
-  // Find last non-empty bitmap
-  r:=Count-1;
-  While (R>l) and (BitMaps[r]^.Width=0) and (BitMaps[r]^.Height=0) do
-    Dec(r);
-  if R>L then
-    With Bitmaps[R]^ do
-      FBounds.right := x + width;
+  // check first 2 bitmaps for left side
+  // check last 2 bitmaps for right side
+  with BitMaps[0]^ do
+    begin
+    FBounds.left := x;
+    FBounds.top := y + height;
+    FBounds.bottom := y;
+    end;
+  with Bitmaps[count-1]^ do
+    FBounds.right := x + width;
+  if count > 1 then
+    begin
+    with Bitmaps[1]^ do
+      r := x;
+    if r < FBounds.left then
+      FBounds.left := r;
+    with Bitmaps[count-2]^ do
+      r := x + width;
+    if r > FBounds.right then
+      FBounds.right := r;
+    end;
   // check top/bottom of other bitmaps
   for r := 1 to count-1 do
-    begin
     with Bitmaps[r]^ do
       begin
       if FBounds.top < y + height then
@@ -904,7 +886,6 @@ begin
       if FBounds.bottom > y then
         FBounds.bottom := y;
       end;
-    end;
 end;
 
 procedure TStringBitmaps.GetBoundRect (out aRect : TRect);

packages/fcl-json/src/fpjson.pp

@@ -30,8 +30,7 @@ type
   TJSONInstanceType = (jitUnknown, jitNumberInteger,jitNumberInt64,jitNumberQWord,jitNumberFloat,
                        jitString, jitBoolean, jitNull, jitArray, jitObject);
   TJSONFloat = Double;
-  TJSONStringType = UTF8String;
-  TJSONUnicodeStringType = Unicodestring;
+  TJSONStringType = AnsiString;
   TJSONCharType = AnsiChar;
   PJSONCharType = ^TJSONCharType;
   TFormatOption = (foSingleLineArray,   // Array without CR/LF : all on one line
@@ -100,8 +99,6 @@ Type
     function GetAsJSON: TJSONStringType; virtual; abstract;
     function GetAsString: TJSONStringType; virtual; abstract;
     procedure SetAsString(const AValue: TJSONStringType); virtual; abstract;
-    function GetAsUnicodeString: TJSONUnicodeStringType; virtual; 
-    procedure SetAsUnicodeString(const AValue: TJSONUnicodeStringType); virtual;
     function GetValue: variant; virtual; abstract;
     procedure SetValue(const AValue: variant); virtual; abstract;
     function GetItem(Index : Integer): TJSONData; virtual;
@@ -125,7 +122,6 @@ Type
     property Items[Index: Integer]: TJSONData read GetItem write SetItem;
     property Value: variant read GetValue write SetValue;
     Property AsString : TJSONStringType Read GetAsString Write SetAsString;
-    Property AsUnicodeString : TJSONUnicodeStringType Read GetAsUnicodeString Write SetAsUnicodeString;
     Property AsFloat : TJSONFloat Read GetAsFloat Write SetAsFloat;
     Property AsInteger : Integer Read GetAsInteger Write SetAsInteger;
     Property AsInt64 : Int64 Read GetAsInt64 Write SetAsInt64;
@@ -285,7 +281,6 @@ Type
     procedure SetAsString(const AValue: TJSONStringType); override;
   public
     Constructor Create(const AValue : TJSONStringType); reintroduce;
-    Constructor Create(const AValue : TJSONUnicodeStringType); reintroduce;
     class function JSONType: TJSONType; override;
     Procedure Clear;  override;
     Function Clone : TJSONData; override;
@@ -366,7 +361,6 @@ Type
     function GetObjects(Index : Integer): TJSONObject;
     function GetQWords(Index : Integer): QWord;
     function GetStrings(Index : Integer): TJSONStringType;
-    function GetUnicodeStrings(Index : Integer): TJSONUnicodeStringType;
     function GetTypes(Index : Integer): TJSONType;
     procedure SetArrays(Index : Integer; const AValue: TJSONArray);
     procedure SetBooleans(Index : Integer; const AValue: Boolean);
@@ -376,7 +370,6 @@ Type
     procedure SetObjects(Index : Integer; const AValue: TJSONObject);
     procedure SetQWords(Index : Integer; AValue: QWord);
     procedure SetStrings(Index : Integer; const AValue: TJSONStringType);
-    procedure SetUnicodeStrings(Index : Integer; const AValue: TJSONUnicodeStringType);
   protected
     Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; override;
     Procedure Converterror(From : Boolean);
@@ -416,7 +409,6 @@ Type
     function Add(I : Int64): Int64;
     function Add(I : QWord): QWord;
     function Add(const S : String): Integer;
-    function Add(const S : UnicodeString): Integer;
     function Add: Integer;
     function Add(F : TJSONFloat): Integer;
     function Add(B : Boolean): Integer;
@@ -432,7 +424,6 @@ Type
     procedure Insert(Index: Integer; I : Int64);
     procedure Insert(Index: Integer; I : QWord);
     procedure Insert(Index: Integer; const S : String);
-    procedure Insert(Index: Integer; const S : UnicodeString);
     procedure Insert(Index: Integer; F : TJSONFloat);
     procedure Insert(Index: Integer; B : Boolean);
     procedure Insert(Index: Integer; AnArray : TJSONArray);
@@ -448,7 +439,6 @@ Type
     Property Int64s[Index : Integer] : Int64 Read GetInt64s Write SetInt64s;
     Property QWords[Index : Integer] : QWord Read GetQWords Write SetQWords;
     Property Strings[Index : Integer] : TJSONStringType Read GetStrings Write SetStrings;
-    Property UnicodeStrings[Index : Integer] : TJSONUnicodeStringType Read GetUnicodeStrings Write SetUnicodeStrings;
     Property Floats[Index : Integer] : TJSONFloat Read GetFloats Write SetFloats;
     Property Booleans[Index : Integer] : Boolean Read GetBooleans Write SetBooleans;
     Property Arrays[Index : Integer] : TJSONArray Read GetArrays Write SetArrays;
@@ -484,7 +474,6 @@ Type
     function GetObjects(const AName : String): TJSONObject;
     function GetQWords(AName : String): QWord;
     function GetStrings(const AName : String): TJSONStringType;
-    function GetUnicodeStrings(const AName : String): TJSONUnicodeStringType;
     function GetTypes(const AName : String): TJSONType;
     procedure SetArrays(const AName : String; const AValue: TJSONArray);
     procedure SetBooleans(const AName : String; const AValue: Boolean);
@@ -496,7 +485,6 @@ Type
     procedure SetObjects(const AName : String; const AValue: TJSONObject);
     procedure SetQWords(AName : String; AValue: QWord);
     procedure SetStrings(const AName : String; const AValue: TJSONStringType);
-    procedure SetUnicodeStrings(const AName : String; const AValue: TJSONUnicodeStringType);
     class function GetUnquotedMemberNames: Boolean; static;
     class procedure SetUnquotedMemberNames(AValue: Boolean); static;
   protected
@@ -541,8 +529,7 @@ Type
     Function Get(Const AName : String; ADefault : Int64) : Int64;
     Function Get(Const AName : String; ADefault : QWord) : QWord;
     Function Get(Const AName : String; ADefault : Boolean) : Boolean;
-    Function Get(Const AName : String; ADefault : TJSONStringType) : TJSONStringType;
-    Function Get(Const AName : String; ADefault : TJSONUnicodeStringType) : TJSONUnicodeStringType;
+    Function Get(Const AName : String; ADefault : TJSONStringType) : TJSONStringTYpe;
     Function Get(Const AName : String; ADefault : TJSONArray) : TJSONArray;
     Function Get(Const AName : String; ADefault : TJSONObject) : TJSONObject;
     // Manipulate
@@ -551,7 +538,6 @@ Type
     function Add(const AName: TJSONStringType; AValue: Boolean): Integer; overload;
     function Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer; overload;
     function Add(const AName, AValue: TJSONStringType): Integer; overload;
-    function Add(const AName : String; AValue: TJSONUnicodeStringType): Integer; overload;
     function Add(const AName: TJSONStringType; Avalue: Integer): Integer; overload;
     function Add(const AName: TJSONStringType; Avalue: Int64): Integer; overload;
     function Add(const AName: TJSONStringType; Avalue: QWord): Integer; overload;
@@ -574,7 +560,6 @@ Type
     Property Int64s[AName : String] : Int64 Read GetInt64s Write SetInt64s;
     Property QWords[AName : String] : QWord Read GetQWords Write SetQWords;
     Property Strings[AName : String] : TJSONStringType Read GetStrings Write SetStrings;
-    Property UnicodeStrings[AName : String] : TJSONUnicodeStringType Read GetUnicodeStrings Write SetUnicodeStrings;
     Property Booleans[AName : String] : Boolean Read GetBooleans Write SetBooleans;
     Property Arrays[AName : String] : TJSONArray Read GetArrays Write SetArrays;
     Property Objects[AName : String] : TJSONObject Read GetObjects Write SetObjects;
@@ -600,7 +585,6 @@ Function CreateJSON(Data : Int64) : TJSONInt64Number;
 Function CreateJSON(Data : QWord) : TJSONQWordNumber;
 Function CreateJSON(Data : TJSONFloat) : TJSONFloatNumber;
 Function CreateJSON(Data : TJSONStringType) : TJSONString;
-Function CreateJSON(Data : TJSONUnicodeStringType) : TJSONString;
 Function CreateJSONArray(Data : Array of const) : TJSONArray;
 Function CreateJSONObject(Data : Array of const) : TJSONObject;
 
@@ -663,12 +647,11 @@ begin
   Result:=DefaultJSONInstanceTypes[AType]
 end;
 
-function StringToJSONString(const S: TJSONStringType): TJSONStringType;
+Function StringToJSONString(const S : TJSONStringType) : TJSONStringType;
 
 Var
   I,J,L : Integer;
   P : PJSONCharType;
-  C : AnsiChar;
 
 begin
   I:=1;
@@ -678,11 +661,10 @@ begin
   P:=PJSONCharType(S);
   While I<=L do
     begin
-    C:=AnsiChar(P^);
-    if (C in ['"','/','\',#0..#31]) then
+    if (AnsiChar(P^) in ['"','/','\',#8,#9,#10,#12,#13]) then
       begin
       Result:=Result+Copy(S,J,I-J);
-      Case C of
+      Case P^ of
         '\' : Result:=Result+'\\';
         '/' : Result:=Result+'\/';
         '"' : Result:=Result+'\"';
@@ -691,8 +673,6 @@ begin
         #10 : Result:=Result+'\n';
         #12 : Result:=Result+'\f';
         #13 : Result:=Result+'\r';
-      else
-        Result:=Result+'\u'+HexStr(Ord(C),4);
       end;
       J:=I+1;
       end;
@@ -702,7 +682,7 @@ begin
   Result:=Result+Copy(S,J,I-1);
 end;
 
-function JSONStringToString(const S: TJSONStringType): TJSONStringType;
+Function JSONStringToString(const S : TJSONStringType) : TJSONStringType;
 
 Var
   I,J,L : Integer;
@@ -788,11 +768,6 @@ begin
   Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
 end;
 
-function CreateJSON(Data: TJSONUnicodeStringType): TJSONString;
-begin
-  Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
-end;
-
 function CreateJSONArray(Data: array of const): TJSONArray;
 begin
   Result:=TJSONArrayCLass(DefaultJSONInstanceTypes[jitArray]).Create(Data);
@@ -806,8 +781,7 @@ end;
 Var
   JPH : TJSONParserHandler;
 
-function GetJSON(const JSON: TJSONStringType; const UseUTF8: Boolean
-  ): TJSONData;
+function GetJSON(const JSON: TJSONStringType; Const UseUTF8: Boolean): TJSONData;
 
 Var
   SS : TStringStream;
@@ -820,7 +794,7 @@ begin
   end;
 end;
 
-function GetJSON(const JSON: TStream; const UseUTF8: Boolean): TJSONData;
+function GetJSON(Const JSON: TStream; Const UseUTF8: Boolean): TJSONData;
 
 begin
   Result:=Nil;
@@ -1037,17 +1011,6 @@ end;
 
 { TJSONData }
 
-function TJSONData.GetAsUnicodeString: TJSONUnicodeStringType; 
-
-begin
-  Result:=UTF8Decode(AsString);
-end;
-
-procedure TJSONData.SetAsUnicodeString(const AValue: TJSONUnicodeStringType); 
-
-begin
-  AsString:=UTF8Encode(AValue);
-end;
 
 function TJSONData.GetItem(Index : Integer): TJSONData;
 begin
@@ -1173,7 +1136,7 @@ end;
 function TJSONData.FindPath(const APath: TJSONStringType): TJSONdata;
 
 Var
-  M : TJSONStringType;
+  M : String;
 
 begin
   Result:=DoFindPath(APath,M);
@@ -1182,7 +1145,7 @@ end;
 function TJSONData.GetPath(const APath: TJSONStringType): TJSONdata;
 
 Var
-  M : TJSONStringType;
+  M : String;
 begin
   Result:=DoFindPath(APath,M);
   If Result=Nil then
@@ -1323,11 +1286,6 @@ begin
   FValue:=AValue;
 end;
 
-constructor TJSONString.Create(const AValue: TJSONUnicodeStringType);
-begin
-  FValue:=UTF8Encode(AValue);
-end;
-
 { TJSONboolean }
 
 
@@ -1425,7 +1383,6 @@ begin
   FValue:=StrToBool(AValue);
 end;
 
-
 constructor TJSONBoolean.Create(AValue: Boolean);
 begin
   FValue:=AValue;
@@ -1512,7 +1469,6 @@ begin
   ConvertError(True);
 end;
 
-
 function TJSONNull.GetValue: variant;
 begin
   Result:=variants.Null;
@@ -1608,15 +1564,16 @@ begin
 end;
 
 procedure TJSONFloatNumber.SetAsString(const AValue: TJSONStringType);
+
 Var
   C : Integer;
+
 begin
   Val(AValue,FValue,C);
   If (C<>0) then
     Raise EConvertError.CreateFmt(SErrInvalidFloat,[AValue]);
 end;
 
-
 function TJSONFloatNumber.GetValue: variant;
 begin
   Result:=FValue;
@@ -1715,7 +1672,6 @@ begin
   FValue:=StrToInt(AValue);
 end;
 
-
 function TJSONIntegerNumber.GetValue: variant;
 begin
   Result:=FValue;
@@ -1892,11 +1848,6 @@ begin
   Result:=Items[Index].AsString;
 end;
 
-function TJSONArray.GetUnicodeStrings(Index : Integer): TJSONUnicodeStringType;
-begin
-  Result:=Items[Index].AsUnicodeString;
-end;
-
 function TJSONArray.GetTypes(Index : Integer): TJSONType;
 begin
   Result:=Items[Index].JSONType;
@@ -1943,12 +1894,6 @@ begin
   Items[Index]:=CreateJSON(AValue);
 end;
 
-procedure TJSONArray.SetUnicodeStrings(Index: Integer;
-  const AValue: TJSONUnicodeStringType);
-begin
-  Items[Index]:=CreateJSON(AValue);
-end;
-
 function TJSONArray.DoFindPath(const APath: TJSONStringType; out
   NotFound: TJSONStringType): TJSONdata;
 
@@ -2281,11 +2226,6 @@ begin
   Result:=Add(CreateJSON(S));
 end;
 
-function TJSONArray.Add(const S: UnicodeString): Integer;
-begin
-  Result:=Add(CreateJSON(S));
-end;
-
 function TJSONArray.Add: Integer;
 begin
   Result:=Add(CreateJSON);
@@ -2365,11 +2305,6 @@ begin
   FList.Insert(Index, CreateJSON(S));
 end;
 
-procedure TJSONArray.Insert(Index: Integer; const S: UnicodeString);
-begin
-  FList.Insert(Index, CreateJSON(S));
-end;
-
 procedure TJSONArray.Insert(Index: Integer; F: TJSONFloat);
 begin
   FList.Insert(Index, CreateJSON(F));
@@ -2468,12 +2403,6 @@ begin
   Result:=GetElements(AName).AsString;
 end;
 
-function TJSONObject.GetUnicodeStrings(const AName: String
-  ): TJSONUnicodeStringType;
-begin
-  Result:=GetElements(AName).AsUnicodeString;
-end;
-
 function TJSONObject.GetTypes(const AName : String): TJSONType;
 begin
   Result:=Getelements(Aname).JSONType;
@@ -2541,13 +2470,7 @@ end;
 
 procedure TJSONObject.SetStrings(const AName : String; const AValue: TJSONStringType);
 begin
-  SetElements(AName,CreateJSON(AValue));
-end;
-
-procedure TJSONObject.SetUnicodeStrings(const AName: String;
-  const AValue: TJSONUnicodeStringType);
-begin
-  SetElements(AName,CreateJSON(AValue));
+  SetElements(AName,CreateJSON(AVAlue));
 end;
 
 class procedure TJSONObject.DetermineElementQuotes;
@@ -2906,12 +2829,6 @@ begin
   Result:=Add(AName,CreateJSON(AValue));
 end;
 
-function TJSONObject.Add(const AName: String; AValue: TJSONUnicodeStringType
-  ): Integer;
-begin
-  Result:=Add(AName,CreateJSON(AValue));
-end;
-
 function TJSONObject.Add(const AName: TJSONStringType; Avalue: Integer): Integer;
 begin
   Result:=Add(AName,CreateJSON(AValue));
@@ -3056,7 +2973,7 @@ begin
 end;
 
 function TJSONObject.Get(const AName: String; ADefault: TJSONStringType
-  ): TJSONStringType;
+  ): TJSONStringTYpe;
 Var
   D : TJSONData;
 
@@ -3068,19 +2985,6 @@ begin
     Result:=ADefault;
 end;
 
-function TJSONObject.Get(const AName: String; ADefault: TJSONUnicodeStringType
-  ): TJSONUnicodeStringType;
-Var
-  D : TJSONData;
-
-begin
-  D:=Find(AName,jtString);
-  If (D<>Nil) then
-    Result:=D.AsUnicodeString
-  else
-    Result:=ADefault;
-end;
-
 function TJSONObject.Get(const AName: String; ADefault: TJSONArray
   ): TJSONArray;
 Var

packages/fcl-json/src/fpjsonrtti.pp

@@ -5,12 +5,7 @@ unit fpjsonrtti;
 interface
 
 uses
-  Classes, SysUtils, contnrs, typinfo, fpjson, rttiutils, jsonparser;
-
-Const
-  RFC3339DateTimeFormat = 'yyyy"-"mm"-"dd"T"hh":"nn":"ss';
-  RFC3339DateTimeFormatMsec = RFC3339DateTimeFormat+'.zzz';
-  
+  Classes, SysUtils, typinfo, fpjson, rttiutils, jsonparser;
 
 Type
 
@@ -27,8 +22,7 @@ Type
                        jsoTStringsAsObject,       // Stream TStrings as an object : string = { object }
                        jsoDateTimeAsString,       // Format a TDateTime value as a string
                        jsoUseFormatString,        // Use FormatString when creating JSON strings.
-                       jsoCheckEmptyDateTime,     // If TDateTime value is empty and jsoDateTimeAsString is used, 0 date returns empty string
-                       jsoLegacyDateTime);         // Set this to enable old date/time formatting. Current behaviour is to save date/time as a ISO 9601 value.
+                       jsoCheckEmptyDateTime);    // If TDateTime value is empty and jsoDateTimeAsString is used, 0 date returns empty string
   TJSONStreamOptions = Set of TJSONStreamOption;
 
   TJSONFiler = Class(TComponent)
@@ -68,8 +62,6 @@ Type
     Function ObjectToJSON(Const AObject : TObject) : TJSONObject;
     // Stream a collection - always returns an array
     function StreamCollection(Const ACollection: TCollection): TJSONArray;
-    // Stream an objectlist - always returns an array
-    function StreamObjectList(Const AnObjectList: TObjectList): TJSONArray;
     // Stream a TStrings instance as an array
     function StreamTStringsArray(Const AStrings: TStrings): TJSONArray;
     // Stream a TStrings instance as an object
@@ -108,25 +100,16 @@ Type
   TJSONRestorePropertyEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Var Handled : Boolean) of object;
   TJSONPropertyErrorEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Error : Exception; Var Continue : Boolean) of object;
   TJSONGetObjectEvent = Procedure (Sender : TOBject; AObject : TObject; Info : PPropInfo; AData : TJSONObject; DataName : TJSONStringType; Var AValue : TObject);
-  TJSONDestreamOption = (jdoCaseInsensitive,jdoIgnorePropertyErrors);
-  TJSONDestreamOptions = set of TJSONDestreamOption;
-
   TJSONDeStreamer = Class(TJSONFiler)
   private
     FAfterReadObject: TJSONStreamEvent;
     FBeforeReadObject: TJSONStreamEvent;
-    FDateTimeFormat: String;
     FOnGetObject: TJSONGetObjectEvent;
     FOnPropError: TJSONpropertyErrorEvent;
     FOnRestoreProp: TJSONRestorePropertyEvent;
     FCaseInsensitive : Boolean;
-    FOptions: TJSONDestreamOptions;
     procedure DeStreamClassProperty(AObject: TObject; PropInfo: PPropInfo; PropData: TJSONData);
-    function GetCaseInsensitive: Boolean;
-    procedure SetCaseInsensitive(AValue: Boolean);
   protected
-    // Try to parse a date.
-    Function ExtractDateTime(S : String): TDateTime;
     function GetObject(AInstance : TObject; const APropName: TJSONStringType; D: TJSONObject; PropInfo: PPropInfo): TObject;
     procedure DoRestoreProperty(AObject: TObject; PropInfo: PPropInfo;  PropData: TJSONData); virtual;
     Function ObjectFromString(Const JSON : TJSONStringType) : TJSONData; virtual;
@@ -158,12 +141,7 @@ Type
     // Published Properties of the instance will be further restored with available data.
     Property OngetObject : TJSONGetObjectEvent Read FOnGetObject Write FOnGetObject;
     // JSON is by definition case sensitive. Should properties be looked up case-insentive ?
-    Property CaseInsensitive : Boolean Read GetCaseInsensitive Write SetCaseInsensitive ; deprecated;
-    // DateTime format. If not set, RFC3339DateTimeFormat is assumed.
-    // If set, it will be used as an argument to ScanDateTime. If that fails, StrToDateTime is used.
-    Property DateTimeFormat : String Read FDateTimeFormat Write FDateTimeFormat;
-    // Options overning the behaviour
-    Property Options : TJSONDestreamOptions Read FOptions Write FOptions;
+    Property CaseInsensitive : Boolean Read FCaseInsensitive Write FCaseInsensitive;
   end;
 
   EJSONRTTI = Class(Exception);
@@ -171,7 +149,7 @@ Type
 
 implementation
 
-uses dateutils, variants, rtlconsts;
+uses variants;
 
 ResourceString
   SErrUnknownPropertyKind     = 'Unknown property kind for property : "%s"';
@@ -227,8 +205,7 @@ begin
   inherited Destroy;
 end;
 
-procedure TJSONDeStreamer.JSONToObject(const JSON: TJSONStringType;
-  AObject: TObject);
+procedure TJSONDeStreamer.JSONToObject(Const JSON: TJSONStringType; AObject: TObject);
 
 Var
   D : TJSONData;
@@ -256,7 +233,7 @@ begin
   end;
 end;
 
-function TJSONDeStreamer.JSONToVariant(Data: TJSONData): Variant;
+Function TJSONDeStreamer.JSONToVariant(Data : TJSONData) : Variant;
 
 Var
   I : integer;
@@ -329,48 +306,6 @@ begin
     end;
 end;
 
-function TJSONDeStreamer.GetCaseInsensitive: Boolean;
-begin
-  Result:=jdoCaseInsensitive in Options;
-end;
-
-procedure TJSONDeStreamer.SetCaseInsensitive(AValue: Boolean);
-begin
-  if AValue then
-    Include(Foptions,jdoCaseInsensitive)
-  else
-    Exclude(Foptions,jdoCaseInsensitive);
-end;
-
-function TJSONDeStreamer.ExtractDateTime(S: String): TDateTime;
-
-Var
-  Fmt : String;
-  E,fmtSpecified : Boolean;
-
-begin
-  E:=False;
-  FMT:=DateTimeFormat;
-  fmtSpecified:=Fmt<>'';
-  if Not fmtSpecified then
-    FMT:=RFC3339DateTimeFormat;
-  Try
-    // No TryScanDateTime
-    Result:=ScanDatetime(FMT,S);
-  except
-    if fmtSpecified then
-      Raise
-    else
-      E:=True;
-  end;
-  if E then
-    if not TryStrToDateTime(S,Result) then
-      if not TryStrToDate(S,Result) then
-        if not TryStrToTime(S,Result) then
-          Raise EConvertError.CreateFmt(SInvalidDateTime,[S]);
-//  ExtractDateTime(PropData.AsString)
-end;
-
 procedure TJSONDeStreamer.RestoreProperty(AObject : TObject;PropInfo : PPropInfo; PropData : TJSONData);
 
 Var
@@ -394,9 +329,7 @@ begin
         FOnPropError(Self,AObject,PropInfo,PropData,E,B);
         If Not B then
           Raise;
-        end
-      else if Not (jdoIgnorePropertyErrors in Options) then
-        Raise;
+        end;
   end;
 end;
 
@@ -432,7 +365,7 @@ begin
     tkFloat :
       begin
       if (TI=TypeInfo(TDateTime)) and (PropData.JSONType=jtString) then
-        SetFloatProp(AObject,PI,ExtractDateTime(PropData.AsString))
+        SetFloatProp(AObject,PI,StrToDateTime(PropData.AsString))
       else
         SetFloatProp(AObject,PI,PropData.AsFloat)
       end;
@@ -465,7 +398,7 @@ begin
     tkAString:
       SetStrProp(AObject,PI,PropData.AsString);
     tkWString :
-      SetWideStrProp(AObject,PI,PropData.AsUnicodeString);
+      SetWideStrProp(AObject,PI,PropData.AsString);
     tkVariant:
       SetVariantProp(AObject,PI,JSONToVariant(PropData));
     tkClass:
@@ -490,7 +423,7 @@ begin
     tkMethod :
       Error(SErrUnsupportedPropertyKind,[PI^.Name]);
     tkUString :
-      SetUnicodeStrProp(AObject,PI,PropData.AsUnicodeString);
+      SetUnicodeStrProp(AObject,PI,PropData.AsString);
     tkUChar:
       begin
       JS:=PropData.asString;
@@ -500,8 +433,7 @@ begin
   end;
 end;
 
-procedure TJSONDeStreamer.JSONToObject(const JSON: TJSONObject; AObject: TObject
-  );
+procedure TJSONDeStreamer.JSONToObject(Const JSON: TJSONObject; AObject: TObject);
 Var
   I,J : Integer;
   PIL : TPropInfoList;
@@ -582,9 +514,7 @@ begin
   end;
 end;
 
-function TJSONDeStreamer.GetObject(AInstance: TObject;
-  const APropName: TJSONStringType; D: TJSONObject; PropInfo: PPropInfo
-  ): TObject;
+Function TJSONDeStreamer.GetObject(AInstance : TObject; Const APropName : TJSONStringType; D : TJSONObject; PropInfo : PPropInfo) : TObject;
 
 Var
   C : TClass;
@@ -739,8 +669,6 @@ begin
       Result.Add('Strings',StreamTStrings(Tstrings(AObject)))
     else If AObject is TCollection then
       Result.Add('Items',StreamCollection(TCollection(AObject)))
-    else If AObject is TObjectList then
-      Result.Add('Objects',StreamObjectList(TObjectList(AObject)))
     else
       begin
       PIL:=TPropInfoList.Create(AObject,tkProperties);
@@ -961,24 +889,7 @@ begin
   end;
 end;
 
-function TJSONStreamer.StreamObjectList(const AnObjectList: TObjectList): TJSONArray;
-Var
-  I : Integer;
-
-begin
-  if not Assigned(AnObjectList) then
-    Result:=Nil;
-  Result:=TJSONArray.Create;
-  try
-    For I:=0 to AnObjectList.Count-1 do
-      Result.Add(ObjectToJSON(AnObjectList.Items[i]));
-  except
-    FreeAndNil(Result);
-    Raise;
-  end;
-end;
-
-function TJSONStreamer.StreamClassProperty(const AObject: TObject): TJSONData;
+Function TJSONStreamer.StreamClassProperty(Const AObject : TObject): TJSONData;
 
 Var
   C : TCollection;
@@ -999,8 +910,6 @@ begin
     Result:=StreamTStrings(TStrings(AObject))
   else if (AObject is TCollection) then
     Result:=StreamCollection(TCollection(Aobject))
-  else If AObject is TObjectList then
-    Result:=StreamObjectList(TObjectList(AObject))
   else // Normally, this is only TPersistent.
     Result:=ObjectToJSON(AObject);
 end;
@@ -1071,8 +980,7 @@ begin
       Result:=TJSONInt64Number.Create(GetOrdProp(AObject,PropertyInfo));
     tkQWord :
       Result:=TJSONFloatNumber.Create(GetOrdProp(AObject,PropertyInfo));
-    tkObject :
-      Result:=ObjectToJSON(GetObjectProp(AObject,PropertyInfo));
+    tkObject,
     tkArray,
     tkRecord,
     tkInterface,
@@ -1100,18 +1008,12 @@ begin
     S:=''
   else if (DateTimeFormat<>'') then
     S:=FormatDateTime(DateTimeFormat,DateTime)
-  else if (jsoLegacyDateTime in options) then  
-    begin
-    if Frac(DateTime)=0 then
-      S:=DateToStr(DateTime)
-    else if Trunc(DateTime)=0 then
-      S:=TimeToStr(DateTime)
-    else
-      S:=DateTimeToStr(DateTime);
-    end
+  else if Frac(DateTime)=0 then
+    S:=DateToStr(DateTime)
+  else if Trunc(DateTime)=0 then
+    S:=TimeToStr(DateTime)
   else
-    S:=FormatDateTime(RFC3339DateTimeFormat,DateTime);
-     
+    S:=DateTimeToStr(DateTime);
   Result:=TJSONString.Create(S);
 end;
 

packages/fcl-json/src/jsonconf.pp

@@ -28,10 +28,8 @@ unit jsonConf;
 interface
 
 uses
-  SysUtils, Classes, fpjson, jsonscanner, jsonparser;
+  SysUtils, Classes, fpjson, jsonscanner,jsonparser;
 
-Const
-  DefaultJSONOptions = [joUTF8,joComments];
 
 type
   EJSONConfigError = class(Exception);
@@ -59,11 +57,9 @@ type
     FFormatIndentSize: Integer;
     FFormatoptions: TFormatOptions;
     FFormatted: Boolean;
-    FJSONOptions: TJSONOptions;
     FKey: TJSONObject;
     procedure DoSetFilename(const AFilename: String; ForceReload: Boolean);
     procedure SetFilename(const AFilename: String);
-    procedure SetJSONOptions(AValue: TJSONOptions);
     Function StripSlash(Const P : UnicodeString) : UnicodeString;
   protected
     FJSON: TJSONObject;
@@ -113,7 +109,6 @@ type
     Property Formatted : Boolean Read FFormatted Write FFormatted;
     Property FormatOptions : TFormatOptions Read FFormatoptions Write FFormatOptions Default DefaultFormat;
     Property FormatIndentsize : Integer Read FFormatIndentSize Write FFormatIndentSize Default DefaultIndentSize;
-    Property JSONOptions : TJSONOptions Read FJSONOptions Write SetJSONOptions Default DefaultJSONOptions;
   end;
 
 
@@ -132,7 +127,6 @@ begin
   FKey:=FJSON;
   FFormatOptions:=DefaultFormat;
   FFormatIndentsize:=DefaultIndentSize;
-  FJSONOptions:=DefaultJSONOptions;
 end;
 
 destructor TJSONConfig.Destroy;
@@ -154,22 +148,22 @@ end;
 procedure TJSONConfig.Flush;
 
 Var
-  F : TFileStream;
+  F : Text;
   S : TJSONStringType;
   
 begin
   if Modified then
     begin
-    F:=TFileStream.Create(FileName,fmCreate);
+    AssignFile(F,FileName);
+    Rewrite(F);
     Try
       if Formatted then
         S:=FJSON.FormatJSON(Formatoptions,FormatIndentSize)
       else
         S:=FJSON.AsJSON;
-      if S>'' then
-        F.WriteBuffer(S[1],Length(S));  
+      Writeln(F,S);  
     Finally
-      F.Free;
+      CloseFile(F);
     end;
     FModified := False;
     end;
@@ -212,7 +206,7 @@ begin
         If (Result.Count=0) then
           I:=-1
         else
-          I:=Result.IndexOfName(UTF8Encode(El));
+          I:=Result.IndexOfName(El);
         If (I=-1) then
           // No element with this name.
           begin
@@ -221,7 +215,7 @@ begin
             // Create new node.
             T:=Result;
             Result:=TJSonObject.Create;
-            T.Add(UTF8Encode(El),Result);
+            T.Add(El,Result);
             end
           else
             Result:=Nil
@@ -230,7 +224,7 @@ begin
           // Node found, check if it is an object
           begin
           if (Result.Items[i].JSONtype=jtObject) then
-            Result:=Result.Objects[UTF8Encode(el)]
+            Result:=Result.Objects[el]
           else
             begin
 //            Writeln(el,' type wrong');
@@ -240,7 +234,7 @@ begin
               Result.Delete(I);
               T:=Result;
               Result:=TJSonObject.Create;
-              T.Add(UTF8Encode(El),Result);
+              T.Add(El,Result);
               end
             else
               Result:=Nil
@@ -276,7 +270,7 @@ begin
   If Assigned(Aparent) then
     begin
 //    Writeln('Found parent, looking for element:',elName);
-    I:=AParent.IndexOfName(UTF8Encode(ElName));
+    I:=AParent.IndexOfName(ElName);
 //    Writeln('Element index is',I);
     If (I<>-1) And ((AParent.items[I].JSONType<>jtObject) or AllowObject) then
       Result:=AParent.Items[i];
@@ -293,7 +287,7 @@ var
 begin
   El:=FindElement(StripSlash(APath),False);
   If Assigned(El) then
-    Result:=El.AsUnicodeString
+    Result:=UTF8Decode(El.AsString)
   else
     Result:=ADefault;
 end;
@@ -407,17 +401,17 @@ begin
   El:=FindElement(StripSlash(APath),True,O,ElName);
   if Assigned(El) and (El.JSONType<>jtString) then
     begin
-    I:=O.IndexOfName(UTF8Encode(elName));
+    I:=O.IndexOfName(elName);
     O.Delete(i);
     El:=Nil;
     end;
   If Not Assigned(el) then
     begin
-    El:=TJSONString.Create(AValue);
-    O.Add(UTF8Encode(ElName),El);
+    El:=TJSONString.Create(UTF8encode(AValue));
+    O.Add(ElName,El);
     end
   else
-    El.AsUnicodeString:=AValue;
+    El.AsString:=UTF8Encode(AValue);
   FModified:=True;
 end;
 
@@ -441,7 +435,7 @@ begin
   El:=FindElement(StripSlash(APath),True,O,ElName);
   if Assigned(El) and (Not (El is TJSONIntegerNumber)) then
     begin
-    I:=O.IndexOfName(UTF8Encode(elName));
+    I:=O.IndexOfName(elName);
     If (I<>-1) then // Normally not needed...
       O.Delete(i);
     El:=Nil;
@@ -449,7 +443,7 @@ begin
   If Not Assigned(el) then
     begin
     El:=TJSONIntegerNumber.Create(AValue);
-    O.Add(UTF8Encode(ElName),El);
+    O.Add(ElName,El);
     end
   else
     El.AsInteger:=AValue;
@@ -468,7 +462,7 @@ begin
   El:=FindElement(StripSlash(APath),True,O,ElName);
   if Assigned(El) and (Not (El is TJSONInt64Number)) then
     begin
-    I:=O.IndexOfName(UTF8Encode(elName));
+    I:=O.IndexOfName(elName);
     If (I<>-1) then // Normally not needed...
       O.Delete(i);
     El:=Nil;
@@ -476,7 +470,7 @@ begin
   If Not Assigned(el) then
     begin
     El:=TJSONInt64Number.Create(AValue);
-    O.Add(UTF8Encode(ElName),El);
+    O.Add(ElName,El);
     end
   else
     El.AsInt64:=AValue;
@@ -513,14 +507,14 @@ begin
   El:=FindElement(StripSlash(APath),True,O,ElName);
   if Assigned(El) and (el.JSONType<>jtBoolean) then
     begin
-    I:=O.IndexOfName(UTF8Encode(elName));
+    I:=O.IndexOfName(elName);
     O.Delete(i);
     El:=Nil;
     end;
   If Not Assigned(el) then
     begin
     El:=TJSONBoolean.Create(AValue);
-    O.Add(UTF8Encode(ElName),El);
+    O.Add(ElName,El);
     end
   else
     El.AsBoolean:=AValue;
@@ -539,14 +533,14 @@ begin
   El:=FindElement(StripSlash(APath),True,O,ElName);
   if Assigned(El) and (Not (El is TJSONFloatNumber)) then
     begin
-    I:=O.IndexOfName(UTF8Encode(elName));
+    I:=O.IndexOfName(elName);
     O.Delete(i);
     El:=Nil;
     end;
   If Not Assigned(el) then
     begin
     El:=TJSONFloatNumber.Create(AValue);
-    O.Add(UTF8Encode(ElName),El);
+    O.Add(ElName,El);
     end
   else
     El.AsFloat:=AValue;
@@ -573,7 +567,7 @@ begin
       DoDelete:=(Not (El is TJSONArray));
     if DoDelete then
       begin
-      I:=O.IndexOfName(UTF8Encode(elName));
+      I:=O.IndexOfName(elName);
       O.Delete(i);
       El:=Nil;
       end;
@@ -584,7 +578,7 @@ begin
       El:=TJSONObject.Create
     else
       El:=TJSONArray.Create;
-    O.Add(UTF8Encode(ElName),El);
+    O.Add(ElName,El);
     end;
   if Not AsObject then
     begin
@@ -617,7 +611,7 @@ end;
 procedure TJSONConfig.DeletePath(const APath: UnicodeString);
 
 Var
-  P : UnicodeString;
+  P : String;
   L : integer;
   Node : TJSONObject;
   ElName : UnicodeString;
@@ -630,7 +624,7 @@ begin
     Node := FindObject(P,False,ElName);
     If Assigned(Node) then
       begin
-      L:=Node.IndexOfName(UTF8Encode(ElName));
+      L:=Node.IndexOfName(ElName);
       If (L<>-1) then
         Node.Delete(L);
       end;
@@ -649,7 +643,6 @@ begin
   if Length(Filename) > 0 then
     DoSetFilename(Filename,True);
 end;
-
 procedure TJSONConfig.Loaded;
 begin
   inherited Loaded;
@@ -693,7 +686,7 @@ begin
     begin
     F:=TFileStream.Create(AFileName,fmopenRead);
     try
-      P:=TJSONParser.Create(F,FJSONOptions);
+      P:=TJSONParser.Create(F,[joUTF8,joComments]);
       try
         J:=P.Parse;
         If (J is TJSONObject) then
@@ -718,16 +711,6 @@ begin
   DoSetFilename(AFilename, False);
 end;
 
-procedure TJSONConfig.SetJSONOptions(AValue: TJSONOptions);
-begin
-  if FJSONOptions=AValue then Exit;
-  FJSONOptions:=AValue;
-  if csLoading in ComponentState then
-    exit;
-  if (FFileName<>'') then
-    Reload;
-end;
-
 function TJSONConfig.StripSlash(const P: UnicodeString): UnicodeString;
 
 Var
@@ -750,9 +733,8 @@ end;
 procedure TJSONConfig.OpenKey(const aPath: UnicodeString; AllowCreate: Boolean);
 
 Var
-  P : UnicodeString;
+  P : String;
   L : Integer;
-  
 begin
   P:=APath;
   L:=Length(P);

packages/fcl-json/src/jsonparser.pp

@@ -82,7 +82,7 @@ Var
 
 begin
   Data:=Nil;
-  P:=TJSONParser.Create(AStream,[joUTF8]);
+  P:=TJSONParser.Create(AStream,AUseUTF8);
   try
     Data:=P.Parse;
   finally
@@ -138,10 +138,7 @@ begin
       tkNull  : Result:=CreateJSON;
       tkTrue,
       tkFalse : Result:=CreateJSON(t=tkTrue);
-      tkString : if joUTF8 in Options then
-                   Result:=CreateJSON(UTF8Decode(CurrentTokenString))
-                     else
-                       Result:=CreateJSON(CurrentTokenString);
+      tkString : Result:=CreateJSON(CurrentTokenString);
       tkCurlyBraceOpen : Result:=ParseObject;
       tkCurlyBraceClose : DoError(SErrUnexpectedToken);
       tkSQuaredBraceOpen : Result:=ParseArray;
@@ -238,10 +235,8 @@ Var
   T : TJSONtoken;
   E : TJSONData;
   N : String;
-  LastComma : Boolean;
-
+  
 begin
-  LastComma:=False;
   Result:=CreateJSONObject([]);
   Try
     T:=GetNextToken;
@@ -259,13 +254,8 @@ begin
       If Not (T in [tkComma,tkCurlyBraceClose]) then
         DoError(SExpectedCommaorBraceClose);
       If T=tkComma then
-        begin
         T:=GetNextToken;
-        LastComma:=(t=tkCurlyBraceClose);
-        end;
       end;
-    If LastComma and ((joStrict in Options) or not (joIgnoreTrailingComma in Options))  then // Test for ,} case
-      DoError(SErrUnExpectedToken);
   Except
     FreeAndNil(Result);
     Raise;
@@ -279,7 +269,7 @@ Var
   T : TJSONtoken;
   E : TJSONData;
   LastComma : Boolean;
-  S : TJSONOPTions;
+  
 begin
   Result:=CreateJSONArray([]);
   LastComma:=False;
@@ -299,8 +289,7 @@ begin
         LastComma:=(t=TkComma);
         end;
     Until (T=tkSquaredBraceClose);
-    S:=Options;
-    If LastComma and ((joStrict in S) or not (joIgnoreTrailingComma in S))  then // Test for ,] case
+    If LastComma then // Test for ,] case
       DoError(SErrUnExpectedToken);
   Except
     FreeAndNil(Result);
@@ -331,17 +320,15 @@ end;
 constructor TJSONParser.Create(Source: TStream; AUseUTF8 : Boolean = True);
 begin
   Inherited Create;
-  FScanner:=TJSONScanner.Create(Source,[joUTF8]);
-  if AUseUTF8 then
-   Options:=Options + [joUTF8];
+  FScanner:=TJSONScanner.Create(Source);
+  UseUTF8:=AUseUTF8;
 end;
 
 constructor TJSONParser.Create(Source: TJSONStringType; AUseUTF8 : Boolean = True);
 begin
   Inherited Create;
-  FScanner:=TJSONScanner.Create(Source,[joUTF8]);
-  if AUseUTF8 then
-   Options:=Options + [joUTF8];
+  FScanner:=TJSONScanner.Create(Source);
+  UseUTF8:=AUseUTF8;
 end;
 
 constructor TJSONParser.Create(Source: TStream; AOptions: TJSONOptions);

packages/fcl-json/src/jsonscanner.pp

@@ -50,7 +50,7 @@ type
 
   EScannerError       = class(EParserError);
 
-  TJSONOption = (joUTF8,joStrict,joComments,joIgnoreTrailingComma);
+  TJSONOption = (joUTF8,joStrict,joComments);
   TJSONOptions = set of TJSONOption;
 
 Const
@@ -247,7 +247,7 @@ begin
     '"','''':
       begin
         C:=TokenStr[0];
-        If (C='''') and (joStrict in Options) then
+        If (C='''') and Strict then
           Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
         Inc(TokenStr);
         TokenStart := TokenStr;
@@ -284,7 +284,7 @@ begin
                       end;
                       end;
                     // WideChar takes care of conversion...  
-                    if (joUTF8 in Options) then
+                    if UseUTF8 then
                       S:=Utf8Encode(WideString(WideChar(StrToInt('$'+S))))
                     else
                       S:=WideChar(StrToInt('$'+S));  
@@ -353,7 +353,6 @@ begin
           end;
         end;
         SectionLength := TokenStr - TokenStart;
-        FCurTokenString:='';
         SetString(FCurTokenString, TokenStart, SectionLength);
         If (FCurTokenString[1]='.') then
           FCurTokenString:='0'+FCurTokenString;
@@ -388,14 +387,11 @@ begin
       begin
       if Not (joComments in Options) then
         Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
-      TokenStart:=TokenStr;
       Inc(TokenStr);
       Case Tokenstr[0] of
         '/' : begin
               SectionLength := Length(FCurLine)- (TokenStr - PChar(FCurLine));
-              Inc(TokenStr);
-              FCurTokenString:='';
-              SetString(FCurTokenString, TokenStr, SectionLength);
+              SetString(FCurTokenString, TokenStart, SectionLength);
               Fetchline;
               end;
         '*' :
@@ -407,8 +403,8 @@ begin
             if (TokenStr[0]=#0) then
               begin
               SectionLength := (TokenStr - TokenStart);
-              S:='';
               SetString(S, TokenStart, SectionLength);
+
               FCurtokenString:=FCurtokenString+S;
               if not fetchLine then
                 Error(SUnterminatedComment, [CurRow,CurCOlumn,TokenStr[0]]);
@@ -421,7 +417,6 @@ begin
           if EOC then
             begin
             SectionLength := (TokenStr - TokenStart-1);
-            S:='';
             SetString(S, TokenStart, SectionLength);
             FCurtokenString:=FCurtokenString+S;
             Inc(TokenStr);
@@ -439,7 +434,6 @@ begin
           Inc(TokenStr);
         until not (TokenStr[0] in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
         SectionLength := TokenStr - TokenStart;
-        FCurTokenString:='';
         SetString(FCurTokenString, TokenStart, SectionLength);
         for it := tkTrue to tkNull do
           if CompareText(CurTokenString, TokenInfos[it]) = 0 then
@@ -448,7 +442,7 @@ begin
             FCurToken := Result;
             exit;
             end;
-        if (joStrict in Options) then
+        if Strict then
           Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]])
         else
           Result:=tkIdentifier;