+

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

.gitattributes

@@ -1014,6 +1014,7 @@ packages/ami-extra/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/ami-extra/README.txt svneol=native#text/plain
 packages/ami-extra/fpmake.pp svneol=native#text/plain
 packages/ami-extra/src/cliputils.pas svneol=native#text/plain
+packages/ami-extra/src/pcq.pas svneol=native#text/plain
 packages/amunits/Makefile svneol=native#text/plain
 packages/amunits/Makefile.fpc svneol=native#text/plain
 packages/amunits/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -1148,8 +1149,6 @@ packages/amunits/src/otherlibs/xadmaster.pas svneol=native#text/plain
 packages/amunits/src/otherlibs/zlib.pas svneol=native#text/plain
 packages/amunits/src/useamigasmartlink.inc svneol=native#text/plain
 packages/amunits/src/useautoopenlib.inc svneol=native#text/plain
-packages/amunits/src/utilunits/Makefile svneol=native#text/plain
-packages/amunits/src/utilunits/Makefile.fpc svneol=native#text/plain
 packages/amunits/src/utilunits/amigautils.pas svneol=native#text/plain
 packages/amunits/src/utilunits/amsgbox.pas svneol=native#text/plain
 packages/amunits/src/utilunits/consoleio.pas svneol=native#text/plain
@@ -1158,10 +1157,7 @@ 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
@@ -1931,6 +1927,7 @@ 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
@@ -1945,6 +1942,7 @@ 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,8 +1958,6 @@ 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
@@ -1990,9 +1986,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
@@ -2075,6 +2071,7 @@ 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
@@ -2509,6 +2506,7 @@ 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,9 +2575,48 @@ 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
@@ -2601,9 +2638,8 @@ 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/win/simpleipc.inc svneol=native#text/plain
+packages/fcl-process/src/winall/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
@@ -2871,6 +2907,7 @@ 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
@@ -2885,6 +2922,7 @@ 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
@@ -3157,6 +3195,8 @@ 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
@@ -3189,6 +3229,9 @@ packages/fcl-web/src/base/restcodegen.pp svneol=native#text/plain
 packages/fcl-web/src/base/webpage.pp svneol=native#text/plain
 packages/fcl-web/src/base/websession.pp svneol=native#text/plain
 packages/fcl-web/src/base/webutil.pp svneol=native#text/plain
+packages/fcl-web/src/hpack/uhpack.pp svneol=native#text/plain
+packages/fcl-web/src/hpack/uhpackimp.pp svneol=native#text/plain
+packages/fcl-web/src/hpack/uhpacktables.pp svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/Makefile svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/Makefile.fpc svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/fpdispextdirect.pp svneol=native#text/plain
@@ -3204,10 +3247,14 @@ packages/fcl-web/src/webdata/fpextjs.pp svneol=native#text/plain
 packages/fcl-web/src/webdata/fpwebdata.pp svneol=native#text/plain
 packages/fcl-web/src/webdata/readme.txt svneol=native#text/plain
 packages/fcl-web/src/webdata/sqldbwebdata.pp svneol=native#text/plain
+packages/fcl-web/tests/README.txt svneol=native#text/plain
 packages/fcl-web/tests/cgigateway.lpi svneol=native#text/plain
 packages/fcl-web/tests/cgigateway.pp svneol=native#text/plain
+packages/fcl-web/tests/fpcunithpack.lpi svneol=native#text/plain
+packages/fcl-web/tests/fpcunithpack.lpr svneol=native#text/plain
 packages/fcl-web/tests/testcgiapp.lpi svneol=native#text/plain
 packages/fcl-web/tests/testcgiapp.pp svneol=native#text/plain
+packages/fcl-web/tests/uhpacktest1.pas svneol=native#text/plain
 packages/fcl-xml/Makefile svneol=native#text/plain
 packages/fcl-xml/Makefile.fpc svneol=native#text/plain
 packages/fcl-xml/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -4971,36 +5018,6 @@ 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
@@ -6270,6 +6287,25 @@ 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/asl.pas svneol=native#text/pascal
+packages/os4units/src/clipboard.pas svneol=native#text/pascal
+packages/os4units/src/diskfont.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/os4units/src/workbench.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
@@ -6490,6 +6526,10 @@ 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
@@ -6622,6 +6662,8 @@ 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
@@ -6969,6 +7011,7 @@ 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
@@ -7979,9 +8022,15 @@ packages/x11/src/xcms.pp svneol=native#text/plain
 packages/x11/src/xf86dga.pp svneol=native#text/plain
 packages/x11/src/xf86dga1.inc svneol=native#text/plain
 packages/x11/src/xf86vmode.pp svneol=native#text/plain
+packages/x11/src/xfixes.pp svneol=native#text/plain
+packages/x11/src/xfixeswire.inc svneol=native#text/plain
 packages/x11/src/xft.pas svneol=native#text/pascal
+packages/x11/src/xge.pp svneol=native#text/plain
 packages/x11/src/xi.pp svneol=native#text/plain
+packages/x11/src/xi2.pp svneol=native#text/plain
 packages/x11/src/xinerama.pp svneol=native#text/plain
+packages/x11/src/xinput.pp svneol=native#text/plain
+packages/x11/src/xinput2.pp svneol=native#text/plain
 packages/x11/src/xkb.pp svneol=native#text/plain
 packages/x11/src/xkblib.pp svneol=native#text/plain
 packages/x11/src/xlib.pp svneol=native#text/plain
@@ -7992,6 +8041,10 @@ packages/x11/src/xshm.pp svneol=native#text/plain
 packages/x11/src/xutil.pp svneol=native#text/plain
 packages/x11/src/xv.pp svneol=native#text/plain
 packages/x11/src/xvlib.pp svneol=native#text/plain
+packages/x11/tests/xfixes_linktest.pp svneol=native#text/plain
+packages/x11/tests/xge_linktest.pp svneol=native#text/plain
+packages/x11/tests/xinput2_linktest.pp svneol=native#text/plain
+packages/x11/tests/xinput_linktest.pp svneol=native#text/plain
 packages/xforms/Makefile svneol=native#text/plain
 packages/xforms/Makefile.fpc svneol=native#text/plain
 packages/xforms/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -14957,6 +15010,7 @@ tests/webtbs/tw2983.pp svneol=native#text/plain
 tests/webtbs/tw2984.pp svneol=native#text/plain
 tests/webtbs/tw29891.pp svneol=native#text/plain
 tests/webtbs/tw29893.pp svneol=native#text/pascal
+tests/webtbs/tw29906.pp svneol=native#text/plain
 tests/webtbs/tw29912.pp svneol=native#text/plain
 tests/webtbs/tw29923.pp svneol=native#text/plain
 tests/webtbs/tw29930.pp svneol=native#text/plain
@@ -14965,11 +15019,13 @@ tests/webtbs/tw29958.pp svneol=native#text/pascal
 tests/webtbs/tw2998.pp svneol=native#text/plain
 tests/webtbs/tw2999.pp svneol=native#text/plain
 tests/webtbs/tw29992.pp svneol=native#text/plain
+tests/webtbs/tw30007.pp svneol=native#text/plain
 tests/webtbs/tw30030.pp svneol=native#text/pascal
 tests/webtbs/tw30035.pp svneol=native#text/plain
 tests/webtbs/tw30035a.pp svneol=native#text/plain
 tests/webtbs/tw3004.pp svneol=native#text/plain
 tests/webtbs/tw3005.pp svneol=native#text/plain
+tests/webtbs/tw30082.pp svneol=native#text/plain
 tests/webtbs/tw3010.pp svneol=native#text/plain
 tests/webtbs/tw3012.pp svneol=native#text/plain
 tests/webtbs/tw3023.pp svneol=native#text/plain

compiler/aarch64/cgcpu.pas

@@ -1116,8 +1116,9 @@ implementation
         if fromsize in [OS_64,OS_S64] then
           begin
             { split into two 32 bit stores }
-            hreg1:=makeregsize(register,OS_32);
+            hreg1:=getintregister(list,OS_32);
             hreg2:=getintregister(list,OS_32);
+            a_load_reg_reg(list,OS_32,OS_32,makeregsize(register,OS_32),hreg1);
             a_op_const_reg_reg(list,OP_SHR,OS_64,32,register,makeregsize(hreg2,OS_64));
             if target_info.endian=endian_big then
               begin

compiler/globals.pas

@@ -493,7 +493,11 @@ interface
   {$ifdef i8086}
         cputype : cpu_8086;
         optimizecputype : cpu_8086;
-        asmcputype : cpu_8086;
+        { Use cpu_none by default,
+        because using cpu_8086 by default means
+        that we reject any instruction above bare 8086 instruction set
+        for all assembler code PM }
+        asmcputype : cpu_none;
         fputype : fpu_x87;
   {$endif i8086}
 {$endif not GENERIC_CPU}

compiler/hlcg2ll.pas

@@ -1121,7 +1121,7 @@ implementation
              ((l.size = dst_cgsize) or
               (TCGSize2Size[l.size] = sizeof(aint)));
           if not const_location then
-            hregister:=cg.getintregister(list,dst_cgsize)
+            hregister:=hlcg.getregisterfordef(list,dst_size)
           else
             hregister := l.register;
           { load value in new register }

compiler/hlcgobj.pas

@@ -828,8 +828,10 @@ implementation
             else
               result:=R_FPUREGISTER;
           filedef,
-          variantdef:
-            internalerror(2010120507);
+          variantdef,
+          forwarddef,
+          undefineddef:
+            result:=R_INVALIDREGISTER;
         else
           internalerror(2010120506);
         end;
@@ -4238,7 +4240,10 @@ implementation
               end
             else
 {$endif cpu64bitalu}
-              rr.new := cg.getintregister(current_asmdata.CurrAsmList,n.location.size);
+              if getregtype(rr.old)=R_ADDRESSREGISTER then
+                rr.new := cg.getaddressregister(current_asmdata.CurrAsmList)
+              else
+                rr.new := cg.getintregister(current_asmdata.CurrAsmList,n.location.size);
           end;
         LOC_CFPUREGISTER:
           rr.new := cg.getfpuregister(current_asmdata.CurrAsmList,n.location.size);

compiler/i386/i386prop.inc

@@ -683,10 +683,10 @@
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
+(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
+(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
+(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),

compiler/i8086/i8086prop.inc

@@ -683,10 +683,10 @@
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
+(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
+(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
+(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),

compiler/m68k/cgcpu.pas

@@ -879,7 +879,7 @@ unit cgcpu;
       var
         instr : taicpu;
       begin
-        instr:=taicpu.op_reg_reg(A_FMOVE,fpuregsize,reg1,reg2);
+        instr:=taicpu.op_reg_reg(A_FMOVE,fpuregopsize,reg1,reg2);
         add_move_instruction(instr);
         list.concat(instr);
       end;
@@ -1754,7 +1754,7 @@ unit cgcpu;
             if saved_fpu_registers[r] in rg[R_FPUREGISTER].used_in_proc then
               begin
                 hfreg:=newreg(R_FPUREGISTER,saved_fpu_registers[r],R_SUBNONE);
-                inc(fsize,12{sizeof(extended)});
+                inc(fsize,fpuregsize);
                 fpuregs:=fpuregs + [saved_fpu_registers[r]];
               end;
 
@@ -1787,10 +1787,10 @@ unit cgcpu;
               begin
                 { size is always longword aligned, while fsize is not }
                 inc(href.offset,size);
-                if fsize = 12{sizeof(extended)} then
-                  list.concat(taicpu.op_reg_ref(A_FMOVE,fpuregsize,hfreg,href))
+                if fsize = fpuregsize then
+                  list.concat(taicpu.op_reg_ref(A_FMOVE,fpuregopsize,hfreg,href))
                 else
-                  list.concat(taicpu.op_regset_ref(A_FMOVEM,fpuregsize,[],[],fpuregs,href));
+                  list.concat(taicpu.op_regset_ref(A_FMOVEM,fpuregopsize,[],[],fpuregs,href));
               end;
           end;
       end;
@@ -1845,7 +1845,7 @@ unit cgcpu;
           for r:=low(saved_fpu_registers) to high(saved_fpu_registers) do
             if saved_fpu_registers[r] in rg[R_FPUREGISTER].used_in_proc then
               begin
-                inc(fsize,12{sizeof(extended)});
+                inc(fsize,fpuregsize);
                 hfreg:=newreg(R_FPUREGISTER,saved_fpu_registers[r],R_SUBNONE);
                 { Allocate register so the optimizer does not remove the load }
                 a_reg_alloc(list,hfreg);
@@ -1875,10 +1875,10 @@ unit cgcpu;
           begin
             { size is always longword aligned, while fsize is not }
             inc(href.offset,size);
-            if fsize = 12{sizeof(extended)} then
-              list.concat(taicpu.op_ref_reg(A_FMOVE,fpuregsize,href,hfreg))
+            if fsize = fpuregsize then
+              list.concat(taicpu.op_ref_reg(A_FMOVE,fpuregopsize,href,hfreg))
             else
-              list.concat(taicpu.op_ref_regset(A_FMOVEM,fpuregsize,href,[],[],fpuregs));
+              list.concat(taicpu.op_ref_regset(A_FMOVEM,fpuregopsize,href,[],[],fpuregs));
           end;
 
         tg.UnGetTemp(list,current_procinfo.save_regs_ref);

compiler/m68k/cpubase.pas

@@ -362,7 +362,8 @@ unit cpubase;
 
     function isaddressregister(reg : tregister) : boolean;
     function isintregister(reg : tregister) : boolean;
-    function fpuregsize: TOpSize; {$ifdef USEINLINE}inline;{$endif USEINLINE}
+    function fpuregopsize: TOpSize; {$ifdef USEINLINE}inline;{$endif USEINLINE}
+    function fpuregsize: aint; {$ifdef USEINLINE}inline;{$endif USEINLINE}
     function isregoverlap(reg1: tregister; reg2: tregister): boolean;
 
     function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
@@ -538,9 +539,16 @@ implementation
         result:=getregtype(reg)=R_INTREGISTER;
       end;
 
-    function fpuregsize: TOpSize; {$ifdef USEINLINE}inline;{$endif USEINLINE}
+    function fpuregopsize: TOpSize; {$ifdef USEINLINE}inline;{$endif USEINLINE}
       const
-        fpu_regsize: array[boolean] of TOpSize = ( S_FX, S_FD );
+        fpu_regopsize: array[boolean] of TOpSize = ( S_FX, S_FD );
+      begin
+        result:=fpu_regopsize[current_settings.fputype = fpu_coldfire];
+      end;
+
+    function fpuregsize: aint; {$ifdef USEINLINE}inline;{$endif USEINLINE}
+      const
+        fpu_regsize: array[boolean] of aint = ( 12, 8 ); { S_FX is 12 bytes on '881 }
       begin
         result:=fpu_regsize[current_settings.fputype = fpu_coldfire];
       end;

compiler/m68k/n68kadd.pas

@@ -182,7 +182,7 @@ implementation
               cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmlist,OS_NO,OS_NO,left.location.register,location.register);
               case right.location.loc of
                 LOC_FPUREGISTER,LOC_CFPUREGISTER:
-                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,fpuregsize,right.location.register,location.register));
+                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,fpuregopsize,right.location.register,location.register));
                 LOC_REFERENCE,LOC_CREFERENCE:
                     begin
                       href:=right.location.reference;
