merge from trunk

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

.gitattributes

@@ -57,6 +57,7 @@ compiler/aoptbase.pas svneol=native#text/plain
 compiler/aoptcs.pas svneol=native#text/plain
 compiler/aoptda.pas svneol=native#text/plain
 compiler/aoptobj.pas svneol=native#text/plain
+compiler/aoptutils.pas svneol=native#text/pascal
 compiler/arm/aasmcpu.pas svneol=native#text/plain
 compiler/arm/agarmgas.pas svneol=native#text/plain
 compiler/arm/aoptcpu.pas svneol=native#text/plain
@@ -121,6 +122,7 @@ compiler/avr/itcpugas.pas svneol=native#text/plain
 compiler/avr/navradd.pas svneol=native#text/plain
 compiler/avr/navrcnv.pas svneol=native#text/plain
 compiler/avr/navrmat.pas svneol=native#text/plain
+compiler/avr/navrutil.pas svneol=native#text/pascal
 compiler/avr/raavr.pas svneol=native#text/plain
 compiler/avr/raavrgas.pas svneol=native#text/plain
 compiler/avr/ravrcon.inc svneol=native#text/plain
@@ -166,12 +168,15 @@ compiler/defcmp.pas svneol=native#text/plain
 compiler/defutil.pas svneol=native#text/plain
 compiler/dirparse.pas svneol=native#text/plain
 compiler/elfbase.pas svneol=native#text/plain
+compiler/entfile.pas svneol=native#text/plain
 compiler/export.pas svneol=native#text/plain
 compiler/expunix.pas svneol=native#text/plain
 compiler/finput.pas svneol=native#text/plain
 compiler/fmodule.pas svneol=native#text/plain
 compiler/fpccrc.pas svneol=native#text/plain
 compiler/fpcdefs.inc svneol=native#text/plain
+compiler/fpcp.pas svneol=native#text/pascal
+compiler/fpkg.pas svneol=native#text/pascal
 compiler/fppu.pas svneol=native#text/plain
 compiler/gendef.pas svneol=native#text/plain
 compiler/generic/cpuinfo.pas svneol=native#text/plain
@@ -184,7 +189,9 @@ compiler/hlcgobj.pas svneol=native#text/plain
 compiler/html/i386/readme.txt svneol=native#text/plain
 compiler/html/powerpc/readme.txt svneol=native#text/plain
 compiler/htypechk.pas svneol=native#text/plain
-compiler/i386/aopt386.pas svneol=native#text/plain
+compiler/i386/aoptcpu.pas svneol=native#text/plain
+compiler/i386/aoptcpub.pas svneol=native#text/plain
+compiler/i386/aoptcpud.pas svneol=native#text/plain
 compiler/i386/cgcpu.pas svneol=native#text/plain
 compiler/i386/cpubase.inc svneol=native#text/plain
 compiler/i386/cpuelf.pas svneol=native#text/plain
@@ -193,7 +200,6 @@ compiler/i386/cpunode.pas svneol=native#text/plain
 compiler/i386/cpupara.pas svneol=native#text/plain
 compiler/i386/cpupi.pas svneol=native#text/plain
 compiler/i386/cputarg.pas svneol=native#text/plain
-compiler/i386/daopt386.pas svneol=native#text/plain
 compiler/i386/hlcgcpu.pas svneol=native#text/plain
 compiler/i386/i386att.inc svneol=native#text/plain
 compiler/i386/i386atts.inc svneol=native#text/plain
@@ -210,7 +216,6 @@ compiler/i386/n386ld.pas svneol=native#text/plain
 compiler/i386/n386mat.pas svneol=native#text/plain
 compiler/i386/n386mem.pas svneol=native#text/plain
 compiler/i386/n386set.pas svneol=native#text/plain
-compiler/i386/popt386.pas svneol=native#text/plain
 compiler/i386/r386ari.inc svneol=native#text/plain
 compiler/i386/r386att.inc svneol=native#text/plain
 compiler/i386/r386con.inc svneol=native#text/plain
@@ -337,6 +342,7 @@ compiler/llvm/llvmsym.pas svneol=native#text/plain
 compiler/llvm/llvmtarg.pas svneol=native#text/plain
 compiler/llvm/llvmtype.pas svneol=native#text/plain
 compiler/llvm/nllvmadd.pas svneol=native#text/plain
+compiler/llvm/nllvmbas.pas svneol=native#text/plain
 compiler/llvm/nllvmcal.pas svneol=native#text/plain
 compiler/llvm/nllvmcnv.pas svneol=native#text/plain
 compiler/llvm/nllvmcon.pas svneol=native#text/plain
@@ -346,6 +352,7 @@ compiler/llvm/nllvmmat.pas svneol=native#text/plain
 compiler/llvm/nllvmmem.pas svneol=native#text/plain
 compiler/llvm/nllvmtcon.pas svneol=native#text/plain
 compiler/llvm/nllvmutil.pas svneol=native#text/plain
+compiler/llvm/nllvmvmt.pas svneol=native#text/plain
 compiler/llvm/rgllvm.pas svneol=native#text/plain
 compiler/llvm/symllvm.pas svneol=native#text/plain
 compiler/llvm/tgllvm.pas svneol=native#text/plain
@@ -370,6 +377,7 @@ compiler/m68k/n68kcnv.pas svneol=native#text/plain
 compiler/m68k/n68kinl.pas svneol=native#text/plain
 compiler/m68k/n68kmat.pas svneol=native#text/plain
 compiler/m68k/n68kmem.pas svneol=native#text/plain
+compiler/m68k/r68kbss.inc svneol=native#text/plain
 compiler/m68k/r68kcon.inc svneol=native#text/plain
 compiler/m68k/r68kgas.inc svneol=native#text/plain
 compiler/m68k/r68kgri.inc svneol=native#text/plain
@@ -486,6 +494,7 @@ compiler/nopt.pas svneol=native#text/plain
 compiler/nset.pas svneol=native#text/plain
 compiler/nstate.pas svneol=native#text/plain
 compiler/nutils.pas svneol=native#text/plain
+compiler/objcasm.pas svneol=native#text/plain
 compiler/objcdef.pas svneol=native#text/plain
 compiler/objcgutl.pas svneol=native#text/plain
 compiler/objcutil.pas svneol=native#text/plain
@@ -518,6 +527,7 @@ compiler/parser.pas svneol=native#text/plain
 compiler/pass_1.pas svneol=native#text/plain
 compiler/pass_2.pas svneol=native#text/plain
 compiler/pbase.pas svneol=native#text/plain
+compiler/pcp.pas svneol=native#text/pascal
 compiler/pdecl.pas svneol=native#text/plain
 compiler/pdecobj.pas svneol=native#text/plain
 compiler/pdecsub.pas svneol=native#text/plain
@@ -527,6 +537,7 @@ compiler/pexpr.pas svneol=native#text/plain
 compiler/pgentype.pas svneol=native#text/pascal
 compiler/pgenutil.pas svneol=native#text/pascal
 compiler/pinline.pas svneol=native#text/plain
+compiler/pkgutil.pas svneol=native#text/pascal
 compiler/pmodules.pas svneol=native#text/plain
 compiler/powerpc/agppcmpw.pas svneol=native#text/plain
 compiler/powerpc/agppcvasm.pas svneol=native#text/plain
@@ -1147,10 +1158,8 @@ 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
@@ -1920,6 +1929,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
@@ -1934,6 +1944,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
@@ -1949,8 +1960,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
@@ -1979,9 +1988,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
@@ -2064,6 +2073,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
@@ -2102,6 +2112,7 @@ packages/fcl-db/src/base/fields.inc svneol=native#text/plain
 packages/fcl-db/src/base/fpmake.inc svneol=native#text/plain
 packages/fcl-db/src/base/fpmake.pp svneol=native#text/plain
 packages/fcl-db/src/base/sqlscript.pp svneol=native#text/plain
+packages/fcl-db/src/base/sqltypes.pp svneol=native#text/plain
 packages/fcl-db/src/base/xmldatapacketreader.pp svneol=native#text/plain
 packages/fcl-db/src/codegen/Makefile svneol=native#text/plain
 packages/fcl-db/src/codegen/Makefile.fpc svneol=native#text/plain
@@ -2121,6 +2132,7 @@ packages/fcl-db/src/datadict/fpdatadict.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpdddbf.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpdddiff.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpddfb.pp svneol=native#text/plain
+packages/fcl-db/src/datadict/fpddmssql.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpddmysql40.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpddmysql41.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpddmysql50.pp svneol=native#text/plain
@@ -2373,6 +2385,7 @@ packages/fcl-fpcunit/src/exampletests/Makefile.fpc svneol=native#text/plain
 packages/fcl-fpcunit/src/exampletests/fpcunittests.pp svneol=native#text/plain
 packages/fcl-fpcunit/src/exampletests/money.pp svneol=native#text/plain
 packages/fcl-fpcunit/src/exampletests/moneytest.pp svneol=native#text/plain
+packages/fcl-fpcunit/src/exampletests/needassert.pp svneol=native#text/plain
 packages/fcl-fpcunit/src/exampletests/testmockobject.pp svneol=native#text/plain
 packages/fcl-fpcunit/src/fpcunit.pp svneol=native#text/plain
 packages/fcl-fpcunit/src/fpcunitreport.pp svneol=native#text/plain
@@ -2495,6 +2508,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
@@ -2563,9 +2577,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
@@ -2587,9 +2640,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
@@ -2857,6 +2909,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
@@ -2871,6 +2924,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
@@ -3143,6 +3197,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
@@ -4295,10 +4351,17 @@ packages/hash/src/md5i386.inc svneol=native#text/plain
 packages/hash/src/ntlm.pas svneol=native#text/plain
 packages/hash/src/sha1.pp svneol=native#text/plain
 packages/hash/src/sha1i386.inc svneol=native#text/plain
+packages/hash/src/uhpack.pp svneol=native#text/plain
+packages/hash/src/uhpackimp.pp svneol=native#text/plain
+packages/hash/src/uhpacktables.pp svneol=native#text/plain
 packages/hash/src/unixcrypt.pas svneol=native#text/plain
 packages/hash/src/uuid.pas svneol=native#text/plain
+packages/hash/tests/README.txt svneol=native#text/plain
+packages/hash/tests/fpcunithpack.lpi svneol=native#text/plain
+packages/hash/tests/fpcunithpack.lpr svneol=native#text/plain
 packages/hash/tests/tests.pp svneol=native#text/pascal
 packages/hash/tests/testshmac.pas svneol=native#text/pascal
+packages/hash/tests/uhpacktest1.pas svneol=native#text/plain
 packages/hermes/Makefile svneol=native#text/plain
 packages/hermes/Makefile.fpc svneol=native#text/plain
 packages/hermes/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -4957,36 +5020,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
@@ -5800,6 +5833,7 @@ packages/morphunits/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/morphunits/fpmake.pp svneol=native#text/plain
 packages/morphunits/src/agraphics.pas svneol=native#text/plain
 packages/morphunits/src/ahi.pas svneol=native#text/plain
+packages/morphunits/src/akeyboard.pas svneol=native#text/plain
 packages/morphunits/src/amigados.pas svneol=native#text/plain
 packages/morphunits/src/amigalib.pas svneol=native#text/plain
 packages/morphunits/src/asl.pas svneol=native#text/plain
@@ -5809,19 +5843,22 @@ packages/morphunits/src/cybergraphics.pas svneol=native#text/plain
 packages/morphunits/src/datatypes.pas svneol=native#text/plain
 packages/morphunits/src/diskfont.pas svneol=native#text/plain
 packages/morphunits/src/exec.pas svneol=native#text/plain
+packages/morphunits/src/gadtools.pas svneol=native#text/pascal
 packages/morphunits/src/get9.pas svneol=native#text/plain
 packages/morphunits/src/hardware.pas svneol=native#text/plain
+packages/morphunits/src/icon.pas svneol=native#text/pascal
 packages/morphunits/src/iffparse.pas svneol=native#text/plain
+packages/morphunits/src/input.pas svneol=native#text/plain
 packages/morphunits/src/inputevent.pas svneol=native#text/plain
 packages/morphunits/src/intuition.pas svneol=native#text/plain
 packages/morphunits/src/keymap.pas svneol=native#text/plain
-packages/morphunits/src/kvm.pas svneol=native#text/plain
 packages/morphunits/src/layers.pas svneol=native#text/plain
 packages/morphunits/src/mui.pas svneol=native#text/plain
 packages/morphunits/src/muihelper.pas svneol=native#text/plain
 packages/morphunits/src/timer.pas svneol=native#text/plain
 packages/morphunits/src/tinygl.pas svneol=native#text/plain
 packages/morphunits/src/utility.pas svneol=native#text/plain
+packages/morphunits/src/workbench.pas svneol=native#text/pascal
 packages/mysql/Makefile svneol=native#text/plain
 packages/mysql/Makefile.fpc svneol=native#text/plain
 packages/mysql/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -6252,6 +6289,22 @@ packages/os2units/src/mmio.pas svneol=native#text/plain
 packages/os2units/src/som.pas svneol=native#text/plain
 packages/os2units/src/sw.pas svneol=native#text/plain
 packages/os2units/src/wpstk.pp svneol=native#text/plain
+packages/os4units/Makefile svneol=native#text/plain
+packages/os4units/Makefile.fpc svneol=native#text/plain
+packages/os4units/Makefile.fpc.fpcmake svneol=native#text/plain
+packages/os4units/fpmake.pp svneol=native#text/pascal
+packages/os4units/src/agraphics.pas svneol=native#text/pascal
+packages/os4units/src/amigados.pas svneol=native#text/pascal
+packages/os4units/src/clipboard.pas svneol=native#text/pascal
+packages/os4units/src/exec.pas svneol=native#text/pascal
+packages/os4units/src/iffparse.pas svneol=native#text/pascal
+packages/os4units/src/inputevent.pas svneol=native#text/pascal
+packages/os4units/src/intuition.pas svneol=native#text/pascal
+packages/os4units/src/keymap.pas svneol=native#text/pascal
+packages/os4units/src/layers.pas svneol=native#text/pascal
+packages/os4units/src/mui.pas svneol=native#text/pascal
+packages/os4units/src/timer.pas svneol=native#text/pascal
+packages/os4units/src/utility.pas svneol=native#text/pascal
 packages/palmunits/Makefile svneol=native#text/plain
 packages/palmunits/Makefile.fpc svneol=native#text/plain
 packages/palmunits/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -6472,6 +6525,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
@@ -6604,6 +6661,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
@@ -6951,6 +7010,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
@@ -8103,6 +8163,7 @@ rtl/amicommon/classes.pp svneol=native#text/plain
 rtl/amicommon/dos.pp svneol=native#text/plain
 rtl/amicommon/osdebug.inc svneol=native#text/plain
 rtl/amicommon/osdebugh.inc svneol=native#text/plain
+rtl/amicommon/paramhandling.inc svneol=native#text/plain
 rtl/amicommon/rtldefs.inc svneol=native#text/plain
 rtl/amicommon/sysdir.inc svneol=native#text/plain
 rtl/amicommon/sysfile.inc svneol=native#text/plain
@@ -8151,6 +8212,7 @@ rtl/android/mipsel/prt0.as svneol=native#text/plain
 rtl/android/sysandroid.inc svneol=native#text/plain
 rtl/arm/arm.inc svneol=native#text/plain
 rtl/arm/armdefines.inc svneol=native#text/plain
+rtl/arm/cpu.pp svneol=native#text/pascal
 rtl/arm/divide.inc svneol=native#text/plain
 rtl/arm/int64p.inc svneol=native#text/plain
 rtl/arm/makefile.cpu svneol=native#text/plain
@@ -8524,6 +8586,7 @@ rtl/embedded/avr/attiny9.pp svneol=native#text/plain
 rtl/embedded/avr/avrcommon.inc svneol=native#text/plain
 rtl/embedded/avr/avrsim.pp svneol=native#text/plain
 rtl/embedded/avr/start.inc svneol=native#text/plain
+rtl/embedded/avr/start_noram.inc svneol=native#text/pascal
 rtl/embedded/buildrtl.lpi svneol=native#text/plain
 rtl/embedded/buildrtl.pp svneol=native#text/plain
 rtl/embedded/check.inc svneol=native#text/plain
@@ -8894,15 +8957,8 @@ rtl/linux/errnostr.inc svneol=native#text/plain
 rtl/linux/fpcylix.pp svneol=native#text/plain
 rtl/linux/fpmake.inc svneol=native#text/plain
 rtl/linux/i386/bsyscall.inc svneol=native#text/plain
-rtl/linux/i386/cprt0.as svneol=native#text/plain
-rtl/linux/i386/cprt21.as svneol=native#text/plain
-rtl/linux/i386/dllprt0.as svneol=native#text/plain
-rtl/linux/i386/gprt0.as svneol=native#text/plain
-rtl/linux/i386/gprt21.as svneol=native#text/plain
-rtl/linux/i386/prt0.as svneol=native#text/plain
 rtl/linux/i386/si_c.inc svneol=native#text/plain
 rtl/linux/i386/si_c21.inc svneol=native#text/plain
-rtl/linux/i386/si_c21g.inc svneol=native#text/plain
 rtl/linux/i386/si_dll.inc svneol=native#text/plain
 rtl/linux/i386/si_g.inc svneol=native#text/plain
 rtl/linux/i386/si_prc.inc svneol=native#text/plain
@@ -9375,6 +9431,7 @@ rtl/objpas/sysutils/sysint.inc svneol=native#text/plain
 rtl/objpas/sysutils/sysinth.inc svneol=native#text/plain
 rtl/objpas/sysutils/syspch.inc svneol=native#text/plain
 rtl/objpas/sysutils/syspchh.inc svneol=native#text/plain
+rtl/objpas/sysutils/syssr.inc svneol=native#text/plain
 rtl/objpas/sysutils/sysstr.inc svneol=native#text/plain
 rtl/objpas/sysutils/sysstrh.inc svneol=native#text/plain
 rtl/objpas/sysutils/systhrdh.inc svneol=native#text/plain
@@ -9792,7 +9849,6 @@ rtl/win32/Makefile.fpc svneol=native#text/plain
 rtl/win32/buildrtl.lpi svneol=native#text/plain
 rtl/win32/buildrtl.pp svneol=native#text/plain
 rtl/win32/classes.pp svneol=native#text/plain
-rtl/win32/gprt0.as svneol=native#text/plain
 rtl/win32/initc.pp svneol=native#text/plain
 rtl/win32/objinc.inc svneol=native#text/plain
 rtl/win32/rtldefs.inc svneol=native#text/plain
@@ -9803,11 +9859,8 @@ rtl/win32/sysinitcyg.pp svneol=native#text/plain
 rtl/win32/sysinitgprof.pp svneol=native#text/plain
 rtl/win32/sysinitpas.pp svneol=native#text/plain
 rtl/win32/system.pp svneol=native#text/plain
-rtl/win32/wcygprt0.as svneol=native#text/plain
-rtl/win32/wdllprt0.as svneol=native#text/plain
 rtl/win32/windows.pp svneol=native#text/plain
 rtl/win32/winsysut.pp svneol=native#text/plain
-rtl/win32/wprt0.as svneol=native#text/plain
 rtl/win64/Makefile svneol=native#text/plain
 rtl/win64/Makefile.fpc svneol=native#text/plain
 rtl/win64/buildrtl.lpi svneol=native#text/plain
@@ -9942,6 +9995,7 @@ tests/bench/shortbench.pp svneol=native#text/plain
 tests/bench/stream.pp svneol=native#text/plain
 tests/bench/timer.pas svneol=native#text/plain
 tests/bench/whet.pas svneol=native#text/plain
+tests/createlst.mak svneol=native#text/plain
 tests/dbdigest.cfg.example -text
 tests/readme.txt svneol=native#text/plain
 tests/tbf/tb0001.pp svneol=native#text/plain
@@ -10820,10 +10874,14 @@ tests/tbs/tb0610.pp svneol=native#text/pascal
 tests/tbs/tb0611.pp svneol=native#text/pascal
 tests/tbs/tb0612.pp svneol=native#text/pascal
 tests/tbs/tb0613.pp svneol=native#text/pascal
+tests/tbs/tb0614.pp svneol=native#text/pascal
+tests/tbs/tb0615.pp svneol=native#text/pascal
+tests/tbs/tb0616.pp svneol=native#text/pascal
+tests/tbs/tb0617.pp svneol=native#text/pascal
+tests/tbs/tb0618.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain
-tests/tbs/tbs0594.pp svneol=native#text/pascal
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain
@@ -11510,6 +11568,7 @@ tests/test/cpu16/i8086/tmmt.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tprcdat1.pp svneol=native#text/plain
 tests/test/cpu16/i8086/tptrcon.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tptrsize.pp svneol=native#text/pascal
+tests/test/cpu16/i8086/tra1.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tretf1.pp svneol=native#text/plain
 tests/test/cpu16/i8086/tretf2.pp svneol=native#text/plain
 tests/test/cpu16/i8086/ttasm1.pp svneol=native#text/plain
@@ -11564,6 +11623,7 @@ tests/test/jvm/tnestproc.pp svneol=native#text/plain
 tests/test/jvm/topovl.pp svneol=native#text/plain
 tests/test/jvm/toverload.pp svneol=native#text/plain
 tests/test/jvm/toverload2.pp svneol=native#text/plain
+tests/test/jvm/tprocvaranon.pp svneol=native#text/plain
 tests/test/jvm/tprop.pp svneol=native#text/plain
 tests/test/jvm/tprop2.pp svneol=native#text/plain
 tests/test/jvm/tprop3.pp svneol=native#text/plain
@@ -11587,6 +11647,7 @@ tests/test/jvm/tsetansistr.pp svneol=native#text/plain
 tests/test/jvm/tsetstring.pp svneol=native#text/plain
 tests/test/jvm/tsmallintarr.pp svneol=native#text/plain
 tests/test/jvm/tstr.pp svneol=native#text/plain
+tests/test/jvm/tstring.pp svneol=native#text/plain
 tests/test/jvm/tstring1.pp svneol=native#text/plain
 tests/test/jvm/tstring9.pp svneol=native#text/plain
 tests/test/jvm/tstrreal1.pp svneol=native#text/plain
@@ -11608,6 +11669,7 @@ tests/test/jvm/tvirtclmeth.pp svneol=native#text/plain
 tests/test/jvm/tw20212.pp svneol=native#text/plain
 tests/test/jvm/tw22807.pp svneol=native#text/plain
 tests/test/jvm/tw24089.pp svneol=native#text/plain
+tests/test/jvm/tw29585.pp svneol=native#text/plain
 tests/test/jvm/twith.pp svneol=native#text/plain
 tests/test/jvm/uenum.pp svneol=native#text/plain
 tests/test/jvm/ujsetter.pp svneol=native#text/plain
@@ -11652,6 +11714,7 @@ tests/test/opt/tdfa14.pp svneol=native#text/pascal
 tests/test/opt/tdfa15.pp svneol=native#text/pascal
 tests/test/opt/tdfa16.pp svneol=native#text/pascal
 tests/test/opt/tdfa17.pp svneol=native#text/pascal
+tests/test/opt/tdfa18.pp svneol=native#text/pascal
 tests/test/opt/tdfa2.pp svneol=native#text/pascal
 tests/test/opt/tdfa3.pp svneol=native#text/pascal
 tests/test/opt/tdfa4.pp svneol=native#text/pascal
@@ -12065,7 +12128,9 @@ tests/test/textthr.pp svneol=native#text/plain
 tests/test/tfillchr.pp svneol=native#text/plain
 tests/test/tfinal1.pp svneol=native#text/pascal
 tests/test/tfinal2.pp svneol=native#text/pascal
-tests/test/tfma1.pp svneol=native#text/pascal
+tests/test/tfma1.inc svneol=native#text/plain
+tests/test/tfma1arm.pp svneol=native#text/pascal
+tests/test/tfma1x86.pp svneol=native#text/pascal
 tests/test/tforin1.pp svneol=native#text/pascal
 tests/test/tforin10.pp svneol=native#text/plain
 tests/test/tforin11.pp svneol=native#text/plain
@@ -12242,6 +12307,21 @@ tests/test/tgeneric96.pp svneol=native#text/pascal
 tests/test/tgeneric97.pp svneol=native#text/pascal
 tests/test/tgeneric98.pp svneol=native#text/pascal
 tests/test/tgeneric99.pp svneol=native#text/pascal
+tests/test/tgenfunc1.pp svneol=native#text/pascal
+tests/test/tgenfunc10.pp svneol=native#text/pascal
+tests/test/tgenfunc11.pp svneol=native#text/pascal
+tests/test/tgenfunc12.pp svneol=native#text/pascal
+tests/test/tgenfunc13.pp svneol=native#text/pascal
+tests/test/tgenfunc14.pp svneol=native#text/pascal
+tests/test/tgenfunc15.pp svneol=native#text/pascal
+tests/test/tgenfunc2.pp svneol=native#text/pascal
+tests/test/tgenfunc3.pp svneol=native#text/pascal
+tests/test/tgenfunc4.pp svneol=native#text/pascal
+tests/test/tgenfunc5.pp svneol=native#text/pascal
+tests/test/tgenfunc6.pp svneol=native#text/pascal
+tests/test/tgenfunc7.pp svneol=native#text/pascal
+tests/test/tgenfunc8.pp svneol=native#text/pascal
+tests/test/tgenfunc9.pp svneol=native#text/pascal
 tests/test/tgoto.pp svneol=native#text/plain
 tests/test/theap.pp svneol=native#text/plain
 tests/test/theapthread.pp svneol=native#text/plain
@@ -12849,6 +12929,7 @@ tests/test/tutf8cpl.pp svneol=native#text/plain
 tests/test/tvarpropsetter1.pp svneol=native#text/plain
 tests/test/tvarpropsetter2.pp svneol=native#text/plain
 tests/test/tvarset1.pp svneol=native#text/plain
+tests/test/tw29833.pp svneol=native#text/plain
 tests/test/twarn1.pp svneol=native#text/pascal
 tests/test/tweaklib1.pp svneol=native#text/plain
 tests/test/tweaklib2.pp svneol=native#text/plain
@@ -12896,6 +12977,7 @@ tests/test/ugeneric96b.pp svneol=native#text/pascal
 tests/test/ugeneric96c.pp svneol=native#text/pascal
 tests/test/ugeneric96d.pp svneol=native#text/pascal
 tests/test/ugeneric99.pp svneol=native#text/pascal
+tests/test/ugenfunc7.pp svneol=native#text/pascal
 tests/test/uhintdir.pp svneol=native#text/plain
 tests/test/uhlp3.pp svneol=native#text/pascal
 tests/test/uhlp31.pp svneol=native#text/pascal
@@ -13146,6 +13228,7 @@ tests/test/units/sysutils/tstrcmp.pp svneol=native#text/plain
 tests/test/units/sysutils/tstrtobool.pp svneol=native#text/plain
 tests/test/units/sysutils/tunifile.pp svneol=native#text/plain
 tests/test/units/sysutils/tuplow.pp svneol=native#text/plain
+tests/test/units/sysutils/twstralloc.pp svneol=native#text/plain
 tests/test/units/sysutils/twstrcmp.pp svneol=native#text/plain
 tests/test/units/ucomplex/tcsqr1.pp svneol=native#text/pascal
 tests/test/units/variants/tcustomvariant.pp svneol=native#text/plain
@@ -13480,6 +13563,7 @@ tests/webtbf/tw2972b.pp svneol=native#text/plain
 tests/webtbf/tw2983a.pp svneol=native#text/plain
 tests/webtbf/tw2996.pp svneol=native#text/plain
 tests/webtbf/tw3000.pp svneol=native#text/plain
+tests/webtbf/tw30022.pp svneol=native#text/plain
 tests/webtbf/tw3047.pp svneol=native#text/plain
 tests/webtbf/tw3114.pp svneol=native#text/plain
 tests/webtbf/tw3116.pp svneol=native#text/plain
@@ -14748,6 +14832,7 @@ tests/webtbs/tw2708.pp svneol=native#text/plain
 tests/webtbs/tw2710.pp svneol=native#text/plain
 tests/webtbs/tw27120.pp svneol=native#text/pascal
 tests/webtbs/tw2713.pp svneol=native#text/plain
+tests/webtbs/tw27149.pp svneol=native#text/plain
 tests/webtbs/tw27153.pp svneol=native#text/pascal
 tests/webtbs/tw27173.pp svneol=native#text/pascal
 tests/webtbs/tw27185.pp svneol=native#text/pascal
@@ -14830,14 +14915,21 @@ tests/webtbs/tw2853e.pp svneol=native#text/plain
 tests/webtbs/tw2859.pp svneol=native#text/plain
 tests/webtbs/tw28593.pp svneol=native#text/plain
 tests/webtbs/tw28632.pp -text svneol=native#text/plain
+tests/webtbs/tw28641.pp svneol=native#text/plain
 tests/webtbs/tw2865.pp svneol=native#text/plain
 tests/webtbs/tw28650.pp svneol=native#text/pascal
+tests/webtbs/tw28667.pp svneol=native#text/plain
+tests/webtbs/tw28668.pp svneol=native#text/plain
 tests/webtbs/tw28674.pp svneol=native#text/pascal
+tests/webtbs/tw28702.pp svneol=native#text/plain
+tests/webtbs/tw28713.pp svneol=native#text/pascal
+tests/webtbs/tw28713b.pp svneol=native#text/pascal
 tests/webtbs/tw28718a.pp svneol=native#text/plain
 tests/webtbs/tw28718b.pp svneol=native#text/plain
 tests/webtbs/tw28718c.pp svneol=native#text/plain
 tests/webtbs/tw28718d.pp svneol=native#text/plain
 tests/webtbs/tw28748.pp svneol=native#text/plain
+tests/webtbs/tw28749.pp svneol=native#text/plain
 tests/webtbs/tw2876.pp svneol=native#text/plain
 tests/webtbs/tw28766.pp svneol=native#text/pascal
 tests/webtbs/tw28801.pp svneol=native#text/plain
@@ -14846,40 +14938,78 @@ tests/webtbs/tw2885.pp svneol=native#text/plain
 tests/webtbs/tw28850.pp svneol=native#text/plain
 tests/webtbs/tw2886.pp svneol=native#text/plain
 tests/webtbs/tw2891.pp svneol=native#text/plain
+tests/webtbs/tw28916.pp svneol=native#text/pascal
 tests/webtbs/tw2892.pp svneol=native#text/plain
 tests/webtbs/tw28934.pp svneol=native#text/plain
+tests/webtbs/tw28948.pp svneol=native#text/plain
+tests/webtbs/tw28964.pp svneol=native#text/plain
 tests/webtbs/tw2897.pp svneol=native#text/plain
 tests/webtbs/tw2899.pp svneol=native#text/plain
 tests/webtbs/tw29010a.pp svneol=native#text/plain
 tests/webtbs/tw29010b.pp svneol=native#text/plain
 tests/webtbs/tw29010c.pp svneol=native#text/plain
+tests/webtbs/tw29030.pp svneol=native#text/plain
 tests/webtbs/tw2904.pp svneol=native#text/plain
 tests/webtbs/tw29040.pp svneol=native#text/plain
+tests/webtbs/tw29053.pp svneol=native#text/pascal
+tests/webtbs/tw29053b.pp svneol=native#text/pascal
+tests/webtbs/tw29064.pp svneol=native#text/plain
 tests/webtbs/tw2908.pp svneol=native#text/plain
+tests/webtbs/tw29080.pp svneol=native#text/pascal
+tests/webtbs/tw29086.pp -text svneol=native#text/plain
+tests/webtbs/tw29096.pp svneol=native#text/plain
 tests/webtbs/tw2911.pp svneol=native#text/plain
 tests/webtbs/tw2912.pp svneol=native#text/plain
 tests/webtbs/tw2913.pp svneol=native#text/plain
+tests/webtbs/tw29153.pp svneol=native#text/plain
 tests/webtbs/tw2916.pp svneol=native#text/plain
 tests/webtbs/tw2920.pp svneol=native#text/plain
 tests/webtbs/tw2923.pp svneol=native#text/plain
+tests/webtbs/tw29244.pp svneol=native#text/pascal
+tests/webtbs/tw29250.pp svneol=native#text/pascal
 tests/webtbs/tw2926.pp svneol=native#text/plain
 tests/webtbs/tw2927.pp svneol=native#text/plain
+tests/webtbs/tw29321.pp svneol=native#text/pascal
+tests/webtbs/tw29353.pp -text svneol=native#text/plain
+tests/webtbs/tw29372.pp svneol=native#text/pascal
 tests/webtbs/tw2942a.pp svneol=native#text/plain
 tests/webtbs/tw2942b.pp svneol=native#text/plain
 tests/webtbs/tw2943.pp svneol=native#text/plain
 tests/webtbs/tw2944.pp svneol=native#text/plain
+tests/webtbs/tw29444.pp svneol=native#text/pascal
 tests/webtbs/tw2946.pp svneol=native#text/plain
+tests/webtbs/tw29471.pp svneol=native#text/plain
 tests/webtbs/tw2949.pp svneol=native#text/plain
 tests/webtbs/tw2953.pp svneol=native#text/plain
+tests/webtbs/tw29546.pp svneol=native#text/pascal
+tests/webtbs/tw29547.pp svneol=native#text/plain
 tests/webtbs/tw2956.pp svneol=native#text/plain
 tests/webtbs/tw2958.pp svneol=native#text/plain
+tests/webtbs/tw29585.pp svneol=native#text/plain
+tests/webtbs/tw29609.pp svneol=native#text/pascal
+tests/webtbs/tw29620.pp svneol=native#text/plain
 tests/webtbs/tw2966.pp svneol=native#text/plain
+tests/webtbs/tw29669.pp svneol=native#text/plain
+tests/webtbs/tw29669a.pp svneol=native#text/plain
+tests/webtbs/tw29745.pp svneol=native#text/pascal
 tests/webtbs/tw2975.pp svneol=native#text/plain
 tests/webtbs/tw2976.pp svneol=native#text/plain
+tests/webtbs/tw29792.pp svneol=native#text/pascal
 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/tw29912.pp svneol=native#text/plain
+tests/webtbs/tw29923.pp svneol=native#text/plain
+tests/webtbs/tw29930.pp svneol=native#text/plain
+tests/webtbs/tw29933.pp svneol=native#text/plain
+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/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/tw3010.pp svneol=native#text/plain
@@ -15558,6 +15688,7 @@ tests/webtbs/uw2738.pp svneol=native#text/plain
 tests/webtbs/uw2834.pp svneol=native#text/plain
 tests/webtbs/uw28442.pp svneol=native#text/pascal
 tests/webtbs/uw28766.pp svneol=native#text/pascal
+tests/webtbs/uw28964.pp svneol=native#text/plain
 tests/webtbs/uw2920.pp svneol=native#text/plain
 tests/webtbs/uw2956.pp svneol=native#text/plain
 tests/webtbs/uw2984.pp svneol=native#text/plain

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: help
-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
@@ -333,8 +333,7 @@ endif
 endif
 override PACKAGE_NAME=fpc
 override PACKAGE_VERSION=3.1.1
-REQUIREDVERSION=2.6.4
-REQUIREDVERSION2=3.0.0
+REQUIREDVERSION=3.0.0
 ifndef inOS2
 override FPCDIR:=$(BASEDIR)
 export FPCDIR
@@ -476,7 +475,7 @@ endif
 endif
 BuildOnlyBaseCPUs=jvm
 ifneq ($(wildcard utils),)
-NOUTILSTARGETS=embedded gba nds msdos win16 $(BuildOnlyBaseCPUs)
+NOUTILSTARGETS=embedded gba nds msdos $(BuildOnlyBaseCPUs)
 ifeq ($(findstring $(OS_TARGET),$(NOUTILSTARGETS)),)
 ifdef BUILDFULLNATIVE
 UTILS=1
@@ -720,9 +719,6 @@ endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
-ifeq ($(FULL_TARGET),i8086-win16)
-override TARGET_DIRS+=compiler rtl utils packages ide installer
-endif
 ifeq ($(FULL_TARGET),aarch64-linux)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
@@ -1129,12 +1125,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)
@@ -2531,14 +2521,6 @@ TARGET_DIRS_PACKAGES=1
 TARGET_DIRS_IDE=1
 TARGET_DIRS_INSTALLER=1
 endif
-ifeq ($(FULL_TARGET),i8086-win16)
-TARGET_DIRS_COMPILER=1
-TARGET_DIRS_RTL=1
-TARGET_DIRS_UTILS=1
-TARGET_DIRS_PACKAGES=1
-TARGET_DIRS_IDE=1
-TARGET_DIRS_INSTALLER=1
-endif
 ifeq ($(FULL_TARGET),aarch64-linux)
 TARGET_DIRS_COMPILER=1
 TARGET_DIRS_RTL=1
@@ -2851,8 +2833,7 @@ override TARGET_DIRS:=$(wildcard $(TARGET_DIRS))
 help:
 	@$(ECHO)
 	@$(ECHO) Targets
-	@$(ECHO)    all         Alias for build
-	@$(ECHO)    build       Build a new compiler and all packages
+	@$(ECHO)    all         Build a new compiler and all packages
 	@$(ECHO)    install     Install newly build files
 	@$(ECHO)    zipinstall  Create zip/tar of installed files
 	@$(ECHO)    singlezipinstall  Alias for zipinstall

Makefile.fpc

@@ -20,11 +20,7 @@ fpcdir=.
 rule=help
 
 [prerules]
-REQUIREDVERSION=2.6.4
-# Accept 3.0.0, without requiring to using OVERRIDEVERSIONCHECK=1
-# 3.0.0 should become REQUIREDVERSION after 3.0.0 final release
-# and 2.6.4 should be moved to REQUIREDVERSION2
-REQUIREDVERSION2=3.0.0
+REQUIREDVERSION=3.0.0
 
 
 # make versions < 3.77 (OS2 version) are buggy
@@ -236,8 +232,7 @@ override TARGET_DIRS:=$(wildcard $(TARGET_DIRS))
 help:
         @$(ECHO)
         @$(ECHO) Targets
-        @$(ECHO)    all         Alias for build
-        @$(ECHO)    build       Build a new compiler and all packages
+        @$(ECHO)    all         Build a new compiler and all packages
         @$(ECHO)    install     Install newly build files
         @$(ECHO)    zipinstall  Create zip/tar of installed files
         @$(ECHO)    singlezipinstall  Alias for zipinstall

compiler/Makefile

@@ -1,5 +1,5 @@
 #
-# 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 [2016/01/04]
 #
 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
@@ -514,11 +514,6 @@ endif
 ifeq ($(PPC_TARGET),sparc)
 override LOCALOPT+=
 endif
-ifeq ($(PPC_TARGET),m68k)
-ifeq ($(OS_TARGET),amiga)
-override LOCALOPT+=-Ct
-endif
-endif
 ifeq ($(PPC_TARGET),arm)
 override LOCALOPT+=
 endif

compiler/Makefile.fpc

@@ -271,13 +271,6 @@ ifeq ($(PPC_TARGET),sparc)
 override LOCALOPT+=
 endif
 
-# m68k specific with low stack
-ifeq ($(PPC_TARGET),m68k)
-ifeq ($(OS_TARGET),amiga)
-override LOCALOPT+=-Ct
-endif
-endif
-
 # ARM specific
 ifeq ($(PPC_TARGET),arm)
 override LOCALOPT+=

compiler/aarch64/cgcpu.pas

@@ -812,7 +812,7 @@ implementation
         if fromsize in [OS_64,OS_S64] then
           begin
             { split into two 32 bit loads }
-            hreg1:=makeregsize(register,OS_32);
+            hreg1:=getintregister(list,OS_32);
             hreg2:=getintregister(list,OS_32);
             if target_info.endian=endian_big then
               begin
@@ -831,6 +831,7 @@ implementation
                 inc(href.offset,4);
                 a_load_ref_reg(list,OS_32,OS_32,href,hreg2);
               end;
+            a_load_reg_reg(list,OS_32,OS_64,hreg1,register);
             list.concat(taicpu.op_reg_reg_const_const(A_BFI,register,makeregsize(hreg2,OS_64),32,32));
           end
        else
@@ -1340,7 +1341,7 @@ implementation
 
     procedure tcgaarch64.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: topcg; size: tcgsize; src1, src2, dst: tregister; setflags : boolean; var ovloc : tlocation);
       var
-        tmpreg1: tregister;
+        tmpreg1, tmpreg2: tregister;
       begin
         ovloc.loc:=LOC_VOID;
         { overflow can only occur with 64 bit calculations on 64 bit cpus }
@@ -1360,9 +1361,7 @@ implementation
                       ovloc.resflags:=F_CC
                   else
                     ovloc.resflags:=F_VS;
-                  { finished; since we won't call through to a_op_reg_reg_reg,
-                    adjust the result here if necessary }
-                  maybeadjustresult(list,op,size,dst);
+                  { finished }
                   exit;
                 end;
               OP_MUL:
@@ -1377,17 +1376,22 @@ implementation
                 end;
               OP_IMUL:
                 begin
-                  { check whether the sign bit of the (128 bit) result is the
-                    same as "sign bit of src1" xor "signbit of src2" (if so, no
-                    overflow and the xor-product of all sign bits is 0) }
+                  { check whether the upper 64 bits of the 128 bit multiplication
+                    result have the same value as the replicated sign bit of the
+                    lower 64 bits }
                   tmpreg1:=getintregister(list,OS_64);
                   list.concat(taicpu.op_reg_reg_reg(A_SMULH,tmpreg1,src2,src1));
-                  list.concat(taicpu.op_reg_reg_reg(A_EOR,tmpreg1,tmpreg1,src1));
-                  list.concat(taicpu.op_reg_reg_reg(A_EOR,tmpreg1,tmpreg1,src2));
-                  list.concat(taicpu.op_reg_const(A_TST,tmpreg1,$80000000));
+                  { calculate lower 64 bits (afterwards, because dst may be
+                    equal to src1 or src2) }
+                  a_op_reg_reg_reg(list,op,size,src1,src2,dst);
+                  { replicate sign bit }
+                  tmpreg2:=getintregister(list,OS_64);
+                  a_op_const_reg_reg(list,OP_SAR,OS_S64,63,dst,tmpreg2);
+                  list.concat(taicpu.op_reg_reg(A_CMP,tmpreg1,tmpreg2));
                   ovloc.loc:=LOC_FLAGS;
                   ovloc.resflags:=F_NE;
-                  { still have to perform the actual multiplication }
+                  { finished }
+                  exit;
                 end;
               OP_IDIV,
               OP_DIV:

compiler/aarch64/hlcgcpu.pas

@@ -208,7 +208,8 @@ implementation
     begin
       if slopt in [SL_SETZERO,SL_SETMAX] then
         inherited
-      else if not(sreg.bitlen in [32,64]) then
+      else if not(sreg.bitlen in [32,64]) or
+              (sreg.startbit<>0) then
         begin
           makeregssamesize(list,def_cgsize(fromsize),sreg.subsetregsize,fromreg,sreg.subsetreg,fromreg,toreg);
           list.concat(taicpu.op_reg_reg_const_const(A_BFI,toreg,fromreg,sreg.startbit,sreg.bitlen))

compiler/aasmbase.pas

@@ -42,7 +42,10 @@ interface
          { global in the current program/library, but not visible outside it }
          AB_PRIVATE_EXTERN,AB_LAZY,AB_IMPORT,
          { a symbol that's internal to the compiler and used as a temp }
-         AB_TEMP);
+         AB_TEMP,
+         { a global symbol that points to another global symbol and is only used
+           to allow indirect loading in case of packages and indirect imports }
+         AB_INDIRECT,AB_EXTERNAL_INDIRECT);
 
        TAsmsymtype=(
          AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL,
@@ -65,7 +68,9 @@ interface
     const
        asmlabeltypeprefix : array[TAsmLabeltype] of char = ('j','a','d','l','f','t','c');
        asmsymbindname : array[TAsmsymbind] of string[23] = ('none', 'external','common',
-       'local','global','weak external','private external','lazy','import','internal temp');
+       'local','global','weak external','private external','lazy','import','internal temp',
+       'indirect','external indirect');
+       asmsymbindindirect = [AB_INDIRECT,AB_EXTERNAL_INDIRECT];
 
     type
        TAsmSectiontype=(sec_none,
@@ -98,6 +103,8 @@ interface
          sec_debug_info,
          sec_debug_line,
          sec_debug_abbrev,
+         sec_debug_aranges,
+         sec_debug_ranges,
          { Yury: "sec_fpc is intended for storing fpc specific data
                   which must be recognized and processed specially by linker.
                   Currently fpc version string, dummy links to stab sections
@@ -151,6 +158,8 @@ interface
          sec_heap
        );
 
+       TObjCAsmSectionType = sec_objc_class..sec_objc_protolist;
+
        TAsmSectionOrder = (secorder_begin,secorder_default,secorder_end);
 
        TAsmSymbol = class(TFPHashObject)

compiler/aasmcnst.pas

@@ -93,6 +93,9 @@ type
      function valuecount: longint;
      procedure insertvaluebeforepos(val: tai_abstracttypedconst; pos: longint);
      function replacevalueatpos(val: tai_abstracttypedconst; pos: longint): tai_abstracttypedconst;
+     { change the type to a record, regardless of how the aggregate was created;
+       the size of the original type and the record must match }
+     procedure changetorecord(_def: trecorddef);
      procedure finish;
      destructor destroy; override;
    end;
@@ -123,7 +126,9 @@ type
      { item in the above list }
      tcalo_vectorized_dead_strip_item,
      { end of the above list }
-     tcalo_vectorized_dead_strip_end
+     tcalo_vectorized_dead_strip_end,
+     { symbol should be weakle defined }
+     tcalo_weak
    );
    ttcasmlistoptions = set of ttcasmlistoption;
 
@@ -133,7 +138,6 @@ type
     private
      fnextfieldname: TIDString;
      function getcuroffset: asizeint;
-     function getfieldoffset(l: longint): asizeint;
      procedure setnextfieldname(AValue: TIDString);
     protected
      { type of the aggregate }
@@ -173,7 +177,6 @@ type
      property curfield: tfieldvarsym read fcurfield write fcurfield;
      property nextfield: tfieldvarsym read fnextfield write fnextfield;
      property nextfieldname: TIDString write setnextfieldname;
-     property fieldoffset[l: longint]: asizeint read getfieldoffset;
      property curoffset: asizeint read getcuroffset;
      property anonrecord: boolean read fanonrecord write fanonrecord;
    end;
@@ -184,6 +187,7 @@ type
    ttypedconstplaceholder = class abstract
      def: tdef;
      constructor create(d: tdef);
+     { same usage as ttai_typedconstbuilder.emit_tai }
      procedure replace(ai: tai; d: tdef); virtual; abstract;
    end;
 
@@ -300,6 +304,7 @@ type
     protected
      procedure maybe_emit_tail_padding(def: tdef); virtual;
      function emit_string_const_common(stringtype: tstringtype; len: asizeint; encoding: tstringencoding; var startlab: tasmlabel):tasmlabofs;
+     function get_dynstring_def_for_type(stringtype: tstringtype; winlikewidestring: boolean): tstringdef;
      procedure begin_aggregate_internal(def: tdef; anonymous: boolean); virtual;
      procedure end_aggregate_internal(def: tdef; anonymous: boolean); virtual;
      { when building an anonymous record, we cannot immediately insert the
@@ -326,6 +331,8 @@ type
 
      { emit a shortstring constant, and return its def }
      function emit_shortstring_const(const str: shortstring): tdef;
+     { emit a pchar string constant (the characters, not a pointer to them), and return its def }
+     function emit_pchar_const(str: pchar; len: pint): tdef;
      { emit a guid constant }
      procedure emit_guid_const(const guid: tguid);
      { emit a procdef constant }
@@ -364,10 +371,11 @@ type
        useful in case you have table preceded by the number of elements, and
        you cound the elements while building the table }
      function emit_placeholder(def: tdef): ttypedconstplaceholder; virtual; abstract;
+    protected
      { common code to check whether a placeholder can be added at the current
        position }
      procedure check_add_placeholder(def: tdef);
-
+    public
      { The next group of routines are for constructing complex expressions.
        While parsing a typed constant these operators are encountered from
        outer to inner, so that is also the order in which they should be
@@ -423,7 +431,7 @@ type
        over the symtables of the entire inheritance tree }
      property next_field: tfieldvarsym write set_next_field;
      { set the name of the next field that will be emitted for an anonymous
-       record (or the next of the next started anonymous record) }
+       record (also if that field is a nested anonymous record) }
      property next_field_name: TIDString write set_next_field_name;
     protected
      { this one always return the actual offset, called by the above (and
@@ -487,15 +495,6 @@ implementation
       end;
 
 
-    function taggregateinformation.getfieldoffset(l: longint): asizeint;
-      var
-        field: tfieldvarsym;
-      begin
-        field:=tfieldvarsym(tabstractrecorddef(def).symtable.symlist[l]);
-        result:=field.fieldoffset;
-      end;
-
-
     procedure taggregateinformation.setnextfieldname(AValue: TIDString);
       begin
         if (fnextfieldname<>'') or
@@ -516,6 +515,7 @@ implementation
 
     function taggregateinformation.prepare_next_field(nextfielddef: tdef): asizeint;
       var
+        sym: tsym;
         currentoffset,nextoffset: asizeint;
         i: longint;
       begin
@@ -544,14 +544,16 @@ implementation
               end
             else if fnextfieldname<>'' then
               internalerror(2015071501);
+            currentoffset:=curoffset;
             { find next field }
             i:=curindex;
             repeat
               inc(i);
-            until (tsym(tabstractrecorddef(def).symtable.symlist[i]).typ=fieldvarsym) and
-              not(sp_static in tsym(tabstractrecorddef(def).symtable.symlist[i]).symoptions);
-            nextoffset:=fieldoffset[i];
-            currentoffset:=curoffset;
+              sym:=tsym(tabstractrecorddef(def).symtable.symlist[i]);
+            until (sym.typ=fieldvarsym) and
+              not(sp_static in sym.symoptions);
+            curfield:=tfieldvarsym(sym);
+            nextoffset:=curfield.fieldoffset;
             curindex:=i;
           end;
         { need padding? }
@@ -752,6 +754,17 @@ implementation
      end;
 
 
+   procedure tai_aggregatetypedconst.changetorecord(_def: trecorddef);
+     begin
+       { must be a record of the same size as the current data }
+       if assigned(fdef) and
+          (fdef.size<>_def.size) then
+         internalerror(2015122402);
+       fdef:=_def;
+       fadetyp:=tck_record;
+     end;
+
+
    procedure tai_aggregatetypedconst.finish;
      begin
        if fisstring then
@@ -926,12 +939,15 @@ implementation
          end;
 
        if not(tcalo_is_lab in options) then
-         if sym.bind=AB_GLOBAL then
-           prelist.concat(tai_symbol.Create_Global(sym,0))
-         else
+         if sym.bind=AB_LOCAL then
            prelist.concat(tai_symbol.Create(sym,0))
+         else
+           prelist.concat(tai_symbol.Create_Global(sym,0))
        else
          prelist.concat(tai_label.Create(tasmlabel(sym)));
+
+       if tcalo_weak in options then
+         prelist.concat(tai_directive.Create(asd_weak_definition,sym.name));
        { insert the symbol information before the data }
        fasmlist.insertlist(prelist);
        { end of the symbol }
@@ -949,6 +965,7 @@ implementation
        customsecname: boolean;
      begin
        fvectorized_finalize_called:=true;
+       sym:=nil;
        customsecname:=get_vectorized_dead_strip_custom_section_name(basename,st,secname);
        if customsecname then
          sectype:=sec_user
@@ -970,7 +987,7 @@ implementation
              internalerror(2015110802);
            sym:=get_vectorized_dead_strip_section_symbol_end(basename,st,true);
            if not customsecname then
-             make_mangledname(basename,st,'3_END');
+             secname:=make_mangledname(basename,st,'3_END');
          end
        else if tcalo_vectorized_dead_strip_item in options then
          begin
@@ -1285,6 +1302,21 @@ implementation
      end;
 
 
+   function ttai_typedconstbuilder.get_dynstring_def_for_type(stringtype: tstringtype; winlikewidestring: boolean): tstringdef;
+     begin
+       if stringtype=st_ansistring then
+         result:=tstringdef(cansistringtype)
+       else if (stringtype=st_unicodestring) or
+               ((stringtype=st_widestring) and
+                not winlikewidestring) then
+         result:=tstringdef(cunicodestringtype)
+       else if stringtype=st_widestring then
+         result:=tstringdef(cwidestringtype)
+       else
+         internalerror(2015122101);
+     end;
+
+
    procedure ttai_typedconstbuilder.begin_aggregate_internal(def: tdef; anonymous: boolean);
      var
        info: taggregateinformation;
@@ -1340,11 +1372,17 @@ implementation
 
 
    class function ttai_typedconstbuilder.get_vectorized_dead_strip_section_symbol(const basename: string; st: tsymtable; define, start: boolean): tasmsymbol;
+     var
+       name: TSymStr;
      begin
        if start then
-         result:=current_asmdata.DefineAsmSymbol(make_mangledname(basename,st,'START'),AB_GLOBAL,AT_DATA)
+         name:=make_mangledname(basename,st,'START')
        else
-         result:=current_asmdata.DefineAsmSymbol(make_mangledname(basename,st,'END'),AB_GLOBAL,AT_DATA);
+         name:=make_mangledname(basename,st,'END');
+       if define then
+         result:=current_asmdata.DefineAsmSymbol(name,AB_GLOBAL,AT_DATA)
+       else
+         result:=current_asmdata.RefAsmSymbol(name,AT_DATA)
      end;
 
 
@@ -1416,6 +1454,7 @@ implementation
        startlab: tasmlabel;
        datadef: tdef;
        datatcb: ttai_typedconstbuilder;
+       unicodestrrecdef: trecorddef;
      begin
        start_internal_data_builder(datalist,sec_rodata_norel,'',datatcb,startlab);
        strlength:=getlengthwidestring(pcompilerwidestring(data));
@@ -1455,18 +1494,18 @@ implementation
            { ending #0 }
            datatcb.emit_tai(Tai_const.Create_16bit(0),cwidechartype);
            datatcb.maybe_end_aggregate(datadef);
-           datatcb.end_anonymous_record;
+           unicodestrrecdef:=datatcb.end_anonymous_record;
          end
        else
          { code generation for other sizes must be written }
          internalerror(200904271);
-       finish_internal_data_builder(datatcb,startlab,datadef,const_align(sizeof(pint)));
+       finish_internal_data_builder(datatcb,startlab,unicodestrrecdef,const_align(sizeof(pint)));
      end;
 
 
    procedure ttai_typedconstbuilder.emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);
      begin
-       emit_tai(Tai_const.Create_sym_offset(ll.lab,ll.ofs),charptrdef);
+       emit_tai(Tai_const.Create_sym_offset(ll.lab,ll.ofs),get_dynstring_def_for_type(st,winlikewidestring));
      end;
 
 
@@ -1485,6 +1524,18 @@ implementation
      end;
 
 
+   function ttai_typedconstbuilder.emit_pchar_const(str: pchar; len: pint): tdef;
+     begin
+       result:=carraydef.getreusable(cansichartype,len+1);
+       maybe_begin_aggregate(result);
+       if len=0 then
+         emit_tai(Tai_const.Create_8bit(0),cansichartype)
+       else
+         emit_tai(Tai_string.Create_pchar(str,len+1),result);
+       maybe_end_aggregate(result);
+     end;
+
+
    procedure ttai_typedconstbuilder.emit_guid_const(const guid: tguid);
      var
        i: longint;
@@ -1763,7 +1814,7 @@ implementation
              resourcestrrec:=trecorddef(search_system_type('TRESOURCESTRINGRECORD').typedef);
              queue_subscriptn_multiple_by_name(resourcestrrec,['CURRENTVALUE']);
              queue_emit_asmsym(current_asmdata.RefAsmSymbol(
-               make_mangledname('RESSTR',cs.owner,cs.name),AT_DATA),cansistringtype
+               make_mangledname('RESSTR',cs.owner,cs.name),AT_DATA),resourcestrrec
              );
            end;
          { can these occur? }

compiler/aasmdata.pas

@@ -62,6 +62,8 @@ interface
         al_dwarf_info,
         al_dwarf_abbrev,
         al_dwarf_line,
+        al_dwarf_aranges,
+        al_dwarf_ranges,
         al_picdata,
         al_indirectpicdata,
         al_resourcestrings,
@@ -114,6 +116,8 @@ interface
         'al_dwarf_info',
         'al_dwarf_abbrev',
         'al_dwarf_line',
+        'al_dwarf_aranges',
+        'al_dwarf_ranges',
         'al_picdata',
         'al_indirectpicdata',
         'al_resourcestrings',
@@ -169,7 +173,7 @@ interface
         function  DefineAsmSymbolByClass(symclass: TAsmSymbolClass; const s : TSymStr;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
         function  DefineAsmSymbol(const s : TSymStr;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
         function  WeakRefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype=AT_NONE) : TAsmSymbol;
-        function  RefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype=AT_NONE) : TAsmSymbol;
+        function  RefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype=AT_NONE;indirect:boolean=false) : TAsmSymbol;
         function  GetAsmSymbol(const s : TSymStr) : TAsmSymbol;
         { create new assembler label }
         procedure getlabel(out l : TAsmLabel;alt:TAsmLabeltype);
@@ -217,6 +221,7 @@ implementation
 
     uses
       verbose,
+      symconst,
       aasmtai;
 
 {$ifdef MEMDEBUG}
@@ -406,8 +411,12 @@ implementation
     function TAsmData.DefineAsmSymbolByClass(symclass: TAsmSymbolClass; const s : TSymStr;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
       var
         hp : TAsmSymbol;
+        namestr : TSymStr;
       begin
-        hp:=TAsmSymbol(FAsmSymbolDict.Find(s));
+        namestr:=s;
+        if _bind in asmsymbindindirect then
+          namestr:=namestr+suffix_indirect;
+        hp:=TAsmSymbol(FAsmSymbolDict.Find(namestr));
         if assigned(hp) then
          begin
            { Redefine is allowed, but the types must be the same. The redefine
@@ -429,9 +438,9 @@ implementation
                  should be ignored; a used cannot change anything about this,
                  so printing a warning/hint is not useful }
                if (_bind=AB_LOCAL) then
-                 Message3(asmw_w_changing_bind_type,s,asmsymbindname[hp.bind],asmsymbindname[_bind])
+                 Message3(asmw_w_changing_bind_type,namestr,asmsymbindname[hp.bind],asmsymbindname[_bind])
                else
-                 Message3(asmw_h_changing_bind_type,s,asmsymbindname[hp.bind],asmsymbindname[_bind]);
+                 Message3(asmw_h_changing_bind_type,namestr,asmsymbindname[hp.bind],asmsymbindname[_bind]);
 {$endif extdebug}
              end;
            hp.bind:=_bind;
@@ -439,7 +448,7 @@ implementation
         else
          begin
            { Not found, insert it. }
-           hp:=symclass.create(AsmSymbolDict,s,_bind,_typ);
+           hp:=symclass.create(AsmSymbolDict,namestr,_bind,_typ);
          end;
         result:=hp;
       end;
@@ -451,14 +460,27 @@ implementation
       end;
 
 
-    function TAsmData.RefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype=AT_NONE) : TAsmSymbol;
+    function TAsmData.RefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype;indirect:boolean) : TAsmSymbol;
+      var
+        namestr : TSymStr;
+        bind : tasmsymbind;
       begin
-        result:=TAsmSymbol(FAsmSymbolDict.Find(s));
+        namestr:=s;
+        if indirect then
+          begin
+            namestr:=namestr+suffix_indirect;
+            bind:=AB_EXTERNAL_INDIRECT;
+          end
+        else
+          begin
+            bind:=AB_EXTERNAL;
+          end;
+        result:=TAsmSymbol(FAsmSymbolDict.Find(namestr));
         if not assigned(result) then
-          result:=TAsmSymbol.create(AsmSymbolDict,s,AB_EXTERNAL,_typ)
+          result:=TAsmSymbol.create(AsmSymbolDict,namestr,bind,_typ)
         { one normal reference removes the "weak" character of a symbol }
         else if (result.bind=AB_WEAK_EXTERNAL) then
-          result.bind:=AB_EXTERNAL;
+          result.bind:=bind;
       end;
 
 

compiler/aasmtai.pas

@@ -69,11 +69,7 @@ interface
           ait_stab,
           ait_force_line,
           ait_function_name,
-{$ifdef m68k}
-          ait_labeled_instruction,
-{$endif m68k}
           ait_symbolpair,
-          ait_weak,
           { used to split into tiny assembler files }
           ait_cutobject,
           ait_regalloc,
@@ -200,11 +196,7 @@ interface
           'stab',
           'force_line',
           'function_name',
-{$ifdef m68k}
-          'labeled_instr',
-{$endif m68k}
           'symbolpair',
-          'weak',
           'cut',
           'regalloc',
           'tempalloc',
@@ -298,7 +290,7 @@ interface
                      ait_stab,ait_function_name,
                      ait_cutobject,ait_marker,ait_varloc,ait_align,ait_section,ait_comment,
                      ait_const,ait_directive,
-                     ait_symbolpair,ait_weak,
+                     ait_symbolpair,
                      ait_realconst,
                      ait_symbol,
 {$ifdef JVM}
@@ -347,8 +339,13 @@ interface
         asd_ent,asd_ent_end,
         { supported by recent clang-based assemblers for data-in-code  }
         asd_data_region, asd_end_data_region,
-        { .thumb_func for ARM }
-        asd_thumb_func
+        { ARM }
+        asd_thumb_func,asd_code,
+        { restricts the assembler only to those instructions, which are
+          available on the specified CPU; this represents directives such as
+          NASM's 'CPU 686' or MASM/TASM's '.686p'. Might not be supported by
+          all assemblers. }
+        asd_cpu
       );
 
       TAsmSehDirective=(
@@ -375,15 +372,17 @@ interface
       directivestr : array[TAsmDirective] of string[23]=(
         'indirect_symbol',
         'extern','nasm_import', 'tc', 'reference',
-        'no_dead_strip','weak_reference','lazy_reference','weak_definition',
+        'no_dead_strip','weak','lazy_reference','weak',
         { for Jasmin }
         'class','interface','super','field','limit','line',
         { .ent/.end for MIPS }
         'ent','end',
         { supported by recent clang-based assemblers for data-in-code }
         'data_region','end_data_region',
-        { .thumb_func for ARM }
-        'thumb_func'
+        { ARM }
+        'thumb_func',
+        'code',
+        'cpu'
       );
       sehdirectivestr : array[TAsmSehDirective] of string[16]=(
         '.seh_proc','.seh_endproc',
@@ -898,14 +897,6 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
         end;
 
-        tai_weak = class(tai)
-          sym: pshortstring;
-          constructor create(const asym: string);
-          destructor destroy;override;
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-        end;
-
     var
       { array with all class types for tais }
       aiclass : taiclassarray;
@@ -1018,31 +1009,6 @@ implementation
       end;
 
 
-    constructor tai_weak.create(const asym: string);
-      begin
-        inherited create;
-        typ:=ait_weak;
-        sym:=stringdup(asym);
-      end;
-
-    destructor tai_weak.destroy;
-      begin
-        stringdispose(sym);
-        inherited destroy;
-      end;
-
-    constructor tai_weak.ppuload(t: taitype; ppufile: tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        sym:=stringdup(ppufile.getstring);
-      end;
-
-    procedure tai_weak.ppuwrite(ppufile: tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putstring(sym^);
-      end;
-
     constructor tai_symbolpair.create(akind: TSymbolPairKind; const asym, avalue: string);
       begin
         inherited create;

compiler/aggas.pas

@@ -52,7 +52,7 @@ interface
         procedure WriteExtraHeader;virtual;
         procedure WriteExtraFooter;virtual;
         procedure WriteInstruction(hp: tai);
-        procedure WriteWeakSymbolDef(s: tasmsymbol); virtual;
+        procedure WriteWeakSymbolRef(s: tasmsymbol); virtual;
         procedure WriteAixStringConst(hp: tai_string);
         procedure WriteAixIntConst(hp: tai_const);
         procedure WriteUnalignedIntConst(hp: tai_const);
@@ -91,8 +91,8 @@ interface
       TAppleGNUAssembler=class(TGNUAssembler)
        protected
         function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
-        procedure WriteWeakSymbolDef(s: tasmsymbol); override;
-
+        procedure WriteWeakSymbolRef(s: tasmsymbol); override;
+        procedure WriteDirectiveName(dir: TAsmDirective); override;
        end;
 
 
@@ -113,7 +113,7 @@ implementation
 {$ifdef m68k}
       cpuinfo,aasmcpu,
 {$endif m68k}
-      cpubase;
+      cpubase,objcasm;
 
     const
       line_length = 70;
@@ -232,7 +232,7 @@ implementation
           '.stabstr',
           '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
           '.eh_frame',
-          '.debug_frame','.debug_info','.debug_line','.debug_abbrev',
+          '.debug_frame','.debug_info','.debug_line','.debug_abbrev','.debug_aranges','.debug_ranges',
           '.fpc',
           '.toc',
           '.init',
@@ -291,7 +291,7 @@ implementation
           '.stabstr',
           '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
           '.eh_frame',
-          '.debug_frame','.debug_info','.debug_line','.debug_abbrev',
+          '.debug_frame','.debug_info','.debug_line','.debug_abbrev','.debug_aranges','.debug_ranges',
           '.fpc',
           '.toc',
           '.init',
@@ -416,7 +416,7 @@ implementation
             result:='r';
 
           sec_stab,sec_stabstr,
-          sec_debug_frame,sec_debug_info,sec_debug_line,sec_debug_abbrev:
+          sec_debug_frame,sec_debug_info,sec_debug_line,sec_debug_abbrev,sec_debug_aranges,sec_debug_ranges:
             result:='n';
         else
           result:='';  { defaults to data+load }
@@ -460,7 +460,7 @@ implementation
          system_powerpc_aix,
          system_powerpc64_aix:
            begin
-             if (atype in [sec_stub,sec_objc_data,sec_objc_const,sec_data_coalesced]) then
+             if (atype in [sec_stub]) then
                writer.AsmWrite('.section ');
            end
          else
@@ -1206,13 +1206,6 @@ implementation
                    writer.AsmWriteLn(tai_symbolpair(hp).value^);
                  end;
              end;
-           ait_weak:
-             begin
-               if replaceforbidden then
-                 writer.AsmWriteLn(#9'.weak '+ReplaceForbiddenAsmSymbolChars(tai_weak(hp).sym^))
-               else
-                 writer.AsmWriteLn(#9'.weak '+tai_weak(hp).sym^);
-             end;
            ait_symbol_end :
              begin
                if tf_needs_symbol_size in target_info.flags then
@@ -1378,7 +1371,7 @@ implementation
       end;
 
 
-    procedure TGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
+    procedure TGNUAssembler.WriteWeakSymbolRef(s: tasmsymbol);
       begin
         writer.AsmWriteLn(#9'.weak '+s.name);
       end;
@@ -1529,7 +1522,12 @@ implementation
 
     procedure TGNUAssembler.WriteDirectiveName(dir: TAsmDirective);
     begin
-      writer.AsmWrite('.'+directivestr[dir]+' ');
+      { TODO: implement asd_cpu for GAS => usually .arch or .cpu, but the CPU
+        name has to be translated as well }
+      if dir=asd_cpu then
+        writer.AsmWrite(asminfo^.comment+' CPU ')
+      else
+        writer.AsmWrite('.'+directivestr[dir]+' ');
     end;
 
 
@@ -1572,7 +1570,7 @@ implementation
       { add weak symbol markers }
       for i:=0 to current_asmdata.asmsymboldict.count-1 do
         if (tasmsymbol(current_asmdata.asmsymboldict[i]).bind=AB_WEAK_EXTERNAL) then
-          writeweaksymboldef(tasmsymbol(current_asmdata.asmsymboldict[i]));
+          WriteWeakSymbolRef(tasmsymbol(current_asmdata.asmsymboldict[i]));
 
       if create_smartlink_sections and
          (target_info.system in systems_darwin) then
@@ -1633,6 +1631,16 @@ implementation
                  result := '.section __DWARF,__debug_abbrev,regular,debug';
                  exit;
                end;
+            sec_debug_aranges:
+               begin
+                 result := '.section __DWARF,__debug_aranges,regular,debug';
+                 exit;
+               end;
+            sec_debug_ranges:
+               begin
+                 result := '.section __DWARF,__debug_ranges,regular,debug';
+                 exit;
+               end;
             sec_rodata:
               begin
                 result := '.const_data';
@@ -1678,139 +1686,33 @@ implementation
                 result:='.section __DATA, __mod_term_func, mod_term_funcs';
                 exit;
               end;
-            sec_objc_protocol_ext:
-              begin
-                result:='.section __OBJC, __protocol_ext, regular, no_dead_strip';
-                exit;
-              end;
-            sec_objc_class_ext:
-              begin
-                result:='.section __OBJC, __class_ext, regular, no_dead_strip';
-                exit;
-              end;
-            sec_objc_property:
-              begin
-                result:='.section __OBJC, __property, regular, no_dead_strip';
-                exit;
-              end;
-            sec_objc_image_info:
+            low(TObjCAsmSectionType)..high(TObjCAsmSectionType):
               begin
-                if (target_info.system in systems_objc_nfabi) then
-                  result:='.section __DATA,__objc_imageinfo,regular,no_dead_strip'
-                else
-                  result:='.section __OBJC, __image_info, regular, no_dead_strip';
-                exit;
-              end;
-            sec_objc_cstring_object:
-              begin
-                result:='.section __OBJC, __cstring_object, regular, no_dead_strip';
-                exit;
-              end;
-            sec_objc_sel_fixup:
-              begin
-                result:='.section __OBJC, __sel_fixup, regular, no_dead_strip';
-                exit;
-              end;
-            sec_objc_message_refs:
-              begin
-                if (target_info.system in systems_objc_nfabi) then
-                  begin
-                    result:='.section __DATA, __objc_selrefs, literal_pointers, no_dead_strip';
-                    exit;
-                  end;
-              end;
-            sec_objc_cls_refs:
-              begin
-                if (target_info.system in systems_objc_nfabi) then
-                  begin
-                    result:='.section __DATA, __objc_clsrefs, regular, no_dead_strip';
-                    exit;
-                  end;
-              end;
-            sec_objc_meth_var_types:
-              begin
-                if (target_info.system in systems_objc_nfabi) then
-                  begin
-                    result:='.section __TEXT,__objc_methtype,cstring_literals';
-                    exit
-                  end;
-              end;
-            sec_objc_meth_var_names:
-              begin
-                if (target_info.system in systems_objc_nfabi) then
-                  begin
-                    result:='.section __TEXT,__objc_methname,cstring_literals';
-                    exit
-                  end;
-              end;
-            sec_objc_class_names:
-              begin
-                if (target_info.system in systems_objc_nfabi) then
-                  begin
-                    result:='.section __TEXT,__objc_classname,cstring_literals';
-                    exit
-                  end;
-              end;
-            sec_objc_inst_meth,
-            sec_objc_cls_meth,
-            sec_objc_cat_inst_meth,
-            sec_objc_cat_cls_meth:
-              begin
-                if (target_info.system in systems_objc_nfabi) then
-                  begin
-                    result:='.section __DATA, __objc_const';
-                    exit;
-                  end;
-              end;
-            sec_objc_meta_class,
-            sec_objc_class:
-              begin
-                if (target_info.system in systems_objc_nfabi) then
-                  begin
-                    result:='.section __DATA, __objc_data';
-                    exit;
-                  end;
-              end;
-            sec_objc_sup_refs:
-              begin
-                result:='.section __DATA, __objc_superrefs, regular, no_dead_strip';
+                result:='.section '+objc_section_name(atype);
                 exit
               end;
-            sec_objc_classlist:
-              begin
-                result:='.section __DATA, __objc_classlist, regular, no_dead_strip';
-                exit
-              end;
-            sec_objc_nlclasslist:
-              begin
-                result:='.section __DATA, __objc_nlclasslist, regular, no_dead_strip';
-                exit
-              end;
-            sec_objc_catlist:
-              begin
-                result:='.section __DATA, __objc_catlist, regular, no_dead_strip';
-                exit
-              end;
-            sec_objc_nlcatlist:
-              begin
-                result:='.section __DATA, __objc_nlcatlist, regular, no_dead_strip';
-                exit
-              end;
-            sec_objc_protolist:
-              begin
-                result:='.section __DATA, __objc_protolist, coalesced, no_dead_strip';
-                exit;
-              end;
           end;
         result := inherited sectionname(atype,aname,aorder);
       end;
 
 
-    procedure TAppleGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
+    procedure TAppleGNUAssembler.WriteWeakSymbolRef(s: tasmsymbol);
       begin
         writer.AsmWriteLn(#9'.weak_reference '+s.name);
       end;
 
+    procedure TAppleGNUAssembler.WriteDirectiveName(dir: TAsmDirective);
+      begin
+        case dir of
+          asd_weak_reference:
+            writer.AsmWrite('.weak_reference ');
+          asd_weak_definition:
+            writer.AsmWrite('.weak_definition ');
+          else
+            inherited;
+        end;
+      end;
+
 
 {****************************************************************************}
 {                       a.out/GNU Assembler writer                           }
@@ -1852,6 +1754,8 @@ implementation
          sec_debug_info,
          sec_debug_line,
          sec_debug_abbrev,
+         sec_debug_aranges,
+         sec_debug_ranges,
          { ELF resources (+ references to stabs debug information sections) }
          sec_code (* sec_fpc *),
          { Table of contents section }

compiler/aopt.pas

@@ -40,7 +40,7 @@ Unit aopt;
         Constructor create(_AsmL: TAsmList); virtual; reintroduce;
 
         { call the necessary optimizer procedures }
-        Procedure Optimize;
+        Procedure Optimize;virtual;
         Destructor destroy;override;
 
       private
@@ -50,6 +50,7 @@ Unit aopt;
           Also fixes some RegDeallocs like "# %eax released; push (%eax)"  }
         Procedure BuildLabelTableAndFixRegAlloc;
         procedure clear;
+      protected
         procedure pass_1;
       End;
       TAsmOptimizerClass = class of TAsmOptimizer;
@@ -189,7 +190,7 @@ Unit aopt;
                         hp2 := nil;
                         While Not(assigned(FindRegAlloc(tai_regalloc(p).Reg, tai(hp1.Next)))) And
                               GetNextInstruction(hp1, hp1) And
-                              RegInInstruction(tai_regalloc(p).Reg, hp1) Do
+                              InstructionLoadsFromReg(tai_regalloc(p).Reg, hp1) Do
                           hp2 := hp1;
                         { move deallocations }
                         If hp2 <> nil Then

compiler/aoptbase.pas

@@ -95,6 +95,12 @@ unit aoptbase;
 
         { returns true if reg is modified by any instruction between p1 and p2 }
         function RegModifiedBetween(reg: TRegister; p1, p2: tai): Boolean;
+
+        { returns true if reg is loaded with a new value by hp }
+        function RegLoadedWithNewValue(reg: tregister; hp: tai): boolean; Virtual;
+
+        { returns true if hp loads a value from reg }
+        function InstructionLoadsFromReg(const reg : TRegister; const hp : tai) : boolean; Virtual;
     end;
 
     function labelCanBeSkipped(p: tai_label): boolean;
@@ -102,7 +108,7 @@ unit aoptbase;
   implementation
 
     uses
-      globtype,globals,aoptcpub;
+      verbose,globtype,globals,aoptcpub;
 
   constructor taoptbase.create;
     begin
@@ -285,6 +291,20 @@ unit aoptbase;
   end;
 
 
+  function TAoptBase.RegLoadedWithNewValue(reg : tregister; hp : tai) : boolean;
+    begin
+      result:=false;
+      internalerror(2016012401);
+    end;
+
+
+  function TAoptBase.InstructionLoadsFromReg(const reg : TRegister; const hp : tai) : boolean;
+    begin
+      { save approximation }
+      Result:=true;
+    end;
+
+
   { ******************* Processor dependent stuff *************************** }
 
   Function TAOptBase.RegMaxSize(Reg: TRegister): TRegister;

compiler/aoptobj.pas

@@ -315,6 +315,10 @@ Unit AoptObj;
         { reg used after p? }
         function RegUsedAfterInstruction(reg: Tregister; p: tai; var AllUsedRegs: TAllUsedRegs): Boolean;
 
+        { returns true if reg reaches it's end of life at p, this means it is either
+          reloaded with a new value or it is deallocated afterwards }
+        function RegEndOfLife(reg: TRegister;p: taicpu): boolean;
+
        { traces sucessive jumps to their final destination and sets it, e.g.
          je l1                je l3
          <code>               <code>
@@ -335,10 +339,10 @@ Unit AoptObj;
         procedure RemoveDelaySlot(hp1: tai);
 
         { peephole optimizer }
-        procedure PrePeepHoleOpts;
-        procedure PeepHoleOptPass1;
+        procedure PrePeepHoleOpts; virtual;
+        procedure PeepHoleOptPass1; virtual;
         procedure PeepHoleOptPass2; virtual;
-        procedure PostPeepHoleOpts;
+        procedure PostPeepHoleOpts; virtual;
 
         { processor dependent methods }
         // if it returns true, perform a "continue"
@@ -1117,15 +1121,25 @@ Unit AoptObj;
        End;
 
 
-      function TAOptObj.RegUsedAfterInstruction(reg: Tregister; p: tai;
-       var AllUsedRegs: TAllUsedRegs): Boolean;
-       begin
-         AllUsedRegs[getregtype(reg)].Update(tai(p.Next),true);
-         RegUsedAfterInstruction :=
-           (AllUsedRegs[getregtype(reg)].IsUsed(reg)); { optimization and
-              (not(getNextInstruction(p,p)) or
-               not(regLoadedWithNewValue(supreg,false,p))); }
-       end;
+    function TAOptObj.RegUsedAfterInstruction(reg: Tregister; p: tai;var AllUsedRegs: TAllUsedRegs): Boolean;
+      begin
+        AllUsedRegs[getregtype(reg)].Update(tai(p.Next),true);
+        RegUsedAfterInstruction :=
+          AllUsedRegs[getregtype(reg)].IsUsed(reg) and
+          not(regLoadedWithNewValue(reg,p)) and
+          (
+            not(GetNextInstruction(p,p)) or
+            InstructionLoadsFromReg(reg,p) or
+            not(regLoadedWithNewValue(reg,p))
+          );
+      end;
+
+
+    function TAOptObj.RegEndOfLife(reg : TRegister;p : taicpu) : boolean;
+      begin
+         Result:=assigned(FindRegDealloc(reg,tai(p.Next))) or
+           RegLoadedWithNewValue(reg,p);
+      end;
 
 
     function SkipLabels(hp: tai; var hp2: tai): boolean;

compiler/aoptutils.pas

@@ -0,0 +1,49 @@
+{
+    Copyright (c) 1998-2016 by Florian Klaempfl and Jonas Maebe
+
+    This unit contains helper procedures for the assembler peephole optimizer
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+unit aoptutils;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      aasmtai,aasmcpu;
+
+    function MatchOpType(const p : taicpu;type0: toptype) : Boolean;
+    function MatchOpType(const p : taicpu;type0,type1 : toptype) : Boolean;
+
+  implementation
+
+    function MatchOpType(const p : taicpu; type0: toptype) : Boolean;
+      begin
+        Result:=(p.oper[0]^.typ=type0);
+      end;
+
+
+    function MatchOpType(const p : taicpu; type0,type1 : toptype) : Boolean;
+      begin
+        Result:=(p.oper[0]^.typ=type0) and (p.oper[0]^.typ=type1);
+      end;
+
+end.
+

compiler/arm/aasmcpu.pas

@@ -275,7 +275,7 @@ uses
          insoffset : longint;
          LastInsOffset : longint; { need to be public to be reset }
          insentry  : PInsEntry;
-         procedure BuildArmMasks;
+         procedure BuildArmMasks(objdata:TObjData);
          function  InsEnd:longint;
          procedure create_ot(objdata:TObjData);
          function  Matches(p:PInsEntry):longint;
@@ -872,6 +872,7 @@ implementation
                 result:=operand_write
               else
                 result:=operand_read;
+            A_VFMA,A_VFMS,A_VFNMA,A_VFNMS,
             A_BFC:
               if opnr in [0] then
                 result:=operand_readwrite
@@ -1416,6 +1417,36 @@ implementation
               ait_instruction:
                 begin
                   case taicpu(curtai).opcode of
+                    A_STM:
+                      begin
+                        if (taicpu(curtai).ops=2) and
+                           (taicpu(curtai).oper[0]^.typ=top_ref) and
+                           (taicpu(curtai).oper[0]^.ref^.index=NR_STACK_POINTER_REG) and
+                           (taicpu(curtai).oper[0]^.ref^.addressmode=AM_PREINDEXED) and
+                           (taicpu(curtai).oppostfix in [PF_FD,PF_DB]) then
+                          begin
+                            taicpu(curtai).oppostfix:=PF_None;
+                            taicpu(curtai).loadregset(0, taicpu(curtai).oper[1]^.regtyp, taicpu(curtai).oper[1]^.subreg, taicpu(curtai).oper[1]^.regset^);
+                            taicpu(curtai).ops:=1;
+                            taicpu(curtai).opcode:=A_PUSH;
+                          end;
+                      end;
+
+                    A_LDM:
+                      begin
+                        if (taicpu(curtai).ops=2) and
+                           (taicpu(curtai).oper[0]^.typ=top_ref) and
+                           (taicpu(curtai).oper[0]^.ref^.index=NR_STACK_POINTER_REG) and
+                           (taicpu(curtai).oper[0]^.ref^.addressmode=AM_PREINDEXED) and
+                           (taicpu(curtai).oppostfix in [PF_FD,PF_IA]) then
+                          begin
+                            taicpu(curtai).oppostfix:=PF_None;
+                            taicpu(curtai).loadregset(0, taicpu(curtai).oper[1]^.regtyp, taicpu(curtai).oper[1]^.subreg, taicpu(curtai).oper[1]^.regset^);
+                            taicpu(curtai).ops:=1;
+                            taicpu(curtai).opcode:=A_POP;
+                          end;
+                      end;
+
                     A_ADD,
                     A_AND,A_EOR,A_ORR,A_BIC,
                     A_LSL,A_LSR,A_ASR,A_ROR,
@@ -2094,7 +2125,7 @@ implementation
       end;
 
 
-    procedure taicpu.BuildArmMasks;
+    procedure taicpu.BuildArmMasks(objdata:TObjData);
       const
         Masks: array[tcputype] of longint =
           (
@@ -2135,7 +2166,8 @@ implementation
       begin
         fArmVMask:=Masks[current_settings.cputype] or FPUMasks[current_settings.fputype];
 
-        if current_settings.instructionset=is_thumb then
+        if objdata.ThumbFunc then
+        //if current_settings.instructionset=is_thumb then
           begin
             fArmMask:=IF_THUMB;
             if CPUARM_HAS_THUMB2 in cpu_capabilities[current_settings.cputype] then
@@ -2636,7 +2668,7 @@ implementation
            { create the .ot fields }
            create_ot(objdata);
 
-           BuildArmMasks;
+           BuildArmMasks(objdata);
            { set the file postion }
            current_filepos:=fileinfo;
          end
@@ -2747,15 +2779,15 @@ implementation
 
       function MakeRegList(reglist: tcpuregisterset): word;
         var
-          i, w: word;
+          i, w: integer;
         begin
           result:=0;
-          w:=1;
+          w:=0;
           for i:=RS_R0 to RS_R15 do
             begin
               if i in reglist then
-                result:=result or w;
-              w:=w shl 1
+                result:=result or (1 shl w);
+              inc(w);
             end;
         end;
 
@@ -2944,13 +2976,15 @@ implementation
               else
                 begin
                   currsym:=objdata.symbolref(oper[0]^.ref^.symbol);
-                  if (currsym.bind<>AB_LOCAL) and (currsym.objsection<>objdata.CurrObjSec) then
-                    begin
-                      objdata.writereloc(oper[0]^.ref^.offset,0,currsym,RELOC_RELATIVE_24);
-                      bytes:=bytes or $fffffe; // TODO: Not sure this is right, but it matches the output of gas
-                    end
+
+                  bytes:=bytes or (((oper[0]^.ref^.offset-8) shr 2) and $ffffff);
+
+                  if (opcode<>A_BL) or (condition<>C_None) then
+                    objdata.writereloc(aint(bytes),4,currsym,RELOC_RELATIVE_24)
                   else
-                    bytes:=bytes or (((currsym.offset-insoffset-8) shr 2) and $ffffff);
+                    objdata.writereloc(aint(bytes),4,currsym,RELOC_RELATIVE_CALL);
+
+                  exit;
                 end;
             end;
           #$02:
@@ -4487,11 +4521,9 @@ implementation
               bytes:=bytes or (ord(insentry^.code[1]) shl 8);
               bytes:=bytes or ord(insentry^.code[2]);
 
-
               case opcode of
                 A_SUB:
                   begin
-                    bytes:=bytes or (getsupreg(oper[0]^.reg) and $7);
                     if (ops=3) and
                        (oper[2]^.typ=top_const) then
                       bytes:=bytes or ((oper[2]^.val shr 2) and $7F)
@@ -4651,7 +4683,7 @@ implementation
                         bytes:=bytes or (1 shl r);
 
                     if oper[0]^.typ=top_ref then
-                      bytes:=bytes or (getsupreg(oper[0]^.ref^.base) shl 8)
+                      bytes:=bytes or (getsupreg(oper[0]^.ref^.index) shl 8)
                     else
                       bytes:=bytes or (getsupreg(oper[0]^.reg) shl 8);
                   end;
@@ -4662,7 +4694,7 @@ implementation
                         bytes:=bytes or (1 shl r);
 
                     if oper[0]^.typ=top_ref then
-                      bytes:=bytes or (getsupreg(oper[0]^.ref^.base) shl 8)
+                      bytes:=bytes or (getsupreg(oper[0]^.ref^.index) shl 8)
                     else
                       bytes:=bytes or (getsupreg(oper[0]^.reg) shl 8);
                   end;

compiler/arm/agarmgas.pas

@@ -360,7 +360,7 @@ unit agarmgas;
                // writeln(taicpu(hp).fileinfo.line);
 
                { LDM and STM use references as first operand but they are written like a register }
-               if (i=0) and (op in [A_LDM,A_STM,A_FSTM,A_FLDM,A_VSTM,A_VLDM]) then
+               if (i=0) and (op in [A_LDM,A_STM,A_FSTM,A_FLDM,A_VSTM,A_VLDM,A_SRS,A_RFE]) then
                  begin
                    case taicpu(hp).oper[0]^.typ of
                      top_ref:

compiler/arm/aoptcpu.pas

@@ -39,11 +39,8 @@ Type
     procedure PeepHoleOptPass2;override;
     Function RegInInstruction(Reg: TRegister; p1: tai): Boolean;override;
     function RemoveSuperfluousMove(const p: tai; movp: tai; const optimizer: string): boolean;
-    function RegUsedAfterInstruction(reg: Tregister; p: tai;
-                                     var AllUsedRegs: TAllUsedRegs): Boolean;
-    { returns true if reg reaches it's end of life at p, this means it is either
-      reloaded with a new value or it is deallocated afterwards }
-    function RegEndOfLife(reg: TRegister;p: taicpu): boolean;
+    function RemoveSuperfluousVMov(const p : tai; movp : tai; const optimizer : string) : boolean;
+
     { gets the next tai object after current that contains info relevant
       to the optimizer in p1 which used the given register or does a
       change in program flow.
@@ -55,6 +52,9 @@ Type
     { outputs a debug message into the assembler file }
     procedure DebugMsg(const s: string; p: tai);
 
+    function InstructionLoadsFromReg(const reg : TRegister; const hp : tai) : boolean; override;
+
+    function RegLoadedWithNewValue(reg : tregister; hp : tai) : boolean; override;
   protected
     function LookForPreindexedPattern(p: taicpu): boolean;
     function LookForPostindexedPattern(p: taicpu): boolean;
@@ -93,7 +93,11 @@ Implementation
         (taicpu(p).opcode<>A_CBZ) and
         (taicpu(p).opcode<>A_CBNZ) and
         (taicpu(p).opcode<>A_PLD) and
-        ((taicpu(p).opcode<>A_BLX) or
+        (((taicpu(p).opcode<>A_BLX) and
+          { BL may need to be converted into BLX by the linker -- could possibly
+            be allowed in case it's to a local symbol of which we know that it
+            uses the same instruction set as the current one }
+          (taicpu(p).opcode<>A_BL)) or
          (taicpu(p).oper[0]^.typ=top_reg));
     end;
 
@@ -167,67 +171,6 @@ Implementation
       end;
     end;
 
-  function regLoadedWithNewValue(reg: tregister; hp: tai): boolean;
-  var
-    p: taicpu;
-  begin
-    p := taicpu(hp);
-    regLoadedWithNewValue := false;
-    if not ((assigned(hp)) and (hp.typ = ait_instruction)) then
-      exit;
-
-    case p.opcode of
-      { These operands do not write into a register at all }
-      A_CMP, A_CMN, A_TST, A_TEQ, A_B, A_BL, A_BX, A_BLX, A_SWI, A_MSR, A_PLD:
-        exit;
-      {Take care of post/preincremented store and loads, they will change their base register}
-      A_STR, A_LDR:
-        begin
-          regLoadedWithNewValue :=
-            (taicpu(p).oper[1]^.typ=top_ref) and
-            (taicpu(p).oper[1]^.ref^.addressmode in [AM_PREINDEXED,AM_POSTINDEXED]) and
-            (taicpu(p).oper[1]^.ref^.base = reg);
-          {STR does not load into it's first register}
-          if p.opcode = A_STR then exit;
-        end;
-      { These four are writing into the first 2 register, UMLAL and SMLAL will also read from them }
-      A_UMLAL, A_UMULL, A_SMLAL, A_SMULL:
-        regLoadedWithNewValue :=
-          (p.oper[1]^.typ = top_reg) and
-          (p.oper[1]^.reg = reg);
-      {Loads to oper2 from coprocessor}
-      {
-      MCR/MRC is currently not supported in FPC
-      A_MRC:
-        regLoadedWithNewValue :=
-          (p.oper[2]^.typ = top_reg) and
-          (p.oper[2]^.reg = reg);
-      }
-      {Loads to all register in the registerset}
-      A_LDM:
-        regLoadedWithNewValue := (getsupreg(reg) in p.oper[1]^.regset^);
-      A_POP:
-        regLoadedWithNewValue := (getsupreg(reg) in p.oper[0]^.regset^) or
-                                 (reg=NR_STACK_POINTER_REG);
-    end;
-
-    if regLoadedWithNewValue then
-      exit;
-
-    case p.oper[0]^.typ of
-      {This is the case}
-      top_reg:
-        regLoadedWithNewValue := (p.oper[0]^.reg = reg) or
-          { LDRD }
-          (p.opcode=A_LDR) and (p.oppostfix=PF_D) and (getsupreg(p.oper[0]^.reg)+1=getsupreg(reg));
-      {LDM/STM might write a new value to their index register}
-      top_ref:
-        regLoadedWithNewValue :=
-          (taicpu(p).oper[0]^.ref^.addressmode in [AM_PREINDEXED,AM_POSTINDEXED]) and
-          (taicpu(p).oper[0]^.ref^.base = reg);
-    end;
-  end;
-
 
   function AlignedToQWord(const ref : treference) : boolean;
     begin
@@ -249,44 +192,6 @@ Implementation
     end;
 
 
-  function instructionLoadsFromReg(const reg: TRegister; const hp: tai): boolean;
-  var
-    p: taicpu;
-    i: longint;
-  begin
-    instructionLoadsFromReg := false;
-    if not (assigned(hp) and (hp.typ = ait_instruction)) then
-      exit;
-    p:=taicpu(hp);
-
-    i:=1;
-    {For these instructions we have to start on oper[0]}
-    if (p.opcode in [A_STR, A_LDM, A_STM, A_PLD,
-                        A_CMP, A_CMN, A_TST, A_TEQ,
-                        A_B, A_BL, A_BX, A_BLX,
-                        A_SMLAL, A_UMLAL]) then i:=0;
-
-    while(i<p.ops) do
-      begin
-        case p.oper[I]^.typ of
-          top_reg:
-            instructionLoadsFromReg := (p.oper[I]^.reg = reg) or
-              { STRD }
-              ((i=0) and (p.opcode=A_STR) and (p.oppostfix=PF_D) and (getsupreg(p.oper[0]^.reg)+1=getsupreg(reg)));
-          top_regset:
-            instructionLoadsFromReg := (getsupreg(reg) in p.oper[I]^.regset^);
-          top_shifterop:
-            instructionLoadsFromReg := p.oper[I]^.shifterop^.rs = reg;
-          top_ref:
-            instructionLoadsFromReg :=
-              (p.oper[I]^.ref^.base = reg) or
-              (p.oper[I]^.ref^.index = reg);
-        end;
-        if instructionLoadsFromReg then exit; {Bailout if we found something}
-        Inc(I);
-      end;
-  end;
-
   function isValidConstLoadStoreOffset(const aoffset: longint; const pf: TOpPostfix) : boolean;
     begin
       if GenerateThumb2Code then
@@ -297,27 +202,118 @@ Implementation
                   (abs(aoffset)<256);
     end;
 
-  function TCpuAsmOptimizer.RegUsedAfterInstruction(reg: Tregister; p: tai;
-    var AllUsedRegs: TAllUsedRegs): Boolean;
+
+  function TCpuAsmOptimizer.InstructionLoadsFromReg(const reg: TRegister; const hp: tai): boolean;
+    var
+      p: taicpu;
+      i: longint;
     begin
-      AllUsedRegs[getregtype(reg)].Update(tai(p.Next),true);
-      RegUsedAfterInstruction :=
-        AllUsedRegs[getregtype(reg)].IsUsed(reg) and
-        not(regLoadedWithNewValue(reg,p)) and
-        (
-          not(GetNextInstruction(p,p)) or
-          instructionLoadsFromReg(reg,p) or
-          not(regLoadedWithNewValue(reg,p))
-        );
+      instructionLoadsFromReg := false;
+      if not (assigned(hp) and (hp.typ = ait_instruction)) then
+        exit;
+      p:=taicpu(hp);
+
+      i:=1;
+      {For these instructions we have to start on oper[0]}
+      if (p.opcode in [A_STR, A_LDM, A_STM, A_PLD,
+                          A_CMP, A_CMN, A_TST, A_TEQ,
+                          A_B, A_BL, A_BX, A_BLX,
+                          A_SMLAL, A_UMLAL]) then i:=0;
+
+      while(i<p.ops) do
+        begin
+          case p.oper[I]^.typ of
+            top_reg:
+              instructionLoadsFromReg := (p.oper[I]^.reg = reg) or
+                { STRD }
+                ((i=0) and (p.opcode=A_STR) and (p.oppostfix=PF_D) and (getsupreg(p.oper[0]^.reg)+1=getsupreg(reg)));
+            top_regset:
+              instructionLoadsFromReg := (getsupreg(reg) in p.oper[I]^.regset^);
+            top_shifterop:
+              instructionLoadsFromReg := p.oper[I]^.shifterop^.rs = reg;
+            top_ref:
+              instructionLoadsFromReg :=
+                (p.oper[I]^.ref^.base = reg) or
+                (p.oper[I]^.ref^.index = reg);
+          end;
+          if instructionLoadsFromReg then exit; {Bailout if we found something}
+          Inc(I);
+        end;
     end;
 
 
-  function TCpuAsmOptimizer.RegEndOfLife(reg : TRegister;p : taicpu) : boolean;
+  function TCpuAsmOptimizer.RegLoadedWithNewValue(reg: tregister; hp: tai): boolean;
+    var
+      p: taicpu;
     begin
-       Result:=assigned(FindRegDealloc(reg,tai(p.Next))) or
-         RegLoadedWithNewValue(reg,p);
+      p := taicpu(hp);
+      Result := false;
+      if not ((assigned(hp)) and (hp.typ = ait_instruction)) then
+        exit;
+
+      case p.opcode of
+        { These operands do not write into a register at all }
+        A_CMP, A_CMN, A_TST, A_TEQ, A_B, A_BL, A_BX, A_BLX, A_SWI, A_MSR, A_PLD,
+        A_VCMP:
+          exit;
+        {Take care of post/preincremented store and loads, they will change their base register}
+        A_STR, A_LDR:
+          begin
+            Result := false;
+            { actually, this does not apply here because post-/preindexed does not mean that a register
+              is loaded with a new value, it is only modified
+              (taicpu(p).oper[1]^.typ=top_ref) and
+              (taicpu(p).oper[1]^.ref^.addressmode in [AM_PREINDEXED,AM_POSTINDEXED]) and
+              (taicpu(p).oper[1]^.ref^.base = reg);
+            }
+            { STR does not load into it's first register }
+            if p.opcode = A_STR then
+              exit;
+          end;
+        A_VSTR:
+          begin
+            Result := false;
+            exit;
+          end;
+        { These four are writing into the first 2 register, UMLAL and SMLAL will also read from them }
+        A_UMLAL, A_UMULL, A_SMLAL, A_SMULL:
+          Result :=
+            (p.oper[1]^.typ = top_reg) and
+            (p.oper[1]^.reg = reg);
+        {Loads to oper2 from coprocessor}
+        {
+        MCR/MRC is currently not supported in FPC
+        A_MRC:
+          Result :=
+            (p.oper[2]^.typ = top_reg) and
+            (p.oper[2]^.reg = reg);
+        }
+        {Loads to all register in the registerset}
+        A_LDM, A_VLDM:
+          Result := (getsupreg(reg) in p.oper[1]^.regset^);
+        A_POP:
+          Result := (getsupreg(reg) in p.oper[0]^.regset^) or
+                                   (reg=NR_STACK_POINTER_REG);
+      end;
+
+      if Result then
+        exit;
+
+      case p.oper[0]^.typ of
+        {This is the case}
+        top_reg:
+          Result := (p.oper[0]^.reg = reg) or
+            { LDRD }
+            (p.opcode=A_LDR) and (p.oppostfix=PF_D) and (getsupreg(p.oper[0]^.reg)+1=getsupreg(reg));
+        {LDM/STM might write a new value to their index register}
+        top_ref:
+          Result :=
+            (taicpu(p).oper[0]^.ref^.addressmode in [AM_PREINDEXED,AM_POSTINDEXED]) and
+            (taicpu(p).oper[0]^.ref^.base = reg);
+      end;
     end;
 
+
   function TCpuAsmOptimizer.GetNextInstructionUsingReg(Current: tai;
     Out Next: tai; reg: TRegister): Boolean;
     begin
@@ -443,6 +439,69 @@ Implementation
         end;
     end;
 
+
+  function TCpuAsmOptimizer.RemoveSuperfluousVMov(const p: tai; movp: tai; const optimizer: string):boolean;
+    var
+      alloc,
+      dealloc : tai_regalloc;
+      hp1 : tai;
+    begin
+      Result:=false;
+      if (MatchInstruction(movp, A_VMOV, [taicpu(p).condition], [taicpu(p).oppostfix]) or
+          ((taicpu(p).oppostfix in [PF_F64F32,PF_F64S16,PF_F64S32,PF_F64U16,PF_F64U32]) and MatchInstruction(movp, A_VMOV, [taicpu(p).condition], [PF_F64])) or
+          ((taicpu(p).oppostfix in [PF_F32F64,PF_F32S16,PF_F32S32,PF_F32U16,PF_F32U32]) and MatchInstruction(movp, A_VMOV, [taicpu(p).condition], [PF_F32]))
+         ) and
+         (taicpu(movp).ops=2) and
+         MatchOperand(taicpu(movp).oper[1]^, taicpu(p).oper[0]^.reg) and
+         { the destination register of the mov might not be used beween p and movp }
+         not(RegUsedBetween(taicpu(movp).oper[0]^.reg,p,movp)) and
+         { Take care to only do this for instructions which REALLY load to the first register.
+           Otherwise
+             vstr reg0, [reg1]
+             vmov reg2, reg0
+           will be optimized to
+             vstr reg2, [reg1]
+         }
+         regLoadedWithNewValue(taicpu(p).oper[0]^.reg, p) then
+        begin
+          dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(movp.Next));
+          if assigned(dealloc) then
+            begin
+              DebugMsg('Peephole '+optimizer+' removed superfluous vmov', movp);
+              result:=true;
+
+              { taicpu(p).oper[0]^.reg is not used anymore, try to find its allocation
+                and remove it if possible }
+              asml.Remove(dealloc);
+              alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.previous));
+              if assigned(alloc) then
+                begin
+                  asml.Remove(alloc);
+                  alloc.free;
+                  dealloc.free;
+                end
+              else
+                asml.InsertAfter(dealloc,p);
+
+              { try to move the allocation of the target register }
+              GetLastInstruction(movp,hp1);
+              alloc:=FindRegAlloc(taicpu(movp).oper[0]^.reg,tai(hp1.Next));
+              if assigned(alloc) then
+                begin
+                  asml.Remove(alloc);
+                  asml.InsertBefore(alloc,p);
+                  { adjust used regs }
+                  IncludeRegInUsedRegs(taicpu(movp).oper[0]^.reg,UsedRegs);
+                end;
+
+              { finally get rid of the mov }
+              taicpu(p).loadreg(0,taicpu(movp).oper[0]^.reg);
+              asml.remove(movp);
+              movp.free;
+            end;
+        end;
+    end;
+
   {
     optimize
       add/sub reg1,reg1,regY/const
@@ -1442,6 +1501,9 @@ Implementation
                            (not GenerateThumb2Code)
                          )
                        ) and
+                       { Only fold if both registers are used. Otherwise we are folding p with itself }
+                       (taicpu(hp1).oper[1]^.ref^.index<>NR_NO) and
+                       (taicpu(hp1).oper[1]^.ref^.base<>NR_NO) and
                        { Only fold if there isn't another shifterop already, and offset is zero. }
                        (taicpu(hp1).oper[1]^.ref^.offset = 0) and
                        (taicpu(hp1).oper[1]^.ref^.shiftmode = SM_None) and
@@ -2151,7 +2213,19 @@ Implementation
                         DebugMsg('Peephole Bl2B done', p);
                       end;
                   end;
-
+                A_VADD,
+                A_VMUL,
+                A_VDIV,
+                A_VSUB,
+                A_VSQRT,
+                A_VNEG,
+                A_VCVT,
+                A_VABS:
+                  begin
+                    if GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
+                      RemoveSuperfluousVMov(p, hp1, 'VOpVMov2VOp') then
+                      Result:=true;
+                  end
               end;
           end;
       end;

compiler/arm/armatt.inc

@@ -167,6 +167,7 @@
 'smuad',
 'smusd',
 'srs',
+'rfe',
 'ssat',
 'ssat16',
 'ssax',

compiler/arm/armatts.inc

@@ -352,5 +352,6 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufNONE,
 attsufNONE
 );

compiler/arm/armins.dat

@@ -1030,6 +1030,7 @@ reg32,reg32,reg32          \x80\xFB\x40\xF0\x0                 THUMB32,ARMv6T2
 reg32,reg32,reg32          \x15\x7\x00\x5\xF                   ARM32,ARMv6
 
 [SRScc]
+[RFEcc]
 
 [SSATcc]
 reg32,immshifter,reg32            \x83\xF3\x00\x0\x0          THUMB32,ARMv6T2
@@ -1667,13 +1668,13 @@ vreg,vreg,vreg          \x92\xEE\xA0\xA\x40          THUMB32,VFPv4
 vreg,vreg,vreg          \x42\xE\xA0\xA\x40          ARM32,VFPv4
 
 [VFNMA]
-vreg,vreg,vreg          \x92\xEE\x90\xA\x00          THUMB32,VFPv4
-vreg,vreg,vreg          \x42\xE\x90\xA\x00          ARM32,VFPv4
-
-[VFNMS]
 vreg,vreg,vreg          \x92\xEE\x90\xA\x40          THUMB32,VFPv4
 vreg,vreg,vreg          \x42\xE\x90\xA\x40          ARM32,VFPv4
 
+[VFNMS]
+vreg,vreg,vreg          \x92\xEE\x90\xA\x00          THUMB32,VFPv4
+vreg,vreg,vreg          \x42\xE\x90\xA\x00          ARM32,VFPv4
+
 [VNEGcc]
 vreg,vreg               \x92\xEE\xB1\xA\x40         THUMB32,VFPv2
 vreg,vreg               \x42\xE\xB1\xA\x40         ARM32,VFPv2
@@ -1837,4 +1838,4 @@ fpureg,immshifter           \xA1\1\xD                     ARM32,FPA
 
 [LOGcc]
 fpureg,fpureg               \xA1\1\xB                     ARM32,FPA
-fpureg,immshifter           \xA1\1\xB                     ARM32,FPA
+fpureg,immshifter           \xA1\1\xB                     ARM32,FPA

compiler/arm/armop.inc

@@ -167,6 +167,7 @@ A_SMMUL,
 A_SMUAD,
 A_SMUSD,
 A_SRS,
+A_RFE,
 A_SSAT,
 A_SSAT16,
 A_SSAX,

compiler/arm/armtab.inc

@@ -6101,28 +6101,28 @@
     opcode  : A_VFNMA;
     ops     : 3;
     optypes : (ot_vreg,ot_vreg,ot_vreg,ot_none,ot_none,ot_none);
-    code    : #146#238#144#10#0;
+    code    : #146#238#144#10#64;
     flags   : if_thumb32 or if_vfpv4
   ),
   (
     opcode  : A_VFNMA;
     ops     : 3;
     optypes : (ot_vreg,ot_vreg,ot_vreg,ot_none,ot_none,ot_none);
-    code    : #66#14#144#10#0;
+    code    : #66#14#144#10#64;
     flags   : if_arm32 or if_vfpv4
   ),
   (
     opcode  : A_VFNMS;
     ops     : 3;
     optypes : (ot_vreg,ot_vreg,ot_vreg,ot_none,ot_none,ot_none);
-    code    : #146#238#144#10#64;
+    code    : #146#238#144#10#0;
     flags   : if_thumb32 or if_vfpv4
   ),
   (
     opcode  : A_VFNMS;
     ops     : 3;
     optypes : (ot_vreg,ot_vreg,ot_vreg,ot_none,ot_none,ot_none);
-    code    : #66#14#144#10#64;
+    code    : #66#14#144#10#0;
     flags   : if_arm32 or if_vfpv4
   ),
   (

compiler/arm/cgcpu.pas

@@ -290,7 +290,7 @@ unit cgcpu;
           non-overlapping subregs per register, so we can only use
           half the single precision registers for now (as sub registers of the
           double precision ones). }
-        if current_settings.fputype=fpu_vfpv3 then
+        if current_settings.fputype in [fpu_vfpv3,fpu_vfpv4] then
           rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBFD,
               [RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7,
                RS_D16,RS_D17,RS_D18,RS_D19,RS_D20,RS_D21,RS_D22,RS_D23,RS_D24,RS_D25,RS_D26,RS_D27,RS_D28,RS_D29,RS_D30,RS_D31,
@@ -646,11 +646,13 @@ unit cgcpu;
         sym : TAsmSymbol;
       begin
         { check not really correct: should only be used for non-Thumb cpus }
-        if (CPUARM_HAS_BLX_LABEL in cpu_capabilities[current_settings.cputype]) and
-          { WinCE GNU AS (not sure if this applies in general) does not support BLX imm }
-          (target_info.system<>system_arm_wince) then
-          branchopcode:=A_BLX
-        else
+        // if (CPUARM_HAS_BLX_LABEL in cpu_capabilities[current_settings.cputype]) and
+        //   { WinCE GNU AS (not sure if this applies in general) does not support BLX imm }
+        // (target_info.system<>system_arm_wince) then
+        //   branchopcode:=A_BLX
+        // else
+        { use always BL as newer binutils do not translate blx apparently
+          generating BL is also what clang and gcc do by default }
           branchopcode:=A_BL;
         if not(weak) then
           sym:=current_asmdata.RefAsmSymbol(s)
@@ -1920,9 +1922,13 @@ unit cgcpu;
                 end;
               fpu_vfpv2,
               fpu_vfpv3,
+              fpu_vfpv4,
               fpu_vfpv3_d16:
                 begin;
-                  mmregs:=rg[R_MMREGISTER].used_in_proc-paramanager.get_volatile_registers_mm(pocall_stdcall);
+                  { the *[0..31] is a hack to prevent that the compiler tries to save odd single-type registers,
+                    they have numbers>$1f which is not really correct as they should simply have the same numbers
+                    as the even ones by with a different subtype as it is done on x86 with al/ah }
+                  mmregs:=(rg[R_MMREGISTER].used_in_proc-paramanager.get_volatile_registers_mm(pocall_stdcall))*[0..31];
                 end;
             end;
             a_reg_alloc(list,NR_STACK_POINTER_REG);
@@ -2066,7 +2072,7 @@ unit cgcpu;
              begin
                reference_reset(ref,4);
                if (tg.direction*tarmprocinfo(current_procinfo).floatregstart>=1023) or
-                  (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv3_d16]) then
+                  (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv4,fpu_vfpv3_d16]) then
                  begin
                    if not is_shifter_const(tarmprocinfo(current_procinfo).floatregstart,shift) then
                      begin
@@ -2095,6 +2101,7 @@ unit cgcpu;
                    end;
                  fpu_vfpv2,
                  fpu_vfpv3,
+                 fpu_vfpv4,
                  fpu_vfpv3_d16:
                    begin
                      ref.index:=ref.base;
@@ -2104,7 +2111,8 @@ unit cgcpu;
                        postfix:=PF_IAX
                      else
                        postfix:=PF_IAD;}
-                     list.concat(taicpu.op_ref_regset(A_VSTM,ref,R_MMREGISTER,R_SUBFD,mmregs));
+                     if mmregs<>[] then
+                       list.concat(taicpu.op_ref_regset(A_VSTM,ref,R_MMREGISTER,R_SUBFD,mmregs));
                    end;
                end;
              end;
@@ -2155,10 +2163,14 @@ unit cgcpu;
                 end;
               fpu_vfpv2,
               fpu_vfpv3,
+              fpu_vfpv4,
               fpu_vfpv3_d16:
                 begin;
                   { restore vfp registers? }
-                  mmregs:=rg[R_MMREGISTER].used_in_proc-paramanager.get_volatile_registers_mm(pocall_stdcall);
+                  { the *[0..31] is a hack to prevent that the compiler tries to save odd single-type registers,
+                    they have numbers>$1f which is not really correct as they should simply have the same numbers
+                    as the even ones by with a different subtype as it is done on x86 with al/ah }
+                  mmregs:=(rg[R_MMREGISTER].used_in_proc-paramanager.get_volatile_registers_mm(pocall_stdcall))*[0..31];
                 end;
             end;
 
@@ -2167,7 +2179,7 @@ unit cgcpu;
               begin
                 reference_reset(ref,4);
                 if (tg.direction*tarmprocinfo(current_procinfo).floatregstart>=1023) or
-                   (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv3_d16]) then
+                   (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv4,fpu_vfpv3_d16]) then
                   begin
                     if not is_shifter_const(tarmprocinfo(current_procinfo).floatregstart,shift) then
                       begin
@@ -2195,6 +2207,7 @@ unit cgcpu;
                     end;
                   fpu_vfpv2,
                   fpu_vfpv3,
+                  fpu_vfpv4,
                   fpu_vfpv3_d16:
                     begin
                       ref.index:=ref.base;
@@ -2204,7 +2217,8 @@ unit cgcpu;
                         mmpostfix:=PF_IAX
                       else
                         mmpostfix:=PF_IAD;}
-                      list.concat(taicpu.op_ref_regset(A_VLDM,ref,R_MMREGISTER,R_SUBFD,mmregs));
+                     if mmregs<>[] then
+                       list.concat(taicpu.op_ref_regset(A_VLDM,ref,R_MMREGISTER,R_SUBFD,mmregs));
                     end;
                 end;
               end;
@@ -4217,7 +4231,7 @@ unit cgcpu;
         rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
             [RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7],first_fpu_imreg,[]);
 
-        if current_settings.fputype=fpu_vfpv3 then
+        if current_settings.fputype in [fpu_vfpv3,fpu_vfpv4] then
           rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBFD,
               [RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7,
                RS_D16,RS_D17,RS_D18,RS_D19,RS_D20,RS_D21,RS_D22,RS_D23,RS_D24,RS_D25,RS_D26,RS_D27,RS_D28,RS_D29,RS_D30,RS_D31,

compiler/arm/cpubase.pas

@@ -109,7 +109,7 @@ unit cpubase;
       { registers which may be destroyed by calls }
       VOLATILE_INTREGISTERS = [RS_R0..RS_R3,RS_R12..RS_R14];
       VOLATILE_FPUREGISTERS = [RS_F0..RS_F3];
-      VOLATILE_MMREGISTERS =  [RS_D0..RS_D7,RS_D16..RS_D31,RS_S1..RS_S15];
+      VOLATILE_MMREGISTERS =  [RS_D0..RS_D7,RS_D16..RS_D31];
 
       VOLATILE_INTREGISTERS_DARWIN = [RS_R0..RS_R3,RS_R9,RS_R12..RS_R14];
 

compiler/arm/cpuelf.pas

@@ -327,6 +327,8 @@ implementation
           result:=R_ARM_REL32;
         RELOC_RELATIVE_24:
           result:=R_ARM_JUMP24;
+        RELOC_RELATIVE_CALL:
+          result:=R_ARM_CALL;
         RELOC_RELATIVE_24_THUMB:
           result:=R_ARM_CALL;
         RELOC_RELATIVE_CALL_THUMB:

compiler/arm/cpuinfo.pas

@@ -499,7 +499,9 @@ Const
        reference, but that's already done for stdcall) }
      pocall_mwpascal,
      { used for interrupt handling }
-     pocall_interrupt
+     pocall_interrupt,
+     { needed sometimes on android }
+     pocall_hardfloat
    ];
 
    cputypestr : array[tcputype] of string[8] = ('',
@@ -965,7 +967,7 @@ Const
       (controllertypestr:'THUMB2_BARE';	controllerunitstr:'THUMB2_BARE';	cputype:cpu_armv7m; fputype:fpu_soft; flashbase:$00000000;	flashsize:$00002000;	srambase:$20000000;	sramsize:$00000400)
     );
 
-   vfp_scalar = [fpu_vfpv2,fpu_vfpv3,fpu_vfpv3_d16,fpu_fpv4_s16];
+   vfp_scalar = [fpu_vfpv2,fpu_vfpv3,fpu_vfpv4,fpu_vfpv3_d16,fpu_fpv4_s16];
 
    { Supported optimizations, only used for information }
    supported_optimizerswitches = genericlevel1optimizerswitches+

compiler/arm/cpupara.pas

@@ -168,12 +168,12 @@ unit cpupara;
             orddef:
               getparaloc:=LOC_REGISTER;
             floatdef:
-              if (target_info.abi = abi_eabihf) and
+              if ((target_info.abi=abi_eabihf) or (calloption=pocall_hardfloat)) and
                  (not isvariadic) then
                 getparaloc:=LOC_MMREGISTER
               else if (calloption in [pocall_cdecl,pocall_cppdecl,pocall_softfloat]) or
                  (cs_fp_emulation in current_settings.moduleswitches) or
-                 (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv3_d16,fpu_fpv4_s16]) then
+                 (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv4,fpu_vfpv3_d16,fpu_fpv4_s16]) then
                 { the ARM eabi also allows passing VFP values via VFP registers,
                   but Mac OS X doesn't seem to do that and linux only does it if
                   built with the "-mfloat-abi=hard" option }
@@ -665,7 +665,7 @@ unit cpupara;
         { Return in FPU register? }
         if result.def.typ=floatdef then
           begin
-            if target_info.abi = abi_eabihf then 
+            if (target_info.abi=abi_eabihf) or (p.proccalloption=pocall_hardfloat) then
               begin
                 paraloc^.loc:=LOC_MMREGISTER;
                 case retcgsize of
@@ -687,7 +687,7 @@ unit cpupara;
               end
             else if (p.proccalloption in [pocall_softfloat]) or
                (cs_fp_emulation in current_settings.moduleswitches) or
-               (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv3_d16,fpu_fpv4_s16]) then
+               (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv4,fpu_vfpv3_d16,fpu_fpv4_s16]) then
               begin
                 case retcgsize of
                   OS_64,

compiler/arm/cpupi.pas

@@ -174,6 +174,7 @@ unit cpupi;
                 end;
               fpu_vfpv2,
               fpu_vfpv3,
+              fpu_vfpv4,
               fpu_vfpv3_d16:
                 begin
                   floatsavesize:=0;

compiler/arm/narmadd.pas

@@ -34,6 +34,7 @@ interface
           function  GetResFlags(unsigned:Boolean):TResFlags;
           function  GetFpuResFlags:TResFlags;
        public
+          function use_fma : boolean;override;
           function pass_1 : tnode;override;
           function use_generic_mul32to64: boolean; override;
           function use_generic_mul64bit: boolean; override;
@@ -158,6 +159,12 @@ interface
       end;
 
 
+    function tarmaddnode.use_fma : boolean;
+      begin
+       Result:=current_settings.fputype in [fpu_vfpv4];
+      end;
+
+
     procedure tarmaddnode.second_addfloat;
       var
         op : TAsmOp;
@@ -200,6 +207,7 @@ interface
             end;
           fpu_vfpv2,
           fpu_vfpv3,
+          fpu_vfpv4,
           fpu_vfpv3_d16:
             begin
               { force mmreg as location, left right doesn't matter
@@ -299,6 +307,7 @@ interface
             end;
           fpu_vfpv2,
           fpu_vfpv3,
+          fpu_vfpv4,
           fpu_vfpv3_d16:
             begin
               hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,true);

compiler/arm/narmcal.pas

@@ -45,9 +45,10 @@ implementation
   procedure tarmcallnode.set_result_location(realresdef: tstoreddef);
     begin
       if (realresdef.typ=floatdef) and 
-         (target_info.abi <> abi_eabihf) and
+         (target_info.abi<>abi_eabihf) and
+         (procdefinition.proccalloption<>pocall_hardfloat) and
          ((cs_fp_emulation in current_settings.moduleswitches) or
-          (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv3_d16,fpu_fpv4_s16])) then
+          (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv4,fpu_vfpv3_d16,fpu_fpv4_s16])) then
         begin
           { keep the fpu values in integer registers for now, the code
             generator will move them to memory or an mmregister when necessary

compiler/arm/narmcnv.pas

@@ -116,6 +116,7 @@ implementation
                 expectloc:=LOC_FPUREGISTER;
               fpu_vfpv2,
               fpu_vfpv3,
+              fpu_vfpv4,
               fpu_vfpv3_d16,
               fpu_fpv4_s16:
                 expectloc:=LOC_MMREGISTER;
@@ -242,6 +243,7 @@ implementation
             end;
           fpu_vfpv2,
           fpu_vfpv3,
+          fpu_vfpv4,
           fpu_vfpv3_d16:
             begin
               location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef));

compiler/arm/narminl.pas

@@ -33,6 +33,7 @@ interface
         function first_abs_real: tnode; override;
         function first_sqr_real: tnode; override;
         function first_sqrt_real: tnode; override;
+        function first_fma : tnode; override;
         { atn,sin,cos,lgn isn't supported by the linux fpe
         function first_arctan_real: tnode; override;
         function first_ln_real: tnode; override;
@@ -50,6 +51,7 @@ interface
         }
         procedure second_prefetch; override;
         procedure second_abs_long; override;
+        procedure second_fma; override;
       private
         procedure load_fpu_location(out singleprec: boolean);
       end;
@@ -61,7 +63,8 @@ implementation
       globtype,verbose,globals,
       cpuinfo, defutil,symdef,aasmdata,aasmcpu,
       cgbase,cgutils,pass_1,pass_2,
-      cpubase,ncgutil,cgobj,cgcpu, hlcgobj;
+      cpubase,ncgutil,cgobj,cgcpu, hlcgobj,
+      ncal;
 
 {*****************************************************************************
                               tarminlinenode
@@ -85,6 +88,7 @@ implementation
             end;
           fpu_vfpv2,
           fpu_vfpv3,
+          fpu_vfpv4,
           fpu_vfpv3_d16,
           fpu_fpv4_s16:
             begin
@@ -125,6 +129,7 @@ implementation
                 expectloc:=LOC_FPUREGISTER;
               fpu_vfpv2,
               fpu_vfpv3,
+              fpu_vfpv4,
               fpu_vfpv3_d16:
                 expectloc:=LOC_MMREGISTER;
               fpu_fpv4_s16:
@@ -155,6 +160,7 @@ implementation
                 expectloc:=LOC_FPUREGISTER;
               fpu_vfpv2,
               fpu_vfpv3,
+              fpu_vfpv4,
               fpu_vfpv3_d16:
                 expectloc:=LOC_MMREGISTER;
               fpu_fpv4_s16:
@@ -185,6 +191,7 @@ implementation
                 expectloc:=LOC_FPUREGISTER;
               fpu_vfpv2,
               fpu_vfpv3,
+              fpu_vfpv4,
               fpu_vfpv3_d16:
                 expectloc:=LOC_MMREGISTER;
               fpu_fpv4_s16:
@@ -202,6 +209,19 @@ implementation
       end;
 
 
+     function tarminlinenode.first_fma : tnode;
+       begin
+         if (true) and
+           ((is_double(resultdef)) or (is_single(resultdef))) then
+           begin
+             expectloc:=LOC_MMREGISTER;
+             Result:=nil;
+           end
+         else
+           Result:=inherited first_fma;
+       end;
+
+
     { atn,sin,cos,lgn isn't supported by the linux fpe
     function tarminlinenode.first_arctan_real: tnode;
       begin
@@ -244,6 +264,7 @@ implementation
             current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_ABS,location.register,left.location.register),get_fpu_postfix(resultdef)));
           fpu_vfpv2,
           fpu_vfpv3,
+          fpu_vfpv4,
           fpu_vfpv3_d16:
             begin
               if singleprec then
@@ -280,6 +301,7 @@ implementation
             current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_MUF,location.register,left.location.register,left.location.register),get_fpu_postfix(resultdef)));
           fpu_vfpv2,
           fpu_vfpv3,
+          fpu_vfpv4,
           fpu_vfpv3_d16:
             begin
               if singleprec then
@@ -309,6 +331,7 @@ implementation
             current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_SQT,location.register,left.location.register),get_fpu_postfix(resultdef)));
           fpu_vfpv2,
           fpu_vfpv3,
+          fpu_vfpv4,
           fpu_vfpv3_d16:
             begin
               if singleprec then
@@ -404,6 +427,93 @@ implementation
         cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
       end;
 
+
+    procedure tarminlinenode.second_fma;
+      const
+        op : array[false..true,false..true] of TAsmOp =
+          { positive product }
+          (
+           { positive third operand }
+           (A_VFMA,
+           { negative third operand }
+            A_VFNMS),
+           { negative product }
+            { positive third operand }
+            (A_VFMS,
+             A_VFNMA)
+           );
+
+      var
+        paraarray : array[1..3] of tnode;
+        i : integer;
+        negop3,
+        negproduct : boolean;
+        oppostfix : TOpPostfix;
+      begin
+         if current_settings.fputype in [fpu_vfpv4] then
+           begin
+             negop3:=false;
+             negproduct:=false;
+             paraarray[1]:=tcallparanode(tcallparanode(tcallparanode(parameters).nextpara).nextpara).paravalue;
+             paraarray[2]:=tcallparanode(tcallparanode(parameters).nextpara).paravalue;
+             paraarray[3]:=tcallparanode(parameters).paravalue;
+
+             { check if a neg. node can be removed
+               this is possible because changing the sign of
+               a floating point number does not affect its absolute
+               value in any way
+             }
+             if paraarray[1].nodetype=unaryminusn then
+               begin
+                 paraarray[1]:=tunarynode(paraarray[1]).left;
+                 { do not release the unused unary minus node, it is kept and release together with the other nodes,
+                   only no code is generated for it }
+                 negproduct:=not(negproduct);
+               end;
+
+             if paraarray[2].nodetype=unaryminusn then
+               begin
+                 paraarray[2]:=tunarynode(paraarray[2]).left;
+                 { do not release the unused unary minus node, it is kept and release together with the other nodes,
+                   only no code is generated for it }
+                 negproduct:=not(negproduct);
+               end;
+
+             if paraarray[3].nodetype=unaryminusn then
+               begin
+                 paraarray[3]:=tunarynode(paraarray[3]).left;
+                 { do not release the unused unary minus node, it is kept and release together with the other nodes,
+                   only no code is generated for it }
+                 negop3:=true;
+               end;
+
+              for i:=1 to 3 do
+               secondpass(paraarray[i]);
+
+             { no memory operand is allowed }
+             for i:=1 to 3 do
+               begin
+                 if not(paraarray[i].location.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
+                   hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,paraarray[i].location,paraarray[i].resultdef,true);
+               end;
+
+             location_reset(location,LOC_MMREGISTER,paraarray[1].location.size);
+             location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
+
+             hlcg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,paraarray[3].resultdef,resultdef,
+               paraarray[3].location.register,location.register,mms_movescalar);
+             if is_double(resultdef) then
+               oppostfix:=PF_F64
+             else
+               oppostfix:=PF_F32;
+             current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(op[negproduct,negop3],
+               location.register,paraarray[1].location.register,paraarray[2].location.register),oppostfix));
+           end
+         else
+           internalerror(2014032301);
+      end;
+
+
 begin
   cinlinenode:=tarminlinenode;
 end.

compiler/arm/narmmat.pas

@@ -409,6 +409,7 @@ implementation
             end;
           fpu_vfpv2,
           fpu_vfpv3,
+          fpu_vfpv4,
           fpu_vfpv3_d16:
             begin
               hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,true);

compiler/arm/narmset.pas

@@ -105,8 +105,8 @@ implementation
           begin
             hlcg.location_force_reg(current_asmdata.CurrAsmList, left.location,
              left.resultdef, opdef, true);
-            register_maybe_adjust_setbase(current_asmdata.CurrAsmList, left.location,
-             setbase);
+            register_maybe_adjust_setbase(current_asmdata.CurrAsmList, opdef,
+             left.location, setbase);
             hlcg.location_force_reg(current_asmdata.CurrAsmList, right.location,
              right.resultdef, right.resultdef, true);
 

compiler/arm/raarmgas.pas

@@ -62,7 +62,7 @@ Unit raarmgas;
       { helpers }
       cutils,
       { global }
-      globtype,verbose,
+      globtype,globals,verbose,
       systems,aasmbase,aasmtai,aasmdata,aasmcpu,
       { symtable }
       symconst,symsym,
@@ -149,12 +149,14 @@ Unit raarmgas;
 
     function tarmattreader.is_targetdirective(const s: string): boolean;
       begin
-        if s = '.thumb_func' then
-          result:=true
-        else if s='.thumb_set' then
-          result:=true
-        else
-          Result:=inherited is_targetdirective(s);
+        case s of
+          '.thumb_func',
+          '.code',
+          '.thumb_set':
+            result:=true
+          else
+            Result:=inherited is_targetdirective(s);
+        end;
       end;
 
 
@@ -1004,7 +1006,7 @@ Unit raarmgas;
                   oper.opr.typ:=OPR_REGISTER;
                   oper.opr.reg:=tempreg;
                 end
-              else if (actasmtoken=AS_NOT) and (actopcode in [A_LDM,A_STM,A_FLDM,A_FSTM,A_VLDM,A_VSTM]) then
+              else if (actasmtoken=AS_NOT) and (actopcode in [A_LDM,A_STM,A_FLDM,A_FSTM,A_VLDM,A_VSTM,A_SRS,A_RFE]) then
                 begin
                   consume(AS_NOT);
                   oper.opr.typ:=OPR_REFERENCE;
@@ -1426,6 +1428,7 @@ Unit raarmgas;
           end;
       end;
 
+
     procedure tarmattreader.HandleTargetDirective;
       var
         symname,
@@ -1433,24 +1436,35 @@ Unit raarmgas;
         val     : aint;
         symtyp  : TAsmsymtype;
       begin
-        if actasmpattern='.thumb_set' then
-          begin
-            consume(AS_TARGET_DIRECTIVE);
-            BuildConstSymbolExpression(true,false,false, val,symname,symtyp);
-            Consume(AS_COMMA);
-            BuildConstSymbolExpression(true,false,false, val,symval,symtyp);
+        case actasmpattern of
+          '.thumb_set':
+            begin
+              consume(AS_TARGET_DIRECTIVE);
+              BuildConstSymbolExpression(true,false,false, val,symname,symtyp);
+              Consume(AS_COMMA);
+              BuildConstSymbolExpression(true,false,false, val,symval,symtyp);
 
-            curList.concat(tai_symbolpair.create(spk_thumb_set,symname,symval));
-          end
-        else if actasmpattern='.thumb_func' then
-          begin
-            consume(AS_TARGET_DIRECTIVE);
-            curList.concat(tai_directive.create(asd_thumb_func,''));
-          end
-        else
-          inherited HandleTargetDirective;
+              curList.concat(tai_symbolpair.create(spk_thumb_set,symname,symval));
+            end;
+          '.code':
+            begin
+              consume(AS_TARGET_DIRECTIVE);
+              val:=BuildConstExpression(false,false);
+              if not(val in [16,32]) then
+                Message(asmr_e_invalid_code_value);
+              curList.concat(tai_directive.create(asd_code,tostr(val)));
+            end;
+          '.thumb_func':
+            begin
+              consume(AS_TARGET_DIRECTIVE);
+              curList.concat(tai_directive.create(asd_thumb_func,''));
+            end
+          else
+            inherited HandleTargetDirective;
+        end;
       end;
 
+
     function tarmattreader.is_unified: boolean;
       begin
         result:=false;

compiler/arm/rgcpu.pas

@@ -346,6 +346,11 @@ unit rgcpu;
               supreg:=getsupreg(reg);
               for i:=RS_D16 to RS_D31 do
                 add_edge(supreg,i);
+              { further, we cannot use the odd single registers as the register
+                allocator cannot handle overlapping registers so far }
+              for i in [RS_S1,RS_S3,RS_S5,RS_S7,RS_S9,RS_S11,RS_S13,RS_S15,RS_S17,RS_S19,
+                RS_S21,RS_S23,RS_S25,RS_S27,RS_S29,RS_S31] do
+                add_edge(supreg,i);
             end;
         end;
       end;

compiler/assemble.pas

@@ -248,9 +248,7 @@ Implementation
       cclasses,
 {$endif memdebug}
       script,fmodule,verbose,
-{$if defined(m68k) or defined(arm)}
       cpuinfo,
-{$endif m68k or arm}
       aasmcpu,
       owar,owomflib
       ;
@@ -927,14 +925,22 @@ Implementation
              Replace(result,'$ASM',maybequoted(AsmFileName));
            Replace(result,'$OBJ',maybequoted(ObjFileName));
          end;
+
          if (cs_create_pic in current_settings.moduleswitches) then
            Replace(result,'$PIC','-KPIC')
          else
            Replace(result,'$PIC','');
+
          if (cs_asm_source in current_settings.globalswitches) then
            Replace(result,'$NOWARN','')
          else
            Replace(result,'$NOWARN','-W');
+
+         if target_info.endian=endian_little then
+           Replace(result,'$ENDIAN','-mlittle')
+         else
+           Replace(result,'$ENDIAN','-mbig');
+
          Replace(result,'$EXTRAOPT',asmextraopt);
       end;
 
@@ -1474,6 +1480,7 @@ Implementation
       var
         objsym,
         objsymend : TObjSymbol;
+        cpu: tcputype;
       begin
         while assigned(hp) do
          begin
@@ -1554,9 +1561,22 @@ Implementation
                    asd_reference:
                      { ignore for now, but should be added}
                      ;
+                   asd_cpu:
+                     begin
+                       ObjData.CPUType:=cpu_none;
+                       for cpu:=low(tcputype) to high(tcputype) do
+                         if cputypestr[cpu]=tai_directive(hp).name then
+                           begin
+                             ObjData.CPUType:=cpu;
+                             break;
+                           end;
+                     end;
 {$ifdef ARM}
                    asd_thumb_func:
                      ObjData.ThumbFunc:=true;
+                   asd_code:
+                     { ai_directive(hp).name can be only 16 or 32, this is checked by the reader }
+                     ObjData.ThumbFunc:=tai_directive(hp).name='16';
 {$endif ARM}
                    else
                      internalerror(2010011101);
@@ -1599,6 +1619,7 @@ Implementation
       var
         objsym,
         objsymend : TObjSymbol;
+        cpu: tcputype;
       begin
         while assigned(hp) do
          begin
@@ -1700,6 +1721,19 @@ Implementation
                    asd_thumb_func:
                      { ignore for now, but should be added}
                      ;
+                   asd_code:
+                     { ignore for now, but should be added}
+                     ;
+                   asd_cpu:
+                     begin
+                       ObjData.CPUType:=cpu_none;
+                       for cpu:=low(tcputype) to high(tcputype) do
+                         if cputypestr[cpu]=tai_directive(hp).name then
+                           begin
+                             ObjData.CPUType:=cpu;
+                             break;
+                           end;
+                     end;
                    else
                      internalerror(2010011102);
                  end;
@@ -1729,6 +1763,7 @@ Implementation
         {$endif}
         ccomp : comp;
         tmp    : word;
+        cpu: tcputype;
       begin
         fillchar(zerobuf,sizeof(zerobuf),0);
         fillchar(objsym,sizeof(objsym),0);
@@ -1916,10 +1951,31 @@ Implementation
              ait_cutobject :
                if SmartAsm then
                 break;
-             ait_weak:
+             ait_directive :
                begin
-                 objsym:=ObjData.symbolref(tai_weak(hp).sym^);
-                 objsym.bind:=AB_WEAK_EXTERNAL;
+                 case tai_directive(hp).directive of
+                   asd_weak_definition,
+                   asd_weak_reference:
+                     begin
+                       objsym:=ObjData.symbolref(tai_directive(hp).name);
+                       if objsym.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL] then
+                         objsym.bind:=AB_WEAK_EXTERNAL
+                       else
+                         { TODO: should become a weak definition; for now, do
+                             the same as what was done for ait_weak }
+                         objsym.bind:=AB_WEAK_EXTERNAL;
+                     end;
+                   asd_cpu:
+                     begin
+                       ObjData.CPUType:=cpu_none;
+                       for cpu:=low(tcputype) to high(tcputype) do
+                         if cputypestr[cpu]=tai_directive(hp).name then
+                           begin
+                             ObjData.CPUType:=cpu;
+                             break;
+                           end;
+                     end;
+                 end
                end;
              ait_symbolpair:
                begin

compiler/avr/aasmcpu.pas

@@ -422,7 +422,6 @@ implementation
                       end;
                     ait_align:
                       inc(CurrOffset,tai_align(curtai).aligntype);
-                    ait_weak,
                     ait_symbolpair,
                     ait_marker:
                       ;

compiler/avr/aoptcpu.pas

@@ -180,7 +180,7 @@ Implementation
                                         A_LSL,A_LSR,
                                         A_OR,A_ORI,A_ROL,A_ROR])))) or
                (MatchInstruction(hp1, A_CPI) and
-                (taicpu(p).opcode in [A_ANDI,A_ORI]) and
+                (taicpu(p).opcode = A_ANDI) and
                 (taicpu(p).oper[1]^.typ=top_const) and
                 (taicpu(hp1).oper[1]^.typ=top_const) and
                 (taicpu(p).oper[1]^.val=taicpu(hp1).oper[1]^.val))) and
@@ -208,6 +208,10 @@ Implementation
                   end;
                 }
 
+                // If we compare to the same value we are masking then invert the comparison
+                if (taicpu(hp1).opcode=A_CPI) then
+                  taicpu(hp2).condition:=inverse_cond(taicpu(hp2).condition);
+
                 asml.InsertBefore(tai_regalloc.alloc(NR_DEFAULTFLAGS,p), p);
                 asml.InsertAfter(tai_regalloc.dealloc(NR_DEFAULTFLAGS,hp2), hp2);
                 IncludeRegInUsedRegs(NR_DEFAULTFLAGS,UsedRegs);

compiler/avr/cgcpu.pas

@@ -402,11 +402,18 @@ unit cgcpu;
 
 
     procedure tcgavr.a_call_name(list : TAsmList;const s : string; weak: boolean);
+      var
+        sym: TAsmSymbol;
       begin
+        if weak then
+          sym:=current_asmdata.WeakRefAsmSymbol(s)
+        else
+          sym:=current_asmdata.RefAsmSymbol(s);
+
         if CPUAVR_HAS_JMP_CALL in cpu_capabilities[current_settings.cputype] then
-          list.concat(taicpu.op_sym(A_CALL,current_asmdata.RefAsmSymbol(s)))
+          list.concat(taicpu.op_sym(A_CALL,sym))
         else
-          list.concat(taicpu.op_sym(A_RCALL,current_asmdata.RefAsmSymbol(s)));
+          list.concat(taicpu.op_sym(A_RCALL,sym));
 
         include(current_procinfo.flags,pi_do_call);
       end;
@@ -1592,17 +1599,17 @@ unit cgcpu;
             end;
 
             if swapped then
-              list.concat(taicpu.op_reg_reg(A_CP,reg,NR_R1))
+              list.concat(taicpu.op_reg_reg(A_CP,NR_R1,reg))
             else
-              list.concat(taicpu.op_reg_reg(A_CP,NR_R1,reg));
+              list.concat(taicpu.op_reg_reg(A_CP,reg,NR_R1));
 
             for i:=2 to tcgsize2size[size] do
               begin
                 reg:=GetNextReg(reg);
                 if swapped then
-                  list.concat(taicpu.op_reg_reg(A_CPC,reg,NR_R1))
+                  list.concat(taicpu.op_reg_reg(A_CPC,NR_R1,reg))
                 else
-                  list.concat(taicpu.op_reg_reg(A_CPC,NR_R1,reg));
+                  list.concat(taicpu.op_reg_reg(A_CPC,reg,NR_R1));
               end;
 
             a_jmp_cond(list,cmp_op,l);

compiler/avr/cpuinfo.pas

@@ -277,8 +277,8 @@ Const
         fputype: fpu_soft;
         flashbase:0;
         flashsize:$20000;
-        srambase:0;
-        sramsize:4096;
+        srambase:256;
+        sramsize:32*1024;
         eeprombase:0;
         eepromsize:4096;
         )

compiler/avr/cpunode.pas

@@ -36,7 +36,8 @@ unit cpunode;
        }
        ,navradd
        ,navrmat
-       ,navrcnv,
+       ,navrcnv
+       ,navrutil,
        { symtable }
        symcpu
        ;

compiler/avr/navrutil.pas

@@ -0,0 +1,198 @@
+{
+    Copyright (c) 2015 by Jeppe Johansen
+
+    AVR version of some node tree helper routines
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit navrutil;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    node,nbas,
+    ngenutil,
+    symtype,symconst,symsym,symdef;
+
+
+  type
+    tavrnodeutils = class(tnodeutils)
+      class procedure InsertInitFinalTable; override;
+    end;
+
+implementation
+
+    uses
+      verbose,cutils,globtype,globals,constexp,fmodule,
+      cclasses,
+      aasmdata,aasmtai,aasmcpu,aasmcnst,aasmbase,
+      cpubase,
+      symbase,symcpu,symtable,defutil,
+      ncnv,ncon,ninl,ncal,nld,nmem,
+      systems,
+      CPUInfo,
+      ppu,
+      pass_1;
+
+
+  procedure AddToStructInits(p:TObject;arg:pointer);
+    var
+      StructList: TFPList absolute arg;
+    begin
+      if (tdef(p).typ in [objectdef,recorddef]) and
+         not (df_generic in tdef(p).defoptions) then
+        begin
+          { first add the class... }
+          if ([oo_has_class_constructor,oo_has_class_destructor] * tabstractrecorddef(p).objectoptions <> []) then
+            StructList.Add(p);
+          { ... and then also add all subclasses }
+          tabstractrecorddef(p).symtable.deflist.foreachcall(@AddToStructInits,arg);
+        end;
+    end;
+
+
+  class procedure tavrnodeutils.InsertInitFinalTable;
+    var
+      hp : tused_unit;
+      op: TAsmOp;
+      initCount, finalCount: longint;
+
+      procedure write_struct_inits(InitList, FinalizeList: TAsmList; u: tmodule);
+        var
+          i: integer;
+          structlist: TFPList;
+          pd: tprocdef;
+        begin
+          structlist := TFPList.Create;
+          if assigned(u.globalsymtable) then
+            u.globalsymtable.DefList.ForEachCall(@AddToStructInits,structlist);
+          u.localsymtable.DefList.ForEachCall(@AddToStructInits,structlist);
+          { write structures }
+          for i:=0 to structlist.Count-1 do
+          begin
+            pd:=tabstractrecorddef(structlist[i]).find_procdef_bytype(potype_class_constructor);
+            if assigned(pd) then
+              begin
+                InitList.Concat(taicpu.op_sym(op,current_asmdata.RefAsmSymbol(pd.mangledname)));
+                inc(initCount);
+              end;
+
+            pd := tabstractrecorddef(structlist[i]).find_procdef_bytype(potype_class_destructor);
+            if assigned(pd) then
+              begin
+                FinalizeList.Concat(taicpu.op_sym(op,current_asmdata.RefAsmSymbol(pd.mangledname)));
+                inc(finalCount);
+              end;
+          end;
+          structlist.free;
+        end;
+
+    var
+      initList, finalList, header: TAsmList;
+    begin
+      initList:=TAsmList.create;
+      finalList:=TAsmList.create;
+
+      initCount:=0;
+      finalCount:=0;
+
+      if CPUAVR_HAS_JMP_CALL in cpu_capabilities[current_settings.cputype] then
+        op:=A_CALL
+      else
+        op:=A_RCALL;
+
+      hp:=tused_unit(usedunits.first);
+      while assigned(hp) do
+        begin
+          if (hp.u.flags and uf_classinits) <> 0 then
+            write_struct_inits(initList, finalList, hp.u);
+
+          if (hp.u.flags and (uf_init or uf_finalize))<>0 then
+            begin
+              if (hp.u.flags and uf_init)<>0 then
+                begin
+                  initList.Concat(taicpu.op_sym(op,current_asmdata.RefAsmSymbol(make_mangledname('INIT$',hp.u.globalsymtable,''))));
+                  inc(initCount);
+                end;
+
+              if (hp.u.flags and uf_finalize)<>0 then
+                begin
+                  finalList.Concat(taicpu.op_sym(op,current_asmdata.RefAsmSymbol(make_mangledname('FINALIZE$',hp.u.globalsymtable,''))));
+                  inc(finalCount);
+                end;
+            end;
+
+          hp:=tused_unit(hp.next);
+        end;
+
+      { insert class constructors/destructor of the program }
+      if (current_module.flags and uf_classinits) <> 0 then
+        write_struct_inits(initList, finalList, current_module);
+
+      { Insert initialization/finalization of the program }
+      if (current_module.flags and (uf_init or uf_finalize))<>0 then
+        begin
+          if (current_module.flags and uf_init)<>0 then
+            begin
+              initList.Concat(taicpu.op_sym(op,current_asmdata.RefAsmSymbol(make_mangledname('INIT$',current_module.localsymtable,''))));
+              inc(initCount);
+            end;
+
+          if (current_module.flags and uf_finalize)<>0 then
+            begin
+              finalList.Concat(taicpu.op_sym(op,current_asmdata.RefAsmSymbol(make_mangledname('FINALIZE$',current_module.localsymtable,''))));
+              inc(finalCount);
+            end;
+        end;
+
+      initList.Concat(taicpu.op_none(A_RET));
+      finalList.Concat(taicpu.op_none(A_RET));
+
+      begin
+        header:=TAsmList.create;
+        new_section(header, sec_code, 'FPC_INIT_FUNC_TABLE', 1);
+        header.concat(tai_symbol.Createname_global('FPC_INIT_FUNC_TABLE',AT_FUNCTION,0));
+
+        initList.insertList(header);
+        header.free;
+
+        current_asmdata.AsmLists[al_procedures].concatList(initList);
+      end;
+
+      begin
+        header:=TAsmList.create;
+        new_section(header, sec_code, 'FPC_FINALIZE_FUNC_TABLE', 1);
+        header.concat(tai_symbol.Createname_global('FPC_FINALIZE_FUNC_TABLE',AT_FUNCTION,0));
+
+        finalList.insertList(header);
+        header.free;
+
+        current_asmdata.AsmLists[al_procedures].concatList(finalList);
+      end;
+
+      initList.Free;
+      finalList.Free;
+
+      inherited InsertInitFinalTable;
+    end;
+
+begin
+  cnodeutils:=tavrnodeutils;
+end.
+

compiler/cclasses.pas

@@ -401,7 +401,7 @@ type
        { string container }
        TCmdStrList = class(TLinkedList)
        private
-          FDoubles : boolean;  { if this is set to true, doubles are allowed }
+          FDoubles : boolean;  { if this is set to true, doubles (case insensitive!) are allowed }
        public
           constructor Create;
           constructor Create_No_Double;
@@ -2407,7 +2407,7 @@ end;
     procedure TCmdStrList.insert(const s : TCmdStr);
       begin
          if (s='') or
-            ((not FDoubles) and (find(s)<>nil)) then
+            ((not FDoubles) and (findcase(s)<>nil)) then
           exit;
          inherited insert(TCmdStrListItem.create(s));
       end;
@@ -2416,7 +2416,7 @@ end;
     procedure TCmdStrList.concat(const s : TCmdStr);
       begin
          if (s='') or
-            ((not FDoubles) and (find(s)<>nil)) then
+            ((not FDoubles) and (findcase(s)<>nil)) then
           exit;
          inherited concat(TCmdStrListItem.create(s));
       end;
@@ -2428,7 +2428,7 @@ end;
       begin
         if s='' then
          exit;
-        p:=find(s);
+        p:=findcase(s);
         if assigned(p) then
          begin
            inherited Remove(p);

compiler/cfileutl.pas

@@ -23,9 +23,7 @@ unit cfileutl;
 
 {$i fpcdefs.inc}
 
-{$ifndef DragonFly}
 {$define usedircache}
-{$endif DragonFly}
 
 interface
 

compiler/cgobj.pas

@@ -1096,8 +1096,12 @@ implementation
                cgsize:=paraloc.size;
                if paraloc.shiftval>0 then
                  a_op_const_reg_reg(list,OP_SHL,OS_INT,paraloc.shiftval,paraloc.register,paraloc.register)
+               { in case the original size was 3 or 5/6/7 bytes, the value was
+                 shifted to the top of the to 4 resp. 8 byte register on the
+                 caller side and needs to be stored with those bytes at the
+                 start of the reference -> don't shift right }
                else if (paraloc.shiftval<0) and
-                       (sizeleft in [1,2,4]) then
+                       ((-paraloc.shiftval) in [1,2,4]) then
                  begin
                    a_op_const_reg_reg(list,OP_SHR,OS_INT,-paraloc.shiftval,paraloc.register,paraloc.register);
                    { convert to a register of 1/2/4 bytes in size, since the
@@ -1319,7 +1323,7 @@ implementation
                     tmpreg2:=makeregsize(list,register,OS_16);
                     a_load_ref_reg(list,OS_8,OS_16,tmpref,tmpreg2);
                     a_op_reg_reg(list,OP_OR,OS_16,tmpreg,tmpreg2);
-                    a_load_reg_reg(list,OS_16,tosize,tmpreg2,register);
+                    a_load_reg_reg(list,fromsize,tosize,tmpreg2,register);
                   end;
               OS_32,OS_S32:
                 if ref.alignment=2 then
@@ -1336,7 +1340,7 @@ implementation
                     tmpreg2:=makeregsize(list,register,OS_32);
                     a_load_ref_reg(list,OS_16,OS_32,tmpref,tmpreg2);
                     a_op_reg_reg(list,OP_OR,OS_32,tmpreg,tmpreg2);
-                    a_load_reg_reg(list,OS_32,tosize,tmpreg2,register);
+                    a_load_reg_reg(list,fromsize,tosize,tmpreg2,register);
                   end
                 else
                   begin
@@ -1355,7 +1359,7 @@ implementation
                         a_load_ref_reg(list,OS_8,OS_32,tmpref,tmpreg2);
                         a_op_reg_reg(list,OP_OR,OS_32,tmpreg2,tmpreg);
                       end;
-                    a_load_reg_reg(list,OS_32,tosize,tmpreg,register);
+                    a_load_reg_reg(list,fromsize,tosize,tmpreg,register);
                   end
               else
                 a_load_ref_reg(list,fromsize,tosize,tmpref,register);

compiler/constexp.pas

@@ -219,7 +219,7 @@ begin
   else if not a.signed and (a.uvalue>qword(high(int64))) then
     goto try_qword
   else
-    sspace:=a.uvalue+qword(abs(low(int64)));
+    sspace:=a.uvalue+abs_low_int64;
   if sspace>=b then
     begin
       result.signed:=true;
@@ -288,7 +288,9 @@ begin
     begin
       result.overflow:=false;
       result.signed:=true;
+      {$push} {$Q-}
       result.svalue:=-a.svalue;
+      {$pop}
     end;
 end;
 

compiler/cresstr.pas

@@ -133,7 +133,6 @@ uses
       Var
         namelab,
         valuelab : tasmlabofs;
-        resstrlab : tasmsymbol;
         R : TResourceStringItem;
         resstrdef: tdef;
         tcb : ttai_typedconstbuilder;
@@ -148,8 +147,8 @@ uses
         tcb.maybe_begin_aggregate(resstrdef);
         namelab:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_const],@current_module.localsymtable.name^[1],length(current_module.localsymtable.name^),getansistringcodepage);
         tcb.emit_string_offset(namelab,length(current_module.localsymtable.name^),st_ansistring,false,charpointertype);
-        tcb.emit_tai(tai_const.create_nil_dataptr,voidpointertype);
-        tcb.emit_tai(tai_const.create_nil_dataptr,voidpointertype);
+        tcb.emit_tai(tai_const.create_nil_dataptr,cansistringtype);
+        tcb.emit_tai(tai_const.create_nil_dataptr,cansistringtype);
         tcb.emit_ord_const(0,u32inttype);
         tcb.maybe_end_aggregate(resstrdef);
         current_asmdata.asmlists[al_resourcestrings].concatList(

compiler/cstreams.pas

@@ -132,6 +132,20 @@ var
   CFileStreamClass: TCFileStreamClass = TCFileStream;
 
 type
+  TCRangeStream = class(TCStream)
+  private
+    FBase: TCStream;
+    FOffset: LongInt;
+    FMaxOffset: LongInt;
+    FSize: LongInt;
+    FPosition: LongInt;
+  public
+    constructor Create(ABase: TCStream; AOffset, ASize: LongInt);
+    function Read(var Buffer; Count: LongInt): LongInt; override;
+    function Write(const Buffer; Count: LongInt): LongInt; override;
+    function Seek(Offset: LongInt; Origin: Word): LongInt; override;
+  end;
+
 { TCustomMemoryStream abstract class }
 
   TCCustomMemoryStream = class(TCStream)
@@ -467,6 +481,92 @@ begin
 end;
 
 
+{****************************************************************************}
+{*                             TCRangeStream                                *}
+{****************************************************************************}
+
+
+constructor TCRangeStream.Create(ABase: TCStream; AOffset, ASize: LongInt);
+begin
+  if not assigned(ABase) then
+    CStreamError:=155
+  else
+    { we allow to be positioned directly at the end for appending }
+    if (AOffset<0) or (AOffset>ABase.Size) then
+      CStreamError:=156
+    else
+      begin
+        FBase:=ABase;
+        FOffset:=AOffset;
+        if ASize<0 then
+          FSize:=maxLongint-FOffset
+        else
+          FSize:=ASize;
+        FMaxOffset:=FOffset+FSize-1;
+      end;
+end;
+
+
+function TCRangeStream.Read(var Buffer; Count: LongInt): LongInt;
+begin
+  Count:=Min(Count,FMaxOffset-FPosition+1);
+  if Count>0 then
+    begin
+      FBase.Seek(FOffset+FPosition,soFromBeginning);
+      result:=FBase.Read(Buffer,Count);
+    end
+  else
+    result:=0;
+  FPosition:=FPosition+result;
+end;
+
+
+function TCRangeStream.Write(const Buffer; Count: LongInt): LongInt;
+begin
+  Count:=Min(Count,FMaxOffset-FPosition+1);
+  if Count>0 then
+    begin
+      FBase.Seek(FOffset+FPosition,soFromBeginning);
+      result:=FBase.Write(Buffer,Count);
+    end
+  else
+    result:=0;
+  FPosition:=FPosition+result;
+end;
+
+
+function TCRangeStream.Seek(Offset: LongInt; Origin: Word): LongInt;
+begin
+  case Origin of
+    soFromBeginning:
+      begin
+        if Offset>FMaxOffset then
+          CStreamError:=156
+        else
+          FPosition:=FBase.Seek(FOffset+Offset,soFromBeginning)-FOffset;
+      end;
+    soFromCurrent:
+      begin
+        if Offset>FMaxOffset then
+          CStreamError:=156
+        else
+          FPosition:=FBase.Seek(FOffset+FPosition+Offset,soFromBeginning)-FOffset;
+      end;
+    soFromEnd:
+      begin
+        if Offset>FSize-1 then
+          CStreamError:=156
+        else
+          FPosition:=FBase.Seek(FMaxOffset-Offset,soFromBeginning)-FOffset;
+      end;
+    else
+      begin
+        CStreamError:=156;
+      end;
+  end;
+  Result:=FPosition;
+end;
+
 {****************************************************************************}
 {*                             TCustomMemoryStream                          *}
 {****************************************************************************}

compiler/cutils.pas

@@ -103,6 +103,7 @@ interface
        exponent value is returned in power.
     }
     function ispowerof2(value : int64;out power : longint) : boolean;
+    function ispowerof2(value : Tconstexprint;out power : longint) : boolean;
     function nextpowerof2(value : int64; out power: longint) : int64;
 {$ifdef VER2_6}  { only 2.7.1+ has a popcnt function in the system unit }
     function PopCnt(AValue : Byte): Byte;
@@ -866,6 +867,22 @@ implementation
       end;
 
 
+    function ispowerof2(value: Tconstexprint; out power: longint): boolean;
+      begin
+        if value.signed or
+           (value.uvalue<=high(int64)) then
+          result:=ispowerof2(value.svalue,power)
+        else if not value.signed and
+            (value.svalue=low(int64)) then
+          begin
+            result:=true;
+            power:=63;
+          end
+        else
+          result:=false;
+      end;
+
+
     function nextpowerof2(value : int64; out power: longint) : int64;
     {
       returns the power of 2 >= value

compiler/dbgdwarf.pas

@@ -1557,6 +1557,24 @@ implementation
                 ]);
               finish_entry;
             end;
+          u128bit:
+            begin
+              append_entry(DW_TAG_base_type,false,[
+                DW_AT_name,DW_FORM_string,'Int128'#0,
+                DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
+                DW_AT_byte_size,DW_FORM_data1,16
+                ]);
+              finish_entry;
+            end;
+          s128bit:
+            begin
+              append_entry(DW_TAG_base_type,false,[
+                DW_AT_name,DW_FORM_string,'Int128'#0,
+                DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
+                DW_AT_byte_size,DW_FORM_data1,16
+                ]);
+              finish_entry;
+            end;
           else
             internalerror(200601287);
         end;
@@ -2213,6 +2231,14 @@ implementation
 
             append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(procentry));
             append_labelentry(DW_AT_high_pc,procendlabel);
+
+            if not(target_info.system in systems_darwin) then
+              begin
+                current_asmdata.asmlists[al_dwarf_aranges].Concat(
+                  tai_const.create_type_sym(aitconst_ptr_unaligned,current_asmdata.RefAsmSymbol(procentry)));
+                current_asmdata.asmlists[al_dwarf_aranges].Concat(
+                  tai_const.Create_rel_sym(aitconst_ptr_unaligned,current_asmdata.RefAsmSymbol(procentry),procendlabel));
+              end;
           end;
 
         { Don't write the funcretsym explicitly, it's also in the
@@ -3134,7 +3160,7 @@ implementation
 
       var
         storefilepos  : tfileposinfo;
-        lenstartlabel : tasmlabel;
+        lenstartlabel,arangestartlabel: tasmlabel;
         i : longint;
         def: tdef;
         dbgname: string;
@@ -3174,6 +3200,39 @@ implementation
         { start abbrev section }
         new_section(current_asmdata.asmlists[al_dwarf_abbrev],sec_debug_abbrev,'',0);
 
+        if not(target_info.system in systems_darwin) then
+          begin
+            { start aranges section }
+            new_section(current_asmdata.asmlists[al_dwarf_aranges],sec_debug_aranges,'',0);
+
+            current_asmdata.getlabel(arangestartlabel,alt_dbgfile);
+
+            if use_64bit_headers then
+              current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_32bit_unaligned(longint($FFFFFFFF)));
+            current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_rel_sym(offsetreltype,
+              arangestartlabel,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'earanges0',AB_LOCAL,AT_DATA)));
+
+            current_asmdata.asmlists[al_dwarf_aranges].concat(tai_label.create(arangestartlabel));
+
+            current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_16bit_unaligned(2));
+
+            if not(tf_dwarf_relative_addresses in target_info.flags) then
+              current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_type_sym(offsetabstype,
+                current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_info0',AB_LOCAL,AT_DATA)))
+            else
+              current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_rel_sym(offsetreltype,
+                current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_infosection0',AB_LOCAL,AT_DATA),
+                current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_info0',AB_LOCAL,AT_DATA)));
+
+            current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_8bit(sizeof(pint)));
+            current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_8bit(0));
+            { alignment }
+            current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_32bit_unaligned(0));
+
+            { start ranges section }
+            new_section(current_asmdata.asmlists[al_dwarf_ranges],sec_debug_ranges,'',0);
+          end;
+
         { debug info header }
         current_asmdata.getlabel(lenstartlabel,alt_dbgfile);
         { size }
@@ -3268,6 +3327,14 @@ implementation
         { end of abbrev table }
         current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
 
+        if not(target_info.system in systems_darwin) then
+          begin
+            { end of aranges table }
+            current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_aint(0));
+            current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_aint(0));
+            current_asmdata.asmlists[al_dwarf_aranges].concat(tai_symbol.createname(target_asm.labelprefix+'earanges0',AT_DATA,0));
+          end;
+
         { reset all def debug states }
         for i:=0 to defnumberlist.count-1 do
           begin

compiler/dbgstabs.pas

@@ -701,7 +701,9 @@ implementation
                 ss:=def_stabstr_evaluate(def,'r${numberstring};0;255;',[]);
               u32bit,
               s64bit,
-              u64bit :
+              u64bit,
+              s128bit,
+              u128bit:
                 ss:=def_stabstr_evaluate(def,'r${numberstring};0;-1;',[]);
               else
                 ss:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low.svalue)),tostr(longint(def.high.svalue))]);

compiler/defcmp.pas

@@ -193,8 +193,8 @@ implementation
       const
         basedeftbl:array[tordtype] of tbasedef =
           (bvoid,
-           bint,bint,bint,bint,
-           bint,bint,bint,bint,
+           bint,bint,bint,bint,bint,
+           bint,bint,bint,bint,bint,
            bbool,bbool,bbool,bbool,
            bbool,bbool,bbool,bbool,
            bchar,bchar,bint);
@@ -990,11 +990,16 @@ implementation
                                       eq:=te_convert_l1;
                                     end
                                   else
-                                   if (subeq>te_incompatible) then
-                                    begin
-                                      doconv:=hct;
-                                      eq:=te_convert_l2;
-                                    end;
+                                    { an array constructor is not an open array, so
+                                      use a lower level of compatibility than that one of
+                                      of the elements }
+                                    if subeq>te_convert_l6 then
+                                     begin
+                                       doconv:=hct;
+                                       eq:=pred(subeq);
+                                     end
+                                   else
+                                     eq:=subeq;
                                 end;
                              end
                             else

compiler/entfile.pas

@@ -0,0 +1,1239 @@
+{
+    Copyright (c) 1998-2013 by Free Pascal development team
+
+    Routines to read/write entry based files (ppu, pcp)
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit entfile;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    systems,globtype,constexp,cstreams;
+
+const
+{ buffer sizes }
+  maxentrysize = 1024;
+  entryfilebufsize   = 16384;
+
+{ppu entries}
+  mainentryid         = 1;
+  subentryid          = 2;
+  {special}
+  iberror             = 0;
+  ibpputable          = 243;
+  ibstartrequireds    = 244;
+  ibendrequireds      = 245;
+  ibstartcontained    = 246;
+  ibendcontained      = 247;
+  ibstartdefs         = 248;
+  ibenddefs           = 249;
+  ibstartsyms         = 250;
+  ibendsyms           = 251;
+  ibendinterface      = 252;
+  ibendimplementation = 253;
+//  ibendbrowser        = 254;
+  ibend               = 255;
+  {general}
+  ibmodulename           = 1;
+  ibsourcefiles          = 2;
+  ibloadunit             = 3;
+  ibinitunit             = 4;
+  iblinkunitofiles       = 5;
+  iblinkunitstaticlibs   = 6;
+  iblinkunitsharedlibs   = 7;
+  iblinkotherofiles      = 8;
+  iblinkotherstaticlibs  = 9;
+  iblinkothersharedlibs  = 10;
+  ibImportSymbols        = 11;
+  ibsymref               = 12;
+  ibdefref               = 13;
+//  ibendsymtablebrowser   = 14;
+//  ibbeginsymtablebrowser = 15;
+{$IFDEF MACRO_DIFF_HINT}
+  ibusedmacros           = 16;
+{$ENDIF}
+  ibderefdata            = 17;
+  ibexportedmacros       = 18;
+  ibderefmap             = 19;
+  {syms}
+  ibtypesym        = 20;
+  ibprocsym        = 21;
+  ibstaticvarsym   = 22;
+  ibconstsym       = 23;
+  ibenumsym        = 24;
+//  ibtypedconstsym  = 25;
+  ibabsolutevarsym = 26;
+  ibpropertysym    = 27;
+  ibfieldvarsym    = 28;
+  ibunitsym        = 29;
+  iblabelsym       = 30;
+  ibsyssym         = 31;
+  ibnamespacesym   = 32;
+  iblocalvarsym    = 33;
+  ibparavarsym     = 34;
+  ibmacrosym       = 35;
+  {definitions}
+  iborddef         = 40;
+  ibpointerdef     = 41;
+  ibarraydef       = 42;
+  ibprocdef        = 43;
+  ibshortstringdef = 44;
+  ibrecorddef      = 45;
+  ibfiledef        = 46;
+  ibformaldef      = 47;
+  ibobjectdef      = 48;
+  ibenumdef        = 49;
+  ibsetdef         = 50;
+  ibprocvardef     = 51;
+  ibfloatdef       = 52;
+  ibclassrefdef    = 53;
+  iblongstringdef  = 54;
+  ibansistringdef  = 55;
+  ibwidestringdef  = 56;
+  ibvariantdef     = 57;
+  ibundefineddef   = 58;
+  ibunicodestringdef = 59;
+  {implementation/ObjData}
+  ibnodetree       = 80;
+  ibasmsymbols     = 81;
+  ibresources      = 82;
+  ibcreatedobjtypes = 83;
+  ibwpofile         = 84;
+  ibmoduleoptions   = 85;
+  ibunitimportsyms  = 86;
+
+  ibmainname       = 90;
+  ibsymtableoptions = 91;
+  ibrecsymtableoptions = 91;
+  ibpackagefiles   = 92;
+  ibpackagename    = 93;
+  { target-specific things }
+  iblinkotherframeworks = 100;
+  ibjvmnamespace = 101;
+
+{$ifdef generic_cpu}
+{ We need to use the correct size of aint and pint for
+  the target CPU }
+const
+  CpuAddrBitSize : array[tsystemcpu] of longint =
+    (
+    {  0 } 32 {'none'},
+    {  1 } 32 {'i386'},
+    {  2 } 32 {'m68k'},
+    {  3 } 32 {'alpha'},
+    {  4 } 32 {'powerpc'},
+    {  5 } 32 {'sparc'},
+    {  6 } 32 {'vis'},
+    {  7 } 64 {'ia64'},
+    {  8 } 64 {'x86_64'},
+    {  9 } 32 {'mipseb'},
+    { 10 } 32 {'arm'},
+    { 11 } 64 {'powerpc64'},
+    { 12 } 16 {'avr'},
+    { 13 } 32 {'mipsel'},
+    { 14 } 32 {'jvm'},
+    { 15 } 16 {'i8086'},
+    { 16 } 64 {'aarch64'}
+    );
+  CpuAluBitSize : array[tsystemcpu] of longint =
+    (
+    {  0 } 32 {'none'},
+    {  1 } 32 {'i386'},
+    {  2 } 32 {'m68k'},
+    {  3 } 32 {'alpha'},
+    {  4 } 32 {'powerpc'},
+    {  5 } 32 {'sparc'},
+    {  6 } 32 {'vis'},
+    {  7 } 64 {'ia64'},
+    {  8 } 64 {'x86_64'},
+    {  9 } 32 {'mipseb'},
+    { 10 } 32 {'arm'},
+    { 11 } 64 {'powerpc64'},
+    { 12 }  8 {'avr'},
+    { 13 } 32 {'mipsel'},
+    { 14 } 64 {'jvm'},
+    { 15 } 16 {'i8086'},
+    { 16 } 64 {'aarch64'}
+    );
+{$endif generic_cpu}
+
+type
+  { bestreal is defined based on the target architecture }
+  entryreal=bestreal;
+
+
+
+  { common part of the header for all kinds of entry files }
+  tentryheader=record
+    id       : array[1..3] of char;
+    ver      : array[1..3] of char;
+    compiler : word;
+    cpu      : word;
+    target   : word;
+    flags    : longint;
+    size     : longint; { size of the ppufile without header }
+  end;
+  pentryheader=^tentryheader;
+
+  tentry=packed record
+    size : longint;
+    id   : byte;
+    nr   : byte;
+  end;
+
+  tentryfile=class
+  private
+    function getposition:longint;
+    procedure setposition(value:longint);
+  protected
+    buf      : pchar;
+    bufstart,
+    bufsize,
+    bufidx   : integer;
+    entrybufstart,
+    entrystart,
+    entryidx : integer;
+    entry    : tentry;
+    closed,
+    tempclosed : boolean;
+    closepos : integer;
+  protected
+    f        : TCStream;
+    mode     : byte; {0 - Closed, 1 - Reading, 2 - Writing}
+    fisfile  : boolean;
+    fname    : string;
+    fsize    : integer;
+    procedure newheader;virtual;abstract;
+    function readheader:longint;virtual;abstract;
+    function outputallowed:boolean;virtual;
+    procedure resetfile;virtual;abstract;
+    function getheadersize:longint;virtual;abstract;
+    function getheaderaddr:pentryheader;virtual;abstract;
+  public
+    entrytyp : byte;
+    size             : integer;
+    change_endian    : boolean; { Used in ppudump util }
+{$ifdef generic_cpu}
+    has_more,
+{$endif not generic_cpu}
+    error         : boolean;
+    constructor create(const fn:string);
+    destructor  destroy;override;
+    function getversion:integer;
+    procedure flush;
+    procedure closefile;virtual;
+    procedure newentry;
+    property position:longint read getposition write setposition;
+    { Warning: don't keep the stream open during a tempclose! }
+    function substream(ofs,len:longint):TCStream;
+    { Warning: don't use the put* or write* functions anymore when writing through this }
+    property stream:TCStream read f;
+  {read}
+    function  openfile:boolean;
+    function  openstream(strm:TCStream):boolean;
+    procedure reloadbuf;
+    procedure readdata(out b;len:integer);
+    procedure skipdata(len:integer);
+    function  readentry:byte;
+    function  EndOfEntry:boolean;
+    function  entrysize:longint;
+    function  entryleft:longint;
+    procedure getdatabuf(out b;len:integer;out res:integer);
+    procedure getdata(out b;len:integer);
+    function  getbyte:byte;
+    function  getword:word;
+    function  getdword:dword;
+    function  getlongint:longint;
+    function getint64:int64;
+    function  getqword:qword;
+    function getaint:{$ifdef generic_cpu}int64{$else}aint{$endif};
+    function getasizeint:{$ifdef generic_cpu}int64{$else}asizeint{$endif};
+    function getaword:{$ifdef generic_cpu}qword{$else}aword{$endif};
+    function  getreal:entryreal;
+    function  getrealsize(sizeofreal : longint):entryreal;
+    function  getstring:string;
+    function  getansistring:ansistring;
+    procedure getnormalset(out b);
+    procedure getsmallset(out b);
+    function  skipuntilentry(untilb:byte):boolean;
+  {write}
+    function  createfile:boolean;virtual;
+    function  createstream(strm:TCStream):boolean;
+    procedure writeheader;virtual;abstract;
+    procedure writebuf;
+    procedure writedata(const b;len:integer);
+    procedure writeentry(ibnr:byte);
+    procedure putdata(const b;len:integer);virtual;
+    procedure putbyte(b:byte);
+    procedure putword(w:word);
+    procedure putdword(w:dword);
+    procedure putlongint(l:longint);
+    procedure putint64(i:int64);
+    procedure putqword(q:qword);
+    procedure putaint(i:aint);
+    procedure putasizeint(i:asizeint);
+    procedure putaword(i:aword);
+    procedure putreal(d:entryreal);
+    procedure putstring(const s:string);
+    procedure putansistring(const s:ansistring);
+    procedure putnormalset(const b);
+    procedure putsmallset(const b);
+    procedure tempclose;        // MG: not used, obsolete?
+    function  tempopen:boolean; // MG: not used, obsolete?
+  end;
+
+implementation
+
+  uses
+    cutils;
+
+
+function swapendian_entryreal(d:entryreal):entryreal;
+type
+  entryreal_bytes=array[0..sizeof(d)-1] of byte;
+var
+  i:0..sizeof(d)-1;
+begin
+  for i:=low(entryreal_bytes) to high(entryreal_bytes) do
+    entryreal_bytes(result)[i]:=entryreal_bytes(d)[high(entryreal_bytes)-i];
+end;
+
+{*****************************************************************************
+                              tentryfile
+*****************************************************************************}
+
+function tentryfile.outputallowed: boolean;
+begin
+  result:=true;
+end;
+
+
+constructor tentryfile.create(const fn:string);
+begin
+  fname:=fn;
+  fisfile:=false;
+  change_endian:=false;
+  mode:=0;
+  newheader;
+  error:=false;
+  closed:=true;
+  tempclosed:=false;
+  getmem(buf,entryfilebufsize);
+end;
+
+
+destructor tentryfile.destroy;
+begin
+  closefile;
+  if assigned(buf) then
+    freemem(buf,entryfilebufsize);
+end;
+
+function tentryfile.getversion:integer;
+  var
+    l    : integer;
+    code : integer;
+    header : pentryheader;
+  begin
+    header:=getheaderaddr;
+    Val(header^.ver[1]+header^.ver[2]+header^.ver[3],l,code);
+    if code=0 then
+     result:=l
+    else
+     result:=0;
+  end;
+
+procedure tentryfile.flush;
+begin
+  if mode=2 then
+   writebuf;
+end;
+
+
+procedure tentryfile.closefile;
+begin
+  if mode<>0 then
+   begin
+     flush;
+     if fisfile then
+       f.Free;
+     mode:=0;
+     closed:=true;
+   end;
+end;
+
+
+procedure tentryfile.setposition(value:longint);
+begin
+  if assigned(f) then
+    f.Position:=value
+  else
+    if tempclosed then
+      closepos:=value;
+end;
+
+
+function tentryfile.getposition:longint;
+begin
+  if assigned(f) then
+    result:=f.Position
+  else
+    if tempclosed then
+      result:=closepos
+    else
+      result:=0;
+end;
+
+
+function tentryfile.substream(ofs,len:longint):TCStream;
+begin
+  result:=nil;
+  if assigned(f) then
+    result:=TCRangeStream.Create(f,ofs,len);
+end;
+
+
+{*****************************************************************************
+                              tentryfile Reading
+*****************************************************************************}
+
+function tentryfile.openfile:boolean;
+var
+  strm : TCStream;
+begin
+  openfile:=false;
+  try
+    strm:=CFileStreamClass.Create(fname,fmOpenRead)
+  except
+    exit;
+  end;
+  openfile:=openstream(strm);
+  fisfile:=result;
+end;
+
+
+function tentryfile.openstream(strm:TCStream):boolean;
+var
+  i : longint;
+begin
+  openstream:=false;
+  f:=strm;
+  closed:=false;
+{read ppuheader}
+  fsize:=f.Size;
+  i:=readheader;
+  if i<0 then
+    exit;
+{reset buffer}
+  bufstart:=i;
+  bufsize:=0;
+  bufidx:=0;
+  mode:=1;
+  FillChar(entry,sizeof(tentry),0);
+  entryidx:=0;
+  entrystart:=0;
+  entrybufstart:=0;
+  error:=false;
+  openstream:=true;
+end;
+
+
+procedure tentryfile.reloadbuf;
+begin
+  inc(bufstart,bufsize);
+  bufsize:=f.Read(buf^,entryfilebufsize);
+  bufidx:=0;
+end;
+
+
+procedure tentryfile.readdata(out b;len:integer);
+var
+  p,pbuf : pchar;
+  left : integer;
+begin
+  p:=pchar(@b);
+  pbuf:=@buf[bufidx];
+  repeat
+    left:=bufsize-bufidx;
+    if len<left then
+      break;
+    move(pbuf^,p^,left);
+    dec(len,left);
+    inc(p,left);
+    reloadbuf;
+    pbuf:=@buf[bufidx];
+    if bufsize=0 then
+      exit;
+  until false;
+  move(pbuf^,p^,len);
+  inc(bufidx,len);
+end;
+
+
+procedure tentryfile.skipdata(len:integer);
+var
+  left : integer;
+begin
+  while len>0 do
+   begin
+     left:=bufsize-bufidx;
+     if len>left then
+      begin
+        dec(len,left);
+        reloadbuf;
+        if bufsize=0 then
+         exit;
+      end
+     else
+      begin
+        inc(bufidx,len);
+        exit;
+      end;
+   end;
+end;
+
+
+function tentryfile.readentry:byte;
+begin
+  if entryidx<entry.size then
+    begin
+{$ifdef generic_cpu}
+     has_more:=true;
+{$endif not generic_cpu}
+     skipdata(entry.size-entryidx);
+    end;
+  readdata(entry,sizeof(tentry));
+  if change_endian then
+    entry.size:=swapendian(entry.size);
+  entrystart:=bufstart+bufidx;
+  entryidx:=0;
+{$ifdef generic_cpu}
+  has_more:=false;
+{$endif not generic_cpu}
+  if not(entry.id in [mainentryid,subentryid]) then
+   begin
+     readentry:=iberror;
+     error:=true;
+     exit;
+   end;
+  readentry:=entry.nr;
+end;
+
+
+function tentryfile.endofentry:boolean;
+begin
+{$ifdef generic_cpu}
+  endofentry:=(entryidx=entry.size);
+{$else not generic_cpu}
+  endofentry:=(entryidx>=entry.size);
+{$endif not generic_cpu}
+end;
+
+
+function tentryfile.entrysize:longint;
+begin
+  entrysize:=entry.size;
+end;
+
+function tentryfile.entryleft:longint;
+begin
+  entryleft:=entry.size-entryidx;
+end;
+
+
+procedure tentryfile.getdatabuf(out b;len:integer;out res:integer);
+begin
+  if entryidx+len>entry.size then
+   res:=entry.size-entryidx
+  else
+   res:=len;
+  readdata(b,res);
+  inc(entryidx,res);
+end;
+
+
+procedure tentryfile.getdata(out b;len:integer);
+begin
+  if entryidx+len>entry.size then
+   begin
+     error:=true;
+     exit;
+   end;
+  readdata(b,len);
+  inc(entryidx,len);
+end;
+
+
+function tentryfile.getbyte:byte;
+begin
+  if entryidx+1>entry.size then
+   begin
+     error:=true;
+     result:=0;
+     exit;
+   end;
+  if bufsize-bufidx>=1 then
+    begin
+      result:=pbyte(@buf[bufidx])^;
+      inc(bufidx);
+    end
+  else
+    readdata(result,1);
+  inc(entryidx);
+end;
+
+
+function tentryfile.getword:word;
+begin
+  if entryidx+2>entry.size then
+   begin
+     error:=true;
+     result:=0;
+     exit;
+   end;
+  if bufsize-bufidx>=sizeof(word) then
+    begin
+      result:=Unaligned(pword(@buf[bufidx])^);
+      inc(bufidx,sizeof(word));
+    end
+  else
+    readdata(result,sizeof(word));
+  if change_endian then
+   result:=swapendian(result);
+  inc(entryidx,2);
+end;
+
+
+function tentryfile.getlongint:longint;
+begin
+  if entryidx+4>entry.size then
+   begin
+     error:=true;
+     result:=0;
+     exit;
+   end;
+  if bufsize-bufidx>=sizeof(longint) then
+    begin
+      result:=Unaligned(plongint(@buf[bufidx])^);
+      inc(bufidx,sizeof(longint));
+    end
+  else
+    readdata(result,sizeof(longint));
+  if change_endian then
+   result:=swapendian(result);
+  inc(entryidx,4);
+end;
+
+
+function tentryfile.getdword:dword;
+begin
+  if entryidx+4>entry.size then
+   begin
+     error:=true;
+     result:=0;
+     exit;
+   end;
+  if bufsize-bufidx>=sizeof(dword) then
+    begin
+      result:=Unaligned(plongint(@buf[bufidx])^);
+      inc(bufidx,sizeof(longint));
+    end
+  else
+    readdata(result,sizeof(dword));
+  if change_endian then
+   result:=swapendian(result);
+  inc(entryidx,4);
+end;
+
+
+function tentryfile.getint64:int64;
+begin
+  if entryidx+8>entry.size then
+   begin
+     error:=true;
+     result:=0;
+     exit;
+   end;
+  if bufsize-bufidx>=sizeof(int64) then
+    begin
+      result:=Unaligned(pint64(@buf[bufidx])^);
+      inc(bufidx,sizeof(int64));
+    end
+  else
+    readdata(result,sizeof(int64));
+  if change_endian then
+   result:=swapendian(result);
+  inc(entryidx,8);
+end;
+
+
+function tentryfile.getqword:qword;
+begin
+  if entryidx+8>entry.size then
+   begin
+     error:=true;
+     result:=0;
+     exit;
+   end;
+  if bufsize-bufidx>=sizeof(qword) then
+    begin
+      result:=Unaligned(pqword(@buf[bufidx])^);
+      inc(bufidx,sizeof(qword));
+    end
+  else
+    readdata(result,sizeof(qword));
+  if change_endian then
+   result:=swapendian(result);
+  inc(entryidx,8);
+end;
+
+
+function tentryfile.getaint:{$ifdef generic_cpu}int64{$else}aint{$endif};
+{$ifdef generic_cpu}
+var
+  header : pentryheader;
+{$endif generic_cpu}
+begin
+{$ifdef generic_cpu}
+  header:=getheaderaddr;
+  if CpuAluBitSize[tsystemcpu(header^.cpu)]=64 then
+    result:=getint64
+  else if CpuAluBitSize[tsystemcpu(header^.cpu)]=32 then
+    result:=getlongint
+  else if CpuAluBitSize[tsystemcpu(header^.cpu)]=16 then
+    result:=smallint(getword)
+  else if CpuAluBitSize[tsystemcpu(header^.cpu)]=8 then
+    result:=shortint(getbyte)
+  else
+    begin
+      error:=true;
+      result:=0;
+    end;
+{$else not generic_cpu}
+  result:=4;
+  case sizeof(aint) of
+    8: result:=getint64;
+    4: result:=getlongint;
+    2: result:=smallint(getword);
+    1: result:=shortint(getbyte);
+  end;
+{$endif not generic_cpu}
+end;
+
+
+function tentryfile.getasizeint:{$ifdef generic_cpu}int64{$else}asizeint{$endif};
+{$ifdef generic_cpu}
+var
+  header : pentryheader;
+{$endif generic_cpu}
+begin
+{$ifdef generic_cpu}
+  header:=getheaderaddr;
+  if CpuAddrBitSize[tsystemcpu(header^.cpu)]=64 then
+    result:=getint64
+  else if CpuAddrBitSize[tsystemcpu(header^.cpu)]=32 then
+    result:=getlongint
+  else if CpuAddrBitSize[tsystemcpu(header^.cpu)]=16 then
+    result:=smallint(getword)
+  else
+    begin
+      error:=true;
+      result:=0;
+    end;
+{$else not generic_cpu}
+  case sizeof(asizeint) of
+    8: result:=asizeint(getint64);
+    4: result:=asizeint(getlongint);
+    2: result:=asizeint(getword);
+    1: result:=asizeint(getbyte);
+    else
+      result:=0;
+end;
+{$endif not generic_cpu}
+end;
+
+
+function tentryfile.getaword:{$ifdef generic_cpu}qword{$else}aword{$endif};
+{$ifdef generic_cpu}
+var
+header : pentryheader;
+{$endif generic_cpu}
+begin
+{$ifdef generic_cpu}
+  header:=getheaderaddr;
+  if CpuAluBitSize[tsystemcpu(header^.cpu)]=64 then
+    result:=getqword
+  else if CpuAluBitSize[tsystemcpu(header^.cpu)]=32 then
+    result:=getdword
+  else if CpuAluBitSize[tsystemcpu(header^.cpu)]=16 then
+    result:=getword
+  else if CpuAluBitSize[tsystemcpu(header^.cpu)]=8 then
+    result:=getbyte
+  else
+    begin
+      error:=true;
+      result:=0;
+    end;
+{$else not generic_cpu}
+  result:=4;
+  case sizeof(aword) of
+    8: result:=getqword;
+    4: result:=getdword;
+    2: result:=getword;
+    1: result:=getbyte;
+  end;
+{$endif not generic_cpu}
+end;
+
+function tentryfile.getrealsize(sizeofreal : longint):entryreal;
+var
+  e : entryreal;
+  d : double;
+  s : single;
+begin
+  if sizeofreal=sizeof(e) then
+    begin
+      if entryidx+sizeof(e)>entry.size then
+       begin
+         error:=true;
+         result:=0;
+         exit;
+       end;
+      readdata(e,sizeof(e));
+      if change_endian then
+        result:=swapendian_entryreal(e)
+      else
+        result:=e;
+      inc(entryidx,sizeof(e));
+      exit;
+    end;
+  if sizeofreal=sizeof(d) then
+    begin
+      if entryidx+sizeof(d)>entry.size then
+       begin
+         error:=true;
+         result:=0;
+         exit;
+       end;
+      readdata(d,sizeof(d));
+      if change_endian then
+        result:=swapendian(pqword(@d)^)
+      else
+        result:=d;
+      inc(entryidx,sizeof(d));
+      result:=d;
+      exit;
+    end;
+  if sizeofreal=sizeof(s) then
+    begin
+      if entryidx+sizeof(s)>entry.size then
+       begin
+         error:=true;
+         result:=0;
+         exit;
+       end;
+      readdata(s,sizeof(s));
+      if change_endian then
+        result:=swapendian(pdword(@s)^)
+      else
+        result:=s;
+      inc(entryidx,sizeof(s));
+      result:=s;
+      exit;
+    end;
+  error:=true;
+  result:=0.0;
+end;
+
+
+function tentryfile.getreal:entryreal;
+var
+  d : entryreal;
+  hd : double;
+begin
+  if target_info.system=system_x86_64_win64 then
+    begin
+      hd:=getrealsize(sizeof(hd));
+      getreal:=hd;
+    end
+  else
+    begin
+      d:=getrealsize(sizeof(d));
+      getreal:=d;
+    end;
+end;
+
+
+function tentryfile.getstring:string;
+begin
+  result[0]:=chr(getbyte);
+  if entryidx+length(result)>entry.size then
+   begin
+     error:=true;
+     exit;
+   end;
+  ReadData(result[1],length(result));
+  inc(entryidx,length(result));
+end;
+
+
+function tentryfile.getansistring:ansistring;
+var
+  len: longint;
+begin
+  len:=getlongint;
+  if entryidx+len>entry.size then
+   begin
+     error:=true;
+     result:='';
+     exit;
+   end;
+  setlength(result,len);
+  if len>0 then
+    getdata(result[1],len);
+end;
+
+
+procedure tentryfile.getsmallset(out b);
+var
+  i : longint;
+begin
+  getdata(b,4);
+  if change_endian then
+    for i:=0 to 3 do
+      Pbyte(@b)[i]:=reverse_byte(Pbyte(@b)[i]);
+end;
+
+
+procedure tentryfile.getnormalset(out b);
+var
+  i : longint;
+begin
+  getdata(b,32);
+  if change_endian then
+    for i:=0 to 31 do
+      Pbyte(@b)[i]:=reverse_byte(Pbyte(@b)[i]);
+end;
+
+
+function tentryfile.skipuntilentry(untilb:byte):boolean;
+var
+  b : byte;
+begin
+  repeat
+    b:=readentry;
+  until (b in [ibend,iberror]) or ((b=untilb) and (entry.id=mainentryid));
+  skipuntilentry:=(b=untilb);
+end;
+
+
+{*****************************************************************************
+                              tentryfile Writing
+*****************************************************************************}
+
+function tentryfile.createfile:boolean;
+var
+  ok: boolean;
+  strm : TCStream;
+begin
+  createfile:=false;
+  strm:=nil;
+  if outputallowed then
+    begin
+      {$ifdef MACOS}
+      {FPas is FreePascal's creator code on MacOS. See systems/mac_crea.txt}
+      SetDefaultMacOSCreator('FPas');
+      SetDefaultMacOSFiletype('FPPU');
+      {$endif}
+      ok:=false;
+      try
+        strm:=CFileStreamClass.Create(fname,fmCreate);
+        ok:=true;
+      except
+      end;
+      {$ifdef MACOS}
+      SetDefaultMacOSCreator('MPS ');
+      SetDefaultMacOSFiletype('TEXT');
+      {$endif}
+      if not ok then
+       exit;
+    end;
+  createfile:=createstream(strm);
+  fisfile:=result;
+end;
+
+function tentryfile.createstream(strm:TCStream):boolean;
+begin
+  createstream:=false;
+  if outputallowed then
+    begin
+      f:=strm;
+      mode:=2;
+      {write header for sure}
+      f.Write(getheaderaddr^,getheadersize);
+    end;
+  bufsize:=entryfilebufsize;
+  bufstart:=getheadersize;
+  bufidx:=0;
+{reset}
+  resetfile;
+  error:=false;
+  size:=0;
+  entrytyp:=mainentryid;
+{start}
+  newentry;
+  createstream:=true;
+end;
+
+
+procedure tentryfile.writebuf;
+begin
+  if outputallowed and
+     (bufidx <> 0) then
+    f.Write(buf^,bufidx);
+  inc(bufstart,bufidx);
+  bufidx:=0;
+end;
+
+
+procedure tentryfile.writedata(const b;len:integer);
+var
+  p   : pchar;
+  left,
+  idx : integer;
+begin
+  if not outputallowed then
+    exit;
+  p:=pchar(@b);
+  idx:=0;
+  while len>0 do
+   begin
+     left:=bufsize-bufidx;
+     if len>left then
+      begin
+        move(p[idx],buf[bufidx],left);
+        dec(len,left);
+        inc(idx,left);
+        inc(bufidx,left);
+        writebuf;
+      end
+     else
+      begin
+        move(p[idx],buf[bufidx],len);
+        inc(bufidx,len);
+        exit;
+      end;
+   end;
+end;
+
+
+procedure tentryfile.newentry;
+begin
+  with entry do
+   begin
+     id:=entrytyp;
+     nr:=ibend;
+     size:=0;
+   end;
+{Reset Entry State}
+  entryidx:=0;
+  entrybufstart:=bufstart;
+  entrystart:=bufstart+bufidx;
+{Alloc in buffer}
+  writedata(entry,sizeof(tentry));
+end;
+
+
+procedure tentryfile.writeentry(ibnr:byte);
+var
+  opos : integer;
+begin
+{create entry}
+  entry.id:=entrytyp;
+  entry.nr:=ibnr;
+  entry.size:=entryidx;
+{it's already been sent to disk ?}
+  if entrybufstart<>bufstart then
+   begin
+    if outputallowed then
+      begin
+      {flush to be sure}
+        WriteBuf;
+      {write entry}
+        opos:=f.Position;
+        f.Position:=entrystart;
+        f.write(entry,sizeof(tentry));
+        f.Position:=opos;
+      end;
+     entrybufstart:=bufstart;
+   end
+  else
+   move(entry,buf[entrystart-bufstart],sizeof(entry));
+{Add New Entry, which is ibend by default}
+  entrystart:=bufstart+bufidx; {next entry position}
+  newentry;
+end;
+
+
+procedure tentryfile.putdata(const b;len:integer);
+begin
+  if outputallowed then
+    writedata(b,len);
+  inc(entryidx,len);
+end;
+
+
+procedure tentryfile.putbyte(b:byte);
+begin
+  putdata(b,1);
+end;
+
+
+procedure tentryfile.putword(w:word);
+begin
+  putdata(w,2);
+end;
+
+
+procedure tentryfile.putdword(w:dword);
+begin
+  putdata(w,4);
+end;
+
+
+procedure tentryfile.putlongint(l:longint);
+begin
+  putdata(l,4);
+end;
+
+
+procedure tentryfile.putint64(i:int64);
+begin
+  putdata(i,8);
+end;
+
+
+procedure tentryfile.putqword(q:qword);
+begin
+  putdata(q,sizeof(qword));
+end;
+
+
+procedure tentryfile.putaint(i:aint);
+begin
+  putdata(i,sizeof(aint));
+end;
+
+
+procedure tentryfile.putasizeint(i: asizeint);
+begin
+  putdata(i,sizeof(asizeint));
+end;
+
+
+procedure tentryfile.putaword(i:aword);
+begin
+  putdata(i,sizeof(aword));
+end;
+
+
+procedure tentryfile.putreal(d:entryreal);
+var
+  hd : double;
+begin
+  if target_info.system=system_x86_64_win64 then
+    begin
+      hd:=d;
+      putdata(hd,sizeof(hd));
+    end
+  else
+    putdata(d,sizeof(entryreal));
+end;
+
+
+procedure tentryfile.putstring(const s:string);
+  begin
+    putdata(s,length(s)+1);
+  end;
+
+
+procedure tentryfile.putansistring(const s:ansistring);
+  var
+    len: longint;
+  begin
+    len:=length(s);
+    putlongint(len);
+    if len>0 then
+      putdata(s[1],len);
+  end;
+
+
+procedure tentryfile.putsmallset(const b);
+  var
+    l : longint;
+  begin
+    l:=longint(b);
+    putlongint(l);
+  end;
+
+
+procedure tentryfile.putnormalset(const b);
+  begin
+    putdata(b,32);
+  end;
+
+
+procedure tentryfile.tempclose;
+  begin
+    if not closed then
+     begin
+       closepos:=f.Position;
+       f.Free;
+       f:=nil;
+       closed:=true;
+       tempclosed:=true;
+     end;
+  end;
+
+
+function tentryfile.tempopen:boolean;
+  begin
+    tempopen:=false;
+    if not closed or not tempclosed then
+     exit;
+   { MG: not sure, if this is correct
+     f.position:=0;
+       No, f was freed in tempclose above, we need to
+       recreate it.  PM 2011/06/06 }
+    try
+      f:=CFileStreamClass.Create(fname,fmOpenRead);
+    except
+      exit;
+    end;
+    closed:=false;
+    tempclosed:=false;
+
+  { restore state }
+    f.Position:=closepos;
+    tempopen:=true;
+  end;
+
+end.

compiler/export.pas

@@ -31,18 +31,21 @@ uses
   symtype,symdef,symsym,
   aasmbase,aasmdata;
 
-const
+type
    { export options }
-   eo_resident = $1;
-   eo_index    = $2;
-   eo_name     = $4;
+   texportoption=(eo_none,
+     eo_resident,
+     eo_index,
+     eo_name,
+     eo_no_sym_name { don't try to use another mangled name if symbol is known }
+   );
+   texportoptions=set of texportoption;
 
-type
    texported_item = class(TLinkedListItem)
       sym : tsym;
       index : longint;
       name : pshortstring;
-      options : word;
+      options : texportoptions;
       is_var : boolean;
       constructor create;
       destructor destroy;override;
@@ -51,9 +54,12 @@ type
    texportlib=class
    private
       notsupmsg : boolean;
+      fignoreduplicates : boolean;
       finitname,
       ffininame  : string;
       procedure NotSupported;
+   protected
+      procedure duplicatesymbol(const s:string);
    public
       constructor Create;virtual;
       destructor Destroy;override;
@@ -66,19 +72,20 @@ type
       
       property initname: string read finitname;
       property fininame: string read ffininame;
+      property ignoreduplicates : boolean read fignoreduplicates write fignoreduplicates;
    end;
 
    TExportLibClass=class of TExportLib;
 
 
-  procedure exportprocsym(sym: tsym; const s : string; index: longint; options: word);
-  procedure exportvarsym(sym: tsym; const s : string; index: longint; options: word);
+  procedure exportprocsym(sym: tsym; const s : string; index: longint; options: texportoptions);
+  procedure exportvarsym(sym: tsym; const s : string; index: longint; options: texportoptions);
   { to export symbols not directly related to a tsym (e.g., the Objective-C
     rtti) }
-  procedure exportname(const s : string; options: word);
+  procedure exportname(const s : string; options: texportoptions);
 
-  procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: word);
-  procedure exportallprocsymnames(ps: tprocsym; options: word);
+  procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: texportoptions);
+  procedure exportallprocsymnames(ps: tprocsym; options: texportoptions);
 
 
 var
@@ -98,20 +105,20 @@ uses
                            TExported_procedure
 ****************************************************************************}
 
-procedure exportprocsym(sym: tsym; const s : string; index: longint; options: word);
+procedure exportprocsym(sym: tsym; const s : string; index: longint; options: texportoptions);
   var
     hp : texported_item;
   begin
     hp:=texported_item.create;
     hp.name:=stringdup(s);
     hp.sym:=sym;
-    hp.options:=options or eo_name;
+    hp.options:=options+[eo_name];
     hp.index:=index;
     exportlib.exportprocedure(hp);
   end;
 
 
-procedure exportvarsym(sym: tsym; const s : string; index: longint; options: word);
+procedure exportvarsym(sym: tsym; const s : string; index: longint; options: texportoptions);
   var
     hp : texported_item;
   begin
@@ -119,19 +126,19 @@ procedure exportvarsym(sym: tsym; const s : string; index: longint; options: wor
     hp.name:=stringdup(s);
     hp.sym:=sym;
     hp.is_var:=true;
-    hp.options:=options or eo_name;
+    hp.options:=options+[eo_name];
     hp.index:=index;
     exportlib.exportvar(hp);
   end;
 
 
-procedure exportname(const s : string; options: word);
+procedure exportname(const s : string; options: texportoptions);
   begin
     exportvarsym(nil,s,0,options);
   end;
 
 
-  procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: word);
+  procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: texportoptions);
     var
       item: TCmdStrListItem;
     begin
@@ -148,7 +155,7 @@ procedure exportname(const s : string; options: word);
     end;
     
 
-  procedure exportallprocsymnames(ps: tprocsym; options: word);
+  procedure exportallprocsymnames(ps: tprocsym; options: texportoptions);
     var
       i: longint;
     begin
@@ -167,7 +174,7 @@ begin
   sym:=nil;
   index:=-1;
   name:=nil;
-  options:=0;
+  options:=[];
   is_var:=false;
 end;
 
@@ -186,6 +193,7 @@ end;
 constructor texportlib.Create;
 begin
   notsupmsg:=false;
+  fignoreduplicates:=false;
 end;
 
 
@@ -205,6 +213,15 @@ begin
 end;
 
 
+procedure texportlib.duplicatesymbol(const s: string);
+begin
+  { only generate an error if the caller is not aware that it could generate
+    duplicates (e.g. exporting from a package) }
+  if not ignoreduplicates then
+    Message1(parser_e_export_name_double,s);
+end;
+
+
 procedure texportlib.preparelib(const s:string);
 begin
   NotSupported;

compiler/expunix.pas

@@ -88,7 +88,7 @@ var
   hp2 : texported_item;
 begin
   { first test the index value }
-  if (hp.options and eo_index)<>0 then
+  if eo_index in hp.options then
    begin
      Message1(parser_e_no_export_with_index_for_target,target_info.shortname);
      exit;
@@ -102,7 +102,7 @@ begin
   if assigned(hp2) and (hp2.name^=hp.name^) then
     begin
       { this is not allowed !! }
-      Message1(parser_e_export_name_double,hp.name^);
+      duplicatesymbol(hp.name^);
       exit;
     end;
   if hp2=texported_item(current_module._exports.first) then
@@ -131,23 +131,36 @@ procedure texportlibunix.generatelib;  // straight t_linux copy for now.
 var
   hp2 : texported_item;
   pd  : tprocdef;
+  anyhasalias : boolean;
+  i : longint;
 {$ifdef x86}
   sym : tasmsymbol;
   r : treference;
 {$endif x86}
 begin
+  pd:=nil;
   create_hlcodegen;
   new_section(current_asmdata.asmlists[al_procedures],sec_code,'',0);
   hp2:=texported_item(current_module._exports.first);
   while assigned(hp2) do
    begin
      if (not hp2.is_var) and
+        assigned(hp2.sym) and
         (hp2.sym.typ=procsym) then
       begin
         { the manglednames can already be the same when the procedure
           is declared with cdecl }
-        pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]);
-        if not has_alias_name(pd,hp2.name^) then
+        { note: for "exports" sections we only allow non overloaded procsyms,
+                so checking all symbols only matters for packages }
+        anyhasalias:=false;
+        for i:=0 to tprocsym(hp2.sym).procdeflist.count-1 do
+          begin
+            pd:=tprocdef(tprocsym(hp2.sym).procdeflist[i]);
+            anyhasalias:=has_alias_name(pd,hp2.name^);
+            if anyhasalias then
+              break;
+          end;
+        if not anyhasalias then
          begin
            { place jump in al_procedures }
            current_asmdata.asmlists[al_procedures].concat(tai_align.create(target_info.alignment.procalign));

compiler/fmodule.pas

@@ -43,7 +43,7 @@ interface
 
     uses
        cutils,cclasses,cfileutl,
-       globtype,finput,ogbase,
+       globtype,finput,ogbase,fpkg,
        symbase,symconst,symsym,
        wpobase,
        aasmbase,aasmtai,aasmdata;
@@ -158,6 +158,7 @@ interface
         procinfo      : TObject;  { current procedure being compiled }
         asmdata       : TObject;  { Assembler data }
         asmprefix     : pshortstring;  { prefix for the smartlink asmfiles }
+        unitimportsyms : tfpobjectlist; { list of symbols that are imported from other units }
         debuginfo     : TObject;
         loaded_from   : tmodule;
         _exports      : tlinkedlist;
@@ -171,6 +172,7 @@ interface
         linkotherstaticlibs,
         linkotherframeworks  : tlinkcontainer;
         mainname      : pshortstring; { alternate name for "main" procedure }
+        package       : tpackage;
 
         used_units           : tlinkedlist;
         dependent_units      : tlinkedlist;
@@ -223,6 +225,7 @@ interface
         procedure reset;virtual;
         procedure adddependency(callermodule:tmodule);
         procedure flagdependent(callermodule:tmodule);
+        procedure addimportedsym(sym:TSymEntry);
         function  addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
         procedure updatemaps;
         function  derefidx_unit(id:longint):longint;
@@ -610,6 +613,7 @@ implementation
         _exports:=TLinkedList.Create;
         dllscannerinputlist:=TFPHashList.Create;
         asmdata:=casmdata.create(modulename);
+        unitimportsyms:=TFPObjectList.Create(false);
         InitDebugInfo(self,false);
       end;
 
@@ -669,6 +673,7 @@ implementation
         linkothersharedlibs.Free;
         linkotherframeworks.Free;
         stringdispose(mainname);
+        unitimportsyms.Free;
         FImportLibraryList.Free;
         extendeddefs.Free;
         genericdummysyms.free;
@@ -886,6 +891,12 @@ implementation
       end;
 
 
+    procedure tmodule.addimportedsym(sym:TSymEntry);
+      begin
+        if unitimportsyms.IndexOf(sym)<0 then
+          unitimportsyms.Add(sym);
+      end;
+
     function tmodule.addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
       var
         pu : tused_unit;

compiler/fpcdefs.inc

@@ -51,6 +51,7 @@
   {$define cpumm}
   {$define fewintregisters}
   {//$define cpurox}
+  {$define cpurefshaveindexreg}
   {$define SUPPORT_SAFECALL}
   {$define cpuneedsmulhelper}
   { TODO: add another define in order to disable the div helper for 16-bit divs? }
@@ -70,6 +71,7 @@
   {$define cpumm}
   {$define fewintregisters}
   {$define cpurox}
+  {$define cpurefshaveindexreg}
   {$define SUPPORT_SAFECALL}
   {$define SUPPORT_GET_FRAME}
   {$define cpucapabilities}

compiler/fpcp.pas

@@ -0,0 +1,570 @@
+{
+    Copyright (c) 2013-2016 by Free Pascal development team
+
+    This unit implements the loading and searching of package files
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit fpcp;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    cclasses,cstreams,
+    globtype,
+    pcp,finput,fpkg;
+
+  type
+    tpcppackage=class(tpackage)
+    private
+      loaded : boolean;
+      pcpfile : tpcpfile;
+    private
+      function openpcp:boolean;
+      function search_package(ashortname:boolean):boolean;
+      function search_package_file:boolean;
+      procedure setfilename(const fn:string;allowoutput:boolean);
+      procedure writecontainernames;
+      procedure writecontainedunits;
+      procedure writerequiredpackages;
+      procedure writepputable;
+      procedure writeppudata;
+      procedure readcontainernames;
+      procedure readcontainedunits;
+      procedure readrequiredpackages;
+      procedure readpputable;
+    public
+      constructor create(const pn:string);
+      destructor destroy; override;
+      procedure loadpcp;
+      procedure savepcp;
+      function getmodulestream(module:tmodulebase):tcstream;
+      procedure initmoduleinfo(module:tmodulebase);
+      procedure addunit(module:tmodulebase);
+      procedure add_required_package(pkg:tpackage);
+    end;
+
+implementation
+
+  uses
+    sysutils,
+    cfileutl,cutils,
+    systems,globals,version,
+    verbose,
+    entfile,fppu,ppu,pkgutil;
+
+{ tpcppackage }
+
+  function tpcppackage.openpcp: boolean;
+    var
+      pcpfiletime : longint;
+    begin
+      result:=false;
+      Message1(package_t_pcp_loading,pcpfilename);
+      { Get pcpfile time (also check if the file exists) }
+      pcpfiletime:=getnamedfiletime(pcpfilename);
+      if pcpfiletime=-1 then
+       exit;
+    { Open the pcpfile }
+      Message1(package_u_pcp_name,pcpfilename);
+      pcpfile:=tpcpfile.create(pcpfilename);
+      if not pcpfile.openfile then
+       begin
+         pcpfile.free;
+         pcpfile:=nil;
+         Message(package_u_pcp_file_too_short);
+         exit;
+       end;
+    { check for a valid PPU file }
+      if not pcpfile.checkpcpid then
+       begin
+         pcpfile.free;
+         pcpfile:=nil;
+         Message(package_u_pcp_invalid_header);
+         exit;
+       end;
+    { check for allowed PCP versions }
+      if not (pcpfile.getversion=CurrentPCPVersion) then
+       begin
+         Message1(package_u_pcp_invalid_version,tostr(pcpfile.getversion));
+         pcpfile.free;
+         pcpfile:=nil;
+         exit;
+       end;
+    { check the target processor }
+      if tsystemcpu(pcpfile.header.common.cpu)<>target_cpu then
+       begin
+         pcpfile.free;
+         pcpfile:=nil;
+         Message(package_u_pcp_invalid_processor);
+         exit;
+       end;
+    { check target }
+      if tsystem(pcpfile.header.common.target)<>target_info.system then
+       begin
+         pcpfile.free;
+         pcpfile:=nil;
+         Message(package_u_pcp_invalid_target);
+         exit;
+       end;
+  {$ifdef cpufpemu}
+     { check if floating point emulation is on?
+       fpu emulation isn't unit levelwise because it affects calling convention }
+     if ((pcpfile.header.common.flags and uf_fpu_emulation)<>0) xor
+          (cs_fp_emulation in current_settings.moduleswitches) then
+       begin
+         pcpfile.free;
+         pcpfile:=nil;
+         Message(package_u_pcp_invalid_fpumode);
+         exit;
+       end;
+  {$endif cpufpemu}
+
+    { Load values to be access easier }
+      //flags:=pcpfile.header.common.flags;
+      //crc:=pcpfile.header.checksum;
+    { Show Debug info }
+      Message1(package_u_pcp_time,filetimestring(pcpfiletime));
+      Message1(package_u_pcp_flags,tostr(pcpfile.header.common.flags{flags}));
+      Message1(package_u_pcp_crc,hexstr(pcpfile.header.checksum,8));
+      (*Message1(package_u_pcp_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
+      Message1(package_u_pcp_crc,hexstr(ppufile.header.indirect_checksum,8)+' (indc)');
+      Comment(V_used,'Number of definitions: '+tostr(ppufile.header.deflistsize));
+      Comment(V_used,'Number of symbols: '+tostr(ppufile.header.symlistsize));
+      do_compile:=false;*)
+      result:=true;
+    end;
+
+  function tpcppackage.search_package(ashortname:boolean):boolean;
+    var
+      singlepathstring,
+      filename : TCmdStr;
+
+    function package_exists(const ext:string;var foundfile:TCmdStr):boolean;
+      begin
+        if CheckVerbosity(V_Tried) then
+          Message1(package_t_packagesearch,Singlepathstring+filename+ext);
+        result:=FindFile(filename+ext,singlepathstring,true,foundfile);
+      end;
+
+    function package_search_path(const s:TCmdStr):boolean;
+      var
+        found : boolean;
+        hs    : TCmdStr;
+      begin
+        found:=false;
+        singlepathstring:=FixPath(s,false);
+        { Check for package file }
+        { TODO }
+        found:=package_exists({target_info.pkginfoext}'.pcp',hs);
+        if found then
+          begin
+            setfilename(hs,false);
+            found:=openpcp;
+          end;
+        result:=found;
+      end;
+
+    function search_path_list(list:TSearchPathList):boolean;
+      var
+        hp : TCmdStrListItem;
+        found : boolean;
+      begin
+        found:=false;
+        hp:=TCmdStrListItem(list.First);
+        while assigned(hp) do
+         begin
+           found:=package_search_path(hp.Str);
+           if found then
+            break;
+           hp:=TCmdStrListItem(hp.next);
+         end;
+        result:=found;
+      end;
+
+    begin
+      filename:=packagename^;
+      result:=search_path_list(packagesearchpath);
+    end;
+
+  function tpcppackage.search_package_file: boolean;
+    var
+      found : boolean;
+    begin
+      found:=false;
+      if search_package(false) then
+        found:=true;
+      if not found and
+          (length(packagename^)>8) and
+         search_package(true) then
+        found:=true;
+      result:=found;
+    end;
+
+  procedure tpcppackage.setfilename(const fn:string;allowoutput:boolean);
+    var
+      p,n : tpathstr;
+    begin
+      p:=FixPath(ExtractFilePath(fn),false);
+      n:=FixFileName(ChangeFileExt(ExtractFileName(fn),''));
+      { pcp name }
+      if allowoutput then
+        if (OutputUnitDir<>'') then
+          p:=OutputUnitDir
+        else
+          if (OutputExeDir<>'') then
+            p:=OutputExeDir;
+      pcpfilename:=p+n+{target_info.pkginfoext}'.pcp';
+    end;
+
+  procedure tpcppackage.writecontainernames;
+    begin
+      pcpfile.putstring(pplfilename);
+      //pcpfile.putstring(ppafilename);
+      pcpfile.writeentry(ibpackagefiles);
+    end;
+
+  procedure tpcppackage.writecontainedunits;
+    var
+      p : pcontainedunit;
+      i : longint;
+    begin
+      pcpfile.putlongint(containedmodules.count);
+      pcpfile.writeentry(ibstartcontained);
+      { for now we write the unit name and the ppu file name }
+      for i:=0 to containedmodules.count-1 do
+        begin
+          p:=pcontainedunit(containedmodules.items[i]);
+          pcpfile.putstring(p^.module.modulename^);
+          pcpfile.putstring(p^.ppufile);
+        end;
+      pcpfile.writeentry(ibendcontained);
+    end;
+
+  procedure tpcppackage.writerequiredpackages;
+    var
+      i : longint;
+    begin
+      pcpfile.putlongint(requiredpackages.count);
+      pcpfile.writeentry(ibstartrequireds);
+      for i:=0 to requiredpackages.count-1 do
+        begin
+          pcpfile.putstring(requiredpackages.NameOfIndex(i));
+        end;
+      pcpfile.writeentry(ibendrequireds);
+    end;
+
+  procedure tpcppackage.writepputable;
+    var
+      module : pcontainedunit;
+      i : longint;
+    begin
+      { no need to write the count again; it's the same as for the contained units }
+      for i:=0 to containedmodules.count-1 do
+        begin
+          module:=pcontainedunit(containedmodules[i]);
+          pcpfile.putlongint(module^.offset);
+          pcpfile.putlongint(module^.size);
+        end;
+      pcpfile.writeentry(ibpputable);
+    end;
+
+  procedure tpcppackage.writeppudata;
+    const
+      align: array[0..15] of byte = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
+    var
+      i,j,
+      pos,
+      rem : longint;
+      module : pcontainedunit;
+      stream : TCStream;
+    begin
+      pcpfile.flush;
+
+      for i:=0 to containedmodules.count-1 do
+        begin
+          module:=pcontainedunit(containedmodules[i]);
+
+          pos:=pcpfile.position;
+          { align to 16 byte so that it can be nicely viewed in hex editors;
+            maybe we could also use 512 byte alignment instead }
+          rem:=$f-(pos and $f);
+          pcpfile.stream.write(align[0],rem+1);
+          pcpfile.flush;
+          module^.offset:=pcpfile.position;
+
+          { retrieve substream for the current position }
+          stream:=pcpfile.substream(module^.offset,-1);
+          rewriteppu(module^.module.ppufilename,stream);
+          module^.size:=stream.position;
+          stream.free;
+        end;
+
+      pos:=pcpfile.position;
+      { align to 16 byte so that it can be nicely viewed in hex editors;
+        maybe we could also use 512 byte alignment instead }
+      rem:=$f-(pos and $f);
+      pcpfile.stream.write(align[0],rem+1);
+    end;
+
+  procedure tpcppackage.readcontainernames;
+    begin
+      if pcpfile.readentry<>ibpackagefiles then
+        begin
+          message(package_f_pcp_read_error);
+          internalerror(424242);
+        end;
+      pplfilename:=pcpfile.getstring;
+
+      writeln('PPL filename: ',pplfilename);
+    end;
+
+  procedure tpcppackage.readcontainedunits;
+    var
+      cnt,i : longint;
+      name,path : string;
+      p : pcontainedunit;
+    begin
+      if pcpfile.readentry<>ibstartcontained then
+        begin
+          message(package_f_pcp_read_error);
+          internalerror(424242);
+        end;
+      cnt:=pcpfile.getlongint;
+      if pcpfile.readentry<>ibendcontained then
+        begin
+          message(package_f_pcp_read_error);
+          internalerror(424242);
+        end;
+      for i:=0 to cnt-1 do
+        begin
+          name:=pcpfile.getstring;
+          path:=pcpfile.getstring;
+          new(p);
+          p^.module:=nil;
+          p^.ppufile:=path;
+          p^.offset:=0;
+          p^.size:=0;
+          containedmodules.add(name,p);
+          message1(package_u_contained_unit,name);
+        end;
+    end;
+
+  procedure tpcppackage.readrequiredpackages;
+    var
+      cnt,i : longint;
+      name : string;
+    begin
+      if pcpfile.readentry<>ibstartrequireds then
+        begin
+          Writeln('Error reading pcp file');
+          internalerror(2014110901);
+        end;
+      cnt:=pcpfile.getlongint;
+      if pcpfile.readentry<>ibendrequireds then
+        begin
+          Writeln('Error reading pcp file');
+          internalerror(2014110902);
+        end;
+      for i:=0 to cnt-1 do
+        begin
+          name:=pcpfile.getstring;
+          requiredpackages.add(name,nil);
+          Writeln('Found required package ',name);
+        end;
+    end;
+
+  procedure tpcppackage.readpputable;
+    var
+      module : pcontainedunit;
+      i : longint;
+    begin
+      if pcpfile.readentry<>ibpputable then
+        begin
+          message(package_f_pcp_read_error);
+          internalerror(2015103001);
+        end;
+      for i:=0 to containedmodules.count-1 do
+        begin
+          module:=pcontainedunit(containedmodules[i]);
+          module^.offset:=pcpfile.getlongint;
+          module^.size:=pcpfile.getlongint;
+        end;
+    end;
+
+    constructor tpcppackage.create(const pn: string);
+    begin
+      inherited create(pn);
+      setfilename(pn,true);
+    end;
+
+  destructor tpcppackage.destroy;
+    begin
+      pcpfile.free;
+      inherited destroy;
+    end;
+
+  procedure tpcppackage.loadpcp;
+    var
+      newpackagename : string;
+    begin
+      if loaded then
+        exit;
+
+      if not search_package_file then
+        begin
+          Message1(package_f_cant_find_pcp,realpackagename^);
+          exit;
+        end
+      else
+        Message1(package_u_pcp_found,realpackagename^);
+
+      if not assigned(pcpfile) then
+        internalerror(2013053101);
+
+      if pcpfile.readentry<>ibpackagename then
+        Message1(package_f_cant_read_pcp,realpackagename^);
+      newpackagename:=pcpfile.getstring;
+      if upper(newpackagename)<>packagename^ then
+        Comment(V_Error,'Package was renamed: '+realpackagename^);
+
+      readcontainernames;
+
+      readrequiredpackages;
+
+      readcontainedunits;
+
+      readpputable;
+    end;
+
+  procedure tpcppackage.savepcp;
+    var
+      tablepos,
+      oldpos : longint;
+    begin
+      { create new ppufile }
+      pcpfile:=tpcpfile.create(pcpfilename);
+      if not pcpfile.createfile then
+        Message2(package_f_cant_create_pcp,realpackagename^,pcpfilename);
+
+      pcpfile.putstring(realpackagename^);
+      pcpfile.writeentry(ibpackagename);
+
+      writecontainernames;
+
+      writerequiredpackages;
+
+      writecontainedunits;
+
+      { the offsets and the contents of the ppus are not crc'd }
+      pcpfile.do_crc:=false;
+
+      pcpfile.flush;
+      tablepos:=pcpfile.position;
+
+      { this will write a table with empty entries }
+      writepputable;
+
+      pcpfile.do_crc:=true;
+
+      { the last entry ibend is written automatically }
+
+      { flush to be sure }
+      pcpfile.flush;
+      { create and write header }
+      pcpfile.header.common.size:=pcpfile.size;
+      pcpfile.header.checksum:=pcpfile.crc;
+      pcpfile.header.common.compiler:=wordversion;
+      pcpfile.header.common.cpu:=word(target_cpu);
+      pcpfile.header.common.target:=word(target_info.system);
+      //pcpfile.header.flags:=flags;
+      pcpfile.header.ppulistsize:=containedmodules.count;
+      pcpfile.header.requiredlistsize:=requiredpackages.count;
+      pcpfile.writeheader;
+
+      { write the ppu table which will also fill the offsets/sizes }
+      writeppudata;
+
+      pcpfile.flush;
+      oldpos:=pcpfile.position;
+
+      { now write the filled PPU table at the previously stored position }
+      pcpfile.position:=tablepos;
+      writepputable;
+
+      pcpfile.position:=oldpos;
+
+      { save crc in current module also }
+      //crc:=pcpfile.crc;
+
+      pcpfile.closefile;
+      pcpfile.free;
+      pcpfile:=nil;
+    end;
+
+  function tpcppackage.getmodulestream(module:tmodulebase):tcstream;
+    var
+      i : longint;
+      contained : pcontainedunit;
+    begin
+      for i:=0 to containedmodules.count-1 do
+        begin
+          contained:=pcontainedunit(containedmodules[i]);
+          if contained^.module=module then
+            begin
+              result:=pcpfile.substream(contained^.offset,contained^.size);
+              exit;
+            end;
+        end;
+      result:=nil;
+    end;
+
+  procedure tpcppackage.initmoduleinfo(module: tmodulebase);
+    begin
+      pplfilename:=extractfilename(module.sharedlibfilename);
+    end;
+
+  procedure tpcppackage.addunit(module: tmodulebase);
+    var
+      containedunit : pcontainedunit;
+    begin
+      new(containedunit);
+      containedunit^.module:=module;
+      containedunit^.ppufile:=extractfilename(module.ppufilename);
+      containedunit^.offset:=0;
+      containedunit^.size:=0;
+      containedmodules.add(module.modulename^,containedunit);
+    end;
+
+
+  procedure tpcppackage.add_required_package(pkg:tpackage);
+    var
+      p : tpackage;
+    begin
+      p:=tpackage(requiredpackages.find(pkg.packagename^));
+      if not assigned(p) then
+        requiredpackages.Add(pkg.packagename^,pkg)
+      else
+        if p<>pkg then
+          internalerror(2015112302);
+    end;
+
+
+end.
+

compiler/fpkg.pas

@@ -0,0 +1,123 @@
+{
+    Copyright (c) 2013-2016 by Free Pascal Development Team
+
+    This unit implements basic parts of the package system
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit fpkg;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    cclasses,
+    globtype,
+    finput;
+
+  type
+    tcontainedunit=record
+      module:tmodulebase;
+      ppufile:tpathstr;
+      offset:longint;
+      size:longint;
+    end;
+    pcontainedunit=^tcontainedunit;
+
+    tpackage=class
+    public
+      realpackagename,
+      packagename : pshortstring;
+      containedmodules : TFPHashList;
+      requiredpackages : TFPHashObjectList;
+      pcpfilename,
+      ppafilename,
+      pplfilename : tpathstr;
+      constructor create(const pn:string);
+      destructor destroy;override;
+    end;
+
+    tpackageentry=record
+      package : tpackage;
+      realpkgname : string;
+      usedunits : longint;
+      direct : boolean;
+    end;
+    ppackageentry=^tpackageentry;
+
+implementation
+
+  uses
+    cutils,globals;
+
+  { tpackage }
+
+  constructor tpackage.create(const pn: string);
+    begin
+      realpackagename:=stringdup(pn);
+      packagename:=stringdup(upper(pn));
+      containedmodules:=TFPHashList.Create;
+      requiredpackages:=TFPHashObjectList.Create(false);
+    end;
+
+  destructor tpackage.destroy;
+    var
+      p : pcontainedunit;
+      i : longint;
+    begin
+      if assigned(containedmodules) then
+        for i:=0 to containedmodules.count-1 do
+          begin
+            p:=pcontainedunit(containedmodules[i]);
+            dispose(p);
+          end;
+      containedmodules.free;
+      requiredpackages.free;
+      inherited destroy;
+    end;
+
+
+    procedure packageinit;
+      begin
+        packagelist:=TFPHashList.Create;
+      end;
+
+
+    procedure packagedone;
+      var
+        i : longint;
+        pkgentry : ppackageentry;
+      begin
+        if assigned(packagelist) then
+          begin
+            for i:=0 to packagelist.count-1 do
+              begin
+                pkgentry:=ppackageentry(packagelist[i]);
+                pkgentry^.package.free;
+                dispose(pkgentry);
+              end;
+          end;
+        packagelist.Free;
+        packagelist:=nil;
+      end;
+
+
+initialization
+  register_initdone_proc(@packageinit,@packagedone);
+end.
+

compiler/fppu.pas

@@ -38,7 +38,7 @@ interface
 
     uses
       cmsgs,verbose,
-      cutils,cclasses,
+      cutils,cclasses,cstreams,
       globtype,globals,finput,fmodule,
       symbase,ppu,symtype;
 
@@ -59,7 +59,8 @@ interface
           constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
           destructor destroy;override;
           procedure reset;override;
-          function  openppu:boolean;
+          function  openppufile:boolean;
+          function  openppustream(strm:TCStream):boolean;
           procedure getppucrc;
           procedure writeppu;
           procedure loadppu;
@@ -68,6 +69,7 @@ interface
           procedure reload_flagged_units;
           procedure end_of_parsing;override;
        private
+          unitimportsymsderefs : tfplist;
          { Each time a unit's defs are (re)created, its defsgeneration is
            set to the value of a global counter, and the global counter is
            increased. We only reresolve its dependent units' defs in case
@@ -75,13 +77,17 @@ interface
            avoid endless resolving loops in case of cyclic dependencies. }
           defsgeneration : longint;
 
+          function  openppu(ppufiletime:longint):boolean;
           function  search_unit_files(onlysource:boolean):boolean;
           function  search_unit(onlysource,shortname:boolean):boolean;
+          function  loadfrompackage:boolean;
           procedure load_interface;
           procedure load_implementation;
           procedure load_usedunits;
           procedure printcomments;
           procedure queuecomment(const s:TMsgStr;v,w:longint);
+          procedure buildderefunitimportsyms;
+          procedure derefunitimportsyms;
           procedure writesourcefiles;
           procedure writeusedunit(intf:boolean);
           procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
@@ -89,6 +95,7 @@ interface
           procedure writederefdata;
           procedure writeImportSymbols;
           procedure writeResources;
+          procedure writeunitimportsyms;
           procedure readsourcefiles;
           procedure readloadunit;
           procedure readlinkcontainer(var p:tlinkcontainer);
@@ -97,6 +104,7 @@ interface
           procedure readImportSymbols;
           procedure readResources;
           procedure readwpofile;
+          procedure readunitimportsyms;
 {$IFDEF MACRO_DIFF_HINT}
           procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
           procedure writeusedmacros;
@@ -118,7 +126,8 @@ uses
   scanner,
   aasmbase,ogbase,
   parser,
-  comphook;
+  comphook,
+  entfile,fpkg,fpcp;
 
 
 var
@@ -133,6 +142,7 @@ var
         inherited create(LoadedFrom,amodulename,afilename,_is_unit);
         ppufile:=nil;
         sourcefn:=afilename;
+        unitimportsymsderefs:=tfplist.create;
       end;
 
 
@@ -143,6 +153,8 @@ var
         ppufile:=nil;
         comments.free;
         comments:=nil;
+        unitimportsymsderefs.free;
+        unitimportsymsderefs:=nil;
         inherited Destroy;
       end;
 
@@ -180,11 +192,11 @@ var
       until false;
     end;
 
-    function tppumodule.openppu:boolean;
+    function tppumodule.openppufile:boolean;
       var
         ppufiletime : longint;
       begin
-        openppu:=false;
+        openppufile:=false;
         Message1(unit_t_ppu_loading,ppufilename,@queuecomment);
       { Get ppufile time (also check if the file exists) }
         ppufiletime:=getnamedfiletime(ppufilename);
@@ -200,6 +212,30 @@ var
            Message(unit_u_ppu_file_too_short);
            exit;
          end;
+        result:=openppu(ppufiletime);
+      end;
+
+
+    function tppumodule.openppustream(strm:TCStream):boolean;
+      begin
+        result:=false;
+      { Open the ppufile }
+        Message1(unit_u_ppu_name,ppufilename);
+        ppufile:=tcompilerppufile.create(ppufilename);
+        if not ppufile.openstream(strm) then
+         begin
+           ppufile.free;
+           ppufile:=nil;
+           Message(unit_u_ppu_file_too_short);
+           exit;
+         end;
+        result:=openppu(-1);
+      end;
+
+
+    function tppumodule.openppu(ppufiletime:longint):boolean;
+      begin
+        openppu:=false;
       { check for a valid PPU file }
         if not ppufile.CheckPPUId then
          begin
@@ -209,15 +245,15 @@ var
            exit;
          end;
       { check for allowed PPU versions }
-        if not (ppufile.GetPPUVersion = CurrentPPUVersion) then
+        if not (ppufile.getversion = CurrentPPUVersion) then
          begin
-           Message1(unit_u_ppu_invalid_version,tostr(ppufile.GetPPUVersion),@queuecomment);
+           Message1(unit_u_ppu_invalid_version,tostr(ppufile.getversion),@queuecomment);
            ppufile.free;
            ppufile:=nil;
            exit;
          end;
       { check the target processor }
-        if tsystemcpu(ppufile.header.cpu)<>target_cpu then
+        if tsystemcpu(ppufile.header.common.cpu)<>target_cpu then
          begin
            ppufile.free;
            ppufile:=nil;
@@ -225,7 +261,7 @@ var
            exit;
          end;
       { check target }
-        if tsystem(ppufile.header.target)<>target_info.system then
+        if tsystem(ppufile.header.common.target)<>target_info.system then
          begin
            ppufile.free;
            ppufile:=nil;
@@ -234,7 +270,7 @@ var
          end;
 {$ifdef i8086}
       { check i8086 memory model flags }
-        if ((ppufile.header.flags and uf_i8086_far_code)<>0) xor
+        if ((ppufile.header.common.flags and uf_i8086_far_code)<>0) xor
             (current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge]) then
          begin
            ppufile.free;
@@ -242,7 +278,7 @@ var
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            exit;
          end;
-        if ((ppufile.header.flags and uf_i8086_far_data)<>0) xor
+        if ((ppufile.header.common.flags and uf_i8086_far_data)<>0) xor
             (current_settings.x86memorymodel in [mm_compact,mm_large]) then
          begin
            ppufile.free;
@@ -250,7 +286,7 @@ var
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            exit;
          end;
-        if ((ppufile.header.flags and uf_i8086_huge_data)<>0) xor
+        if ((ppufile.header.common.flags and uf_i8086_huge_data)<>0) xor
             (current_settings.x86memorymodel=mm_huge) then
          begin
            ppufile.free;
@@ -258,7 +294,7 @@ var
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            exit;
          end;
-        if ((ppufile.header.flags and uf_i8086_cs_equals_ds)<>0) xor
+        if ((ppufile.header.common.flags and uf_i8086_cs_equals_ds)<>0) xor
             (current_settings.x86memorymodel=mm_tiny) then
          begin
            ppufile.free;
@@ -270,7 +306,7 @@ var
 {$ifdef cpufpemu}
        { check if floating point emulation is on?
          fpu emulation isn't unit levelwise because it affects calling convention }
-       if ((ppufile.header.flags and uf_fpu_emulation)<>0) xor
+       if ((ppufile.header.common.flags and uf_fpu_emulation)<>0) xor
             (cs_fp_emulation in current_settings.moduleswitches) then
          begin
            ppufile.free;
@@ -281,12 +317,15 @@ var
 {$endif cpufpemu}
 
       { Load values to be access easier }
-        flags:=ppufile.header.flags;
+        flags:=ppufile.header.common.flags;
         crc:=ppufile.header.checksum;
         interface_crc:=ppufile.header.interface_checksum;
         indirect_crc:=ppufile.header.indirect_checksum;
       { Show Debug info }
-        Message1(unit_u_ppu_time,filetimestring(ppufiletime));
+        if ppufiletime<>-1 then
+          Message1(unit_u_ppu_time,filetimestring(ppufiletime))
+        else
+          Message1(unit_u_ppu_time,'unknown');
         Message1(unit_u_ppu_flags,tostr(flags));
         Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8));
         Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
@@ -337,7 +376,7 @@ var
            if Found then
             Begin
               SetFileName(hs,false);
-              Found:=OpenPPU;
+              Found:=openppufile;
             End;
            PPUSearchPath:=Found;
          end;
@@ -477,6 +516,121 @@ var
          search_unit:=fnd;
       end;
 
+    function tppumodule.loadfrompackage: boolean;
+      (*var
+        singlepathstring,
+        filename : TCmdStr;
+
+        Function UnitExists(const ext:string;var foundfile:TCmdStr):boolean;
+          begin
+            if CheckVerbosity(V_Tried) then
+              Message1(unit_t_unitsearch,Singlepathstring+filename);
+            UnitExists:=FindFile(FileName,Singlepathstring,true,foundfile);
+          end;
+
+        Function PPUSearchPath(const s:TCmdStr):boolean;
+          var
+            found : boolean;
+            hs    : TCmdStr;
+          begin
+            Found:=false;
+            singlepathstring:=FixPath(s,false);
+          { Check for PPU file }
+            Found:=UnitExists(target_info.unitext,hs);
+            if Found then
+             Begin
+               SetFileName(hs,false);
+               //Found:=OpenPPU;
+             End;
+            PPUSearchPath:=Found;
+          end;
+
+        Function SearchPathList(list:TSearchPathList):boolean;
+          var
+            hp : TCmdStrListItem;
+            found : boolean;
+          begin
+            found:=false;
+            hp:=TCmdStrListItem(list.First);
+            while assigned(hp) do
+             begin
+               found:=PPUSearchPath(hp.Str);
+               if found then
+                break;
+               hp:=TCmdStrListItem(hp.next);
+             end;
+            SearchPathList:=found;
+          end;*)
+
+      var
+        pkg : ppackageentry;
+        pkgunit : pcontainedunit;
+        i,idx : longint;
+        strm : TCStream;
+      begin
+        result:=false;
+        for i:=0 to packagelist.count-1 do
+          begin
+            pkg:=ppackageentry(packagelist[i]);
+            if not assigned(pkg^.package) then
+              internalerror(2013053103);
+            idx:=pkg^.package.containedmodules.FindIndexOf(modulename^);
+            if idx>=0 then
+              begin
+                { the unit is part of this package }
+                pkgunit:=pcontainedunit(pkg^.package.containedmodules[idx]);
+                if not assigned(pkgunit^.module) then
+                  pkgunit^.module:=self;
+                { ToDo: check whether we really don't need this anymore }
+                {filename:=pkgunit^.ppufile;
+                if not SearchPathList(unitsearchpath) then
+                  exit};
+                strm:=tpcppackage(pkg^.package).getmodulestream(self);
+                if not assigned(strm) then
+                  internalerror(2015103002);
+                if not openppustream(strm) then
+                  exit;
+                package:=pkg^.package;
+                Message2(unit_u_loading_from_package,modulename^,pkg^.package.packagename^);
+
+                { now load the unit and all used units }
+                load_interface;
+                setdefgeneration;
+                load_usedunits;
+                Message1(unit_u_finished_loading_unit,modulename^);
+
+                result:=true;
+                break;
+              end;
+          end;
+      end;
+
+
+    procedure tppumodule.buildderefunitimportsyms;
+      var
+        i : longint;
+        deref : pderef;
+      begin
+        for i:=0 to unitimportsyms.count-1 do
+          begin
+            new(deref);
+            deref^.build(unitimportsyms[i]);
+            unitimportsymsderefs.add(deref);
+          end;
+      end;
+
+
+    procedure tppumodule.derefunitimportsyms;
+      var
+        i : longint;
+        sym : tsym;
+      begin
+        for i:=0 to unitimportsymsderefs.count-1 do
+          begin
+            sym:=tsym(pderef(unitimportsymsderefs[i])^.resolve);
+            unitimportsyms.add(sym);
+          end;
+      end;
 
 {**********************************
     PPU Reading/Writing Helpers
@@ -693,6 +847,16 @@ var
       end;
 
 
+    procedure tppumodule.writeunitimportsyms;
+      var
+        i : longint;
+      begin
+        ppufile.putlongint(unitimportsymsderefs.count);
+        for i:=0 to unitimportsymsderefs.count-1 do
+          ppufile.putderef(pderef(unitimportsymsderefs[i])^);
+        ppufile.writeentry(ibunitimportsyms);
+      end;
+
 {$IFDEF MACRO_DIFF_HINT}
 
 {
@@ -989,6 +1153,20 @@ var
       end;
 
 
+    procedure tppumodule.readunitimportsyms;
+      var
+        c,i : longint;
+        deref : pderef;
+      begin
+        c:=ppufile.getlongint;
+        for i:=0 to c-1 do
+          begin
+            new(deref);
+            ppufile.getderef(deref^);
+            unitimportsymsderefs.add(deref);
+          end;
+      end;
+
     procedure tppumodule.load_interface;
       var
         b : byte;
@@ -1086,6 +1264,8 @@ var
              ibasmsymbols :
 { TODO: Remove ibasmsymbols}
                ;
+             ibunitimportsyms:
+               readunitimportsyms;
              ibendimplementation :
                break;
            else
@@ -1201,6 +1381,7 @@ var
          tunitwpoinfo(wpoinfo).buildderefimpl;
          if (flags and uf_local_symtable)<>0 then
            tstoredsymtable(localsymtable).buildderef_registered;
+         buildderefunitimportsyms;
          writederefmap;
          writederefdata;
 
@@ -1227,6 +1408,9 @@ var
          { write implementation uses }
          writeusedunit(false);
 
+         { write all symbols imported from another unit }
+         writeunitimportsyms;
+
          { end of implementation }
          ppufile.writeentry(ibendimplementation);
 
@@ -1243,14 +1427,14 @@ var
          { flush to be sure }
          ppufile.flush;
          { create and write header }
-         ppufile.header.size:=ppufile.size;
+         ppufile.header.common.size:=ppufile.size;
          ppufile.header.checksum:=ppufile.crc;
          ppufile.header.interface_checksum:=ppufile.interface_crc;
          ppufile.header.indirect_checksum:=ppufile.indirect_crc;
-         ppufile.header.compiler:=wordversion;
-         ppufile.header.cpu:=word(target_cpu);
-         ppufile.header.target:=word(target_info.system);
-         ppufile.header.flags:=flags;
+         ppufile.header.common.compiler:=wordversion;
+         ppufile.header.common.cpu:=word(target_cpu);
+         ppufile.header.common.target:=word(target_info.system);
+         ppufile.header.common.flags:=flags;
          ppufile.header.deflistsize:=current_module.deflist.count;
          ppufile.header.symlistsize:=current_module.symlist.count;
          ppufile.writeheader;
@@ -1349,14 +1533,14 @@ var
 
          { create and write header, this will only be used
            for debugging purposes }
-         ppufile.header.size:=ppufile.size;
+         ppufile.header.common.size:=ppufile.size;
          ppufile.header.checksum:=ppufile.crc;
          ppufile.header.interface_checksum:=ppufile.interface_crc;
          ppufile.header.indirect_checksum:=ppufile.indirect_crc;
-         ppufile.header.compiler:=wordversion;
-         ppufile.header.cpu:=word(target_cpu);
-         ppufile.header.target:=word(target_info.system);
-         ppufile.header.flags:=flags;
+         ppufile.header.common.compiler:=wordversion;
+         ppufile.header.common.cpu:=word(target_cpu);
+         ppufile.header.common.target:=word(target_info.system);
+         ppufile.header.common.flags:=flags;
          ppufile.writeheader;
 
          ppufile.closefile;
@@ -1391,7 +1575,7 @@ var
               if (pu.u.interface_crc<>pu.interface_checksum) or
                  (pu.u.indirect_crc<>pu.indirect_checksum) or
                  (
-                  ((ppufile.header.flags and uf_release)=0) and
+                  ((ppufile.header.common.flags and uf_release)=0) and
                   (pu.u.crc<>pu.checksum)
                  ) then
                begin
@@ -1481,6 +1665,8 @@ var
         if assigned(localsymtable) then
           tstoredsymtable(localsymtable).derefimpl(false);
 
+        derefunitimportsyms;
+
          { read whole program optimisation-related information }
          wpoinfo:=tunitwpoinfo.ppuload(ppufile);
          tunitwpoinfo(wpoinfo).deref;
@@ -1593,6 +1779,23 @@ var
         second_time:=false;
         set_current_module(self);
 
+        { try to load it as a package unit first }
+        if (packagelist.count>0) and loadfrompackage then
+          begin
+            do_load:=false;
+            do_reload:=false;
+            state:=ms_compiled;
+            { PPU is not needed anymore }
+            if assigned(ppufile) then
+             begin
+                ppufile.closefile;
+                ppufile.free;
+                ppufile:=nil;
+             end;
+            { add the unit to the used units list of the program }
+            usedunits.concat(tused_unit.create(self,true,false,nil));
+          end;
+
         { A force reload }
         if do_reload then
          begin

compiler/globals.pas

@@ -44,6 +44,9 @@ interface
       { comphook pulls in sysutils anyways }
       cutils,cclasses,cfileutl,
       cpuinfo,
+{$if defined(LLVM) and not defined(GENERIC_CPU)}
+      llvminfo,
+{$endif LLVM and not GENERIC_CPU}
       globtype,version,systems;
 
     const
@@ -148,7 +151,8 @@ interface
          maxfpuregisters : shortint;
 
          cputype,
-         optimizecputype : tcputype;
+         optimizecputype,
+         asmcputype      : tcputype;
          fputype         : tfputype;
          asmmode         : tasmmode;
          interfacetype   : tinterfacetypes;
@@ -167,6 +171,10 @@ interface
          instructionset : tinstructionset;
 {$endif defined(ARM)}
 
+{$if defined(LLVM) and not defined(GENERIC_CPU)}
+         llvmversion: tllvmversion;
+{$endif defined(LLVM) and not defined(GENERIC_CPU)}
+
         { CPU targets with microcontroller support can add a controller specific unit }
          controllertype   : tcontrollertype;
 
@@ -269,11 +277,12 @@ interface
        objectsearchpath,
        includesearchpath,
        frameworksearchpath  : TSearchPathList;
+       packagesearchpath     : TSearchPathList;
+       { contains tpackageentry entries }
+       packagelist : TFPHashList;
        autoloadunits      : string;
 
        { linking }
-       usegnubinutils : boolean;
-       forceforwardslash : boolean;
        usewindowapi  : boolean;
        description   : string;
        SetPEFlagsSetExplicity,
@@ -346,8 +355,6 @@ interface
        prop_auto_setter_prefix : string;
 
     const
-       DLLsource : boolean = false;
-
        Inside_asm_statement : boolean = false;
 
        global_unit_count : word = 0;
@@ -391,7 +398,7 @@ interface
         globalswitches : [cs_check_unit_name,cs_link_static];
         targetswitches : [];
         moduleswitches : [cs_extsyntax,cs_implicit_exceptions];
-        localswitches : [cs_check_io,cs_typed_const_writable,cs_pointermath{$ifdef i8086},cs_force_far_calls{$endif}];
+        localswitches : [cs_check_io,cs_typed_const_writable,cs_pointermath,cs_imported_data{$ifdef i8086},cs_force_far_calls{$endif}];
         modeswitches : fpcmodeswitches;
         optimizerswitches : [];
         genwpoptimizerswitches : [];
@@ -414,66 +421,79 @@ interface
 {$ifdef GENERIC_CPU}
         cputype : cpu_none;
         optimizecputype : cpu_none;
+        asmcputype : cpu_none;
         fputype : fpu_none;
 {$else not GENERIC_CPU}
   {$ifdef i386}
         cputype : cpu_Pentium;
         optimizecputype : cpu_Pentium3;
+        asmcputype : cpu_none;
         fputype : fpu_x87;
   {$endif i386}
   {$ifdef m68k}
         cputype : cpu_MC68020;
         optimizecputype : cpu_MC68020;
+        asmcputype : cpu_none;
         fputype : fpu_soft;
   {$endif m68k}
   {$ifdef powerpc}
         cputype : cpu_PPC604;
         optimizecputype : cpu_ppc7400;
+        asmcputype : cpu_none;
         fputype : fpu_standard;
   {$endif powerpc}
   {$ifdef POWERPC64}
         cputype : cpu_PPC970;
         optimizecputype : cpu_ppc970;
+        asmcputype : cpu_none;
         fputype : fpu_standard;
   {$endif POWERPC64}
   {$ifdef sparc}
         cputype : cpu_SPARC_V9;
         optimizecputype : cpu_SPARC_V9;
+        asmcputype : cpu_none;
         fputype : fpu_hard;
   {$endif sparc}
   {$ifdef arm}
         cputype : cpu_armv4;
         optimizecputype : cpu_armv4;
+        asmcputype : cpu_none;
         fputype : fpu_fpa;
   {$endif arm}
   {$ifdef x86_64}
         cputype : cpu_athlon64;
         optimizecputype : cpu_athlon64;
+        asmcputype : cpu_none;
         fputype : fpu_sse64;
   {$endif x86_64}
   {$ifdef avr}
         cputype : cpuinfo.cpu_avr5;
         optimizecputype : cpuinfo.cpu_avr5;
+        asmcputype : cpu_none;
         fputype : fpu_none;
   {$endif avr}
   {$ifdef mips}
         cputype : cpu_mips2;
         optimizecputype : cpu_mips2;
+        asmcputype : cpu_none;
         fputype : fpu_mips2;
   {$endif mips}
   {$ifdef jvm}
         cputype : cpu_none;
         optimizecputype : cpu_none;
+        asmcputype : cpu_none;
         fputype : fpu_standard;
   {$endif jvm}
   {$ifdef aarch64}
         cputype : cpu_armv8;
         optimizecputype : cpu_armv8;
+        asmcputype : cpu_none;
         fputype : fpu_vfp;
   {$endif aarch64}
   {$ifdef i8086}
         cputype : cpu_8086;
         optimizecputype : cpu_8086;
+        asmcputype : cpu_8086;
         fputype : fpu_x87;
   {$endif i8086}
 {$endif not GENERIC_CPU}
@@ -494,6 +514,9 @@ interface
 {$if defined(ARM)}
         instructionset : is_arm;
 {$endif defined(ARM)}
+{$if defined(LLVM) and not defined(GENERIC_CPU)}
+        llvmversion    : llvmver_3_6_0;
+{$endif defined(LLVM) and not defined(GENERIC_CPU)}
         controllertype : ct_none;
         pmessage : nil;
       );
@@ -517,6 +540,7 @@ interface
 
     procedure InitGlobals;
     procedure DoneGlobals;
+    procedure register_initdone_proc(init,done:tprocedure);
 
     function  string2guid(const s: string; var GUID: TGUID): boolean;
     function  guid2string(const GUID: TGUID): string;
@@ -746,10 +770,10 @@ implementation
      get the current time in a string HH:MM:SS
    }
       var
-        hour,min,sec,hsec : word;
+        st: TSystemTime;
       begin
-        DecodeTime(Time,hour,min,sec,hsec);
-        gettimestr:=L0(Hour)+':'+L0(min)+':'+L0(sec);
+        GetLocalTime(st);
+        gettimestr:=L0(st.Hour)+':'+L0(st.Minute)+':'+L0(st.Second);
       end;
 
 
@@ -758,10 +782,10 @@ implementation
      get the current date in a string YY/MM/DD
    }
       var
-        Year,Month,Day: Word;
+        st: TSystemTime;
       begin
-        DecodeDate(Date,year,month,day);
-        getdatestr:=L0(Year)+'/'+L0(Month)+'/'+L0(Day);
+        GetLocalTime(st);
+        getdatestr:=L0(st.Year)+'/'+L0(st.Month)+'/'+L0(st.Day);
       end;
 
 
@@ -789,10 +813,10 @@ implementation
 
    function getrealtime : real;
      var
-       h,m,s,s1000 : word;
+       st:TSystemTime;
      begin
-       DecodeTime(Time,h,m,s,s1000);
-       result:=h*3600.0+m*60.0+s+s1000/1000.0;
+       GetLocalTime(st);
+       result:=st.Hour*3600.0+st.Minute*60.0+st.Second+st.MilliSecond/1000.0;
      end;
 
 {****************************************************************************
@@ -1068,7 +1092,8 @@ implementation
          'STDCALL',
          'SOFTFLOAT',
          'MWPASCAL',
-         'INTERRUPT'
+         'INTERRUPT',
+         'HARDFLOAT'
         );
       var
         t  : tproccalloption;
@@ -1343,8 +1368,70 @@ implementation
 
 
 
+   type
+     tinitdoneentry=record
+       init:tprocedure;
+       done:tprocedure;
+     end;
+     pinitdoneentry=^tinitdoneentry;
+
+
+   var
+     initdoneprocs : TFPList;
+
+
+   procedure register_initdone_proc(init,done:tprocedure);
+     var
+       entry : pinitdoneentry;
+     begin
+       new(entry);
+       entry^.init:=init;
+       entry^.done:=done;
+       initdoneprocs.add(entry);
+     end;
+
+
+   procedure callinitprocs;
+     var
+       i : longint;
+     begin
+       for i:=0 to initdoneprocs.count-1 do
+         with pinitdoneentry(initdoneprocs[i])^ do
+           if assigned(init) then
+             init();
+     end;
+
+
+   procedure calldoneprocs;
+     var
+       i : longint;
+     begin
+       for i:=0 to initdoneprocs.count-1 do
+         with pinitdoneentry(initdoneprocs[i])^ do
+           if assigned(done) then
+             done();
+     end;
+
+
+   procedure allocinitdoneprocs;
+     begin
+       initdoneprocs:=tfplist.create;
+     end;
+
+
+   procedure freeinitdoneprocs;
+     var
+       i : longint;
+     begin
+       for i:=0 to initdoneprocs.count-1 do
+         dispose(pinitdoneentry(initdoneprocs[i]));
+       initdoneprocs.free;
+     end;
+
+
    procedure DoneGlobals;
      begin
+       calldoneprocs;
        librarysearchpath.Free;
        unitsearchpath.Free;
        objectsearchpath.Free;
@@ -1352,6 +1439,7 @@ implementation
        frameworksearchpath.Free;
        LinkLibraryAliases.Free;
        LinkLibraryOrder.Free;
+       packagesearchpath.Free;
      end;
 
    procedure InitGlobals;
@@ -1364,7 +1452,6 @@ implementation
         do_make:=true;
         compile_level:=0;
         codegenerror:=false;
-        DLLsource:=false;
 
         { Output }
         OutputFileName:='';
@@ -1388,6 +1475,7 @@ implementation
         includesearchpath:=TSearchPathList.Create;
         objectsearchpath:=TSearchPathList.Create;
         frameworksearchpath:=TSearchPathList.Create;
+        packagesearchpath:=TSearchPathList.Create;
 
         { Def file }
         usewindowapi:=false;
@@ -1429,6 +1517,12 @@ implementation
 
         { enable all features by default }
         features:=[low(Tfeature)..high(Tfeature)];
+
+        callinitprocs;
      end;
 
+initialization
+  allocinitdoneprocs;
+finalization
+  freeinitdoneprocs;
 end.

compiler/globtype.pas

@@ -92,8 +92,16 @@ interface
        PAInt = ^AInt;
 
        { target cpu specific type used to store data sizes }
+{$ifdef cpu16bitaddr}
+       { on small CPUs such as i8086, we use LongInt to support data structures
+         larger than 32767 bytes and up to 65535 bytes in size. Since asizeint
+         must be signed, we use LongInt/LongWord. }
+       ASizeInt = LongInt;
+       ASizeUInt = LongWord;
+{$else cpu16bitaddr}
        ASizeInt = PInt;
        ASizeUInt = PUInt;
+{$endif cpu16bitaddr}
 
        { type used for handling constants etc. in the code generator }
        TCGInt = Int64;
@@ -106,7 +114,7 @@ interface
 {$ifdef i8086}
        TConstPtrUInt = LongWord;  { 32-bit for far pointers support }
 {$else i8086}
-       TConstPtrUInt = AWord;
+       TConstPtrUInt = PUint;
 {$endif i8086}
 
        { Use a variant record to be sure that the array if aligned correctly }
@@ -133,7 +141,7 @@ interface
          cs_generate_stackframes,cs_do_assertion,cs_generate_rtti,
          cs_full_boolean_eval,cs_typed_const_writable,cs_allow_enum_calc,
          cs_do_inline,cs_fpu_fwait,cs_ieee_errors,
-         cs_check_low_addr_load,
+         cs_check_low_addr_load,cs_imported_data,
          { mmx }
          cs_mmx,cs_mmx_saturation,
          { parser }
@@ -515,7 +523,10 @@ interface
          { constant records by reference.                            }
          pocall_mwpascal,
          { Special interrupt handler for embedded systems }
-         pocall_interrupt
+         pocall_interrupt,
+         { Directive for arm: pass floating point values in (v)float registers
+           regardless of the actual calling conventions }
+         pocall_hardfloat
        );
        tproccalloptions = set of tproccalloption;
 
@@ -533,7 +544,8 @@ interface
            'StdCall',
            'SoftFloat',
            'MWPascal',
-           'Interrupt'
+           'Interrupt',
+           'HardFloat'
          );
 
        { Default calling convention }
@@ -636,7 +648,12 @@ interface
          { set if the stack frame of the procedure is estimated }
          pi_estimatestacksize,
          { the routine calls a C-style varargs function }
-         pi_calls_c_varargs
+         pi_calls_c_varargs,
+         { the routine has an open array parameter,
+           for i8086 cpu huge memory model,
+           as this changes SP register it requires special handling
+           to restore DS segment register  }
+         pi_has_open_array_parameter
        );
        tprocinfoflags=set of tprocinfoflag;
 

compiler/hlcg2ll.pas

@@ -1026,7 +1026,6 @@ implementation
 {$else}
                hregister:=cg.makeregsize(list,l.register64.reglo,OS_32);
 {$endif}
-               cg.a_load_reg_reg(list,l.size,OS_32,l.register64.reglo,hregister);
              end
             else
              hregister:=cg.getintregister(list,OS_32);

compiler/hlcgobj.pas

@@ -542,7 +542,7 @@ unit hlcgobj;
             reference if necessary. fromdef needs to be a pointerdef because
             it may have to be passed as fromdef to a_loadaddr_ref_reg, which
             needs the "pointeddef" of fromdef }
-          procedure g_ptrtypecast_ref(list: TAsmList; fromdef: tpointerdef; todef: tdef; var ref: treference); virtual;
+          procedure g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tdef; var ref: treference); virtual;
 
           { update a reference pointing to the start address of a record/object/
             class (contents) so it refers to the indicated field }
@@ -552,7 +552,12 @@ unit hlcgobj;
           procedure g_setup_load_field_by_name(list: TAsmList; recdef: trecorddef; const name: TIDString; const recref: treference; out fref: treference; out fielddef: tdef);
          public
           procedure g_load_reg_field_by_name(list: TAsmList; regsize: tdef; recdef: trecorddef; reg: tregister; const name: TIDString; const recref: treference);
-          procedure g_load_const_field_by_name(list: TAsmList; recdef: trecorddef; const name: TIDString; a: tcgint; const recref: treference);
+          procedure g_load_const_field_by_name(list: TAsmList; recdef: trecorddef; a: tcgint; const name: TIDString; const recref: treference);
+          { laod a named field into a register }
+          procedure g_load_field_reg_by_name(list: TAsmList; recdef: trecorddef; regsize: tdef; const name: TIDString; const recref: treference; reg: tregister);
+          { same as above, but allocates the register and determines the def
+            based on the type of the field }
+          procedure g_force_field_reg_by_name(list: TAsmList; recdef: trecorddef; const name: TIDString; const recref: treference; out regdef: tdef; out reg: tregister);
 
           { routines migrated from ncgutil }
 
@@ -1768,7 +1773,7 @@ implementation
     begin
       href:=ref;
       g_ptrtypecast_ref(list,cpointerdef.getreusable(tosize),cpointerdef.getreusable(u8inttype),href);
-      a_load_const_subsetref(list,u8inttype,ord(doset),get_bit_reg_ref_sref(list,fromsize,tosize,bitnumber,ref));
+      a_load_const_subsetref(list,u8inttype,ord(doset),get_bit_reg_ref_sref(list,fromsize,tosize,bitnumber,href));
     end;
 
   procedure thlcgobj.a_bit_set_reg_loc(list: TAsmList; doset: boolean; regsize, tosize: tdef; bitnumber: tregister; const loc: tlocation);
@@ -3680,6 +3685,7 @@ implementation
       { because some abis don't support dynamic stack allocation properly
         open array value parameters are copied onto the heap
       }
+      include(current_procinfo.flags, pi_has_open_array_parameter);
 
       { calculate necessary memory }
 
@@ -3844,7 +3850,7 @@ implementation
       { nothing to do }
     end;
 
-  procedure thlcgobj.g_ptrtypecast_ref(list: TAsmList; fromdef: tpointerdef; todef: tdef; var ref: treference);
+  procedure thlcgobj.g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tdef; var ref: treference);
     begin
       { nothing to do }
     end;
@@ -3882,7 +3888,7 @@ implementation
     end;
 
 
-  procedure thlcgobj.g_load_const_field_by_name(list: TAsmList; recdef: trecorddef; const name: TIDString; a: tcgint; const recref: treference);
+  procedure thlcgobj.g_load_const_field_by_name(list: TAsmList; recdef: trecorddef; a: tcgint; const name: TIDString; const recref: treference);
     var
       fref: treference;
       fielddef: tdef;
@@ -3892,6 +3898,26 @@ implementation
     end;
 
 
+  procedure thlcgobj.g_load_field_reg_by_name(list: TAsmList; recdef: trecorddef; regsize: tdef; const name: TIDString; const recref: treference; reg: tregister);
+    var
+      fref: treference;
+      fielddef: tdef;
+    begin
+      g_setup_load_field_by_name(list,recdef,name,recref,fref,fielddef);
+      a_load_ref_reg(list,fielddef,regsize,fref,reg);
+    end;
+
+
+  procedure thlcgobj.g_force_field_reg_by_name(list: TAsmList; recdef: trecorddef; const name: TIDString; const recref: treference; out regdef: tdef; out reg: tregister);
+    var
+      fref: treference;
+    begin
+      g_setup_load_field_by_name(list,recdef,name,recref,fref,regdef);
+      reg:=getregisterfordef(list,regdef);
+      a_load_ref_reg(list,regdef,regdef,fref,reg);
+    end;
+
+
   procedure thlcgobj.location_force_reg(list: TAsmList; var l: tlocation; src_size, dst_size: tdef; maybeconst: boolean);
     var
       hregister,
@@ -4605,7 +4631,11 @@ implementation
        begin
          { initialize units }
          if not(current_module.islibrary) then
+{$ifdef AVR}
+           cg.a_call_name(list,'FPC_INIT_FUNC_TABLE',false)
+{$else AVR}
            g_call_system_proc(list,'fpc_initializeunits',[],nil)
+{$endif AVR}
          else
            g_call_system_proc(list,'fpc_libinitializeunits',[],nil);
        end;
@@ -4623,7 +4653,7 @@ implementation
           look up procdef, use hlcgobj.a_call_name()) }
 
       { call __EXIT for main program }
-      if (not DLLsource) and
+      if (not current_module.islibrary) and
          (current_procinfo.procdef.proctypeoption=potype_proginit) then
         g_call_system_proc(list,'fpc_do_exit',[],nil);
     end;
@@ -4849,6 +4879,7 @@ implementation
                 else
                   highloc.loc:=LOC_INVALID;
                 eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
+                g_ptrtypecast_ref(list,cpointerdef.getreusable(tparavarsym(p).vardef),cpointerdef.getreusable(eldef),href);
                 g_array_rtti_helper(list,eldef,href,highloc,'fpc_finalize_array');
               end
             else
@@ -4914,6 +4945,7 @@ implementation
                          { open arrays do not contain correct element count in their rtti,
                            the actual count must be passed separately. }
                          eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
+                         g_ptrtypecast_ref(list,cpointerdef.getreusable(tparavarsym(p).vardef),cpointerdef.getreusable(eldef),href);
                          g_array_rtti_helper(list,eldef,href,highloc,'fpc_addref_array');
                        end
                      else

compiler/htypechk.pas

@@ -2396,7 +2396,7 @@ implementation
             while assigned(pt) do
               begin
                 if (pt.resultdef.typ=recorddef) and
-                    (sto_has_operator in tabstractrecorddef(pt.resultdef).owner.tableoptions) then
+                    (sto_has_operator in tabstractrecorddef(pt.resultdef).symtable.tableoptions) then
                   collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList,searchhelpers,anoninherited,spezcontext);
                 pt:=tcallparanode(pt.right);
               end;
@@ -2472,10 +2472,7 @@ implementation
                   )
                 ) or
                 (
-                  (
-                    not pd.is_specialization or
-                    assigned(pd.owner)
-                  ) and
+                  assigned(pd.owner) and
                   (
                     not (pd.owner.symtabletype in [objectsymtable,recordsymtable]) or
                     is_visible_for_object(pd,contextstructdef)
@@ -2999,8 +2996,8 @@ implementation
     function get_variantequaltype(def: tdef): tvariantequaltype;
       const
         variantorddef_cl: array[tordtype] of tvariantequaltype =
-          (tve_incompatible,tve_byte,tve_word,tve_cardinal,tve_chari64,
-           tve_shortint,tve_smallint,tve_longint,tve_chari64,
+          (tve_incompatible,tve_byte,tve_word,tve_cardinal,tve_chari64,tve_incompatible,
+           tve_shortint,tve_smallint,tve_longint,tve_chari64,tve_incompatible,
            tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
            tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
            tve_chari64,tve_chari64,tve_dblcurrency);

compiler/i386/aopt386.pas

@@ -1,118 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Jonas Maebe
-
-    This unit calls the optimization procedures to optimize the assembler
-    code for i386+
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    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.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-Unit aopt386;
-
-{$i fpcdefs.inc}
-
-Interface
-
-Uses
-  aasmbase,aasmtai,aasmdata,aasmcpu;
-
-Procedure Optimize(AsmL: TAsmList);
-
-
-Implementation
-
-Uses
-  globtype,
-  globals,
-  DAOpt386,POpt386;
-
-
-Procedure Optimize(AsmL: TAsmList);
-Var
-  BlockStart, BlockEnd, HP: Tai;
-  pass: longint;
-  slowopt, changed, lastLoop: boolean;
-Begin
-  slowopt := (cs_opt_level3 in current_settings.optimizerswitches);
-  pass := 0;
-  changed := false;
-  dfa := TDFAObj.create(asml);
-  repeat
-     lastLoop :=
-       not(slowopt) or
-       (not changed and (pass > 2)) or
-      { prevent endless loops }
-       (pass = 4);
-     changed := false;
-   { Setup labeltable, always necessary }
-     blockstart := tai(asml.first);
-     blockend := dfa.pass_1(blockstart);
-   { Blockend now either contains an ait_marker with Kind = mark_AsmBlockStart, }
-   { or nil                                                                }
-     While Assigned(BlockStart) Do
-       Begin
-         if (cs_opt_peephole in current_settings.optimizerswitches) then
-           begin
-            if (pass = 0) then
-              PrePeepHoleOpts(AsmL, BlockStart, BlockEnd);
-              { Peephole optimizations }
-               PeepHoleOptPass1(AsmL, BlockStart, BlockEnd);
-              { Only perform them twice in the first pass }
-               if pass = 0 then
-                 PeepHoleOptPass1(AsmL, BlockStart, BlockEnd);
-           end;
-        { More peephole optimizations }
-         if (cs_opt_peephole in current_settings.optimizerswitches) then
-           begin
-             PeepHoleOptPass2(AsmL, BlockStart, BlockEnd);
-             if lastLoop then
-               PostPeepHoleOpts(AsmL, BlockStart, BlockEnd);
-           end;
-
-        { Free memory }
-        dfa.clear;
-
-        { Continue where we left off, BlockEnd is either the start of an }
-        { assembler block or nil                                         }
-         BlockStart := BlockEnd;
-         While Assigned(BlockStart) And
-               (BlockStart.typ = ait_Marker) And
-               (Tai_Marker(BlockStart).Kind = mark_AsmBlockStart) Do
-           Begin
-           { We stopped at an assembler block, so skip it }
-            Repeat
-              BlockStart := Tai(BlockStart.Next);
-            Until (BlockStart.Typ = Ait_Marker) And
-                  (Tai_Marker(Blockstart).Kind = mark_AsmBlockEnd);
-           { Blockstart now contains a Tai_marker(mark_AsmBlockEnd) }
-             If GetNextInstruction(BlockStart, HP) And
-                ((HP.typ <> ait_Marker) Or
-                 (Tai_Marker(HP).Kind <> mark_AsmBlockStart)) Then
-             { There is no assembler block anymore after the current one, so }
-             { optimize the next block of "normal" instructions              }
-               BlockEnd := dfa.pass_1(blockstart)
-             { Otherwise, skip the next assembler block }
-             else
-               blockStart := hp;
-           End;
-       End;
-     inc(pass);
-  until lastLoop;
-  dfa.free;
-
-End;
-
-End.

compiler/i386/aoptcpub.pas

@@ -0,0 +1,113 @@
+ {
+    Copyright (c) 1998-2004 by Jonas Maebe, member of the Free Pascal
+    Development Team
+
+    This unit contains several types and constants necessary for the
+    optimizer to work on the sparc architecture
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+Unit aoptcpub; { Assembler OPTimizer CPU specific Base }
+
+{$i fpcdefs.inc}
+
+{ enable the following define if memory references can have a scaled index }
+{ define RefsHaveScale}
+
+{ enable the following define if memory references can have a segment }
+{ override                                                            }
+{ define RefsHaveSegment}
+
+Interface
+
+Uses
+  cpubase,aasmcpu,AOptBase;
+
+Type
+
+{ type of a normal instruction }
+  TInstr = Taicpu;
+  PInstr = ^TInstr;
+
+{ ************************************************************************* }
+{ **************************** TCondRegs ********************************** }
+{ ************************************************************************* }
+{ Info about the conditional registers                                      }
+  TCondRegs = Object
+    Constructor Init;
+    Destructor Done;
+  End;
+
+{ ************************************************************************* }
+{ **************************** TAoptBaseCpu ******************************* }
+{ ************************************************************************* }
+
+  TAoptBaseCpu = class(TAoptBase)
+  End;
+
+
+{ ************************************************************************* }
+{ ******************************* Constants ******************************* }
+{ ************************************************************************* }
+Const
+
+{ the maximum number of things (registers, memory, ...) a single instruction }
+{ changes                                                                    }
+
+  MaxCh = 3;
+
+{ the maximum number of operands an instruction has }
+
+  MaxOps = 3;
+
+{Oper index of operand that contains the source (reference) with a load }
+{instruction                                                            }
+
+  LoadSrc = 0;
+
+{Oper index of operand that contains the destination (register) with a load }
+{instruction                                                                }
+
+  LoadDst = 1;
+
+{Oper index of operand that contains the source (register) with a store }
+{instruction                                                            }
+
+  StoreSrc = 0;
+
+{Oper index of operand that contains the destination (reference) with a load }
+{instruction                                                                 }
+
+  StoreDst = 1;
+
+  aopt_uncondjmp = A_JMP;
+  aopt_condjmp = A_Jcc;
+
+Implementation
+
+{ ************************************************************************* }
+{ **************************** TCondRegs ********************************** }
+{ ************************************************************************* }
+Constructor TCondRegs.init;
+Begin
+End;
+
+Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl}
+Begin
+End;
+
+End.

compiler/i386/aoptcpud.pas

@@ -0,0 +1,36 @@
+{
+    Copyright (c) 1998-2004 by Jonas Maebe, member of the Free Pascal
+    Development Team
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+Unit aoptcpud;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      aoptda;
+
+    type
+      TAOptDFACpu = class(TAOptDFA)
+      end;
+
+  implementation
+
+end.

compiler/i386/cgcpu.pas

@@ -209,7 +209,11 @@ unit cgcpu;
               end
           end
         else
-          inherited a_load_ref_cgpara(list,size,r,cgpara);
+          begin
+            href:=r;
+            make_simple_ref(list,href);
+            inherited a_load_ref_cgpara(list,size,href,cgpara);
+          end;
       end;
 
 
@@ -217,9 +221,15 @@ unit cgcpu;
       var
         tmpreg : tregister;
         opsize : topsize;
-        tmpref : treference;
+        tmpref,dirref : treference;
       begin
-        with r do
+        dirref:=r;
+
+        { this could probably done in a more optimized way, but for now this
+          is sufficent }
+        make_direct_ref(list,dirref);
+
+        with dirref do
           begin
             if use_push(cgpara) then
               begin
@@ -230,11 +240,11 @@ unit cgcpu;
                     if assigned(symbol) then
                       begin
                         if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and
-                           ((r.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or
+                           ((dirref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or
                             (cs_create_pic in current_settings.moduleswitches)) then
                           begin
                             tmpreg:=getaddressregister(list);
-                            a_loadaddr_ref_reg(list,r,tmpreg);
+                            a_loadaddr_ref_reg(list,dirref,tmpreg);
                             list.concat(taicpu.op_reg(A_PUSH,opsize,tmpreg));
                           end
                         else if cs_create_pic in current_settings.moduleswitches then
@@ -242,12 +252,12 @@ unit cgcpu;
                             if offset<>0 then
                               begin
                                 tmpreg:=getaddressregister(list);
-                                a_loadaddr_ref_reg(list,r,tmpreg);
+                                a_loadaddr_ref_reg(list,dirref,tmpreg);
                                 list.concat(taicpu.op_reg(A_PUSH,opsize,tmpreg));
                               end
                             else
                               begin
-                                reference_reset_symbol(tmpref,r.symbol,0,r.alignment);
+                                reference_reset_symbol(tmpref,dirref.symbol,0,dirref.alignment);
                                 tmpref.refaddr:=addr_pic;
                                 tmpref.base:=current_procinfo.got;
 {$ifdef EXTDEBUG}
@@ -273,12 +283,12 @@ unit cgcpu;
                 else
                   begin
                     tmpreg:=getaddressregister(list);
-                    a_loadaddr_ref_reg(list,r,tmpreg);
+                    a_loadaddr_ref_reg(list,dirref,tmpreg);
                     list.concat(taicpu.op_reg(A_PUSH,opsize,tmpreg));
                   end;
               end
             else
-              inherited a_loadaddr_ref_cgpara(list,r,cgpara);
+              inherited a_loadaddr_ref_cgpara(list,dirref,cgpara);
           end;
       end;
 
@@ -630,9 +640,13 @@ unit cgcpu;
             get_64bit_ops(op,op1,op2);
             tempref:=ref;
             tcgx86(cg).make_simple_ref(list,tempref);
+            if op in [OP_ADD,OP_SUB] then
+              cg.a_reg_alloc(list,NR_DEFAULTFLAGS);
             list.concat(taicpu.op_ref_reg(op1,S_L,tempref,reg.reglo));
             inc(tempref.offset,4);
             list.concat(taicpu.op_ref_reg(op2,S_L,tempref,reg.reghi));
+            if op in [OP_ADD,OP_SUB] then
+              cg.a_reg_dealloc(list,NR_DEFAULTFLAGS);
           end
         else
           begin
@@ -652,8 +666,10 @@ unit cgcpu;
               if (regsrc.reglo<>regdst.reglo) then
                 a_load64_reg_reg(list,regsrc,regdst);
               list.concat(taicpu.op_reg(A_NOT,S_L,regdst.reghi));
+              cg.a_reg_alloc(list,NR_DEFAULTFLAGS);
               list.concat(taicpu.op_reg(A_NEG,S_L,regdst.reglo));
               list.concat(taicpu.op_const_reg(A_SBB,S_L,-1,regdst.reghi));
+              cg.a_reg_dealloc(list,NR_DEFAULTFLAGS);
               exit;
             end;
           OP_NOT :
@@ -666,8 +682,12 @@ unit cgcpu;
             end;
         end;
         get_64bit_ops(op,op1,op2);
+        if op in [OP_ADD,OP_SUB] then
+          cg.a_reg_alloc(list,NR_DEFAULTFLAGS);
         list.concat(taicpu.op_reg_reg(op1,S_L,regsrc.reglo,regdst.reglo));
         list.concat(taicpu.op_reg_reg(op2,S_L,regsrc.reghi,regdst.reghi));
+        if op in [OP_ADD,OP_SUB] then
+          cg.a_reg_dealloc(list,NR_DEFAULTFLAGS);
       end;
 
 
@@ -685,8 +705,10 @@ unit cgcpu;
             begin
               // can't use a_op_const_ref because this may use dec/inc
               get_64bit_ops(op,op1,op2);
+              cg.a_reg_alloc(list,NR_DEFAULTFLAGS);
               list.concat(taicpu.op_const_reg(op1,S_L,aint(lo(value)),reg.reglo));
               list.concat(taicpu.op_const_reg(op2,S_L,aint(hi(value)),reg.reghi));
+              cg.a_reg_dealloc(list,NR_DEFAULTFLAGS);
             end;
           else
             internalerror(200204021);
@@ -712,9 +734,11 @@ unit cgcpu;
             begin
               get_64bit_ops(op,op1,op2);
               // can't use a_op_const_ref because this may use dec/inc
+              cg.a_reg_alloc(list,NR_DEFAULTFLAGS);
               list.concat(taicpu.op_const_ref(op1,S_L,aint(lo(value)),tempref));
               inc(tempref.offset,4);
               list.concat(taicpu.op_const_ref(op2,S_L,aint(hi(value)),tempref));
+              cg.a_reg_dealloc(list,NR_DEFAULTFLAGS);
             end;
           else
             internalerror(200204022);

compiler/i386/cpuinfo.pas

@@ -45,6 +45,7 @@ Type
    tcputype =
       (cpu_none,
        cpu_386,
+       cpu_486,
        cpu_Pentium,
        cpu_Pentium2,
        cpu_Pentium3,
@@ -110,6 +111,7 @@ Const
 
    cputypestr : array[tcputype] of string[10] = ('',
      '80386',
+     '80486',
      'PENTIUM',
      'PENTIUM2',
      'PENTIUM3',
@@ -173,6 +175,7 @@ type
    cpu_capabilities : array[tcputype] of set of tcpuflags = (
      { cpu_none      } [],
      { cpu_386       } [],
+     { cpu_486       } [],
      { cpu_Pentium   } [],
      { cpu_Pentium2  } [CPUX86_HAS_CMOV],
      { cpu_Pentium3  } [CPUX86_HAS_CMOV,CPUX86_HAS_SSEUNIT],

compiler/i386/daopt386.pas

@@ -1,2806 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Jonas Maebe, member of the Freepascal
-      development team
-
-    This unit contains the data flow analyzer and several helper procedures
-    and functions.
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    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.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit daopt386;
-
-{$i fpcdefs.inc}
-
-interface
-
-uses
-  globtype,
-  cclasses,aasmbase,aasmtai,aasmdata,aasmcpu,cgbase,cgutils,
-  cpubase;
-
-{******************************* Constants *******************************}
-
-const
-
-{ Possible register content types }
-  con_Unknown = 0;
-  con_ref = 1;
-  con_const = 2;
-  { The contents aren't usable anymore for CSE, but they may still be   }
-  { useful for detecting whether the result of a load is actually used }
-  con_invalid = 3;
-  { the reverse of the above (in case a (conditional) jump is encountered): }
-  { CSE is still possible, but the original instruction can't be removed    }
-  con_noRemoveRef = 4;
-  { same, but for constants }
-  con_noRemoveConst = 5;
-
-
-const
-  topsize2tcgsize: array[topsize] of tcgsize = (OS_NO,
-    OS_8,OS_16,OS_32,OS_64,OS_16,OS_32,OS_32,
-    OS_16,OS_32,OS_64,
-    OS_F32,OS_F64,OS_F80,OS_C64,OS_F128,
-    OS_M32,
-    OS_ADDR,OS_NO,OS_NO,
-    OS_NO,
-    OS_NO,
-    OS_NO);
-
-
-
-{********************************* Types *********************************}
-
-type
-  TRegEnum = RS_EAX..RS_ESP;
-  TRegArray = Array[TRegEnum] of tsuperregister;
-  TRegSet = Set of TRegEnum;
-  toptreginfo = Record
-                NewRegsEncountered, OldRegsEncountered: TRegSet;
-                RegsLoadedForRef: TRegSet;
-                lastReload: array[RS_EAX..RS_ESP] of tai;
-                New2OldReg: TRegArray;
-              end;
-
-{possible actions on an operand: read, write or modify (= read & write)}
-  TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown);
-
-{the possible states of a flag}
-  TFlagContents = (F_Unknown, F_notSet, F_Set);
-
-  TContent = Packed Record
-      {start and end of block instructions that defines the
-       content of this register.}
-               StartMod: tai;
-               MemWrite: taicpu;
-      {how many instructions starting with StarMod does the block consist of}
-               NrOfMods: Word;
-      {the type of the content of the register: unknown, memory, constant}
-               Typ: Byte;
-               case byte of
-      {starts at 0, gets increased everytime the register is written to}
-                 1: (WState: Byte;
-      {starts at 0, gets increased everytime the register is read from}
-                       RState: Byte);
-      { to compare both states in one operation }
-                 2: (state: word);
-             end;
-
-{Contents of the integer registers}
-  TRegContent = Array[RS_EAX..RS_ESP] Of TContent;
-
-{contents of the FPU registers}
-//  TRegFPUContent = Array[RS_ST..RS_ST7] Of TContent;
-
-{$ifdef tempOpts}
-{ linked list which allows searching/deleting based on value, no extra frills}
-  PSearchLinkedListItem = ^TSearchLinkedListItem;
-  TSearchLinkedListItem = object(TLinkedList_Item)
-    constructor init;
-    function equals(p: PSearchLinkedListItem): boolean; virtual;
-  end;
-
-  PSearchDoubleIntItem = ^TSearchDoubleInttem;
-  TSearchDoubleIntItem = object(TLinkedList_Item)
-    constructor init(_int1,_int2: longint);
-    function equals(p: PSearchLinkedListItem): boolean; virtual;
-   private
-    int1, int2: longint;
-  end;
-
-  PSearchLinkedList = ^TSearchLinkedList;
-  TSearchLinkedList = object(TLinkedList)
-    function searchByValue(p: PSearchLinkedListItem): boolean;
-    procedure removeByValue(p: PSearchLinkedListItem);
-  end;
-{$endif tempOpts}
-
-{information record with the contents of every register. Every tai object
- gets one of these assigned: a pointer to it is stored in the OptInfo field}
-  TtaiProp = Record
-               Regs: TRegContent;
-{               FPURegs: TRegFPUContent;} {currently not yet used}
-    { allocated Registers }
-               UsedRegs: TRegSet;
-    { status of the direction flag }
-               DirFlag: TFlagContents;
-{$ifdef tempOpts}
-    { currently used temps }
-               tempAllocs: PSearchLinkedList;
-{$endif tempOpts}
-    { can this instruction be removed? }
-               CanBeRemoved: Boolean;
-               { are the resultflags set by this instruction used? }
-               FlagsUsed: Boolean;
-             end;
-
-  ptaiprop = ^TtaiProp;
-
-  TtaiPropBlock = Array[1..250000] Of TtaiProp;
-  PtaiPropBlock = ^TtaiPropBlock;
-
-  TInstrSinceLastMod = Array[RS_EAX..RS_ESP] Of Word;
-
-  TLabelTableItem = Record
-                      taiObj: tai;
-{$ifDef JumpAnal}
-                      InstrNr: Longint;
-                      RefsFound: Word;
-                      JmpsProcessed: Word
-{$endif JumpAnal}
-                    end;
-  TLabelTable = Array[0..2500000] Of TLabelTableItem;
-  PLabelTable = ^TLabelTable;
-
-
-{*********************** procedures and functions ************************}
-
-procedure InsertLLItem(AsmL: TAsmList; prev, foll, new_one: TLinkedListItem);
-
-function isgp32reg(supreg: tsuperregister): Boolean;
-function reginref(supreg: tsuperregister; const ref: treference): boolean;
-function RegReadByInstruction(supreg: tsuperregister; hp: tai): boolean;
-function RegModifiedByInstruction(supreg: tsuperregister; p1: tai): boolean;
-function RegInInstruction(supreg: tsuperregister; p1: tai): boolean;
-function reginop(supreg: tsuperregister; const o:toper): boolean;
-function instrWritesFlags(p: tai): boolean;
-function instrReadsFlags(p: tai): boolean;
-
-function writeToMemDestroysContents(regWritten: tsuperregister; const ref: treference;
-  supreg: tsuperregister; size: tcgsize; const c: tcontent; var invalsmemwrite: boolean): boolean;
-function writeToRegDestroysContents(destReg, supreg: tsuperregister;
-  const c: tcontent): boolean;
-function writeDestroysContents(const op: toper; supreg: tsuperregister; size: tcgsize;
-  const c: tcontent; var memwritedestroyed: boolean): boolean;
-
-function sequenceDependsonReg(const Content: TContent; seqreg: tsuperregister; supreg: tsuperregister): Boolean;
-
-function GetNextInstruction(Current: tai; var Next: tai): Boolean;
-function GetLastInstruction(Current: tai; var Last: tai): Boolean;
-procedure SkipHead(var p: tai);
-function labelCanBeSkipped(p: tai_label): boolean;
-
-procedure RemoveLastDeallocForFuncRes(asmL: TAsmList; p: tai);
-function regLoadedWithNewValue(supreg: tsuperregister; canDependOnPrevValue: boolean;
-           hp: tai): boolean;
-procedure UpdateUsedRegs(var UsedRegs: TRegSet; p: tai);
-procedure AllocRegBetween(asml: TAsmList; reg: tregister; p1, p2: tai; var initialusedregs: tregset);
-function FindRegDealloc(supreg: tsuperregister; p: tai): boolean;
-
-function InstructionsEquivalent(p1, p2: tai; var RegInfo: toptreginfo): Boolean;
-function sizescompatible(loadsize,newsize: topsize): boolean;
-function OpsEqual(const o1,o2:toper): Boolean;
-
-
-type
-  tdfaobj = class
-    constructor create(_list: TAsmList); virtual;
-
-    function pass_1(_blockstart: tai): tai;
-    function pass_generate_code: boolean;
-    procedure clear;
-
-    function getlabelwithsym(sym: tasmlabel): tai;
-
-   private
-    { asm list we're working on }
-    list: TAsmList;
-
-    { current part of the asm list }
-    blockstart, blockend: tai;
-
-    { the amount of taiObjects in the current part of the assembler list }
-    nroftaiobjs: longint;
-
-    { Array which holds all TtaiProps }
-    taipropblock: ptaipropblock;
-
-    { all labels in the current block: their value mapped to their location }
-    lolab, hilab, labdif: longint;
-    labeltable: plabeltable;
-
-    { Walks through the list to find the lowest and highest label number, inits the }
-    { labeltable and fixes/optimizes some regallocs                                 }
-     procedure initlabeltable;
-
-    function initdfapass2: boolean;
-    procedure dodfapass2;
-  end;
-
-
-function FindLabel(L: tasmlabel; var hp: tai): Boolean;
-
-procedure incState(var S: Byte; amount: longint);
-
-{******************************* Variables *******************************}
-
-var
-  dfa: tdfaobj;
-
-{*********************** end of Interface section ************************}
-
-
-Implementation
-
-Uses
-{$ifdef csdebug}
-  cutils,
-{$else}
-  {$ifdef statedebug}
-    cutils,
-  {$else}
-    {$ifdef allocregdebug}
-      cutils,
-    {$endif}
-  {$endif}
-{$endif}
-  globals, systems, verbose, symconst, cgobj, procinfo,
-  aoptx86;
-
-Type
-  TRefCompare = function(const r1, r2: treference; size1, size2: tcgsize): boolean;
-
-var
- {How many instructions are between the current instruction and the last one
-  that modified the register}
-  NrOfInstrSinceLastMod: TInstrSinceLastMod;
-
-{$ifdef tempOpts}
-  constructor TSearchLinkedListItem.init;
-  begin
-  end;
-
-  function TSearchLinkedListItem.equals(p: PSearchLinkedListItem): boolean;
-  begin
-    equals := false;
-  end;
-
-  constructor TSearchDoubleIntItem.init(_int1,_int2: longint);
-  begin
-    int1 := _int1;
-    int2 := _int2;
-  end;
-
-  function TSearchDoubleIntItem.equals(p: PSearchLinkedListItem): boolean;
-  begin
-    equals := (TSearchDoubleIntItem(p).int1 = int1) and
-              (TSearchDoubleIntItem(p).int2 = int2);
-  end;
-
-  function TSearchLinkedList.FindByValue(p: PSearchLinkedListItem): boolean;
-  var temp: PSearchLinkedListItem;
-  begin
-    temp := first;
-    while (temp <> last.next) and
-          not(temp.equals(p)) do
-      temp := temp.next;
-    searchByValue := temp <> last.next;
-  end;
-
-  procedure TSearchLinkedList.removeByValue(p: PSearchLinkedListItem);
-  begin
-    temp := first;
-    while (temp <> last.next) and
-          not(temp.equals(p)) do
-      temp := temp.next;
-    if temp <> last.next then
-      begin
-        remove(temp);
-        dispose(temp,done);
-      end;
-  end;
-
-procedure updateTempAllocs(var UsedRegs: TRegSet; p: tai);
-{updates UsedRegs with the RegAlloc Information coming after p}
-begin
-  repeat
-    while assigned(p) and
-          ((p.typ in (SkipInstr - [ait_RegAlloc])) or
-           ((p.typ = ait_label) and
-            labelCanBeSkipped(tai_label(current)))) Do
-         p := tai(p.next);
-    while assigned(p) and
-          (p.typ=ait_RegAlloc) Do
-      begin
-        case tai_regalloc(p).ratype of
-          ra_alloc :
-            Include(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg)));
-          ra_dealloc :
-            Exclude(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg)));
-        end;
-        p := tai(p.next);
-      end;
-  until not(assigned(p)) or
-        (not(p.typ in SkipInstr) and
-         not((p.typ = ait_label) and
-             labelCanBeSkipped(tai_label(current))));
-end;
-
-{$endif tempOpts}
-
-{************************ Create the Label table ************************}
-
-function findregalloc(supreg: tsuperregister; starttai: tai; ratyp: tregalloctype): boolean;
-{ Returns true if a ait_alloc object for reg is found in the block of tai's }
-{ starting with Starttai and ending with the next "real" instruction        }
-begin
-  findregalloc := false;
-  repeat
-    while assigned(starttai) and
-          ((starttai.typ in (skipinstr - [ait_regalloc])) or
-           ((starttai.typ = ait_label) and
-            labelcanbeskipped(tai_label(starttai)))) do
-      starttai := tai(starttai.next);
-    if assigned(starttai) and
-       (starttai.typ = ait_regalloc) then
-      begin
-        if (tai_regalloc(Starttai).ratype = ratyp) and
-           (getsupreg(tai_regalloc(Starttai).reg) = supreg) then
-          begin
-            findregalloc:=true;
-            break;
-          end;
-        starttai := tai(starttai.next);
-      end
-    else
-      break;
-  until false;
-end;
-
-procedure RemoveLastDeallocForFuncRes(asml: TAsmList; p: tai);
-
-  procedure DoRemoveLastDeallocForFuncRes(asml: TAsmList; supreg: tsuperregister);
-  var
-    hp2: tai;
-  begin
-    hp2 := p;
-    repeat
-      hp2 := tai(hp2.previous);
-      if assigned(hp2) and
-         (hp2.typ = ait_regalloc) and
-         (tai_regalloc(hp2).ratype=ra_dealloc) and
-         (getregtype(tai_regalloc(hp2).reg) = R_INTREGISTER) and
-         (getsupreg(tai_regalloc(hp2).reg) = supreg) then
-        begin
-          asml.remove(hp2);
-          hp2.free;
-          break;
-        end;
-    until not(assigned(hp2)) or regInInstruction(supreg,hp2);
-  end;
-
-begin
-    case current_procinfo.procdef.returndef.typ of
-      arraydef,recorddef,pointerdef,
-         stringdef,enumdef,procdef,objectdef,errordef,
-         filedef,setdef,procvardef,
-         classrefdef,forwarddef:
-        DoRemoveLastDeallocForFuncRes(asml,RS_EAX);
-      orddef:
-        if current_procinfo.procdef.returndef.size <> 0 then
-          begin
-            DoRemoveLastDeallocForFuncRes(asml,RS_EAX);
-            { for int64/qword }
-            if current_procinfo.procdef.returndef.size = 8 then
-              DoRemoveLastDeallocForFuncRes(asml,RS_EDX);
-          end;
-    end;
-end;
-
-procedure getNoDeallocRegs(var regs: tregset);
-var
-  regCounter: TSuperRegister;
-begin
-  regs := [];
-  case current_procinfo.procdef.returndef.typ of
-    arraydef,recorddef,pointerdef,
-       stringdef,enumdef,procdef,objectdef,errordef,
-       filedef,setdef,procvardef,
-       classrefdef,forwarddef:
-     regs := [RS_EAX];
-    orddef:
-      if current_procinfo.procdef.returndef.size <> 0 then
-        begin
-          regs := [RS_EAX];
-          { for int64/qword }
-          if current_procinfo.procdef.returndef.size = 8 then
-            regs := regs + [RS_EDX];
-        end;
-  end;
-  for regCounter := RS_EAX to RS_EBX do
-{    if not(regCounter in rg.usableregsint) then}
-      include(regs,regcounter);
-end;
-
-
-procedure AddRegDeallocFor(asml: TAsmList; reg: tregister; p: tai);
-var
-  hp1: tai;
-  funcResRegs: tregset;
-{  funcResReg: boolean;}
-begin
-{ if not(supreg in rg.usableregsint) then
-    exit;}
-{ if not(supreg in [RS_EDI]) then
-    exit;}
-  getNoDeallocRegs(funcresregs);
-{  funcResRegs := funcResRegs - rg.usableregsint;}
-{  funcResRegs := funcResRegs - [RS_EDI];}
-{  funcResRegs := funcResRegs - [RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI]; }
-{  funcResReg := getsupreg(reg) in funcresregs;}
-
-  hp1 := p;
-{
-
-
-  while not(funcResReg and
-            (p.typ = ait_instruction) and
-            (taicpu(p).opcode = A_JMP) and
-            (tasmlabel(taicpu(p).oper[0]^.sym) = aktexit2label)) and
-        getLastInstruction(p, p) and
-        not(regInInstruction(supreg, p)) do
-    hp1 := p;
-}
-  { don't insert a dealloc for registers which contain the function result }
-  { if they are followed by a jump to the exit label (for exit(...))       }
-{  if not(funcResReg) or
-     not((hp1.typ = ait_instruction) and
-         (taicpu(hp1).opcode = A_JMP) and
-         (tasmlabel(taicpu(hp1).oper[0]^.sym) = aktexit2label)) then }
-    begin
-      p := tai_regalloc.deAlloc(reg,nil);
-      insertLLItem(AsmL, hp1.previous, hp1, p);
-    end;
-end;
-
-
-
-{************************ Search the Label table ************************}
-
-function findlabel(l: tasmlabel; var hp: tai): boolean;
-
-{searches for the specified label starting from hp as long as the
- encountered instructions are labels, to be able to optimize constructs like
-
- jne l2              jmp l2
- jmp l3     and      l1:
- l1:                 l2:
- l2:}
-
-var
-  p: tai;
-
-begin
-  p := hp;
-  while assigned(p) and
-       (p.typ in SkipInstr + [ait_label,ait_align]) Do
-    if (p.typ <> ait_Label) or
-       (tai_label(p).labsym <> l) then
-      GetNextInstruction(p, p)
-    else
-       begin
-          hp := p;
-          findlabel := true;
-          exit
-        end;
-  findlabel := false;
-end;
-
-{************************ Some general functions ************************}
-
-function tch2reg(ch: tinschange): tsuperregister;
-{converts a TChange variable to a TRegister}
-const
-  ch2reg: array[CH_REAX..CH_REDI] of tsuperregister = (RS_EAX,RS_ECX,RS_EDX,RS_EBX,RS_ESP,RS_EBP,RS_ESI,RS_EDI);
-begin
-  if (ch <= CH_REDI) then
-    tch2reg := ch2reg[ch]
-  else if (ch <= CH_WEDI) then
-    tch2reg := ch2reg[tinschange(ord(ch) - ord(CH_REDI))]
-  else if (ch <= CH_RWEDI) then
-    tch2reg := ch2reg[tinschange(ord(ch) - ord(CH_WEDI))]
-  else if (ch <= CH_MEDI) then
-    tch2reg := ch2reg[tinschange(ord(ch) - ord(CH_RWEDI))]
-  else
-    InternalError($db)
-end;
-
-
-{ inserts new_one between prev and foll }
-
-procedure InsertLLItem(AsmL: TAsmList; prev, foll, new_one: TLinkedListItem);
-begin
-  if assigned(prev) then
-    if assigned(foll) then
-      begin
-        if assigned(new_one) then
-          begin
-            new_one.previous := prev;
-            new_one.next := foll;
-            prev.next := new_one;
-            foll.previous := new_one;
-            { shgould we update line information }
-            if (not (tai(new_one).typ in SkipLineInfo)) and
-               (not (tai(foll).typ in SkipLineInfo)) then
-            tailineinfo(new_one).fileinfo := tailineinfo(foll).fileinfo;
-          end;
-      end
-    else
-      asml.Concat(new_one)
-  else
-    if assigned(foll) then
-      asml.Insert(new_one)
-end;
-
-{********************* Compare parts of tai objects *********************}
-
-function regssamesize(reg1, reg2: tregister): boolean;
-{returns true if Reg1 and Reg2 are of the same size (so if they're both
- 8bit, 16bit or 32bit)}
-begin
-  if (reg1 = NR_NO) or (reg2 = NR_NO) then
-    internalerror(2003111602);
-  regssamesize := getsubreg(reg1) = getsubreg(reg2);
-end;
-
-
-procedure AddReg2RegInfo(OldReg, NewReg: TRegister; var RegInfo: toptreginfo);
-{updates the ???RegsEncountered and ???2???reg fields of RegInfo. Assumes that
- OldReg and NewReg have the same size (has to be chcked in advance with
- RegsSameSize) and that neither equals RS_INVALID}
-var
-  newsupreg, oldsupreg: tsuperregister;
-begin
-  if (newreg = NR_NO) or (oldreg = NR_NO) then
-    internalerror(2003111601);
-  newsupreg := getsupreg(newreg);
-  oldsupreg := getsupreg(oldreg);
-  with RegInfo Do
-    begin
-      NewRegsEncountered := NewRegsEncountered + [newsupreg];
-      OldRegsEncountered := OldRegsEncountered + [oldsupreg];
-      New2OldReg[newsupreg] := oldsupreg;
-    end;
-end;
-
-
-procedure AddOp2RegInfo(const o:toper; var reginfo: toptreginfo);
-begin
-  case o.typ Of
-    top_reg:
-      if (o.reg <> NR_NO) then
-        AddReg2RegInfo(o.reg, o.reg, RegInfo);
-    top_ref:
-      begin
-        if o.ref^.base <> NR_NO then
-          AddReg2RegInfo(o.ref^.base, o.ref^.base, RegInfo);
-        if o.ref^.index <> NR_NO then
-          AddReg2RegInfo(o.ref^.index, o.ref^.index, RegInfo);
-      end;
-  end;
-end;
-
-
-function RegsEquivalent(oldreg, newreg: tregister; const oldinst, newinst: taicpu; var reginfo: toptreginfo; opact: topaction): Boolean;
-begin
-  if not((oldreg = NR_NO) or (newreg = NR_NO)) then
-    if RegsSameSize(oldreg, newreg) then
-      with reginfo do
-{here we always check for the 32 bit component, because it is possible that
- the 8 bit component has not been set, event though NewReg already has been
- processed. This happens if it has been compared with a register that doesn't
- have an 8 bit component (such as EDI). in that case the 8 bit component is
- still set to RS_NO and the comparison in the else-part will fail}
-        if (getsupreg(oldReg) in OldRegsEncountered) then
-          if (getsupreg(NewReg) in NewRegsEncountered) then
-            RegsEquivalent := (getsupreg(oldreg) = New2OldReg[getsupreg(newreg)])
-
- { if we haven't encountered the new register yet, but we have encountered the
-   old one already, the new one can only be correct if it's being written to
-   (and consequently the old one is also being written to), otherwise
-
-   movl -8(%ebp), %eax        and         movl -8(%ebp), %eax
-   movl (%eax), %eax                      movl (%edx), %edx
-
-   are considered equivalent}
-
-          else
-            if (opact = opact_write) then
-              begin
-                AddReg2RegInfo(oldreg, newreg, reginfo);
-                RegsEquivalent := true
-              end
-            else
-              Regsequivalent := false
-        else
-           if not(getsupreg(newreg) in NewRegsEncountered) and
-              ((opact = opact_write) or
-               ((newreg = oldreg) and
-                (ptaiprop(oldinst.optinfo)^.regs[getsupreg(oldreg)].wstate =
-                 ptaiprop(newinst.optinfo)^.regs[getsupreg(oldreg)].wstate) and
-                not(regmodifiedbyinstruction(getsupreg(oldreg),oldinst)))) then
-             begin
-               AddReg2RegInfo(oldreg, newreg, reginfo);
-               RegsEquivalent := true
-             end
-           else
-             RegsEquivalent := false
-    else
-      RegsEquivalent := false
-  else
-    RegsEquivalent := oldreg = newreg
-end;
-
-
-function RefsEquivalent(const r1, r2: treference; const oldinst, newinst: taicpu; var regInfo: toptreginfo): boolean;
-begin
-  RefsEquivalent :=
-    (r1.offset = r2.offset) and
-    RegsEquivalent(r1.base, r2.base, oldinst, newinst, reginfo, OpAct_Read) and
-    RegsEquivalent(r1.index, r2.index, oldinst, newinst, reginfo, OpAct_Read) and
-    (r1.segment = r2.segment) and (r1.scalefactor = r2.scalefactor) and
-    (r1.symbol = r2.symbol) and (r1.refaddr = r2.refaddr) and
-    (r1.relsymbol = r2.relsymbol);
-end;
-
-
-{$push}
-{$q-}
-
-// checks whether a write to r2 of size "size" contains address r1
-function refsoverlapping(const r1, r2: treference; size1, size2: tcgsize): boolean;
-var
-  realsize1, realsize2: aint;
-begin
-  realsize1 := tcgsize2size[size1];
-  realsize2 := tcgsize2size[size2];
-  refsoverlapping :=
-    (r2.offset <= r1.offset+realsize1) and
-    (r1.offset <= r2.offset+realsize2) and
-    (r1.segment = r2.segment) and (r1.base = r2.base) and
-    (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and
-    (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and
-    (r1.relsymbol = r2.relsymbol);
-end;
-
-{$pop}
-
-
-function isgp32reg(supreg: tsuperregister): boolean;
-{Checks if the register is a 32 bit general purpose register}
-begin
-  isgp32reg := false;
-{$push}{$warnings off}
-  if (supreg >= RS_EAX) and (supreg <= RS_EBX) then
-    isgp32reg := true
-{$pop}
-end;
-
-
-function reginref(supreg: tsuperregister; const ref: treference): boolean;
-begin {checks whether ref contains a reference to reg}
-  reginref :=
-     ((ref.base <> NR_NO) and
-      (getsupreg(ref.base) = supreg)) or
-     ((ref.index <> NR_NO) and
-      (getsupreg(ref.index) = supreg))
-end;
-
-
-function RegReadByInstruction(supreg: tsuperregister; hp: tai): boolean;
-var
-  p: taicpu;
-  opcount: longint;
-begin
-  RegReadByInstruction := false;
-  if hp.typ <> ait_instruction then
-    exit;
-  p := taicpu(hp);
-  case p.opcode of
-    A_CALL:
-      regreadbyinstruction := true;
-    A_IMUL:
-      case p.ops of
-        1:
-          regReadByInstruction :=
-             (supreg = RS_EAX) or reginop(supreg,p.oper[0]^);
-        2,3:
-          regReadByInstruction :=
-            reginop(supreg,p.oper[0]^) or
-            reginop(supreg,p.oper[1]^);
-      end;
-    A_IDIV,A_DIV,A_MUL:
-      begin
-        regReadByInstruction :=
-          reginop(supreg,p.oper[0]^) or (supreg in [RS_EAX,RS_EDX]);
-      end;
-    else
-      begin
-        for opcount := 0 to p.ops-1 do
-          if (p.oper[opCount]^.typ = top_ref) and
-             reginref(supreg,p.oper[opcount]^.ref^) then
-            begin
-              RegReadByInstruction := true;
-              exit
-            end;
-        for opcount := 1 to maxinschanges do
-          case insprop[p.opcode].ch[opcount] of
-            CH_REAX..CH_REDI,CH_RWEAX..CH_MEDI:
-              if supreg = tch2reg(insprop[p.opcode].ch[opcount]) then
-                begin
-                  RegReadByInstruction := true;
-                  exit
-                end;
-            CH_RWOP1,CH_ROP1,CH_MOP1:
-              if //(p.oper[0]^.typ = top_reg) and
-                 reginop(supreg,p.oper[0]^) then
-                begin
-                  RegReadByInstruction := true;
-                  exit
-                end;
-            Ch_RWOP2,Ch_ROP2,Ch_MOP2:
-              if //(p.oper[1]^.typ = top_reg) and
-                 reginop(supreg,p.oper[1]^) then
-                begin
-                  RegReadByInstruction := true;
-                  exit
-                end;
-            Ch_RWOP3,Ch_ROP3,Ch_MOP3:
-              if //(p.oper[2]^.typ = top_reg) and
-                 reginop(supreg,p.oper[2]^) then
-                begin
-                  RegReadByInstruction := true;
-                  exit
-                end;
-          end;
-      end;
-  end;
-end;
-
-
-function regInInstruction(supreg: tsuperregister; p1: tai): boolean;
-{ Checks if reg is used by the instruction p1                              }
-{ Difference with "regReadBysinstruction() or regModifiedByInstruction()": }
-{ this one ignores CH_ALL opcodes, while regModifiedByInstruction doesn't  }
-var
-  p: taicpu;
-  opcount: longint;
-begin
-  regInInstruction := false;
-  if p1.typ <> ait_instruction then
-    exit;
-  p := taicpu(p1);
-  case p.opcode of
-    A_CALL:
-      regininstruction := true;
-    A_IMUL:
-      case p.ops of
-        1:
-          regInInstruction :=
-            (supreg = RS_EAX) or reginop(supreg,p.oper[0]^);
-        2,3:
-          regInInstruction :=
-            reginop(supreg,p.oper[0]^) or
-            reginop(supreg,p.oper[1]^) or
-            (assigned(p.oper[2]) and
-             reginop(supreg,p.oper[2]^));
-      end;
-    A_IDIV,A_DIV,A_MUL:
-      regInInstruction :=
-        reginop(supreg,p.oper[0]^) or
-         (supreg in [RS_EAX,RS_EDX])
-    else
-      begin
-        for opcount := 0 to p.ops-1 do
-          if (p.oper[opCount]^.typ = top_ref) and
-             reginref(supreg,p.oper[opcount]^.ref^) then
-            begin
-              regInInstruction := true;
-              exit
-            end;
-        for opcount := 1 to maxinschanges do
-          case insprop[p.opcode].Ch[opCount] of
-            CH_REAX..CH_MEDI:
-              if tch2reg(InsProp[p.opcode].Ch[opCount]) = supreg then
-                begin
-                  regInInstruction := true;
-                  exit;
-                end;
-            CH_ROp1..CH_MOp1:
-              if reginop(supreg,p.oper[0]^) then
-                begin
-                  regInInstruction := true;
-                  exit
-                end;
-            Ch_ROp2..Ch_MOp2:
-              if reginop(supreg,p.oper[1]^) then
-                begin
-                  regInInstruction := true;
-                  exit
-                end;
-            Ch_ROp3..Ch_MOp3:
-              if reginop(supreg,p.oper[2]^) then
-                begin
-                  regInInstruction := true;
-                  exit
-                end;
-          end;
-      end;
-  end;
-end;
-
-
-function reginop(supreg: tsuperregister; const o:toper): boolean;
-begin
-  reginop := false;
-  case o.typ Of
-    top_reg:
-      reginop :=
-        (getregtype(o.reg) = R_INTREGISTER) and
-        (supreg = getsupreg(o.reg));
-    top_ref:
-      reginop :=
-        ((o.ref^.base <> NR_NO) and
-         (supreg = getsupreg(o.ref^.base))) or
-        ((o.ref^.index <> NR_NO) and
-         (supreg = getsupreg(o.ref^.index)));
-  end;
-end;
-
-
-function RegModifiedByInstruction(supreg: tsuperregister; p1: tai): boolean;
-var
-  InstrProp: TInsProp;
-  TmpResult: Boolean;
-  Cnt: Word;
-begin
-  TmpResult := False;
-  Result := False;
-  if supreg = RS_INVALID then
-    exit;
-  if (p1.typ = ait_instruction) then
-    case taicpu(p1).opcode of
-      A_IMUL:
-        With taicpu(p1) Do
-          TmpResult :=
-            ((ops = 1) and (supreg in [RS_EAX,RS_EDX])) or
-            ((ops = 2) and (getsupreg(oper[1]^.reg) = supreg)) or
-            ((ops = 3) and (getsupreg(oper[2]^.reg) = supreg));
-      A_DIV, A_IDIV, A_MUL:
-        With taicpu(p1) Do
-          TmpResult :=
-            (supreg in [RS_EAX,RS_EDX]);
-      else
-        begin
-          Cnt := 1;
-          InstrProp := InsProp[taicpu(p1).OpCode];
-          while (Cnt <= maxinschanges) and
-                (InstrProp.Ch[Cnt] <> Ch_None) and
-                not(TmpResult) Do
-            begin
-              case InstrProp.Ch[Cnt] Of
-                Ch_WEAX..Ch_MEDI:
-                  TmpResult := supreg = tch2reg(InstrProp.Ch[Cnt]);
-                Ch_RWOp1,Ch_WOp1,Ch_Mop1:
-                  TmpResult := (taicpu(p1).oper[0]^.typ = top_reg) and
-                               reginop(supreg,taicpu(p1).oper[0]^);
-                Ch_RWOp2,Ch_WOp2,Ch_Mop2:
-                  TmpResult := (taicpu(p1).oper[1]^.typ = top_reg) and
-                               reginop(supreg,taicpu(p1).oper[1]^);
-                Ch_RWOp3,Ch_WOp3,Ch_Mop3:
-                  TmpResult := (taicpu(p1).oper[2]^.typ = top_reg) and
-                               reginop(supreg,taicpu(p1).oper[2]^);
-                Ch_FPU: TmpResult := false; // supreg is supposed to be an intreg!! supreg in [RS_ST..RS_ST7,RS_MM0..RS_MM7];
-                Ch_ALL: TmpResult := true;
-              end;
-              inc(Cnt)
-            end
-        end
-    end;
-  RegModifiedByInstruction := TmpResult
-end;
-
-
-function instrWritesFlags(p: tai): boolean;
-var
-  l: longint;
-begin
-  instrWritesFlags := true;
-  case p.typ of
-    ait_instruction:
-      begin
-        for l := 1 to maxinschanges do
-          if InsProp[taicpu(p).opcode].Ch[l] in [Ch_WFlags,Ch_RWFlags,Ch_All] then
-            exit;
-      end;
-    ait_label:
-      exit;
-  end;
-  instrWritesFlags := false;
-end;
-
-
-function instrReadsFlags(p: tai): boolean;
-var
-  l: longint;
-begin
-  instrReadsFlags := true;
-  case p.typ of
-    ait_instruction:
-      begin
-        for l := 1 to maxinschanges do
-          if InsProp[taicpu(p).opcode].Ch[l] in [Ch_RFlags,Ch_RWFlags,Ch_All] then
-            exit;
-      end;
-    ait_label:
-      exit;
-  end;
-  instrReadsFlags := false;
-end;
-
-
-{********************* GetNext and GetLastInstruction *********************}
-function GetNextInstruction(Current: tai; var Next: tai): Boolean;
-{ skips ait_regalloc, ait_regdealloc and ait_stab* objects and puts the }
-{ next tai object in Next. Returns false if there isn't any             }
-begin
-  repeat
-    if (Current.typ = ait_marker) and
-       (tai_Marker(current).Kind = mark_AsmBlockStart) then
-      begin
-        GetNextInstruction := False;
-        Next := Nil;
-        Exit
-      end;
-    Current := tai(current.Next);
-    while assigned(Current) and
-          ((current.typ in skipInstr) or
-           ((current.typ = ait_label) and
-            labelCanBeSkipped(tai_label(current)))) do
-      Current := tai(current.Next);
-{    if assigned(Current) and
-       (current.typ = ait_Marker) and
-       (tai_Marker(current).Kind = mark_NoPropInfoStart) then
-      begin
-        while assigned(Current) and
-              ((current.typ <> ait_Marker) or
-               (tai_Marker(current).Kind <> mark_NoPropInfoEnd)) Do
-          Current := tai(current.Next);
-      end;}
-  until not(assigned(Current)) or
-        (current.typ <> ait_Marker) or
-        not(tai_Marker(current).Kind in [mark_NoPropInfoStart,mark_NoPropInfoEnd]);
-  Next := Current;
-  if assigned(Current) and
-     not((current.typ in SkipInstr) or
-         ((current.typ = ait_label) and
-          labelCanBeSkipped(tai_label(current))))
-    then
-      GetNextInstruction :=
-         not((current.typ = ait_marker) and
-             (tai_marker(current).kind = mark_AsmBlockStart))
-    else
-      begin
-        GetNextInstruction := False;
-        Next := nil;
-      end;
-end;
-
-
-function GetLastInstruction(Current: tai; var Last: tai): boolean;
-{skips the ait-types in SkipInstr puts the previous tai object in
- Last. Returns false if there isn't any}
-begin
-  repeat
-    Current := tai(current.previous);
-    while assigned(Current) and
-          (((current.typ = ait_Marker) and
-            not(tai_Marker(current).Kind in [mark_AsmBlockEnd{,mark_NoPropInfoEnd}])) or
-           (current.typ in SkipInstr) or
-           ((current.typ = ait_label) and
-            labelCanBeSkipped(tai_label(current)))) Do
-      Current := tai(current.previous);
-{    if assigned(Current) and
-       (current.typ = ait_Marker) and
-       (tai_Marker(current).Kind = mark_NoPropInfoEnd) then
-      begin
-        while assigned(Current) and
-              ((current.typ <> ait_Marker) or
-               (tai_Marker(current).Kind <> mark_NoPropInfoStart)) Do
-          Current := tai(current.previous);
-      end;}
-  until not(assigned(Current)) or
-        (current.typ <> ait_Marker) or
-        not(tai_Marker(current).Kind in [mark_NoPropInfoStart,mark_NoPropInfoEnd]);
-  if not(assigned(Current)) or
-     (current.typ in SkipInstr) or
-     ((current.typ = ait_label) and
-      labelCanBeSkipped(tai_label(current))) or
-     ((current.typ = ait_Marker) and
-      (tai_Marker(current).Kind = mark_AsmBlockEnd))
-    then
-      begin
-        Last := nil;
-        GetLastInstruction := False
-      end
-    else
-      begin
-        Last := Current;
-        GetLastInstruction := True;
-      end;
-end;
-
-
-procedure SkipHead(var p: tai);
-var
- oldp: tai;
-begin
-  repeat
-    oldp := p;
-    if (p.typ in SkipInstr) or
-       ((p.typ = ait_marker) and
-        (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd])) then
-      GetNextInstruction(p,p)
-    else if ((p.Typ = Ait_Marker) and
-        (tai_Marker(p).Kind = mark_NoPropInfoStart)) then
-   {a marker of the mark_NoPropInfoStart can't be the first instruction of a
-    TAsmList list}
-      GetNextInstruction(tai(p.previous),p);
-    until p = oldp
-end;
-
-
-function labelCanBeSkipped(p: tai_label): boolean;
-begin
-  labelCanBeSkipped := not(p.labsym.is_used) or (p.labsym.labeltype<>alt_jump);
-end;
-
-{******************* The Data Flow Analyzer functions ********************}
-
-function regLoadedWithNewValue(supreg: tsuperregister; canDependOnPrevValue: boolean;
-           hp: tai): boolean;
-{ assumes reg is a 32bit register }
-var
-  p: taicpu;
-begin
-  if not assigned(hp) or
-     (hp.typ <> ait_instruction) then
-   begin
-     regLoadedWithNewValue := false;
-     exit;
-   end;
-  p := taicpu(hp);
-  regLoadedWithNewValue :=
-    (((p.opcode = A_MOV) or
-      (p.opcode = A_MOVZX) or
-      (p.opcode = A_MOVSX) or
-      (p.opcode = A_LEA)) and
-     (p.oper[1]^.typ = top_reg) and
-     (getsupreg(p.oper[1]^.reg) = supreg) and
-     (canDependOnPrevValue or
-      (p.oper[0]^.typ = top_const) or
-      ((p.oper[0]^.typ = top_reg) and
-       (getsupreg(p.oper[0]^.reg) <> supreg)) or
-      ((p.oper[0]^.typ = top_ref) and
-       not regInRef(supreg,p.oper[0]^.ref^)))) or
-    ((p.opcode = A_POP) and
-     (getsupreg(p.oper[0]^.reg) = supreg));
-end;
-
-procedure UpdateUsedRegs(var UsedRegs: TRegSet; p: tai);
-{updates UsedRegs with the RegAlloc Information coming after p}
-begin
-  repeat
-    while assigned(p) and
-          ((p.typ in (SkipInstr - [ait_RegAlloc])) or
-           ((p.typ = ait_label) and
-            labelCanBeSkipped(tai_label(p))) or
-           ((p.typ = ait_marker) and
-            (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd]))) do
-         p := tai(p.next);
-    while assigned(p) and
-          (p.typ=ait_RegAlloc) Do
-      begin
-        if (getregtype(tai_regalloc(p).reg) = R_INTREGISTER) then
-          begin
-            case tai_regalloc(p).ratype of
-              ra_alloc :
-                Include(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg)));
-              ra_dealloc :
-                Exclude(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg)));
-            end;
-          end;
-        p := tai(p.next);
-      end;
-  until not(assigned(p)) or
-        (not(p.typ in SkipInstr) and
-         not((p.typ = ait_label) and
-             labelCanBeSkipped(tai_label(p))));
-end;
-
-
-procedure AllocRegBetween(asml: TAsmList; reg: tregister; p1, p2: tai; var initialusedregs: tregset);
-{ allocates register reg between (and including) instructions p1 and p2 }
-{ the type of p1 and p2 must not be in SkipInstr                        }
-{ note that this routine is both called from the peephole optimizer     }
-{ where optinfo is not yet initialised) and from the cse (where it is)  }
-var
-  hp, start: tai;
-  removedsomething,
-  firstRemovedWasAlloc,
-  lastRemovedWasDealloc: boolean;
-  supreg: tsuperregister;
-begin
-{$ifdef EXTDEBUG}
-  if assigned(p1.optinfo) and
-     (ptaiprop(p1.optinfo)^.usedregs <> initialusedregs) then
-   internalerror(2004101010);
-{$endif EXTDEBUG}
-  start := p1;
- if (reg = NR_ESP) or
-    (reg = current_procinfo.framepointer) or
-     not(assigned(p1)) then
-    { this happens with registers which are loaded implicitely, outside the }
-    { current block (e.g. esi with self)                                    }
-    exit;
-  supreg := getsupreg(reg);
-  { make sure we allocate it for this instruction }
-  getnextinstruction(p2,p2);
-  lastRemovedWasDealloc := false;
-  removedSomething := false;
-  firstRemovedWasAlloc := false;
-{$ifdef allocregdebug}
-  hp := tai_comment.Create(strpnew('allocating '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+
-    ' from here...'));
-  insertllitem(asml,p1.previous,p1,hp);
-  hp := tai_comment.Create(strpnew('allocated '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+
-    ' till here...'));
-  insertllitem(asml,p2,p2.next,hp);
-{$endif allocregdebug}
-  if not(supreg in initialusedregs) then
-    begin
-      hp := tai_regalloc.alloc(reg,nil);
-      insertllItem(asmL,p1.previous,p1,hp);
-      include(initialusedregs,supreg);
-    end;
-  while assigned(p1) and
-        (p1 <> p2) do
-    begin
-      if assigned(p1.optinfo) then
-        include(ptaiprop(p1.optinfo)^.usedregs,supreg);
-      p1 := tai(p1.next);
-      repeat
-        while assigned(p1) and
-              (p1.typ in (SkipInstr-[ait_regalloc])) Do
-          p1 := tai(p1.next);
-{ remove all allocation/deallocation info about the register in between }
-        if assigned(p1) and
-           (p1.typ = ait_regalloc) then
-          if (getsupreg(tai_regalloc(p1).reg) = supreg) then
-            begin
-              if not removedSomething then
-                begin
-                  firstRemovedWasAlloc := tai_regalloc(p1).ratype=ra_alloc;
-                  removedSomething := true;
-                end;
-              lastRemovedWasDealloc := (tai_regalloc(p1).ratype=ra_dealloc);
-              hp := tai(p1.Next);
-              asml.Remove(p1);
-              p1.free;
-              p1 := hp;
-            end
-          else p1 := tai(p1.next);
-      until not(assigned(p1)) or
-            not(p1.typ in SkipInstr);
-    end;
-  if assigned(p1) then
-    begin
-      if firstRemovedWasAlloc then
-        begin
-          hp := tai_regalloc.Alloc(reg,nil);
-          insertLLItem(asmL,start.previous,start,hp);
-        end;
-      if lastRemovedWasDealloc then
-        begin
-          hp := tai_regalloc.DeAlloc(reg,nil);
-          insertLLItem(asmL,p1.previous,p1,hp);
-        end;
-    end;
-end;
-
-
-function FindRegDealloc(supreg: tsuperregister; p: tai): boolean;
-var
-  hp: tai;
-  first: boolean;
-begin
-  findregdealloc := false;
-  first := true;
-  while assigned(p.previous) and
-        ((tai(p.previous).typ in (skipinstr+[ait_align])) or
-         ((tai(p.previous).typ = ait_label) and
-          labelCanBeSkipped(tai_label(p.previous)))) do
-    begin
-      p := tai(p.previous);
-      if (p.typ = ait_regalloc) and
-         (getregtype(tai_regalloc(p).reg) = R_INTREGISTER) and
-         (getsupreg(tai_regalloc(p).reg) = supreg) then
-        if (tai_regalloc(p).ratype=ra_dealloc) then
-          if first then
-            begin
-              findregdealloc := true;
-              break;
-            end
-          else
-            begin
-              findRegDealloc :=
-                getNextInstruction(p,hp) and
-                 regLoadedWithNewValue(supreg,false,hp);
-              break
-            end
-        else
-          first := false;
-    end
-end;
-
-
-
-procedure incState(var S: Byte; amount: longint);
-{increases S by 1, wraps around at $ffff to 0 (so we won't get overflow
- errors}
-begin
-  if (s <= $ff - amount) then
-    inc(s, amount)
-  else s := longint(s) + amount - $ff;
-end;
-
-
-function sequenceDependsonReg(const Content: TContent; seqreg: tsuperregister; supreg: tsuperregister): Boolean;
-{ Content is the sequence of instructions that describes the contents of   }
-{ seqReg. reg is being overwritten by the current instruction. if the      }
-{ content of seqReg depends on reg (ie. because of a                       }
-{ "movl (seqreg,reg), seqReg" instruction), this function returns true     }
-var
-  p: tai;
-  Counter: Word;
-  TmpResult: Boolean;
-  RegsChecked: TRegSet;
-begin
-  RegsChecked := [];
-  p := Content.StartMod;
-  TmpResult := False;
-  Counter := 1;
-  while not(TmpResult) and
-        (Counter <= Content.NrOfMods) Do
-    begin
-      if (p.typ = ait_instruction) and
-         ((taicpu(p).opcode = A_MOV) or
-          (taicpu(p).opcode = A_MOVZX) or
-          (taicpu(p).opcode = A_MOVSX) or
-          (taicpu(p).opcode = A_LEA)) and
-         (taicpu(p).oper[0]^.typ = top_ref) then
-        With taicpu(p).oper[0]^.ref^ Do
-          if ((base = current_procinfo.FramePointer) or
-              (assigned(symbol) and (base = NR_NO))) and
-             (index = NR_NO) then
-            begin
-              RegsChecked := RegsChecked + [getsupreg(taicpu(p).oper[1]^.reg)];
-              if supreg = getsupreg(taicpu(p).oper[1]^.reg) then
-                break;
-            end
-          else
-            tmpResult :=
-              regReadByInstruction(supreg,p) and
-              regModifiedByInstruction(seqReg,p)
-      else
-        tmpResult :=
-          regReadByInstruction(supreg,p) and
-          regModifiedByInstruction(seqReg,p);
-      inc(Counter);
-      GetNextInstruction(p,p)
-    end;
-  sequenceDependsonReg := TmpResult
-end;
-
-
-procedure invalidateDependingRegs(p1: ptaiprop; supreg: tsuperregister);
-var
-  counter: tsuperregister;
-begin
-  for counter := RS_EAX to RS_EDI do
-    if counter <> supreg then
-      with p1^.regs[counter] Do
-        begin
-          if (typ in [con_ref,con_noRemoveRef]) and
-             sequenceDependsOnReg(p1^.Regs[counter],counter,supreg) then
-            if typ in [con_ref, con_invalid] then
-              typ := con_invalid
-            { con_noRemoveRef = con_unknown }
-            else
-              typ := con_unknown;
-          if assigned(memwrite) and
-             regInRef(counter,memwrite.oper[1]^.ref^) then
-            memwrite := nil;
-        end;
-end;
-
-
-procedure DestroyReg(p1: ptaiprop; supreg: tsuperregister; doincState:Boolean);
-{Destroys the contents of the register reg in the ptaiprop p1, as well as the
- contents of registers are loaded with a memory location based on reg.
- doincState is false when this register has to be destroyed not because
- it's contents are directly modified/overwritten, but because of an indirect
- action (e.g. this register holds the contents of a variable and the value
- of the variable in memory is changed) }
-begin
-{$push}{$warnings off}
-  { the following happens for fpu registers }
-  if (supreg < low(NrOfInstrSinceLastMod)) or
-     (supreg > high(NrOfInstrSinceLastMod)) then
-    exit;
-{$pop}
-  NrOfInstrSinceLastMod[supreg] := 0;
-  with p1^.regs[supreg] do
-    begin
-      if doincState then
-        begin
-          incState(wstate,1);
-          typ := con_unknown;
-          startmod := nil;
-        end
-      else
-        if typ in [con_ref,con_const,con_invalid] then
-          typ := con_invalid
-        { con_noRemoveRef = con_unknown }
-        else
-          typ := con_unknown;
-      memwrite := nil;
-    end;
-  invalidateDependingRegs(p1,supreg);
-end;
-
-{procedure AddRegsToSet(p: tai; var RegSet: TRegSet);
-begin
-  if (p.typ = ait_instruction) then
-    begin
-      case taicpu(p).oper[0]^.typ Of
-        top_reg:
-          if not(taicpu(p).oper[0]^.reg in [RS_NO,RS_ESP,current_procinfo.FramePointer]) then
-            RegSet := RegSet + [taicpu(p).oper[0]^.reg];
-        top_ref:
-          With TReference(taicpu(p).oper[0]^) Do
-            begin
-              if not(base in [current_procinfo.FramePointer,RS_NO,RS_ESP])
-                then RegSet := RegSet + [base];
-              if not(index in [current_procinfo.FramePointer,RS_NO,RS_ESP])
-                then RegSet := RegSet + [index];
-            end;
-      end;
-      case taicpu(p).oper[1]^.typ Of
-        top_reg:
-          if not(taicpu(p).oper[1]^.reg in [RS_NO,RS_ESP,current_procinfo.FramePointer]) then
-            if RegSet := RegSet + [TRegister(TwoWords(taicpu(p).oper[1]^).Word1];
-        top_ref:
-          With TReference(taicpu(p).oper[1]^) Do
-            begin
-              if not(base in [current_procinfo.FramePointer,RS_NO,RS_ESP])
-                then RegSet := RegSet + [base];
-              if not(index in [current_procinfo.FramePointer,RS_NO,RS_ESP])
-                then RegSet := RegSet + [index];
-            end;
-      end;
-    end;
-end;}
-
-function OpsEquivalent(const o1, o2: toper; const oldinst, newinst: taicpu; var RegInfo: toptreginfo; OpAct: TopAction): Boolean;
-begin {checks whether the two ops are equivalent}
-  OpsEquivalent := False;
-  if o1.typ=o2.typ then
-    case o1.typ Of
-      top_reg:
-        OpsEquivalent :=RegsEquivalent(o1.reg,o2.reg, oldinst, newinst, RegInfo, OpAct);
-      top_ref:
-        OpsEquivalent := RefsEquivalent(o1.ref^, o2.ref^, oldinst, newinst, RegInfo);
-      Top_Const:
-        OpsEquivalent := o1.val = o2.val;
-      Top_None:
-        OpsEquivalent := True
-    end;
-end;
-
-
-function OpsEqual(const o1,o2:toper): Boolean;
-begin {checks whether the two ops are equal}
-  OpsEqual := False;
-  if o1.typ=o2.typ then
-    case o1.typ Of
-      top_reg :
-        OpsEqual:=o1.reg=o2.reg;
-      top_ref :
-        OpsEqual := RefsEqual(o1.ref^, o2.ref^);
-      Top_Const :
-        OpsEqual:=o1.val=o2.val;
-      Top_None :
-        OpsEqual := True
-    end;
-end;
-
-
-function sizescompatible(loadsize,newsize: topsize): boolean;
-  begin
-    case loadsize of
-      S_B,S_BW,S_BL:
-        sizescompatible := (newsize = loadsize) or (newsize = S_B);
-      S_W,S_WL:
-        sizescompatible := (newsize = loadsize) or (newsize = S_W);
-      else
-        sizescompatible := newsize = S_L;
-    end;
-  end;
-
-
-function opscompatible(p1,p2: taicpu): boolean;
-begin
-  case p1.opcode of
-    A_MOVZX,A_MOVSX:
-      opscompatible :=
-        ((p2.opcode = p1.opcode) or (p2.opcode = A_MOV)) and
-        sizescompatible(p1.opsize,p2.opsize);
-    else
-      opscompatible :=
-        (p1.opcode = p2.opcode) and
-        (p1.ops = p2.ops) and
-        (p1.opsize = p2.opsize);
-  end;
-end;
-
-
-function InstructionsEquivalent(p1, p2: tai; var RegInfo: toptreginfo): Boolean;
-{$ifdef csdebug}
-var
-  hp: tai;
-{$endif csdebug}
-begin {checks whether two taicpu instructions are equal}
-  if assigned(p1) and assigned(p2) and
-     (tai(p1).typ = ait_instruction) and
-     (tai(p2).typ = ait_instruction) and
-     opscompatible(taicpu(p1),taicpu(p2)) and
-     (not(assigned(taicpu(p1).oper[0])) or
-      (taicpu(p1).oper[0]^.typ = taicpu(p2).oper[0]^.typ)) and
-     (not(assigned(taicpu(p1).oper[1])) or
-      (taicpu(p1).oper[1]^.typ = taicpu(p2).oper[1]^.typ)) and
-     (not(assigned(taicpu(p1).oper[2])) or
-      (taicpu(p1).oper[2]^.typ = taicpu(p2).oper[2]^.typ)) then
- {both instructions have the same structure:
-  "<operator> <operand of type1>, <operand of type 2>"}
-    if ((taicpu(p1).opcode = A_MOV) or
-        (taicpu(p1).opcode = A_MOVZX) or
-        (taicpu(p1).opcode = A_MOVSX)  or
-        (taicpu(p1).opcode = A_LEA)) and
-       (taicpu(p1).oper[0]^.typ = top_ref) {then .oper[1]^t = top_reg} then
-      if not(RegInRef(getsupreg(taicpu(p1).oper[1]^.reg), taicpu(p1).oper[0]^.ref^)) then
- {the "old" instruction is a load of a register with a new value, not with
-  a value based on the contents of this register (so no "mov (reg), reg")}
-        if not(RegInRef(getsupreg(taicpu(p2).oper[1]^.reg), taicpu(p2).oper[0]^.ref^)) and
-           RefsEquivalent(taicpu(p1).oper[0]^.ref^, taicpu(p2).oper[0]^.ref^,taicpu(p1), taicpu(p2), reginfo) then
- {the "new" instruction is also a load of a register with a new value, and
-  this value is fetched from the same memory location}
-          begin
-            With taicpu(p2).oper[0]^.ref^ Do
-              begin
-                if (base <> NR_NO) and
-                    (not(getsupreg(base) in [getsupreg(current_procinfo.FramePointer), RS_ESP])) then
-                  include(RegInfo.RegsLoadedForRef, getsupreg(base));
-                if (index <> NR_NO) and
-                    (not(getsupreg(index) in [getsupreg(current_procinfo.FramePointer), RS_ESP])) then
-                  include(RegInfo.RegsLoadedForRef, getsupreg(index));
-              end;
- {add the registers from the reference (.oper[0]^) to the RegInfo, all registers
-  from the reference are the same in the old and in the new instruction
-  sequence}
-            AddOp2RegInfo(taicpu(p1).oper[0]^, RegInfo);
- {the registers from .oper[1]^ have to be equivalent, but not necessarily equal}
-            InstructionsEquivalent :=
-              RegsEquivalent(taicpu(p1).oper[1]^.reg,
-                taicpu(p2).oper[1]^.reg, taicpu(p1), taicpu(p2), RegInfo, OpAct_Write);
-          end
- {the registers are loaded with values from different memory locations. if
-  this was allowed, the instructions "mov -4(esi),eax" and "mov -4(ebp),eax"
-  would be considered equivalent}
-        else
-          InstructionsEquivalent := False
-      else
- {load register with a value based on the current value of this register}
-        begin
-          With taicpu(p2).oper[0]^.ref^ Do
-            begin
-              if (base <> NR_NO) and
-                 (not(getsupreg(base) in [getsupreg(current_procinfo.FramePointer),
-                   getsupreg(taicpu(p2).oper[1]^.reg),RS_ESP])) then
- {it won't do any harm if the register is already in RegsLoadedForRef}
-                begin
-                  include(RegInfo.RegsLoadedForRef, getsupreg(base));
-{$ifdef csdebug}
-                  Writeln(std_regname(base), ' added');
-{$endif csdebug}
-                end;
-              if (index <> NR_NO) and
-                 (not(getsupreg(index) in [getsupreg(current_procinfo.FramePointer),
-                   getsupreg(taicpu(p2).oper[1]^.reg),RS_ESP])) then
-                begin
-                  include(RegInfo.RegsLoadedForRef, getsupreg(index));
-{$ifdef csdebug}
-                  Writeln(std_regname(index), ' added');
-{$endif csdebug}
-                end;
-
-            end;
-          if (taicpu(p2).oper[1]^.reg <> NR_NO) and
-             (not(getsupreg(taicpu(p2).oper[1]^.reg) in [getsupreg(current_procinfo.FramePointer),RS_ESP])) then
-            begin
-              RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef -
-                                              [getsupreg(taicpu(p2).oper[1]^.reg)];
-{$ifdef csdebug}
-              Writeln(std_regname(newreg(R_INTREGISTER,getsupreg(taicpu(p2).oper[1]^.reg),R_SUBWHOLE)), ' removed');
-{$endif csdebug}
-            end;
-          InstructionsEquivalent :=
-             OpsEquivalent(taicpu(p1).oper[0]^, taicpu(p2).oper[0]^, taicpu(p1), taicpu(p2), RegInfo, OpAct_Read) and
-             OpsEquivalent(taicpu(p1).oper[1]^, taicpu(p2).oper[1]^, taicpu(p1), taicpu(p2), RegInfo, OpAct_Write)
-        end
-    else
- {an instruction <> mov, movzx, movsx}
-      begin
-  {$ifdef csdebug}
-        hp := tai_comment.Create(strpnew('checking if equivalent'));
-        hp.previous := p2;
-        hp.next := p2.next;
-        p2.next.previous := hp;
-        p2.next := hp;
-  {$endif csdebug}
-        InstructionsEquivalent :=
-          (not(assigned(taicpu(p1).oper[0])) or
-           OpsEquivalent(taicpu(p1).oper[0]^, taicpu(p2).oper[0]^, taicpu(p1), taicpu(p2), RegInfo, OpAct_Unknown)) and
-          (not(assigned(taicpu(p1).oper[1])) or
-           OpsEquivalent(taicpu(p1).oper[1]^, taicpu(p2).oper[1]^, taicpu(p1), taicpu(p2), RegInfo, OpAct_Unknown)) and
-          (not(assigned(taicpu(p1).oper[2])) or
-           OpsEquivalent(taicpu(p1).oper[2]^, taicpu(p2).oper[2]^, taicpu(p1), taicpu(p2), RegInfo, OpAct_Unknown))
-       end
- {the instructions haven't even got the same structure, so they're certainly
-  not equivalent}
-    else
-      begin
-  {$ifdef csdebug}
-        hp := tai_comment.Create(strpnew('different opcodes/format'));
-        hp.previous := p2;
-        hp.next := p2.next;
-        p2.next.previous := hp;
-        p2.next := hp;
-  {$endif csdebug}
-        InstructionsEquivalent := False;
-      end;
-  {$ifdef csdebug}
-    hp := tai_comment.Create(strpnew('instreq: '+tostr(byte(instructionsequivalent))));
-    hp.previous := p2;
-    hp.next := p2.next;
-    p2.next.previous := hp;
-    p2.next := hp;
-  {$endif csdebug}
-end;
-
-(*
-function InstructionsEqual(p1, p2: tai): Boolean;
-begin {checks whether two taicpu instructions are equal}
-  InstructionsEqual :=
-    assigned(p1) and assigned(p2) and
-    ((tai(p1).typ = ait_instruction) and
-     (tai(p1).typ = ait_instruction) and
-     (taicpu(p1).opcode = taicpu(p2).opcode) and
-     (taicpu(p1).oper[0]^.typ = taicpu(p2).oper[0]^.typ) and
-     (taicpu(p1).oper[1]^.typ = taicpu(p2).oper[1]^.typ) and
-     OpsEqual(taicpu(p1).oper[0]^.typ, taicpu(p1).oper[0]^, taicpu(p2).oper[0]^) and
-     OpsEqual(taicpu(p1).oper[1]^.typ, taicpu(p1).oper[1]^, taicpu(p2).oper[1]^))
-end;
-*)
-
-procedure readreg(p: ptaiprop; supreg: tsuperregister);
-begin
-  if supreg in [RS_EAX..RS_EDI] then
-    incState(p^.regs[supreg].rstate,1)
-end;
-
-
-procedure readref(p: ptaiprop; const ref: preference);
-begin
-  if ref^.base <> NR_NO then
-    readreg(p, getsupreg(ref^.base));
-  if ref^.index <> NR_NO then
-    readreg(p, getsupreg(ref^.index));
-end;
-
-
-procedure ReadOp(p: ptaiprop;const o:toper);
-begin
-  case o.typ Of
-    top_reg: readreg(p, getsupreg(o.reg));
-    top_ref: readref(p, o.ref);
-  end;
-end;
-
-
-function RefInInstruction(const ref: TReference; p: tai;
-           RefsEq: TRefCompare; size: tcgsize): Boolean;
-{checks whehter ref is used in p}
-var
-  mysize: tcgsize;
-  TmpResult: Boolean;
-begin
-  TmpResult := False;
-  if (p.typ = ait_instruction) then
-    begin
-      mysize := topsize2tcgsize[taicpu(p).opsize];
-      if (taicpu(p).ops >= 1) and
-         (taicpu(p).oper[0]^.typ = top_ref) then
-        TmpResult := RefsEq(taicpu(p).oper[0]^.ref^,ref,mysize,size);
-      if not(TmpResult) and
-         (taicpu(p).ops >= 2) and
-         (taicpu(p).oper[1]^.typ = top_ref) then
-        TmpResult := RefsEq(taicpu(p).oper[1]^.ref^,ref,mysize,size);
-      if not(TmpResult) and
-         (taicpu(p).ops >= 3) and
-         (taicpu(p).oper[2]^.typ = top_ref) then
-        TmpResult := RefsEq(taicpu(p).oper[2]^.ref^,ref,mysize,size);
-    end;
-  RefInInstruction := TmpResult;
-end;
-
-
-function RefInSequence(const ref: TReference; Content: TContent;
-           RefsEq: TRefCompare; size: tcgsize): Boolean;
-{checks the whole sequence of Content (so StartMod and and the next NrOfMods
- tai objects) to see whether ref is used somewhere}
-var p: tai;
-    Counter: Word;
-    TmpResult: Boolean;
-begin
-  p := Content.StartMod;
-  TmpResult := False;
-  Counter := 1;
-  while not(TmpResult) and
-        (Counter <= Content.NrOfMods) Do
-    begin
-      if (p.typ = ait_instruction) and
-         RefInInstruction(ref, p, RefsEq, size)
-        then TmpResult := True;
-      inc(Counter);
-      GetNextInstruction(p,p)
-    end;
-  RefInSequence := TmpResult
-end;
-
-{$push}
-{$q-}
-// checks whether a write to r2 of size "size" contains address r1
-function arrayrefsoverlapping(const r1, r2: treference; size1, size2: tcgsize): Boolean;
-var
-  realsize1, realsize2: aint;
-begin
-  realsize1 := tcgsize2size[size1];
-  realsize2 := tcgsize2size[size2];
-  arrayrefsoverlapping :=
-    (r2.offset <= r1.offset+realsize1) and
-    (r1.offset <= r2.offset+realsize2) and
-    (r1.segment = r2.segment) and
-    (r1.symbol=r2.symbol) and
-    (r1.base = r2.base)
-end;
-{$pop}
-
-function isSimpleRef(const ref: treference): boolean;
-{ returns true if ref is reference to a local or global variable, to a  }
-{ parameter or to an object field (this includes arrays). Returns false }
-{ otherwise.                                                            }
-begin
-  isSimpleRef :=
-    assigned(ref.symbol) or
-    (ref.base = current_procinfo.framepointer);
-end;
-
-
-function containsPointerRef(p: tai): boolean;
-{ checks if an instruction contains a reference which is a pointer location }
-var
-  hp: taicpu;
-  count: longint;
-begin
-  containsPointerRef := false;
-  if p.typ <> ait_instruction then
-    exit;
-  hp := taicpu(p);
-  for count := 0 to hp.ops-1 do
-    begin
-      case hp.oper[count]^.typ of
-        top_ref:
-          if not isSimpleRef(hp.oper[count]^.ref^) then
-            begin
-              containsPointerRef := true;
-              exit;
-            end;
-        top_none:
-          exit;
-      end;
-    end;
-end;
-
-
-function containsPointerLoad(c: tcontent): boolean;
-{ checks whether the contents of a register contain a pointer reference }
-var
-  p: tai;
-  count: longint;
-begin
-  containsPointerLoad := false;
-  p := c.startmod;
-  for count := c.nrOfMods downto 1 do
-    begin
-      if containsPointerRef(p) then
-        begin
-          containsPointerLoad := true;
-          exit;
-        end;
-      getnextinstruction(p,p);
-    end;
-end;
-
-
-function writeToMemDestroysContents(regWritten: tsuperregister; const ref: treference;
-  supreg: tsuperregister; size: tcgsize; const c: tcontent; var invalsmemwrite: boolean): boolean;
-{ returns whether the contents c of reg are invalid after regWritten is }
-{ is written to ref                                                     }
-var
-  refsEq: trefCompare;
-begin
-  if isSimpleRef(ref) then
-    begin
-      if (ref.index <> NR_NO) or
-         (assigned(ref.symbol) and
-          (ref.base <> NR_NO)) then
-        { local/global variable or parameter which is an array }
-        refsEq := @arrayRefsOverlapping
-      else
-        { local/global variable or parameter which is not an array }
-        refsEq := @refsOverlapping;
-      invalsmemwrite :=
-        assigned(c.memwrite) and
-        ((not(cs_opt_size in current_settings.optimizerswitches) and
-          containsPointerRef(c.memwrite)) or
-         refsEq(c.memwrite.oper[1]^.ref^,ref,topsize2tcgsize[c.memwrite.opsize],size));
-      if not(c.typ in [con_ref,con_noRemoveRef,con_invalid]) then
-        begin
-          writeToMemDestroysContents := false;
-          exit;
-        end;
-
-     { write something to a parameter, a local or global variable, so          }
-     {  * with uncertain optimizations on:                                     }
-     {    - destroy the contents of registers whose contents have somewhere a  }
-     {      "mov?? (ref), %reg". WhichReg (this is the register whose contents }
-     {      are being written to memory) is not destroyed if it's StartMod is  }
-     {      of that form and NrOfMods = 1 (so if it holds ref, but is not a    }
-     {      expression based on ref)                                           }
-     {  * with uncertain optimizations off:                                    }
-     {    - also destroy registers that contain any pointer                    }
-      with c do
-        writeToMemDestroysContents :=
-          (typ in [con_ref,con_noRemoveRef]) and
-          ((not(cs_opt_size in current_settings.optimizerswitches) and
-            containsPointerLoad(c)
-           ) or
-           (refInSequence(ref,c,refsEq,size) and
-            ((supreg <> regWritten) or
-             not((nrOfMods = 1) and
-                 {StarMod is always of the type ait_instruction}
-                 (taicpu(StartMod).oper[0]^.typ = top_ref) and
-                 refsEq(taicpu(StartMod).oper[0]^.ref^, ref, topsize2tcgsize[taicpu(StartMod).opsize],size)
-                )
-            )
-           )
-          );
-    end
-  else
-    { write something to a pointer location, so                               }
-    {   * with uncertain optimzations on:                                     }
-    {     - do not destroy registers which contain a local/global variable or }
-    {       a parameter, except if DestroyRefs is called because of a "movsl" }
-    {   * with uncertain optimzations off:                                    }
-    {     - destroy every register which contains a memory location           }
-    begin
-      invalsmemwrite :=
-        assigned(c.memwrite) and
-        (not(cs_opt_size in current_settings.optimizerswitches) or
-         containsPointerRef(c.memwrite));
-      if not(c.typ in [con_ref,con_noRemoveRef,con_invalid]) then
-        begin
-          writeToMemDestroysContents := false;
-          exit;
-        end;
-      with c do
-        writeToMemDestroysContents :=
-          (typ in [con_ref,con_noRemoveRef]) and
-          (not(cs_opt_size in current_settings.optimizerswitches) or
-         { for movsl }
-           ((ref.base = NR_EDI) and (ref.index = NR_EDI)) or
-         { don't destroy if reg contains a parameter, local or global variable }
-           containsPointerLoad(c)
-          );
-    end;
-end;
-
-
-function writeToRegDestroysContents(destReg, supreg: tsuperregister;
-  const c: tcontent): boolean;
-{ returns whether the contents c of reg are invalid after destReg is }
-{ modified                                                           }
-begin
-  writeToRegDestroysContents :=
-    (c.typ in [con_ref,con_noRemoveRef,con_invalid]) and
-    sequenceDependsOnReg(c,supreg,destReg);
-end;
-
-
-function writeDestroysContents(const op: toper; supreg: tsuperregister; size: tcgsize;
-  const c: tcontent; var memwritedestroyed: boolean): boolean;
-{ returns whether the contents c of reg are invalid after regWritten is }
-{ is written to op                                                      }
-begin
-  memwritedestroyed := false;
-  case op.typ of
-    top_reg:
-      writeDestroysContents :=
-        (getregtype(op.reg) = R_INTREGISTER) and
-        writeToRegDestroysContents(getsupreg(op.reg),supreg,c);
-    top_ref:
-      writeDestroysContents :=
-        writeToMemDestroysContents(RS_INVALID,op.ref^,supreg,size,c,memwritedestroyed);
-  else
-    writeDestroysContents := false;
-  end;
-end;
-
-
-procedure destroyRefs(p: tai; const ref: treference; regwritten: tsuperregister; size: tcgsize);
-{ destroys all registers which possibly contain a reference to ref, regWritten }
-{ is the register whose contents are being written to memory (if this proc     }
-{ is called because of a "mov?? %reg, (mem)" instruction)                      }
-var
-  counter: tsuperregister;
-  destroymemwrite: boolean;
-begin
-  for counter := RS_EAX to RS_EDI Do
-    begin
-      if writeToMemDestroysContents(regwritten,ref,counter,size,
-           ptaiprop(p.optInfo)^.regs[counter],destroymemwrite) then
-        destroyReg(ptaiprop(p.optInfo), counter, false)
-      else if destroymemwrite then
-        ptaiprop(p.optinfo)^.regs[counter].MemWrite := nil;
-    end;
-end;
-
-
-procedure DestroyAllRegs(p: ptaiprop; read, written: boolean);
-var Counter: tsuperregister;
-begin {initializes/desrtoys all registers}
-  For Counter := RS_EAX To RS_EDI Do
-    begin
-      if read then
-        readreg(p, Counter);
-      DestroyReg(p, Counter, written);
-      p^.regs[counter].MemWrite := nil;
-    end;
-  p^.DirFlag := F_Unknown;
-end;
-
-
-procedure DestroyOp(taiObj: tai; const o:Toper);
-{$ifdef statedebug}
-var
-    hp: tai;
-{$endif statedebug}
-begin
-  case o.typ Of
-    top_reg:
-      begin
-{$ifdef statedebug}
-        hp := tai_comment.Create(strpnew('destroying '+std_regname(o.reg)));
-        hp.next := taiobj.next;
-        hp.previous := taiobj;
-        taiobj.next := hp;
-        if assigned(hp.next) then
-          hp.next.previous := hp;
-{$endif statedebug}
-        DestroyReg(ptaiprop(taiObj.OptInfo), getsupreg(o.reg), true);
-      end;
-    top_ref:
-      begin
-        readref(ptaiprop(taiObj.OptInfo), o.ref);
-        DestroyRefs(taiObj, o.ref^, RS_INVALID,topsize2tcgsize[(taiobj as taicpu).opsize]);
-      end;
-  end;
-end;
-
-
-procedure AddInstr2RegContents({$ifdef statedebug} asml: TAsmList; {$endif}
-p: taicpu; supreg: tsuperregister);
-{$ifdef statedebug}
-var
-  hp: tai;
-{$endif statedebug}
-begin
-  With ptaiprop(p.optinfo)^.regs[supreg] Do
-    if (typ in [con_ref,con_noRemoveRef]) then
-      begin
-        incState(wstate,1);
-        { also store how many instructions are part of the sequence in the first }
-        { instructions ptaiprop, so it can be easily accessed from within        }
-        { CheckSequence}
-        inc(NrOfMods, NrOfInstrSinceLastMod[supreg]);
-        ptaiprop(tai(StartMod).OptInfo)^.Regs[supreg].NrOfMods := NrOfMods;
-        NrOfInstrSinceLastMod[supreg] := 0;
-        invalidateDependingRegs(p.optinfo,supreg);
-        ptaiprop(p.optinfo)^.regs[supreg].memwrite := nil;
-{$ifdef StateDebug}
-        hp := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+': '+tostr(ptaiprop(p.optinfo)^.Regs[supreg].WState)
-              + ' -- ' + tostr(ptaiprop(p.optinfo)^.Regs[supreg].nrofmods)));
-        InsertLLItem(AsmL, p, p.next, hp);
-{$endif StateDebug}
-      end
-    else
-      begin
-{$ifdef statedebug}
-        hp := tai_comment.Create(strpnew('destroying '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))));
-        insertllitem(asml,p,p.next,hp);
-{$endif statedebug}
-        DestroyReg(ptaiprop(p.optinfo), supreg, true);
-{$ifdef StateDebug}
-        hp := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+': '+tostr(ptaiprop(p.optinfo)^.Regs[supreg].WState)));
-        InsertLLItem(AsmL, p, p.next, hp);
-{$endif StateDebug}
-      end
-end;
-
-
-procedure AddInstr2OpContents({$ifdef statedebug} asml: TAsmList; {$endif}
-p: taicpu; const oper: TOper);
-begin
-  if oper.typ = top_reg then
-    AddInstr2RegContents({$ifdef statedebug} asml, {$endif}p, getsupreg(oper.reg))
-  else
-    begin
-      ReadOp(ptaiprop(p.optinfo), oper);
-      DestroyOp(p, oper);
-    end
-end;
-
-
-{*************************************************************************************}
-{************************************** TDFAOBJ **************************************}
-{*************************************************************************************}
-
-constructor tdfaobj.create(_list: TAsmList);
-begin
-  list := _list;
-  blockstart := nil;
-  blockend := nil;
-  nroftaiobjs := 0;
-  taipropblock := nil;
-  lolab := 0;
-  hilab := 0;
-  labdif := 0;
-  labeltable := nil;
-end;
-
-
-procedure tdfaobj.initlabeltable;
-var
-  labelfound: boolean;
-  p, prev: tai;
-  hp1, hp2: tai;
-{$ifdef i386}
-  regcounter,
-  supreg : tsuperregister;
-{$endif i386}
-  usedregs, nodeallocregs: tregset;
-begin
-  labelfound := false;
-  lolab := maxlongint;
-  hilab := 0;
-  p := blockstart;
-  prev := p;
-  while assigned(p) do
-    begin
-      if (tai(p).typ = ait_label) then
-        if not labelcanbeskipped(tai_label(p)) then
-          begin
-            labelfound := true;
-             if (tai_Label(p).labsym.labelnr < lolab) then
-               lolab := tai_label(p).labsym.labelnr;
-             if (tai_Label(p).labsym.labelnr > hilab) then
-               hilab := tai_label(p).labsym.labelnr;
-          end;
-      prev := p;
-      getnextinstruction(p, p);
-    end;
-  if (prev.typ = ait_marker) and
-     (tai_marker(prev).kind = mark_AsmBlockStart) then
-    blockend := prev
-  else blockend := nil;
-  if labelfound then
-    labdif := hilab+1-lolab
-  else labdif := 0;
-
-  usedregs := [];
-  if (labdif <> 0) then
-    begin
-      getmem(labeltable, labdif*sizeof(tlabeltableitem));
-      fillchar(labeltable^, labdif*sizeof(tlabeltableitem), 0);
-    end;
-  p := blockstart;
-  prev := p;
-  while (p <> blockend) do
-    begin
-      case p.typ of
-        ait_label:
-          if not labelcanbeskipped(tai_label(p)) then
-            labeltable^[tai_label(p).labsym.labelnr-lolab].taiobj := p;
-{$ifdef i386}
-        ait_regalloc:
-         if (getregtype(tai_regalloc(p).reg) = R_INTREGISTER) then
-          begin
-            supreg:=getsupreg(tai_regalloc(p).reg);
-            case tai_regalloc(p).ratype of
-              ra_alloc :
-                begin
-                  if not(supreg in usedregs) then
-                    include(usedregs, supreg)
-                  else
-                    begin
-                      //addregdeallocfor(list, tai_regalloc(p).reg, p);
-                      hp1 := tai(p.previous);
-                      list.remove(p);
-                      p.free;
-                      p := hp1;
-                    end;
-                end;
-              ra_dealloc :
-                begin
-                  exclude(usedregs, supreg);
-                  hp1 := p;
-                  hp2 := nil;
-                  while not(findregalloc(supreg,tai(hp1.next),ra_alloc)) and
-                        getnextinstruction(hp1, hp1) and
-                        regininstruction(getsupreg(tai_regalloc(p).reg), hp1) Do
-                    hp2 := hp1;
-                  if hp2 <> nil then
-                    begin
-                      hp1 := tai(p.previous);
-                      list.remove(p);
-                      insertllitem(list, hp2, tai(hp2.next), p);
-                      p := hp1;
-                    end
-                  else if findregalloc(getsupreg(tai_regalloc(p).reg), tai(p.next),ra_alloc)
-                          and getnextinstruction(p,hp1) then
-                    begin
-                      hp1 := tai(p.previous);
-                      list.remove(p);
-                      p.free;
-                      p := hp1;
-//                      don't include here, since then the allocation will be removed when it's processed
-//                      include(usedregs,supreg);
-                    end;
-                end;
-             end;
-           end;
-{$endif i386}
-      end;
-      repeat
-        prev := p;
-        p := tai(p.next);
-      until not(assigned(p)) or
-            (p = blockend) or
-            not(p.typ in (skipinstr - [ait_regalloc]));
-    end;
-{$ifdef i386}
-  { don't add deallocation for function result variable or for regvars}
-  getNoDeallocRegs(noDeallocRegs);
-  usedRegs := usedRegs - noDeallocRegs;
-  for regCounter := RS_EAX to RS_EDI do
-    if regCounter in usedRegs then
-      addRegDeallocFor(list,newreg(R_INTREGISTER,regCounter,R_SUBWHOLE),prev);
-{$endif i386}
-end;
-
-
-function tdfaobj.pass_1(_blockstart: tai): tai;
-begin
-  blockstart := _blockstart;
-  initlabeltable;
-  pass_1 := blockend;
-end;
-
-
-
-function tdfaobj.initdfapass2: boolean;
-{reserves memory for the PtaiProps in one big memory block when not using
- TP, returns False if not enough memory is available for the optimizer in all
- cases}
-var
-  p: tai;
-  count: Longint;
-{    TmpStr: String; }
-begin
-  p := blockstart;
-  skiphead(p);
-  nroftaiobjs := 0;
-  while (p <> blockend) do
-    begin
-{$ifDef JumpAnal}
-      case p.typ of
-        ait_label:
-          begin
-            if not labelcanbeskipped(tai_label(p)) then
-              labeltable^[tai_label(p).labsym.labelnr-lolab].instrnr := nroftaiobjs
-          end;
-        ait_instruction:
-          begin
-            if taicpu(p).is_jmp then
-             begin
-               if (tasmlabel(taicpu(p).oper[0]^.sym).labsymabelnr >= lolab) and
-                  (tasmlabel(taicpu(p).oper[0]^.sym).labsymabelnr <= hilab) then
-                 inc(labeltable^[tasmlabel(taicpu(p).oper[0]^.sym).labsymabelnr-lolab].refsfound);
-             end;
-          end;
-{        ait_instruction:
-          begin
-           if (taicpu(p).opcode = A_PUSH) and
-              (taicpu(p).oper[0]^.typ = top_symbol) and
-              (PCSymbol(taicpu(p).oper[0]^)^.offset = 0) then
-             begin
-               TmpStr := StrPas(PCSymbol(taicpu(p).oper[0]^)^.symbol);
-               if}
-      end;
-{$endif JumpAnal}
-      inc(NrOftaiObjs);
-      getnextinstruction(p,p);
-    end;
-  if nroftaiobjs <> 0 then
-    begin
-      initdfapass2 := True;
-      getmem(taipropblock, nroftaiobjs*sizeof(ttaiprop));
-      fillchar(taiPropblock^,nroftaiobjs*sizeof(ttaiprop),0);
-      p := blockstart;
-      skiphead(p);
-      for count := 1 To nroftaiobjs do
-        begin
-          ptaiprop(p.optinfo) := @taipropblock^[count];
-          getnextinstruction(p, p);
-        end;
-    end
-  else
-    initdfapass2 := false;
-end;
-
-
-procedure tdfaobj.dodfapass2;
-{Analyzes the Data Flow of an assembler list. Starts creating the reg
- contents for the instructions starting with p. Returns the last tai which has
- been processed}
-var
-    curprop, LastFlagsChangeProp: ptaiprop;
-    Cnt, InstrCnt : Longint;
-    InstrProp: TInsProp;
-    UsedRegs: TRegSet;
-    prev,p  : tai;
-    tmpref: TReference;
-    tmpsupreg: tsuperregister;
-{$ifdef statedebug}
-    hp : tai;
-{$endif}
-{$ifdef AnalyzeLoops}
-    hp : tai;
-    TmpState: Byte;
-{$endif AnalyzeLoops}
-begin
-  p := BlockStart;
-  LastFlagsChangeProp := nil;
-  prev := nil;
-  UsedRegs := [];
-  UpdateUsedregs(UsedRegs, p);
-  SkipHead(p);
-  BlockStart := p;
-  InstrCnt := 1;
-  fillchar(NrOfInstrSinceLastMod, SizeOf(NrOfInstrSinceLastMod), 0);
-  while (p <> Blockend) Do
-    begin
-      curprop := @taiPropBlock^[InstrCnt];
-      if assigned(prev)
-        then
-          begin
-{$ifdef JumpAnal}
-            if (p.Typ <> ait_label) then
-{$endif JumpAnal}
-              begin
-                curprop^.regs := ptaiprop(prev.OptInfo)^.Regs;
-                curprop^.DirFlag := ptaiprop(prev.OptInfo)^.DirFlag;
-                curprop^.FlagsUsed := false;
-              end
-          end
-        else
-          begin
-            fillchar(curprop^, SizeOf(curprop^), 0);
-{            For tmpreg := RS_EAX to RS_EDI Do
-              curprop^.regs[tmpreg].WState := 1;}
-          end;
-      curprop^.UsedRegs := UsedRegs;
-      curprop^.CanBeRemoved := False;
-      UpdateUsedRegs(UsedRegs, tai(p.Next));
-      For tmpsupreg := RS_EAX To RS_EDI Do
-        if NrOfInstrSinceLastMod[tmpsupreg] < 255 then
-          inc(NrOfInstrSinceLastMod[tmpsupreg])
-        else
-          begin
-            NrOfInstrSinceLastMod[tmpsupreg] := 0;
-            curprop^.regs[tmpsupreg].typ := con_unknown;
-          end;
-      case p.typ Of
-        ait_marker:;
-        ait_label:
-{$ifndef JumpAnal}
-          if not labelCanBeSkipped(tai_label(p)) then
-            DestroyAllRegs(curprop,false,false);
-{$else JumpAnal}
-          begin
-           if not labelCanBeSkipped(tai_label(p)) then
-             With LTable^[tai_Label(p).labsym^.labelnr-LoLab] Do
-{$ifDef AnalyzeLoops}
-              if (RefsFound = tai_Label(p).labsym^.RefCount)
-{$else AnalyzeLoops}
-              if (JmpsProcessed = tai_Label(p).labsym^.RefCount)
-{$endif AnalyzeLoops}
-                then
-{all jumps to this label have been found}
-{$ifDef AnalyzeLoops}
-                  if (JmpsProcessed > 0)
-                    then
-{$endif AnalyzeLoops}
- {we've processed at least one jump to this label}
-                      begin
-                        if (GetLastInstruction(p, hp) and
-                           not(((hp.typ = ait_instruction)) and
-                                (taicpu_labeled(hp).is_jmp))
-                          then
-  {previous instruction not a JMP -> the contents of the registers after the
-   previous intruction has been executed have to be taken into account as well}
-                            For tmpsupreg := RS_EAX to RS_EDI Do
-                              begin
-                                if (curprop^.regs[tmpsupreg].WState <>
-                                    ptaiprop(hp.OptInfo)^.Regs[tmpsupreg].WState)
-                                  then DestroyReg(curprop, tmpsupreg, true)
-                              end
-                      end
-{$ifDef AnalyzeLoops}
-                    else
- {a label from a backward jump (e.g. a loop), no jump to this label has
-  already been processed}
-                      if GetLastInstruction(p, hp) and
-                         not(hp.typ = ait_instruction) and
-                            (taicpu_labeled(hp).opcode = A_JMP))
-                        then
-  {previous instruction not a jmp, so keep all the registers' contents from the
-   previous instruction}
-                          begin
-                            curprop^.regs := ptaiprop(hp.OptInfo)^.Regs;
-                            curprop.DirFlag := ptaiprop(hp.OptInfo)^.DirFlag;
-                          end
-                        else
-  {previous instruction a jmp and no jump to this label processed yet}
-                          begin
-                            hp := p;
-                            Cnt := InstrCnt;
-     {continue until we find a jump to the label or a label which has already
-      been processed}
-                            while GetNextInstruction(hp, hp) and
-                                  not((hp.typ = ait_instruction) and
-                                      (taicpu(hp).is_jmp) and
-                                      (tasmlabel(taicpu(hp).oper[0]^.sym).labsymabelnr = tai_Label(p).labsym^.labelnr)) and
-                                  not((hp.typ = ait_label) and
-                                      (LTable^[tai_Label(hp).labsym^.labelnr-LoLab].RefsFound
-                                       = tai_Label(hp).labsym^.RefCount) and
-                                      (LTable^[tai_Label(hp).labsym^.labelnr-LoLab].JmpsProcessed > 0)) Do
-                              inc(Cnt);
-                            if (hp.typ = ait_label)
-                              then
-   {there's a processed label after the current one}
-                                begin
-                                  curprop^.regs := taiPropBlock^[Cnt].Regs;
-                                  curprop.DirFlag := taiPropBlock^[Cnt].DirFlag;
-                                end
-                              else
-   {there's no label anymore after the current one, or they haven't been
-    processed yet}
-                                begin
-                                  GetLastInstruction(p, hp);
-                                  curprop^.regs := ptaiprop(hp.OptInfo)^.Regs;
-                                  curprop.DirFlag := ptaiprop(hp.OptInfo)^.DirFlag;
-                                  DestroyAllRegs(ptaiprop(hp.OptInfo),true,true)
-                                end
-                          end
-{$endif AnalyzeLoops}
-                else
-{not all references to this label have been found, so destroy all registers}
-                  begin
-                    GetLastInstruction(p, hp);
-                    curprop^.regs := ptaiprop(hp.OptInfo)^.Regs;
-                    curprop.DirFlag := ptaiprop(hp.OptInfo)^.DirFlag;
-                    DestroyAllRegs(curprop,true,true)
-                  end;
-          end;
-{$endif JumpAnal}
-
-        ait_stab, ait_force_line, ait_function_name:;
-        ait_align: ; { may destroy flags !!! }
-        ait_instruction:
-          begin
-            if taicpu(p).is_jmp or
-               (taicpu(p).opcode = A_JMP) then
-             begin
-{$ifNDef JumpAnal}
-                for tmpsupreg := RS_EAX to RS_EDI do
-                  with curprop^.regs[tmpsupreg] do
-                    case typ of
-                      con_ref: typ := con_noRemoveRef;
-                      con_const: typ := con_noRemoveConst;
-                      con_invalid: typ := con_unknown;
-                    end;
-{$else JumpAnal}
-          With LTable^[tasmlabel(taicpu(p).oper[0]^.sym).labsymabelnr-LoLab] Do
-            if (RefsFound = tasmlabel(taicpu(p).oper[0]^.sym).RefCount) then
-              begin
-                if (InstrCnt < InstrNr)
-                  then
-                {forward jump}
-                    if (JmpsProcessed = 0) then
-                {no jump to this label has been processed yet}
-                      begin
-                        taiPropBlock^[InstrNr].Regs := curprop^.regs;
-                        taiPropBlock^[InstrNr].DirFlag := curprop.DirFlag;
-                        inc(JmpsProcessed);
-                      end
-                    else
-                      begin
-                        For tmpreg := RS_EAX to RS_EDI Do
-                          if (taiPropBlock^[InstrNr].Regs[tmpreg].WState <>
-                             curprop^.regs[tmpreg].WState) then
-                            DestroyReg(@taiPropBlock^[InstrNr], tmpreg, true);
-                        inc(JmpsProcessed);
-                      end
-{$ifdef AnalyzeLoops}
-                  else
-{                backward jump, a loop for example}
-{                    if (JmpsProcessed > 0) or
-                       not(GetLastInstruction(taiObj, hp) and
-                           (hp.typ = ait_labeled_instruction) and
-                           (taicpu_labeled(hp).opcode = A_JMP))
-                      then}
-{instruction prior to label is not a jmp, or at least one jump to the label
- has yet been processed}
-                        begin
-                          inc(JmpsProcessed);
-                          For tmpreg := RS_EAX to RS_EDI Do
-                            if (taiPropBlock^[InstrNr].Regs[tmpreg].WState <>
-                                curprop^.regs[tmpreg].WState)
-                              then
-                                begin
-                                  TmpState := taiPropBlock^[InstrNr].Regs[tmpreg].WState;
-                                  Cnt := InstrNr;
-                                  while (TmpState = taiPropBlock^[Cnt].Regs[tmpreg].WState) Do
-                                    begin
-                                      DestroyReg(@taiPropBlock^[Cnt], tmpreg, true);
-                                      inc(Cnt);
-                                    end;
-                                  while (Cnt <= InstrCnt) Do
-                                    begin
-                                      inc(taiPropBlock^[Cnt].Regs[tmpreg].WState);
-                                      inc(Cnt)
-                                    end
-                                end;
-                        end
-{                      else }
-{instruction prior to label is a jmp and no jumps to the label have yet been
- processed}
-{                        begin
-                          inc(JmpsProcessed);
-                          For tmpreg := RS_EAX to RS_EDI Do
-                            begin
-                              TmpState := taiPropBlock^[InstrNr].Regs[tmpreg].WState;
-                              Cnt := InstrNr;
-                              while (TmpState = taiPropBlock^[Cnt].Regs[tmpreg].WState) Do
-                                begin
-                                  taiPropBlock^[Cnt].Regs[tmpreg] := curprop^.regs[tmpreg];
-                                  inc(Cnt);
-                                end;
-                              TmpState := taiPropBlock^[InstrNr].Regs[tmpreg].WState;
-                              while (TmpState = taiPropBlock^[Cnt].Regs[tmpreg].WState) Do
-                                begin
-                                  DestroyReg(@taiPropBlock^[Cnt], tmpreg, true);
-                                  inc(Cnt);
-                                end;
-                              while (Cnt <= InstrCnt) Do
-                                begin
-                                  inc(taiPropBlock^[Cnt].Regs[tmpreg].WState);
-                                  inc(Cnt)
-                                end
-                            end
-                        end}
-{$endif AnalyzeLoops}
-          end;
-{$endif JumpAnal}
-          end
-          else
-           begin
-            InstrProp := InsProp[taicpu(p).opcode];
-            case taicpu(p).opcode Of
-              A_MOV, A_MOVZX, A_MOVSX:
-                begin
-                  case taicpu(p).oper[0]^.typ Of
-                    top_ref, top_reg:
-                      case taicpu(p).oper[1]^.typ Of
-                        top_reg:
-                          begin
-{$ifdef statedebug}
-                            hp := tai_comment.Create(strpnew('destroying '+std_regname(taicpu(p).oper[1]^.reg)));
-                            insertllitem(list,p,p.next,hp);
-{$endif statedebug}
-
-                            readOp(curprop, taicpu(p).oper[0]^);
-                            tmpsupreg := getsupreg(taicpu(p).oper[1]^.reg);
-                            if reginop(tmpsupreg, taicpu(p).oper[0]^) and
-                               (curprop^.regs[tmpsupreg].typ in [con_ref,con_noRemoveRef]) then
-                              begin
-                                with curprop^.regs[tmpsupreg] Do
-                                  begin
-                                    incState(wstate,1);
- { also store how many instructions are part of the sequence in the first }
- { instruction's ptaiprop, so it can be easily accessed from within       }
- { CheckSequence                                                          }
-                                    inc(nrOfMods, nrOfInstrSinceLastMod[tmpsupreg]);
-                                    ptaiprop(startmod.optinfo)^.regs[tmpsupreg].nrOfMods := nrOfMods;
-                                    nrOfInstrSinceLastMod[tmpsupreg] := 0;
-                                   { Destroy the contents of the registers  }
-                                   { that depended on the previous value of }
-                                   { this register                          }
-                                    invalidateDependingRegs(curprop,tmpsupreg);
-                                    curprop^.regs[tmpsupreg].memwrite := nil;
-                                end;
-                            end
-                          else
-                            begin
-{$ifdef statedebug}
-                              hp := tai_comment.Create(strpnew('destroying & initing '+std_regname(newreg(R_INTREGISTER,tmpsupreg,R_SUBWHOLE))));
-                              insertllitem(list,p,p.next,hp);
-{$endif statedebug}
-                              destroyReg(curprop, tmpsupreg, true);
-                              if not(reginop(tmpsupreg, taicpu(p).oper[0]^)) then
-                                with curprop^.regs[tmpsupreg] Do
-                                  begin
-                                    typ := con_ref;
-                                    startmod := p;
-                                    nrOfMods := 1;
-                                  end
-                            end;
-{$ifdef StateDebug}
-                            hp := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,tmpsupreg,R_SUBWHOLE))+': '+tostr(curprop^.regs[tmpsupreg].WState)));
-                            insertllitem(list,p,p.next,hp);
-{$endif StateDebug}
-                          end;
-                        top_ref:
-                          begin
-                            readref(curprop, taicpu(p).oper[1]^.ref);
-                            if taicpu(p).oper[0]^.typ = top_reg then
-                              begin
-                                readreg(curprop, getsupreg(taicpu(p).oper[0]^.reg));
-                                DestroyRefs(p, taicpu(p).oper[1]^.ref^, getsupreg(taicpu(p).oper[0]^.reg),topsize2tcgsize[taicpu(p).opsize]);
-                                ptaiprop(p.optinfo)^.regs[getsupreg(taicpu(p).oper[0]^.reg)].memwrite :=
-                                  taicpu(p);
-                              end
-                            else
-                              DestroyRefs(p, taicpu(p).oper[1]^.ref^, RS_INVALID,topsize2tcgsize[taicpu(p).opsize]);
-                          end;
-                      end;
-                    top_Const:
-                      begin
-                        case taicpu(p).oper[1]^.typ Of
-                          top_reg:
-                            begin
-                              tmpsupreg := getsupreg(taicpu(p).oper[1]^.reg);
-{$ifdef statedebug}
-                              hp := tai_comment.Create(strpnew('destroying '+std_regname(newreg(R_INTREGISTER,tmpsupreg,R_SUBWHOLE))));
-                              insertllitem(list,p,p.next,hp);
-{$endif statedebug}
-                              With curprop^.regs[tmpsupreg] Do
-                                begin
-                                  DestroyReg(curprop, tmpsupreg, true);
-                                  typ := Con_Const;
-                                  StartMod := p;
-                                  nrOfMods := 1;
-                                end
-                            end;
-                          top_ref:
-                            begin
-                              readref(curprop, taicpu(p).oper[1]^.ref);
-                              DestroyRefs(p, taicpu(p).oper[1]^.ref^, RS_INVALID,topsize2tcgsize[taicpu(p).opsize]);
-                            end;
-                        end;
-                      end;
-                  end;
-                end;
-              A_DIV, A_IDIV, A_MUL:
-                begin
-                  ReadOp(curprop, taicpu(p).oper[0]^);
-                  readreg(curprop,RS_EAX);
-                  if (taicpu(p).OpCode = A_IDIV) or
-                     (taicpu(p).OpCode = A_DIV) then
-                    begin
-                      readreg(curprop,RS_EDX);
-                    end;
-{$ifdef statedebug}
-                  hp := tai_comment.Create(strpnew('destroying eax and edx'));
-                  insertllitem(list,p,p.next,hp);
-{$endif statedebug}
-{                  DestroyReg(curprop, RS_EAX, true);}
-                  AddInstr2RegContents({$ifdef statedebug}list,{$endif}
-                    taicpu(p), RS_EAX);
-                  DestroyReg(curprop, RS_EDX, true);
-                  LastFlagsChangeProp := curprop;
-                end;
-              A_IMUL:
-                begin
-                  ReadOp(curprop,taicpu(p).oper[0]^);
-                  if (taicpu(p).ops >= 2) then
-                    ReadOp(curprop,taicpu(p).oper[1]^);
-                  if (taicpu(p).ops <= 2) then
-                    if (taicpu(p).ops=1) then
-                      begin
-                        readreg(curprop,RS_EAX);
-{$ifdef statedebug}
-                        hp := tai_comment.Create(strpnew('destroying eax and edx'));
-                        insertllitem(list,p,p.next,hp);
-{$endif statedebug}
-{                        DestroyReg(curprop, RS_EAX, true); }
-                        AddInstr2RegContents({$ifdef statedebug}list,{$endif}
-                          taicpu(p), RS_EAX);
-                        DestroyReg(curprop,RS_EDX, true)
-                      end
-                    else
-                      AddInstr2OpContents(
-                        {$ifdef statedebug}list,{$endif}
-                          taicpu(p), taicpu(p).oper[1]^)
-                  else
-                    AddInstr2OpContents({$ifdef statedebug}list,{$endif}
-                      taicpu(p), taicpu(p).oper[2]^);
-                  LastFlagsChangeProp := curprop;
-                end;
-              A_LEA:
-                begin
-                  readop(curprop,taicpu(p).oper[0]^);
-                  if reginref(getsupreg(taicpu(p).oper[1]^.reg),taicpu(p).oper[0]^.ref^) then
-                    AddInstr2RegContents({$ifdef statedebug}list,{$endif}
-                      taicpu(p), getsupreg(taicpu(p).oper[1]^.reg))
-                  else
-                    begin
-{$ifdef statedebug}
-                      hp := tai_comment.Create(strpnew('destroying & initing'+
-                        std_regname(taicpu(p).oper[1]^.reg)));
-                      insertllitem(list,p,p.next,hp);
-{$endif statedebug}
-                      destroyreg(curprop,getsupreg(taicpu(p).oper[1]^.reg),true);
-                      with curprop^.regs[getsupreg(taicpu(p).oper[1]^.reg)] Do
-                         begin
-                           typ := con_ref;
-                           startmod := p;
-                           nrOfMods := 1;
-                         end
-                    end;
-                end;
-              else
-                begin
-                  Cnt := 1;
-                  while (Cnt <= maxinschanges) and
-                        (InstrProp.Ch[Cnt] <> Ch_None) Do
-                    begin
-                      case InstrProp.Ch[Cnt] Of
-                        Ch_REAX..Ch_REDI:
-                          begin
-                            tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
-                            readreg(curprop,tmpsupreg);
-                          end;
-                        Ch_WEAX..Ch_RWEDI:
-                          begin
-                            if (InstrProp.Ch[Cnt] >= Ch_RWEAX) then
-                              begin
-                                tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
-                                readreg(curprop,tmpsupreg);
-                              end;
-{$ifdef statedebug}
-                            hp := tai_comment.Create(strpnew('destroying '+
-                              std_regname(tch2reg(InstrProp.Ch[Cnt]))));
-                            insertllitem(list,p,p.next,hp);
-{$endif statedebug}
-                            tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
-                            DestroyReg(curprop,tmpsupreg, true);
-                          end;
-                        Ch_MEAX..Ch_MEDI:
-                          begin
-                            tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
-                            AddInstr2RegContents({$ifdef statedebug} list,{$endif}
-                                                 taicpu(p),tmpsupreg);
-                          end;
-                        Ch_CDirFlag: curprop^.DirFlag := F_notSet;
-                        Ch_SDirFlag: curprop^.DirFlag := F_Set;
-                        Ch_Rop1: ReadOp(curprop, taicpu(p).oper[0]^);
-                        Ch_Rop2: ReadOp(curprop, taicpu(p).oper[1]^);
-                        Ch_ROp3: ReadOp(curprop, taicpu(p).oper[2]^);
-                        Ch_Wop1..Ch_RWop1:
-                          begin
-                            if (InstrProp.Ch[Cnt] in [Ch_RWop1]) then
-                              ReadOp(curprop, taicpu(p).oper[0]^);
-                            DestroyOp(p, taicpu(p).oper[0]^);
-                          end;
-                        Ch_Mop1:
-                          AddInstr2OpContents({$ifdef statedebug} list, {$endif}
-                            taicpu(p), taicpu(p).oper[0]^);
-                        Ch_Wop2..Ch_RWop2:
-                          begin
-                            if (InstrProp.Ch[Cnt] = Ch_RWop2) then
-                              ReadOp(curprop, taicpu(p).oper[1]^);
-                            DestroyOp(p, taicpu(p).oper[1]^);
-                          end;
-                        Ch_Mop2:
-                          AddInstr2OpContents({$ifdef statedebug} list, {$endif}
-                            taicpu(p), taicpu(p).oper[1]^);
-                        Ch_WOp3..Ch_RWOp3:
-                          begin
-                            if (InstrProp.Ch[Cnt] = Ch_RWOp3) then
-                              ReadOp(curprop, taicpu(p).oper[2]^);
-                            DestroyOp(p, taicpu(p).oper[2]^);
-                          end;
-                        Ch_Mop3:
-                          AddInstr2OpContents({$ifdef statedebug} list, {$endif}
-                            taicpu(p), taicpu(p).oper[2]^);
-                        Ch_WMemEDI:
-                          begin
-                            readreg(curprop, RS_EDI);
-                            fillchar(tmpref, SizeOf(tmpref), 0);
-                            tmpref.base := NR_EDI;
-                            tmpref.index := NR_EDI;
-                            DestroyRefs(p, tmpref,RS_INVALID,OS_32)
-                          end;
-                        Ch_RFlags:
-                          if assigned(LastFlagsChangeProp) then
-                            LastFlagsChangeProp^.FlagsUsed := true;
-                        Ch_WFlags:
-                          LastFlagsChangeProp := curprop;
-                        Ch_RWFlags:
-                          begin
-                            if assigned(LastFlagsChangeProp) then
-                              LastFlagsChangeProp^.FlagsUsed := true;
-                            LastFlagsChangeProp := curprop;
-                          end;
-                         Ch_FPU:;
-                        else
-                          begin
-{$ifdef statedebug}
-                            hp := tai_comment.Create(strpnew(
-                              'destroying all regs for prev instruction'));
-                            insertllitem(list,p, p.next,hp);
-{$endif statedebug}
-                            DestroyAllRegs(curprop,true,true);
-                            LastFlagsChangeProp := curprop;
-                          end;
-                      end;
-                      inc(Cnt);
-                    end
-                end;
-              end;
-            end;
-          end
-        else
-          begin
-{$ifdef statedebug}
-            hp := tai_comment.Create(strpnew(
-              'destroying all regs: unknown tai: '+tostr(ord(p.typ))));
-            insertllitem(list,p, p.next,hp);
-{$endif statedebug}
-            DestroyAllRegs(curprop,true,true);
-          end;
-      end;
-      inc(InstrCnt);
-      prev := p;
-      GetNextInstruction(p, p);
-    end;
-end;
-
-
-function tdfaobj.pass_generate_code: boolean;
-begin
-  if initdfapass2 then
-    begin
-      dodfapass2;
-      pass_generate_code := true
-    end
-  else
-    pass_generate_code := false;
-end;
-
-{$push}
-{$r-}
-function tdfaobj.getlabelwithsym(sym: tasmlabel): tai;
-begin
-  if (sym.labelnr >= lolab) and
-     (sym.labelnr <= hilab) then   { range check, a jump can go past an assembler block! }
-    getlabelwithsym := labeltable^[sym.labelnr-lolab].taiobj
-  else
-    getlabelwithsym := nil;
-end;
-{$pop}
-
-
-procedure tdfaobj.clear;
-begin
-  if labdif <> 0 then
-    begin
-      freemem(labeltable);
-      labeltable := nil;
-    end;
-  if assigned(taipropblock) then
-    begin
-      freemem(taipropblock, nroftaiobjs*sizeof(ttaiprop));
-      taipropblock := nil;
-    end;
-end;
-
-
-end.

compiler/i386/hlcgcpu.pas

@@ -192,7 +192,6 @@ implementation
     need_got_load:=not (target_info.system in systems_darwin) and
                    (cs_create_pic in current_settings.moduleswitches) and
                    (tf_pic_uses_got in target_info.flags) and
-                   (pi_needs_got in current_procinfo.flags) and
                    (po_external in pd.procoptions);
     if need_got_load then
       begin

compiler/i386/i386att.inc

@@ -670,6 +670,7 @@
 'aesdeclast',
 'aesimc',
 'aeskeygenassist',
+'rdtscp',
 'vaddpd',
 'vaddps',
 'vaddsd',
@@ -1024,5 +1025,14 @@
 'vfnmsub231sd',
 'vfnmsub132ss',
 'vfnmsub213ss',
-'vfnmsub231ss'
+'vfnmsub231ss',
+'xacquire',
+'xrelease',
+'xbegin',
+'xabort',
+'xend',
+'xtest',
+'rdrand',
+'rdseed',
+'xgetbv'
 );

compiler/i386/i386atts.inc

@@ -45,8 +45,8 @@ attsufNONE,
 attsufNONE,
 attsufFPU,
 attsufFPU,
-attsufFPU,
-attsufFPU,
+attsufNONE,
+attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufFPU,
@@ -701,6 +701,7 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufNONE,
 attsufMM,
 attsufMM,
 attsufNONE,
@@ -1024,5 +1025,14 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufINT,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
 attsufNONE
 );

compiler/i386/i386int.inc

@@ -670,6 +670,7 @@
 'aesdeclast',
 'aesimc',
 'aeskeygenassist',
+'rdtscp',
 'vaddpd',
 'vaddps',
 'vaddsd',
@@ -1024,5 +1025,14 @@
 'vfnmsub231sd',
 'vfnmsub132ss',
 'vfnmsub213ss',
-'vfnmsub231ss'
+'vfnmsub231ss',
+'xacquire',
+'xrelease',
+'xbegin',
+'xabort',
+'xend',
+'xtest',
+'rdrand',
+'rdseed',
+'xgetbv'
 );

compiler/i386/i386nop.inc

@@ -1,2 +1,2 @@
 { don't edit, this file is generated from x86ins.dat }
-1942;
+1952;

compiler/i386/i386op.inc

@@ -670,6 +670,7 @@ A_AESDEC,
 A_AESDECLAST,
 A_AESIMC,
 A_AESKEYGENASSIST,
+A_RDTSCP,
 A_VADDPD,
 A_VADDPS,
 A_VADDSD,
@@ -1024,5 +1025,14 @@ A_VFNMSUB213SD,
 A_VFNMSUB231SD,
 A_VFNMSUB132SS,
 A_VFNMSUB213SS,
-A_VFNMSUB231SS
+A_VFNMSUB231SS,
+A_XACQUIRE,
+A_XRELEASE,
+A_XBEGIN,
+A_XABORT,
+A_XEND,
+A_XTEST,
+A_RDRAND,
+A_RDSEED,
+A_XGETBV
 );

compiler/i386/i386prop.inc

@@ -670,6 +670,7 @@
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_WEAX, Ch_WEDX, Ch_None)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
@@ -699,22 +700,22 @@
 (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_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_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_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, 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_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
@@ -1024,5 +1025,14 @@
 (Ch: (Ch_Mop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Mop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Mop3, Ch_Rop2, Ch_Rop1)),
-(Ch: (Ch_Mop3, Ch_Rop2, Ch_Rop1))
+(Ch: (Ch_Mop3, Ch_Rop2, Ch_Rop1)),
+(Ch: (Ch_None, Ch_None, Ch_None)),
+(Ch: (Ch_None, Ch_None, Ch_None)),
+(Ch: (Ch_None, Ch_None, Ch_None)),
+(Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_None, Ch_None, Ch_None)),
+(Ch: (Ch_WFlags, Ch_None, Ch_None)),
+(Ch: (Ch_Wop1, Ch_WFlags, CH_None)),
+(Ch: (Ch_Wop1, Ch_WFlags, CH_None)),
+(Ch: (Ch_WEAX, Ch_WEDX, Ch_RECX))
 );

compiler/i386/i386tab.inc

@@ -2308,56 +2308,56 @@
     ops     : 3;
     optypes : (ot_reg32 or ot_bits64,ot_rm_gpr,ot_immediate or ot_bits8 or ot_signed,ot_none);
     code    : #208#1#107#72#14;
-    flags   : if_286 or if_sm
+    flags   : if_386 or if_sm
   ),
   (
     opcode  : A_IMUL;
     ops     : 3;
     optypes : (ot_reg32 or ot_bits64,ot_rm_gpr,ot_immediate,ot_none);
     code    : #208#1#105#72#34;
-    flags   : if_286 or if_sm or if_sd or if_ar2
+    flags   : if_386 or if_sm or if_sd or if_ar2
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none);
     code    : #208#1#107#64#13;
-    flags   : if_286
+    flags   : if_386
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg32,ot_immediate,ot_none,ot_none);
     code    : #213#1#105#64#33;
-    flags   : if_286 or if_sd
+    flags   : if_386 or if_sd
   ),
   (
     opcode  : A_IMUL;
     ops     : 3;
     optypes : (ot_reg16,ot_rm_gpr,ot_immediate or ot_bits8 or ot_signed,ot_none);
     code    : #212#1#107#72#14;
-    flags   : if_286 or if_sm
+    flags   : if_186 or if_sm
   ),
   (
     opcode  : A_IMUL;
     ops     : 3;
     optypes : (ot_reg16,ot_rm_gpr,ot_immediate,ot_none);
     code    : #212#1#105#72#26;
-    flags   : if_286 or if_sm or if_sw or if_ar2
+    flags   : if_186 or if_sm or if_sw or if_ar2
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg16,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none);
     code    : #212#1#107#64#13;
-    flags   : if_286
+    flags   : if_186
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg16,ot_immediate,ot_none,ot_none);
     code    : #212#1#105#64#25;
-    flags   : if_286 or if_sw
+    flags   : if_186 or if_sw
   ),
   (
     opcode  : A_IMUL;
@@ -4009,7 +4009,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #215#1#157;
-    flags   : if_186 or if_nox86_64
+    flags   : if_8086 or if_nox86_64
   ),
   (
     opcode  : A_POPFD;
@@ -4023,7 +4023,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #212#1#157;
-    flags   : if_186 or if_nox86_64
+    flags   : if_8086 or if_nox86_64
   ),
   (
     opcode  : A_POR;
@@ -4520,14 +4520,14 @@
     ops     : 1;
     optypes : (ot_immediate or ot_bits16,ot_none,ot_none,ot_none);
     code    : #212#1#104#24#221;
-    flags   : if_286
+    flags   : if_186
   ),
   (
     opcode  : A_PUSH;
     ops     : 1;
     optypes : (ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none,ot_none);
     code    : #1#106#12#221;
-    flags   : if_286
+    flags   : if_186
   ),
   (
     opcode  : A_PUSH;
@@ -4569,7 +4569,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #215#1#156;
-    flags   : if_186
+    flags   : if_8086
   ),
   (
     opcode  : A_PUSHFD;
@@ -4583,7 +4583,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #212#1#156;
-    flags   : if_186
+    flags   : if_8086
   ),
   (
     opcode  : A_PXOR;
@@ -4618,7 +4618,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#130#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_RCL;
@@ -4660,7 +4660,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#131#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_RCR;
@@ -4807,7 +4807,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#128#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_ROL;
@@ -4849,7 +4849,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#129#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_ROR;
@@ -4919,7 +4919,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#132#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_SAL;
@@ -4968,7 +4968,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#135#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_SAR;
@@ -5115,14 +5115,14 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #1#100;
-    flags   : if_8086 or if_pre
+    flags   : if_386 or if_pre
   ),
   (
     opcode  : A_SEGGS;
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #1#101;
-    flags   : if_8086 or if_pre
+    flags   : if_386 or if_pre
   ),
   (
     opcode  : A_SEGSS;
@@ -7677,21 +7677,21 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #219#3#15#166#192;
-    flags   : if_centaur
+    flags   : if_p6 or if_cyrix
   ),
   (
     opcode  : A_XSHA1;
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #219#3#15#166#200;
-    flags   : if_centaur
+    flags   : if_p6 or if_cyrix
   ),
   (
     opcode  : A_XSHA256;
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #219#3#15#166#208;
-    flags   : if_centaur
+    flags   : if_p6 or if_cyrix
   ),
   (
     opcode  : A_DMINT;
@@ -8449,6 +8449,13 @@
     code    : #241#3#15#58#223#72#22;
     flags   : if_sse4 or if_sb or if_ar2
   ),
+  (
+    opcode  : A_RDTSCP;
+    ops     : 0;
+    optypes : (ot_none,ot_none,ot_none,ot_none);
+    code    : #3#15#1#249;
+    flags   : if_sse4 or if_sm
+  ),
   (
     opcode  : A_VADDPD;
     ops     : 3;
@@ -13593,5 +13600,68 @@
     optypes : (ot_xmmreg,ot_xmmreg,ot_xmmrm,ot_none);
     code    : #241#242#249#1#191#61#80;
     flags   : if_fma
+  ),
+  (
+    opcode  : A_XACQUIRE;
+    ops     : 0;
+    optypes : (ot_none,ot_none,ot_none,ot_none);
+    code    : #1#242;
+    flags   : if_tsx
+  ),
+  (
+    opcode  : A_XRELEASE;
+    ops     : 0;
+    optypes : (ot_none,ot_none,ot_none,ot_none);
+    code    : #1#243;
+    flags   : if_tsx
+  ),
+  (
+    opcode  : A_XBEGIN;
+    ops     : 1;
+    optypes : (ot_memory,ot_none,ot_none,ot_none);
+    code    : #208#2#199#248#52;
+    flags   : if_tsx
+  ),
+  (
+    opcode  : A_XABORT;
+    ops     : 1;
+    optypes : (ot_immediate,ot_none,ot_none,ot_none);
+    code    : #2#198#248#20;
+    flags   : if_tsx or if_sb
+  ),
+  (
+    opcode  : A_XEND;
+    ops     : 0;
+    optypes : (ot_none,ot_none,ot_none,ot_none);
+    code    : #3#15#1#213;
+    flags   : if_tsx
+  ),
+  (
+    opcode  : A_XTEST;
+    ops     : 0;
+    optypes : (ot_none,ot_none,ot_none,ot_none);
+    code    : #3#15#1#214;
+    flags   : if_tsx
+  ),
+  (
+    opcode  : A_RDRAND;
+    ops     : 1;
+    optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none);
+    code    : #208#2#15#199#134;
+    flags   : if_rand
+  ),
+  (
+    opcode  : A_RDSEED;
+    ops     : 1;
+    optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none);
+    code    : #208#2#15#199#135;
+    flags   : if_rand
+  ),
+  (
+    opcode  : A_XGETBV;
+    ops     : 0;
+    optypes : (ot_none,ot_none,ot_none,ot_none);
+    code    : #3#15#1#208;
+    flags   : if_xsave
   )
 );

compiler/i386/n386add.pas

@@ -190,11 +190,13 @@ interface
             begin
               r:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
               cg64.a_load64low_loc_reg(current_asmdata.CurrAsmList,right.location,r);
+              cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
               emit_reg_reg(op1,opsize,left.location.register64.reglo,r);
               emit_reg_reg(A_MOV,opsize,r,left.location.register64.reglo);
               cg64.a_load64high_loc_reg(current_asmdata.CurrAsmList,right.location,r);
               { the carry flag is still ok }
               emit_reg_reg(op2,opsize,left.location.register64.reghi,r);
+              cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
               emit_reg_reg(A_MOV,opsize,r,left.location.register64.reghi);
             end
            else

compiler/i386/n386cal.pas

@@ -69,7 +69,11 @@ implementation
               // one syscall convention for AROS
               current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('AROS SysCall')));
               reference_reset(tmpref,sizeof(pint));
-              tmpref.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(tcpuprocdef(procdefinition).libsym).mangledname);
+              { re-read the libbase pushed first on the stack, instead of just trusting the
+                mangledname will work. this is important for example for threadvar libbases.
+                and this way they also don't need to be resolved twice then. (KB) }
+              tmpref.base:=NR_ESP;
+              tmpref.offset:=pushedparasize-sizeof(pint);
               cg.getcpuregister(current_asmdata.CurrAsmList,NR_EAX);
               cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,tmpref,NR_EAX);
               reference_reset_base(tmpref,NR_EAX,-tprocdef(procdefinition).extnumber,sizeof(pint));

compiler/i8086/cgcpu.pas

@@ -1818,6 +1818,24 @@ unit cgcpu;
       var
         stacksize : longint;
         ret_instr: TAsmOp;
+        sp_moved : boolean;
+
+      procedure maybe_move_sp;
+        var
+          ref : treference;
+        begin
+          if sp_moved then 
+            exit;
+          if not(pi_has_open_array_parameter in current_procinfo.flags) then
+            exit;
+          { Restore SP position before SP change }
+          if current_settings.x86memorymodel=mm_huge then
+            stacksize:=stacksize + 2;
+          reference_reset_base(ref,NR_BP,-stacksize,2);
+          list.concat(Taicpu.op_ref_reg(A_LEA,S_W,ref,NR_SP));
+          sp_moved:=true;
+        end;
+
       begin
         if is_proc_far(current_procinfo.procdef) then
           ret_instr:=A_RETF
@@ -1828,12 +1846,22 @@ unit cgcpu;
            (rg[R_MMXREGISTER].uses_registers) then
           list.concat(Taicpu.op_none(A_EMMS,S_NO));
 
+        sp_moved:=false;
         { remove stackframe }
         if not nostackframe then
           begin
+            stacksize:=current_procinfo.calc_stackframe_size;
+            if (target_info.stackalign>4) and
+               ((stacksize <> 0) or
+                (pi_do_call in current_procinfo.flags) or
+                { can't detect if a call in this case -> use nostackframe }
+                { if you (think you) know what you are doing              }
+                (po_assembler in current_procinfo.procdef.procoptions)) then
+              stacksize := align(stacksize+sizeof(aint),target_info.stackalign) - sizeof(aint);
             if (po_exports in current_procinfo.procdef.procoptions) and
                (target_info.system=system_i8086_win16) then
               begin
+                maybe_move_sp;
                 list.concat(Taicpu.Op_reg(A_POP,S_W,NR_DI));
                 list.concat(Taicpu.Op_reg(A_POP,S_W,NR_SI));
               end;
@@ -1841,17 +1869,12 @@ unit cgcpu;
                 not (po_interrupt in current_procinfo.procdef.procoptions)) or
                ((po_exports in current_procinfo.procdef.procoptions) and
                 (target_info.system=system_i8086_win16)) then
-              list.concat(Taicpu.Op_reg(A_POP,S_W,NR_DS));
+              begin
+                maybe_move_sp;
+                list.concat(Taicpu.Op_reg(A_POP,S_W,NR_DS));
+              end;
             if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
               begin
-                stacksize:=current_procinfo.calc_stackframe_size;
-                if (target_info.stackalign>4) and
-                   ((stacksize <> 0) or
-                    (pi_do_call in current_procinfo.flags) or
-                    { can't detect if a call in this case -> use nostackframe }
-                    { if you (think you) know what you are doing              }
-                    (po_assembler in current_procinfo.procdef.procoptions)) then
-                  stacksize := align(stacksize+sizeof(aint),target_info.stackalign) - sizeof(aint);
                 if (stacksize<>0) then
                   cg.a_op_const_reg(list,OP_ADD,OS_ADDR,stacksize,current_procinfo.framepointer);
               end
@@ -1921,6 +1944,8 @@ unit cgcpu;
         a_load_loc_reg(list,OS_INT,lenloc,NR_DI);
         list.concat(Taicpu.op_reg(A_INC,S_W,NR_DI));
         { Now DI contains (high+1). }
+	
+        include(current_procinfo.flags, pi_has_open_array_parameter);
 
         { special case handling for elesize=2:
           set CX = (high+1) instead of CX = (high+1)*elesize.
@@ -2034,7 +2059,7 @@ unit cgcpu;
 
     procedure tcg8086.g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
       begin
-        { Nothing to release }
+        { Nothing to do }
       end;
 
 

compiler/i8086/cpuinfo.pas

@@ -48,6 +48,7 @@ Type
        cpu_186,
        cpu_286,
        cpu_386,
+       cpu_486,
        cpu_Pentium,
        cpu_Pentium2,
        cpu_Pentium3,
@@ -113,6 +114,7 @@ Const
      '80186',
      '80286',
      '80386',
+     '80486',
      'PENTIUM',
      'PENTIUM2',
      'PENTIUM3',

compiler/i8086/hlcgcpu.pas

@@ -248,6 +248,15 @@ implementation
       if is_implicit_pointer_object_type(size) or is_implicit_array_pointer(size) then
         size:=voidpointertype;
 
+      { procvars follow the default code pointer size for the current memory model }
+      if size.typ=procvardef then
+        if ((po_methodpointer in tprocvardef(size).procoptions) or
+            is_nested_pd(tprocvardef(size))) and
+           not(po_addressonly in tprocvardef(size).procoptions) then
+          internalerror(2015120101)
+        else
+          size:=voidcodepointertype;
+
       if is_farpointer(size) or is_hugepointer(size) then
         Result:=cg.getintregister(list,OS_32)
       else

compiler/i8086/i8086att.inc

@@ -670,6 +670,7 @@
 'aesdeclast',
 'aesimc',
 'aeskeygenassist',
+'rdtscp',
 'vaddpd',
 'vaddps',
 'vaddsd',
@@ -1038,5 +1039,14 @@
 'vfnmsub231sd',
 'vfnmsub132ss',
 'vfnmsub213ss',
-'vfnmsub231ss'
+'vfnmsub231ss',
+'xacquire',
+'xrelease',
+'xbegin',
+'xabort',
+'xend',
+'xtest',
+'rdrand',
+'rdseed',
+'xgetbv'
 );

compiler/i8086/i8086atts.inc

@@ -45,8 +45,8 @@ attsufNONE,
 attsufNONE,
 attsufFPU,
 attsufFPU,
-attsufFPU,
-attsufFPU,
+attsufNONE,
+attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufFPU,
@@ -701,6 +701,7 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufNONE,
 attsufMM,
 attsufMM,
 attsufNONE,
@@ -1038,5 +1039,14 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufINT,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
 attsufNONE
 );

compiler/i8086/i8086int.inc

@@ -670,6 +670,7 @@
 'aesdeclast',
 'aesimc',
 'aeskeygenassist',
+'rdtscp',
 'vaddpd',
 'vaddps',
 'vaddsd',
@@ -1038,5 +1039,14 @@
 'vfnmsub231sd',
 'vfnmsub132ss',
 'vfnmsub213ss',
-'vfnmsub231ss'
+'vfnmsub231ss',
+'xacquire',
+'xrelease',
+'xbegin',
+'xabort',
+'xend',
+'xtest',
+'rdrand',
+'rdseed',
+'xgetbv'
 );

compiler/i8086/i8086nop.inc

@@ -1,2 +1,2 @@
 { don't edit, this file is generated from x86ins.dat }
-1972;
+1984;

compiler/i8086/i8086op.inc

@@ -670,6 +670,7 @@ A_AESDEC,
 A_AESDECLAST,
 A_AESIMC,
 A_AESKEYGENASSIST,
+A_RDTSCP,
 A_VADDPD,
 A_VADDPS,
 A_VADDSD,
@@ -1038,5 +1039,14 @@ A_VFNMSUB213SD,
 A_VFNMSUB231SD,
 A_VFNMSUB132SS,
 A_VFNMSUB213SS,
-A_VFNMSUB231SS
+A_VFNMSUB231SS,
+A_XACQUIRE,
+A_XRELEASE,
+A_XBEGIN,
+A_XABORT,
+A_XEND,
+A_XTEST,
+A_RDRAND,
+A_RDSEED,
+A_XGETBV
 );

compiler/i8086/i8086prop.inc

@@ -670,6 +670,7 @@
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_WEAX, Ch_WEDX, Ch_None)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
@@ -699,22 +700,22 @@
 (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_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_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_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, 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_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
@@ -1038,5 +1039,14 @@
 (Ch: (Ch_Mop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Mop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Mop3, Ch_Rop2, Ch_Rop1)),
-(Ch: (Ch_Mop3, Ch_Rop2, Ch_Rop1))
+(Ch: (Ch_Mop3, Ch_Rop2, Ch_Rop1)),
+(Ch: (Ch_None, Ch_None, Ch_None)),
+(Ch: (Ch_None, Ch_None, Ch_None)),
+(Ch: (Ch_None, Ch_None, Ch_None)),
+(Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_None, Ch_None, Ch_None)),
+(Ch: (Ch_WFlags, Ch_None, Ch_None)),
+(Ch: (Ch_Wop1, Ch_WFlags, CH_None)),
+(Ch: (Ch_Wop1, Ch_WFlags, CH_None)),
+(Ch: (Ch_WEAX, Ch_WEDX, Ch_RECX))
 );

compiler/i8086/i8086tab.inc

@@ -378,6 +378,13 @@
     code    : #208#2#15#186#133#21;
     flags   : if_386 or if_sb
   ),
+  (
+    opcode  : A_CALL;
+    ops     : 1;
+    optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none);
+    code    : #212#1#255#130;
+    flags   : if_8086 or if_16bitonly
+  ),
   (
     opcode  : A_CALL;
     ops     : 1;
@@ -2308,56 +2315,56 @@
     ops     : 3;
     optypes : (ot_reg32 or ot_bits64,ot_rm_gpr,ot_immediate or ot_bits8 or ot_signed,ot_none);
     code    : #208#1#107#72#14;
-    flags   : if_286 or if_sm
+    flags   : if_386 or if_sm
   ),
   (
     opcode  : A_IMUL;
     ops     : 3;
     optypes : (ot_reg32 or ot_bits64,ot_rm_gpr,ot_immediate,ot_none);
     code    : #208#1#105#72#34;
-    flags   : if_286 or if_sm or if_sd or if_ar2
+    flags   : if_386 or if_sm or if_sd or if_ar2
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none);
     code    : #208#1#107#64#13;
-    flags   : if_286
+    flags   : if_386
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg32,ot_immediate,ot_none,ot_none);
     code    : #213#1#105#64#33;
-    flags   : if_286 or if_sd
+    flags   : if_386 or if_sd
   ),
   (
     opcode  : A_IMUL;
     ops     : 3;
     optypes : (ot_reg16,ot_rm_gpr,ot_immediate or ot_bits8 or ot_signed,ot_none);
     code    : #212#1#107#72#14;
-    flags   : if_286 or if_sm
+    flags   : if_186 or if_sm
   ),
   (
     opcode  : A_IMUL;
     ops     : 3;
     optypes : (ot_reg16,ot_rm_gpr,ot_immediate,ot_none);
     code    : #212#1#105#72#26;
-    flags   : if_286 or if_sm or if_sw or if_ar2
+    flags   : if_186 or if_sm or if_sw or if_ar2
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg16,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none);
     code    : #212#1#107#64#13;
-    flags   : if_286
+    flags   : if_186
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg16,ot_immediate,ot_none,ot_none);
     code    : #212#1#105#64#25;
-    flags   : if_286 or if_sw
+    flags   : if_186 or if_sw
   ),
   (
     opcode  : A_IMUL;
@@ -2541,6 +2548,13 @@
     code    : #208#1#233#52;
     flags   : if_8086 or if_pass2
   ),
+  (
+    opcode  : A_JMP;
+    ops     : 1;
+    optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none);
+    code    : #212#1#255#132;
+    flags   : if_8086 or if_16bitonly
+  ),
   (
     opcode  : A_JMP;
     ops     : 1;
@@ -4009,7 +4023,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #215#1#157;
-    flags   : if_186 or if_nox86_64
+    flags   : if_8086 or if_nox86_64
   ),
   (
     opcode  : A_POPFD;
@@ -4023,7 +4037,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #212#1#157;
-    flags   : if_186 or if_nox86_64
+    flags   : if_8086 or if_nox86_64
   ),
   (
     opcode  : A_POR;
@@ -4520,14 +4534,14 @@
     ops     : 1;
     optypes : (ot_immediate or ot_bits16,ot_none,ot_none,ot_none);
     code    : #212#1#104#24#221;
-    flags   : if_286
+    flags   : if_186
   ),
   (
     opcode  : A_PUSH;
     ops     : 1;
     optypes : (ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none,ot_none);
     code    : #1#106#12#221;
-    flags   : if_286
+    flags   : if_186
   ),
   (
     opcode  : A_PUSH;
@@ -4569,7 +4583,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #215#1#156;
-    flags   : if_186
+    flags   : if_8086
   ),
   (
     opcode  : A_PUSHFD;
@@ -4583,7 +4597,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #212#1#156;
-    flags   : if_186
+    flags   : if_8086
   ),
   (
     opcode  : A_PXOR;
@@ -4618,7 +4632,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#130#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_RCL;
@@ -4660,7 +4674,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#131#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_RCR;
@@ -4807,7 +4821,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#128#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_ROL;
@@ -4849,7 +4863,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#129#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_ROR;
@@ -4919,7 +4933,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#132#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_SAL;
@@ -4968,7 +4982,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#135#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_SAR;
@@ -5115,14 +5129,14 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #1#100;
-    flags   : if_8086 or if_pre
+    flags   : if_386 or if_pre
   ),
   (
     opcode  : A_SEGGS;
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #1#101;
-    flags   : if_8086 or if_pre
+    flags   : if_386 or if_pre
   ),
   (
     opcode  : A_SEGSS;
@@ -7691,21 +7705,21 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #219#3#15#166#192;
-    flags   : if_centaur
+    flags   : if_p6 or if_cyrix
   ),
   (
     opcode  : A_XSHA1;
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #219#3#15#166#200;
-    flags   : if_centaur
+    flags   : if_p6 or if_cyrix
   ),
   (
     opcode  : A_XSHA256;
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #219#3#15#166#208;
-    flags   : if_centaur
+    flags   : if_p6 or if_cyrix
   ),
   (
     opcode  : A_DMINT;
@@ -8463,6 +8477,13 @@
     code    : #241#3#15#58#223#72#22;
     flags   : if_sse4 or if_sb or if_ar2
   ),
+  (
+    opcode  : A_RDTSCP;
+    ops     : 0;
+    optypes : (ot_none,ot_none,ot_none,ot_none);
+    code    : #3#15#1#249;
+    flags   : if_sse4 or if_sm
+  ),
   (
     opcode  : A_VADDPD;
     ops     : 3;
@@ -12955,14 +12976,14 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none);
     code    : #2#15#26#128#21;
-    flags   : if_nec or if_sb or if_16bitonly
+    flags   : if_nec or if_sb or if_imm3 or if_16bitonly
   ),
   (
     opcode  : A_CLR1;
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none);
     code    : #2#15#27#128#21;
-    flags   : if_nec or if_sw or if_16bitonly
+    flags   : if_nec or if_sw or if_imm4 or if_16bitonly
   ),
   (
     opcode  : A_CMP4S;
@@ -12983,7 +13004,7 @@
     ops     : 2;
     optypes : (ot_reg8,ot_immediate,ot_none,ot_none);
     code    : #2#15#59#128#21;
-    flags   : if_nec or if_sb or if_16bitonly
+    flags   : if_nec or if_sb or if_imm4 or if_16bitonly
   ),
   (
     opcode  : A_INS;
@@ -12997,7 +13018,7 @@
     ops     : 2;
     optypes : (ot_reg8,ot_immediate,ot_none,ot_none);
     code    : #2#15#57#128#21;
-    flags   : if_nec or if_sb or if_16bitonly
+    flags   : if_nec or if_sb or if_imm4 or if_16bitonly
   ),
   (
     opcode  : A_NOT1;
@@ -13018,14 +13039,14 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none);
     code    : #2#15#30#128#21;
-    flags   : if_nec or if_sb or if_16bitonly
+    flags   : if_nec or if_sb or if_imm3 or if_16bitonly
   ),
   (
     opcode  : A_NOT1;
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none);
     code    : #2#15#31#128#21;
-    flags   : if_nec or if_sw or if_16bitonly
+    flags   : if_nec or if_sw or if_imm4 or if_16bitonly
   ),
   (
     opcode  : A_REPC;
@@ -13074,14 +13095,14 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none);
     code    : #2#15#28#128#21;
-    flags   : if_nec or if_sb or if_16bitonly
+    flags   : if_nec or if_sb or if_imm3 or if_16bitonly
   ),
   (
     opcode  : A_SET1;
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none);
     code    : #2#15#29#128#21;
-    flags   : if_nec or if_sw or if_16bitonly
+    flags   : if_nec or if_sw or if_imm4 or if_16bitonly
   ),
   (
     opcode  : A_SUB4S;
@@ -13109,14 +13130,14 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none);
     code    : #2#15#24#128#21;
-    flags   : if_nec or if_sb or if_16bitonly
+    flags   : if_nec or if_sb or if_imm3 or if_16bitonly
   ),
   (
     opcode  : A_TEST1;
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none);
     code    : #2#15#25#128#21;
-    flags   : if_nec or if_sw or if_16bitonly
+    flags   : if_nec or if_sw or if_imm4 or if_16bitonly
   ),
   (
     opcode  : A_VFMADD132PD;
@@ -13803,5 +13824,68 @@
     optypes : (ot_xmmreg,ot_xmmreg,ot_xmmrm,ot_none);
     code    : #241#242#249#1#191#61#80;
     flags   : if_fma
+  ),
+  (
+    opcode  : A_XACQUIRE;
+    ops     : 0;
+    optypes : (ot_none,ot_none,ot_none,ot_none);
+    code    : #1#242;
+    flags   : if_tsx
+  ),
+  (
+    opcode  : A_XRELEASE;
+    ops     : 0;
+    optypes : (ot_none,ot_none,ot_none,ot_none);
+    code    : #1#243;
+    flags   : if_tsx
+  ),
+  (
+    opcode  : A_XBEGIN;
+    ops     : 1;
+    optypes : (ot_memory,ot_none,ot_none,ot_none);
+    code    : #208#2#199#248#52;
+    flags   : if_tsx
+  ),
+  (
+    opcode  : A_XABORT;
+    ops     : 1;
+    optypes : (ot_immediate,ot_none,ot_none,ot_none);
+    code    : #2#198#248#20;
+    flags   : if_tsx or if_sb
+  ),
+  (
+    opcode  : A_XEND;
+    ops     : 0;
+    optypes : (ot_none,ot_none,ot_none,ot_none);
+    code    : #3#15#1#213;
+    flags   : if_tsx
+  ),
+  (
+    opcode  : A_XTEST;
+    ops     : 0;
+    optypes : (ot_none,ot_none,ot_none,ot_none);
+    code    : #3#15#1#214;
+    flags   : if_tsx
+  ),
+  (
+    opcode  : A_RDRAND;
+    ops     : 1;
+    optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none);
+    code    : #208#2#15#199#134;
+    flags   : if_rand
+  ),
+  (
+    opcode  : A_RDSEED;
+    ops     : 1;
+    optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none);
+    code    : #208#2#15#199#135;
+    flags   : if_rand
+  ),
+  (
+    opcode  : A_XGETBV;
+    ops     : 0;
+    optypes : (ot_none,ot_none,ot_none,ot_none);
+    code    : #3#15#1#208;
+    flags   : if_xsave
   )
 );

compiler/jvm/agjasmin.pas

@@ -502,6 +502,10 @@ implementation
 
              ait_directive :
                begin
+                 { the CPU directive is probably not supported by the JVM assembler,
+                   so it's commented out }
+                 if tai_directive(hp).directive=asd_cpu then
+                   writer.AsmWrite(asminfo^.comment);
                  writer.AsmWrite('.'+directivestr[tai_directive(hp).directive]+' ');
                  if tai_directive(hp).name<>'' then
                    writer.AsmWrite(tai_directive(hp).name);
@@ -1098,39 +1102,26 @@ implementation
 
 
     procedure TJasminAssembler.WriteAsmList;
-    begin
-{$ifdef EXTDEBUG}
-      if assigned(current_module.mainsource) then
-       Comment(V_Debug,'Start writing Jasmin-styled assembler output for '+current_module.mainsource);
-{$endif}
-
-      writer.MarkEmpty;
-      WriteExtraHeader(nil);
-(*
-      for hal:=low(TasmlistType) to high(TasmlistType) do
-        begin
-          writer.AsmWriteLn(asminfo^.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
-          writetree(current_asmdata.asmlists[hal]);
-          writer.AsmWriteLn(asminfo^.comment+'End asmlist '+AsmlistTypeStr[hal]);
-        end;
-*)
-      { print all global variables }
-      WriteSymtableVarSyms(current_module.globalsymtable);
-      WriteSymtableVarSyms(current_module.localsymtable);
-      writer.AsmLn;
-      { print all global procedures/functions }
-      WriteSymtableProcdefs(current_module.globalsymtable);
-      WriteSymtableProcdefs(current_module.localsymtable);
-
-      WriteSymtableStructDefs(current_module.globalsymtable);
-      WriteSymtableStructDefs(current_module.localsymtable);
-
-      writer.AsmLn;
-{$ifdef EXTDEBUG}
-      if assigned(current_module.mainsource) then
-       Comment(V_Debug,'Done writing gas-styled assembler output for '+current_module.mainsource);
-{$endif EXTDEBUG}
-    end;
+      begin
+        { the code for Java methods needs to be emitted class per class,
+          so instead of iterating over all asmlists, we iterate over all types
+          and global variables (a unit becomes a class, with its global
+          variables static fields) }
+        writer.MarkEmpty;
+        WriteExtraHeader(nil);
+        { print all global variables }
+        WriteSymtableVarSyms(current_module.globalsymtable);
+        WriteSymtableVarSyms(current_module.localsymtable);
+        writer.AsmLn;
+        { print all global procedures/functions }
+        WriteSymtableProcdefs(current_module.globalsymtable);
+        WriteSymtableProcdefs(current_module.localsymtable);
+
+        WriteSymtableStructDefs(current_module.globalsymtable);
+        WriteSymtableStructDefs(current_module.localsymtable);
+
+        writer.AsmLn;
+      end;
 
 
 {****************************************************************************}

compiler/jvm/njvmcnv.pas

@@ -30,6 +30,8 @@ interface
 
     type
        tjvmtypeconvnode = class(tcgtypeconvnode)
+          class function target_specific_need_equal_typeconv(fromdef, todef: tdef): boolean; override;
+
           function typecheck_dynarray_to_openarray: tnode; override;
           function typecheck_string_to_chararray: tnode; override;
           function typecheck_string_to_string: tnode;override;
@@ -148,6 +150,19 @@ implementation
       end;
 
 
+   class function tjvmtypeconvnode.target_specific_need_equal_typeconv(fromdef, todef: tdef): boolean;
+     begin
+       result:=
+         (fromdef<>todef) and
+         { two procdefs that are structurally the same but semantically different
+           still need a convertion }
+         (
+          ((fromdef.typ=procvardef) and
+           (todef.typ=procvardef))
+         );
+     end;
+
+
    function tjvmtypeconvnode.typecheck_dynarray_to_openarray: tnode;
      begin
        { all arrays are equal in Java }
@@ -476,7 +491,7 @@ implementation
                      { get the class representing the primitive type }
                      fvs:=search_struct_member(tobjectdef(corrclass),'FTYPE');
                      newpara:=nil;
-                     if not handle_staticfield_access(fvs,false,newpara) then
+                     if not handle_staticfield_access(fvs,newpara) then
                        internalerror(2011072417);
                    end
                  else

compiler/jvm/njvmcon.pas

@@ -125,7 +125,7 @@ implementation
 
         { c) create loadnode of the field }
         result:=nil;
-        if not handle_staticfield_access(classfield,false,result) then
+        if not handle_staticfield_access(classfield,result) then
           internalerror(2011062606);
       end;
 

compiler/jvm/njvminl.pas

@@ -305,6 +305,12 @@ implementation
              begin
                result:=typecheck_new(handled);
              end;
+           in_sizeof_x:
+             begin
+               { can't get the size of the data of a class/object }
+               if left.resultdef.typ in [objectdef,classrefdef] then
+                 Message(parser_e_illegal_expression);
+             end;
          end;
         if not handled then
           result:=inherited pass_typecheck;

compiler/jvm/njvmtcon.pas

@@ -42,6 +42,7 @@ interface
       tjvmtypedconstbuilder = class(tnodetreetypedconstbuilder)
        private
         procedure tc_flush_arr_strconst(def: tdef);
+        procedure tc_emit_arr_strconst_ele(val: int64; def: torddef);
        protected
         arrstringdata: tarrstringdata;
         parsingordarray: boolean;
@@ -55,8 +56,9 @@ implementation
 
     uses
       globals,widestr,verbose,constexp,
+      tokens,scanner,pexpr,
       defutil,
-      nbas,ncal,ncon,njvmcon;
+      nbas,ncal,ncon,ncnv,njvmcon;
 
 
     procedure init_arrstringdata(out data: tarrstringdata);
@@ -88,7 +90,9 @@ implementation
             tcompilerwidechar(ord(arrstringdata.arrstring[length(arrstringdata.arrstring)]) shl 8));
 
 
-        if is_signed(def) then
+        if is_char(def) then
+          procvariant:='ansichar'
+        else if is_signed(def) then
           case def.size of
             1: procvariant:='shortint';
             2: procvariant:='smallint';
@@ -121,14 +125,54 @@ implementation
       end;
 
 
+    procedure tjvmtypedconstbuilder.tc_emit_arr_strconst_ele(val: int64; def: torddef);
+      var
+        elesize: longint;
+      begin
+        elesize:=def.size;
+        inc(arrstringdata.arrdatalen);
+        case elesize of
+          1:
+            arrstringdata.arrstring:=arrstringdata.arrstring+char(val);
+          2:
+            arrstringdata.arrstring:=arrstringdata.arrstring+char(val shr 8)+char(val and $ff);
+          4:
+            arrstringdata.arrstring:=arrstringdata.arrstring+char((val shr 24))+
+              char((val shr 16) and $ff)+
+              char((val shr 8) and $ff)+
+              char(val and $ff);
+          8:
+            arrstringdata.arrstring:=arrstringdata.arrstring+char((val shr 56))+
+              char((val shr 48) and $ff)+
+              char((val shr 40) and $ff)+
+              char((val shr 32) and $ff)+
+              char((val shr 24) and $ff)+
+              char((val shr 16) and $ff)+
+              char((val shr 8) and $ff)+
+              char(val and $ff);
+        end;
+        { we can't use the full 64kb, because inside the Java class file the
+          string constant is actually encoded using UTF-8 and it's this UTF-8
+          encoding that has to fit inside 64kb (and utf-8 encoding of random
+          data can easily blow up its size by about a third) }
+        if length(arrstringdata.arrstring)>40000 then
+          tc_flush_arr_strconst(def);
+      end;
+
+
     procedure tjvmtypedconstbuilder.parse_arraydef(def: tarraydef);
       var
+        n: tnode;
+        i, len: longint;
+        ca: pbyte;
+        ch: array[0..1] of char;
         old_arrstringdata: tarrstringdata;
         old_parsingordarray: boolean;
       begin
         if is_dynamic_array(def) or
-           not is_integer(def.elementdef) or
-           not(ts_compact_int_array_init in current_settings.targetswitches) then
+           (not is_char(def.elementdef) and
+            (not is_integer(def.elementdef) or
+             not(ts_compact_int_array_init in current_settings.targetswitches))) then
           begin
             inherited;
             exit;
@@ -138,7 +182,66 @@ implementation
         arrstringdata.arraybase:=basenode.getcopy;
         old_parsingordarray:=parsingordarray;
         parsingordarray:=true;
-        inherited;
+        if (token=_LKLAMMER) or
+           not is_char(def.elementdef) then
+          inherited
+        else
+          begin
+            { array of ansichar -> can be constant char/string; can't use plain
+              assignment in this case, because it will result in a codepage
+              conversion }
+            n:=comp_expr([ef_accept_equal]);
+            if n.nodetype=stringconstn then
+              begin
+                len:=tstringconstnode(n).len;
+                if (tstringconstnode(n).cst_type in [cst_unicodestring,cst_widestring]) then
+                  inserttypeconv(n,getansistringdef);
+                  if n.nodetype<>stringconstn then
+                    internalerror(2010033003);
+                  ca:=pbyte(tstringconstnode(n).value_str);
+                { For tp7 the maximum lentgh can be 255 }
+                if (m_tp7 in current_settings.modeswitches) and
+                   (len>255) then
+                 len:=255;
+              end
+            else if is_constcharnode(n) then
+               begin
+                 ch[0]:=chr(tordconstnode(n).value.uvalue and $ff);
+                 ca:=@ch;
+                 len:=1;
+               end
+            else if is_constwidecharnode(n) and (current_settings.sourcecodepage<>CP_UTF8) then
+               begin
+                 inserttypeconv(n,cansichartype);
+                 if not is_constcharnode(n) then
+                   internalerror(2010033001);
+                 ch[0]:=chr(tordconstnode(n).value.uvalue and $ff);
+                 ca:=@ch;
+                 len:=1;
+               end
+            else
+              begin
+                Message(parser_e_illegal_expression);
+                len:=0;
+                { avoid crash later on }
+                ch[0]:=#0;
+                ca:=@ch;
+              end;
+            if len>(def.highrange-def.lowrange+1) then
+              Message(parser_e_string_larger_array);
+            for i:=0 to def.highrange-def.lowrange do
+              begin
+                if i<len then
+                  begin
+                    tc_emit_arr_strconst_ele(pbyte(ca)^,torddef(cansichartype));
+                    inc(ca);
+                  end
+                else
+                  {Fill the remaining positions with #0.}
+                  tc_emit_arr_strconst_ele(0,torddef(cansichartype));
+              end;
+            n.free;
+          end;
         if length(arrstringdata.arrstring)<>0 then
           tc_flush_arr_strconst(def.elementdef);
         arrstringdata.arraybase.free;
@@ -158,8 +261,6 @@ implementation
 
 
     procedure tjvmtypedconstbuilder.tc_emit_orddef(def: torddef; var node: tnode);
-      var
-        elesize: longint;
       begin
         if not parsingordarray then
           begin
@@ -168,34 +269,7 @@ implementation
           end;
         if node.nodetype<>ordconstn then
           internalerror(2011111101);
-        elesize:=def.size;
-        inc(arrstringdata.arrdatalen);
-        case elesize of
-          1:
-            arrstringdata.arrstring:=arrstringdata.arrstring+char(tordconstnode(node).value.svalue);
-          2:
-            arrstringdata.arrstring:=arrstringdata.arrstring+char(tordconstnode(node).value.svalue shr 8)+char(tordconstnode(node).value.svalue and $ff);
-          4:
-            arrstringdata.arrstring:=arrstringdata.arrstring+char((tordconstnode(node).value.svalue shr 24))+
-              char((tordconstnode(node).value.svalue shr 16) and $ff)+
-              char((tordconstnode(node).value.svalue shr 8) and $ff)+
-              char(tordconstnode(node).value.svalue and $ff);
-          8:
-            arrstringdata.arrstring:=arrstringdata.arrstring+char((tordconstnode(node).value.svalue shr 56))+
-              char((tordconstnode(node).value.svalue shr 48) and $ff)+
-              char((tordconstnode(node).value.svalue shr 40) and $ff)+
-              char((tordconstnode(node).value.svalue shr 32) and $ff)+
-              char((tordconstnode(node).value.svalue shr 24) and $ff)+
-              char((tordconstnode(node).value.svalue shr 16) and $ff)+
-              char((tordconstnode(node).value.svalue shr 8) and $ff)+
-              char(tordconstnode(node).value.svalue and $ff);
-        end;
-        { we can't use the full 64kb, because inside the Java class file the
-          string constant is actually encoded using UTF-8 and it's this UTF-8
-          encoding that has to fit inside 64kb (and utf-8 encoding of random
-          data can easily blow up its size by about a third) }
-        if length(arrstringdata.arrstring)>40000 then
-          tc_flush_arr_strconst(def);
+        tc_emit_arr_strconst_ele(tordconstnode(node).value.svalue,def);
         basenode.free;
         basenode:=nil;
         node.free;