Browse Source

revert broken merges

git-svn-id: branches/interfacertti@33641 -
steve 9 years ago
parent
commit
b90e03eec7
100 changed files with 4007 additions and 5104 deletions
  1. 57 200
      .gitattributes
  2. 25 6
      Makefile
  3. 7 2
      Makefile.fpc
  4. 6 1
      compiler/Makefile
  5. 7 0
      compiler/Makefile.fpc
  6. 13 18
      compiler/aarch64/cgcpu.pas
  7. 1 2
      compiler/aarch64/hlcgcpu.pas
  8. 2 11
      compiler/aasmbase.pas
  9. 28 79
      compiler/aasmcnst.pas
  10. 9 31
      compiler/aasmdata.pas
  11. 47 13
      compiler/aasmtai.pas
  12. 139 43
      compiler/aggas.pas
  13. 2 3
      compiler/aopt.pas
  14. 1 21
      compiler/aoptbase.pas
  15. 12 26
      compiler/aoptobj.pas
  16. 0 49
      compiler/aoptutils.pas
  17. 18 50
      compiler/arm/aasmcpu.pas
  18. 1 1
      compiler/arm/agarmgas.pas
  19. 120 194
      compiler/arm/aoptcpu.pas
  20. 0 1
      compiler/arm/armatt.inc
  21. 0 1
      compiler/arm/armatts.inc
  22. 5 6
      compiler/arm/armins.dat
  23. 0 1
      compiler/arm/armop.inc
  24. 4 4
      compiler/arm/armtab.inc
  25. 13 27
      compiler/arm/cgcpu.pas
  26. 1 1
      compiler/arm/cpubase.pas
  27. 0 2
      compiler/arm/cpuelf.pas
  28. 2 4
      compiler/arm/cpuinfo.pas
  29. 4 4
      compiler/arm/cpupara.pas
  30. 0 1
      compiler/arm/cpupi.pas
  31. 0 9
      compiler/arm/narmadd.pas
  32. 2 3
      compiler/arm/narmcal.pas
  33. 0 2
      compiler/arm/narmcnv.pas
  34. 1 111
      compiler/arm/narminl.pas
  35. 0 1
      compiler/arm/narmmat.pas
  36. 2 2
      compiler/arm/narmset.pas
  37. 23 37
      compiler/arm/raarmgas.pas
  38. 0 5
      compiler/arm/rgcpu.pas
  39. 5 61
      compiler/assemble.pas
  40. 1 0
      compiler/avr/aasmcpu.pas
  41. 1 5
      compiler/avr/aoptcpu.pas
  42. 6 13
      compiler/avr/cgcpu.pas
  43. 2 2
      compiler/avr/cpuinfo.pas
  44. 1 2
      compiler/avr/cpunode.pas
  45. 0 198
      compiler/avr/navrutil.pas
  46. 4 4
      compiler/cclasses.pas
  47. 2 0
      compiler/cfileutl.pas
  48. 4 8
      compiler/cgobj.pas
  49. 1 3
      compiler/constexp.pas
  50. 3 2
      compiler/cresstr.pas
  51. 0 100
      compiler/cstreams.pas
  52. 0 17
      compiler/cutils.pas
  53. 1 68
      compiler/dbgdwarf.pas
  54. 1 3
      compiler/dbgstabs.pas
  55. 7 12
      compiler/defcmp.pas
  56. 0 1239
      compiler/entfile.pas
  57. 19 36
      compiler/export.pas
  58. 4 17
      compiler/expunix.pas
  59. 1 12
      compiler/fmodule.pas
  60. 0 2
      compiler/fpcdefs.inc
  61. 0 570
      compiler/fpcp.pas
  62. 0 123
      compiler/fpkg.pas
  63. 28 231
      compiler/fppu.pas
  64. 17 115
      compiler/globals.pas
  65. 5 22
      compiler/globtype.pas
  66. 2 1
      compiler/hlcg2ll.pas
  67. 9 46
      compiler/hlcgobj.pas
  68. 7 4
      compiler/htypechk.pas
  69. 118 0
      compiler/i386/aopt386.pas
  70. 0 113
      compiler/i386/aoptcpub.pas
  71. 0 36
      compiler/i386/aoptcpud.pas
  72. 9 33
      compiler/i386/cgcpu.pas
  73. 0 3
      compiler/i386/cpuinfo.pas
  74. 2806 0
      compiler/i386/daopt386.pas
  75. 1 0
      compiler/i386/hlcgcpu.pas
  76. 1 11
      compiler/i386/i386att.inc
  77. 2 12
      compiler/i386/i386atts.inc
  78. 1 11
      compiler/i386/i386int.inc
  79. 1 1
      compiler/i386/i386nop.inc
  80. 1 11
      compiler/i386/i386op.inc
  81. 21 31
      compiler/i386/i386prop.inc
  82. 25 95
      compiler/i386/i386tab.inc
  83. 0 2
      compiler/i386/n386add.pas
  84. 1 5
      compiler/i386/n386cal.pas
  85. 195 454
      compiler/i386/popt386.pas
  86. 10 35
      compiler/i8086/cgcpu.pas
  87. 0 2
      compiler/i8086/cpuinfo.pas
  88. 0 9
      compiler/i8086/hlcgcpu.pas
  89. 1 11
      compiler/i8086/i8086att.inc
  90. 2 12
      compiler/i8086/i8086atts.inc
  91. 1 11
      compiler/i8086/i8086int.inc
  92. 1 1
      compiler/i8086/i8086nop.inc
  93. 1 11
      compiler/i8086/i8086op.inc
  94. 21 31
      compiler/i8086/i8086prop.inc
  95. 35 119
      compiler/i8086/i8086tab.inc
  96. 33 24
      compiler/jvm/agjasmin.pas
  97. 1 16
      compiler/jvm/njvmcnv.pas
  98. 1 1
      compiler/jvm/njvmcon.pas
  99. 0 6
      compiler/jvm/njvminl.pas
  100. 35 109
      compiler/jvm/njvmtcon.pas

+ 57 - 200
.gitattributes

@@ -57,7 +57,6 @@ 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
@@ -122,7 +121,6 @@ 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
@@ -168,15 +166,12 @@ 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
@@ -189,9 +184,7 @@ 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/aoptcpu.pas svneol=native#text/plain
-compiler/i386/aoptcpub.pas svneol=native#text/plain
-compiler/i386/aoptcpud.pas svneol=native#text/plain
+compiler/i386/aopt386.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
@@ -200,6 +193,7 @@ 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
@@ -216,6 +210,7 @@ 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
@@ -342,7 +337,6 @@ 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
@@ -352,7 +346,6 @@ 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
@@ -377,7 +370,6 @@ 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
@@ -494,7 +486,6 @@ 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
@@ -527,7 +518,6 @@ 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
@@ -537,7 +527,6 @@ 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
@@ -1014,7 +1003,6 @@ packages/ami-extra/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/ami-extra/README.txt svneol=native#text/plain
 packages/ami-extra/fpmake.pp svneol=native#text/plain
 packages/ami-extra/src/cliputils.pas svneol=native#text/plain
-packages/ami-extra/src/pcq.pas svneol=native#text/plain
 packages/amunits/Makefile svneol=native#text/plain
 packages/amunits/Makefile.fpc svneol=native#text/plain
 packages/amunits/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -1149,6 +1137,8 @@ packages/amunits/src/otherlibs/xadmaster.pas svneol=native#text/plain
 packages/amunits/src/otherlibs/zlib.pas svneol=native#text/plain
 packages/amunits/src/useamigasmartlink.inc svneol=native#text/plain
 packages/amunits/src/useautoopenlib.inc svneol=native#text/plain
+packages/amunits/src/utilunits/Makefile svneol=native#text/plain
+packages/amunits/src/utilunits/Makefile.fpc svneol=native#text/plain
 packages/amunits/src/utilunits/amigautils.pas svneol=native#text/plain
 packages/amunits/src/utilunits/amsgbox.pas svneol=native#text/plain
 packages/amunits/src/utilunits/consoleio.pas svneol=native#text/plain
@@ -1157,7 +1147,10 @@ packages/amunits/src/utilunits/doublebuffer.pas svneol=native#text/plain
 packages/amunits/src/utilunits/easyasl.pas svneol=native#text/plain
 packages/amunits/src/utilunits/hisoft.pas svneol=native#text/plain
 packages/amunits/src/utilunits/linklist.pas svneol=native#text/plain
+packages/amunits/src/utilunits/longarray.pas svneol=native#text/plain
 packages/amunits/src/utilunits/pastoc.pas svneol=native#text/plain
+packages/amunits/src/utilunits/pcq.pas svneol=native#text/plain
+packages/amunits/src/utilunits/systemvartags.pas svneol=native#text/plain
 packages/amunits/src/utilunits/tagsarray.pas svneol=native#text/plain
 packages/amunits/src/utilunits/timerutils.pas svneol=native#text/plain
 packages/amunits/src/utilunits/vartags.pas svneol=native#text/plain
@@ -1927,7 +1920,6 @@ packages/fcl-base/examples/b64test2.pp svneol=native#text/plain
 packages/fcl-base/examples/base64decodingtestcase.pas svneol=native#text/plain
 packages/fcl-base/examples/cachetest.pp svneol=native#text/plain
 packages/fcl-base/examples/cfgtest.pp svneol=native#text/plain
-packages/fcl-base/examples/contit.pp svneol=native#text/plain
 packages/fcl-base/examples/crittest.pp svneol=native#text/plain
 packages/fcl-base/examples/dbugsrv.pp svneol=native#text/plain
 packages/fcl-base/examples/debugtest.pp svneol=native#text/plain
@@ -1942,7 +1934,6 @@ packages/fcl-base/examples/fpdoc.dtd -text
 packages/fcl-base/examples/fpexprpars.txt svneol=native#text/plain
 packages/fcl-base/examples/fstream.pp svneol=native#text/plain
 packages/fcl-base/examples/htdump.pp svneol=native#text/plain
-packages/fcl-base/examples/inifmt.pp svneol=native#text/plain
 packages/fcl-base/examples/intl/Makefile svneol=native#text/plain
 packages/fcl-base/examples/intl/README.txt svneol=native#text/plain
 packages/fcl-base/examples/intl/restest.cs.mo -text
@@ -1958,6 +1949,8 @@ packages/fcl-base/examples/intl/restest.pb.po svneol=native#text/plain
 packages/fcl-base/examples/intl/restest.ru.mo -text
 packages/fcl-base/examples/intl/restest.ru.po svneol=native#text/plain
 packages/fcl-base/examples/intl/resttest.po svneol=native#text/plain
+packages/fcl-base/examples/ipcclient.pp svneol=native#text/plain
+packages/fcl-base/examples/ipcserver.pp svneol=native#text/plain
 packages/fcl-base/examples/isockcli.pp svneol=native#text/plain
 packages/fcl-base/examples/isocksvr.pp svneol=native#text/plain
 packages/fcl-base/examples/istream.pp svneol=native#text/plain
@@ -1986,9 +1979,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
@@ -2071,7 +2064,6 @@ packages/fcl-base/src/wtex.pp svneol=native#text/plain
 packages/fcl-base/tests/fclbase-unittests.lpi svneol=native#text/plain
 packages/fcl-base/tests/fclbase-unittests.pp svneol=native#text/plain
 packages/fcl-base/tests/tchashlist.pp svneol=native#text/plain
-packages/fcl-base/tests/testexprpars.pp svneol=native#text/plain
 packages/fcl-base/tests/tests_fptemplate.pp svneol=native#text/plain
 packages/fcl-base/texts/fptemplate.txt svneol=native#text/plain
 packages/fcl-db/Makefile svneol=native#text/plain
@@ -2110,7 +2102,6 @@ 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
@@ -2130,7 +2121,6 @@ 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
@@ -2383,7 +2373,6 @@ 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
@@ -2506,7 +2495,6 @@ packages/fcl-json/src/jsonconf.pp svneol=native#text/plain
 packages/fcl-json/src/jsonparser.pp svneol=native#text/plain
 packages/fcl-json/src/jsonscanner.pp svneol=native#text/plain
 packages/fcl-json/tests/jsonconftest.pp svneol=native#text/plain
-packages/fcl-json/tests/testcomps.pp svneol=native#text/plain
 packages/fcl-json/tests/testjson.lpi svneol=native#text/plain
 packages/fcl-json/tests/testjson.pp svneol=native#text/plain
 packages/fcl-json/tests/testjsonconf.lpi svneol=native#text/plain
@@ -2575,48 +2563,9 @@ packages/fcl-passrc/tests/tctypeparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcvarparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/testpassrc.lpi svneol=native#text/plain
 packages/fcl-passrc/tests/testpassrc.lpr svneol=native#text/plain
-packages/fcl-pdf/Makefile svneol=native#text/plain
-packages/fcl-pdf/Makefile.fpc svneol=native#text/plain
-packages/fcl-pdf/examples/poppy.jpg -text
-packages/fcl-pdf/examples/testfppdf.lpi svneol=native#text/plain
-packages/fcl-pdf/examples/testfppdf.lpr svneol=native#text/plain
-packages/fcl-pdf/fpmake.pp svneol=native#text/plain
-packages/fcl-pdf/readme.txt svneol=native#text/plain
-packages/fcl-pdf/src/fpparsettf.pp svneol=native#text/plain
-packages/fcl-pdf/src/fppdf.pp svneol=native#text/plain
-packages/fcl-pdf/src/fpttf.pp svneol=native#text/plain
-packages/fcl-pdf/src/fpttfencodings.pp svneol=native#text/plain
-packages/fcl-pdf/tests/fonts/README.txt svneol=native#text/plain
-packages/fcl-pdf/tests/fpparsettf_test.pas svneol=native#text/plain
-packages/fcl-pdf/tests/fppdf_test.pas svneol=native#text/plain
-packages/fcl-pdf/tests/fpttf_test.pas svneol=native#text/plain
-packages/fcl-pdf/tests/readme.txt svneol=native#text/plain
-packages/fcl-pdf/tests/testunits.inc svneol=native#text/plain
-packages/fcl-pdf/tests/unittests_console.lpi svneol=native#text/plain
-packages/fcl-pdf/tests/unittests_console.lpr svneol=native#text/plain
-packages/fcl-pdf/tests/unittests_gui.lpi svneol=native#text/plain
-packages/fcl-pdf/tests/unittests_gui.lpr svneol=native#text/plain
-packages/fcl-pdf/utils/mkpdffontdef.lpi svneol=native#text/plain
-packages/fcl-pdf/utils/mkpdffontdef.pp svneol=native#text/plain
-packages/fcl-pdf/utils/ttfdump.lpi svneol=native#text/plain
-packages/fcl-pdf/utils/ttfdump.lpr svneol=native#text/plain
 packages/fcl-process/Makefile svneol=native#text/plain
 packages/fcl-process/Makefile.fpc svneol=native#text/plain
 packages/fcl-process/Makefile.fpc.fpcmake svneol=native#text/plain