@@ -219,7 +219,7 @@ implementation
               { emit compare }
               case right.location.loc of
                 LOC_FPUREGISTER,LOC_CFPUREGISTER:
-                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FCMP,fpuregsize,right.location.register,left.location.register));
+                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FCMP,fpuregopsize,right.location.register,left.location.register));
                 LOC_REFERENCE,LOC_CREFERENCE:
                     begin
                       href:=right.location.reference;

compiler/m68k/n68kinl.pas

@@ -176,7 +176,7 @@ implementation
                   location.loc := LOC_FPUREGISTER;
                   cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmlist,OS_NO,OS_NO,left.location.register,location.register);
                 end;
-              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FMUL,fpuregsize,left.location.register,location.register));
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FMUL,fpuregopsize,left.location.register,location.register));
             end;
         else
           internalerror(2015022202);
@@ -215,12 +215,12 @@ implementation
                 LOC_FPUREGISTER:
                   begin
                     location.register:=left.location.register;
-                    current_asmdata.CurrAsmList.concat(taicpu.op_reg(op,fpuregsize,location.register))
+                    current_asmdata.CurrAsmList.concat(taicpu.op_reg(op,fpuregopsize,location.register))
                   end;
                 LOC_CFPUREGISTER:
                   begin
                     location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
-                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,fpuregsize,left.location.register,location.register));
+                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,fpuregopsize,left.location.register,location.register));
                   end;
                 LOC_REFERENCE,LOC_CREFERENCE:
                   begin

compiler/m68k/n68kmat.pas

@@ -200,12 +200,12 @@ implementation
           LOC_FPUREGISTER:
             begin
               location.register:=left.location.register;
-              current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_FNEG,fpuregsize,location.register));
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_FNEG,fpuregopsize,location.register));
             end;
           LOC_CFPUREGISTER:
             begin
                location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
-               current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FNEG,fpuregsize,left.location.register,location.register));
+               current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FNEG,fpuregopsize,left.location.register,location.register));
             end;
           else
             internalerror(200306021);

compiler/nadd.pas

@@ -824,7 +824,11 @@ implementation
                   begin
                     t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2,nil);
                     typecheckpass(t);
-                    tstringconstnode(t).changestringtype(resultdef);
+                    if not is_ansistring(resultdef) or
+                       (tstringdef(resultdef).encoding<>globals.CP_NONE) then
+                      tstringconstnode(t).changestringtype(resultdef)
+                    else
+                      tstringconstnode(t).changestringtype(getansistringdef)
                   end;
                 ltn :
                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),pasbool8type,true);
@@ -1859,7 +1863,7 @@ implementation
                     begin
                       { use same code page if possible (don't force same code
                         page in case both are ansistrings with code page <>
-                        CP_NONE, since then data loss can occur (the ansistring
+                        CP_NONE, since then data loss can occur: the ansistring
                         helpers will convert them at run time to an encoding
                         that can represent both encodings) }
                       if is_ansistring(ld) and

compiler/ncal.pas

@@ -303,7 +303,7 @@ implementation
       verbose,globals,
       symconst,defutil,defcmp,
       htypechk,pass_1,
-      ncnv,nld,ninl,nadd,ncon,nmem,nset,nobjc,
+      ncnv,nflw,nld,ninl,nadd,ncon,nmem,nset,nobjc,
       ngenutil,objcutil,
       procinfo,cpuinfo,
       wpobase;
@@ -765,16 +765,24 @@ implementation
                  { move(para,temp,sizeof(arr)) (no "left.getcopy" below because
                    we replace left afterwards) }
                  addstatement(initstat,
-                   ccallnode.createintern('MOVE',
-                     ccallparanode.create(
-                       arraysize,
+                   cifnode.create_internal(
+                     caddnode.create_internal(
+                       unequaln,
+                       arraysize.getcopy,
+                       genintconstnode(0)
+                     ),
+                     ccallnode.createintern('MOVE',
                        ccallparanode.create(
-                         cderefnode.create(ctemprefnode.create(paratemp)),
+                         arraysize,
                          ccallparanode.create(
-                           arraybegin,nil
+                           cderefnode.create(ctemprefnode.create(paratemp)),
+                           ccallparanode.create(
+                             arraybegin,nil
+                           )
                          )
                        )
-                     )
+                     ),
+                     nil
                    )
                  );
                  { no reference count increases, that's still done on the callee
@@ -1789,6 +1797,12 @@ implementation
             printnode(t,methodpointer);
           end;
 
+        if assigned(funcretnode) then
+          begin
+            writeln(t,printnodeindention,'funcretnode =');
+            printnode(t,funcretnode);
+          end;
+
         if assigned(callinitblock) then
           begin
             writeln(t,printnodeindention,'callinitblock =');

compiler/ncgflw.pas

@@ -111,6 +111,7 @@ implementation
              if checkusedregvars then
                begin
                  usedregvars.intregvars.init;
+                 usedregvars.addrregvars.init;
                  usedregvars.fpuregvars.init;
                  usedregvars.mmregvars.init;
 
@@ -123,6 +124,7 @@ implementation
                begin
                  gen_sync_regvars(current_asmdata.CurrAsmList,usedregvars);
                  usedregvars.intregvars.done;
+                 usedregvars.addrregvars.done;
                  usedregvars.fpuregvars.done;
                  usedregvars.mmregvars.done;
                end;
@@ -384,6 +386,7 @@ implementation
              if checkusedregvars then
                begin
                  usedregvars.intregvars.init;
+                 usedregvars.addrregvars.init;
                  usedregvars.fpuregvars.init;
                  usedregvars.mmregvars.init;
 
@@ -404,6 +407,7 @@ implementation
                begin
                  gen_sync_regvars(current_asmdata.CurrAsmList,usedregvars);
                  usedregvars.intregvars.done;
+                 usedregvars.addrregvars.done;
                  usedregvars.fpuregvars.done;
                  usedregvars.mmregvars.done;
                end;

compiler/ncgutil.pas

@@ -41,7 +41,7 @@ interface
 
       pusedregvars = ^tusedregvars;
       tusedregvars = record
-        intregvars, fpuregvars, mmregvars: Tsuperregisterworklist;
+        intregvars, addrregvars, fpuregvars, mmregvars: Tsuperregisterworklist;
       end;
 
 {
@@ -69,7 +69,7 @@ interface
 
     { allocate registers for a tlocation; assumes that loc.loc is already
       set to LOC_CREGISTER/LOC_CFPUREGISTER/... }
-    procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation);
+    procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation;def: tdef);
 
     procedure register_maybe_adjust_setbase(list: TAsmList; opdef: tdef; var l: tlocation; setbase: aint);
 
@@ -578,7 +578,7 @@ implementation
                     tcgassignmentnode thlcgobj.maybe_change_load_node_reg is
                     called for the temporary node; so the workaround for now is
                     to fix the symptoms... }
-              l.register:=cg.getintregister(list,l.size);
+              l.register:=hlcg.getregisterfordef(list,def);
           end;
       end;
 
@@ -652,7 +652,7 @@ implementation
       end;
 
 
-    procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation);
+    procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation;def: tdef);
       begin
         case loc.loc of
           LOC_CREGISTER:
@@ -672,7 +672,10 @@ implementation
                 end
               else
 {$endif cpu64bitalu}
-                loc.register:=cg.getintregister(list,loc.size);
+                if hlcg.def2regtyp(def)=R_ADDRESSREGISTER then
+                  loc.register:=hlcg.getaddressregister(list,def)
+                else
+                  loc.register:=cg.getintregister(list,loc.size);
             end;
           LOC_CFPUREGISTER:
             begin
@@ -687,9 +690,17 @@ implementation
 
 
     procedure gen_alloc_regvar(list:TAsmList;sym: tabstractnormalvarsym; allocreg: boolean);
+      var
+        usedef: tdef;
       begin
         if allocreg then
-          gen_alloc_regloc(list,sym.initialloc);
+          begin
+            if sym.typ=paravarsym then
+              usedef:=tparavarsym(sym).paraloc[calleeside].def
+            else
+              usedef:=sym.vardef;
+            gen_alloc_regloc(list,sym.initialloc,usedef);
+          end;
         if (pi_has_label in current_procinfo.flags) then
           begin
             { Allocate register already, to prevent first allocation to be
@@ -856,7 +867,7 @@ implementation
                             { paraloc^ -> high
                               paraloc^.next -> low }
                             unget_para(paraloc^);
-                            gen_alloc_regloc(list,destloc);
+                            gen_alloc_regloc(list,destloc,vardef);
                             { reg->reg, alignment is irrelevant }
                             cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reghi,8);
                             unget_para(paraloc^.next^);
@@ -867,7 +878,7 @@ implementation
                             { paraloc^ -> low
                               paraloc^.next -> high }
                             unget_para(paraloc^);
-                            gen_alloc_regloc(list,destloc);
+                            gen_alloc_regloc(list,destloc,vardef);
                             cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reglo,8);
                             unget_para(paraloc^.next^);
                             cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^.next^,destloc.register128.reghi,8);
@@ -875,7 +886,7 @@ implementation
                       end;
                     LOC_REFERENCE:
                       begin
-                        gen_alloc_regloc(list,destloc);
+                        gen_alloc_regloc(list,destloc,vardef);
                         reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset,para.alignment);
                         cg128.a_load128_ref_reg(list,href,destloc.register128);
                         unget_para(paraloc^);
@@ -908,7 +919,7 @@ implementation
                                 { paraloc^ -> high
                                   paraloc^.next^.next^.next^.next -> low }
                                 unget_para(paraloc^);
-                                gen_alloc_regloc(list,destloc);
+                                gen_alloc_regloc(list,destloc,vardef);
                                 { reg->reg, alignment is irrelevant }
                                 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,GetNextReg(destloc.register64.reghi),1);
                                 unget_para(paraloc^.next^);
@@ -924,7 +935,7 @@ implementation
                                   paraloc^.next^.next^.next^.next -> high }
                                 curparaloc:=paraloc;
                                 unget_para(curparaloc^);
-                                gen_alloc_regloc(list,destloc);
+                                gen_alloc_regloc(list,destloc,vardef);
                                 cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^,destloc.register64.reglo,2);
                                 unget_para(curparaloc^.next^);
                                 cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^,GetNextReg(destloc.register64.reglo),1);
@@ -952,7 +963,7 @@ implementation
                                 { paraloc^ -> high
                                   paraloc^.next^.next -> low }
                                 unget_para(paraloc^);
-                                gen_alloc_regloc(list,destloc);
+                                gen_alloc_regloc(list,destloc,vardef);
                                 { reg->reg, alignment is irrelevant }
                                 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,GetNextReg(destloc.register64.reghi),2);
                                 unget_para(paraloc^.next^);
@@ -967,7 +978,7 @@ implementation
                                 { paraloc^ -> low
                                   paraloc^.next^.next -> high }
                                 unget_para(paraloc^);
-                                gen_alloc_regloc(list,destloc);
+                                gen_alloc_regloc(list,destloc,vardef);
                                 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,destloc.register64.reglo,2);
                                 unget_para(paraloc^.next^);
                                 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,GetNextReg(destloc.register64.reglo),2);
@@ -983,7 +994,7 @@ implementation
                                 { paraloc^ -> high
                                   paraloc^.next -> low }
                                 unget_para(paraloc^);
-                                gen_alloc_regloc(list,destloc);
+                                gen_alloc_regloc(list,destloc,vardef);
                                 { reg->reg, alignment is irrelevant }
                                 cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reghi,4);
                                 unget_para(paraloc^.next^);
@@ -994,7 +1005,7 @@ implementation
                                 { paraloc^ -> low
                                   paraloc^.next -> high }
                                 unget_para(paraloc^);
-                                gen_alloc_regloc(list,destloc);
+                                gen_alloc_regloc(list,destloc,vardef);
                                 cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reglo,4);
                                 unget_para(paraloc^.next^);
                                 cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reghi,4);
@@ -1006,7 +1017,7 @@ implementation
                       end;
                     LOC_REFERENCE:
                       begin
-                        gen_alloc_regloc(list,destloc);
+                        gen_alloc_regloc(list,destloc,vardef);
                         reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset,para.alignment);
                         cg64.a_load64_ref_reg(list,href,destloc.register64);
                         unget_para(paraloc^);
@@ -1024,7 +1035,7 @@ implementation
                         (para.Size in [OS_PAIR,OS_SPAIR]) then
                         begin
                           unget_para(paraloc^);
-                          gen_alloc_regloc(list,destloc);
+                          gen_alloc_regloc(list,destloc,vardef);
                           cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^,destloc.register,sizeof(aint));
                           unget_para(paraloc^.Next^);
                           {$if defined(cpu16bitalu) or defined(cpu8bitalu)}
@@ -1038,7 +1049,7 @@ implementation
                         (para.Size in [OS_32,OS_S32]) then
                         begin
                           unget_para(paraloc^);
-                          gen_alloc_regloc(list,destloc);
+                          gen_alloc_regloc(list,destloc,vardef);
                           cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^,destloc.register,sizeof(aint));
                           unget_para(paraloc^.Next^);
                           cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^,GetNextReg(destloc.register),sizeof(aint));
@@ -1063,7 +1074,7 @@ implementation
                           { store everything first to memory, then load it in
                             destloc }
                           tg.gettemp(list,sizeleft,sizeleft,tt_persistent,tempref);
-                          gen_alloc_regloc(list,destloc);
+                          gen_alloc_regloc(list,destloc,vardef);
                           while sizeleft>0 do
                             begin
                               if not assigned(paraloc) then
@@ -1085,7 +1096,7 @@ implementation
                   else
                     begin
                       unget_para(paraloc^);
-                      gen_alloc_regloc(list,destloc);
+                      gen_alloc_regloc(list,destloc,vardef);
                       { we can't directly move regular registers into fpu
                         registers }
                       if getregtype(paraloc^.register)=R_FPUREGISTER then
@@ -1110,13 +1121,13 @@ implementation
                  (paraloc^.Loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER,LOC_REFERENCE,LOC_CREFERENCE]) then
                 begin
                   unget_para(paraloc^);
-                  gen_alloc_regloc(list,destloc);
+                  gen_alloc_regloc(list,destloc,vardef);
                   cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,para.alignment);
                 end
               else if (destloc.size = OS_F32) and
                  (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then
                 begin
-                  gen_alloc_regloc(list,destloc);
+                  gen_alloc_regloc(list,destloc,vardef);
                   unget_para(paraloc^);
                   list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.register,destloc.register));
                 end
@@ -1126,7 +1137,7 @@ implementation
                       (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) and
                       (paraloc^.next^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then
                 begin
-                  gen_alloc_regloc(list,destloc);
+                  gen_alloc_regloc(list,destloc,vardef);
 
                   tmpreg:=destloc.register;
                   unget_para(paraloc^);
@@ -1149,7 +1160,7 @@ implementation
                       dec(sizeleft,TCGSize2Size[paraloc^.size]);
                       paraloc:=paraloc^.next;
                     end;
-                  gen_alloc_regloc(list,destloc);
+                  gen_alloc_regloc(list,destloc,vardef);
                   cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register);
                   tg.UnGetTemp(list,tempref);
                 end;
@@ -1168,12 +1179,12 @@ implementation
                   dec(sizeleft,TCGSize2Size[paraloc^.size]);
                   paraloc:=paraloc^.next;
                 end;
-              gen_alloc_regloc(list,destloc);
+              gen_alloc_regloc(list,destloc,vardef);
               cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register);
               tg.UnGetTemp(list,tempref);
 {$else defined(sparc) or defined(arm)}
               unget_para(paraloc^);
-              gen_alloc_regloc(list,destloc);
+              gen_alloc_regloc(list,destloc,vardef);
               { from register to register -> alignment is irrelevant }
               cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0);
               if assigned(paraloc^.next) then
@@ -1209,7 +1220,7 @@ implementation
                   { don't free before the above, because then the getintregister
                     could reallocate this register and overwrite it }
                   unget_para(paraloc^);
-                  gen_alloc_regloc(list,destloc);
+                  gen_alloc_regloc(list,destloc,vardef);
                   if (target_info.endian=endian_big) then
                     { paraloc^ -> high
                       paraloc^.next -> low }
@@ -1224,7 +1235,7 @@ implementation
                   if not assigned(paraloc^.next) then
                     begin
                       unget_para(paraloc^);
-                      gen_alloc_regloc(list,destloc);
+                      gen_alloc_regloc(list,destloc,vardef);
                       { from register to register -> alignment is irrelevant }
                       cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0);
                     end
@@ -1706,7 +1717,10 @@ implementation
               end
             else
 {$endif}
-              rv.intregvars.addnodup(getsupreg(location.register));
+              if getregtype(location.register)=R_INTREGISTER then
+                rv.intregvars.addnodup(getsupreg(location.register))
+              else
+                rv.addrregvars.addnodup(getsupreg(location.register));
           LOC_CFPUREGISTER:
             rv.fpuregvars.addnodup(getsupreg(location.register));
           LOC_CMMREGISTER:
@@ -1801,6 +1815,8 @@ implementation
       begin
         for count := 1 to rv.intregvars.length do
           cg.a_reg_sync(list,newreg(R_INTREGISTER,rv.intregvars.readidx(count-1),R_SUBWHOLE));
+        for count := 1 to rv.addrregvars.length do
+          cg.a_reg_sync(list,newreg(R_ADDRESSREGISTER,rv.addrregvars.readidx(count-1),R_SUBWHOLE));
         for count := 1 to rv.fpuregvars.length do
           cg.a_reg_sync(list,newreg(R_FPUREGISTER,rv.fpuregvars.readidx(count-1),R_SUBWHOLE));
         for count := 1 to rv.mmregvars.length do

compiler/objcasm.pas

@@ -29,7 +29,14 @@ unit objcasm;
   uses
     aasmbase;
 
+{ Workaround for mantis #29906: bug in PPC jump table generation if a jump
+  table is created for a case-statement that handles at least the lowest
+  and highest possible value of the case expression type }
+{$ifndef VER3_0_0}
   function objc_section_name(sec: TObjCAsmSectionType): string;
+{$else}
+  function objc_section_name(sec: TAsmSectionType): string;
+{$endif}
 
 implementation
 
@@ -37,7 +44,11 @@ implementation
     verbose,
     systems;
 
+{$ifndef VER3_0_0}
   function objc_section_name(sec: TObjCAsmSectionType): string;
+{$else}
+  function objc_section_name(sec: TAsmSectionType): string;
+{$endif}
     begin
       result:='';
       if target_info.system in systems_darwin then

compiler/options.pas

@@ -3914,6 +3914,13 @@ begin
   { now we can define cpu and fpu type }
   def_system_macro('CPU'+Cputypestr[init_settings.cputype]);
 
+  { Use init_settings cpu type for asm cpu type,
+    if asmcputype is cpu_none,
+    at least as long as there is no explicit 
+    option to set it on command line PM }
+  if init_settings.asmcputype = cpu_none then
+    init_settings.asmcputype:=init_settings.cputype;
+
   def_system_macro('FPU'+fputypestr[init_settings.fputype]);
 
 {$ifdef llvm}

compiler/ppcgen/ngppcset.pas

@@ -75,7 +75,6 @@ implementation
         last : TConstExprInt;
         indexreg : tregister;
         href : treference;
-        mulfactor: longint;
 
         procedure genitem(list:TAsmList;t : pcaselabel);
           var
@@ -108,30 +107,28 @@ implementation
         indexreg:= cg.makeregsize(current_asmdata.CurrAsmList, hregister, OS_INT);
         { indexreg := hregister; }
         cg.a_load_reg_reg(current_asmdata.CurrAsmList, def_cgsize(opsize), OS_INT, hregister, indexreg);
+        { a <= x <= b <-> unsigned(x-a) <= (b-a) }
+        cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,aint(min_),indexreg);
         if not(jumptable_no_range) then
           begin
-             { use aword(value-min)<aword(max-min) instead of two comparisons }
-             { case expr outside min_ .. max_ => goto elselabel               }
-             cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,aint(min_),indexreg);
-             { this trick requires an unsigned comparison in all cases }
+             { case expr greater than max_ => goto elselabel }
              cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_A,aint(max_)-aint(min_),indexreg,elselabel);
-             { already taken into account now }
-             min_:=0;
           end;
         current_asmdata.getjumplabel(table);
         { create reference, indexreg := indexreg * sizeof(jtentry) (= 4) }
-        mulfactor:=4;
-        cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_MUL, OS_INT, mulfactor, indexreg);
-        reference_reset_symbol(href, table, (-aint(min_)) * mulfactor, 4);
+        cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_MUL, OS_INT, 4, indexreg);
+        reference_reset_symbol(href, table, 0, 4);
 
         hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
         cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,hregister);
         reference_reset_base(href,hregister,0,4);
         href.index:=indexreg;
         indexreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
+        { load table entry }
         cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_S32,OS_ADDR,href,indexreg);
+        { add table base }
         cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_ADD,OS_ADDR,hregister,indexreg);
-
+        { jump }
         current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_MTCTR, indexreg));
         current_asmdata.CurrAsmList.concat(taicpu.op_none(A_BCTR));
 

compiler/systems/i_amiga.pas

@@ -97,7 +97,7 @@ unit i_amiga;
             system       : system_powerpc_Amiga;
             name         : 'AmigaOS for PowerPC';
             shortname    : 'amiga';
-            flags        : [tf_files_case_aware];
+            flags        : [tf_files_case_aware,tf_has_winlike_resources];
             cpu          : cpu_powerpc;
             unit_env     : 'AMIGAUNITS';
             extradefines : 'PPC603;HASAMIGA;AMIGAOS4';
@@ -129,7 +129,7 @@ unit i_amiga;
             link         : ld_none;
             linkextern   : ld_amiga;
             ar           : ar_gnu_ar;
-            res          : res_none;
+            res          : res_elf;
             dbg          : dbg_stabs;
             script       : script_amiga;
             endian       : endian_big;

compiler/x86/x86ins.dat

@@ -3522,22 +3522,22 @@ xmmreg,xmmrm                         \361\362\371\1\xDB\110               AVX,SA
 xmmreg,xmmrm,imm8                    \361\362\372\1\xDF\110\26            AVX,SANDYBRIDGE
 
 [VANDNPD]