-packages/fcl-process/examples/demoproject.ico -text
-packages/fcl-process/examples/demoproject.lpi svneol=native#text/plain
-packages/fcl-process/examples/demoproject.pp svneol=native#text/plain
-packages/fcl-process/examples/demoproject.res -text
-packages/fcl-process/examples/demoruncommand.lpi svneol=native#text/plain
-packages/fcl-process/examples/demoruncommand.pp svneol=native#text/plain
-packages/fcl-process/examples/echoparams.pp svneol=native#text/plain
-packages/fcl-process/examples/empty.pp svneol=native#text/pascal
-packages/fcl-process/examples/infinity.pp svneol=native#text/pascal
-packages/fcl-process/examples/ipcclient.lpi svneol=native#text/plain
-packages/fcl-process/examples/ipcclient.pp svneol=native#text/plain
-packages/fcl-process/examples/ipcserver.lpi svneol=native#text/plain
-packages/fcl-process/examples/ipcserver.pp svneol=native#text/plain
-packages/fcl-process/examples/waitonexit.pp svneol=native#text/pascal
 packages/fcl-process/fpmake.pp svneol=native#text/plain
 packages/fcl-process/src/amicommon/pipes.inc svneol=native#text/plain
 packages/fcl-process/src/amicommon/process.inc svneol=native#text/plain
@@ -2638,8 +2587,9 @@ packages/fcl-process/src/unix/process.inc svneol=native#text/plain
 packages/fcl-process/src/unix/simpleipc.inc svneol=native#text/plain
 packages/fcl-process/src/win/pipes.inc svneol=native#text/plain
 packages/fcl-process/src/win/process.inc svneol=native#text/plain
-packages/fcl-process/src/winall/simpleipc.inc svneol=native#text/plain
+packages/fcl-process/src/win/simpleipc.inc svneol=native#text/plain
 packages/fcl-process/src/wince/process.inc svneol=native#text/plain
+packages/fcl-process/src/wince/simpleipc.inc svneol=native#text/plain
 packages/fcl-registry/Makefile svneol=native#text/plain
 packages/fcl-registry/Makefile.fpc svneol=native#text/plain
 packages/fcl-registry/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -2907,7 +2857,6 @@ packages/fcl-stl/src/garrayutils.pp svneol=native#text/plain
 packages/fcl-stl/src/gdeque.pp svneol=native#text/plain
 packages/fcl-stl/src/ghashmap.pp svneol=native#text/plain
 packages/fcl-stl/src/ghashset.pp svneol=native#text/plain
-packages/fcl-stl/src/glinkedlist.pp svneol=native#text/plain
 packages/fcl-stl/src/gmap.pp svneol=native#text/plain
 packages/fcl-stl/src/gpriorityqueue.pp svneol=native#text/plain
 packages/fcl-stl/src/gqueue.pp svneol=native#text/plain
@@ -2922,7 +2871,6 @@ packages/fcl-stl/tests/gcompositetest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gdequetest.pp svneol=native#text/plain
 packages/fcl-stl/tests/ghashmaptest.pp svneol=native#text/plain
 packages/fcl-stl/tests/ghashsettest.pp svneol=native#text/plain
-packages/fcl-stl/tests/glinkedlisttest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gmaptest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gmaptestzal.pp svneol=native#text/plain
 packages/fcl-stl/tests/gpriorityqueuetest.pp svneol=native#text/plain
@@ -3195,8 +3143,6 @@ packages/fcl-web/src/base/Makefile.fpc svneol=native#text/plain
 packages/fcl-web/src/base/README.txt svneol=native#text/plain
 packages/fcl-web/src/base/cgiapp.pp svneol=native#text/plain
 packages/fcl-web/src/base/cgiprotocol.pp svneol=native#text/plain
-packages/fcl-web/src/base/custapache.pp svneol=native#text/plain
-packages/fcl-web/src/base/custapache24.pp svneol=native#text/plain
 packages/fcl-web/src/base/custcgi.pp svneol=native#text/plain
 packages/fcl-web/src/base/custfcgi.pp svneol=native#text/plain
 packages/fcl-web/src/base/custhttpapp.pp svneol=native#text/plain
@@ -3229,9 +3175,6 @@ packages/fcl-web/src/base/restcodegen.pp svneol=native#text/plain
 packages/fcl-web/src/base/webpage.pp svneol=native#text/plain
 packages/fcl-web/src/base/websession.pp svneol=native#text/plain
 packages/fcl-web/src/base/webutil.pp svneol=native#text/plain
-packages/fcl-web/src/hpack/uhpack.pp svneol=native#text/plain
-packages/fcl-web/src/hpack/uhpackimp.pp svneol=native#text/plain
-packages/fcl-web/src/hpack/uhpacktables.pp svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/Makefile svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/Makefile.fpc svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/fpdispextdirect.pp svneol=native#text/plain
@@ -3247,14 +3190,10 @@ packages/fcl-web/src/webdata/fpextjs.pp svneol=native#text/plain
 packages/fcl-web/src/webdata/fpwebdata.pp svneol=native#text/plain
 packages/fcl-web/src/webdata/readme.txt svneol=native#text/plain
 packages/fcl-web/src/webdata/sqldbwebdata.pp svneol=native#text/plain
-packages/fcl-web/tests/README.txt svneol=native#text/plain
 packages/fcl-web/tests/cgigateway.lpi svneol=native#text/plain
 packages/fcl-web/tests/cgigateway.pp svneol=native#text/plain
-packages/fcl-web/tests/fpcunithpack.lpi svneol=native#text/plain
-packages/fcl-web/tests/fpcunithpack.lpr svneol=native#text/plain
 packages/fcl-web/tests/testcgiapp.lpi svneol=native#text/plain
 packages/fcl-web/tests/testcgiapp.pp svneol=native#text/plain
-packages/fcl-web/tests/uhpacktest1.pas svneol=native#text/plain
 packages/fcl-xml/Makefile svneol=native#text/plain
 packages/fcl-xml/Makefile.fpc svneol=native#text/plain
 packages/fcl-xml/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -5018,6 +4957,36 @@ packages/libgd/examples/gdtest.pp svneol=native#text/plain
 packages/libgd/examples/gdtestcgi.pp svneol=native#text/plain
 packages/libgd/fpmake.pp svneol=native#text/plain
 packages/libgd/src/gd.pas svneol=native#text/plain
+packages/libmicrohttpd/Makefile svneol=native#text/plain
+packages/libmicrohttpd/Makefile.fpc svneol=native#text/plain
+packages/libmicrohttpd/examples/basicauthentication.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/benchmark.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/benchmark_https.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/chunked_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/cutils.pas svneol=native#text/plain
+packages/libmicrohttpd/examples/demo.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/demo_https.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/digest_auth_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/dual_stack_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/fileserver_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/fileserver_example_dirs.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/fileserver_example_external_select.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/hellobrowser.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/https_fileserver_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/largepost.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/logging.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/magic.inc svneol=native#text/plain
+packages/libmicrohttpd/examples/minimal_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/minimal_example_comet.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/post_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/querystring_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/refuse_post_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/responseheaders.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/sessions.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/simplepost.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/tlsauthentication.pp svneol=native#text/plain
+packages/libmicrohttpd/fpmake.pp svneol=native#text/plain
+packages/libmicrohttpd/src/libmicrohttpd.pp svneol=native#text/plain
 packages/libndsfpc/Makefile svneol=native#text/plain
 packages/libndsfpc/Makefile.fpc svneol=native#text/plain
 packages/libndsfpc/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -5831,7 +5800,6 @@ 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
@@ -5841,22 +5809,19 @@ 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
@@ -6287,25 +6252,6 @@ packages/os2units/src/mmio.pas svneol=native#text/plain
 packages/os2units/src/som.pas svneol=native#text/plain
 packages/os2units/src/sw.pas svneol=native#text/plain
 packages/os2units/src/wpstk.pp svneol=native#text/plain
-packages/os4units/Makefile svneol=native#text/plain
-packages/os4units/Makefile.fpc svneol=native#text/plain
-packages/os4units/Makefile.fpc.fpcmake svneol=native#text/plain
-packages/os4units/fpmake.pp svneol=native#text/pascal
-packages/os4units/src/agraphics.pas svneol=native#text/pascal
-packages/os4units/src/amigados.pas svneol=native#text/pascal
-packages/os4units/src/asl.pas svneol=native#text/pascal
-packages/os4units/src/clipboard.pas svneol=native#text/pascal
-packages/os4units/src/diskfont.pas svneol=native#text/pascal
-packages/os4units/src/exec.pas svneol=native#text/pascal
-packages/os4units/src/iffparse.pas svneol=native#text/pascal
-packages/os4units/src/inputevent.pas svneol=native#text/pascal
-packages/os4units/src/intuition.pas svneol=native#text/pascal
-packages/os4units/src/keymap.pas svneol=native#text/pascal
-packages/os4units/src/layers.pas svneol=native#text/pascal
-packages/os4units/src/mui.pas svneol=native#text/pascal
-packages/os4units/src/timer.pas svneol=native#text/pascal
-packages/os4units/src/utility.pas svneol=native#text/pascal
-packages/os4units/src/workbench.pas svneol=native#text/pascal
 packages/palmunits/Makefile svneol=native#text/plain
 packages/palmunits/Makefile.fpc svneol=native#text/plain
 packages/palmunits/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -6526,10 +6472,6 @@ packages/paszlib/examples/Makefile.fpc svneol=native#text/plain
 packages/paszlib/examples/example.pas svneol=native#text/plain
 packages/paszlib/examples/example2.pas svneol=native#text/plain
 packages/paszlib/examples/extractodt.pas svneol=native#text/plain
-packages/paszlib/examples/fpunzipper.lpi svneol=native#text/plain
-packages/paszlib/examples/fpunzipper.lpr svneol=native#text/plain
-packages/paszlib/examples/fpzipper.lpi svneol=native#text/plain
-packages/paszlib/examples/fpzipper.lpr svneol=native#text/plain
 packages/paszlib/examples/minigzip.pas svneol=native#text/plain
 packages/paszlib/examples/miniunz.pas svneol=native#text/plain
 packages/paszlib/examples/minizip.pas svneol=native#text/plain
@@ -6662,8 +6604,6 @@ packages/ptc/src/c_api/capi_surface.inc svneol=native#text/plain
 packages/ptc/src/c_api/capi_surfaced.inc svneol=native#text/plain
 packages/ptc/src/c_api/capi_timer.inc svneol=native#text/plain
 packages/ptc/src/c_api/capi_timerd.inc svneol=native#text/plain
-packages/ptc/src/cocoa/cocoaconsoled.inc svneol=native#text/plain
-packages/ptc/src/cocoa/cocoaconsolei.inc svneol=native#text/plain
 packages/ptc/src/core/aread.inc svneol=native#text/plain
 packages/ptc/src/core/areai.inc svneol=native#text/plain
 packages/ptc/src/core/baseconsoled.inc svneol=native#text/plain
@@ -7011,7 +6951,6 @@ packages/rtl-objpas/src/inc/varerror.inc svneol=native#text/plain
 packages/rtl-objpas/src/inc/variants.pp svneol=native#text/plain
 packages/rtl-objpas/src/inc/varutilh.inc svneol=native#text/plain
 packages/rtl-objpas/src/inc/varutils.inc svneol=native#text/plain
-packages/rtl-objpas/src/inc/widestrutils.pp svneol=native#text/plain
 packages/rtl-objpas/src/morphos/varutils.pp svneol=native#text/plain
 packages/rtl-objpas/src/msdos/varutils.pp svneol=native#text/plain
 packages/rtl-objpas/src/nativent/varutils.pp svneol=native#text/pascal
@@ -8022,15 +7961,9 @@ packages/x11/src/xcms.pp svneol=native#text/plain
 packages/x11/src/xf86dga.pp svneol=native#text/plain
 packages/x11/src/xf86dga1.inc svneol=native#text/plain
 packages/x11/src/xf86vmode.pp svneol=native#text/plain
-packages/x11/src/xfixes.pp svneol=native#text/plain
-packages/x11/src/xfixeswire.inc svneol=native#text/plain
 packages/x11/src/xft.pas svneol=native#text/pascal
-packages/x11/src/xge.pp svneol=native#text/plain
 packages/x11/src/xi.pp svneol=native#text/plain
-packages/x11/src/xi2.pp svneol=native#text/plain
 packages/x11/src/xinerama.pp svneol=native#text/plain
-packages/x11/src/xinput.pp svneol=native#text/plain
-packages/x11/src/xinput2.pp svneol=native#text/plain
 packages/x11/src/xkb.pp svneol=native#text/plain
 packages/x11/src/xkblib.pp svneol=native#text/plain
 packages/x11/src/xlib.pp svneol=native#text/plain
@@ -8041,10 +7974,6 @@ packages/x11/src/xshm.pp svneol=native#text/plain
 packages/x11/src/xutil.pp svneol=native#text/plain
 packages/x11/src/xv.pp svneol=native#text/plain
 packages/x11/src/xvlib.pp svneol=native#text/plain
-packages/x11/tests/xfixes_linktest.pp svneol=native#text/plain
-packages/x11/tests/xge_linktest.pp svneol=native#text/plain
-packages/x11/tests/xinput2_linktest.pp svneol=native#text/plain
-packages/x11/tests/xinput_linktest.pp svneol=native#text/plain
 packages/xforms/Makefile svneol=native#text/plain
 packages/xforms/Makefile.fpc svneol=native#text/plain
 packages/xforms/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -8174,7 +8103,6 @@ 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
@@ -8223,7 +8151,6 @@ 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
@@ -8597,7 +8524,6 @@ 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
@@ -8968,8 +8894,15 @@ 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
@@ -9442,7 +9375,6 @@ 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
@@ -9860,6 +9792,7 @@ 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
@@ -9870,8 +9803,11 @@ 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
@@ -10006,7 +9942,6 @@ 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
@@ -10885,14 +10820,10 @@ 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
@@ -11579,7 +11510,6 @@ 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
@@ -11634,7 +11564,6 @@ 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
@@ -11658,7 +11587,6 @@ 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
@@ -11680,7 +11608,6 @@ 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
@@ -11725,7 +11652,6 @@ 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
@@ -12139,9 +12065,7 @@ 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.inc svneol=native#text/plain
-tests/test/tfma1arm.pp svneol=native#text/pascal
-tests/test/tfma1x86.pp svneol=native#text/pascal
+tests/test/tfma1.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
@@ -12318,21 +12242,6 @@ 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
@@ -12940,7 +12849,6 @@ 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
@@ -12988,7 +12896,6 @@ 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
@@ -13239,7 +13146,6 @@ 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
@@ -13574,7 +13480,6 @@ 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
@@ -14843,7 +14748,6 @@ 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
@@ -14926,21 +14830,14 @@ 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
@@ -14949,83 +14846,44 @@ 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/tw29906.pp svneol=native#text/plain
-tests/webtbs/tw29912.pp svneol=native#text/plain
-tests/webtbs/tw29923.pp svneol=native#text/plain
-tests/webtbs/tw29930.pp svneol=native#text/plain
-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/tw30007.pp svneol=native#text/plain
-tests/webtbs/tw30030.pp svneol=native#text/pascal
-tests/webtbs/tw30035.pp svneol=native#text/plain
-tests/webtbs/tw30035a.pp svneol=native#text/plain
 tests/webtbs/tw3004.pp svneol=native#text/plain
 tests/webtbs/tw3005.pp svneol=native#text/plain
-tests/webtbs/tw30082.pp svneol=native#text/plain
 tests/webtbs/tw3010.pp svneol=native#text/plain
 tests/webtbs/tw3012.pp svneol=native#text/plain
 tests/webtbs/tw3023.pp svneol=native#text/plain
@@ -15702,7 +15560,6 @@ 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

+ 25 - 6
Makefile

@@ -1,11 +1,11 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-07-28 rev 31240]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-09-05 rev 31523]
 #
 default: 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 aarch64-linux aarch64-darwin
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos i8086-win16 aarch64-linux aarch64-darwin
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
-LIMIT83fs = go32v2 os2 emx watcom msdos
+LIMIT83fs = go32v2 os2 emx watcom msdos win16
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
@@ -333,7 +333,8 @@ endif
 endif
 override PACKAGE_NAME=fpc
 override PACKAGE_VERSION=3.1.1
-REQUIREDVERSION=3.0.0
+REQUIREDVERSION=2.6.4
+REQUIREDVERSION2=3.0.0
 ifndef inOS2
 override FPCDIR:=$(BASEDIR)
 export FPCDIR
@@ -475,7 +476,7 @@ endif
 endif
 BuildOnlyBaseCPUs=jvm
 ifneq ($(wildcard utils),)
-NOUTILSTARGETS=embedded gba nds msdos $(BuildOnlyBaseCPUs)
+NOUTILSTARGETS=embedded gba nds msdos win16 $(BuildOnlyBaseCPUs)
 ifeq ($(findstring $(OS_TARGET),$(NOUTILSTARGETS)),)
 ifdef BUILDFULLNATIVE
 UTILS=1
@@ -719,6 +720,9 @@ 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
@@ -1125,6 +1129,12 @@ ifeq ($(OS_TARGET),embedded)
 EXEEXT=.bin
 SHORTSUFFIX=emb
 endif
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -2521,6 +2531,14 @@ 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
@@ -2833,7 +2851,8 @@ override TARGET_DIRS:=$(wildcard $(TARGET_DIRS))
 help:
 	@$(ECHO)
 	@$(ECHO) Targets
-	@$(ECHO)    all         Build a new compiler and all packages
+	@$(ECHO)    all         Alias for build
+	@$(ECHO)    build       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

+ 7 - 2
Makefile.fpc

@@ -20,7 +20,11 @@ fpcdir=.
 rule=help
 
 [prerules]
-REQUIREDVERSION=3.0.0
+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
 
 
 # make versions < 3.77 (OS2 version) are buggy
@@ -232,7 +236,8 @@ override TARGET_DIRS:=$(wildcard $(TARGET_DIRS))
 help:
         @$(ECHO)
         @$(ECHO) Targets
-        @$(ECHO)    all         Build a new compiler and all packages
+        @$(ECHO)    all         Alias for build
+        @$(ECHO)    build       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

+ 6 - 1
compiler/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2016/01/04]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-09-05 rev 31523]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos i8086-win16 aarch64-linux aarch64-darwin
@@ -514,6 +514,11 @@ 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

+ 7 - 0
compiler/Makefile.fpc

@@ -271,6 +271,13 @@ 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+=

+ 13 - 18
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:=getintregister(list,OS_32);
+            hreg1:=makeregsize(register,OS_32);
             hreg2:=getintregister(list,OS_32);
             if target_info.endian=endian_big then
               begin
@@ -831,7 +831,6 @@ 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
@@ -1116,9 +1115,8 @@ implementation
         if fromsize in [OS_64,OS_S64] then
           begin
             { split into two 32 bit stores }
-            hreg1:=getintregister(list,OS_32);
+            hreg1:=makeregsize(register,OS_32);
             hreg2:=getintregister(list,OS_32);
-            a_load_reg_reg(list,OS_32,OS_32,makeregsize(register,OS_32),hreg1);
             a_op_const_reg_reg(list,OP_SHR,OS_64,32,register,makeregsize(hreg2,OS_64));
             if target_info.endian=endian_big then
               begin
@@ -1342,7 +1340,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, tmpreg2: tregister;
+        tmpreg1: tregister;
       begin
         ovloc.loc:=LOC_VOID;
         { overflow can only occur with 64 bit calculations on 64 bit cpus }
@@ -1362,7 +1360,9 @@ implementation
                       ovloc.resflags:=F_CC
                   else
                     ovloc.resflags:=F_VS;
-                  { finished }
+                  { finished; since we won't call through to a_op_reg_reg_reg,
+                    adjust the result here if necessary }
+                  maybeadjustresult(list,op,size,dst);
                   exit;
                 end;
               OP_MUL:
@@ -1377,22 +1377,17 @@ implementation
                 end;
               OP_IMUL:
                 begin
-                  { 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 }
+                  { 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) }
                   tmpreg1:=getintregister(list,OS_64);
                   list.concat(taicpu.op_reg_reg_reg(A_SMULH,tmpreg1,src2,src1));
-                  { 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));
+                  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));
                   ovloc.loc:=LOC_FLAGS;
                   ovloc.resflags:=F_NE;
-                  { finished }
-                  exit;
+                  { still have to perform the actual multiplication }
                 end;
               OP_IDIV,
               OP_DIV:

+ 1 - 2
compiler/aarch64/hlcgcpu.pas

@@ -208,8 +208,7 @@ implementation
     begin
       if slopt in [SL_SETZERO,SL_SETMAX] then
         inherited
-      else if not(sreg.bitlen in [32,64]) or
-              (sreg.startbit<>0) then
+      else if not(sreg.bitlen in [32,64]) 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))

+ 2 - 11
compiler/aasmbase.pas

@@ -42,10 +42,7 @@ 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,
-         { 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);
+         AB_TEMP);
 
        TAsmsymtype=(
          AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL,
@@ -68,9 +65,7 @@ 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',
-       'indirect','external indirect');
-       asmsymbindindirect = [AB_INDIRECT,AB_EXTERNAL_INDIRECT];
+       'local','global','weak external','private external','lazy','import','internal temp');
 
     type
        TAsmSectiontype=(sec_none,
@@ -103,8 +98,6 @@ 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
@@ -158,8 +151,6 @@ interface
          sec_heap
        );
 
-       TObjCAsmSectionType = sec_objc_class..sec_objc_protolist;
-
        TAsmSectionOrder = (secorder_begin,secorder_default,secorder_end);
 
        TAsmSymbol = class(TFPHashObject)

+ 28 - 79
compiler/aasmcnst.pas

@@ -93,9 +93,6 @@ 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;
@@ -126,9 +123,7 @@ type
      { item in the above list }
      tcalo_vectorized_dead_strip_item,
      { end of the above list }
-     tcalo_vectorized_dead_strip_end,
-     { symbol should be weakle defined }
-     tcalo_weak
+     tcalo_vectorized_dead_strip_end
    );
    ttcasmlistoptions = set of ttcasmlistoption;
 
@@ -138,6 +133,7 @@ type
     private
      fnextfieldname: TIDString;
      function getcuroffset: asizeint;
+     function getfieldoffset(l: longint): asizeint;
      procedure setnextfieldname(AValue: TIDString);
     protected
      { type of the aggregate }
@@ -177,6 +173,7 @@ 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;
@@ -187,7 +184,6 @@ 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;
 
@@ -304,7 +300,6 @@ 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
@@ -331,8 +326,6 @@ 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 }
@@ -371,11 +364,10 @@ 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
@@ -431,7 +423,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 (also if that field is a nested anonymous record) }
+       record (or the next of the next started 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
@@ -495,6 +487,15 @@ 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
@@ -515,7 +516,6 @@ implementation
 
     function taggregateinformation.prepare_next_field(nextfielddef: tdef): asizeint;
       var
-        sym: tsym;
         currentoffset,nextoffset: asizeint;
         i: longint;
       begin
@@ -544,16 +544,14 @@ implementation
               end
             else if fnextfieldname<>'' then
               internalerror(2015071501);
-            currentoffset:=curoffset;
             { find next field }
             i:=curindex;
             repeat
               inc(i);
-              sym:=tsym(tabstractrecorddef(def).symtable.symlist[i]);
-            until (sym.typ=fieldvarsym) and
-              not(sp_static in sym.symoptions);
-            curfield:=tfieldvarsym(sym);
-            nextoffset:=curfield.fieldoffset;
+            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;
             curindex:=i;
           end;
         { need padding? }
@@ -754,17 +752,6 @@ 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
@@ -939,15 +926,12 @@ implementation
          end;
 
        if not(tcalo_is_lab in options) then
-         if sym.bind=AB_LOCAL then
-           prelist.concat(tai_symbol.Create(sym,0))
-         else
+         if sym.bind=AB_GLOBAL then
            prelist.concat(tai_symbol.Create_Global(sym,0))
+         else
+           prelist.concat(tai_symbol.Create(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 }
@@ -965,7 +949,6 @@ 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
@@ -987,7 +970,7 @@ implementation
              internalerror(2015110802);
            sym:=get_vectorized_dead_strip_section_symbol_end(basename,st,true);
            if not customsecname then
-             secname:=make_mangledname(basename,st,'3_END');
+             make_mangledname(basename,st,'3_END');
          end
        else if tcalo_vectorized_dead_strip_item in options then
          begin
@@ -1302,21 +1285,6 @@ 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;
@@ -1372,17 +1340,11 @@ 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
-         name:=make_mangledname(basename,st,'START')
+         result:=current_asmdata.DefineAsmSymbol(make_mangledname(basename,st,'START'),AB_GLOBAL,AT_DATA)
        else
-         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)
+         result:=current_asmdata.DefineAsmSymbol(make_mangledname(basename,st,'END'),AB_GLOBAL,AT_DATA);
      end;
 
 
@@ -1454,7 +1416,6 @@ 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));
@@ -1494,18 +1455,18 @@ implementation
            { ending #0 }
            datatcb.emit_tai(Tai_const.Create_16bit(0),cwidechartype);
            datatcb.maybe_end_aggregate(datadef);
-           unicodestrrecdef:=datatcb.end_anonymous_record;
+           datatcb.end_anonymous_record;
          end
        else
          { code generation for other sizes must be written }
          internalerror(200904271);
-       finish_internal_data_builder(datatcb,startlab,unicodestrrecdef,const_align(sizeof(pint)));
+       finish_internal_data_builder(datatcb,startlab,datadef,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),get_dynstring_def_for_type(st,winlikewidestring));
+       emit_tai(Tai_const.Create_sym_offset(ll.lab,ll.ofs),charptrdef);
      end;
 
 
@@ -1524,18 +1485,6 @@ 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;
@@ -1814,7 +1763,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),resourcestrrec
+               make_mangledname('RESSTR',cs.owner,cs.name),AT_DATA),cansistringtype
              );
            end;
          { can these occur? }

+ 9 - 31
compiler/aasmdata.pas

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

+ 47 - 13
compiler/aasmtai.pas

@@ -69,7 +69,11 @@ 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,
@@ -196,7 +200,11 @@ interface
           'stab',
           'force_line',
           'function_name',
+{$ifdef m68k}
+          'labeled_instr',
+{$endif m68k}
           'symbolpair',
+          'weak',
           'cut',
           'regalloc',
           'tempalloc',
@@ -290,7 +298,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_symbolpair,ait_weak,
                      ait_realconst,
                      ait_symbol,
 {$ifdef JVM}
@@ -339,13 +347,8 @@ interface
         asd_ent,asd_ent_end,
         { supported by recent clang-based assemblers for data-in-code  }
         asd_data_region, asd_end_data_region,