-(Ch_All, Ch_None, Ch_None)
+(Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg,xmmreg,xmmrm                  \361\362\370\1\x55\75\120            AVX,SANDYBRIDGE
 ymmreg,ymmreg,ymmrm                  \361\362\364\370\1\x55\75\120        AVX,SANDYBRIDGE
 
 [VANDNPS]
-(Ch_All, Ch_None, Ch_None)
+(Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg,xmmreg,xmmrm                  \362\370\1\x55\75\120                AVX,SANDYBRIDGE
 ymmreg,ymmreg,ymmrm                  \362\364\370\1\x55\75\120            AVX,SANDYBRIDGE
 
 [VANDPD]
-(Ch_All, Ch_None, Ch_None)
+(Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg,xmmreg,xmmrm                  \361\362\370\1\x54\75\120            AVX,SANDYBRIDGE
 ymmreg,ymmreg,ymmrm                  \361\362\364\370\1\x54\75\120        AVX,SANDYBRIDGE
 
 [VANDPS]
-(Ch_All, Ch_None, Ch_None)
+(Ch_Wop3, Ch_Rop2, Ch_Rop1)
 xmmreg,xmmreg,xmmrm                  \362\370\1\x54\75\120                AVX,SANDYBRIDGE
 ymmreg,ymmreg,ymmrm                  \362\364\370\1\x54\75\120            AVX,SANDYBRIDGE
 

compiler/x86_64/x8664pro.inc

@@ -677,10 +677,10 @@
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
+(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
+(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
+(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),

packages/Makefile

@@ -1,11 +1,11 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-09-05 rev 31523]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-08-12 rev 31317]
 #
 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 i8086-win16 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 aarch64-linux aarch64-darwin
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
-LIMIT83fs = go32v2 os2 emx watcom msdos win16
+LIMIT83fs = go32v2 os2 emx watcom msdos
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
@@ -762,12 +762,6 @@ 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)
@@ -1260,9 +1254,6 @@ 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/Makefile.fpc.fpcmake

@@ -7,7 +7,7 @@ name=ami-extra
 version=3.1.1
 
 [target]
-units=cliputils
+units=cliputils pcq
 
 [compiler]
 includedir=src

packages/ami-extra/fpmake.pp

@@ -21,7 +21,10 @@ begin
 
     P.Dependencies.Add('morphunits',[morphos]);
     P.Dependencies.Add('arosunits',[aros]);
-    P.Dependencies.Add('amunits',[amiga]);
+    if Defaults.CPU=m68k then
+      P.Dependencies.Add('amunits',[amiga]);
+    if Defaults.CPU=powerpc then
+      P.Dependencies.Add('os4units',[amiga]);
 
 {$ifdef ALLPACKAGES}
     P.Directory:=ADirectory;
@@ -32,6 +35,7 @@ begin
     P.OSes:=AllAmigaLikeOSes;
 
     T:=P.Targets.AddUnit('cliputils.pas');
+    T:=P.Targets.AddUnit('pcq.pas');
 
 {$ifndef ALLPACKAGES}
     Run;

packages/amunits/src/utilunits/pcq.pas → packages/ami-extra/src/pcq.pas

@@ -14,11 +14,6 @@
 
  **********************************************************************}
 
-{$I useamigasmartlink.inc}
-{$ifdef use_amiga_smartlink}
-    {$smartlink on}
-{$endif use_amiga_smartlink}
-
 unit pcq;
 
 {

packages/amunits/Makefile.fpc.fpcmake

@@ -8,7 +8,7 @@ version=3.1.1
 
 [target]
 units= amsgbox amigautils wbargs vartags pastoc tagsarray deadkeys \
-       deadkeys consoleio pcq linklist hisoft exec timerutils easyasl \
+       deadkeys consoleio linklist hisoft exec timerutils easyasl \
        doublebuffer intuition agraphics amigalib nonvolatile iffparse hardware  \
        expansion diskfont conunit amigados configvars keyboard bootblock icon  \
        cd realtime rexx translator scsidisk lowlevel configregs prefs parallel \

packages/amunits/examples/asltest.pas

@@ -1,6 +1,6 @@
 PROGRAM AslTest;
 
-uses Exec, Utility, Asl, amsgbox, systemvartags;
+uses Exec, Utility, Asl, amsgbox;
 
 
 {
@@ -26,13 +26,13 @@ VAR
 BEGIN
 
     fr := AllocAslRequestTags(ASL_FileRequest,[
-                          ASLFR_InitialPattern,'#?',
-                          ASLFR_TitleText,'Test av ASL-Requester by NS',
-                          ASLFR_DoPatterns,ltrue,
+                          ASLFR_InitialPattern, AsTag('#?'),
+                          ASLFR_TitleText, AsTag('Test av ASL-Requester by NS'),
+                          ASLFR_DoPatterns, LTrue,
                           TAG_DONE]);
 
     IF fr <> nil THEN BEGIN
-        dummy := AslRequest(fr,NIL) <> LFALSE;
+        dummy := AslRequest(fr,NIL);
         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, systemvartags;
+uses exec, intuition, agraphics, utility;
 
 type
     PointRec = packed Record
@@ -221,10 +221,11 @@ end;
 
 begin
 
-   s := OpenScreenTags(nil,[SA_Pens,@pens,
-      SA_Depth,     2,
-      SA_DisplayID, HIRES_KEY,
-      SA_Title,     'Simple Bezier Curves',
+   s := OpenScreenTags(nil,[
+      AsTag(SA_Pens), AsTag(@pens),
+      AsTag(SA_Depth),     2,
+      AsTag(SA_DisplayID), HIRES_KEY,
+      AsTag(SA_Title),     AsTag('Simple Bezier Curves'),
       TAG_END]);
 
     if s = NIL then CleanUpAndDie;
@@ -241,8 +242,8 @@ begin
       WA_ReportMouse,  ltrue,
       WA_SmartRefresh, ltrue,
       WA_Activate,     ltrue,
-      WA_Title,        'Close the Window to Quit',
-      WA_CustomScreen, s,
+      WA_Title,        AsTag('Close the Window to Quit'),
+      WA_CustomScreen, AsTag(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, systemvartags;
+uses exec, intuition, agraphics, utility;
 
 type
     PointRec = Record
@@ -242,11 +242,12 @@ begin
 end;
 
 begin
-      s := OpenScreenTags(nil,[SA_Pens, @pens,
-      SA_Depth,     2,
-      SA_DisplayID, HIRES_KEY,
-      SA_Title,     'Simple Bezier Curves',
-      TAG_END]);
+      s := OpenScreenTags(nil,[
+        SA_Pens, AsTag(@pens),
+        SA_Depth,     2,
+        SA_DisplayID, HIRES_KEY,
+        SA_Title,     AsTag('Simple Bezier Curves'),
+        TAG_END]);
 
     if s = NIL then CleanUpAndDie;
 
@@ -262,8 +263,8 @@ begin
       WA_ReportMouse,  ltrue,
       WA_SmartRefresh, ltrue,
       WA_Activate,     ltrue,
-      WA_Title,        'Close the Window to Quit',
-      WA_CustomScreen, s,
+      WA_Title,        AsTag('Close the Window to Quit'),
+      WA_CustomScreen, AsTag(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( AllocMem( SizeOf(tInfoData), MEMF_PUBLIC ) );
+  Inf:=pInfoData(ExecAllocMem( 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,pastoc, amigalib;
+uses Amigados, exec, strings, linklist, amigalib;
 
 CONST BufferSize = 2048;
       CSI      = chr($9b);
@@ -26,7 +26,7 @@ VAR ExData       : pExAllData;
     Buffer       : PChar;
     i,temp       : longint;
     TotalSize    : longint;
-    TheDir       : string;
+    TheDir       : AnsiString;
 
 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 := AllocMem(BufferSize,0);
+    ExData := ExecAllocMem(BufferSize,0);
     EAC^.eac_LastKey := 0;
     EAC^.eac_MatchString := NIL;
     EAC^.eac_MatchFunc := NIL;
-    MyLock:=Lock(pas2c(TheDir),SHARED_LOCK);
+    MyLock:=Lock(PChar(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,[long(GetNodeData(tempnode))]);
+        printf('%-30s  <DIR>'#10,[PtrUInt(GetNodeData(tempnode))]);
         tempnode := GetNextNode(tempnode);
     END;
     Write(CSI, '0m');
     tempnode := GetFirstNode(FileList);
     FOR i := 1 TO NodesInList(FileList) DO BEGIN
-        printf('%-30s%7ld'#10 ,[long(GetNodeData(tempnode)),tempnode^.ln_Size]);
+        printf('%-30s%7ld'#10 ,[PtrUInt(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, pastoc,systemvartags;
+USES Intuition, Exec, AGraphics, GadTools, Utility;
 
 CONST
 
@@ -90,16 +90,16 @@ begin
    ButtonGadget := gad;
 end;
 
-function ButtonGadget(id,left,top,width,height:word; txt: string): pGadget;
+function ButtonGadget(id,left,top,width,height:word; txt: AnsiString): pGadget;
 begin
-   ButtonGadget := ButtonGadget(id,left,top,width,height,pas2c(txt));
+   ButtonGadget := ButtonGadget(id,left,top,width,height,PChar(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,[
-                                         GTCY_Labels,thearr,
+                                         AsTag(GTCY_Labels), AsTag(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, glist,
-                WA_Title, 'Test of EasyGadtools',
-                WA_Left,100,
-                WA_Top,100,
+                WA_Gadgets, AsTag(glist),
+                WA_Title,   AsTag('Test of EasyGadtools'),
+                WA_Left,    AsTag(100),
+                WA_Top,     AsTag(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,7 +46,6 @@ Begin
       ('O') : tmp := tmp + strpas(Month);
       ('Y') : tmp := tmp + strpas(Year);
      end;
-     i:=i+1;
     end
    else
     tmp := tmp + Str[i];
@@ -104,7 +103,7 @@ begin
  DT.dat_StrDay:=WeekDay;
  DT.dat_StrDate:=Date;
  DT.dat_StrTime:=Time;
- If DateToStr(@DT) then begin
+ If DOSDateToStr(@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, systemvartags;
+uses Exec, Intuition, Utility, GadTools;
 
 
 
@@ -130,7 +130,7 @@ begin
                              WA_Activate,    ltrue,
                              WA_Height, 100,
                              WA_CloseGadget, ltrue,
-                             WA_Title,  'Menu Test Window',
+                             WA_Title,  AsTag('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, systemvartags,pastoc;
+USES Intuition, Exec, AGraphics, GadTools, Utility;
 
 
 CONST
@@ -361,8 +361,8 @@ BEGIN
   g^.SelectRender := @selecti;
 
   wp := OpenWindowTags(NIL,[
-                WA_Gadgets,gl,
-                WA_Title, 'Images in Gadgets',
+                WA_Gadgets, AsTag(gl),
+                WA_Title, AsTag('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,pas2c('You have clicked on the Gadget!'),pas2c('Wheeew!'));
+             i := EasyReq(wp,WIN_TITLE, 'You have clicked on the Gadget!', '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, systemvartags;
+uses Exec, Intuition, AGraphics, Utility;
 
 
 const
@@ -81,10 +81,10 @@ begin
 
 
     s := OpenScreenTags(NIL, [
-    SA_Pens,      @pens,
+    SA_Pens,      AsTag(@pens),
     SA_Depth,     2,
     SA_DisplayID, HIRES_KEY,
-    SA_Title,     'Close the Window to End This Demonstration',
+    SA_Title,     AsTag('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,        'Feel Free to Re-Size the Window',
-    WA_CustomScreen, s,
+    WA_Title,        AsTag('Feel Free to Re-Size the Window'),
+    WA_CustomScreen, AsTag(s),
     TAG_END]);
 
     IF w <> NIL THEN begin

packages/amunits/examples/otherlibs/amarqueetest.pas

@@ -21,11 +21,15 @@ 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,
-                                                                @errid,TAG_DONE]);
+                                                                AsTag(@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,6 +47,11 @@ 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,10 +29,14 @@ begin
 end;
 
 begin
-
-     App := TR_CreateAppTags([TRCA_Name,'Triton CheckBox',
-                              TRCA_Release,'1.0',
-                              TRCA_Date,'03-06-1998',
+  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'),
                               TAG_DONE]);
 
      if App = nil then CleanUp('Can''t create application',20);
@@ -65,16 +69,18 @@ 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('~'); WindowID(1);
+    WindowTitle('Groups'); WindowPosition(TRWP_CENTERDISPLAY); WindowUnderscore(string('~')); 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, appwindow_project,
-                                                     TREZ_Title,'AppWindow report',
+                                                     TREZ_LockProject, AsTag(appwindow_project),
+                                                     TREZ_Title, AsTag('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,Main_Project,
-                                                TREZ_Title,'Triton help',
+                                                TREZ_LockProject, AsTag(Main_Project),
+                                                TREZ_Title, AsTag('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,Main_Project,
-                                                     TREZ_Title,'Triton help',
+                                                     TREZ_LockProject, AsTag(Main_Project),
+                                                     TREZ_Title, AsTag('Triton help'),
                                                      TAG_END]);
                                     END;
                  TRMS_ERROR:        WriteLN(TR_GetErrorString(trmsg^.trm_Data));
@@ -1136,11 +1136,16 @@ BEGIN
 END;
 
 BEGIN
+  if not Assigned(TritonBase) then
+  begin
+    writeln('cannot open ' + TRITONNAME);
+    Halt(5);
+  end;
 
     App := TR_CreateAppTags([
-              TRCA_Name,'TritonDemo',
-              TRCA_LongName,'Triton Demo',
-              TRCA_Version,'2.0',
+              TRCA_Name, AsTag('TritonDemo'),
+              TRCA_LongName, AsTag('Triton Demo'),
+              TRCA_Version, AsTag('2.0'),
               TAG_DONE]);
 
     if App <> nil then begin

packages/amunits/examples/otherlibs/envprint.pas

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

packages/amunits/examples/otherlibs/gadgetdemo.pas

@@ -73,19 +73,23 @@ 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,'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',
+                     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'),
                      TAG_DONE]);
 
     if Triton_App = NIL then CleanExit('Can''t create application',20);

packages/amunits/examples/otherlibs/gttest.pas

@@ -42,6 +42,11 @@ 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,
@@ -50,26 +55,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,'Main Group',
+                   LA_LabelText, AsTag('Main Group'),
                    TAG_DONE]);
 
     LT_New(handle,[LA_Type,BUTTON_KIND,         { A plain button. }
-                   LA_LabelText,'A button',
+                   LA_LabelText, AsTag('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,'Another button',
+                   LA_LabelText, AsTag('Another button'),
                    LA_ID,22,
                    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,CHECKBOX_KIND,LA_LabelText,AsTag('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,'Window title',
+    win := LT_Build(handle,[LAWN_Title, AsTag('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,Project,
-                            TREZ_Title,'Delete this file?',
+                            TREZ_LockProject, AsTag(Project),
+                            TREZ_Title, AsTag('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,Project,
-                                      TREZ_Title,'Delete all?',
+                                      TREZ_LockProject, AsTag(Project),
+                                      TREZ_Title, AsTag('Delete all?'),
                                       TREZ_Activate,1,
                                       TAG_END]);
    IF dummy = 1 THEN BEGIN
@@ -255,13 +255,18 @@ END;
 
 
 BEGIN  { Main }
+  if not Assigned(TritonBase) then
+  begin
+    writeln('cannot open ' + TRITONNAME);
+    Halt(5);
+  end;
         Triton_App := TR_CreateAppTags([
-                       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',
+                       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'),
                        TAG_END]);
         if Triton_App <> nil then begin
         path := @pdummy;

packages/amunits/examples/otherlibs/listview.pas

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

packages/amunits/examples/otherlibs/modelist.pas

@@ -31,6 +31,11 @@ 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,6 +38,11 @@ Var
     rda             :   pRDArgs;
 
 Begin
+  if not Assigned(P96Base) then
+  begin
+    writeln('Cannot open ', PICASSO96APINAME);
+    Halt(5);
+  end;
     width := 256;
     height := 256;
     StrCopy(@PubScreenName,WB);
@@ -54,7 +59,7 @@ Begin
     wd := p96PIP_OpenTags([P96PIP_SourceFormat, long(RGBFB_R5G5B5),
                            P96PIP_SourceWidth,256,
                            P96PIP_SourceHeight,256,
-                           WA_Title,'Picasso96 API PIP Test',
+                           WA_Title, AsTag('Picasso96 API PIP Test'),
                            WA_Activate,lTRUE,
                            WA_RMBTrap,lTRUE,
                            WA_Width,Width,
@@ -65,14 +70,14 @@ Begin
                            WA_SizeGadget,lTRUE,
                            WA_CloseGadget,lTRUE,
                            WA_IDCMP,IDCMP_CLOSEWINDOW,
-                           WA_PubScreenName,@PubScreenName,
+                           WA_PubScreenName, AsTag(@PubScreenName),
                            TAG_DONE]);
 
     If wd <> Nil Then Begin
         goahead:=True;
         rp:=Nil;
 
-        p96PIP_GetTags(wd,[P96PIP_SourceRPort, @rp, TAG_END]);
+        p96PIP_GetTags(wd,[P96PIP_SourceRPort, AsTag(@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,systemvartags;
+uses exec, amigados, agraphics, intuition, picasso96api, utility;
 
 Const
 
@@ -61,6 +61,11 @@ begin
 end;
 
 BEGIN
+  if not Assigned(P96Base) then
+  begin
+    writeln('Cannot open ', PICASSO96APINAME);
+    Halt(5);
+  end;
     Width:=640;
     Height:=480;
     Depth:=8;
@@ -77,8 +82,8 @@ BEGIN
                            P96SA_Height, Height,
                            P96SA_Depth, Depth,
                            P96SA_AutoScroll, lTRUE,
-                           P96SA_Pens, @Pens,
-                           P96SA_Title, ScreenTitle,
+                           P96SA_Pens, AsTag(@Pens),
+                           P96SA_Title, AsTag(ScreenTitle),
                            TAG_DONE]);
 
 
@@ -89,11 +94,11 @@ BEGIN
     Dimensions[2]:=sc^.Width;
     Dimensions[3]:=sc^.Height-sc^.BarHeight-1;
 
-    wdp:=OpenWindowTags(NIL,[WA_CustomScreen, sc,
-                             WA_Title,'Writepixel',
+    wdp:=OpenWindowTags(NIL,[WA_CustomScreen, AsTag(sc),
+                             WA_Title, AsTag('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, @Dimensions,
+                             WA_Zoom, AsTag(@Dimensions),
                              WA_Width, 200,
                              WA_Height, 300,
                              WA_MinWidth, 100,
@@ -109,17 +114,17 @@ BEGIN
                              WA_SizeGadget, lTRUE,
                              WA_SizeBBottom, lTRUE,
                              WA_GimmeZeroZero, lTRUE,
-                             WA_ScreenTitle,ScreenTitle,
+                             WA_ScreenTitle, AsTag(ScreenTitle),
                              WA_IDCMP, IDCMP_RAWKEY + IDCMP_CLOSEWINDOW,
                              TAG_DONE]);
 
     If wdp = Nil Then CleanUp('Unable to open window 1.');
 
-    wdf:=OpenWindowTags(NIL,[WA_CustomScreen,sc,
-                             WA_Title, 'FillRect',
+    wdf:=OpenWindowTags(NIL,[WA_CustomScreen, PtrUInt(sc),
+                             WA_Title, PtrUInt(PChar('FillRect')),
                              WA_Left,(sc^.Width div 2-200) div 2,
                              WA_Top,(sc^.Height-sc^.BarHeight-300)div 2,
-                             WA_Zoom, @Dimensions,
+                             WA_Zoom, PtrUInt(@Dimensions),
                              WA_Width, 200,
                              WA_Height, 300,
                              WA_MinWidth, 100,
@@ -135,7 +140,7 @@ BEGIN
                              WA_SizeGadget, lTRUE,
                              WA_SizeBBottom, lTRUE,
                              WA_GimmeZeroZero, lTRUE,
-                             WA_ScreenTitle, ScreenTitle,
+                             WA_ScreenTitle, PtrUInt(PChar(ScreenTitle)),
                              WA_IDCMP, IDCMP_RAWKEY or IDCMP_CLOSEWINDOW,
                              TAG_DONE]);
 

packages/amunits/examples/otherlibs/p96checkboards.pas

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

packages/amunits/examples/otherlibs/palette.pas

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

packages/amunits/examples/otherlibs/progindex.pas

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

packages/amunits/examples/otherlibs/requestmodeid.pas

@@ -34,6 +34,11 @@ Var
 
 
 Begin
+  if not Assigned(P96Base) then
+  begin
+    writeln('Cannot open ', PICASSO96APINAME);
+    Halt(5);
+  end;
     width:=640;
     height:=480;
     depth:=15;
@@ -49,7 +54,7 @@ Begin
     DisplayID := p96RequestModeIDTags([P96MA_MinWidth, width,
                                        P96MA_MinHeight, height,
                                        P96MA_MinDepth, depth,
-                                       P96MA_WindowTitle, 'RequestModeID Test',
+                                       P96MA_WindowTitle, AsTag('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,longarray;
+uses reqtools, strings, utility, exec, amigados;
 
 
 
@@ -45,6 +45,7 @@ VAR
     ret             : Longint;
     color           : Longint;
     undertag        : Array [0..1] of tTagItem;
+    Param           : array of PtrUInt;
 
 FUNCTION GetScrollValue(value : INTEGER): STRING;
 BEGIN
@@ -61,6 +62,11 @@ BEGIN
 END;
 
 BEGIN
+  if not Assigned(ReqToolsBase) then
+  begin
+    writeln('Cannot open ', REQTOOLSNAME);
+    Halt(5);
+  end;
     dummy:= StrAlloc(400);
     dummy2 := StrAlloc(200);
 
@@ -88,14 +94,13 @@ 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,
-        readinlongs([buffer]),NIL);
+        rtEZRequestA('You entered this string:' + #10 + '%s','So I did', NIL, @buffer, NIL);
 
     ret := rtGetString(buffer, 127, 'Enter anything:', NIL,[
-                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]);
+                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)]);
 
 
 
@@ -104,15 +109,15 @@ BEGIN
                        'Oh boy!',NIL,NIL,NIL);
 
     ret := rtGetString(buffer, 127, 'Enter anything:',NIL,[
-                        RTGS_GadFmt,' _Ok | _Abort |_Cancel',
-                        RTGS_TextFmt,'New is also the ability to switch off the' + #10 +
+                        RTGS_GadFmt, AsTag(' _Ok | _Abort |_Cancel'),
+                        RTGS_TextFmt, AsTag('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, FALSE,
+                        'the rtGetLong() requester.'),
+                        RTGS_BackFill, LFALSE,
                         RTGS_Flags, GSREQF_CENTERTEXT + GSREQF_HIGHLIGHTTEXT,
-                        TAG_MORE, @undertag]);
+                        TAG_MORE, AsTag(@undertag)]);
 
     IF ret = 2 THEN
         rtEZRequestA('What!! You pressed abort!?!' + #10 + 'You must be joking :-)',
@@ -122,7 +127,7 @@ BEGIN
                      'Show me', NIL, NIL, NIL);
 
     ret := rtGetLong(longnum, 'Enter a number:',NIL,[
-                      RTGL_ShowDefault, FALSE,
+                      RTGL_ShowDefault, LFALSE,
                       RTGL_Min, 0,
                       RTGL_Max, 666,
                       TAG_DONE]);
@@ -131,7 +136,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, readinlongs([longnum]), NIL);
+                     'So it was', NIL, @longnum, NIL);
 
     rtEZRequestA ('NUMBER 3:' + #10 + 'Notification requester, the requester' + #10 +
                          'you''ve been using all the time!' + #10 +
@@ -176,7 +181,7 @@ BEGIN
                             RTEZ_DefaultResponse, 4,
                             TAG_DONE]);
 
-    rtEZRequestA('You picked ''%ld''.', 'How true', NIL, readinlongs([ret]),NIL);
+    rtEZRequestA('You picked ''%ld''.', 'How true', NIL, @ret, NIL);
 
     {
       If i used just a string for this text is will be truncated
@@ -202,20 +207,22 @@ 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,readinlongs([5,'five']),@undertag);
+                        '_Proceed',NIL, @Param, @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,@undertag]);
+                        TAG_MORE, AsTag(@undertag)]);
 
     IF ((ret = DISKINSERTED)) THEN
         rtEZRequestA('You inserted a disk.', 'I did', NIL, NIL, NIL)
@@ -229,14 +236,14 @@ BEGIN
                         'This works for all requesters, not just rtEZRequest()!',
                         '_Amazing', NIL,NIL,[
                         RT_ReqPos, REQPOS_TOPLEFTSCR,
-                        TAG_MORE,@undertag]);
+                        TAG_MORE, AsTag(@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,@undertag]);
+                        TAG_MORE, AsTag(@undertag)]);
 
 
     ret := rtEZRequestA('NUMBER 4:' + #10 + 'File requester' + #10 + 'function: rtFileRequest()',
@@ -253,9 +260,11 @@ 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, readinlongs([
-                                                          filename,filereq^.Dir]),NIL);
+                                + #10 + '%s', 'Right', NIL, @Param, NIL);
         END
         ELSE
             rtEZRequestA('You didn''t pick a file.', 'No', NIL, NIL, NIL);
@@ -276,7 +285,7 @@ BEGIN
                           '"%s"' + #10 +
                           'All the files are returned as a linked' + #10 +
                           'list (see demo.c and reqtools.h).',
-                          'Aha', NIL, readinlongs([filelist^.Name]),NIL);
+                          'Aha', NIL, @(filelist^.Name),NIL);
             (* Traverse all selected files *)
             (*
             tempflist = flist;
@@ -305,7 +314,7 @@ BEGIN
 
          IF(ret=1) THEN begin
              rtEZRequestA('You picked the directory:' + #10 +'%s',
-                          'Right', NIL, readinlongs([filereq^.Dir]), NIL);
+                          'Right', NIL, @(filereq^.Dir), NIL);
          end ELSE
              rtEZRequestA('You didn''t pick a directory.', 'No', NIL, NIL, NIL);
 
@@ -322,10 +331,12 @@ 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, readinlongs([fontreq^.Attr.ta_Name,
-                                                    fontreq^.Attr.ta_YSize]),NIL);
+                         'Right', NIL, @Param, NIL);
          end ELSE
              ret := rtEZRequestA('You didn''t pick a font','I know', NIL, NIL, NIL);
          rtFreeRequest(fontreq);
@@ -342,7 +353,7 @@ BEGIN
                          'Nah', NIL, NIL, NIL)
     ELSE begin
         rtEZRequestA('You picked color number %ld.', 'Sure did',
-                         NIL, readinlongs([color]), NIL);
+                         NIL, @color, NIL);
     END;
 
     rtEZRequestA('NUMBER 7: (ReqTools 2.0)' + #10 +
@@ -359,7 +370,7 @@ BEGIN
                                       TAG_END]));
         IF (ret = 1) THEN begin
             rtEZRequestA('You picked the volume:' + #10 + '%s',
-                        'Right',NIL,readinlongs([filereq^.Dir]),NIL);
+                        'Right',NIL, @filereq^.Dir,NIL);
         end
         ELSE
             rtEZRequestA('You didn''t pick a volume.','I did not',NIL,NIL,NIL);
@@ -383,6 +394,13 @@ 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 +
@@ -390,12 +408,7 @@ BEGIN
                          'Overscan: %ld' + #10 +
                          'AutoScroll %s',
                          'Right', NIL,
-                         readinlongs([scrnreq^.DisplayID,
-                                      scrnreq^.DisplayWidth,
-                                      scrnreq^.DisplayHeight,
-                                      scrnreq^.DisplayDepth,
-                                      scrnreq^.OverscanType,
-                                      GetScrollValue(scrnreq^.AutoScroll)]),NIL);
+                         @Param,NIL);
         END
         ELSE
             rtEZRequestA('You didn''t pick a screen mode.', 'Sorry', NIL, NIL, NIL);

packages/amunits/examples/otherlibs/scroller.pas

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

packages/amunits/examples/otherlibs/slider.pas

@@ -30,11 +30,15 @@ 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,' Triton Slider Demo' ,
-                     TRCA_Release,' 1.0' ,
-                     TRCA_Date,' 03-08-1998' ,
+                     TRCA_Name, AsTag(' Triton Slider Demo'),
+                     TRCA_Release, AsTag(' 1.0'),
+                     TRCA_Date, AsTag(' 03-08-1998'),
                      TAG_DONE]);
 
     if Triton_App <> nil then begin

packages/amunits/examples/otherlibs/smallplay.pas

@@ -18,20 +18,25 @@ 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);
 
@@ -43,7 +48,7 @@ begin
     PTPlay(module);
 
     SigMask := Wait(SIGBREAKF_CTRL_C or (1 shl SigBit));
-    if (SigMask and SIGBREAKF_CTRL_C) then
+    if (SigMask and SIGBREAKF_CTRL_C) <> 0 then
         PTFade(module,1)
     else
         PTStop(module);

packages/amunits/examples/otherlibs/string.pas

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

packages/amunits/examples/otherlibs/toolmanager1.pas

@@ -65,15 +65,20 @@ 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,'ToolManagerGUIDemo1',
-                               TRCA_LongName,'ToolManager GUI demo 1',
-                               TRCA_Info,'Looks like the original ToolManager',
+                               TRCA_Name, AsTag('ToolManagerGUIDemo1'),
+                               TRCA_LongName, AsTag('ToolManager GUI demo 1'),
+                               TRCA_Info, AsTag('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,15 +66,20 @@ 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,'ToolManagerGUIDemo2',
-                          TRCA_LongName,'ToolManager GUI demo 2',
-                          TRCA_Info,'Looks like the ToolManager demo 2 of GUIFront',
+                          TRCA_Name, AsTag('ToolManagerGUIDemo2'),
+                          TRCA_LongName, AsTag('ToolManager GUI demo 2'),
+                          TRCA_Info, AsTag('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,6 +67,11 @@ 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]);
@@ -74,9 +79,9 @@ begin
 
 
     Triton_App := TR_CreateAppTags([
-                               TRCA_Name,'ToolManagerGUIDemo3',
-                               TRCA_LongName,'ToolManager GUI demo 3',
-                               TRCA_Info,'My own creation for a ToolManager GUI',
+                               TRCA_Name, AsTag('ToolManagerGUIDemo3'),
+                               TRCA_LongName, AsTag('ToolManager GUI demo 3'),
+                               TRCA_Info, AsTag('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,14 +57,18 @@ END;
 
 
 begin
-
+  if not Assigned(TritonBase) then
+  begin
+    writeln('cannot open ' + TRITONNAME);
+    Halt(5);
+  end;
     Triton_App := TR_CreateAppTags([
-                     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',
+                     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'),
                      TAG_DONE]);
 
      if Triton_App = nil then CleanExit('Can''t create Application',20);
@@ -84,7 +88,7 @@ begin
                         Space;
                         SliderGadget(SLIDER_MIN,SLIDER_MAX,5,MYGAD_SLIDER);
                         Space;
-                        TextID('5',MYGAD_SLIDERTEXT); SetTRTag(TRAT_MinWidth, 2);
+                        TextID(string('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,systemvartags;
+uses exec, amigados, intuition, agraphics, picasso96api, utility;
 
 
 Const
@@ -65,7 +65,11 @@ begin
 end;
 
 Begin
-
+  if not Assigned(P96Base) then
+  begin
+    writeln('Cannot open ', PICASSO96APINAME);
+    Halt(5);
+  end;
  width:=640;
  height:=480;
  depth:=24;
@@ -91,8 +95,8 @@ Begin
                           P96SA_Height, height,
                           P96SA_Depth, depth,
                           P96SA_AutoScroll, lTRUE,
-                          P96SA_Pens, @Pens,
-                          P96SA_Title, 'WriteTrueColorData Test',
+                          P96SA_Pens, AsTag(@Pens),
+                          P96SA_Title, AsTag('WriteTrueColorData Test'),
                           TAG_DONE]);
 
 if sc = nil then CleanUp('Can''t open screen');
@@ -100,7 +104,7 @@ if sc = nil then CleanUp('Can''t open screen');
 
 
 
- win := OpenWindowTags(Nil,[WA_CustomScreen, sc,
+ win := OpenWindowTags(Nil,[WA_CustomScreen, AsTag(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,systemvartags;
+uses exec, agraphics, intuition, utility;
 
 VAR RP : pRastPort;
     Win : pWindow;
@@ -58,7 +58,7 @@ Begin
 
   Win:=OpenWindowTags(nil,[WA_Width,150,
                         WA_Height,100,
-                        WA_Title,'PenShare',
+                        WA_Title,AsTag('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,systemvartags;
+uses exec,intuition,agraphics,utility;
 
 
 
@@ -114,10 +114,10 @@ begin
     nc := readcycles();
     initarrays;
 
-    s := OpenScreenTags(nil, [SA_Pens,   @pens,
+    s := OpenScreenTags(nil, [SA_Pens,   AsTag(@pens),
       SA_Depth,     2,
       SA_DisplayID, HIRES_KEY,
-      SA_Title,     'Simple Fractal SnowFlakes',
+      SA_Title,     AsTag('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,        'Close the Window to Quit',
-         WA_CustomScreen, s,
+         WA_Title,        AsTag('Close the Window to Quit'),
+         WA_CustomScreen, AsTag(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,systemvartags;
+uses Exec, Intuition, AGraphics, Utility, GadTools, amsgbox;
 
 
 CONST
@@ -192,16 +192,16 @@ PROCEDURE setpixel(i: Integer);
 BEGIN
   SetAPen(Rast,1);
   IF needles THEN BEGIN
-    Move(Rast,i,range); Draw(Rast,i,Round((1-sort[i])*range));
+    GfxMove(Rast,i,range); Draw(Rast,i,Round((1-sort[i])*range));
   END ELSE
-    IF WritePixel(Rast,i,Round((1-sort[i])*range))=0 THEN;
+    WritePixel(Rast,i,Round((1-sort[i])*range))
 END;
 
 PROCEDURE clearpixel(i: Integer);
 BEGIN
   SetAPen(Rast,0);
   IF needles THEN BEGIN
-    Move(Rast,i,range); Draw(Rast,i,Round((1-sort[i])*range));
+    GfxMove(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,7 +262,8 @@ 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);
@@ -499,8 +500,7 @@ 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,16 +516,14 @@ IDCMP_NEWSIZE,
                 WA_Activate,      ltrue,
                 WA_SizeBRight,    ltrue,
                 WA_GimmeZeroZero, ltrue,
-                WA_PubScreen,     s,
+                WA_PubScreen,     AsTag(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]);
@@ -534,7 +532,6 @@ IDCMP_NEWSIZE,
     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);
 
@@ -623,16 +620,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, systemvartags;
+uses Exec, AGraphics, Intuition, Utility;
 
 
 
@@ -115,7 +115,7 @@ BEGIN
   Win:=OpenWindowTags(Nil, [
                         WA_Flags, WFLG_BORDERLESS,
                         WA_IDCMP, IDCMP_MOUSEBUTTONS,
-                        WA_CustomScreen, Scr,
+                        WA_CustomScreen, AsTag(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, systemvartags;
+uses Exec, Intuition, Utility,amsgbox;
 
 
 
@@ -98,7 +98,7 @@ BEGIN
     GA_Left,     (w^.BorderLeft) + 5,
     GA_Width,    PROPGADGETWIDTH,
     GA_Height,   PROPGADGETHEIGHT,
-    ICA_MAP,     @prop2intmap,
+    ICA_MAP,     AsTag(@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,    @int2propmap,
-    ICA_TARGET, prop,
-    GA_Previous, prop,
+      ICA_MAP,    AsTag(@int2propmap),
+      ICA_TARGET, AsTag(prop),
+      GA_Previous,AsTag(prop),
 
     STRINGA_LongVal,  INITIALVAL,
     STRINGA_MaxChars, MAXCHARS,
     TAG_END]);
 
     temp := SetGadgetAttrs(prop, w, NIL,[
-    ICA_TARGET, int,
+    ICA_TARGET, AsTag(int),
     TAG_END]);
 
     IF int = NIL THEN CleanUp('No INTEGER gadget',20);

packages/amunits/fpmake.pp

@@ -22,7 +22,7 @@ begin
     P.License := 'LGPL with modification';
     P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
-    P.Description := 'A set of units for Amiga OS. 68k only?';
+    P.Description := 'A set of units for classic AmigaOS. (68k only)';
     P.NeedLibC:= false;
 
     P.CPUs:=[m68k];
@@ -39,11 +39,8 @@ 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 DateToStr(datetime : pDateTime location 'd1') : LongBool; syscall _DOSBase 744;
+FUNCTION DOSDateToStr(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') : LongBool; syscall _DOSBase 342;
+FUNCTION FPuts(fh : BPTR location 'd1';const str : pCHAR location 'd2') : LongInt; 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 StrToDate(datetime : pDateTime location 'd1') : LongBool; syscall _DOSBase 750;
+FUNCTION DOSStrToDate(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 : POINTER location 'd3') : LONGINT; syscall _DOSBase 354;
+FUNCTION VFPrintf(fh : BPTR location 'd1';const format : pCHAR location 'd2';const argarray : PLongInt 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 : POINTER location 'd2') : LONGINT; syscall _DOSBase 954;
+FUNCTION VPrintf(const format : pCHAR location 'd1'; const argarray : PLongInt 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,6 +1740,12 @@ 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;
@@ -1772,7 +1778,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) : BOOLEAN;
+FUNCTION FPuts(fh : LONGINT;const str : string) : LongInt;
 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;
@@ -1824,6 +1830,26 @@ 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);
@@ -1974,7 +2000,7 @@ begin
     Format := Format(PChar(RawByteString(filesystem)),PChar(RawByteString(volumename)),dostype);
 end;
 
-FUNCTION FPuts(fh : LONGINT;const str : string) : BOOLEAN;
+FUNCTION FPuts(fh : LONGINT;const str : string) : LongInt;
 begin
     FPuts := FPuts(fh,PChar(RawByteString(str)));
 end;

packages/amunits/src/coreunits/amigalib.pas

@@ -100,6 +100,8 @@ 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;
 
 {
@@ -360,15 +362,17 @@ begin
 end;
 
 function DoMethodA(obj : pObject_; msg : APTR): ulong;
-var
-    o : p_Object;
 begin
     if assigned(obj) then begin
-       o := p_Object(obj);
-       DoMethodA := CallHookPkt(@o^.o_Class^.cl_Dispatcher, obj,msg);
+       DoMethodA := CallHookPkt(@THook(OCLASS(obj)^.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,11 +31,6 @@
     [email protected] Nils Sjoholm
 }
 
-{$I useamigasmartlink.inc}
-{$ifdef use_amiga_smartlink}
-   {$smartlink on}
-{$endif use_amiga_smartlink}
-
 UNIT expansion;
 
 INTERFACE
@@ -49,389 +44,43 @@ Const
 
     ADNF_STARTPROC      = 1;
 
-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;
+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;
 
 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;
 
-{$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}
-
-
+initialization
+  ExpansionBase := OpenLibrary(EXPANSIONNAME,LIBVERSION);
+finalization
+  if Assigned(ExpansionBase) then
+    CloseLibrary(ExpansionBase);
 END. (* UNIT EXPANSION *)
 
 

packages/amunits/src/coreunits/gadtools.pas

@@ -465,7 +465,7 @@ Type
 
 
 VAR
-    GadToolsBase : pLibrary;
+    GadToolsBase : pLibrary = nil;
 
 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,119 +487,80 @@ 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
 
-uses
-{$ifndef dont_use_openlib}
-amsgbox;
-{$endif dont_use_openlib}
-
-function GTMENUITEM_USERDATA(menuitem : pMenuItem): pointer;
+function CreateGadget(kind : ULONG; gad : pGadget; ng : pNewGadget; Const argv : array of PtrUInt) : pGadget;
 begin
-    GTMENUITEM_USERDATA := pointer((pMenuItem(menuitem)+1));
+    CreateGadget := CreateGadgetA(kind,gad,ng,@argv);
 end;
 
-function GTMENU_USERDATA(menu : pMenu): pointer;
+function CreateMenus(newmenu : pNewMenu; Const argv : array of PtrUInt) : pMenu;
 begin
-    GTMENU_USERDATA := pointer((pMenu(menu)+1));
+    CreateMenus := CreateMenusA(newmenu,@argv);
 end;
 
-const
-    { Change VERSION and LIBVERSION to proper values }
-
-    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}
-
-var
-    gadtools_exit : Pointer;
-
-procedure ClosegadtoolsLibrary;
+procedure DrawBevelBox(rport : pRastPort; left : LONGINT; top : LONGINT; width : LONGINT; height : LONGINT; Const argv : array of PtrUInt);
 begin
-    ExitProc := gadtools_exit;
-    if GadToolsBase <> nil then begin
-        CloseLibrary(GadToolsBase);
-        GadToolsBase := nil;
-    end;
+    DrawBevelBoxA(rport,left,top,width,height,@argv);
 end;
 
-procedure InitGADTOOLSLibrary;
+function GetVisualInfo(screen : pScreen; Const argv : array of PtrUInt) : POINTER;
 begin
-    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;
+    GetVisualInfo := GetVisualInfoA(screen,@argv);
 end;
 
+function GT_GetGadgetAttrs(gad : pGadget; win : pWindow; req : pRequester; Const argv : array of PtrUInt) : LONGINT;
 begin
-    GADTOOLSIsCompiledHow := 2;
-{$endif use_init_openlib}
+    GT_GetGadgetAttrs := GT_GetGadgetAttrsA(gad,win,req,@argv);
+end;
 
-{$ifdef use_auto_openlib}
-  {$Info Compiling autoopening of gadtools.library}
+procedure GT_SetGadgetAttrs(gad : pGadget; win : pWindow; req : pRequester; Const argv : array of PtrUInt);
+begin
+    GT_SetGadgetAttrsA(gad,win,req,@argv);
+end;
 
-var
-    gadtools_exit : Pointer;
+function LayoutMenuItems(firstitem : pMenuItem; vi : POINTER; Const argv : array of PtrUInt) : BOOLEAN;
+begin
+    LayoutMenuItems := LayoutMenuItemsA(firstitem,vi,@argv);
+end;
 
-procedure ClosegadtoolsLibrary;
+function LayoutMenus(firstmenu : pMenu; vi : POINTER; Const argv : array of PtrUInt) : BOOLEAN;
 begin
-    ExitProc := gadtools_exit;
-    if GadToolsBase <> nil then begin
-        CloseLibrary(GadToolsBase);
-        GadToolsBase := nil;
-    end;
+    LayoutMenus := LayoutMenusA(firstmenu,vi,@argv);
 end;
 
+function GTMENUITEM_USERDATA(menuitem : pMenuItem): pointer;
 begin
-    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}
+    GTMENUITEM_USERDATA := pointer((pMenuItem(menuitem)+1));
+end;
+
+function GTMENU_USERDATA(menu : pMenu): pointer;
 begin
-    GADTOOLSIsCompiledHow := 3;
-   {$Warning No autoopening of gadtools.library compiled}
-   {$Warning Make sure you open gadtools.library yourself}
-{$endif dont_use_openlib}
+    GTMENU_USERDATA := pointer((pMenu(menu)+1));
+end;
 
+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;
+VAR IconBase : pLibrary = nil;
 
 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,198 +373,96 @@ FUNCTION LayoutIconA(icon : pDiskObject location 'a0'; screen : pScreen location
 PROCEDURE ChangeToSelectedIconColor(cr : pColorRegister location 'a0'); syscall IconBase 198;
 
 { overlay }
-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;
+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;
 
 { version 44 overlay}
-FUNCTION GetIconTagList(CONST name : string; CONST tags : pTagItem) : pDiskObject;
-FUNCTION PutIconTagList(CONST name : string; CONST icon : pDiskObject; CONST tags : pTagItem) : BOOLEAN;
+FUNCTION GetIconTagList(CONST name : RawByteString; CONST tags : pTagItem) : pDiskObject;
+FUNCTION PutIconTagList(CONST name : RawByteString; 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 : string;const oldname : pCHAR) : pCHAR;
+FUNCTION BumpRevision(newname : pCHar;const oldname : RawByteString) : pCHAR;
 begin
-      BumpRevision := BumpRevision(pas2c(newname),oldname);
+      BumpRevision := BumpRevision(newname,PChar(oldname));
 end;
 
-FUNCTION BumpRevision(newname : pCHar;const oldname : string) : pCHAR;
+FUNCTION DeleteDiskObject(const name : RawByteString) : BOOLEAN;
 begin
-      BumpRevision := BumpRevision(newname,pas2c(oldname));
+      DeleteDiskObject := DeleteDiskObject(PChar(name));
 end;
 
-FUNCTION BumpRevision(newname : string;const oldname : string) : pCHAR;
+FUNCTION FindToolType(const toolTypeArray : POINTER;const typeName : RawByteString) : pCHAR;
 begin
-      BumpRevision := BumpRevision(pas2c(newname),pas2c(oldname));
+      FindToolType := FindToolType(toolTypeArray,PChar(typeName));
 end;
 
-FUNCTION DeleteDiskObject(const name : string) : BOOLEAN;
+FUNCTION GetDiskObject(const name : RawByteString) : pDiskObject;
 begin
-      DeleteDiskObject := DeleteDiskObject(pas2c(name));
+      GetDiskObject := GetDiskObject(PChar(name));
 end;
 
-FUNCTION FindToolType(const toolTypeArray : POINTER;const typeName : string) : pCHAR;
+FUNCTION GetDiskObjectNew(const name : RawByteString) : pDiskObject;
 begin
-      FindToolType := FindToolType(toolTypeArray,pas2c(typeName));
+      GetDiskObjectNew := GetDiskObjectNew(PChar(name));
 end;
 
-FUNCTION GetDiskObject(const name : string) : pDiskObject;
+FUNCTION MatchToolValue(const typeString : RawByteString;const value : pCHAR) : BOOLEAN;
 begin
-      GetDiskObject := GetDiskObject(pas2c(name));
+       MatchToolValue := MatchToolValue(PChar(typeString),value);
 end;
 
-FUNCTION GetDiskObjectNew(const name : string) : pDiskObject;
+FUNCTION MatchToolValue(const typeString : pCHAR;const value : RawByteString) : BOOLEAN;
 begin
-      GetDiskObjectNew := GetDiskObjectNew(pas2c(name));
+       MatchToolValue := MatchToolValue(typeString,PChar(value));
 end;
 
-FUNCTION MatchToolValue(const typeString : string;const value : pCHAR) : BOOLEAN;
+FUNCTION MatchToolValue(const typeString : RawByteString;const value : RawByteString) : BOOLEAN;
 begin
-       MatchToolValue := MatchToolValue(pas2c(typeString),value);
+       MatchToolValue := MatchToolValue(PChar(typeString),PChar(value));
 end;
 
-FUNCTION MatchToolValue(const typeString : pCHAR;const value : string) : BOOLEAN;
+FUNCTION PutDiskObject(const name : RawByteString;const diskobj : pDiskObject) : BOOLEAN;
 begin
-       MatchToolValue := MatchToolValue(typeString,pas2c(value));
+       PutDiskObject := PutDiskObject(PChar(name),diskobj);
 end;
 
-FUNCTION MatchToolValue(const typeString : string;const value : string) : BOOLEAN;
+FUNCTION GetIconTagList(CONST name : RawByteString; CONST tags : pTagItem) : pDiskObject;
 begin
-       MatchToolValue := MatchToolValue(pas2c(typeString),pas2c(value));
+       GetIconTagList := GetIconTagList(PChar(name),tags);
 end;
 
-FUNCTION PutDiskObject(const name : string;const diskobj : pDiskObject) : BOOLEAN;
+FUNCTION PutIconTagList(CONST name : RawByteString; CONST icon : pDiskObject; CONST tags : pTagItem) : BOOLEAN;
 begin
-       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);
+       PutIconTagList := PutIconTagList(PChar(name),icon,tags);
 end;
 
 const
     { Change VERSION and LIBVERSION to proper values }
-
     VERSION : string[2] = '0';
     LIBVERSION : longword = 0;
 
-{$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}
-
-
+initialization
+  IconBase := OpenLibrary(ICONNAME,LIBVERSION);
+finalization
+  if Assigned(IconBase) then
+    CloseLibrary(IconBase);
 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;
+VAR KeymapBase : pLibrary = nil;
 
 const
     KEYMAPNAME : PChar = 'keymap.library';
@@ -117,50 +117,16 @@ 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;
 
-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}
-
-
+initialization
+  KeymapBase := OpenLibrary(KEYMAPNAME,LIBVERSION);
+finalization
+  if Assigned(KeymapBase) then
+    CloseLibrary(KeymapBase);
 END. (* UNIT KEYMAP *)
 
 

packages/amunits/src/coreunits/layers.pas

@@ -84,7 +84,7 @@ const
 
  LAYERSNAME : PChar = 'layers.library';
 
-VAR LayersBase : pLibrary;
+VAR LayersBase : pLibrary = nil;
 
 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,106 +119,18 @@ 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;
 
-{$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}
-
-
+initialization
+  LayersBase := OpenLibrary(LAYERSNAME,LIBVERSION);
+finalization
+  if Assigned(LayersBase) then
+    CloseLibrary(LayersBase);
 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;
+VAR LocaleBase : pLocaleBase = nil;
 
 const
     LOCALENAME : PChar = 'locale.library';
@@ -292,108 +292,25 @@ 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;
 
-
-{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;
+function OpenCatalog(locale : pLocale; name : pCHAR; Const argv : array of PtrUInt) : pCatalog;
 
 IMPLEMENTATION
 
-uses
-{$ifndef dont_use_openlib}
-amsgbox;
-{$endif dont_use_openlib}
-
+function OpenCatalog(locale : pLocale; name : pCHAR; Const argv : array of PtrUInt) : pCatalog;
+begin
+    OpenCatalog := OpenCatalogA(locale,name,@argv);
+end;
 
 const
     { Change VERSION and LIBVERSION to proper values }
-
     VERSION : string[2] = '0';
     LIBVERSION : longword = 0;
 
-{$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}
-
-
+initialization
+  LocaleBase := pLocaleBase(OpenLibrary(LOCALENAME,LIBVERSION));
+finalization
+  if Assigned(LocaleBase) then
+    CloseLibrary(pLibrary(LocaleBase));
 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;
+VAR LowLevelBase : pLibrary = nil;
 
 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,104 +279,31 @@ 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;
 
-{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;
+function SetJoyPortAttrs(portNumber : ULONG; Const argv : array of PtrUInt) : BOOLEAN;
+function SystemControl(Const argv : array of PtrUInt) : ULONG;
 
 IMPLEMENTATION
 
-{$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;
+function SetJoyPortAttrs(portNumber : ULONG; Const argv : array of PtrUInt) : BOOLEAN;
 begin
-    ExitProc := lowlevel_exit;
-    if LowLevelBase <> nil then begin
-        CloseLibrary(LowLevelBase);
-        LowLevelBase := nil;
-    end;
+    SetJoyPortAttrs := SetJoyPortAttrsA(portNumber,@argv);
 end;
 
-procedure InitLOWLEVELLibrary;
+function SystemControl(Const argv : array of PtrUInt) : ULONG;
 begin
-    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;
+    SystemControl := SystemControlA(@argv);
 end;
 
-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}
+const
+    { Change VERSION and LIBVERSION to proper values }
+    VERSION : string[2] = '0';
+    LIBVERSION : longword = 0;
 
+initialization
+  LowLevelBase := OpenLibrary(LOWLEVELNAME,LIBVERSION);
+finalization
+  if Assigned(LowLevelBase) then
+    CloseLibrary(LowLevelBase);
 END. (* UNIT LOWLEVEL *)
 
 

packages/amunits/src/otherlibs/ahi_sub.pas

@@ -136,333 +136,40 @@ USES Exec, ahi, utility;
 
 
 
-VAR AHIsubBase : pLibrary;
+VAR AHIsubBase : pLibrary = nil;
 
 const
     AHI_SUBNAME : PChar = 'ahi_sub.library';
 
 
-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;
+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;
 
 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;
 
-{$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}
-
-
+initialization
+  AHIsubBase := OpenLibrary(AHI_SUBNAME,LIBVERSION);
+finalization
+  if Assigned(AHIsubBase) then
+    CloseLibrary(AHIsubBase);
 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 const.
+  Added functions and procedures with array of PtrUInt.
   For use with fpc 1.0.7
   30 Nov 2002.
 
@@ -37,7 +37,6 @@
 
 }
 
-{$mode objfpc}
 {$I useamigasmartlink.inc}
 {$ifdef use_amiga_smartlink}
     {$smartlink on}
@@ -202,64 +201,64 @@ uses exec, utility;
   { (struct QSharedMessagePort  mp) A shared message port created with QCreateSharedMessagePort()  }
      QSESSION_SHAREDMSGPORT = $b0000002;
 
-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;
+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;
 
 {
-     This is functions and procedures with array of const.
+     This is functions and procedures with array of PtrUInt.
      For use with fpc 1.0 and above.
 
 }
-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 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 QDebugOp(session : pQSession; string_ : string) : LONGINT;
@@ -286,611 +285,21 @@ 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 const.
+     This is functions and procedures with array of PtrUInt.
      For use with fpc 1.0 and above.
 }
 
-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;
+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;
 
 IMPLEMENTATION
 
 uses
-{$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;
-
+  pastoc;
 
 FUNCTION QDebugOp(session : pQSession; string_ : string) : LONGINT;
 begin
@@ -1002,153 +411,82 @@ begin
     QNewServerSession := QNewServerSession(pas2c(hostnames),pas2c(prognames),taglist);
 end;
 
-FUNCTION QNewSocketSessiontags(host : pCHar; port : LONGINT; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSocketSessiontags(host : pCHar; port : LONGINT; const argv : array of PtrUInt) : pQSession;
 begin
-    QNewSocketSessiontags := QNewSocketSession(host,port,readintags(argv));
+    QNewSocketSessiontags := QNewSocketSession(host,port,@argv);
 end;
 
-FUNCTION QNewSocketSessionAsyncTags(host : pCHar; port : LONGINT; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSocketSessionAsyncTags(host : pCHar; port : LONGINT; const argv : array of PtrUInt) : pQSession;
 begin
-    QNewSocketSessionAsyncTags := QNewSocketSessionAsync(host,port,readintags(argv));
+    QNewSocketSessionAsyncTags := QNewSocketSessionAsync(host,port,@argv);
 end;
 
-FUNCTION QNewSocketServerSessionTags( port : pLONGINT; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSocketServerSessionTags( port : pLONGINT; const argv : array of PtrUInt) : pQSession;
 begin
-    QNewSocketServerSessionTags := QNewSocketServerSession(port,readintags(argv));
+    QNewSocketServerSessionTags := QNewSocketServerSession(port,@argv);
 end;
 
-FUNCTION QNewSessionTags(host : pCHar; port : LONGINT; name : pCHar; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSessionTags(host : pCHar; port : LONGINT; name : pCHar; const argv : array of PtrUInt) : pQSession;
 begin
-    QNewSessionTags := QNewSession(host,port,name,readintags(argv));
+    QNewSessionTags := QNewSession(host,port,name,@argv);
 end;
 
-FUNCTION QNewSessionAsyncTags(host : pCHar; port : LONGINT; name : pCHar; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSessionAsyncTags(host : pCHar; port : LONGINT; name : pCHar; const argv : array of PtrUInt) : pQSession;
 begin
-    QNewSessionAsyncTags := QNewSessionAsync(host,port,name,readintags(argv));
+    QNewSessionAsyncTags := QNewSessionAsync(host,port,name,@argv);
 end;
 
-FUNCTION QNewHostSessionTags(hostnames : pCHar; port : pLONGINT; names : pCHar; const argv : Array Of Const) : pQSession;
+FUNCTION QNewHostSessionTags(hostnames : pCHar; port : pLONGINT; names : pCHar; const argv : array of PtrUInt) : pQSession;
 begin
-    QNewHostSessionTags := QNewHostSession(hostnames,port,names,readintags(argv));
+    QNewHostSessionTags := QNewHostSession(hostnames,port,names,@argv);
 end;
 
-FUNCTION QNewServerSessionTags(hostNames : pCHar; progNames : pCHar; const argv : Array Of Const) : pQSession;
+FUNCTION QNewServerSessionTags(hostNames : pCHar; progNames : pCHar; const argv : array of PtrUInt) : pQSession;
 begin
-    QNewServerSessionTags := QNewServerSession(hostnames,prognames,readintags(argv));
+    QNewServerSessionTags := QNewServerSession(hostnames,prognames,@argv);
 end;
 
 
-FUNCTION QNewSocketSessionTags(host : string; port : LONGINT; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSocketSessionTags(host : string; port : LONGINT; const argv : array of PtrUInt) : pQSession;
 begin
-    QNewSocketSessionTags := QNewSocketSession(host,port,readintags(argv));
+    QNewSocketSessionTags := QNewSocketSession(host,port,@argv);
 end;
 
-FUNCTION QNewSocketSessionAsyncTags(host : string; port : LONGINT; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSocketSessionAsyncTags(host : string; port : LONGINT; const argv : array of PtrUInt) : pQSession;
 begin
-    QNewSocketSessionAsyncTags := QNewSocketSessionAsync(host,port,readintags(argv));
+    QNewSocketSessionAsyncTags := QNewSocketSessionAsync(host,port,@argv);
 end;
 
-FUNCTION QNewSessionTags(host : string; port : LONGINT; name : string; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSessionTags(host : string; port : LONGINT; name : string; const argv : array of PtrUInt) : pQSession;
 begin
-    QNewSessionTags := QNewSession(host,port,name,readintags(argv));
+    QNewSessionTags := QNewSession(host,port,name,@argv);
 end;
 
-FUNCTION QNewSessionAsyncTags(host : string; port : LONGINT; name : string; const argv : Array Of Const) : pQSession;
+FUNCTION QNewSessionAsyncTags(host : string; port : LONGINT; name : string; const argv : array of PtrUInt) : pQSession;
 begin
-    QNewSessionAsyncTags := QNewSessionAsync(host,port,name,readintags(argv));
+    QNewSessionAsyncTags := QNewSessionAsync(host,port,name,@argv);
 end;
 
-FUNCTION QNewHostSessionTags(hostnames : string; port : pLONGINT; names : string; const argv : Array Of Const) : pQSession;
+FUNCTION QNewHostSessionTags(hostnames : string; port : pLONGINT; names : string; const argv : array of PtrUInt) : pQSession;
 begin
-    QNewHostSessionTags := QNewHostSession(hostnames,port,names,readintags(argv));
+    QNewHostSessionTags := QNewHostSession(hostnames,port,names,@argv);
 end;
 
-FUNCTION QNewServerSessionTags(hostNames : string; progNames : string; const argv : Array Of Const) : pQSession;
+FUNCTION QNewServerSessionTags(hostNames : string; progNames : string; const argv : array of PtrUInt) : pQSession;
 begin
-    QNewServerSessionTags := QNewServerSession(hostnames,prognames,readintags(argv));
+    QNewServerSessionTags := QNewServerSession(hostnames,prognames,@argv);
 end;
 
 const
     { Change VERSION and LIBVERSION to proper values }
-
     VERSION : string[2] = '0';
     LIBVERSION : longword = 0;
 
-{$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}
-
+initialization
+  AMarqueeBase := OpenLibrary(AMARQUEENAME,LIBVERSION);
+finalization
+  if Assigned(AMarqueeBase) then
+    CloseLibrary(AMarqueeBase);
 END. (* UNIT AMARQUEE *)
 
 

packages/amunits/src/otherlibs/lucyplay.pas

@@ -28,18 +28,12 @@
   [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;
+VAR LucyPlayBase : pLibrary = nil;
 
 const
     LUCYPLAYNAME : PChar = 'lucyplay.library';
@@ -96,276 +90,33 @@ const
      LUC_ERR_READJOYPORT = 9;
      LUC_ERR_DOIO = 10;
 
-
-
-
-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;
+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;
 
 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;
 
-{$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}
-
+initialization
+  LucyPlayBase := OpenLibrary(LUCYPLAYNAME,LIBVERSION);
+finalization
+  if Assigned(LucyPlayBase) then
+    CloseLibrary(LucyPlayBase);
 END. (* UNIT LUCYPLAY *)
 
 

packages/amunits/src/otherlibs/triton.pas

@@ -17,7 +17,7 @@
 {
     History
 
-    Updated to triton 2.0. Added function with array of const.
+    Updated to triton 2.0. Added function with array of PtrUInt.
     09 Jan 2003.
 
     Added the defines use_amiga_smartlink and
@@ -33,11 +33,6 @@
 
 }
 
-{$mode objfpc}
-{$I useamigasmartlink.inc}
-{$ifdef use_amiga_smartlink}
-    {$smartlink on}
-{$endif use_amiga_smartlink}
 
 UNIT TRITON;
 
@@ -685,78 +680,64 @@ surrounding array *}
         TRFB_TEXT               = $00000004;     {* A text container *}
 
 
-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;
+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;
 FUNCTION TR_FirstOccurance(ch : BYTE; str : String) : LONGINT;
-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_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_NumOccurances(ch : BYTE; str : String) : LONGINT;
-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_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_TextHeight(project : pTR_Project; txt : String; flags : ULONG) : ULONG;
-FUNCTION TR_TextWidth(project : pTR_Project; txt : pCHAR; 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 : String; flags : ULONG) : ULONG;
-PROCEDURE TR_UnlockProject(project : pTR_Project);
-PROCEDURE TR_UnlockScreen(screen : pScreen);
-FUNCTION TR_Wait(app : pTR_App; otherbits : 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;
 
 {
-   Functions with array of const
+   Functions with array of PtrUInt
 }
 FUNCTION TR_AddClassTags(app : pTR_App; d0arg : longword; supertag : longword;
-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;
+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;
 
 {  This are a few support functions for triton.
    Could be handy.
@@ -778,23 +759,10 @@ 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
-{$ifndef dont_use_openlib}
-amsgbox,
-{$endif dont_use_openlib}
-tagsarray,pastoc;
+  pastoc;
 
 procedure TR_Disable(p : pTR_Project; id : Longint);
 begin
@@ -881,182 +849,6 @@ 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;
@@ -1076,459 +868,88 @@ 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 const
+   Functions with array of PtrUInt
 }
 {
- Functions and procedures with array of const go here
+ Functions and procedures with array of PtrUInt go here
 }
-FUNCTION TR_AddClassTags(app : pTR_App; d0arg : longword; supertag : longword; defaultmethod : LONGINT; datasize : longword; const tags : Array Of Const) : BOOLEAN;
+FUNCTION TR_AddClassTags(app : pTR_App; d0arg : longword; supertag : longword; defaultmethod : LONGINT; datasize : longword; const tags : array of PtrUInt) : BOOLEAN;
 begin
-    TR_AddClassTags := TR_AddClass(app , d0arg , supertag , defaultmethod , datasize , readintags(tags));
+    TR_AddClassTags := TR_AddClass(app , d0arg , supertag , defaultmethod , datasize , @tags);
 end;
 
-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 : pCHAR; const taglist : array of PtrUInt) : Ulong;
 begin
-    TR_EasyRequestTags := TR_EasyRequest(app , bodyfmt , gadfmt , readintags(taglist));
+    TR_EasyRequestTags := TR_EasyRequest(app , bodyfmt , gadfmt , @taglist);
 end;
 
-FUNCTION TR_OpenProjectTags(app : pTR_App; const taglist : Array Of Const) : pTR_Project;
+FUNCTION TR_OpenProjectTags(app : pTR_App; const taglist : array of PtrUInt) : pTR_Project;
 begin
-    TR_OpenProjectTags := TR_OpenProject(app , readintags(taglist));
+    TR_OpenProjectTags := TR_OpenProject(app , @taglist);
 end;
 
-FUNCTION TR_AutoRequestTags(app : pTR_App; lockproject : pTR_Project; const wintags : Array Of Const): ULONG;
+FUNCTION TR_AutoRequestTags(app : pTR_App; lockproject : pTR_Project; const wintags : array of PtrUInt): ULONG;
 begin
-    TR_AutoRequestTags := TR_AutoRequest(app,lockproject,readintags(wintags));
+    TR_AutoRequestTags := TR_AutoRequest(app,lockproject, @wintags);
 end;
 
-FUNCTION TR_CreateAppTags(const apptags : Array of Const) : pTR_App;
+FUNCTION TR_CreateAppTags(const apptags : array of PtrUInt) : pTR_App;
 begin
-    TR_CreateAppTags := TR_CreateApp(readintags(apptags));
+    TR_CreateAppTags := TR_CreateApp(@apptags);
 end;
 
-FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : pCHAR; gadfmt : String; Const taglist : Array Of Const) : ULONG;
+FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : pCHAR; gadfmt : String; Const taglist : array of PtrUInt) : ULONG;
 begin
-    TR_EasyRequestTags := TR_EasyRequest(app,bodyfmt,pas2c(gadfmt),readintags(taglist));
+    TR_EasyRequestTags := TR_EasyRequest(app,bodyfmt,pas2c(gadfmt), @taglist);
 end;
 
-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 : pCHAR; Const taglist : array of PtrUInt) : ULONG;
 begin
-    TR_EasyRequestTags := TR_EasyRequest(app,pas2c(bodyfmt),gadfmt,readintags(taglist));
+    TR_EasyRequestTags := TR_EasyRequest(app,pas2c(bodyfmt),gadfmt, @taglist);
 end;
 
-FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : String; gadfmt : String; Const taglist : Array Of Const) : ULONG;
+FUNCTION TR_EasyRequestTags(app : pTR_App; bodyfmt : String; gadfmt : String; Const taglist : array of PtrUInt) : ULONG;
 begin
-    TR_EasyRequestTags := TR_EasyRequest(app,pas2c(bodyfmt),pas2c(gadfmt),readintags(taglist));
+    TR_EasyRequestTags := TR_EasyRequest(app,pas2c(bodyfmt),pas2c(gadfmt), @taglist);
 end;
 
 const
     { Change VERSION and LIBVERSION to proper values }
-
     VERSION : string[2] = '0';
     LIBVERSION : longword = 0;
 
-{$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}
-
-
+initialization
+  TritonBase := OpenLibrary(TRITONNAME,LIBVERSION);
+finalization
+  if Assigned(TritonBase) then
+    CloseLibrary(TritonBase);
 END. (* UNIT TRITON *)
 
 

packages/amunits/src/otherlibs/xadmaster.pas

@@ -22,11 +22,6 @@
   [email protected] Nils Sjoholm
 }
 
-{$mode objfpc}
-{$I useamigasmartlink.inc}
-{$ifdef use_amiga_smartlink}
-   {$smartlink on}
-{$endif use_amiga_smartlink}
 
 UNIT XADMASTER;
 
@@ -1182,575 +1177,153 @@ const
      XADCID_DMS = 9000;
      XADCID_DMSSFX = 9001;
 
-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;
+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;
 {
- Functions and procedures with array of const go here
+ Functions and procedures with array of PtrUInt go here
 }
-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;
+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;
 
 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 const go here
+ Functions and procedures with array of PtrUInt go here
 }
-FUNCTION xadAddDiskEntry(di : pxadDiskInfo; ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadAddDiskEntry(di : pxadDiskInfo; ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
 begin
-    xadAddDiskEntry := xadAddDiskEntryA(di , ai , readintags(tags));
+    xadAddDiskEntry := xadAddDiskEntryA(di , ai , @tags);
 end;
 
-FUNCTION xadAddFileEntry(fi : pxadFileInfo; ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadAddFileEntry(fi : pxadFileInfo; ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
 begin
-    xadAddFileEntry := xadAddFileEntryA(fi , ai , readintags(tags));
+    xadAddFileEntry := xadAddFileEntryA(fi , ai , @tags);
 end;
 
-FUNCTION xadAllocObject(_type : LONGINT; const tags : Array Of Const) : POINTER;
+FUNCTION xadAllocObject(_type : LONGINT; const tags : array of PtrUInt) : POINTER;
 begin
-    xadAllocObject := xadAllocObjectA(_type , readintags(tags));
+    xadAllocObject := xadAllocObjectA(_type , @tags);
 end;
 
-FUNCTION xadConvertDates(const tags : Array Of Const) : LONGINT;
+FUNCTION xadConvertDates(const tags : array of PtrUInt) : LONGINT;
 begin
-    xadConvertDates := xadConvertDatesA(readintags(tags));
+    xadConvertDates := xadConvertDatesA(@tags);
 end;
 
-FUNCTION xadConvertName(charset : longword; const tags : Array Of Const) : pCHAR;
+FUNCTION xadConvertName(charset : longword; const tags : array of PtrUInt) : pCHAR;
 begin
-    xadConvertName := xadConvertNameA(charset , readintags(tags));
+    xadConvertName := xadConvertNameA(charset , @tags);
 end;
 
-FUNCTION xadConvertProtection(const tags : Array Of Const) : LONGINT;
+FUNCTION xadConvertProtection(const tags : array of PtrUInt) : LONGINT;
 begin
-    xadConvertProtection := xadConvertProtectionA(readintags(tags));
+    xadConvertProtection := xadConvertProtectionA(@tags);
 end;
 
-FUNCTION xadDiskFileUnArc(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadDiskFileUnArc(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
 begin
-    xadDiskFileUnArc := xadDiskFileUnArcA(ai , readintags(tags));
+    xadDiskFileUnArc := xadDiskFileUnArcA(ai , @tags);
 end;
 
-FUNCTION xadDiskUnArc(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadDiskUnArc(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
 begin
-    xadDiskUnArc := xadDiskUnArcA(ai , readintags(tags));
+    xadDiskUnArc := xadDiskUnArcA(ai , @tags);
 end;
 
-FUNCTION xadFileUnArc(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadFileUnArc(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
 begin
-    xadFileUnArc := xadFileUnArcA(ai , readintags(tags));
+    xadFileUnArc := xadFileUnArcA(ai , @tags);
 end;
 
-FUNCTION xadFreeHookAccess(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadFreeHookAccess(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
 begin
-    xadFreeHookAccess := xadFreeHookAccessA(ai , readintags(tags));
+    xadFreeHookAccess := xadFreeHookAccessA(ai , @tags);
 end;
 
-PROCEDURE xadFreeObject(obj : POINTER; const tags : Array Of Const);
+PROCEDURE xadFreeObject(obj : POINTER; const tags : array of PtrUInt);
 begin
-    xadFreeObjectA(obj , readintags(tags));
+    xadFreeObjectA(obj , @tags);
 end;
 
-FUNCTION xadGetDiskInfo(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadGetDiskInfo(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
 begin
-    xadGetDiskInfo := xadGetDiskInfoA(ai , readintags(tags));
+    xadGetDiskInfo := xadGetDiskInfoA(ai , @tags);
 end;
 
-FUNCTION xadGetFilename(buffersize : longword; buffer : pCHAR; path : pCHAR; name : pCHAR; const tags : Array Of Const) : LONGINT;
+FUNCTION xadGetFilename(buffersize : longword; buffer : pCHAR; path : pCHAR; name : pCHAR; const tags : array of PtrUInt) : LONGINT;
 begin
-    xadGetFilename := xadGetFilenameA(buffersize , buffer , path , name , readintags(tags));
+    xadGetFilename := xadGetFilenameA(buffersize , buffer , path , name , @tags);
 end;
 
-FUNCTION xadGetHookAccess(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadGetHookAccess(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
 begin
-    xadGetHookAccess := xadGetHookAccessA(ai , readintags(tags));
+    xadGetHookAccess := xadGetHookAccessA(ai , @tags);
 end;
 
-FUNCTION xadGetInfo(ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadGetInfo(ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
 begin
-    xadGetInfo := xadGetInfoA(ai , readintags(tags));
+    xadGetInfo := xadGetInfoA(ai , @tags);
 end;
 
-FUNCTION xadHookTagAccess(command : longword; data : LONGINT; buffer : POINTER; ai : pxadArchiveInfo; const tags : Array Of Const) : LONGINT;
+FUNCTION xadHookTagAccess(command : longword; data : LONGINT; buffer : POINTER; ai : pxadArchiveInfo; const tags : array of PtrUInt) : LONGINT;
 begin
-    xadHookTagAccess := xadHookTagAccessA(command , data , buffer , ai , readintags(tags));
+    xadHookTagAccess := xadHookTagAccessA(command , data , buffer , ai , @tags);
 end;
 
-FUNCTION xadRecogFile(size : longword; memory : POINTER; const tags : Array Of Const) : pxadClient;
+FUNCTION xadRecogFile(size : longword; memory : POINTER; const tags : array of PtrUInt) : pxadClient;
 begin
-    xadRecogFile := xadRecogFileA(size , memory , readintags(tags));
+    xadRecogFile := xadRecogFileA(size , memory , @tags);
 end;
 
 const
     { Change VERSION and LIBVERSION to proper values }
-
     VERSION : string[2] = '0';
     LIBVERSION : longword = 0;
 
-{$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}
-
-
+initialization
+  xadMasterBase := pxadMasterBase(OpenLibrary(XADMASTERNAME,LIBVERSION));
+finalization
+  if Assigned(xadMasterBase) then
+    CloseLibrary(pLibrary(xadMasterBase));
 END. (* UNIT XADMASTER *)

packages/amunits/src/utilunits/Makefile.fpc

@@ -1,27 +0,0 @@
-#
-#   Makefile.fpc for Free Pascal Amiga units Bindings
-#
-
-[package]
-name=amunits
-version=3.1.1
-
-[target]
-units=amigautils consoleio deadkeys doublebuffer easyasl hisoft \
-	linklist msgbox pastoc pcq \
-	tagsarray timerutils vartags wbargs
-
-
-[compiler]
-sourcedir=.
-includedir=../inc
-unitdir=../units
-
-[install]
-fpcpackage=y
-
-[default]
-fpcdir=../../../../
-
-[rules]
-.NOTPARALLEL:

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) <> 0 THEN BEGIN
+       IF AslRequest(fr,NIL) 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) <> 0 THEN BEGIN
+         IF AslRequest(fr,NIL) 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) <> 0 THEN BEGIN
+             IF AslRequest(fr,NIL) 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) <> 0 THEN BEGIN
+         IF AslRequest(fr,NIL) 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) <> 0 THEN BEGIN
+         IF AslRequest(fr,NIL) 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

@@ -1,63 +0,0 @@
-{
-    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

@@ -1,414 +0,0 @@
-{
-    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,16 +26,11 @@ 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;
@@ -69,43 +64,8 @@ begin
   GetTagPtr := @(TagList[0]);
 end;
 
-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-09-05 rev 31523]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-07-28 rev 31240]
 #
 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 i8086-win16 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 aarch64-linux aarch64-darwin
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
-LIMIT83fs = go32v2 os2 emx watcom msdos win16
+LIMIT83fs = go32v2 os2 emx watcom msdos
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
@@ -741,12 +741,6 @@ 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)
@@ -1634,14 +1628,6 @@ 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-09-05 rev 31523]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-07-28 rev 31240]
 #
 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 i8086-win16 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 aarch64-linux aarch64-darwin
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
-LIMIT83fs = go32v2 os2 emx watcom msdos win16
+LIMIT83fs = go32v2 os2 emx watcom msdos
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
@@ -741,12 +741,6 @@ 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)
@@ -1634,14 +1628,6 @@ 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-09-05 rev 31523]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-07-28 rev 31240]
 #
 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 i8086-win16 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 aarch64-linux aarch64-darwin
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
-LIMIT83fs = go32v2 os2 emx watcom msdos win16
+LIMIT83fs = go32v2 os2 emx watcom msdos
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
@@ -741,12 +741,6 @@ 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)
@@ -1634,14 +1628,6 @@ 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-09-05 rev 31523]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-07-28 rev 31240]
 #
 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 i8086-win16 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 aarch64-linux aarch64-darwin
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
-LIMIT83fs = go32v2 os2 emx watcom msdos win16
+LIMIT83fs = go32v2 os2 emx watcom msdos
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
@@ -568,9 +568,6 @@ 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
@@ -977,12 +974,6 @@ 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)
@@ -1949,15 +1940,6 @@ 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,3 +73,5 @@ 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

@@ -0,0 +1,118 @@
+{$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

@@ -0,0 +1,71 @@
+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-base/examples/sitest.pp

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

packages/fcl-base/examples/testini.pp

@@ -0,0 +1,61 @@
+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,9 +53,8 @@ begin
     T:=P.Targets.AddUnit('contnrs.pp');
       T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('singleinstance.pp');
-      T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('custapp.pp');
-    T.ResourceStrings:=true;
+      T.ResourceStrings:=true;
     with T.Dependencies do
       AddUnit('singleinstance');
     T:=P.Targets.AddUnit('eventlog.pp');
@@ -67,9 +66,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
@@ -124,6 +123,7 @@ 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;
+  sysutils, Classes, singleinstance;
 
 const
   HEADER_VERSION = 2;
@@ -168,6 +168,43 @@ 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.';
@@ -772,8 +809,284 @@ 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,10 +412,15 @@ 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;
@@ -424,6 +429,7 @@ 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;
@@ -435,9 +441,14 @@ 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;
@@ -446,6 +457,7 @@ 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;
@@ -464,11 +476,15 @@ 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;
@@ -479,6 +495,7 @@ 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;
@@ -1939,13 +1956,7 @@ end;
 
 Function THTCustomNode.HasKey(const AKey: string): boolean;
 begin
-  if Length(AKey) <> Length(FKey) then
-    begin
-    Result:=false;
-    Exit;
-    end
-  else
-    Result:=CompareMem(PChar(FKey), PChar(AKey), Length(AKey));
+  Result:=(AKey=FKey);
 end;
 
 { TFPCustomHashTable }
@@ -2053,11 +2064,8 @@ begin
   if Assigned(chn) then
     if chn.count>0 then
       for i:=0 to chn.Count - 1 do
-        if THTCustomNode(chn[i]).HasKey(aKey) then
-          begin
-          Result:=THTCustomNode(chn[i]);
-          Exit;
-          end;
+        if THTCustomNode(chn[i]).Key=aKey then
+          Exit(THTCustomNode(chn[i]));
   Result:=nil;
 end;
 
@@ -2072,7 +2080,7 @@ begin
     begin
     if Result.count>0 then
       for i:=0 to Result.Count - 1 do
-        if THTCustomNode(Result[i]).HasKey(aKey) then
+        if (THTCustomNode(Result[i]).Key=aKey) then
           raise EDuplicate.CreateFmt(DuplicateMsg, [aKey]);
     end
   else
@@ -2095,7 +2103,7 @@ begin
   if Assigned(chn) then
     if chn.count>0 then
       for i:=0 to chn.Count - 1 do
-        if THTCustomNode(chn[i]).HasKey(aKey) then
+        if THTCustomNode(chn[i]).Key=aKey then
           begin
           chn.Delete(i);
           dec(FCount);
@@ -2159,11 +2167,8 @@ begin
     begin
     if chn.count>0 then
       for i:=0 to chn.Count - 1 do
-        if THTCustomNode(chn[i]).HasKey(aKey) then
-          begin
-          Result:=THTNode(chn[i]);
-          Exit;
-          end
+        if (THTCustomNode(chn[i]).Key=aKey) then
+          Exit(THTNode(chn[i]));
     end
   else
     begin
@@ -2242,6 +2247,17 @@ 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;
@@ -2321,6 +2337,17 @@ 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;
@@ -2398,6 +2425,17 @@ 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;