-        { 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
+        { .thumb_func for ARM }
+        asd_thumb_func
       );
 
       TAsmSehDirective=(
@@ -372,17 +375,15 @@ interface
       directivestr : array[TAsmDirective] of string[23]=(
         'indirect_symbol',
         'extern','nasm_import', 'tc', 'reference',
-        'no_dead_strip','weak','lazy_reference','weak',
+        'no_dead_strip','weak_reference','lazy_reference','weak_definition',
         { 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',
-        { ARM }
-        'thumb_func',
-        'code',
-        'cpu'
+        { .thumb_func for ARM }
+        'thumb_func'
       );
       sehdirectivestr : array[TAsmSehDirective] of string[16]=(
         '.seh_proc','.seh_endproc',
@@ -897,6 +898,14 @@ 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;
@@ -1009,6 +1018,31 @@ 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;

+ 139 - 43
compiler/aggas.pas

@@ -52,7 +52,7 @@ interface
         procedure WriteExtraHeader;virtual;
         procedure WriteExtraFooter;virtual;
         procedure WriteInstruction(hp: tai);
-        procedure WriteWeakSymbolRef(s: tasmsymbol); virtual;
+        procedure WriteWeakSymbolDef(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 WriteWeakSymbolRef(s: tasmsymbol); override;
-        procedure WriteDirectiveName(dir: TAsmDirective); override;
+        procedure WriteWeakSymbolDef(s: tasmsymbol); override;
+
        end;
 
 
@@ -113,7 +113,7 @@ implementation
 {$ifdef m68k}
       cpuinfo,aasmcpu,
 {$endif m68k}
-      cpubase,objcasm;
+      cpubase;
 
     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_aranges','.debug_ranges',
+          '.debug_frame','.debug_info','.debug_line','.debug_abbrev',
           '.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_aranges','.debug_ranges',
+          '.debug_frame','.debug_info','.debug_line','.debug_abbrev',
           '.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_aranges,sec_debug_ranges:
+          sec_debug_frame,sec_debug_info,sec_debug_line,sec_debug_abbrev:
             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]) then
+             if (atype in [sec_stub,sec_objc_data,sec_objc_const,sec_data_coalesced]) then
                writer.AsmWrite('.section ');
            end
          else
@@ -1206,6 +1206,13 @@ 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
@@ -1371,7 +1378,7 @@ implementation
       end;
 
 
-    procedure TGNUAssembler.WriteWeakSymbolRef(s: tasmsymbol);
+    procedure TGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
       begin
         writer.AsmWriteLn(#9'.weak '+s.name);
       end;
@@ -1522,12 +1529,7 @@ implementation
 
     procedure TGNUAssembler.WriteDirectiveName(dir: TAsmDirective);
     begin
-      { 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]+' ');
+      writer.AsmWrite('.'+directivestr[dir]+' ');
     end;
 
 
@@ -1570,7 +1572,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
-          WriteWeakSymbolRef(tasmsymbol(current_asmdata.asmsymboldict[i]));
+          writeweaksymboldef(tasmsymbol(current_asmdata.asmsymboldict[i]));
 
       if create_smartlink_sections and
          (target_info.system in systems_darwin) then
@@ -1631,16 +1633,6 @@ 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';
@@ -1686,33 +1678,139 @@ implementation
                 result:='.section __DATA, __mod_term_func, mod_term_funcs';
                 exit;
               end;
-            low(TObjCAsmSectionType)..high(TObjCAsmSectionType):
+            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:
               begin
-                result:='.section '+objc_section_name(atype);
+                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';
                 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.WriteWeakSymbolRef(s: tasmsymbol);
+    procedure TAppleGNUAssembler.WriteWeakSymbolDef(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                           }
@@ -1754,8 +1852,6 @@ 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 }

+ 2 - 3
compiler/aopt.pas

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

+ 1 - 21
compiler/aoptbase.pas

@@ -95,12 +95,6 @@ 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;
@@ -108,7 +102,7 @@ unit aoptbase;
   implementation
 
     uses
-      verbose,globtype,globals,aoptcpub;
+      globtype,globals,aoptcpub;
 
   constructor taoptbase.create;
     begin
@@ -291,20 +285,6 @@ 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;

+ 12 - 26
compiler/aoptobj.pas

@@ -315,10 +315,6 @@ 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>
@@ -339,10 +335,10 @@ Unit AoptObj;
         procedure RemoveDelaySlot(hp1: tai);
 
         { peephole optimizer }
-        procedure PrePeepHoleOpts; virtual;
-        procedure PeepHoleOptPass1; virtual;
+        procedure PrePeepHoleOpts;
+        procedure PeepHoleOptPass1;
         procedure PeepHoleOptPass2; virtual;
-        procedure PostPeepHoleOpts; virtual;
+        procedure PostPeepHoleOpts;
 
         { processor dependent methods }
         // if it returns true, perform a "continue"
@@ -1121,25 +1117,15 @@ 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) 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 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 SkipLabels(hp: tai; var hp2: tai): boolean;

+ 0 - 49
compiler/aoptutils.pas

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

+ 18 - 50
compiler/arm/aasmcpu.pas

@@ -275,7 +275,7 @@ uses
          insoffset : longint;
          LastInsOffset : longint; { need to be public to be reset }
          insentry  : PInsEntry;
-         procedure BuildArmMasks(objdata:TObjData);
+         procedure BuildArmMasks;
          function  InsEnd:longint;
          procedure create_ot(objdata:TObjData);
          function  Matches(p:PInsEntry):longint;
@@ -872,7 +872,6 @@ 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
@@ -1417,36 +1416,6 @@ 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,
@@ -2125,7 +2094,7 @@ implementation
       end;
 
 
-    procedure taicpu.BuildArmMasks(objdata:TObjData);
+    procedure taicpu.BuildArmMasks;
       const
         Masks: array[tcputype] of longint =
           (
@@ -2166,8 +2135,7 @@ implementation
       begin
         fArmVMask:=Masks[current_settings.cputype] or FPUMasks[current_settings.fputype];
 
-        if objdata.ThumbFunc then
-        //if current_settings.instructionset=is_thumb then
+        if current_settings.instructionset=is_thumb then
           begin
             fArmMask:=IF_THUMB;
             if CPUARM_HAS_THUMB2 in cpu_capabilities[current_settings.cputype] then
@@ -2668,7 +2636,7 @@ implementation
            { create the .ot fields }
            create_ot(objdata);
 
-           BuildArmMasks(objdata);
+           BuildArmMasks;
            { set the file postion }
            current_filepos:=fileinfo;
          end
@@ -2779,15 +2747,15 @@ implementation
 
       function MakeRegList(reglist: tcpuregisterset): word;
         var
-          i, w: integer;
+          i, w: word;
         begin
           result:=0;
-          w:=0;
+          w:=1;
           for i:=RS_R0 to RS_R15 do
             begin
               if i in reglist then
-                result:=result or (1 shl w);
-              inc(w);
+                result:=result or w;
+              w:=w shl 1
             end;
         end;
 
@@ -2976,15 +2944,13 @@ implementation
               else
                 begin
                   currsym:=objdata.symbolref(oper[0]^.ref^.symbol);
-
-                  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)
+                  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
                   else
-                    objdata.writereloc(aint(bytes),4,currsym,RELOC_RELATIVE_CALL);
-
-                  exit;
+                    bytes:=bytes or (((currsym.offset-insoffset-8) shr 2) and $ffffff);
                 end;
             end;
           #$02:
@@ -4521,9 +4487,11 @@ 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)
@@ -4683,7 +4651,7 @@ implementation
                         bytes:=bytes or (1 shl r);
 
                     if oper[0]^.typ=top_ref then
-                      bytes:=bytes or (getsupreg(oper[0]^.ref^.index) shl 8)
+                      bytes:=bytes or (getsupreg(oper[0]^.ref^.base) shl 8)
                     else
                       bytes:=bytes or (getsupreg(oper[0]^.reg) shl 8);
                   end;
@@ -4694,7 +4662,7 @@ implementation
                         bytes:=bytes or (1 shl r);
 
                     if oper[0]^.typ=top_ref then
-                      bytes:=bytes or (getsupreg(oper[0]^.ref^.index) shl 8)
+                      bytes:=bytes or (getsupreg(oper[0]^.ref^.base) shl 8)
                     else
                       bytes:=bytes or (getsupreg(oper[0]^.reg) shl 8);
                   end;

+ 1 - 1
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,A_SRS,A_RFE]) then
+               if (i=0) and (op in [A_LDM,A_STM,A_FSTM,A_FLDM,A_VSTM,A_VLDM]) then
                  begin
                    case taicpu(hp).oper[0]^.typ of
                      top_ref:

+ 120 - 194
compiler/arm/aoptcpu.pas

@@ -39,8 +39,11 @@ Type
     procedure PeepHoleOptPass2;override;
     Function RegInInstruction(Reg: TRegister; p1: tai): Boolean;override;
     function RemoveSuperfluousMove(const p: tai; movp: tai; const optimizer: string): boolean;
-    function RemoveSuperfluousVMov(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;
     { 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.
@@ -52,9 +55,6 @@ 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,11 +93,7 @@ Implementation
         (taicpu(p).opcode<>A_CBZ) and
         (taicpu(p).opcode<>A_CBNZ) and
         (taicpu(p).opcode<>A_PLD) and
-        (((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).opcode<>A_BLX) or
          (taicpu(p).oper[0]^.typ=top_reg));
     end;
 
@@ -171,6 +167,67 @@ 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
@@ -192,6 +249,44 @@ 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
@@ -202,118 +297,27 @@ Implementation
                   (abs(aoffset)<256);
     end;
 
-
-  function TCpuAsmOptimizer.InstructionLoadsFromReg(const reg: TRegister; const hp: tai): boolean;
-    var
-      p: taicpu;
-      i: longint;
+  function TCpuAsmOptimizer.RegUsedAfterInstruction(reg: Tregister; p: tai;
+    var AllUsedRegs: TAllUsedRegs): Boolean;
     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;
+      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 TCpuAsmOptimizer.RegLoadedWithNewValue(reg: tregister; hp: tai): boolean;
-    var
-      p: taicpu;
+  function TCpuAsmOptimizer.RegEndOfLife(reg : TRegister;p : taicpu) : boolean;
     begin
-      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;
+       Result:=assigned(FindRegDealloc(reg,tai(p.Next))) or
+         RegLoadedWithNewValue(reg,p);
     end;
 
-
   function TCpuAsmOptimizer.GetNextInstructionUsingReg(Current: tai;
     Out Next: tai; reg: TRegister): Boolean;
     begin
@@ -439,69 +443,6 @@ 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
@@ -1501,9 +1442,6 @@ 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
@@ -2213,19 +2151,7 @@ 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;

+ 0 - 1
compiler/arm/armatt.inc

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

+ 0 - 1
compiler/arm/armatts.inc

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

+ 5 - 6
compiler/arm/armins.dat

@@ -1030,7 +1030,6 @@ 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
@@ -1668,13 +1667,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\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
 
+[VFNMS]
+vreg,vreg,vreg          \x92\xEE\x90\xA\x40          THUMB32,VFPv4
+vreg,vreg,vreg          \x42\xE\x90\xA\x40          ARM32,VFPv4
+
 [VNEGcc]
 vreg,vreg               \x92\xEE\xB1\xA\x40         THUMB32,VFPv2
 vreg,vreg               \x42\xE\xB1\xA\x40         ARM32,VFPv2
@@ -1838,4 +1837,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

+ 0 - 1
compiler/arm/armop.inc

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

+ 4 - 4
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#64;
+    code    : #146#238#144#10#0;
     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#64;
+    code    : #66#14#144#10#0;
     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#0;
+    code    : #146#238#144#10#64;
     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#0;
+    code    : #66#14#144#10#64;
     flags   : if_arm32 or if_vfpv4
   ),
   (

+ 13 - 27
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 in [fpu_vfpv3,fpu_vfpv4] then
+        if current_settings.fputype=fpu_vfpv3 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,13 +646,11 @@ 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
-        { use always BL as newer binutils do not translate blx apparently
-          generating BL is also what clang and gcc do by default }
+        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
           branchopcode:=A_BL;
         if not(weak) then
           sym:=current_asmdata.RefAsmSymbol(s)
@@ -1922,13 +1920,9 @@ unit cgcpu;
                 end;
               fpu_vfpv2,
               fpu_vfpv3,
-              fpu_vfpv4,
               fpu_vfpv3_d16:
                 begin;
-                  { 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];
+                  mmregs:=rg[R_MMREGISTER].used_in_proc-paramanager.get_volatile_registers_mm(pocall_stdcall);
                 end;
             end;
             a_reg_alloc(list,NR_STACK_POINTER_REG);
@@ -2072,7 +2066,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_vfpv4,fpu_vfpv3_d16]) then
+                  (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv3_d16]) then
                  begin
                    if not is_shifter_const(tarmprocinfo(current_procinfo).floatregstart,shift) then
                      begin
@@ -2101,7 +2095,6 @@ unit cgcpu;
                    end;
                  fpu_vfpv2,
                  fpu_vfpv3,
-                 fpu_vfpv4,
                  fpu_vfpv3_d16:
                    begin
                      ref.index:=ref.base;
@@ -2111,8 +2104,7 @@ unit cgcpu;
                        postfix:=PF_IAX
                      else
                        postfix:=PF_IAD;}
-                     if mmregs<>[] then
-                       list.concat(taicpu.op_ref_regset(A_VSTM,ref,R_MMREGISTER,R_SUBFD,mmregs));
+                     list.concat(taicpu.op_ref_regset(A_VSTM,ref,R_MMREGISTER,R_SUBFD,mmregs));
                    end;
                end;
              end;
@@ -2163,14 +2155,10 @@ unit cgcpu;
                 end;
               fpu_vfpv2,
               fpu_vfpv3,
-              fpu_vfpv4,
               fpu_vfpv3_d16:
                 begin;
                   { restore vfp registers? }
-                  { 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];
+                  mmregs:=rg[R_MMREGISTER].used_in_proc-paramanager.get_volatile_registers_mm(pocall_stdcall);
                 end;
             end;
 
@@ -2179,7 +2167,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_vfpv4,fpu_vfpv3_d16]) then
+                   (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv3_d16]) then
                   begin
                     if not is_shifter_const(tarmprocinfo(current_procinfo).floatregstart,shift) then
                       begin
@@ -2207,7 +2195,6 @@ unit cgcpu;
                     end;
                   fpu_vfpv2,
                   fpu_vfpv3,
-                  fpu_vfpv4,
                   fpu_vfpv3_d16:
                     begin
                       ref.index:=ref.base;
@@ -2217,8 +2204,7 @@ unit cgcpu;
                         mmpostfix:=PF_IAX
                       else
                         mmpostfix:=PF_IAD;}
-                     if mmregs<>[] then
-                       list.concat(taicpu.op_ref_regset(A_VLDM,ref,R_MMREGISTER,R_SUBFD,mmregs));
+                      list.concat(taicpu.op_ref_regset(A_VLDM,ref,R_MMREGISTER,R_SUBFD,mmregs));
                     end;
                 end;
               end;
@@ -4231,7 +4217,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 in [fpu_vfpv3,fpu_vfpv4] then
+        if current_settings.fputype=fpu_vfpv3 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,

+ 1 - 1
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];
+      VOLATILE_MMREGISTERS =  [RS_D0..RS_D7,RS_D16..RS_D31,RS_S1..RS_S15];
 
       VOLATILE_INTREGISTERS_DARWIN = [RS_R0..RS_R3,RS_R9,RS_R12..RS_R14];
 

+ 0 - 2
compiler/arm/cpuelf.pas

@@ -327,8 +327,6 @@ 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:

+ 2 - 4
compiler/arm/cpuinfo.pas

@@ -499,9 +499,7 @@ Const
        reference, but that's already done for stdcall) }
      pocall_mwpascal,
      { used for interrupt handling }
-     pocall_interrupt,
-     { needed sometimes on android }
-     pocall_hardfloat
+     pocall_interrupt
    ];
 
    cputypestr : array[tcputype] of string[8] = ('',
@@ -967,7 +965,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_vfpv4,fpu_vfpv3_d16,fpu_fpv4_s16];
+   vfp_scalar = [fpu_vfpv2,fpu_vfpv3,fpu_vfpv3_d16,fpu_fpv4_s16];
 
    { Supported optimizations, only used for information }
    supported_optimizerswitches = genericlevel1optimizerswitches+

+ 4 - 4
compiler/arm/cpupara.pas

@@ -168,12 +168,12 @@ unit cpupara;
             orddef:
               getparaloc:=LOC_REGISTER;
             floatdef:
-              if ((target_info.abi=abi_eabihf) or (calloption=pocall_hardfloat)) and
+              if (target_info.abi = abi_eabihf) 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_vfpv4,fpu_vfpv3_d16,fpu_fpv4_s16]) then
+                 (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,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) or (p.proccalloption=pocall_hardfloat) then
+            if target_info.abi = abi_eabihf 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_vfpv4,fpu_vfpv3_d16,fpu_fpv4_s16]) then
+               (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv3_d16,fpu_fpv4_s16]) then
               begin
                 case retcgsize of
                   OS_64,

+ 0 - 1
compiler/arm/cpupi.pas

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

+ 0 - 9
compiler/arm/narmadd.pas

@@ -34,7 +34,6 @@ 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;
@@ -159,12 +158,6 @@ interface
       end;
 
 
-    function tarmaddnode.use_fma : boolean;
-      begin
-       Result:=current_settings.fputype in [fpu_vfpv4];
-      end;
-
-
     procedure tarmaddnode.second_addfloat;
       var
         op : TAsmOp;
@@ -207,7 +200,6 @@ interface
             end;
           fpu_vfpv2,
           fpu_vfpv3,
-          fpu_vfpv4,
           fpu_vfpv3_d16:
             begin
               { force mmreg as location, left right doesn't matter
@@ -307,7 +299,6 @@ interface
             end;
           fpu_vfpv2,
           fpu_vfpv3,
-          fpu_vfpv4,
           fpu_vfpv3_d16:
             begin
               hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,true);

+ 2 - 3
compiler/arm/narmcal.pas

@@ -45,10 +45,9 @@ implementation
   procedure tarmcallnode.set_result_location(realresdef: tstoreddef);
     begin
       if (realresdef.typ=floatdef) and 
-         (target_info.abi<>abi_eabihf) and
-         (procdefinition.proccalloption<>pocall_hardfloat) and
+         (target_info.abi <> abi_eabihf) and
          ((cs_fp_emulation in current_settings.moduleswitches) or
-          (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv4,fpu_vfpv3_d16,fpu_fpv4_s16])) then
+          (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,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

+ 0 - 2
compiler/arm/narmcnv.pas

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

+ 1 - 111
compiler/arm/narminl.pas

@@ -33,7 +33,6 @@ 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;
@@ -51,7 +50,6 @@ interface
         }
         procedure second_prefetch; override;
         procedure second_abs_long; override;
-        procedure second_fma; override;
       private
         procedure load_fpu_location(out singleprec: boolean);
       end;
@@ -63,8 +61,7 @@ implementation
       globtype,verbose,globals,
       cpuinfo, defutil,symdef,aasmdata,aasmcpu,
       cgbase,cgutils,pass_1,pass_2,
-      cpubase,ncgutil,cgobj,cgcpu, hlcgobj,
-      ncal;
+      cpubase,ncgutil,cgobj,cgcpu, hlcgobj;
 
 {*****************************************************************************
                               tarminlinenode
@@ -88,7 +85,6 @@ implementation
             end;
           fpu_vfpv2,
           fpu_vfpv3,
-          fpu_vfpv4,
           fpu_vfpv3_d16,
           fpu_fpv4_s16:
             begin
@@ -129,7 +125,6 @@ implementation
                 expectloc:=LOC_FPUREGISTER;
               fpu_vfpv2,
               fpu_vfpv3,
-              fpu_vfpv4,
               fpu_vfpv3_d16:
                 expectloc:=LOC_MMREGISTER;
               fpu_fpv4_s16:
@@ -160,7 +155,6 @@ implementation
                 expectloc:=LOC_FPUREGISTER;
               fpu_vfpv2,
               fpu_vfpv3,
-              fpu_vfpv4,
               fpu_vfpv3_d16:
                 expectloc:=LOC_MMREGISTER;
               fpu_fpv4_s16:
@@ -191,7 +185,6 @@ implementation
                 expectloc:=LOC_FPUREGISTER;
               fpu_vfpv2,
               fpu_vfpv3,
-              fpu_vfpv4,
               fpu_vfpv3_d16:
                 expectloc:=LOC_MMREGISTER;
               fpu_fpv4_s16:
@@ -209,19 +202,6 @@ 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
@@ -264,7 +244,6 @@ 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
@@ -301,7 +280,6 @@ 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
@@ -331,7 +309,6 @@ 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
@@ -427,93 +404,6 @@ 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.

+ 0 - 1
compiler/arm/narmmat.pas

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

+ 2 - 2
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, opdef,
-             left.location, setbase);
+            register_maybe_adjust_setbase(current_asmdata.CurrAsmList, left.location,
+             setbase);
             hlcg.location_force_reg(current_asmdata.CurrAsmList, right.location,
              right.resultdef, right.resultdef, true);
 

+ 23 - 37
compiler/arm/raarmgas.pas

@@ -62,7 +62,7 @@ Unit raarmgas;
       { helpers }
       cutils,
       { global }
-      globtype,globals,verbose,
+      globtype,verbose,
       systems,aasmbase,aasmtai,aasmdata,aasmcpu,
       { symtable }
       symconst,symsym,
@@ -149,14 +149,12 @@ Unit raarmgas;
 
     function tarmattreader.is_targetdirective(const s: string): boolean;
       begin
-        case s of
-          '.thumb_func',
-          '.code',
-          '.thumb_set':
-            result:=true
-          else
-            Result:=inherited is_targetdirective(s);
-        end;
+        if s = '.thumb_func' then
+          result:=true
+        else if s='.thumb_set' then
+          result:=true
+        else
+          Result:=inherited is_targetdirective(s);
       end;
 
 
@@ -1006,7 +1004,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,A_SRS,A_RFE]) then
+              else if (actasmtoken=AS_NOT) and (actopcode in [A_LDM,A_STM,A_FLDM,A_FSTM,A_VLDM,A_VSTM]) then
                 begin
                   consume(AS_NOT);
                   oper.opr.typ:=OPR_REFERENCE;
@@ -1428,7 +1426,6 @@ Unit raarmgas;
           end;
       end;
 
-
     procedure tarmattreader.HandleTargetDirective;
       var
         symname,
@@ -1436,35 +1433,24 @@ Unit raarmgas;
         val     : aint;
         symtyp  : TAsmsymtype;
       begin
-        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);
+        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);
 
-              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;
+            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;
       end;
 
-
     function tarmattreader.is_unified: boolean;
       begin
         result:=false;

+ 0 - 5
compiler/arm/rgcpu.pas

@@ -346,11 +346,6 @@ 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;

+ 5 - 61
compiler/assemble.pas

@@ -248,7 +248,9 @@ Implementation
       cclasses,
 {$endif memdebug}
       script,fmodule,verbose,
+{$if defined(m68k) or defined(arm)}
       cpuinfo,
+{$endif m68k or arm}
       aasmcpu,
       owar,owomflib
       ;
@@ -925,22 +927,14 @@ 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;
 
@@ -1480,7 +1474,6 @@ Implementation
       var
         objsym,
         objsymend : TObjSymbol;
-        cpu: tcputype;
       begin
         while assigned(hp) do
          begin
@@ -1561,22 +1554,9 @@ 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);
@@ -1619,7 +1599,6 @@ Implementation
       var
         objsym,
         objsymend : TObjSymbol;
-        cpu: tcputype;
       begin
         while assigned(hp) do
          begin
@@ -1721,19 +1700,6 @@ 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;
@@ -1763,7 +1729,6 @@ Implementation
         {$endif}
         ccomp : comp;
         tmp    : word;
-        cpu: tcputype;
       begin
         fillchar(zerobuf,sizeof(zerobuf),0);
         fillchar(objsym,sizeof(objsym),0);
@@ -1951,31 +1916,10 @@ Implementation
              ait_cutobject :
                if SmartAsm then
                 break;
-             ait_directive :
+             ait_weak:
                begin
-                 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
+                 objsym:=ObjData.symbolref(tai_weak(hp).sym^);
+                 objsym.bind:=AB_WEAK_EXTERNAL;
                end;
              ait_symbolpair:
                begin

+ 1 - 0
compiler/avr/aasmcpu.pas

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

+ 1 - 5
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 = A_ANDI) and
+                (taicpu(p).opcode in [A_ANDI,A_ORI]) 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,10 +208,6 @@ 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);

+ 6 - 13
compiler/avr/cgcpu.pas

@@ -402,18 +402,11 @@ 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,sym))
+          list.concat(taicpu.op_sym(A_CALL,current_asmdata.RefAsmSymbol(s)))
         else
-          list.concat(taicpu.op_sym(A_RCALL,sym));
+          list.concat(taicpu.op_sym(A_RCALL,current_asmdata.RefAsmSymbol(s)));
 
         include(current_procinfo.flags,pi_do_call);
       end;
@@ -1599,17 +1592,17 @@ unit cgcpu;
             end;
 
             if swapped then
-              list.concat(taicpu.op_reg_reg(A_CP,NR_R1,reg))
+              list.concat(taicpu.op_reg_reg(A_CP,reg,NR_R1))
             else
-              list.concat(taicpu.op_reg_reg(A_CP,reg,NR_R1));
+              list.concat(taicpu.op_reg_reg(A_CP,NR_R1,reg));
 
             for i:=2 to tcgsize2size[size] do
               begin
                 reg:=GetNextReg(reg);
                 if swapped then
-                  list.concat(taicpu.op_reg_reg(A_CPC,NR_R1,reg))
+                  list.concat(taicpu.op_reg_reg(A_CPC,reg,NR_R1))
                 else
-                  list.concat(taicpu.op_reg_reg(A_CPC,reg,NR_R1));
+                  list.concat(taicpu.op_reg_reg(A_CPC,NR_R1,reg));
               end;
 
             a_jmp_cond(list,cmp_op,l);

+ 2 - 2
compiler/avr/cpuinfo.pas

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

+ 1 - 2
compiler/avr/cpunode.pas

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

+ 0 - 198
compiler/avr/navrutil.pas

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

+ 4 - 4
compiler/cclasses.pas

@@ -401,7 +401,7 @@ type
        { string container }
        TCmdStrList = class(TLinkedList)
        private
-          FDoubles : boolean;  { if this is set to true, doubles (case insensitive!) are allowed }
+          FDoubles : boolean;  { if this is set to true, doubles 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 (findcase(s)<>nil)) then
+            ((not FDoubles) and (find(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 (findcase(s)<>nil)) then
+            ((not FDoubles) and (find(s)<>nil)) then
           exit;
          inherited concat(TCmdStrListItem.create(s));
       end;
@@ -2428,7 +2428,7 @@ end;
       begin
         if s='' then
          exit;
-        p:=findcase(s);
+        p:=find(s);
         if assigned(p) then
          begin
            inherited Remove(p);

+ 2 - 0
compiler/cfileutl.pas

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

+ 4 - 8
compiler/cgobj.pas

@@ -1096,12 +1096,8 @@ 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
-                       ((-paraloc.shiftval) in [1,2,4]) then
+                       (sizeleft 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
@@ -1323,7 +1319,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,fromsize,tosize,tmpreg2,register);
+                    a_load_reg_reg(list,OS_16,tosize,tmpreg2,register);
                   end;
               OS_32,OS_S32:
                 if ref.alignment=2 then
@@ -1340,7 +1336,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,fromsize,tosize,tmpreg2,register);
+                    a_load_reg_reg(list,OS_32,tosize,tmpreg2,register);
                   end
                 else
                   begin
@@ -1359,7 +1355,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,fromsize,tosize,tmpreg,register);
+                    a_load_reg_reg(list,OS_32,tosize,tmpreg,register);
                   end
               else
                 a_load_ref_reg(list,fromsize,tosize,tmpref,register);

+ 1 - 3
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+abs_low_int64;
+    sspace:=a.uvalue+qword(abs(low(int64)));
   if sspace>=b then
     begin
       result.signed:=true;
@@ -288,9 +288,7 @@ begin
     begin
       result.overflow:=false;
       result.signed:=true;
-      {$push} {$Q-}
       result.svalue:=-a.svalue;
-      {$pop}
     end;
 end;
 

+ 3 - 2
compiler/cresstr.pas

@@ -133,6 +133,7 @@ uses
       Var
         namelab,
         valuelab : tasmlabofs;
+        resstrlab : tasmsymbol;
         R : TResourceStringItem;
         resstrdef: tdef;
         tcb : ttai_typedconstbuilder;
@@ -147,8 +148,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,cansistringtype);
-        tcb.emit_tai(tai_const.create_nil_dataptr,cansistringtype);
+        tcb.emit_tai(tai_const.create_nil_dataptr,voidpointertype);
+        tcb.emit_tai(tai_const.create_nil_dataptr,voidpointertype);
         tcb.emit_ord_const(0,u32inttype);
         tcb.maybe_end_aggregate(resstrdef);
         current_asmdata.asmlists[al_resourcestrings].concatList(

+ 0 - 100
compiler/cstreams.pas

@@ -132,20 +132,6 @@ 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)
@@ -481,92 +467,6 @@ 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                          *}
 {****************************************************************************}

+ 0 - 17
compiler/cutils.pas

@@ -103,7 +103,6 @@ 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;
@@ -867,22 +866,6 @@ 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

+ 1 - 68
compiler/dbgdwarf.pas

@@ -1557,24 +1557,6 @@ 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;
@@ -2231,14 +2213,6 @@ 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
@@ -3160,7 +3134,7 @@ implementation
 
       var
         storefilepos  : tfileposinfo;
-        lenstartlabel,arangestartlabel: tasmlabel;
+        lenstartlabel : tasmlabel;
         i : longint;
         def: tdef;
         dbgname: string;
@@ -3200,39 +3174,6 @@ 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 }
@@ -3327,14 +3268,6 @@ 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

+ 1 - 3
compiler/dbgstabs.pas

@@ -701,9 +701,7 @@ implementation
                 ss:=def_stabstr_evaluate(def,'r${numberstring};0;255;',[]);
               u32bit,
               s64bit,
-              u64bit,
-              s128bit,
-              u128bit:
+              u64bit :
                 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))]);

+ 7 - 12
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,16 +990,11 @@ implementation
                                       eq:=te_convert_l1;
                                     end
                                   else
-                                    { 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;
+                                   if (subeq>te_incompatible) then
+                                    begin
+                                      doconv:=hct;
+                                      eq:=te_convert_l2;
+                                    end;
                                 end;
                              end
                             else

+ 0 - 1239
compiler/entfile.pas

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

+ 19 - 36
compiler/export.pas

@@ -31,21 +31,18 @@ uses
   symtype,symdef,symsym,
   aasmbase,aasmdata;
 
-type
+const
    { export options }
-   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;
+   eo_resident = $1;
+   eo_index    = $2;
+   eo_name     = $4;
 
+type
    texported_item = class(TLinkedListItem)
       sym : tsym;
       index : longint;
       name : pshortstring;
-      options : texportoptions;
+      options : word;
       is_var : boolean;
       constructor create;
       destructor destroy;override;
@@ -54,12 +51,9 @@ 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;
@@ -72,20 +66,19 @@ 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: texportoptions);
-  procedure exportvarsym(sym: tsym; const s : string; index: longint; options: texportoptions);
+  procedure exportprocsym(sym: tsym; const s : string; index: longint; options: word);
+  procedure exportvarsym(sym: tsym; const s : string; index: longint; options: word);
   { to export symbols not directly related to a tsym (e.g., the Objective-C
     rtti) }
-  procedure exportname(const s : string; options: texportoptions);
+  procedure exportname(const s : string; options: word);
 
-  procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: texportoptions);
-  procedure exportallprocsymnames(ps: tprocsym; options: texportoptions);
+  procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: word);
+  procedure exportallprocsymnames(ps: tprocsym; options: word);
 
 
 var
@@ -105,20 +98,20 @@ uses
                            TExported_procedure
 ****************************************************************************}
 
-procedure exportprocsym(sym: tsym; const s : string; index: longint; options: texportoptions);
+procedure exportprocsym(sym: tsym; const s : string; index: longint; options: word);
   var
     hp : texported_item;
   begin
     hp:=texported_item.create;
     hp.name:=stringdup(s);
     hp.sym:=sym;
-    hp.options:=options+[eo_name];
+    hp.options:=options or eo_name;
     hp.index:=index;
     exportlib.exportprocedure(hp);
   end;
 
 
-procedure exportvarsym(sym: tsym; const s : string; index: longint; options: texportoptions);
+procedure exportvarsym(sym: tsym; const s : string; index: longint; options: word);
   var
     hp : texported_item;
   begin
@@ -126,19 +119,19 @@ procedure exportvarsym(sym: tsym; const s : string; index: longint; options: tex
     hp.name:=stringdup(s);
     hp.sym:=sym;
     hp.is_var:=true;
-    hp.options:=options+[eo_name];
+    hp.options:=options or eo_name;
     hp.index:=index;
     exportlib.exportvar(hp);
   end;
 
 
-procedure exportname(const s : string; options: texportoptions);
+procedure exportname(const s : string; options: word);
   begin
     exportvarsym(nil,s,0,options);
   end;
 
 
-  procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: texportoptions);
+  procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: word);
     var
       item: TCmdStrListItem;
     begin
@@ -155,7 +148,7 @@ procedure exportname(const s : string; options: texportoptions);
     end;
     
 
-  procedure exportallprocsymnames(ps: tprocsym; options: texportoptions);
+  procedure exportallprocsymnames(ps: tprocsym; options: word);
     var
       i: longint;
     begin
@@ -174,7 +167,7 @@ begin
   sym:=nil;
   index:=-1;
   name:=nil;
-  options:=[];
+  options:=0;
   is_var:=false;
 end;
 
@@ -193,7 +186,6 @@ end;
 constructor texportlib.Create;
 begin
   notsupmsg:=false;
-  fignoreduplicates:=false;
 end;
 
 
@@ -213,15 +205,6 @@ 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;

+ 4 - 17
compiler/expunix.pas

@@ -88,7 +88,7 @@ var
   hp2 : texported_item;
 begin
   { first test the index value }
-  if eo_index in hp.options then
+  if (hp.options and eo_index)<>0 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 !! }
-      duplicatesymbol(hp.name^);
+      Message1(parser_e_export_name_double,hp.name^);
       exit;
     end;
   if hp2=texported_item(current_module._exports.first) then
@@ -131,36 +131,23 @@ 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 }
-        { 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
+        pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]);
+        if not has_alias_name(pd,hp2.name^) then
          begin
            { place jump in al_procedures }
            current_asmdata.asmlists[al_procedures].concat(tai_align.create(target_info.alignment.procalign));

+ 1 - 12
compiler/fmodule.pas

@@ -43,7 +43,7 @@ interface
 
     uses
        cutils,cclasses,cfileutl,
-       globtype,finput,ogbase,fpkg,
+       globtype,finput,ogbase,
        symbase,symconst,symsym,
        wpobase,
        aasmbase,aasmtai,aasmdata;
@@ -158,7 +158,6 @@ 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;
@@ -172,7 +171,6 @@ interface
         linkotherstaticlibs,
         linkotherframeworks  : tlinkcontainer;
         mainname      : pshortstring; { alternate name for "main" procedure }
-        package       : tpackage;
 
         used_units           : tlinkedlist;
         dependent_units      : tlinkedlist;
@@ -225,7 +223,6 @@ 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;
@@ -613,7 +610,6 @@ implementation
         _exports:=TLinkedList.Create;
         dllscannerinputlist:=TFPHashList.Create;
         asmdata:=casmdata.create(modulename);
-        unitimportsyms:=TFPObjectList.Create(false);
         InitDebugInfo(self,false);
       end;
 
@@ -673,7 +669,6 @@ implementation
         linkothersharedlibs.Free;
         linkotherframeworks.Free;
         stringdispose(mainname);
-        unitimportsyms.Free;
         FImportLibraryList.Free;
         extendeddefs.Free;
         genericdummysyms.free;
@@ -891,12 +886,6 @@ 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;

+ 0 - 2
compiler/fpcdefs.inc

@@ -51,7 +51,6 @@
   {$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? }
@@ -71,7 +70,6 @@
   {$define cpumm}
   {$define fewintregisters}
   {$define cpurox}
-  {$define cpurefshaveindexreg}
   {$define SUPPORT_SAFECALL}
   {$define SUPPORT_GET_FRAME}
   {$define cpucapabilities}

+ 0 - 570
compiler/fpcp.pas

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

+ 0 - 123
compiler/fpkg.pas

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

+ 28 - 231
compiler/fppu.pas

@@ -38,7 +38,7 @@ interface
 
     uses
       cmsgs,verbose,
-      cutils,cclasses,cstreams,
+      cutils,cclasses,
       globtype,globals,finput,fmodule,
       symbase,ppu,symtype;
 
@@ -59,8 +59,7 @@ interface
           constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
           destructor destroy;override;
           procedure reset;override;
-          function  openppufile:boolean;
-          function  openppustream(strm:TCStream):boolean;
+          function  openppu:boolean;
           procedure getppucrc;
           procedure writeppu;
           procedure loadppu;
@@ -69,7 +68,6 @@ 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
@@ -77,17 +75,13 @@ 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);
@@ -95,7 +89,6 @@ interface
           procedure writederefdata;
           procedure writeImportSymbols;
           procedure writeResources;
-          procedure writeunitimportsyms;
           procedure readsourcefiles;
           procedure readloadunit;
           procedure readlinkcontainer(var p:tlinkcontainer);
@@ -104,7 +97,6 @@ interface
           procedure readImportSymbols;
           procedure readResources;
           procedure readwpofile;
-          procedure readunitimportsyms;
 {$IFDEF MACRO_DIFF_HINT}
           procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
           procedure writeusedmacros;
@@ -126,8 +118,7 @@ uses
   scanner,
   aasmbase,ogbase,
   parser,
-  comphook,
-  entfile,fpkg,fpcp;
+  comphook;
 
 
 var
@@ -142,7 +133,6 @@ var
         inherited create(LoadedFrom,amodulename,afilename,_is_unit);
         ppufile:=nil;
         sourcefn:=afilename;
-        unitimportsymsderefs:=tfplist.create;
       end;
 
 
@@ -153,8 +143,6 @@ var
         ppufile:=nil;
         comments.free;
         comments:=nil;
-        unitimportsymsderefs.free;
-        unitimportsymsderefs:=nil;
         inherited Destroy;
       end;
 
@@ -192,11 +180,11 @@ var
       until false;
     end;
 
-    function tppumodule.openppufile:boolean;
+    function tppumodule.openppu:boolean;
       var
         ppufiletime : longint;
       begin
-        openppufile:=false;
+        openppu:=false;
         Message1(unit_t_ppu_loading,ppufilename,@queuecomment);
       { Get ppufile time (also check if the file exists) }
         ppufiletime:=getnamedfiletime(ppufilename);
@@ -212,30 +200,6 @@ 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
@@ -245,15 +209,15 @@ var
            exit;
          end;
       { check for allowed PPU versions }
-        if not (ppufile.getversion = CurrentPPUVersion) then
+        if not (ppufile.GetPPUVersion = CurrentPPUVersion) then
          begin
-           Message1(unit_u_ppu_invalid_version,tostr(ppufile.getversion),@queuecomment);
+           Message1(unit_u_ppu_invalid_version,tostr(ppufile.GetPPUVersion),@queuecomment);
            ppufile.free;
            ppufile:=nil;
            exit;
          end;
       { check the target processor }
-        if tsystemcpu(ppufile.header.common.cpu)<>target_cpu then
+        if tsystemcpu(ppufile.header.cpu)<>target_cpu then
          begin
            ppufile.free;
            ppufile:=nil;
@@ -261,7 +225,7 @@ var
            exit;
          end;
       { check target }
-        if tsystem(ppufile.header.common.target)<>target_info.system then
+        if tsystem(ppufile.header.target)<>target_info.system then
          begin
            ppufile.free;
            ppufile:=nil;
@@ -270,7 +234,7 @@ var
          end;
 {$ifdef i8086}
       { check i8086 memory model flags }
-        if ((ppufile.header.common.flags and uf_i8086_far_code)<>0) xor
+        if ((ppufile.header.flags and uf_i8086_far_code)<>0) xor
             (current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge]) then
          begin
            ppufile.free;
@@ -278,7 +242,7 @@ var
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            exit;
          end;
-        if ((ppufile.header.common.flags and uf_i8086_far_data)<>0) xor
+        if ((ppufile.header.flags and uf_i8086_far_data)<>0) xor
             (current_settings.x86memorymodel in [mm_compact,mm_large]) then
          begin
            ppufile.free;
@@ -286,7 +250,7 @@ var
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            exit;
          end;
-        if ((ppufile.header.common.flags and uf_i8086_huge_data)<>0) xor
+        if ((ppufile.header.flags and uf_i8086_huge_data)<>0) xor
             (current_settings.x86memorymodel=mm_huge) then
          begin
            ppufile.free;
@@ -294,7 +258,7 @@ var
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            exit;
          end;
-        if ((ppufile.header.common.flags and uf_i8086_cs_equals_ds)<>0) xor
+        if ((ppufile.header.flags and uf_i8086_cs_equals_ds)<>0) xor
             (current_settings.x86memorymodel=mm_tiny) then
          begin
            ppufile.free;
@@ -306,7 +270,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.common.flags and uf_fpu_emulation)<>0) xor
+       if ((ppufile.header.flags and uf_fpu_emulation)<>0) xor
             (cs_fp_emulation in current_settings.moduleswitches) then
          begin
            ppufile.free;
@@ -317,15 +281,12 @@ var
 {$endif cpufpemu}
 
       { Load values to be access easier }
-        flags:=ppufile.header.common.flags;
+        flags:=ppufile.header.flags;
         crc:=ppufile.header.checksum;
         interface_crc:=ppufile.header.interface_checksum;
         indirect_crc:=ppufile.header.indirect_checksum;
       { Show Debug info }
-        if ppufiletime<>-1 then
-          Message1(unit_u_ppu_time,filetimestring(ppufiletime))
-        else
-          Message1(unit_u_ppu_time,'unknown');
+        Message1(unit_u_ppu_time,filetimestring(ppufiletime));
         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)');
@@ -376,7 +337,7 @@ var
            if Found then
             Begin
               SetFileName(hs,false);
-              Found:=openppufile;
+              Found:=OpenPPU;
             End;
            PPUSearchPath:=Found;
          end;
@@ -516,121 +477,6 @@ 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
@@ -847,16 +693,6 @@ 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}
 
 {
@@ -1153,20 +989,6 @@ 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;
@@ -1264,8 +1086,6 @@ var
              ibasmsymbols :
 { TODO: Remove ibasmsymbols}
                ;
-             ibunitimportsyms:
-               readunitimportsyms;
              ibendimplementation :
                break;
            else
@@ -1381,7 +1201,6 @@ var
          tunitwpoinfo(wpoinfo).buildderefimpl;
          if (flags and uf_local_symtable)<>0 then
            tstoredsymtable(localsymtable).buildderef_registered;
-         buildderefunitimportsyms;
          writederefmap;
          writederefdata;
 
@@ -1408,9 +1227,6 @@ var
          { write implementation uses }
          writeusedunit(false);
 
-         { write all symbols imported from another unit }
-         writeunitimportsyms;
-
          { end of implementation }
          ppufile.writeentry(ibendimplementation);
 
@@ -1427,14 +1243,14 @@ var
          { flush to be sure }
          ppufile.flush;
          { create and write header }
-         ppufile.header.common.size:=ppufile.size;
+         ppufile.header.size:=ppufile.size;
          ppufile.header.checksum:=ppufile.crc;
          ppufile.header.interface_checksum:=ppufile.interface_crc;
          ppufile.header.indirect_checksum:=ppufile.indirect_crc;
-         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.compiler:=wordversion;
+         ppufile.header.cpu:=word(target_cpu);
+         ppufile.header.target:=word(target_info.system);
+         ppufile.header.flags:=flags;
          ppufile.header.deflistsize:=current_module.deflist.count;
          ppufile.header.symlistsize:=current_module.symlist.count;
          ppufile.writeheader;
@@ -1533,14 +1349,14 @@ var
 
          { create and write header, this will only be used
            for debugging purposes }
-         ppufile.header.common.size:=ppufile.size;
+         ppufile.header.size:=ppufile.size;
          ppufile.header.checksum:=ppufile.crc;
          ppufile.header.interface_checksum:=ppufile.interface_crc;
          ppufile.header.indirect_checksum:=ppufile.indirect_crc;
-         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.compiler:=wordversion;
+         ppufile.header.cpu:=word(target_cpu);
+         ppufile.header.target:=word(target_info.system);
+         ppufile.header.flags:=flags;
          ppufile.writeheader;
 
          ppufile.closefile;
@@ -1575,7 +1391,7 @@ var
               if (pu.u.interface_crc<>pu.interface_checksum) or
                  (pu.u.indirect_crc<>pu.indirect_checksum) or
                  (
-                  ((ppufile.header.common.flags and uf_release)=0) and
+                  ((ppufile.header.flags and uf_release)=0) and
                   (pu.u.crc<>pu.checksum)
                  ) then
                begin
@@ -1665,8 +1481,6 @@ var
         if assigned(localsymtable) then
           tstoredsymtable(localsymtable).derefimpl(false);
 
-        derefunitimportsyms;
-
          { read whole program optimisation-related information }
          wpoinfo:=tunitwpoinfo.ppuload(ppufile);
          tunitwpoinfo(wpoinfo).deref;
@@ -1779,23 +1593,6 @@ 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

+ 17 - 115
compiler/globals.pas

@@ -44,9 +44,6 @@ 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
@@ -151,8 +148,7 @@ interface
          maxfpuregisters : shortint;
 
          cputype,
-         optimizecputype,
-         asmcputype      : tcputype;
+         optimizecputype : tcputype;
          fputype         : tfputype;
          asmmode         : tasmmode;
          interfacetype   : tinterfacetypes;
@@ -171,10 +167,6 @@ 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;
 
@@ -277,12 +269,11 @@ interface
        objectsearchpath,
        includesearchpath,
        frameworksearchpath  : TSearchPathList;
-       packagesearchpath     : TSearchPathList;
-       { contains tpackageentry entries }
-       packagelist : TFPHashList;
        autoloadunits      : string;
 
        { linking }
+       usegnubinutils : boolean;
+       forceforwardslash : boolean;
        usewindowapi  : boolean;
        description   : string;
        SetPEFlagsSetExplicity,
@@ -355,6 +346,8 @@ interface
        prop_auto_setter_prefix : string;
 
     const
+       DLLsource : boolean = false;
+
        Inside_asm_statement : boolean = false;
 
        global_unit_count : word = 0;
@@ -398,7 +391,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,cs_imported_data{$ifdef i8086},cs_force_far_calls{$endif}];
+        localswitches : [cs_check_io,cs_typed_const_writable,cs_pointermath{$ifdef i8086},cs_force_far_calls{$endif}];
         modeswitches : fpcmodeswitches;
         optimizerswitches : [];
         genwpoptimizerswitches : [];
@@ -421,83 +414,66 @@ 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;
-        { Use cpu_none by default,
-        because using cpu_8086 by default means
-        that we reject any instruction above bare 8086 instruction set
-        for all assembler code PM }
-        asmcputype : cpu_none;
         fputype : fpu_x87;
   {$endif i8086}
 {$endif not GENERIC_CPU}
@@ -518,9 +494,6 @@ 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;
       );
@@ -544,7 +517,6 @@ 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;
@@ -774,10 +746,10 @@ implementation
      get the current time in a string HH:MM:SS
    }
       var
-        st: TSystemTime;
+        hour,min,sec,hsec : word;
       begin
-        GetLocalTime(st);
-        gettimestr:=L0(st.Hour)+':'+L0(st.Minute)+':'+L0(st.Second);
+        DecodeTime(Time,hour,min,sec,hsec);
+        gettimestr:=L0(Hour)+':'+L0(min)+':'+L0(sec);
       end;
 
 
@@ -786,10 +758,10 @@ implementation
      get the current date in a string YY/MM/DD
    }
       var
-        st: TSystemTime;
+        Year,Month,Day: Word;
       begin
-        GetLocalTime(st);
-        getdatestr:=L0(st.Year)+'/'+L0(st.Month)+'/'+L0(st.Day);
+        DecodeDate(Date,year,month,day);
+        getdatestr:=L0(Year)+'/'+L0(Month)+'/'+L0(Day);
       end;
 
 
@@ -817,10 +789,10 @@ implementation
 
    function getrealtime : real;
      var
-       st:TSystemTime;
+       h,m,s,s1000 : word;
      begin
-       GetLocalTime(st);
-       result:=st.Hour*3600.0+st.Minute*60.0+st.Second+st.MilliSecond/1000.0;
+       DecodeTime(Time,h,m,s,s1000);
+       result:=h*3600.0+m*60.0+s+s1000/1000.0;
      end;
 
 {****************************************************************************
@@ -1096,8 +1068,7 @@ implementation
          'STDCALL',
          'SOFTFLOAT',
          'MWPASCAL',
-         'INTERRUPT',
-         'HARDFLOAT'
+         'INTERRUPT'
         );
       var
         t  : tproccalloption;
@@ -1372,70 +1343,8 @@ 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;
@@ -1443,7 +1352,6 @@ implementation
        frameworksearchpath.Free;
        LinkLibraryAliases.Free;
        LinkLibraryOrder.Free;
-       packagesearchpath.Free;
      end;
 
    procedure InitGlobals;
@@ -1456,6 +1364,7 @@ implementation
         do_make:=true;
         compile_level:=0;
         codegenerror:=false;
+        DLLsource:=false;
 
         { Output }
         OutputFileName:='';
@@ -1479,7 +1388,6 @@ implementation
         includesearchpath:=TSearchPathList.Create;
         objectsearchpath:=TSearchPathList.Create;
         frameworksearchpath:=TSearchPathList.Create;
-        packagesearchpath:=TSearchPathList.Create;
 
         { Def file }
         usewindowapi:=false;
@@ -1521,12 +1429,6 @@ implementation
 
         { enable all features by default }
         features:=[low(Tfeature)..high(Tfeature)];
-
-        callinitprocs;
      end;
 
-initialization
-  allocinitdoneprocs;
-finalization
-  freeinitdoneprocs;
 end.

+ 5 - 22
compiler/globtype.pas

@@ -92,16 +92,8 @@ 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;
@@ -114,7 +106,7 @@ interface
 {$ifdef i8086}
        TConstPtrUInt = LongWord;  { 32-bit for far pointers support }
 {$else i8086}
-       TConstPtrUInt = PUint;
+       TConstPtrUInt = AWord;
 {$endif i8086}
 
        { Use a variant record to be sure that the array if aligned correctly }
@@ -141,7 +133,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_imported_data,
+         cs_check_low_addr_load,
          { mmx }
          cs_mmx,cs_mmx_saturation,
          { parser }
@@ -523,10 +515,7 @@ interface
          { constant records by reference.                            }
          pocall_mwpascal,
          { Special interrupt handler for embedded systems }
-         pocall_interrupt,
-         { Directive for arm: pass floating point values in (v)float registers
-           regardless of the actual calling conventions }
-         pocall_hardfloat
+         pocall_interrupt
        );
        tproccalloptions = set of tproccalloption;
 
@@ -544,8 +533,7 @@ interface
            'StdCall',
            'SoftFloat',
            'MWPascal',
-           'Interrupt',
-           'HardFloat'
+           'Interrupt'
          );
 
        { Default calling convention }
@@ -648,12 +636,7 @@ 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,
-         { 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
+         pi_calls_c_varargs
        );
        tprocinfoflags=set of tprocinfoflag;
 

+ 2 - 1
compiler/hlcg2ll.pas

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

+ 9 - 46
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, todef: tdef; var ref: treference); virtual;
+          procedure g_ptrtypecast_ref(list: TAsmList; fromdef: tpointerdef; 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,12 +552,7 @@ 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; 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);
+          procedure g_load_const_field_by_name(list: TAsmList; recdef: trecorddef; const name: TIDString; a: tcgint; const recref: treference);
 
           { routines migrated from ncgutil }
 
@@ -828,10 +823,8 @@ implementation
             else
               result:=R_FPUREGISTER;
           filedef,
-          variantdef,
-          forwarddef,
-          undefineddef:
-            result:=R_INVALIDREGISTER;
+          variantdef:
+            internalerror(2010120507);
         else
           internalerror(2010120506);
         end;
@@ -1775,7 +1768,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,href));
+      a_load_const_subsetref(list,u8inttype,ord(doset),get_bit_reg_ref_sref(list,fromsize,tosize,bitnumber,ref));
     end;
 
   procedure thlcgobj.a_bit_set_reg_loc(list: TAsmList; doset: boolean; regsize, tosize: tdef; bitnumber: tregister; const loc: tlocation);
@@ -3687,7 +3680,6 @@ 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 }
 
@@ -3852,7 +3844,7 @@ implementation
       { nothing to do }
     end;
 
-  procedure thlcgobj.g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tdef; var ref: treference);
+  procedure thlcgobj.g_ptrtypecast_ref(list: TAsmList; fromdef: tpointerdef; todef: tdef; var ref: treference);
     begin
       { nothing to do }
     end;
@@ -3890,7 +3882,7 @@ implementation
     end;
 
 
-  procedure thlcgobj.g_load_const_field_by_name(list: TAsmList; recdef: trecorddef; a: tcgint; const name: TIDString; const recref: treference);
+  procedure thlcgobj.g_load_const_field_by_name(list: TAsmList; recdef: trecorddef; const name: TIDString; a: tcgint; const recref: treference);
     var
       fref: treference;
       fielddef: tdef;
@@ -3900,26 +3892,6 @@ 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,
@@ -4240,10 +4212,7 @@ implementation
               end
             else
 {$endif cpu64bitalu}
-              if getregtype(rr.old)=R_ADDRESSREGISTER then
-                rr.new := cg.getaddressregister(current_asmdata.CurrAsmList)
-              else
-                rr.new := cg.getintregister(current_asmdata.CurrAsmList,n.location.size);
+              rr.new := cg.getintregister(current_asmdata.CurrAsmList,n.location.size);
           end;
         LOC_CFPUREGISTER:
           rr.new := cg.getfpuregister(current_asmdata.CurrAsmList,n.location.size);
@@ -4636,11 +4605,7 @@ 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;
@@ -4658,7 +4623,7 @@ implementation
           look up procdef, use hlcgobj.a_call_name()) }
 
       { call __EXIT for main program }
-      if (not current_module.islibrary) and
+      if (not DLLsource) and
          (current_procinfo.procdef.proctypeoption=potype_proginit) then
         g_call_system_proc(list,'fpc_do_exit',[],nil);
     end;
@@ -4884,7 +4849,6 @@ 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
@@ -4950,7 +4914,6 @@ 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

+ 7 - 4
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).symtable.tableoptions) then
+                    (sto_has_operator in tabstractrecorddef(pt.resultdef).owner.tableoptions) then
                   collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList,searchhelpers,anoninherited,spezcontext);
                 pt:=tcallparanode(pt.right);
               end;
@@ -2472,7 +2472,10 @@ implementation
                   )
                 ) or
                 (
-                  assigned(pd.owner) and
+                  (
+                    not pd.is_specialization or
+                    assigned(pd.owner)
+                  ) and
                   (
                     not (pd.owner.symtabletype in [objectsymtable,recordsymtable]) or
                     is_visible_for_object(pd,contextstructdef)
@@ -2996,8 +2999,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_incompatible,
-           tve_shortint,tve_smallint,tve_longint,tve_chari64,tve_incompatible,
+          (tve_incompatible,tve_byte,tve_word,tve_cardinal,tve_chari64,
+           tve_shortint,tve_smallint,tve_longint,tve_chari64,
            tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
            tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
            tve_chari64,tve_chari64,tve_dblcurrency);

+ 118 - 0
compiler/i386/aopt386.pas

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

+ 0 - 113
compiler/i386/aoptcpub.pas

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

+ 0 - 36
compiler/i386/aoptcpud.pas

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

+ 9 - 33
compiler/i386/cgcpu.pas

@@ -209,11 +209,7 @@ unit cgcpu;
               end
           end
         else
-          begin
-            href:=r;
-            make_simple_ref(list,href);
-            inherited a_load_ref_cgpara(list,size,href,cgpara);
-          end;
+          inherited a_load_ref_cgpara(list,size,r,cgpara);
       end;
 
 
@@ -221,15 +217,9 @@ unit cgcpu;
       var
         tmpreg : tregister;
         opsize : topsize;
-        tmpref,dirref : treference;
+        tmpref : treference;
       begin
-        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
+        with r do
           begin
             if use_push(cgpara) then
               begin
@@ -240,11 +230,11 @@ unit cgcpu;
                     if assigned(symbol) then
                       begin
                         if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and
-                           ((dirref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or
+                           ((r.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,dirref,tmpreg);
+                            a_loadaddr_ref_reg(list,r,tmpreg);
                             list.concat(taicpu.op_reg(A_PUSH,opsize,tmpreg));
                           end
                         else if cs_create_pic in current_settings.moduleswitches then
@@ -252,12 +242,12 @@ unit cgcpu;
                             if offset<>0 then
                               begin
                                 tmpreg:=getaddressregister(list);
-                                a_loadaddr_ref_reg(list,dirref,tmpreg);
+                                a_loadaddr_ref_reg(list,r,tmpreg);
                                 list.concat(taicpu.op_reg(A_PUSH,opsize,tmpreg));
                               end
                             else
                               begin
-                                reference_reset_symbol(tmpref,dirref.symbol,0,dirref.alignment);
+                                reference_reset_symbol(tmpref,r.symbol,0,r.alignment);
                                 tmpref.refaddr:=addr_pic;
                                 tmpref.base:=current_procinfo.got;
 {$ifdef EXTDEBUG}
@@ -283,12 +273,12 @@ unit cgcpu;
                 else
                   begin
                     tmpreg:=getaddressregister(list);
-                    a_loadaddr_ref_reg(list,dirref,tmpreg);
+                    a_loadaddr_ref_reg(list,r,tmpreg);
                     list.concat(taicpu.op_reg(A_PUSH,opsize,tmpreg));
                   end;
               end
             else
-              inherited a_loadaddr_ref_cgpara(list,dirref,cgpara);
+              inherited a_loadaddr_ref_cgpara(list,r,cgpara);
           end;
       end;
 
@@ -640,13 +630,9 @@ 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
@@ -666,10 +652,8 @@ 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 :
@@ -682,12 +666,8 @@ 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;
 
 
@@ -705,10 +685,8 @@ 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);
@@ -734,11 +712,9 @@ 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);

+ 0 - 3
compiler/i386/cpuinfo.pas

@@ -45,7 +45,6 @@ Type
    tcputype =
       (cpu_none,
        cpu_386,
-       cpu_486,
        cpu_Pentium,
        cpu_Pentium2,
        cpu_Pentium3,
@@ -111,7 +110,6 @@ Const
 
    cputypestr : array[tcputype] of string[10] = ('',
      '80386',
-     '80486',
      'PENTIUM',
      'PENTIUM2',
      'PENTIUM3',
@@ -175,7 +173,6 @@ 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],

+ 2806 - 0
compiler/i386/daopt386.pas

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

+ 1 - 0
compiler/i386/hlcgcpu.pas

@@ -192,6 +192,7 @@ 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

+ 1 - 11
compiler/i386/i386att.inc

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

+ 2 - 12
compiler/i386/i386atts.inc

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

+ 1 - 11
compiler/i386/i386int.inc

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

+ 1 - 1
compiler/i386/i386nop.inc

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

+ 1 - 11
compiler/i386/i386op.inc

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

+ 21 - 31
compiler/i386/i386prop.inc

@@ -670,7 +670,6 @@
 (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)),
@@ -683,10 +682,6 @@
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
-(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
-(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
-(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
@@ -700,22 +695,26 @@
 (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_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_All, Ch_None, Ch_None)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
@@ -1025,14 +1024,5 @@
 (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))
+(Ch: (Ch_Mop3, Ch_Rop2, Ch_Rop1))
 );

+ 25 - 95
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_386 or if_sm
+    flags   : if_286 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_386 or if_sm or if_sd or if_ar2
+    flags   : if_286 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_386
+    flags   : if_286
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg32,ot_immediate,ot_none,ot_none);
     code    : #213#1#105#64#33;
-    flags   : if_386 or if_sd
+    flags   : if_286 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_186 or if_sm
+    flags   : if_286 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_186 or if_sm or if_sw or if_ar2
+    flags   : if_286 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_186
+    flags   : if_286
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg16,ot_immediate,ot_none,ot_none);
     code    : #212#1#105#64#25;
-    flags   : if_186 or if_sw
+    flags   : if_286 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_8086 or if_nox86_64
+    flags   : if_186 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_8086 or if_nox86_64
+    flags   : if_186 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_186
+    flags   : if_286
   ),
   (
     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_186
+    flags   : if_286
   ),
   (
     opcode  : A_PUSH;
@@ -4569,7 +4569,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #215#1#156;
-    flags   : if_8086
+    flags   : if_186
   ),
   (
     opcode  : A_PUSHFD;
@@ -4583,7 +4583,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #212#1#156;
-    flags   : if_8086
+    flags   : if_186
   ),
   (
     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_186 or if_sb
+    flags   : if_8086 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_186 or if_sb
+    flags   : if_8086 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_186 or if_sb
+    flags   : if_8086 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_186 or if_sb
+    flags   : if_8086 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_186 or if_sb
+    flags   : if_8086 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_186 or if_sb
+    flags   : if_8086 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_386 or if_pre
+    flags   : if_8086 or if_pre
   ),
   (
     opcode  : A_SEGGS;
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #1#101;
-    flags   : if_386 or if_pre
+    flags   : if_8086 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_p6 or if_cyrix
+    flags   : if_centaur
   ),
   (
     opcode  : A_XSHA1;
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #219#3#15#166#200;
-    flags   : if_p6 or if_cyrix
+    flags   : if_centaur
   ),
   (
     opcode  : A_XSHA256;
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #219#3#15#166#208;
-    flags   : if_p6 or if_cyrix
+    flags   : if_centaur
   ),
   (
     opcode  : A_DMINT;
@@ -8449,13 +8449,6 @@
     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;
@@ -13600,68 +13593,5 @@
     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
   )
 );

+ 0 - 2
compiler/i386/n386add.pas

@@ -190,13 +190,11 @@ 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

+ 1 - 5
compiler/i386/n386cal.pas

@@ -69,11 +69,7 @@ implementation
               // one syscall convention for AROS
               current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('AROS SysCall')));
               reference_reset(tmpref,sizeof(pint));
-              { 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);
+              tmpref.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(tcpuprocdef(procdefinition).libsym).mangledname);
               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));

File diff suppressed because it is too large
+ 195 - 454
compiler/i386/popt386.pas


+ 10 - 35
compiler/i8086/cgcpu.pas

@@ -1818,24 +1818,6 @@ 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
@@ -1846,22 +1828,12 @@ 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;
@@ -1869,12 +1841,17 @@ 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
-              begin
-                maybe_move_sp;
-                list.concat(Taicpu.Op_reg(A_POP,S_W,NR_DS));
-              end;
+              list.concat(Taicpu.Op_reg(A_POP,S_W,NR_DS));
             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
@@ -1944,8 +1921,6 @@ 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.
@@ -2059,7 +2034,7 @@ unit cgcpu;
 
     procedure tcg8086.g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
       begin
-        { Nothing to do }
+        { Nothing to release }
       end;
 
 

+ 0 - 2
compiler/i8086/cpuinfo.pas

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

+ 0 - 9
compiler/i8086/hlcgcpu.pas

@@ -248,15 +248,6 @@ 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

+ 1 - 11
compiler/i8086/i8086att.inc

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

+ 2 - 12
compiler/i8086/i8086atts.inc

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

+ 1 - 11
compiler/i8086/i8086int.inc

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

+ 1 - 1
compiler/i8086/i8086nop.inc

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

+ 1 - 11
compiler/i8086/i8086op.inc

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

+ 21 - 31
compiler/i8086/i8086prop.inc

@@ -670,7 +670,6 @@
 (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)),
@@ -683,10 +682,6 @@
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
-(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
-(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
-(Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
@@ -700,22 +695,26 @@
 (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_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_All, Ch_None, Ch_None)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
@@ -1039,14 +1038,5 @@
 (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))
+(Ch: (Ch_Mop3, Ch_Rop2, Ch_Rop1))
 );

+ 35 - 119
compiler/i8086/i8086tab.inc

@@ -378,13 +378,6 @@
     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;
@@ -2315,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_386 or if_sm
+    flags   : if_286 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_386 or if_sm or if_sd or if_ar2
+    flags   : if_286 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_386
+    flags   : if_286
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg32,ot_immediate,ot_none,ot_none);
     code    : #213#1#105#64#33;
-    flags   : if_386 or if_sd
+    flags   : if_286 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_186 or if_sm
+    flags   : if_286 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_186 or if_sm or if_sw or if_ar2
+    flags   : if_286 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_186
+    flags   : if_286
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg16,ot_immediate,ot_none,ot_none);
     code    : #212#1#105#64#25;
-    flags   : if_186 or if_sw
+    flags   : if_286 or if_sw
   ),
   (
     opcode  : A_IMUL;
@@ -2548,13 +2541,6 @@
     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;
@@ -4023,7 +4009,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #215#1#157;
-    flags   : if_8086 or if_nox86_64
+    flags   : if_186 or if_nox86_64
   ),
   (
     opcode  : A_POPFD;
@@ -4037,7 +4023,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #212#1#157;
-    flags   : if_8086 or if_nox86_64
+    flags   : if_186 or if_nox86_64
   ),
   (
     opcode  : A_POR;
@@ -4534,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_186
+    flags   : if_286
   ),
   (
     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_186
+    flags   : if_286
   ),
   (
     opcode  : A_PUSH;
@@ -4583,7 +4569,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #215#1#156;
-    flags   : if_8086
+    flags   : if_186
   ),
   (
     opcode  : A_PUSHFD;
@@ -4597,7 +4583,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #212#1#156;
-    flags   : if_8086
+    flags   : if_186
   ),
   (
     opcode  : A_PXOR;
@@ -4632,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_186 or if_sb
+    flags   : if_8086 or if_sb
   ),
   (
     opcode  : A_RCL;
@@ -4674,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_186 or if_sb
+    flags   : if_8086 or if_sb
   ),
   (
     opcode  : A_RCR;
@@ -4821,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_186 or if_sb
+    flags   : if_8086 or if_sb
   ),
   (
     opcode  : A_ROL;
@@ -4863,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_186 or if_sb
+    flags   : if_8086 or if_sb
   ),
   (
     opcode  : A_ROR;
@@ -4933,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_186 or if_sb
+    flags   : if_8086 or if_sb
   ),
   (
     opcode  : A_SAL;
@@ -4982,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_186 or if_sb
+    flags   : if_8086 or if_sb
   ),
   (
     opcode  : A_SAR;
@@ -5129,14 +5115,14 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #1#100;
-    flags   : if_386 or if_pre
+    flags   : if_8086 or if_pre
   ),
   (
     opcode  : A_SEGGS;
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #1#101;
-    flags   : if_386 or if_pre
+    flags   : if_8086 or if_pre
   ),
   (
     opcode  : A_SEGSS;
@@ -7705,21 +7691,21 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #219#3#15#166#192;
-    flags   : if_p6 or if_cyrix
+    flags   : if_centaur
   ),
   (
     opcode  : A_XSHA1;
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #219#3#15#166#200;
-    flags   : if_p6 or if_cyrix
+    flags   : if_centaur
   ),
   (
     opcode  : A_XSHA256;
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #219#3#15#166#208;
-    flags   : if_p6 or if_cyrix
+    flags   : if_centaur
   ),
   (
     opcode  : A_DMINT;
@@ -8477,13 +8463,6 @@
     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;
@@ -12976,14 +12955,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_imm3 or if_16bitonly
+    flags   : if_nec or if_sb 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_imm4 or if_16bitonly
+    flags   : if_nec or if_sw or if_16bitonly
   ),
   (
     opcode  : A_CMP4S;
@@ -13004,7 +12983,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_imm4 or if_16bitonly
+    flags   : if_nec or if_sb or if_16bitonly
   ),
   (
     opcode  : A_INS;
@@ -13018,7 +12997,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_imm4 or if_16bitonly
+    flags   : if_nec or if_sb or if_16bitonly
   ),
   (
     opcode  : A_NOT1;
@@ -13039,14 +13018,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_imm3 or if_16bitonly
+    flags   : if_nec or if_sb 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_imm4 or if_16bitonly
+    flags   : if_nec or if_sw or if_16bitonly
   ),
   (
     opcode  : A_REPC;
@@ -13095,14 +13074,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_imm3 or if_16bitonly
+    flags   : if_nec or if_sb 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_imm4 or if_16bitonly
+    flags   : if_nec or if_sw or if_16bitonly
   ),
   (
     opcode  : A_SUB4S;
@@ -13130,14 +13109,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_imm3 or if_16bitonly
+    flags   : if_nec or if_sb 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_imm4 or if_16bitonly
+    flags   : if_nec or if_sw or if_16bitonly
   ),
   (
     opcode  : A_VFMADD132PD;
@@ -13824,68 +13803,5 @@
     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
   )
 );

+ 33 - 24
compiler/jvm/agjasmin.pas

@@ -502,10 +502,6 @@ 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);
@@ -1102,26 +1098,39 @@ implementation
 
 
     procedure TJasminAssembler.WriteAsmList;
-      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;
+    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;
 
 
 {****************************************************************************}

+ 1 - 16
compiler/jvm/njvmcnv.pas

@@ -30,8 +30,6 @@ 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;
@@ -150,19 +148,6 @@ 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 }
@@ -491,7 +476,7 @@ implementation
                      { get the class representing the primitive type }
                      fvs:=search_struct_member(tobjectdef(corrclass),'FTYPE');
                      newpara:=nil;
-                     if not handle_staticfield_access(fvs,newpara) then
+                     if not handle_staticfield_access(fvs,false,newpara) then
                        internalerror(2011072417);
                    end
                  else

+ 1 - 1
compiler/jvm/njvmcon.pas

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

+ 0 - 6
compiler/jvm/njvminl.pas

@@ -305,12 +305,6 @@ 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;

+ 35 - 109
compiler/jvm/njvmtcon.pas

@@ -42,7 +42,6 @@ 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;
@@ -56,9 +55,8 @@ implementation
 
     uses
       globals,widestr,verbose,constexp,
-      tokens,scanner,pexpr,
       defutil,
-      nbas,ncal,ncon,ncnv,njvmcon;
+      nbas,ncal,ncon,njvmcon;
 
 
     procedure init_arrstringdata(out data: tarrstringdata);
@@ -90,9 +88,7 @@ implementation
             tcompilerwidechar(ord(arrstringdata.arrstring[length(arrstringdata.arrstring)]) shl 8));
 
 
-        if is_char(def) then
-          procvariant:='ansichar'
-        else if is_signed(def) then
+        if is_signed(def) then
           case def.size of
             1: procvariant:='shortint';
             2: procvariant:='smallint';
@@ -125,54 +121,14 @@ 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_char(def.elementdef) and
-            (not is_integer(def.elementdef) or
-             not(ts_compact_int_array_init in current_settings.targetswitches))) then
+           not is_integer(def.elementdef) or
+           not(ts_compact_int_array_init in current_settings.targetswitches) then
           begin
             inherited;
             exit;
@@ -182,66 +138,7 @@ implementation
         arrstringdata.arraybase:=basenode.getcopy;
         old_parsingordarray:=parsingordarray;
         parsingordarray:=true;
-        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;
+        inherited;
         if length(arrstringdata.arrstring)<>0 then
           tc_flush_arr_strconst(def.elementdef);
         arrstringdata.arraybase.free;
@@ -261,6 +158,8 @@ implementation
 
 
     procedure tjvmtypedconstbuilder.tc_emit_orddef(def: torddef; var node: tnode);
+      var
+        elesize: longint;
       begin
         if not parsingordarray then
           begin
@@ -269,7 +168,34 @@ implementation
           end;
         if node.nodetype<>ordconstn then
           internalerror(2011111101);
-        tc_emit_arr_strconst_ele(tordconstnode(node).value.svalue,def);
+        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);
         basenode.free;
         basenode:=nil;
         node.free;

Some files were not shown because too many files changed in this diff