* Synchronize with trunk

git-svn-id: branches/unicodekvm@41321 -

.gitattributes

@@ -650,6 +650,7 @@ compiler/ppcx64.lpi svneol=native#text/plain
 compiler/ppcx64llvm.lpi svneol=native#text/plain
 compiler/ppheap.pas svneol=native#text/plain
 compiler/ppu.pas svneol=native#text/plain
+compiler/procdefutil.pas svneol=native#text/plain
 compiler/procinfo.pas svneol=native#text/plain
 compiler/pstatmnt.pas svneol=native#text/plain
 compiler/psub.pas svneol=native#text/plain
@@ -2604,6 +2605,7 @@ packages/fcl-net/src/netware/resolve.inc svneol=native#text/plain
 packages/fcl-net/src/netwlibc/resolve.inc svneol=native#text/plain
 packages/fcl-net/src/os2/resolve.inc svneol=native#text/plain
 packages/fcl-net/src/resolve.pp svneol=native#text/plain
+packages/fcl-net/src/sslbase.pp svneol=native#text/plain
 packages/fcl-net/src/sslsockets.pp svneol=native#text/plain
 packages/fcl-net/src/ssockets.pp svneol=native#text/plain
 packages/fcl-net/src/unix/resolve.inc svneol=native#text/plain
@@ -3830,6 +3832,15 @@ packages/gnome1/src/zvt/libzvt.pp svneol=native#text/plain
 packages/gnome1/src/zvt/lists.inc svneol=native#text/plain
 packages/gnome1/src/zvt/vt.inc svneol=native#text/plain
 packages/gnome1/src/zvt/vtx.inc svneol=native#text/plain
+packages/gnutls/Makefile svneol=native#text/plain
+packages/gnutls/Makefile.fpc svneol=native#text/plain
+packages/gnutls/examples/httpget.pp svneol=native#text/plain
+packages/gnutls/examples/privkey.pp svneol=native#text/plain
+packages/gnutls/examples/srvcacert.pp svneol=native#text/plain
+packages/gnutls/examples/testgnutls.pp svneol=native#text/plain
+packages/gnutls/fpmake.pp svneol=native#text/plain
+packages/gnutls/src/gnutls.pp svneol=native#text/plain
+packages/gnutls/src/gnutlssockets.pp svneol=native#text/plain
 packages/googleapi/Makefile svneol=native#text/plain
 packages/googleapi/Makefile.fpc svneol=native#text/plain
 packages/googleapi/README.txt svneol=native#text/plain
@@ -5422,6 +5433,11 @@ 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/libmagic/Makefile svneol=native#text/plain
+packages/libmagic/Makefile.fpc svneol=native#text/plain
+packages/libmagic/examples/basic.pp svneol=native#text/plain
+packages/libmagic/fpmake.pp svneol=native#text/plain
+packages/libmagic/src/libmagic.pp 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
@@ -6711,6 +6727,7 @@ packages/openssl/examples/test1.pas svneol=native#text/plain
 packages/openssl/fpmake.pp svneol=native#text/plain
 packages/openssl/src/fpopenssl.pp svneol=native#text/plain
 packages/openssl/src/openssl.pas svneol=native#text/plain
+packages/openssl/src/opensslsockets.pp svneol=native#text/plain
 packages/oracle/Makefile svneol=native#text/plain
 packages/oracle/Makefile.fpc svneol=native#text/plain
 packages/oracle/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -7504,6 +7521,7 @@ packages/rtl-extra/src/inc/real48utils.pp svneol=native#text/plain
 packages/rtl-extra/src/inc/sockets.inc svneol=native#text/plain
 packages/rtl-extra/src/inc/socketsh.inc svneol=native#text/plain
 packages/rtl-extra/src/inc/sockovl.inc svneol=native#text/plain
+packages/rtl-extra/src/inc/sortalgs.pp svneol=native#text/plain
 packages/rtl-extra/src/inc/stdsock.inc svneol=native#text/plain
 packages/rtl-extra/src/inc/ucomplex.pp svneol=native#text/plain
 packages/rtl-extra/src/linux/ipccall.inc svneol=native#text/plain
@@ -7618,8 +7636,10 @@ packages/rtl-objpas/src/inc/widestrutils.pp svneol=native#text/plain
 packages/rtl-objpas/src/win/varutils.pp svneol=native#text/plain
 packages/rtl-objpas/src/x86_64/invoke.inc svneol=native#text/plain
 packages/rtl-objpas/tests/testrunner.rtlobjpas.pp svneol=native#text/pascal
+packages/rtl-objpas/tests/tests.rtti.impl.pas svneol=native#text/pascal
 packages/rtl-objpas/tests/tests.rtti.invoke.pas svneol=native#text/pascal
 packages/rtl-objpas/tests/tests.rtti.pas svneol=native#text/plain
+packages/rtl-objpas/tests/tests.rtti.util.pas svneol=native#text/pascal
 packages/rtl-unicode/Makefile svneol=native#text/plain
 packages/rtl-unicode/Makefile.fpc svneol=native#text/plain
 packages/rtl-unicode/fpmake.pp svneol=native#text/plain
@@ -8804,6 +8824,7 @@ rtl/amicommon/README.TXT svneol=native#text/plain
 rtl/amicommon/athreads.pp svneol=native#text/plain
 rtl/amicommon/classes.pp svneol=native#text/plain
 rtl/amicommon/dos.pp svneol=native#text/plain
+rtl/amicommon/lineinfo.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
@@ -9423,31 +9444,24 @@ rtl/go32v2/v2prt0.as svneol=native#text/plain
 rtl/haiku/Makefile svneol=native#text/plain
 rtl/haiku/Makefile.fpc svneol=native#text/plain
 rtl/haiku/baseunix.pp svneol=native#text/plain
-rtl/haiku/bethreads.pp svneol=native#text/plain
 rtl/haiku/classes.pp svneol=native#text/plain
 rtl/haiku/errno.inc svneol=native#text/plain
 rtl/haiku/errnostr.inc svneol=native#text/plain
 rtl/haiku/i386/cprt0.as svneol=native#text/plain
 rtl/haiku/i386/dllcprt0.as svneol=native#text/plain
-rtl/haiku/i386/dllprt.as svneol=native#text/plain
-rtl/haiku/i386/dllprt.cpp svneol=native#text/plain
-rtl/haiku/i386/func.as svneol=native#text/plain
-rtl/haiku/i386/prt0.as svneol=native#text/plain
+rtl/haiku/i386/sig_cpu.inc svneol=native#text/plain
 rtl/haiku/i386/sighnd.inc svneol=native#text/plain
 rtl/haiku/osdefs.inc svneol=native#text/plain
 rtl/haiku/osmacro.inc svneol=native#text/plain
-rtl/haiku/ossysc.inc svneol=native#text/plain
 rtl/haiku/ostypes.inc svneol=native#text/plain
 rtl/haiku/pthread.inc svneol=native#text/plain
 rtl/haiku/ptypes.inc svneol=native#text/plain
 rtl/haiku/rtldefs.inc svneol=native#text/plain
-rtl/haiku/settimeo.inc svneol=native#text/plain
+rtl/haiku/si_c.pp svneol=native#text/plain
+rtl/haiku/si_dllc.pp svneol=native#text/plain
 rtl/haiku/signal.inc svneol=native#text/plain
 rtl/haiku/suuid.inc svneol=native#text/plain
-rtl/haiku/syscall.inc svneol=native#text/plain
-rtl/haiku/syscallh.inc svneol=native#text/plain
 rtl/haiku/sysconst.inc svneol=native#text/plain
-rtl/haiku/sysnr.inc svneol=native#text/plain
 rtl/haiku/sysos.inc svneol=native#text/plain
 rtl/haiku/sysosh.inc svneol=native#text/plain
 rtl/haiku/system.pp svneol=native#text/plain
@@ -9456,6 +9470,8 @@ rtl/haiku/termios.inc svneol=native#text/plain
 rtl/haiku/termiosproc.inc svneol=native#text/plain
 rtl/haiku/unxconst.inc svneol=native#text/plain
 rtl/haiku/unxfunc.inc svneol=native#text/plain
+rtl/haiku/x86_64/sig_cpu.inc svneol=native#text/plain
+rtl/haiku/x86_64/sighnd.inc svneol=native#text/plain
 rtl/i386/cpu.pp svneol=native#text/plain
 rtl/i386/cpuh.inc svneol=native#text/plain
 rtl/i386/cpuinnr.inc svneol=native#text/plain
@@ -9560,6 +9576,7 @@ rtl/inc/rttih.inc svneol=native#text/plain
 rtl/inc/sfpu128.pp svneol=native#text/pascal
 rtl/inc/sfpux80.pp svneol=native#text/pascal
 rtl/inc/softfpu.pp svneol=native#text/plain
+rtl/inc/sortbase.pp svneol=native#text/plain
 rtl/inc/sstrings.inc svneol=native#text/plain
 rtl/inc/strings.pp svneol=native#text/plain
 rtl/inc/stringsi.inc svneol=native#text/plain
@@ -10751,6 +10768,7 @@ tests/Makefile.fpc svneol=native#text/plain
 tests/bench/bansi1.inc svneol=native#text/plain
 tests/bench/bansi1.pp svneol=native#text/plain
 tests/bench/bansi1mt.pp svneol=native#text/plain
+tests/bench/bcase.pp -text svneol=native#text/pascal
 tests/bench/blists1.inc svneol=native#text/plain
 tests/bench/blists1.pp svneol=native#text/plain
 tests/bench/bmd5.pp svneol=native#text/plain
@@ -11117,6 +11135,9 @@ tests/tbf/tb0262.pp svneol=native#text/pascal
 tests/tbf/tb0263.pp svneol=native#text/pascal
 tests/tbf/tb0264.pp svneol=native#text/pascal
 tests/tbf/tb0265.pp svneol=native#text/pascal
+tests/tbf/tb0266a.pp svneol=native#text/pascal
+tests/tbf/tb0266b.pp svneol=native#text/pascal
+tests/tbf/tb0267.pp svneol=native#text/plain
 tests/tbf/tb0588.pp svneol=native#text/pascal
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
@@ -11777,6 +11798,7 @@ tests/tbs/tb0650.pp svneol=native#text/pascal
 tests/tbs/tb0651.pp svneol=native#text/pascal
 tests/tbs/tb0652.pp svneol=native#text/pascal
 tests/tbs/tb0653.pp svneol=native#text/plain
+tests/tbs/tb0654.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain
@@ -12877,6 +12899,7 @@ tests/test/tasmpublic3.pp svneol=native#text/pascal
 tests/test/tasmread.pp svneol=native#text/plain
 tests/test/tasout.pp svneol=native#text/plain
 tests/test/tassignmentoperator1.pp svneol=native#text/pascal
+tests/test/tb0266.pp svneol=native#text/plain
 tests/test/tblock1.pp svneol=native#text/plain
 tests/test/tblock1a.pp svneol=native#text/plain
 tests/test/tblock1c.pp svneol=native#text/plain
@@ -12935,6 +12958,7 @@ tests/test/tcase47.pp svneol=native#text/pascal
 tests/test/tcase47_2.pp svneol=native#text/pascal
 tests/test/tcase48.pp svneol=native#text/pascal
 tests/test/tcase48_2.pp svneol=native#text/pascal
+tests/test/tcase49.pp svneol=native#text/pascal
 tests/test/tcase5.pp svneol=native#text/pascal
 tests/test/tcase6.pp svneol=native#text/pascal
 tests/test/tcase7.pp svneol=native#text/pascal
@@ -14173,6 +14197,7 @@ tests/test/units/classes/tmakeobjinst.pp svneol=native#text/plain
 tests/test/units/classes/tsetstream.pp svneol=native#text/plain
 tests/test/units/classes/tstringlistexchange.pp svneol=native#text/pascal
 tests/test/units/classes/ttbits.pp svneol=native#text/pascal
+tests/test/units/classes/ttlist.pp svneol=native#text/plain
 tests/test/units/classes/tvclcomobject.pp svneol=native#text/plain
 tests/test/units/cpu/tcpu1.pp svneol=native#text/pascal
 tests/test/units/crt/tcrt.pp svneol=native#text/plain
@@ -14261,6 +14286,8 @@ tests/test/units/objects/testobj2.pp svneol=native#text/plain
 tests/test/units/sharemem/libtest.pp svneol=native#text/plain
 tests/test/units/sharemem/test1.pp svneol=native#text/plain
 tests/test/units/softfpu/sfttst.pp svneol=native#text/plain
+tests/test/units/sortalgs/tsortalgs1.pp svneol=native#text/plain
+tests/test/units/sortbase/tsortbase.pp svneol=native#text/plain
 tests/test/units/strings/tstrcopy.pp svneol=native#text/plain
 tests/test/units/strings/tstrings1.pp svneol=native#text/plain
 tests/test/units/strutils/taddchar.pp svneol=native#text/plain
@@ -14707,9 +14734,11 @@ tests/webtbf/tw26704.pp svneol=native#text/plain
 tests/webtbf/tw2719.pp svneol=native#text/plain
 tests/webtbf/tw2721.pp svneol=native#text/plain
 tests/webtbf/tw2724.pp svneol=native#text/plain
+tests/webtbf/tw27378.pp svneol=native#text/pascal
 tests/webtbf/tw2739.pp svneol=native#text/plain
 tests/webtbf/tw2751.pp svneol=native#text/plain
 tests/webtbf/tw2752.pp svneol=native#text/plain
+tests/webtbf/tw27543.pp svneol=native#text/pascal
 tests/webtbf/tw2787.pp svneol=native#text/plain
 tests/webtbf/tw27880.pp svneol=native#text/pascal
 tests/webtbf/tw2795.pp svneol=native#text/plain
@@ -14769,9 +14798,11 @@ tests/webtbf/tw3395.pp svneol=native#text/plain
 tests/webtbf/tw3395a.pp svneol=native#text/plain
 tests/webtbf/tw34355.pp svneol=native#text/pascal
 tests/webtbf/tw3450.pp svneol=native#text/plain
+tests/webtbf/tw34691.pp svneol=native#text/pascal
 tests/webtbf/tw3473.pp svneol=native#text/plain
 tests/webtbf/tw3480.pp svneol=native#text/plain
 tests/webtbf/tw3480a.pp svneol=native#text/plain
+tests/webtbf/tw34821.pp svneol=native#text/plain
 tests/webtbf/tw3488.pp svneol=native#text/plain
 tests/webtbf/tw3495.pp svneol=native#text/plain
 tests/webtbf/tw3502.pp svneol=native#text/plain
@@ -14803,6 +14834,7 @@ tests/webtbf/tw4256.pp svneol=native#text/plain
 tests/webtbf/tw4359.pp svneol=native#text/plain
 tests/webtbf/tw4445.pp svneol=native#text/plain
 tests/webtbf/tw4529.pp svneol=native#text/plain
+tests/webtbf/tw4541.pp svneol=native#text/pascal
 tests/webtbf/tw4554a.pp svneol=native#text/plain
 tests/webtbf/tw4554b.pp svneol=native#text/plain
 tests/webtbf/tw4554c.pp svneol=native#text/plain
@@ -14916,9 +14948,12 @@ tests/webtbf/uw0840b.pp svneol=native#text/plain
 tests/webtbf/uw0856.pp svneol=native#text/plain
 tests/webtbf/uw2414.pp svneol=native#text/plain
 tests/webtbf/uw25283.pp svneol=native#text/plain
+tests/webtbf/uw27378a.pp svneol=native#text/pascal
+tests/webtbf/uw27378b.pp svneol=native#text/pascal
 tests/webtbf/uw3450.pp svneol=native#text/plain
 tests/webtbf/uw3969.pp svneol=native#text/plain
 tests/webtbf/uw4103.pp svneol=native#text/plain
+tests/webtbf/uw4541.pp svneol=native#text/pascal
 tests/webtbf/uw6922.pp svneol=native#text/plain
 tests/webtbf/uw8738a.pas svneol=native#text/plain
 tests/webtbf/uw8738b.pas svneol=native#text/plain
@@ -16240,6 +16275,7 @@ tests/webtbs/tw30179.pp svneol=native#text/pascal
 tests/webtbs/tw30182.pp svneol=native#text/plain
 tests/webtbs/tw30202.pp svneol=native#text/pascal
 tests/webtbs/tw30203.pp svneol=native#text/pascal
+tests/webtbs/tw30205.pp svneol=native#text/pascal
 tests/webtbs/tw30207.pp svneol=native#text/plain
 tests/webtbs/tw30208.pp svneol=native#text/pascal
 tests/webtbs/tw3023.pp svneol=native#text/plain
@@ -16472,22 +16508,31 @@ tests/webtbs/tw3443.pp svneol=native#text/plain
 tests/webtbs/tw34438.pp svneol=native#text/pascal
 tests/webtbs/tw3444.pp svneol=native#text/plain
 tests/webtbs/tw34442.pp svneol=native#text/plain
+tests/webtbs/tw34496.pp svneol=native#text/pascal
+tests/webtbs/tw34509.pp svneol=native#text/pascal
 tests/webtbs/tw3456.pp svneol=native#text/plain
 tests/webtbs/tw3457.pp svneol=native#text/plain
 tests/webtbs/tw3460.pp svneol=native#text/plain
 tests/webtbs/tw34605.pp svneol=native#text/plain
+tests/webtbs/tw34653.pp svneol=native#text/pascal
 tests/webtbs/tw3467.pp svneol=native#text/plain
 tests/webtbs/tw3470.pp svneol=native#text/plain
 tests/webtbs/tw3474.pp svneol=native#text/plain
 tests/webtbs/tw3477.pp svneol=native#text/plain
 tests/webtbs/tw3478.pp svneol=native#text/plain
 tests/webtbs/tw3479.pp svneol=native#text/plain
+tests/webtbs/tw34818.pp svneol=native#text/pascal
+tests/webtbs/tw34848.pp svneol=native#text/pascal
 tests/webtbs/tw3489.pp svneol=native#text/plain
+tests/webtbs/tw34893.pp -text svneol=native#text/pascal
 tests/webtbs/tw3490.pp svneol=native#text/plain
 tests/webtbs/tw3491.pp svneol=native#text/plain
 tests/webtbs/tw3492.pp svneol=native#text/plain
 tests/webtbs/tw3494.pp svneol=native#text/plain
+tests/webtbs/tw34971.pp svneol=native#text/plain
 tests/webtbs/tw3499.pp svneol=native#text/plain
+tests/webtbs/tw35027.pp svneol=native#text/pascal
+tests/webtbs/tw35028.pp svneol=native#text/pascal
 tests/webtbs/tw3504.pp svneol=native#text/plain
 tests/webtbs/tw3506.pp svneol=native#text/plain
 tests/webtbs/tw3523.pp svneol=native#text/plain
@@ -16655,7 +16700,6 @@ tests/webtbs/tw4533.pp svneol=native#text/plain
 tests/webtbs/tw4534.pp svneol=native#text/plain
 tests/webtbs/tw4537.pp svneol=native#text/plain
 tests/webtbs/tw4540.pp svneol=native#text/plain
-tests/webtbs/tw4541.pp svneol=native#text/plain
 tests/webtbs/tw4557.pp svneol=native#text/plain
 tests/webtbs/tw4566.pp svneol=native#text/plain
 tests/webtbs/tw4574.pp svneol=native#text/plain
@@ -17090,7 +17134,6 @@ tests/webtbs/uw4352b.pp svneol=native#text/plain
 tests/webtbs/uw4352c.pp svneol=native#text/plain
 tests/webtbs/uw4352d.pp svneol=native#text/plain
 tests/webtbs/uw4352e.pp svneol=native#text/plain
-tests/webtbs/uw4541.pp svneol=native#text/plain
 tests/webtbs/uw6203.pp svneol=native#text/plain
 tests/webtbs/uw6767.pp svneol=native#text/plain
 tests/webtbs/uw6822a.pp svneol=native#text/plain

Makefile

@@ -2,7 +2,7 @@
 # Don't edit, this file is generated by FPCMake Version 2.0.0
 #
 default: help
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris 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-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macos 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-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros 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-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-darwin aarch64-android wasm-wasm sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris 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-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macos 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-haiku x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros 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-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-darwin aarch64-android wasm-wasm sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari
@@ -617,6 +617,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override TARGET_DIRS+=compiler rtl utils packages installer
 endif
+ifeq ($(FULL_TARGET),x86_64-haiku)
+override TARGET_DIRS+=compiler rtl utils packages installer
+endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
 override TARGET_DIRS+=compiler rtl utils packages installer
 endif
@@ -2250,6 +2253,13 @@ TARGET_DIRS_UTILS=1
 TARGET_DIRS_PACKAGES=1
 TARGET_DIRS_INSTALLER=1
 endif
+ifeq ($(FULL_TARGET),x86_64-haiku)
+TARGET_DIRS_COMPILER=1
+TARGET_DIRS_RTL=1
+TARGET_DIRS_UTILS=1
+TARGET_DIRS_PACKAGES=1
+TARGET_DIRS_INSTALLER=1
+endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
 TARGET_DIRS_COMPILER=1
 TARGET_DIRS_RTL=1

compiler/Makefile

@@ -2,7 +2,7 @@
 # Don't edit, this file is generated by FPCMake Version 2.0.0
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris 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-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macos 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-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros 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-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-darwin aarch64-android wasm-wasm sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris 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-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macos 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-haiku x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros 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-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-darwin aarch64-android wasm-wasm sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari
@@ -730,6 +730,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override TARGET_DIRS+=utils
 endif
+ifeq ($(FULL_TARGET),x86_64-haiku)
+override TARGET_DIRS+=utils
+endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
 override TARGET_DIRS+=utils
 endif
@@ -1003,6 +1006,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override TARGET_PROGRAMS+=pp
 endif
+ifeq ($(FULL_TARGET),x86_64-haiku)
+override TARGET_PROGRAMS+=pp
+endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
 override TARGET_PROGRAMS+=pp
 endif
@@ -1277,6 +1283,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
+ifeq ($(FULL_TARGET),x86_64-haiku)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
@@ -1550,6 +1559,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
+ifeq ($(FULL_TARGET),x86_64-haiku)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -1823,6 +1835,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override COMPILER_TARGETDIR+=$(CPU_UNITDIR)/bin/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),x86_64-haiku)
+override COMPILER_TARGETDIR+=$(CPU_UNITDIR)/bin/$(FULL_TARGET)
+endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
 override COMPILER_TARGETDIR+=$(CPU_UNITDIR)/bin/$(FULL_TARGET)
 endif
@@ -2096,6 +2111,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),x86_64-haiku)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -3035,6 +3053,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),x86_64-haiku)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -3953,6 +3974,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 TARGET_DIRS_UTILS=1
 endif
+ifeq ($(FULL_TARGET),x86_64-haiku)
+TARGET_DIRS_UTILS=1
+endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
 TARGET_DIRS_UTILS=1
 endif

compiler/aasmcnst.pas

@@ -58,6 +58,7 @@ type
      fval: tai;
     public
      constructor create(_adetyp: ttypedconstkind; _def: tdef; _val: tai);
+     destructor destroy; override;
      property val: tai read fval write setval;
    end;
 
@@ -646,6 +647,13 @@ implementation
      end;
 
 
+   destructor tai_simpletypedconst.destroy;
+     begin
+       fval.free;
+       inherited destroy;
+     end;
+
+
 {****************************************************************************
               tai_aggregatetypedconst.tadeenumerator
  ****************************************************************************}
@@ -820,7 +828,11 @@ implementation
 
 
    destructor tai_aggregatetypedconst.destroy;
+     var
+       ai: tai_abstracttypedconst;
      begin
+       for ai in self do
+          ai.free;
        fvalues.free;
        inherited destroy;
      end;

compiler/aasmtai.pas

@@ -1971,10 +1971,10 @@ implementation
           aitconst_16bit,aitconst_16bit_unaligned :
             result:=2;
           aitconst_32bit,aitconst_darwin_dwarf_delta32,
-	  aitconst_32bit_unaligned:
+          aitconst_32bit_unaligned:
             result:=4;
           aitconst_64bit,aitconst_darwin_dwarf_delta64,
-	  aitconst_64bit_unaligned:
+          aitconst_64bit_unaligned:
             result:=8;
           aitconst_secrel32_symbol,
           aitconst_rva_symbol :
@@ -2926,9 +2926,10 @@ implementation
         i : integer;
       begin
         inherited ppuload(t,ppufile);
-        { hopefully, we don't get problems with big/litte endian here when cross compiling :/ }
+        { hopefully, we don't get problems with big/little endian here when cross compiling :/ }
         ppufile.getdata(condition,sizeof(tasmcond));
-        allocate_oper(ppufile.getbyte);
+        ops := ppufile.getbyte;
+        allocate_oper(ops);
         for i:=0 to ops-1 do
           ppuloadoper(ppufile,oper[i]^);
         opcode:=tasmop(ppufile.getword);

compiler/aopt.pas

@@ -36,6 +36,9 @@ Unit aopt;
 
     Type
       TAsmOptimizer = class(TAoptObj)
+        { Pooled object that can be used by optimisation procedures to evaluate
+          future register usage without upsetting the current state. }
+        TmpUsedRegs: TAllUsedRegs;
 
         { _AsmL is the PAasmOutpout list that has to be optimized }
         Constructor create(_AsmL: TAsmList); virtual; reintroduce;
@@ -87,6 +90,7 @@ Unit aopt;
         inherited create(_asml,nil,nil,nil);
         { setup labeltable, always necessary }
         New(LabelInfo);
+        CreateUsedRegs(TmpUsedRegs);
       End;
 
     procedure TAsmOptimizer.FindLoHiLabels;
@@ -318,6 +322,7 @@ Unit aopt;
 
     Destructor TAsmOptimizer.Destroy;
       Begin
+        ReleaseUsedRegs(TmpUsedRegs);
         if assigned(LabelInfo^.LabelTable) then
           Freemem(LabelInfo^.LabelTable);
         Dispose(LabelInfo);

compiler/aoptobj.pas

@@ -270,6 +270,8 @@ Unit AoptObj;
         Procedure UpdateUsedRegs(p : Tai);
         class procedure UpdateUsedRegs(var Regs: TAllUsedRegs; p: Tai);
         Function CopyUsedRegs(var dest : TAllUsedRegs) : boolean;
+        procedure RestoreUsedRegs(const Regs : TAllUsedRegs);
+        procedure TransferUsedRegs(var dest: TAllUsedRegs);
         class Procedure ReleaseUsedRegs(const regs : TAllUsedRegs);
         class Function RegInUsedRegs(reg : TRegister;regs : TAllUsedRegs) : boolean;
         class Procedure IncludeRegInUsedRegs(reg : TRegister;var regs : TAllUsedRegs);
@@ -457,7 +459,7 @@ Unit AoptObj;
       End;
 
 
-    Function TUsedRegs.GetUsedRegs: TRegSet;
+    Function TUsedRegs.GetUsedRegs: TRegSet; inline;
       Begin
         GetUsedRegs := UsedRegs;
       End;
@@ -945,6 +947,30 @@ Unit AoptObj;
       end;
 
 
+      procedure TAOptObj.RestoreUsedRegs(const Regs: TAllUsedRegs);
+      var
+        i : TRegisterType;
+      begin
+        { Note that the constructor Create_Regset is being called as a regular
+          method - it is not instantiating a new object.  This is because it is
+          the only published means to modify the internal state en-masse. [Kit] }
+        for i:=low(TRegisterType) to high(TRegisterType) do
+          UsedRegs[i].Create_Regset(i,Regs[i].GetUsedRegs);
+      end;
+
+
+      procedure TAOptObj.TransferUsedRegs(var dest: TAllUsedRegs);
+      var
+        i : TRegisterType;
+      begin
+        { Note that the constructor Create_Regset is being called as a regular
+          method - it is not instantiating a new object.  This is because it is
+          the only published means to modify the internal state en-masse. [Kit] }
+        for i:=low(TRegisterType) to high(TRegisterType) do
+          dest[i].Create_Regset(i, UsedRegs[i].GetUsedRegs);
+      end;
+
+
       class procedure TAOptObj.ReleaseUsedRegs(const regs: TAllUsedRegs);
         var
           i : TRegisterType;

compiler/arm/agarmgas.pas

@@ -94,7 +94,9 @@ unit agarmgas;
       begin
         inherited;
         InstrWriter := TArmInstrWriter.create(self);
+{$ifndef llvm}
         if GenerateThumb2Code then
+{$endif}
           TArmInstrWriter(InstrWriter).unified_syntax:=true;
       end;
 
@@ -205,6 +207,8 @@ unit agarmgas;
                        s:=s+', rrx'
                      else if shiftmode <> SM_None then
                        s:=s+', '+gas_shiftmode2str[shiftmode]+' #'+tostr(shiftimm);
+                     if offset<>0 then
+                       Internalerror(2019012601);
                   end
                 else if offset<>0 then
                   s:=s+', #'+tostr(offset);

compiler/arm/aoptcpu.pas

@@ -646,7 +646,6 @@ Implementation
     var
       hp1,hp2,hp3,hp4: tai;
       i, i2: longint;
-      TmpUsedRegs: TAllUsedRegs;
       tempop: tasmop;
       oldreg: tregister;
       dealloc: tai_regalloc;
@@ -932,7 +931,7 @@ Implementation
                           MatchInstruction(hp2, A_STR, [taicpu(p).condition], [PF_H]) and
                           MatchOperand(taicpu(hp2).oper[0]^, taicpu(p).oper[0]^.reg) then
                           begin
-                            CopyUsedRegs(TmpUsedRegs);
+                            TransferUsedRegs(TmpUsedRegs);
                             UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                             UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
                             if not(RegUsedAfterInstruction(taicpu(p).oper[0]^.reg,hp2,TmpUsedRegs)) then
@@ -946,7 +945,6 @@ Implementation
                                 p:=hp2;
                                 Result:=true;
                               end;
-                            ReleaseUsedRegs(TmpUsedRegs);
                           end
                         { fold
                           mov reg1,reg0, shift imm1

compiler/arm/aoptcpub.pas

@@ -119,6 +119,15 @@ Implementation
       i : Longint;
     begin
       result:=false;
+      case taicpu(p1).opcode of
+        A_LDR:
+          { special handling for LDRD }
+          if (taicpu(p1).oppostfix=PF_D) and (getsupreg(taicpu(p1).oper[0]^.reg)+1=getsupreg(Reg)) then
+            begin
+              result:=true;
+              exit;
+            end;
+      end;
       for i:=0 to taicpu(p1).ops-1 do
         case taicpu(p1).oper[i]^.typ of
           top_reg:

compiler/arm/armins.dat

@@ -402,6 +402,7 @@ reg32,regf          \x10\x01\x0F                        ARM32,ARMv4
 regf,reg32          \x96\xF3\x80\x80\x0                 THUMB32,ARMv6
 
 regf,reg32          \x12\x01\x20\xF0                    ARM32,ARMv4
+regs,reg32          \x12\x01\x20\xF0                    ARM32,ARMv4
 regf,immshifter     \x13\x03\x20\xF0                    ARM32,ARMv4
 regs,immshifter     \x13\x03\x20\xF0                    ARM32,ARMv4
 

compiler/arm/armnop.inc

@@ -1,2 +1,2 @@
 { don't edit, this file is generated from armins.dat }
-958;
+959;

compiler/arm/armtab.inc

@@ -1351,6 +1351,13 @@
     code    : #18#1#32#240;
     flags   : if_arm32 or if_armv4
   ),
+  (
+    opcode  : A_MSR;
+    ops     : 2;
+    optypes : (ot_regs,ot_reg32,ot_none,ot_none,ot_none,ot_none);
+    code    : #18#1#32#240;
+    flags   : if_arm32 or if_armv4
+  ),
   (
     opcode  : A_MSR;
     ops     : 2;

compiler/arm/cgcpu.pas

@@ -2686,6 +2686,21 @@ unit cgcpu;
           list.concat(taicpu.op_reg_reg(A_MOV,destreg,destreg));
         end;
 
+      { save estimation, if a creating a separate ref is needed or
+        if we can keep the original reference while copying }
+      function SimpleRef(const ref : treference) : boolean;
+        begin
+          result:=((ref.base=NR_PC) and (ref.addressmode=AM_OFFSET) and (ref.refaddr=addr_full)) or
+              ((ref.symbol=nil) and
+               (ref.addressmode=AM_OFFSET) and
+               (((ref.offset>=0) and (ref.offset+len<=31)) or
+                (not(GenerateThumbCode) and (ref.offset>=-255) and (ref.offset+len<=255)) or
+                { ldrh has a limited offset range }
+                (not(GenerateThumbCode) and ((len mod 4) in [0,1]) and (ref.offset>=-4095) and (ref.offset+len<=4095))
+               )
+              );
+        end;
+
       { will never be called with count<=4 }
       procedure genloop_thumb(count : aword;size : byte);
 
@@ -2792,17 +2807,15 @@ unit cgcpu;
           begin
             tmpregi:=0;
 
-            srcreg:=getintregister(list,OS_ADDR);
-
-            { explicit pc relative addressing, could be
-              e.g. a floating point constant }
-            if source.base=NR_PC then
+            { loading address in a separate register needed? }
+            if SimpleRef(source) then
               begin
                 { ... then we don't need a loadaddr }
                 srcref:=source;
               end
             else
               begin
+                srcreg:=getintregister(list,OS_ADDR);
                 a_loadaddr_ref_reg(list,source,srcreg);
                 reference_reset_base(srcref,srcreg,0,source.temppos,source.alignment,source.volatility);
               end;
@@ -2816,9 +2829,15 @@ unit cgcpu;
                 dec(len,4);
               end;
 
-            destreg:=getintregister(list,OS_ADDR);
-            a_loadaddr_ref_reg(list,dest,destreg);
-            reference_reset_base(dstref,destreg,0,dest.temppos,dest.alignment,dest.volatility);
+            { loading address in a separate register needed? }
+            if SimpleRef(dest) then
+              dstref:=dest
+            else
+              begin
+                destreg:=getintregister(list,OS_ADDR);
+                a_loadaddr_ref_reg(list,dest,destreg);
+                reference_reset_base(dstref,destreg,0,dest.temppos,dest.alignment,dest.volatility);
+              end;
             tmpregi2:=1;
             while (tmpregi2<=tmpregi) do
               begin

compiler/arm/cpupara.pas

@@ -50,6 +50,7 @@ unit cpupara;
             var sparesinglereg: tregister);
           function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
             var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword; var sparesinglereg: tregister; isvariadic: boolean):longint;
+          procedure paradeftointparaloc(paradef: tdef; paracgsize: tcgsize; out paralocdef: tdef; out paralocsize: tcgsize);
        end;
 
   implementation
@@ -377,6 +378,11 @@ unit cpupara;
             if (p.proccalloption in cstylearrayofconst) and
                is_array_of_const(paradef) then
               begin
+                hp.paraloc[side].def:=paradef;
+                hp.paraloc[side].size:=OS_NO;
+                hp.paraloc[side].alignment:=std_param_align;
+                hp.paraloc[side].intsize:=0;
+
                 paraloc:=hp.paraloc[side].add_location;
                 { hack: the paraloc must be valid, but is not actually used }
                 paraloc^.loc:=LOC_REGISTER;
@@ -430,35 +436,20 @@ unit cpupara;
              while paralen>0 do
                begin
                  paraloc:=hp.paraloc[side].add_location;
-
-                 if (loc=LOC_REGISTER) and (paracgsize in [OS_F32,OS_F64,OS_F80]) then
-                   case paracgsize of
-                     OS_F32:
-                       begin
-                         paraloc^.size:=OS_32;
-                         paraloc^.def:=u32inttype;
-                       end;
-                     OS_F64:
-                       begin
-                         paraloc^.size:=OS_32;
-                         paraloc^.def:=u32inttype;
-                       end;
-                     else
-                       internalerror(2005082901);
-                   end
-                 else if (paracgsize in [OS_NO,OS_64,OS_S64]) then
-                   begin
-                     paraloc^.size:=OS_32;
-                     paraloc^.def:=u32inttype;
-                   end
-                 else
-                   begin
-                     paraloc^.size:=paracgsize;
-                     paraloc^.def:=get_paraloc_def(paradef,paralen,firstparaloc);
-                   end;
                  case loc of
                     LOC_REGISTER:
                       begin
+                        if paracgsize in [OS_F32,OS_F64,OS_F80] then
+                          case paracgsize of
+                            OS_F32,
+                            OS_F64:
+                              begin
+                                paraloc^.size:=OS_32;
+                                paraloc^.def:=u32inttype;
+                              end;
+                            else
+                              internalerror(2005082901);
+                          end;
                         { align registers for eabi }
                         if (target_info.abi in [abi_eabi,abi_eabihf]) and
                            firstparaloc and
@@ -467,22 +458,24 @@ unit cpupara;
                             if (nextintreg in [RS_R1,RS_R3]) then
                               inc(nextintreg)
                             else if nextintreg>RS_R3 then
-                              stack_offset:=align(stack_offset,8);
+                              begin
+                                stack_offset:=align(stack_offset,8);
+                                hp.paraloc[side].Alignment:=8;
+                              end;
                           end;
-                        { this is not abi compliant
-                          why? (FK) }
                         if nextintreg<=RS_R3 then
                           begin
+                            paradeftointparaloc(paradef,paracgsize,paraloc^.def,paraloc^.size);
                             paraloc^.loc:=LOC_REGISTER;
                             paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
                             inc(nextintreg);
                           end
                         else
                           begin
-                            { LOC_REFERENCE always contains everything that's left }
+                            { LOC_REFERENCE always contains everything that's left as a multiple of 4 bytes}
                             paraloc^.loc:=LOC_REFERENCE;
-                            paraloc^.size:=int_cgsize(paralen);
-                            paraloc^.def:=carraydef.getreusable_no_free(u8inttype,paralen);
+                            paraloc^.def:=get_paraloc_def(paradef,paralen,firstparaloc);
+                            paraloc^.size:=def_cgsize(paraloc^.def);
                             if (side=callerside) then
                               paraloc^.reference.index:=NR_STACK_POINTER_REG;
                             paraloc^.reference.offset:=stack_offset;
@@ -492,6 +485,8 @@ unit cpupara;
                       end;
                     LOC_FPUREGISTER:
                       begin
+                        paraloc^.size:=paracgsize;
+                        paraloc^.def:=paradef;
                         if nextfloatreg<=RS_F3 then
                           begin
                             paraloc^.loc:=LOC_FPUREGISTER;
@@ -519,6 +514,8 @@ unit cpupara;
                       end;
                     LOC_MMREGISTER:
                       begin
+                        paraloc^.size:=paracgsize;
+                        paraloc^.def:=paradef;
                         if (nextmmreg<=RS_D7) or
                            ((paraloc^.size = OS_F32) and
                             (sparesinglereg<>NR_NO)) then
@@ -556,7 +553,6 @@ unit cpupara;
                             { LOC_REFERENCE always contains everything that's left }
                             paraloc^.loc:=LOC_REFERENCE;
                             paraloc^.size:=int_cgsize(paralen);
-                            paraloc^.def:=carraydef.getreusable_no_free(u8inttype,paralen);
                             if (side=callerside) then
                               paraloc^.reference.index:=NR_STACK_POINTER_REG;
                             paraloc^.reference.offset:=stack_offset;
@@ -566,6 +562,8 @@ unit cpupara;
                       end;
                     LOC_REFERENCE:
                       begin
+                        paraloc^.size:=paracgsize;
+                        paraloc^.def:=paradef;
                         if push_addr_param(hp.varspez,paradef,p.proccalloption) then
                           begin
                             paraloc^.size:=OS_ADDR;
@@ -578,10 +576,11 @@ unit cpupara;
                             if (target_info.abi in [abi_eabi,abi_eabihf]) and
                                firstparaloc and
                                (paradef.alignment=8) then
-                              stack_offset:=align(stack_offset,8);
+                              begin
+                                stack_offset:=align(stack_offset,8);
+                                hp.paraloc[side].Alignment:=8;
+                              end;
 
-                             paraloc^.size:=paracgsize;
-                             paraloc^.def:=paradef;
                              paraloc^.loc:=LOC_REFERENCE;
                              paraloc^.reference.index:=NR_STACK_POINTER_REG;
                              paraloc^.reference.offset:=stack_offset;
@@ -624,6 +623,23 @@ unit cpupara;
       end;
 
 
+    procedure tcpuparamanager.paradeftointparaloc(paradef: tdef; paracgsize: tcgsize; out paralocdef: tdef; out paralocsize: tcgsize);
+      begin
+        if not(paracgsize in [OS_32,OS_S32]) or
+           (paradef.typ in [arraydef,recorddef]) or
+           is_object(paradef) then
+          begin
+            paralocsize:=OS_32;
+            paralocdef:=u32inttype;
+          end
+        else
+          begin
+            paralocsize:=paracgsize;
+            paralocdef:=paradef;
+          end;
+      end;
+
+
     function  tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       var
         paraloc : pcgparalocation;
@@ -740,8 +756,7 @@ unit cpupara;
                     end;
                   else
                     begin
-                      paraloc^.size:=retcgsize;
-                      paraloc^.def:=result.def;
+                      paradeftointparaloc(result.def,result.size,paraloc^.def,paraloc^.size);
                     end;
                 end;
               end;

compiler/arm/narmld.pas

@@ -50,7 +50,7 @@ implementation
       procinfo;
 
 {*****************************************************************************
-                            TI386LOADNODE
+                            TARMLOADNODE
 *****************************************************************************}
 
     procedure tarmloadnode.generate_threadvar_access(gvs: tstaticvarsym);

compiler/arm/raarmgas.pas

@@ -147,6 +147,7 @@ Unit raarmgas;
           end;
       end;
 
+
     function tarmattreader.is_targetdirective(const s: string): boolean;
       begin
         case s of

compiler/avr/aoptcpu.pas

@@ -231,7 +231,6 @@ Implementation
       alloc, dealloc: tai_regalloc;
       i: integer;
       l: TAsmLabel;
-      TmpUsedRegs : TAllUsedRegs;
     begin
       result := false;
       case p.typ of
@@ -325,7 +324,7 @@ Implementation
                        (taicpu(hp1).oper[1]^.reg=taicpu(p).oper[0]^.reg) and
                        not(MatchOperand(taicpu(hp1).oper[0]^,taicpu(hp1).oper[1]^)) then
                       begin
-                        CopyUsedRegs(TmpUsedRegs);
+                        TransferUsedRegs(TmpUsedRegs);
                         if not(RegUsedAfterInstruction(taicpu(hp1).oper[1]^.reg, hp1, TmpUsedRegs)) then
                           begin
                             case taicpu(hp1).opcode of
@@ -353,7 +352,6 @@ Implementation
 
                             RemoveCurrentP(p);
                           end;
-                        ReleaseUsedRegs(TmpUsedRegs);
                       end;
                   end;
                 A_STS:
@@ -690,14 +688,12 @@ Implementation
                            taicpu(hp1).loadreg(0, taicpu(hp2).oper[0]^.reg);
 
                            { life range of reg2 and reg3 is increased, fix register allocation entries }
-                           CopyUsedRegs(TmpUsedRegs);
+                           TransferUsedRegs(TmpUsedRegs);
                            UpdateUsedRegs(TmpUsedRegs,tai(p.Next));
                            AllocRegBetween(taicpu(hp2).oper[0]^.reg,hp1,hp2,TmpUsedRegs);
-                           ReleaseUsedRegs(TmpUsedRegs);
 
-                           CopyUsedRegs(TmpUsedRegs);
+                           TransferUsedRegs(TmpUsedRegs);
                            AllocRegBetween(taicpu(hp3).oper[0]^.reg,p,hp3,TmpUsedRegs);
-                           ReleaseUsedRegs(TmpUsedRegs);
 
                            IncludeRegInUsedRegs(taicpu(hp3).oper[0]^.reg,UsedRegs);
                            UpdateUsedRegs(tai(p.Next));
@@ -750,7 +746,7 @@ Implementation
                     }
                     if MatchOpType(taicpu(p),top_reg,top_reg) then
                       begin
-                        CopyUsedRegs(TmpUsedRegs);
+                        TransferUsedRegs(TmpUsedRegs);
                         UpdateUsedRegs(TmpUsedRegs,tai(p.Next));
                         if not(RegInUsedRegs(taicpu(p).oper[0]^.reg,TmpUsedRegs)) and
                           { reg. allocation information before calls is not perfect, so don't do this before
@@ -760,10 +756,8 @@ Implementation
                           begin
                             DebugMsg('Peephole Mov2Nop performed', p);
                             result:=RemoveCurrentP(p);
-                            ReleaseUsedRegs(TmpUsedRegs);
                             exit;
                           end;
-                        ReleaseUsedRegs(TmpUsedRegs);
                       end;
 
                     { turn

compiler/avr/cgcpu.pas

@@ -302,30 +302,30 @@ unit cgcpu;
           begin
             if not(assigned(hp)) then
               internalerror(2014011105);
-             //paramanager.allocparaloc(list,hp);
-             case hp^.loc of
-               LOC_REGISTER,LOC_CREGISTER:
-                 begin
-                   if (tcgsize2size[hp^.size]<>1) or
-                     (hp^.shiftval<>0) then
-                     internalerror(2015041101);
-                   a_load_const_reg(list,hp^.size,(a shr (8*(i-1))) and $ff,hp^.register);
+            paramanager.allocparaloc(list,hp);
+            case hp^.loc of
+              LOC_REGISTER,LOC_CREGISTER:
+                begin
+                  if (tcgsize2size[hp^.size]<>1) or
+                    (hp^.shiftval<>0) then
+                    internalerror(2015041101);
+                  a_load_const_reg(list,hp^.size,(a shr (8*(i-1))) and $ff,hp^.register);
 
-                   inc(i,tcgsize2size[hp^.size]);
-                   hp:=hp^.Next;
-                 end;
-               LOC_REFERENCE,LOC_CREFERENCE:
-                 begin
-                   reference_reset(ref,paraloc.alignment,[]);
-                   ref.base:=hp^.reference.index;
-                   ref.offset:=hp^.reference.offset;
-                   a_load_const_ref(list,hp^.size,a shr (8*(i-1)),ref);
+                  inc(i,tcgsize2size[hp^.size]);
+                  hp:=hp^.Next;
+                end;
+              LOC_REFERENCE,LOC_CREFERENCE:
+                begin
+                  reference_reset(ref,paraloc.alignment,[]);
+                  ref.base:=hp^.reference.index;
+                  ref.offset:=hp^.reference.offset;
+                  a_load_const_ref(list,hp^.size,a shr (8*(i-1)),ref);
 
-                   inc(i,tcgsize2size[hp^.size]);
-                   hp:=hp^.Next;
-                 end;
-               else
-                 internalerror(2002071004);
+                  inc(i,tcgsize2size[hp^.size]);
+                  hp:=hp^.Next;
+                end;
+              else
+                internalerror(2002071004);
             end;
           end;
       end;
@@ -1345,21 +1345,38 @@ unit cgcpu;
            end;
          if not conv_done then
            begin
-             for i:=1 to tcgsize2size[fromsize] do
+             // CC
+             // Write to 16 bit ioreg, first high byte then low byte
+             // sequence required for 16 bit timer registers
+             // See e.g. atmega328p manual para 15.3 Accessing 16 bit registers
+             if (fromsize in [OS_16, OS_S16]) and QuickRef and (href.offset > 31)
+               and (href.offset < cpuinfo.embedded_controllers[current_settings.controllertype].srambase) then
                begin
-                   if not(QuickRef) and (i<tcgsize2size[fromsize]) then
-                     href.addressmode:=AM_POSTINCREMENT
-                   else
-                     href.addressmode:=AM_UNCHANGED;
-
+                 tmpreg:=GetNextReg(reg);
+                 href.addressmode:=AM_UNCHANGED;
+                 inc(href.offset);
+                 list.concat(taicpu.op_ref_reg(GetStore(href),href,tmpreg));
+                 dec(href.offset);
                  list.concat(taicpu.op_ref_reg(GetStore(href),href,reg));
+               end
+             else
+               begin
+                 for i:=1 to tcgsize2size[fromsize] do
+                   begin
+                       if not(QuickRef) and (i<tcgsize2size[fromsize]) then
+                         href.addressmode:=AM_POSTINCREMENT
+                       else
+                         href.addressmode:=AM_UNCHANGED;
 
-                 if QuickRef then
-                   inc(href.offset);
+                     list.concat(taicpu.op_ref_reg(GetStore(href),href,reg));
 
-                 { check if we are not in the last iteration to avoid an internalerror in GetNextReg }
-                 if i<tcgsize2size[fromsize] then
-                   reg:=GetNextReg(reg);
+                     if QuickRef then
+                       inc(href.offset);
+
+                     { check if we are not in the last iteration to avoid an internalerror in GetNextReg }
+                     if i<tcgsize2size[fromsize] then
+                       reg:=GetNextReg(reg);
+                   end;
                end;
            end;
 
@@ -2124,7 +2141,7 @@ unit cgcpu;
 
     procedure tcgavr.g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);
       var
-        countreg,tmpreg : tregister;
+        countreg,tmpreg,tmpreg2: tregister;
         srcref,dstref : treference;
         copysize,countregsize : tcgsize;
         l : TAsmLabel;
@@ -2269,40 +2286,91 @@ unit cgcpu;
                 dstref:=dest;
               end;
 
-            for i:=1 to len do
-              begin
-                if not(SrcQuickRef) and (i<len) then
-                  srcref.addressmode:=AM_POSTINCREMENT
-                else
-                  srcref.addressmode:=AM_UNCHANGED;
+              // CC
+              // If dest is an ioreg (31 < offset < srambase) and size = 16 bit then
+              // load high byte first, then low byte
+              if (len = 2) and DestQuickRef
+                and (dest.offset > 31)
+                and (dest.offset < cpuinfo.embedded_controllers[current_settings.controllertype].srambase) then
+                begin
+                  // If src is also a 16 bit ioreg then read low byte then high byte
+                  if SrcQuickRef and (srcref.offset > 31)
+                    and (srcref.offset < cpuinfo.embedded_controllers[current_settings.controllertype].srambase) then
+                    begin
+                      // First read source into temp registers
+                      tmpreg:=getintregister(list, OS_16);
+                      list.concat(taicpu.op_reg_ref(GetLoad(srcref),tmpreg,srcref));
+                      inc(srcref.offset);
+                      tmpreg2:=GetNextReg(tmpreg);
+                      list.concat(taicpu.op_reg_ref(GetLoad(srcref),tmpreg2,srcref));
+
+                      // then move temp registers to dest in reverse order
+                      inc(dstref.offset);
+                      list.concat(taicpu.op_ref_reg(GetStore(dstref),dstref,tmpreg2));
+                      dec(dstref.offset);
+                      list.concat(taicpu.op_ref_reg(GetStore(dstref),dstref,tmpreg));
+                    end
+                  else
+                    begin
+                      srcref.addressmode:=AM_UNCHANGED;
+                      inc(srcref.offset);
+                      dstref.addressmode:=AM_UNCHANGED;
+                      inc(dstref.offset);
+
+                      cg.getcpuregister(list,NR_R0);
+                      list.concat(taicpu.op_reg_ref(GetLoad(srcref),NR_R0,srcref));
+                      list.concat(taicpu.op_ref_reg(GetStore(dstref),dstref,NR_R0));
+                      cg.ungetcpuregister(list,NR_R0);
+
+                      if not(SrcQuickRef) then
+                        srcref.addressmode:=AM_POSTINCREMENT
+                      else
+                        srcref.addressmode:=AM_UNCHANGED;
+
+                      dec(srcref.offset);
+                      dec(dstref.offset);
+
+                      cg.getcpuregister(list,NR_R0);
+                      list.concat(taicpu.op_reg_ref(GetLoad(srcref),NR_R0,srcref));
+                      list.concat(taicpu.op_ref_reg(GetStore(dstref),dstref,NR_R0));
+                      cg.ungetcpuregister(list,NR_R0);
+                    end;
+                end
+              else
+              for i:=1 to len do
+                begin
+                  if not(SrcQuickRef) and (i<len) then
+                    srcref.addressmode:=AM_POSTINCREMENT
+                  else
+                    srcref.addressmode:=AM_UNCHANGED;
 
-                if not(DestQuickRef) and (i<len) then
-                  dstref.addressmode:=AM_POSTINCREMENT
-                else
-                  dstref.addressmode:=AM_UNCHANGED;
+                  if not(DestQuickRef) and (i<len) then
+                    dstref.addressmode:=AM_POSTINCREMENT
+                  else
+                    dstref.addressmode:=AM_UNCHANGED;
 
-                cg.getcpuregister(list,NR_R0);
-                list.concat(taicpu.op_reg_ref(GetLoad(srcref),NR_R0,srcref));
-                list.concat(taicpu.op_ref_reg(GetStore(dstref),dstref,NR_R0));
-                cg.ungetcpuregister(list,NR_R0);
+                  cg.getcpuregister(list,NR_R0);
+                  list.concat(taicpu.op_reg_ref(GetLoad(srcref),NR_R0,srcref));
+                  list.concat(taicpu.op_ref_reg(GetStore(dstref),dstref,NR_R0));
+                  cg.ungetcpuregister(list,NR_R0);
 
-                if SrcQuickRef then
-                  inc(srcref.offset);
-                if DestQuickRef then
-                  inc(dstref.offset);
-              end;
-            if not(SrcQuickRef) then
-              begin
-                ungetcpuregister(list,srcref.base);
-                ungetcpuregister(list,TRegister(ord(srcref.base)+1));
-              end;
-            if not(DestQuickRef) then
-              begin
-                ungetcpuregister(list,dstref.base);
-                ungetcpuregister(list,TRegister(ord(dstref.base)+1));
-              end;
-          end;
-      end;
+                  if SrcQuickRef then
+                    inc(srcref.offset);
+                  if DestQuickRef then
+                    inc(dstref.offset);
+                end;
+              if not(SrcQuickRef) then
+                begin
+                  ungetcpuregister(list,srcref.base);
+                  ungetcpuregister(list,TRegister(ord(srcref.base)+1));
+                end;
+              if not(DestQuickRef) then
+                begin
+                  ungetcpuregister(list,dstref.base);
+                  ungetcpuregister(list,TRegister(ord(dstref.base)+1));
+                end;
+            end;
+        end;
 
 
     procedure tcgavr.g_overflowCheck(list : TAsmList;const l : tlocation;def : tdef);

compiler/cfileutl.pas

@@ -37,6 +37,9 @@ interface
 {$if defined(go32v2) or defined(watcom)}
       Dos,
 {$endif}
+{$ifdef macos}
+      macutils,
+{$endif macos}
 {$IFNDEF USE_FAKE_SYSUTILS}
       SysUtils,
 {$ELSE}

compiler/cgbase.pas

@@ -130,6 +130,10 @@ interface
          ,addr_ntpoff
          ,addr_tlsgd
          {$ENDIF}
+{$ifdef x86_64}
+          ,addr_tpoff
+          ,addr_tlsgd
+{$endif x86_64}
          );
 
 

compiler/cgutils.pas

@@ -135,15 +135,15 @@ unit cgutils;
 {$endif cpuflags}
             LOC_CONSTANT : (
               case longint of
-{$ifdef cpu64bitalu}
+{$if defined(cpu64bitalu) or defined(cpuhighleveltarget)}
                 1 : (value : Int64);
-{$else cpu64bitalu}
+{$else cpu64bitalu or cpuhighleveltarget}
     {$ifdef FPC_BIG_ENDIAN}
                 1 : (_valuedummy,value : longint);
     {$else FPC_BIG_ENDIAN}
                 1 : (value : longint);
     {$endif FPC_BIG_ENDIAN}
-{$endif cpu64bitalu}
+{$endif cpu64bitalu or cpuhighleveltarget}
                 2 : (value64 : Int64);
               );
             LOC_CREFERENCE,
@@ -164,10 +164,10 @@ unit cgutils;
 {$ifdef cpu64bitalu}
                 { overlay a 128 Bit register type }
                 2 : (register128 : tregister128);
-{$else cpu64bitalu}
+{$else if not defined(cpuhighleveltarget}
                 { overlay a 64 Bit register type }
                 2 : (register64 : tregister64);
-{$endif cpu64bitalu}
+{$endif cpu64bitalu and not cpuhighleveltarget}
 {$ifdef cpu8bitalu}
                 3 : (registers : array[0..3] of tregister);
 {$endif cpu8bitalu}

compiler/defcmp.pas

@@ -289,8 +289,15 @@ implementation
              if assigned(tstoreddef(def_from).genconstraintdata) or
                  assigned(tstoreddef(def_to).genconstraintdata) then
                begin
-                 { constants could get another deftype (e.g. niln) }
-                 if (def_from.typ<>def_to.typ) and not(fromtreetype in nodetype_const) then
+                 { this is bascially a poor man's type checking, if there is a chance
+                   that the types are equal considering the constraints, this needs probably
+                   to be improved and maybe factored out or even result in a recursive compare_defs_ext }
+                 if (def_from.typ<>def_to.typ) and
+                   { formaldefs are compatible with everything }
+                   not(def_from.typ in [formaldef]) and
+                   not(def_to.typ in [formaldef]) and
+                   { constants could get another deftype (e.g. niln) }
+                   not(fromtreetype in nodetype_const) then
                    begin
                      { not compatible anyway }
                      doconv:=tc_not_possible;

compiler/fpcdefs.inc

@@ -298,10 +298,6 @@
   {$define cpurequiresproperalignment}
 {$endif riscv64}
 
-{$IFDEF MACOS}
-{$DEFINE USE_FAKE_SYSUTILS}
-{$ENDIF MACOS}
-
 { Stabs is not officially supported on 64 bit targets by gdb, except on Mac OS X
   (but there we don't support it)
 }
@@ -322,9 +318,7 @@
 }
 {$ifdef llvm}
   {$undef SUPPORT_MMX}
-  {$undef cpu16bitalu}
-  {$undef cpu32bitalu}
-  {$define cpu64bitalu}
   {$define cpuhighleveltarget}
+  {$define cpucg64shiftsupport}
   {$define symansistr}
 {$endif}

compiler/globals.pas

@@ -406,9 +406,9 @@ interface
           procalign : 0;
           loopalign : 0;
           jumpalign : 0;
-          jumpalignmax    : 0;
+          jumpalignskipmax    : 0;
           coalescealign   : 0;
-          coalescealignmax: 0;
+          coalescealignskipmax: 0;
           constalignmin : 0;
           constalignmax : 0;
           varalignmin : 0;

compiler/globstat.pas

@@ -60,6 +60,7 @@ type
     old_settings : tsettings;
     old_switchesstatestack : tswitchesstatestack;
     old_switchesstatestackpos : Integer;
+    old_verbosity : longint;
 
   { only saved/restored if "full" is true }
     old_asmdata : tasmdata;
@@ -74,7 +75,7 @@ procedure restore_global_state(const state:tglobalstate;full:boolean);
 implementation
 
 uses
-  pbase;
+  pbase,comphook;
 
   procedure save_global_state(out state:tglobalstate;full:boolean);
     begin
@@ -106,6 +107,7 @@ uses
           //flushpendingswitchesstate;
           oldcurrent_filepos:=current_filepos;
           old_settings:=current_settings;
+          old_verbosity:=status.verbosity;
 
           if full then
             begin
@@ -142,6 +144,7 @@ uses
           current_procinfo:=oldcurrent_procinfo;
           current_filepos:=oldcurrent_filepos;
           current_settings:=old_settings;
+          status.verbosity:=old_verbosity;
 
           if full then
             begin

compiler/hlcg2ll.pas

@@ -330,7 +330,8 @@ implementation
 
     uses
        globals,systems,
-       verbose,defutil,
+       verbose,defutil,symsym,
+       procinfo,paramgr,
        cgobj,tgobj,cutils,
        ncgutil;
 
@@ -1297,6 +1298,7 @@ implementation
                reg:=getmmregister(list,newsize);
                a_loadmm_loc_reg(list,size,newsize,l,reg,mms_movescalar);
                l.size:=def_cgsize(newsize);
+               size:=newsize;
              end;
           location_freetemp(list,l);
           location_reset(l,LOC_MMREGISTER,l.size);
@@ -1318,9 +1320,83 @@ implementation
     end;
 
   procedure thlcg2ll.gen_load_para_value(list: TAsmList);
-    begin
-      ncgutil.gen_load_para_value(list);
-    end;
+
+    procedure get_para(const paraloc:TCGParaLocation);
+      begin
+         case paraloc.loc of
+           LOC_REGISTER :
+             begin
+               if getsupreg(paraloc.register)<first_int_imreg then
+                 cg.getcpuregister(list,paraloc.register);
+             end;
+           LOC_MMREGISTER :
+             begin
+               if getsupreg(paraloc.register)<first_mm_imreg then
+                 cg.getcpuregister(list,paraloc.register);
+             end;
+           LOC_FPUREGISTER :
+             begin
+               if getsupreg(paraloc.register)<first_fpu_imreg then
+                 cg.getcpuregister(list,paraloc.register);
+             end;
+         end;
+      end;
+
+   var
+     i : longint;
+     currpara : tparavarsym;
+     paraloc  : pcgparalocation;
+   begin
+     if (po_assembler in current_procinfo.procdef.procoptions) or
+     { exceptfilters have a single hidden 'parentfp' parameter, which
+       is handled by tcg.g_proc_entry. }
+        (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
+       exit;
+
+     { Allocate registers used by parameters }
+     for i:=0 to current_procinfo.procdef.paras.count-1 do
+       begin
+         currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
+         paraloc:=currpara.paraloc[calleeside].location;
+         while assigned(paraloc) do
+           begin
+             if paraloc^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER] then
+               get_para(paraloc^);
+             paraloc:=paraloc^.next;
+           end;
+       end;
+
+     { Copy parameters to local references/registers }
+     for i:=0 to current_procinfo.procdef.paras.count-1 do
+       begin
+         currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
+         { don't use currpara.vardef, as this will be wrong in case of
+           call-by-reference parameters (it won't contain the pointerdef) }
+         gen_load_cgpara_loc(list,currpara.paraloc[calleeside].def,currpara.paraloc[calleeside],currpara.initialloc,paramanager.param_use_paraloc(currpara.paraloc[calleeside]));
+         { gen_load_cgpara_loc() already allocated the initialloc
+           -> don't allocate again }
+         if currpara.initialloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER] then
+           begin
+             gen_alloc_regvar(list,currpara,false);
+             hlcg.varsym_set_localloc(list,currpara);
+           end;
+       end;
+
+     { generate copies of call by value parameters, must be done before
+       the initialization and body is parsed because the refcounts are
+       incremented using the local copies }
+     current_procinfo.procdef.parast.SymList.ForEachCall(@hlcg.g_copyvalueparas,list);
+     if not(po_assembler in current_procinfo.procdef.procoptions) then
+       begin
+         { initialize refcounted paras, and trash others. Needed here
+           instead of in gen_initialize_code, because when a reference is
+           intialised or trashed while the pointer to that reference is kept
+           in a regvar, we add a register move and that one again has to
+           come after the parameter loading code as far as the register
+           allocator is concerned }
+         current_procinfo.procdef.parast.SymList.ForEachCall(@init_paras,list);
+       end;
+   end;
 
   procedure thlcg2ll.gen_loadfpu_loc_cgpara(list: TAsmList; size: tdef; const l: tlocation; const cgpara: tcgpara; locintsize: longint);
     var
@@ -1524,8 +1600,542 @@ implementation
     end;
 
   procedure thlcg2ll.gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
+
+    procedure unget_para(const paraloc:TCGParaLocation);
+      begin
+         case paraloc.loc of
+           LOC_REGISTER :
+             begin
+               if getsupreg(paraloc.register)<first_int_imreg then
+                 cg.ungetcpuregister(list,paraloc.register);
+             end;
+           LOC_MMREGISTER :
+             begin
+               if getsupreg(paraloc.register)<first_mm_imreg then
+                 cg.ungetcpuregister(list,paraloc.register);
+             end;
+           LOC_FPUREGISTER :
+             begin
+               if getsupreg(paraloc.register)<first_fpu_imreg then
+                 cg.ungetcpuregister(list,paraloc.register);
+             end;
+         end;
+      end;
+
+    var
+      paraloc   : pcgparalocation;
+      href      : treference;
+      sizeleft  : aint;
+      tempref   : treference;
+      loadsize  : tcgint;
+      tempreg  : tregister;
+{$ifdef mips}
+      //tmpreg   : tregister;
+{$endif mips}
+{$ifndef cpu64bitalu}
+      reg64    : tregister64;
+{$if defined(cpu8bitalu)}
+      curparaloc : PCGParaLocation;
+{$endif defined(cpu8bitalu)}
+{$endif not cpu64bitalu}
     begin
-      ncgutil.gen_load_cgpara_loc(list, vardef, para, destloc, reusepara);
+      paraloc:=para.location;
+      if not assigned(paraloc) then
+        internalerror(200408203);
+      { skip e.g. empty records }
+      if (paraloc^.loc = LOC_VOID) then
+        exit;
+      case destloc.loc of
+        LOC_REFERENCE :
+          begin
+            { If the parameter location is reused we don't need to copy
+              anything }
+            if not reusepara then
+              begin
+                href:=destloc.reference;
+                sizeleft:=para.intsize;
+                while assigned(paraloc) do
+                  begin
+                    if (paraloc^.size=OS_NO) then
+                      begin
+                        { Can only be a reference that contains the rest
+                          of the parameter }
+                        if (paraloc^.loc<>LOC_REFERENCE) or
+                           assigned(paraloc^.next) then
+                          internalerror(2005013010);
+                        cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment);
+                        inc(href.offset,sizeleft);
+                        sizeleft:=0;
+                      end
+                    else
+                      begin
+                        { the min(...) call ensures that we do not store more than place is left as
+                           paraloc^.size could be bigger than destloc.size of a parameter occupies a full register
+                           and as on big endian system the parameters might be left aligned, we have to work
+                           with the full register size for paraloc^.size }
+                        if tcgsize2size[destloc.size]<>0 then
+                          loadsize:=min(min(tcgsize2size[paraloc^.size],tcgsize2size[destloc.size]),sizeleft)
+                        else
+                          loadsize:=min(tcgsize2size[paraloc^.size],sizeleft);
+
+                        cg.a_load_cgparaloc_ref(list,paraloc^,href,loadsize,destloc.reference.alignment);
+                        inc(href.offset,loadsize);
+                        dec(sizeleft,loadsize);
+                      end;
+                    unget_para(paraloc^);
+                    paraloc:=paraloc^.next;
+                  end;
+              end;
+          end;
+        LOC_REGISTER,
+        LOC_CREGISTER :
+          begin
+{$ifdef cpu64bitalu}
+            if (para.size in [OS_128,OS_S128,OS_F128]) and
+               ({ in case of fpu emulation, or abi's that pass fpu values
+                  via integer registers }
+                (vardef.typ=floatdef) or
+                 is_methodpointer(vardef) or
+                 is_record(vardef)) then
+              begin
+                case paraloc^.loc of
+                  LOC_REGISTER,
+                  LOC_MMREGISTER:
+                    begin
+                      if not assigned(paraloc^.next) then
+                        internalerror(200410104);
+                      case tcgsize2size[paraloc^.size] of
+                        8:
+                          begin
+                            if (target_info.endian=ENDIAN_BIG) then
+                              begin
+                                { paraloc^ -> high
+                                  paraloc^.next -> low }
+                                unget_para(paraloc^);
+                                gen_alloc_regloc(list,destloc,vardef);
+                                { reg->reg, alignment is irrelevant }
+                                cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reghi,8);
+                                unget_para(paraloc^.next^);
+                                cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^.next^,destloc.register128.reglo,8);
+                              end
+                            else
+                              begin
+                                { paraloc^ -> low
+                                  paraloc^.next -> high }
+                                unget_para(paraloc^);
+                                gen_alloc_regloc(list,destloc,vardef);
+                                cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reglo,8);
+                                unget_para(paraloc^.next^);
+                                cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^.next^,destloc.register128.reghi,8);
+                              end;
+                          end;
+                        4:
+                          begin
+                            { The 128-bit parameter is located in 4 32-bit MM registers.
+                              It is needed to copy them to 2 64-bit int registers.
+                              A code generator or a target cpu must support loading of a 32-bit MM register to
+                              a 64-bit int register, zero extending it. }
+                            if target_info.endian=ENDIAN_BIG then
+                              internalerror(2018101702);  // Big endian support not implemented yet
+                            gen_alloc_regloc(list,destloc,vardef);
+                            tempreg:=cg.getintregister(list,OS_64);
+                            // Low part of the 128-bit param
+                            unget_para(paraloc^);
+                            cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,tempreg,4);
+                            paraloc:=paraloc^.next;
+                            if paraloc=nil then
+                              internalerror(2018101703);
+                            unget_para(paraloc^);
+                            cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reglo,4);
+                            cg.a_op_const_reg(list,OP_SHL,OS_64,32,destloc.register128.reglo);
+                            cg.a_op_reg_reg(list,OP_OR,OS_64,tempreg,destloc.register128.reglo);
+                            // High part of the 128-bit param
+                            paraloc:=paraloc^.next;
+                            if paraloc=nil then
+                              internalerror(2018101704);
+                            unget_para(paraloc^);
+                            cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,tempreg,4);
+                            paraloc:=paraloc^.next;
+                            if paraloc=nil then
+                              internalerror(2018101705);
+                            unget_para(paraloc^);
+                            cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reghi,4);
+                            cg.a_op_const_reg(list,OP_SHL,OS_64,32,destloc.register128.reghi);
+                            cg.a_op_reg_reg(list,OP_OR,OS_64,tempreg,destloc.register128.reghi);
+                          end
+                        else
+                          internalerror(2018101701);
+                      end;
+                    end;
+                  LOC_REFERENCE:
+                    begin
+                      gen_alloc_regloc(list,destloc,vardef);
+                      reference_reset_base(href,cpointerdef.getreusable(vardef),paraloc^.reference.index,paraloc^.reference.offset,ctempposinvalid,para.alignment,[]);
+                      cg128.a_load128_ref_reg(list,href,destloc.register128);
+                      unget_para(paraloc^);
+                    end;
+                  else
+                    internalerror(2012090607);
+                end
+              end
+            else
+{$else cpu64bitalu}
+            if (para.size in [OS_64,OS_S64,OS_F64]) and
+               (is_64bit(vardef) or
+                { in case of fpu emulation, or abi's that pass fpu values
+                  via integer registers }
+                (vardef.typ=floatdef) or
+                 is_methodpointer(vardef) or
+                 is_record(vardef)) then
+              begin
+                case paraloc^.loc of
+                  LOC_REGISTER:
+                    begin
+                      case para.locations_count of
+{$if defined(cpu8bitalu)}
+                        { 8 paralocs? }
+                        8:
+                          if (target_info.endian=ENDIAN_BIG) then
+                            begin
+                              { is there any big endian 8 bit ALU/16 bit Addr CPU? }
+                              internalerror(2015041003);
+                              { paraloc^ -> high
+                                paraloc^.next^.next^.next^.next -> low }
+                              unget_para(paraloc^);
+                              gen_alloc_regloc(list,destloc,vardef);
+                              { reg->reg, alignment is irrelevant }
+                              cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,cg.GetNextReg(destloc.register64.reghi),1);
+                              unget_para(paraloc^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,destloc.register64.reghi,1);
+                              unget_para(paraloc^.next^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,cg.GetNextReg(destloc.register64.reglo),1);
+                              unget_para(paraloc^.next^.next^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,destloc.register64.reglo,1);
+                            end
+                          else
+                            begin
+                              { paraloc^ -> low
+                                paraloc^.next^.next^.next^.next -> high }
+                              curparaloc:=paraloc;
+                              unget_para(curparaloc^);
+                              gen_alloc_regloc(list,destloc,vardef);
+                              cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^,destloc.register64.reglo,2);
+                              unget_para(curparaloc^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^,cg.GetNextReg(destloc.register64.reglo),1);
+                              unget_para(curparaloc^.next^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^,cg.GetNextReg(cg.GetNextReg(destloc.register64.reglo)),1);
+                              unget_para(curparaloc^.next^.next^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^.next^,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(destloc.register64.reglo))),1);
+
+                              curparaloc:=paraloc^.next^.next^.next^.next;
+                              unget_para(curparaloc^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^,destloc.register64.reghi,2);
+                              unget_para(curparaloc^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^,cg.GetNextReg(destloc.register64.reghi),1);
+                              unget_para(curparaloc^.next^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^,cg.GetNextReg(cg.GetNextReg(destloc.register64.reghi)),1);
+                              unget_para(curparaloc^.next^.next^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^.next^,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(destloc.register64.reghi))),1);
+                            end;
+{$endif defined(cpu8bitalu)}
+{$if defined(cpu16bitalu) or defined(cpu8bitalu)}
+                        { 4 paralocs? }
+                        4:
+                          if (target_info.endian=ENDIAN_BIG) then
+                            begin
+                              { paraloc^ -> high
+                                paraloc^.next^.next -> low }
+                              unget_para(paraloc^);
+                              gen_alloc_regloc(list,destloc,vardef);
+                              { reg->reg, alignment is irrelevant }
+                              cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,cg.GetNextReg(destloc.register64.reghi),2);
+                              unget_para(paraloc^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,destloc.register64.reghi,2);
+                              unget_para(paraloc^.next^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,cg.GetNextReg(destloc.register64.reglo),2);
+                              unget_para(paraloc^.next^.next^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,destloc.register64.reglo,2);
+                            end
+                          else
+                            begin
+                              { paraloc^ -> low
+                                paraloc^.next^.next -> high }
+                              unget_para(paraloc^);
+                              gen_alloc_regloc(list,destloc,vardef);
+                              cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,destloc.register64.reglo,2);
+                              unget_para(paraloc^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,cg.GetNextReg(destloc.register64.reglo),2);
+                              unget_para(paraloc^.next^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,destloc.register64.reghi,2);
+                              unget_para(paraloc^.next^.next^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,cg.GetNextReg(destloc.register64.reghi),2);
+                            end;
+{$endif defined(cpu16bitalu) or defined(cpu8bitalu)}
+                        2:
+                          if (target_info.endian=ENDIAN_BIG) then
+                            begin
+                              { paraloc^ -> high
+                                paraloc^.next -> low }
+                              unget_para(paraloc^);
+                              gen_alloc_regloc(list,destloc,vardef);
+                              { reg->reg, alignment is irrelevant }
+                              cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reghi,4);
+                              unget_para(paraloc^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reglo,4);
+                            end
+                          else
+                            begin
+                              { paraloc^ -> low
+                                paraloc^.next -> high }
+                              unget_para(paraloc^);
+                              gen_alloc_regloc(list,destloc,vardef);
+                              cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reglo,4);
+                              unget_para(paraloc^.next^);
+                              cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reghi,4);
+                            end;
+                        else
+                          { unexpected number of paralocs }
+                          internalerror(200410104);
+                      end;
+                    end;
+                  LOC_REFERENCE:
+                    begin
+                      gen_alloc_regloc(list,destloc,vardef);
+                      reference_reset_base(href,cpointerdef.getreusable(vardef),paraloc^.reference.index,paraloc^.reference.offset,ctempposinvalid,para.alignment,[]);
+                      cg64.a_load64_ref_reg(list,href,destloc.register64);
+                      unget_para(paraloc^);
+                    end;
+                  else
+                    internalerror(2005101501);
+                end
+              end
+            else
+{$endif cpu64bitalu}
+              begin
+                if assigned(paraloc^.next) then
+                  begin
+                    if (destloc.size in [OS_PAIR,OS_SPAIR]) and
+                      (para.Size in [OS_PAIR,OS_SPAIR]) then
+                      begin
+                        unget_para(paraloc^);
+                        gen_alloc_regloc(list,destloc,vardef);
+                        cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^,destloc.register,sizeof(aint));
+                        unget_para(paraloc^.Next^);
+                        {$if defined(cpu16bitalu) or defined(cpu8bitalu)}
+                          cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^.Next^,cg.GetNextReg(destloc.register),sizeof(aint));
+                        {$else}
+                          cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^.Next^,destloc.registerhi,sizeof(aint));
+                        {$endif}
+                      end
+{$if defined(cpu8bitalu)}
+                    else if (destloc.size in [OS_32,OS_S32]) and
+                      (para.Size in [OS_32,OS_S32]) then
+                      begin
+                        unget_para(paraloc^);
+                        gen_alloc_regloc(list,destloc,vardef);
+                        cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^,destloc.register,sizeof(aint));
+                        unget_para(paraloc^.Next^);
+                        cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^,cg.GetNextReg(destloc.register),sizeof(aint));
+                        unget_para(paraloc^.Next^.Next^);
+                        cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^.Next^,cg.GetNextReg(cg.GetNextReg(destloc.register)),sizeof(aint));
+                        unget_para(paraloc^.Next^.Next^.Next^);
+                        cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^.Next^.Next^,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(destloc.register))),sizeof(aint));
+                      end
+{$endif defined(cpu8bitalu)}
+                    else
+                      begin
+                        { this can happen if a parameter is spread over
+                          multiple paralocs, e.g. if a record with two single
+                          fields must be passed in two single precision
+                          registers }
+                        { does it fit in the register of destloc? }
+                        sizeleft:=para.intsize;
+                        if sizeleft<>vardef.size then
+                          internalerror(2014122806);
+                        if sizeleft<>tcgsize2size[destloc.size] then
+                          internalerror(200410105);
+                        { store everything first to memory, then load it in
+                          destloc }
+                        tg.gettemp(list,sizeleft,sizeleft,tt_persistent,tempref);
+                        gen_alloc_regloc(list,destloc,vardef);
+                        while sizeleft>0 do
+                          begin
+                            if not assigned(paraloc) then
+                              internalerror(2014122807);
+                            unget_para(paraloc^);
+                            cg.a_load_cgparaloc_ref(list,paraloc^,tempref,sizeleft,newalignment(para.alignment,para.intsize-sizeleft));
+                            if (paraloc^.size=OS_NO) and
+                               assigned(paraloc^.next) then
+                              internalerror(2014122805);
+                            inc(tempref.offset,tcgsize2size[paraloc^.size]);
+                            dec(sizeleft,tcgsize2size[paraloc^.size]);
+                            paraloc:=paraloc^.next;
+                          end;
+                        dec(tempref.offset,para.intsize);
+                        cg.a_load_ref_reg(list,para.size,para.size,tempref,destloc.register);
+                        tg.ungettemp(list,tempref);
+                      end;
+                  end
+                else
+                  begin
+                    unget_para(paraloc^);
+                    gen_alloc_regloc(list,destloc,vardef);
+                    { we can't directly move regular registers into fpu
+                      registers }
+                    if getregtype(paraloc^.register)=R_FPUREGISTER then
+                      begin
+                        { store everything first to memory, then load it in
+                          destloc }
+                        tg.gettemp(list,tcgsize2size[paraloc^.size],para.intsize,tt_persistent,tempref);
+                        cg.a_load_cgparaloc_ref(list,paraloc^,tempref,tcgsize2size[paraloc^.size],tempref.alignment);
+                        cg.a_load_ref_reg(list,int_cgsize(tcgsize2size[paraloc^.size]),destloc.size,tempref,destloc.register);
+                        tg.ungettemp(list,tempref);
+                      end
+                    else
+                      cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,sizeof(aint));
+                  end;
+              end;
+          end;
+        LOC_FPUREGISTER,
+        LOC_CFPUREGISTER :
+          begin
+{$ifdef mips}
+            if (destloc.size = paraloc^.Size) and
+               (paraloc^.Loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER,LOC_REFERENCE,LOC_CREFERENCE]) then
+              begin
+                unget_para(paraloc^);
+                gen_alloc_regloc(list,destloc,vardef);
+                cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,para.alignment);
+              end
+            else if (destloc.size = OS_F32) and
+               (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then
+              begin
+                gen_alloc_regloc(list,destloc,vardef);
+                unget_para(paraloc^);
+                list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.register,destloc.register));
+              end
+{ TODO: Produces invalid code, needs fixing together with regalloc setup. }
+{
+            else if (destloc.size = OS_F64) and
+                    (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) and
+                    (paraloc^.next^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then
+              begin
+                gen_alloc_regloc(list,destloc,vardef);
+
+                tmpreg:=destloc.register;
+                unget_para(paraloc^);
+                list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.register,tmpreg));
+                setsupreg(tmpreg,getsupreg(tmpreg)+1);
+                unget_para(paraloc^.next^);
+                list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.Next^.register,tmpreg));
+              end
+}
+            else
+              begin
+                sizeleft := TCGSize2Size[destloc.size];
+                tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref);
+                href:=tempref;
+                while assigned(paraloc) do
+                  begin
+                    unget_para(paraloc^);
+                    cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment);
+                    inc(href.offset,TCGSize2Size[paraloc^.size]);
+                    dec(sizeleft,TCGSize2Size[paraloc^.size]);
+                    paraloc:=paraloc^.next;
+                  end;
+                gen_alloc_regloc(list,destloc,vardef);
+                cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register);
+                tg.UnGetTemp(list,tempref);
+              end;
+{$else mips}
+{$if defined(sparc) or defined(arm)}
+            { Arm and Sparc passes floats in int registers, when loading to fpu register
+              we need a temp }
+            sizeleft := TCGSize2Size[destloc.size];
+            tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref);
+            href:=tempref;
+            while assigned(paraloc) do
+              begin
+                unget_para(paraloc^);
+                cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment);
+                inc(href.offset,TCGSize2Size[paraloc^.size]);
+                dec(sizeleft,TCGSize2Size[paraloc^.size]);
+                paraloc:=paraloc^.next;
+              end;
+            gen_alloc_regloc(list,destloc,vardef);
+            cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register);
+            tg.UnGetTemp(list,tempref);
+{$else defined(sparc) or defined(arm)}
+            unget_para(paraloc^);
+            gen_alloc_regloc(list,destloc,vardef);
+            { from register to register -> alignment is irrelevant }
+            cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0);
+            if assigned(paraloc^.next) then
+              internalerror(200410109);
+{$endif defined(sparc) or defined(arm)}
+{$endif mips}
+          end;
+        LOC_MMREGISTER,
+        LOC_CMMREGISTER :
+          begin
+{$ifndef cpu64bitalu}
+            { ARM vfp floats are passed in integer registers }
+            if (para.size=OS_F64) and
+               (paraloc^.size in [OS_32,OS_S32]) and
+               use_vectorfpu(vardef) then
+              begin
+                { we need 2x32bit reg }
+                if not assigned(paraloc^.next) or
+                   assigned(paraloc^.next^.next) then
+                  internalerror(2009112421);
+                unget_para(paraloc^.next^);
+                case paraloc^.next^.loc of
+                  LOC_REGISTER:
+                    tempreg:=paraloc^.next^.register;
+                  LOC_REFERENCE:
+                    begin
+                      tempreg:=cg.getintregister(list,OS_32);
+                      cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,tempreg,4);
+                    end;
+                  else
+                    internalerror(2012051301);
+                end;
+                { don't free before the above, because then the getintregister
+                  could reallocate this register and overwrite it }
+                unget_para(paraloc^);
+                gen_alloc_regloc(list,destloc,vardef);
+                if (target_info.endian=endian_big) then
+                  { paraloc^ -> high
+                    paraloc^.next -> low }
+                  reg64:=joinreg64(tempreg,paraloc^.register)
+                else
+                  reg64:=joinreg64(paraloc^.register,tempreg);
+                cg64.a_loadmm_intreg64_reg(list,OS_F64,reg64,destloc.register);
+              end
+            else
+{$endif not cpu64bitalu}
+              begin
+                if not assigned(paraloc^.next) then
+                  begin
+                    unget_para(paraloc^);
+                    gen_alloc_regloc(list,destloc,vardef);
+                    { from register to register -> alignment is irrelevant }
+                    cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0);
+                  end
+                else
+                  begin
+                    internalerror(200410108);
+                  end;
+                { data could come in two memory locations, for now
+                  we simply ignore the sanity check (FK)
+                if assigned(paraloc^.next) then
+                  internalerror(200410108);
+                }
+              end;
+          end;
+        else
+          internalerror(2010052903);
+      end;
     end;
 
   function thlcg2ll.getintmmcgsize(reg: tregister; size: tcgsize): tcgsize;

compiler/hlcgobj.pas

@@ -991,7 +991,7 @@ implementation
                      { load the value piecewise to get it into the register }
                      orgsizeleft:=sizeleft;
                      reghasvalue:=false;
-{$ifdef cpu64bitalu}
+{$if defined(cpu64bitalu) or defined(cpuhighleveltarget)}
                      if sizeleft>=4 then
                        begin
                          a_load_ref_reg(list,u32inttype,location^.def,tmpref,location^.register);
@@ -1001,7 +1001,7 @@ implementation
                          inc(tmpref.offset,4);
                          reghasvalue:=true;
                        end;
-{$endif cpu64bitalu}
+{$endif defind(cpu64bitalu) or defined(cpuhighleveltarget)}
                      if sizeleft>=2 then
                        begin
                          tmpreg:=getintregister(list,location^.def);
@@ -3186,7 +3186,7 @@ implementation
          paramanager.getintparaloc(list,pd,1,cgpara1);
          a_load_const_cgpara(list,s32inttype,aint(210),cgpara1);
          paramanager.freecgpara(list,cgpara1);
-         g_call_system_proc(list,pd,[@cgpara1],nil);
+         g_call_system_proc(list,pd,[@cgpara1],nil).resetiftemp;
          cgpara1.done;
          a_label(list,oklabel);
        end;
@@ -3234,7 +3234,7 @@ implementation
       paramanager.freecgpara(list,cgpara3);
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil);
+      g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil).resetiftemp;
       cgpara3.done;
       cgpara2.done;
       cgpara1.done;
@@ -3262,7 +3262,7 @@ implementation
         end;
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil);
+      g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil).resetiftemp;
       cgpara2.done;
       cgpara1.done;
     end;
@@ -3301,7 +3301,7 @@ implementation
             { these functions get the pointer by value }
             a_load_ref_cgpara(list,t,ref,cgpara1);
           paramanager.freecgpara(list,cgpara1);
-          g_call_system_proc(list,pd,[@cgpara1],nil);
+          g_call_system_proc(list,pd,[@cgpara1],nil).resetiftemp;
         end
        else
         begin
@@ -3323,7 +3323,7 @@ implementation
             end;
           paramanager.freecgpara(list,cgpara1);
           paramanager.freecgpara(list,cgpara2);
-          g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil);
+          g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil).resetiftemp;
         end;
        cgpara2.done;
        cgpara1.done;
@@ -3349,7 +3349,7 @@ implementation
            paramanager.getintparaloc(list,pd,1,cgpara1);
            a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
            paramanager.freecgpara(list,cgpara1);
-          g_call_system_proc(list,pd,[@cgpara1],nil);
+          g_call_system_proc(list,pd,[@cgpara1],nil).resetiftemp;
          end
        else
          begin
@@ -3371,7 +3371,7 @@ implementation
               end;
             paramanager.freecgpara(list,cgpara1);
             paramanager.freecgpara(list,cgpara2);
-            g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil);
+            g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil).resetiftemp;
          end;
        cgpara1.done;
        cgpara2.done;
@@ -3421,7 +3421,7 @@ implementation
             end;
           paramanager.freecgpara(list,cgpara1);
           paramanager.freecgpara(list,cgpara2);
-          g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil);
+          g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil).resetiftemp;
           cgpara1.done;
           cgpara2.done;
           exit;
@@ -3431,7 +3431,7 @@ implementation
       paramanager.getintparaloc(list,pd,1,cgpara1);
       a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,pd,[@cgpara1],nil);
+      g_call_system_proc(list,pd,[@cgpara1],nil).resetiftemp;
       cgpara1.done;
     end;
 
@@ -3485,7 +3485,7 @@ implementation
       paramanager.freecgpara(list,cgpara1);
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara3);
-      g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil);
+      g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil).resetiftemp;
 
       cgpara3.done;
       cgpara2.done;
@@ -3502,7 +3502,9 @@ implementation
 
   procedure thlcgobj.g_rangecheck(list: TAsmList; const l: tlocation; fromdef, todef: tdef);
     var
-{$if defined(cpu64bitalu) or defined(cpu32bitalu)}
+{$if defined(cpuhighleveltarget)}
+      aintmax: tcgint;
+{$elseif defined(cpu64bitalu) or defined(cpu32bitalu)}
       aintmax: aint;
 {$else}
       aintmax: longint;
@@ -3664,7 +3666,7 @@ implementation
                   { if low(to) > maxlongint also range error }
                   (lto > aintmax) then
                  begin
-                   g_call_system_proc(list,'fpc_rangeerror',[],nil);
+                   g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp;
                    exit
                  end;
                { from is signed and to is unsigned -> when looking at to }
@@ -3679,7 +3681,7 @@ implementation
                if (lfrom > aintmax) or
                   (hto < 0) then
                  begin
-                   g_call_system_proc(list,'fpc_rangeerror',[],nil);
+                   g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp;
                    exit
                  end;
                { from is unsigned and to is signed -> when looking at to }
@@ -3702,7 +3704,7 @@ implementation
         a_cmp_const_reg_label(list,maxdef,OC_BE,aintmax,hreg,neglabel)
       else
         a_cmp_const_reg_label(list,maxdef,OC_BE,tcgint(int64(hto-lto)),hreg,neglabel);
-      g_call_system_proc(list,'fpc_rangeerror',[],nil);
+      g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp;
       a_label(list,neglabel);
     end;
 
@@ -3781,7 +3783,7 @@ implementation
       paramanager.freecgpara(list,cgpara3);
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil);
+      g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil).resetiftemp;
       cgpara3.done;
       cgpara2.done;
       cgpara1.done;
@@ -3800,7 +3802,7 @@ implementation
       { load source }
       a_load_loc_cgpara(list,cpointerdef.getreusable(arrdef),l,cgpara1);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,pd,[@cgpara1],nil);
+      g_call_system_proc(list,pd,[@cgpara1],nil).resetiftemp;
       cgpara1.done;
     end;
 
@@ -4639,10 +4641,10 @@ implementation
 {$ifdef AVR}
            cg.a_call_name(list,'FPC_INIT_FUNC_TABLE',false)
 {$else AVR}
-           g_call_system_proc(list,'fpc_initializeunits',[],nil)
+           g_call_system_proc(list,'fpc_initializeunits',[],nil).resetiftemp
 {$endif AVR}
          else
-           g_call_system_proc(list,'fpc_libinitializeunits',[],nil);
+           g_call_system_proc(list,'fpc_libinitializeunits',[],nil).resetiftemp;
        end;
 
       list.concat(Tai_force_line.Create);
@@ -4660,7 +4662,7 @@ implementation
       { call __EXIT for main program }
       if (not current_module.islibrary) and
          (current_procinfo.procdef.proctypeoption=potype_proginit) then
-        g_call_system_proc(list,'fpc_do_exit',[],nil);
+        g_call_system_proc(list,'fpc_do_exit',[],nil).resetiftemp;
     end;
 
   procedure thlcgobj.inittempvariables(list: TAsmList);
@@ -5182,7 +5184,7 @@ implementation
 
   procedure thlcgobj.gen_load_return_value(list: TAsmList);
     var
-      ressym : tabstractnormalvarsym;
+      ressym : tsym;
       retdef : tdef;
     begin
       { Is the loading needed? }
@@ -5196,30 +5198,19 @@ implementation
         exit;
 
       { constructors return self }
-      if (current_procinfo.procdef.proctypeoption=potype_constructor) then
-        begin
-          ressym:=tabstractnormalvarsym(current_procinfo.procdef.parast.Find('self'));
-          retdef:=ressym.vardef;
-          { and TP-style constructors return a pointer to self }
-          if is_object(ressym.vardef) then
-            retdef:=cpointerdef.getreusable(retdef);
-        end
-      else
-        begin
-          ressym:=tabstractnormalvarsym(current_procinfo.procdef.funcretsym);
-          retdef:=ressym.vardef;
-        end;
+      if not current_procinfo.procdef.getfuncretsyminfo(ressym,retdef) then
+        internalerror(2018122501);
       if (ressym.refs>0) or
          is_managed_type(retdef) then
         begin
           { was: don't do anything if funcretloc.loc in [LOC_INVALID,LOC_REFERENCE] }
           if not paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
-            gen_load_loc_function_result(list,retdef,ressym.localloc);
+            gen_load_loc_function_result(list,retdef,tabstractnormalvarsym(ressym).localloc);
         end
       else
         gen_load_uninitialized_function_result(list,current_procinfo.procdef,retdef,current_procinfo.procdef.funcretloc[calleeside]);
-      if ressym.localloc.loc=LOC_REFERENCE then
-        tg.UnGetLocal(list,ressym.localloc.reference);
+      if tabstractnormalvarsym(ressym).localloc.loc=LOC_REFERENCE then
+        tg.UnGetLocal(list,tabstractnormalvarsym(ressym).localloc.reference);
     end;
 
   procedure thlcgobj.gen_stack_check_size_para(list: TAsmList);
@@ -5247,7 +5238,7 @@ implementation
       paramanager.getintparaloc(list,pd,1,paraloc1);
       paramanager.freecgpara(list,paraloc1);
       { Call the helper }
-      hlcg.g_call_system_proc(list,pd,[@paraloc1],nil);
+      g_call_system_proc(list,pd,[@paraloc1],nil).resetiftemp;
       paraloc1.done;
     end;
 

compiler/i386/aoptcpu.pas

@@ -40,7 +40,6 @@ unit aoptcpu;
         procedure PeepHoleOptPass1; override;
         procedure PeepHoleOptPass2; override;
         procedure PostPeepHoleOpts; override;
-        function DoFpuLoadStoreOpt(var p : tai) : boolean;
       end;
 
     Var
@@ -58,74 +57,6 @@ unit aoptcpu;
       { units we should get rid off: }
       symsym,symconst;
 
-    function TCPUAsmoptimizer.DoFpuLoadStoreOpt(var p: tai): boolean;
-    { returns true if a "continue" should be done after this optimization }
-    var hp1, hp2: tai;
-    begin
-      DoFpuLoadStoreOpt := false;
-      if (taicpu(p).oper[0]^.typ = top_ref) and
-         getNextInstruction(p, hp1) and
-         (hp1.typ = ait_instruction) and
-         (((taicpu(hp1).opcode = A_FLD) and
-           (taicpu(p).opcode = A_FSTP)) or
-          ((taicpu(p).opcode = A_FISTP) and
-           (taicpu(hp1).opcode = A_FILD))) and
-         (taicpu(hp1).oper[0]^.typ = top_ref) and
-         (taicpu(hp1).opsize = taicpu(p).opsize) and
-         RefsEqual(taicpu(p).oper[0]^.ref^, taicpu(hp1).oper[0]^.ref^) then
-        begin
-          { replacing fstp f;fld f by fst f is only valid for extended because of rounding }
-          if (taicpu(p).opsize=S_FX) and
-             getNextInstruction(hp1, hp2) and
-             (hp2.typ = ait_instruction) and
-             IsExitCode(hp2) and
-             (taicpu(p).oper[0]^.ref^.base = current_procinfo.FramePointer) and
-             not(assigned(current_procinfo.procdef.funcretsym) and
-                 (taicpu(p).oper[0]^.ref^.offset < tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)) and
-             (taicpu(p).oper[0]^.ref^.index = NR_NO) then
-            begin
-              asml.remove(p);
-              asml.remove(hp1);
-              p.free;
-              hp1.free;
-              p := hp2;
-              removeLastDeallocForFuncRes(p);
-              doFPULoadStoreOpt := true;
-            end
-          (* can't be done because the store operation rounds
-          else
-            { fst can't store an extended value! }
-            if (taicpu(p).opsize <> S_FX) and
-               (taicpu(p).opsize <> S_IQ) then
-              begin
-                if (taicpu(p).opcode = A_FSTP) then
-                  taicpu(p).opcode := A_FST
-                else taicpu(p).opcode := A_FIST;
-                asml.remove(hp1);
-                hp1.free;
-              end
-          *)
-        end;
-    end;
-
-
-  { converts a TChange variable to a TRegister }
-  function tch2reg(ch: tinschange): tsuperregister;
-    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(2016041901)
-    end;
-
 
   { Checks if the register is a 32 bit general purpose register }
   function isgp32reg(reg: TRegister): boolean;
@@ -475,109 +406,10 @@ begin
                         end
                     end;
                   A_FLD:
-                    begin
-                      if (taicpu(p).oper[0]^.typ = top_reg) and
-                         GetNextInstruction(p, hp1) and
-                         (hp1.typ = Ait_Instruction) and
-                          (taicpu(hp1).oper[0]^.typ = top_reg) and
-                         (taicpu(hp1).oper[1]^.typ = top_reg) and
-                         (taicpu(hp1).oper[0]^.reg = NR_ST) and
-                         (taicpu(hp1).oper[1]^.reg = NR_ST1) then
-                         { change                        to
-                             fld      reg               fxxx reg,st
-                             fxxxp    st, st1 (hp1)
-                           Remark: non commutative operations must be reversed!
-                         }
-                        begin
-                            case taicpu(hp1).opcode Of
-                              A_FMULP,A_FADDP,
-                              A_FSUBP,A_FDIVP,A_FSUBRP,A_FDIVRP:
-                                begin
-                                  case taicpu(hp1).opcode Of
-                                    A_FADDP: taicpu(hp1).opcode := A_FADD;
-                                    A_FMULP: taicpu(hp1).opcode := A_FMUL;
-                                    A_FSUBP: taicpu(hp1).opcode := A_FSUBR;
-                                    A_FSUBRP: taicpu(hp1).opcode := A_FSUB;
-                                    A_FDIVP: taicpu(hp1).opcode := A_FDIVR;
-                                    A_FDIVRP: taicpu(hp1).opcode := A_FDIV;
-                                  end;
-                                  taicpu(hp1).oper[0]^.reg := taicpu(p).oper[0]^.reg;
-                                  taicpu(hp1).oper[1]^.reg := NR_ST;
-                                  asml.remove(p);
-                                  p.free;
-                                  p := hp1;
-                                  continue;
-                                end;
-                            end;
-                        end
-                      else
-                        if (taicpu(p).oper[0]^.typ = top_ref) and
-                           GetNextInstruction(p, hp2) and
-                           (hp2.typ = Ait_Instruction) and
-                           (taicpu(hp2).ops = 2) and
-                           (taicpu(hp2).oper[0]^.typ = top_reg) and
-                           (taicpu(hp2).oper[1]^.typ = top_reg) and
-                           (taicpu(p).opsize in [S_FS, S_FL]) and
-                           (taicpu(hp2).oper[0]^.reg = NR_ST) and
-                           (taicpu(hp2).oper[1]^.reg = NR_ST1) then
-                          if GetLastInstruction(p, hp1) and
-                             (hp1.typ = Ait_Instruction) and
-                             ((taicpu(hp1).opcode = A_FLD) or
-                              (taicpu(hp1).opcode = A_FST)) and
-                             (taicpu(hp1).opsize = taicpu(p).opsize) and
-                             (taicpu(hp1).oper[0]^.typ = top_ref) and
-                             RefsEqual(taicpu(p).oper[0]^.ref^, taicpu(hp1).oper[0]^.ref^) then
-                            if ((taicpu(hp2).opcode = A_FMULP) or
-                                (taicpu(hp2).opcode = A_FADDP)) then
-                            { change                      to
-                                fld/fst   mem1  (hp1)       fld/fst   mem1
-                                fld       mem1  (p)         fadd/
-                                faddp/                       fmul     st, st
-                                fmulp  st, st1 (hp2) }
-                              begin
-                                asml.remove(p);
-                                p.free;
-                                p := hp1;
-                                if (taicpu(hp2).opcode = A_FADDP) then
-                                  taicpu(hp2).opcode := A_FADD
-                                else
-                                  taicpu(hp2).opcode := A_FMUL;
-                                taicpu(hp2).oper[1]^.reg := NR_ST;
-                              end
-                            else
-                            { change              to
-                                fld/fst mem1 (hp1)   fld/fst mem1
-                                fld     mem1 (p)     fld      st}
-                              begin
-                                taicpu(p).changeopsize(S_FL);
-                                taicpu(p).loadreg(0,NR_ST);
-                              end
-                          else
-                            begin
-                              case taicpu(hp2).opcode Of
-                                A_FMULP,A_FADDP,A_FSUBP,A_FDIVP,A_FSUBRP,A_FDIVRP:
-                          { change                        to
-                              fld/fst  mem1    (hp1)      fld/fst    mem1
-                              fld      mem2    (p)        fxxx       mem2
-                              fxxxp    st, st1 (hp2)                      }
-
-                                  begin
-                                    case taicpu(hp2).opcode Of
-                                      A_FADDP: taicpu(p).opcode := A_FADD;
-                                      A_FMULP: taicpu(p).opcode := A_FMUL;
-                                      A_FSUBP: taicpu(p).opcode := A_FSUBR;
-                                      A_FSUBRP: taicpu(p).opcode := A_FSUB;
-                                      A_FDIVP: taicpu(p).opcode := A_FDIVR;
-                                      A_FDIVRP: taicpu(p).opcode := A_FDIV;
-                                    end;
-                                    asml.remove(hp2);
-                                    hp2.free;
-                                  end
-                              end
-                            end
-                    end;
+                    if OptPass1FLD(p) then
+                      continue;
                   A_FSTP,A_FISTP:
-                    if doFpuLoadStoreOpt(p) then
+                    if OptPass1FSTP(p) then
                       continue;
                   A_LEA:
                     begin
@@ -776,7 +608,7 @@ begin
                 if OptPass2Jcc(p) then
                   continue;
               A_FSTP,A_FISTP:
-                if DoFpuLoadStoreOpt(p) then
+                if OptPass1FSTP(p) then
                   continue;
               A_IMUL:
                 if OptPass2Imul(p) then

compiler/i386/cpupara.pas

@@ -466,25 +466,23 @@ unit cpupara;
             else
               begin
                 paralen:=push_size(hp.varspez,paradef,p.proccalloption);
-                { darwin/x86 requires that parameters < sizeof(aint) are sign/ }
-                { zero extended to sizeof(aint)                                }
-                if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and
-                   (side = callerside) and
-                   (paralen > 0) and
-                   (paralen < sizeof(aint)) then
-                  begin
-                    paralen:=sizeof(aint);
-                    paracgsize:=OS_SINT;
-                    paradef:=sinttype;
-                  end
-                else
-                  paracgsize:=def_cgsize(paradef);
+                paracgsize:=def_cgsize(paradef);
               end;
             hp.paraloc[side].reset;
             hp.paraloc[side].size:=paracgsize;
             hp.paraloc[side].intsize:=paralen;
             hp.paraloc[side].def:=paradef;
             hp.paraloc[side].Alignment:=paraalign;
+            { darwin/x86 requires that parameters < sizeof(aint) are sign/ }
+            { zero extended to sizeof(aint)                                }
+            if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and
+               (side = callerside) and
+               (paralen > 0) and
+               (paralen < sizeof(aint)) then
+              begin
+                paracgsize:=OS_SINT;
+                paradef:=sinttype;
+              end;
             { Copy to stack? }
             if (paracgsize=OS_NO) or
                (use_fixed_stack) then

compiler/i386/i386att.inc

@@ -684,6 +684,8 @@
 'aesimc',
 'aeskeygenassist',
 'rdtscp',
+'movbe',
+'pclmulqdq',
 'vaddpd',
 'vaddps',
 'vaddsd',
@@ -1009,6 +1011,9 @@
 'vzeroupper',
 'andn',
 'bextr',
+'blsi',
+'blsmsk',
+'blsr',
 'tzcnt',
 'bzhi',
 'mulx',
@@ -1018,6 +1023,8 @@
 'sarx',
 'shlx',
 'shrx',
+'adcx',
+'adox',
 'vbroadcasti128',
 'vextracti128',
 'vinserti128',

compiler/i386/i386atts.inc

@@ -684,6 +684,8 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufINT,
+attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
@@ -1021,6 +1023,11 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufINT,
+attsufINT,
+attsufNONE,
+attsufNONE,
+attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,

compiler/i386/i386int.inc

@@ -684,6 +684,8 @@
 'aesimc',
 'aeskeygenassist',
 'rdtscp',
+'movbe',
+'pclmulqdq',
 'vaddpd',
 'vaddps',
 'vaddsd',
@@ -1009,6 +1011,9 @@
 'vzeroupper',
 'andn',
 'bextr',
+'blsi',
+'blsmsk',
+'blsr',
 'tzcnt',
 'bzhi',
 'mulx',
@@ -1018,6 +1023,8 @@
 'sarx',
 'shlx',
 'shrx',
+'adcx',
+'adox',
 'vbroadcasti128',
 'vextracti128',
 'vinserti128',

compiler/i386/i386nop.inc

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

compiler/i386/i386op.inc

@@ -684,6 +684,8 @@ A_AESDECLAST,
 A_AESIMC,
 A_AESKEYGENASSIST,
 A_RDTSCP,
+A_MOVBE,
+A_PCLMULQDQ,
 A_VADDPD,
 A_VADDPS,
 A_VADDSD,
@@ -1009,6 +1011,9 @@ A_VZEROALL,
 A_VZEROUPPER,
 A_ANDN,
 A_BEXTR,
+A_BLSI,
+A_BLSMSK,
+A_BLSR,
 A_TZCNT,
 A_BZHI,
 A_MULX,
@@ -1018,6 +1023,8 @@ A_RORX,
 A_SARX,
 A_SHLX,
 A_SHRX,
+A_ADCX,
+A_ADOX,
 A_VBROADCASTI128,
 A_VEXTRACTI128,
 A_VINSERTI128,

compiler/i386/i386prop.inc

@@ -684,6 +684,8 @@
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_WEAX, Ch_WEDX]),
+(Ch: [Ch_Rop1, Ch_Wop2]),
+(Ch: [Ch_All]),
 (Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
 (Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
 (Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
@@ -1009,6 +1011,9 @@
 (Ch: [Ch_All]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
+(Ch: [Ch_Rop1, Ch_Wop2, Ch_W0OverflowFlag, Ch_WCarryFlag, Ch_WSignFlag, Ch_WZeroFlag, Ch_WUParityFlag, Ch_WUAuxiliaryFlag]),
+(Ch: [Ch_Rop1, Ch_Wop2, Ch_W0OverflowFlag, Ch_WCarryFlag, Ch_WSignFlag, Ch_W0ZeroFlag, Ch_WUParityFlag, Ch_WUAuxiliaryFlag]),
+(Ch: [Ch_Rop1, Ch_Wop2, Ch_W0OverflowFlag, Ch_WCarryFlag, Ch_WSignFlag, Ch_WZeroFlag, Ch_WUParityFlag, Ch_WUAuxiliaryFlag]),
 (Ch: [Ch_Wop2, Ch_WFlags, Ch_Rop1]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
 (Ch: [Ch_REDX, Ch_Rop1, Ch_Wop2, Ch_Wop3]),
@@ -1018,6 +1023,8 @@
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
+(Ch: [Ch_Rop1, Ch_Mop2, Ch_RWCarryFlag]),
+(Ch: [Ch_Rop1, Ch_Mop2, Ch_RWOverflowFlag]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),

compiler/i386/i386tab.inc

@@ -8708,6 +8708,27 @@
     code    : #3#15#1#249;
     flags   : [if_sse4,if_sm]
   ),
+  (
+    opcode  : A_MOVBE;
+    ops     : 2;
+    optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_memory or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none);
+    code    : #208#3#15#56#240#72;
+    flags   : [if_movbe,if_sm]
+  ),
+  (
+    opcode  : A_MOVBE;
+    ops     : 2;
+    optypes : (ot_memory or ot_bits16 or ot_bits32 or ot_bits64,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none);
+    code    : #209#3#15#56#241#65;
+    flags   : [if_movbe,if_sm]
+  ),
+  (
+    opcode  : A_PCLMULQDQ;
+    ops     : 3;
+    optypes : (ot_xmmreg,ot_xmmrm,ot_immediate or ot_bits8,ot_none);
+    code    : #241#3#15#58#68#72#22;
+    flags   : [if_clmul,if_sandybridge]
+  ),
   (
     opcode  : A_VADDPD;
     ops     : 3;
@@ -13608,6 +13629,27 @@
     code    : #242#249#1#247#62#72;
     flags   : [if_bmi1,if_prot]
   ),
+  (
+    opcode  : A_BLSI;
+    ops     : 2;
+    optypes : (ot_reg32,ot_rm_gpr or ot_bits32,ot_none,ot_none);
+    code    : #242#249#1#243#60#139;
+    flags   : [if_bmi1,if_prot]
+  ),
+  (
+    opcode  : A_BLSMSK;
+    ops     : 2;
+    optypes : (ot_reg32,ot_rm_gpr or ot_bits32,ot_none,ot_none);
+    code    : #242#249#1#243#60#138;
+    flags   : [if_bmi1,if_prot]
+  ),
+  (
+    opcode  : A_BLSR;
+    ops     : 2;
+    optypes : (ot_reg32,ot_rm_gpr or ot_bits32,ot_none,ot_none);
+    code    : #242#249#1#243#60#137;
+    flags   : [if_bmi1,if_prot]
+  ),
   (
     opcode  : A_TZCNT;
     ops     : 2;
@@ -13671,6 +13713,20 @@
     code    : #220#242#249#1#247#62#72;
     flags   : [if_bmi2,if_prot]
   ),
+  (
+    opcode  : A_ADCX;
+    ops     : 2;
+    optypes : (ot_reg32,ot_rm_gpr or ot_bits32,ot_none,ot_none);
+    code    : #241#3#15#56#246#72;
+    flags   : [if_adx]
+  ),
+  (
+    opcode  : A_ADOX;
+    ops     : 2;
+    optypes : (ot_reg32,ot_rm_gpr or ot_bits32,ot_none,ot_none);
+    code    : #219#3#15#56#246#72;
+    flags   : [if_adx]
+  ),
   (
     opcode  : A_VBROADCASTI128;
     ops     : 2;

compiler/i386/n386flw.pas

@@ -58,7 +58,7 @@ implementation
     symconst,symbase,symtable,symsym,symdef,
     cgbase,cgobj,cgcpu,cgutils,tgobj,
     cpubase,htypechk,
-    parabase,paramgr,pdecsub,pass_1,pass_2,ncgutil,cga,
+    parabase,paramgr,pass_1,pass_2,ncgutil,cga,
     aasmbase,aasmtai,aasmdata,aasmcpu,procinfo,cpupi;
 
   var
@@ -168,13 +168,7 @@ constructor ti386tryfinallynode.create(l, r: TNode);
       (df_generic in current_procinfo.procdef.defoptions)
       then
       exit;
-    finalizepi:=tcgprocinfo(cprocinfo.create(current_procinfo));
-    finalizepi.force_nested;
-    finalizepi.procdef:=create_finalizer_procdef;
-    finalizepi.entrypos:=r.fileinfo;
-    finalizepi.entryswitches:=r.localswitches;
-    finalizepi.exitpos:=current_filepos; // last_endtoken_pos?
-    finalizepi.exitswitches:=current_settings.localswitches;
+    finalizepi:=tcgprocinfo(current_procinfo.create_for_outlining('$fin$',current_procinfo.procdef.struct,potype_exceptfilter,voidtype,r));
     { Regvar optimization for symbols is suppressed when using exceptions, but
       temps may be still placed into registers. This must be fixed. }
     foreachnodestatic(r,@reset_regvars,finalizepi);
@@ -196,13 +190,7 @@ constructor ti386tryfinallynode.create_implicit(l, r: TNode);
     if df_generic in current_procinfo.procdef.defoptions then
       InternalError(2013012501);
 
-    finalizepi:=tcgprocinfo(cprocinfo.create(current_procinfo));
-    finalizepi.force_nested;
-    finalizepi.procdef:=create_finalizer_procdef;
-    finalizepi.entrypos:=current_filepos;
-    finalizepi.exitpos:=current_filepos; // last_endtoken_pos?
-    finalizepi.entryswitches:=r.localswitches;
-    finalizepi.exitswitches:=current_settings.localswitches;
+    finalizepi:=tcgprocinfo(current_procinfo.create_for_outlining('$fin$',current_procinfo.procdef.struct,potype_exceptfilter,voidtype,r));
     include(finalizepi.flags,pi_has_assembler_block);
     include(finalizepi.flags,pi_do_call);
     include(finalizepi.flags,pi_uses_exceptions);

compiler/i8086/i8086att.inc

@@ -684,6 +684,8 @@
 'aesimc',
 'aeskeygenassist',
 'rdtscp',
+'movbe',
+'pclmulqdq',
 'vaddpd',
 'vaddps',
 'vaddsd',
@@ -1009,6 +1011,9 @@
 'vzeroupper',
 'andn',
 'bextr',
+'blsi',
+'blsmsk',
+'blsr',
 'tzcnt',
 'bzhi',
 'mulx',
@@ -1018,6 +1023,8 @@
 'sarx',
 'shlx',
 'shrx',
+'adcx',
+'adox',
 'vbroadcasti128',
 'vextracti128',
 'vinserti128',

compiler/i8086/i8086atts.inc

@@ -684,6 +684,8 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufINT,
+attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
@@ -1021,6 +1023,11 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufINT,
+attsufINT,
+attsufNONE,
+attsufNONE,
+attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,

compiler/i8086/i8086int.inc

@@ -684,6 +684,8 @@
 'aesimc',
 'aeskeygenassist',
 'rdtscp',
+'movbe',
+'pclmulqdq',
 'vaddpd',
 'vaddps',
 'vaddsd',
@@ -1009,6 +1011,9 @@
 'vzeroupper',
 'andn',
 'bextr',
+'blsi',
+'blsmsk',
+'blsr',
 'tzcnt',
 'bzhi',
 'mulx',
@@ -1018,6 +1023,8 @@
 'sarx',
 'shlx',
 'shrx',
+'adcx',
+'adox',
 'vbroadcasti128',
 'vextracti128',
 'vinserti128',

compiler/i8086/i8086nop.inc

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

compiler/i8086/i8086op.inc

@@ -684,6 +684,8 @@ A_AESDECLAST,
 A_AESIMC,
 A_AESKEYGENASSIST,
 A_RDTSCP,
+A_MOVBE,
+A_PCLMULQDQ,
 A_VADDPD,
 A_VADDPS,
 A_VADDSD,
@@ -1009,6 +1011,9 @@ A_VZEROALL,
 A_VZEROUPPER,
 A_ANDN,
 A_BEXTR,
+A_BLSI,
+A_BLSMSK,
+A_BLSR,
 A_TZCNT,
 A_BZHI,
 A_MULX,
@@ -1018,6 +1023,8 @@ A_RORX,
 A_SARX,
 A_SHLX,
 A_SHRX,
+A_ADCX,
+A_ADOX,
 A_VBROADCASTI128,
 A_VEXTRACTI128,
 A_VINSERTI128,

compiler/i8086/i8086prop.inc

@@ -684,6 +684,8 @@
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_WEAX, Ch_WEDX]),
+(Ch: [Ch_Rop1, Ch_Wop2]),
+(Ch: [Ch_All]),
 (Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
 (Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
 (Ch: [Ch_Wop3, Ch_Rop2, Ch_Rop1]),
@@ -1009,6 +1011,9 @@
 (Ch: [Ch_All]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
+(Ch: [Ch_Rop1, Ch_Wop2, Ch_W0OverflowFlag, Ch_WCarryFlag, Ch_WSignFlag, Ch_WZeroFlag, Ch_WUParityFlag, Ch_WUAuxiliaryFlag]),
+(Ch: [Ch_Rop1, Ch_Wop2, Ch_W0OverflowFlag, Ch_WCarryFlag, Ch_WSignFlag, Ch_W0ZeroFlag, Ch_WUParityFlag, Ch_WUAuxiliaryFlag]),
+(Ch: [Ch_Rop1, Ch_Wop2, Ch_W0OverflowFlag, Ch_WCarryFlag, Ch_WSignFlag, Ch_WZeroFlag, Ch_WUParityFlag, Ch_WUAuxiliaryFlag]),
 (Ch: [Ch_Wop2, Ch_WFlags, Ch_Rop1]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
 (Ch: [Ch_REDX, Ch_Rop1, Ch_Wop2, Ch_Wop3]),
@@ -1018,6 +1023,8 @@
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
 (Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
+(Ch: [Ch_Rop1, Ch_Mop2, Ch_RWCarryFlag]),
+(Ch: [Ch_Rop1, Ch_Mop2, Ch_RWOverflowFlag]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),

compiler/i8086/i8086tab.inc

@@ -8736,6 +8736,27 @@
     code    : #3#15#1#249;
     flags   : [if_sse4,if_sm]
   ),
+  (
+    opcode  : A_MOVBE;
+    ops     : 2;
+    optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_memory or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none);
+    code    : #208#3#15#56#240#72;
+    flags   : [if_movbe,if_sm]
+  ),
+  (
+    opcode  : A_MOVBE;
+    ops     : 2;
+    optypes : (ot_memory or ot_bits16 or ot_bits32 or ot_bits64,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none);
+    code    : #209#3#15#56#241#65;
+    flags   : [if_movbe,if_sm]
+  ),
+  (
+    opcode  : A_PCLMULQDQ;
+    ops     : 3;
+    optypes : (ot_xmmreg,ot_xmmrm,ot_immediate or ot_bits8,ot_none);
+    code    : #241#3#15#58#68#72#22;
+    flags   : [if_clmul,if_sandybridge]
+  ),
   (
     opcode  : A_VADDPD;
     ops     : 3;
@@ -13636,6 +13657,27 @@
     code    : #242#249#1#247#62#72;
     flags   : [if_bmi1,if_prot]
   ),
+  (
+    opcode  : A_BLSI;
+    ops     : 2;
+    optypes : (ot_reg32,ot_rm_gpr or ot_bits32,ot_none,ot_none);
+    code    : #242#249#1#243#60#139;
+    flags   : [if_bmi1,if_prot]
+  ),
+  (
+    opcode  : A_BLSMSK;
+    ops     : 2;
+    optypes : (ot_reg32,ot_rm_gpr or ot_bits32,ot_none,ot_none);
+    code    : #242#249#1#243#60#138;
+    flags   : [if_bmi1,if_prot]
+  ),
+  (
+    opcode  : A_BLSR;
+    ops     : 2;
+    optypes : (ot_reg32,ot_rm_gpr or ot_bits32,ot_none,ot_none);
+    code    : #242#249#1#243#60#137;
+    flags   : [if_bmi1,if_prot]
+  ),
   (
     opcode  : A_TZCNT;
     ops     : 2;
@@ -13699,6 +13741,20 @@
     code    : #220#242#249#1#247#62#72;
     flags   : [if_bmi2,if_prot]
   ),
+  (
+    opcode  : A_ADCX;
+    ops     : 2;
+    optypes : (ot_reg32,ot_rm_gpr or ot_bits32,ot_none,ot_none);
+    code    : #241#3#15#56#246#72;
+    flags   : [if_adx]
+  ),
+  (
+    opcode  : A_ADOX;
+    ops     : 2;
+    optypes : (ot_reg32,ot_rm_gpr or ot_bits32,ot_none,ot_none);
+    code    : #219#3#15#56#246#72;
+    flags   : [if_adx]
+  ),
   (
     opcode  : A_VBROADCASTI128;
     ops     : 2;

compiler/jvm/jvmdef.pas

@@ -30,7 +30,7 @@ interface
     uses
       globtype,
       node,
-      symbase,symtype;
+      symbase,symtype,symdef;
 
     { returns whether a def can make use of an extra type signature (for
       Java-style generics annotations; not use for FPC-style generics or their
@@ -90,6 +90,10 @@ interface
       array }
     procedure jvmgetarraydimdef(arrdef: tdef; out eledef: tdef; out ndim: longint);
 
+    { the JVM specs require that you add a default parameterless
+      constructor in case the programmer hasn't specified any }
+    procedure maybe_add_public_default_java_constructor(obj: tabstractrecorddef);
+
 
 implementation
 
@@ -97,7 +101,8 @@ implementation
     cutils,cclasses,constexp,
     verbose,systems,
     fmodule,
-    symtable,symconst,symsym,symdef,symcpu,symcreat,
+    symtable,symconst,symsym,symcpu,symcreat,
+    pparautl,
     defutil,paramgr;
 
 {******************************************************************
@@ -1024,4 +1029,135 @@ implementation
       end;
 
 
+
+{******************************************************************
+                   Adding extra methods
+*******************************************************************}
+    procedure maybe_add_public_default_java_constructor(obj: tabstractrecorddef);
+      var
+        sym: tsym;
+        ps: tprocsym;
+        pd: tprocdef;
+        topowner: tdefentry;
+        i: longint;
+        sstate: tscannerstate;
+        needclassconstructor: boolean;
+      begin
+        ps:=nil;
+        { if there is at least one constructor for a class, do nothing (for
+           records, we'll always also need a parameterless constructor) }
+        if not is_javaclass(obj) or
+           not (oo_has_constructor in obj.objectoptions) then
+          begin
+            { check whether the parent has a parameterless constructor that we can
+              call (in case of a class; all records will derive from
+              java.lang.Object or a shim on top of that with a parameterless
+              constructor) }
+            if is_javaclass(obj) then
+              begin
+                pd:=nil;
+                { childof may not be assigned in case of a parser error }
+                if not assigned(tobjectdef(obj).childof) then
+                  exit;
+                sym:=tsym(tobjectdef(obj).childof.symtable.find('CREATE'));
+                if assigned(sym) and
+                   (sym.typ=procsym) then
+                  pd:=tprocsym(sym).find_bytype_parameterless(potype_constructor);
+                if not assigned(pd) then
+                  begin
+                    Message(sym_e_no_matching_inherited_parameterless_constructor);
+                    exit
+                  end;
+              end;
+            { we call all constructors CREATE, because they don't have a name in
+              Java and otherwise we can't determine whether multiple overloads
+              are created with the same parameters }
+            sym:=tsym(obj.symtable.find('CREATE'));
+            if assigned(sym) then
+              begin
+                { does another, non-procsym, symbol already exist with that name? }
+                if (sym.typ<>procsym) then
+                  begin
+                    Message1(sym_e_duplicate_id_create_java_constructor,sym.realname);
+                    exit;
+                  end;
+                ps:=tprocsym(sym);
+                { is there already a parameterless function/procedure create? }
+                pd:=ps.find_bytype_parameterless(potype_function);
+                if not assigned(pd) then
+                  pd:=ps.find_bytype_parameterless(potype_procedure);
+                if assigned(pd) then
+                  begin
+                    Message1(sym_e_duplicate_id_create_java_constructor,pd.fullprocname(false));
+                    exit;
+                  end;
+              end;
+            if not assigned(sym) then
+              begin
+                ps:=cprocsym.create('Create');
+                obj.symtable.insert(ps);
+              end;
+            { determine symtable level }
+            topowner:=obj;
+            while not(topowner.owner.symtabletype in [staticsymtable,globalsymtable]) do
+              topowner:=topowner.owner.defowner;
+            { create procdef }
+            pd:=cprocdef.create(topowner.owner.symtablelevel+1,true);
+            if df_generic in obj.defoptions then
+              include(pd.defoptions,df_generic);
+            { method of this objectdef }
+            pd.struct:=obj;
+            { associated procsym }
+            pd.procsym:=ps;
+            { constructor }
+            pd.proctypeoption:=potype_constructor;
+            { needs to be exported }
+            include(pd.procoptions,po_global);
+            { by default do not include this routine when looking for overloads }
+            include(pd.procoptions,po_ignore_for_overload_resolution);
+            { generate anonymous inherited call in the implementation }
+            pd.synthetickind:=tsk_anon_inherited;
+            { public }
+            pd.visibility:=vis_public;
+            { result type }
+            pd.returndef:=obj;
+            { calling convention, self, ... (not for advanced records, for those
+              this is handled later) }
+            if obj.typ=recorddef then
+              handle_calling_convention(pd,[hcc_declaration,hcc_check])
+            else
+              handle_calling_convention(pd,hcc_default_actions_intf);
+            { register forward declaration with procsym }
+            proc_add_definition(pd);
+          end;
+
+        { also add class constructor if class fields that need wrapping, and
+          if none was defined }
+        if obj.find_procdef_bytype(potype_class_constructor)=nil then
+          begin
+            needclassconstructor:=false;
+            for i:=0 to obj.symtable.symlist.count-1 do
+              begin
+                if (tsym(obj.symtable.symlist[i]).typ=staticvarsym) and
+                   jvmimplicitpointertype(tstaticvarsym(obj.symtable.symlist[i]).vardef) then
+                  begin
+                    needclassconstructor:=true;
+                    break;
+                  end;
+              end;
+            if needclassconstructor then
+              begin
+                replace_scanner('custom_class_constructor',sstate);
+                if str_parse_method_dec('constructor fpc_jvm_class_constructor;',potype_class_constructor,true,obj,pd) then
+                  pd.synthetickind:=tsk_empty
+                else
+                  internalerror(2011040501);
+                restore_scanner(sstate);
+              end;
+          end;
+      end;
+
+
+
+
 end.

compiler/jvm/njvminl.pas

@@ -521,7 +521,7 @@ implementation
     function tjvminlinenode.first_setlength: tnode;
       begin
         { reverse the parameter order so we can process them more easily }
-        left:=reverseparameters(tcallparanode(left));
+        reverseparameters(tcallparanode(left));
         { treat setlength(x,0) specially: used to init uninitialised locations }
         if not is_shortstring(left.resultdef) and
            not assigned(tcallparanode(tcallparanode(left).right).right) and
@@ -535,7 +535,7 @@ implementation
         { strings are handled the same as on other platforms }
         if left.resultdef.typ=stringdef then
           begin
-            left:=reverseparameters(tcallparanode(left));
+            reverseparameters(tcallparanode(left));
             result:=inherited first_setlength;
             exit;
           end;

compiler/jvm/pjvm.pas

@@ -30,10 +30,6 @@ interface
       globtype,
       symconst,symtype,symbase,symdef,symsym;
 
-    { the JVM specs require that you add a default parameterless
-      constructor in case the programmer hasn't specified any }
-    procedure maybe_add_public_default_java_constructor(obj: tabstractrecorddef);
-
     { records are emulated via Java classes. They require a default constructor
       to initialise temps, a deep copy helper for assignments, and clone()
       to initialse dynamic arrays }
@@ -56,138 +52,11 @@ implementation
     verbose,globals,systems,
     fmodule,
     parabase,aasmdata,
-    pdecsub,ngenutil,pparautl,
+    ngenutil,pparautl,
     symtable,symcreat,defcmp,jvmdef,symcpu,nobj,
     defutil,paramgr;
 
 
-    { the JVM specs require that you add a default parameterless
-      constructor in case the programmer hasn't specified any }
-    procedure maybe_add_public_default_java_constructor(obj: tabstractrecorddef);
-      var
-        sym: tsym;
-        ps: tprocsym;
-        pd: tprocdef;
-        topowner: tdefentry;
-        i: longint;
-        sstate: tscannerstate;
-        needclassconstructor: boolean;
-      begin
-        ps:=nil;
-        { if there is at least one constructor for a class, do nothing (for
-           records, we'll always also need a parameterless constructor) }
-        if not is_javaclass(obj) or
-           not (oo_has_constructor in obj.objectoptions) then
-          begin
-            { check whether the parent has a parameterless constructor that we can
-              call (in case of a class; all records will derive from
-              java.lang.Object or a shim on top of that with a parameterless
-              constructor) }
-            if is_javaclass(obj) then
-              begin
-                pd:=nil;
-                { childof may not be assigned in case of a parser error }
-                if not assigned(tobjectdef(obj).childof) then
-                  exit;
-                sym:=tsym(tobjectdef(obj).childof.symtable.find('CREATE'));
-                if assigned(sym) and
-                   (sym.typ=procsym) then
-                  pd:=tprocsym(sym).find_bytype_parameterless(potype_constructor);
-                if not assigned(pd) then
-                  begin
-                    Message(sym_e_no_matching_inherited_parameterless_constructor);
-                    exit
-                  end;
-              end;
-            { we call all constructors CREATE, because they don't have a name in
-              Java and otherwise we can't determine whether multiple overloads
-              are created with the same parameters }
-            sym:=tsym(obj.symtable.find('CREATE'));
-            if assigned(sym) then
-              begin
-                { does another, non-procsym, symbol already exist with that name? }
-                if (sym.typ<>procsym) then
-                  begin
-                    Message1(sym_e_duplicate_id_create_java_constructor,sym.realname);
-                    exit;
-                  end;
-                ps:=tprocsym(sym);
-                { is there already a parameterless function/procedure create? }
-                pd:=ps.find_bytype_parameterless(potype_function);
-                if not assigned(pd) then
-                  pd:=ps.find_bytype_parameterless(potype_procedure);
-                if assigned(pd) then
-                  begin
-                    Message1(sym_e_duplicate_id_create_java_constructor,pd.fullprocname(false));
-                    exit;
-                  end;
-              end;
-            if not assigned(sym) then
-              begin
-                ps:=cprocsym.create('Create');
-                obj.symtable.insert(ps);
-              end;
-            { determine symtable level }
-            topowner:=obj;
-            while not(topowner.owner.symtabletype in [staticsymtable,globalsymtable]) do
-              topowner:=topowner.owner.defowner;
-            { create procdef }
-            pd:=cprocdef.create(topowner.owner.symtablelevel+1,true);
-            if df_generic in obj.defoptions then
-              include(pd.defoptions,df_generic);
-            { method of this objectdef }
-            pd.struct:=obj;
-            { associated procsym }
-            pd.procsym:=ps;
-            { constructor }
-            pd.proctypeoption:=potype_constructor;
-            { needs to be exported }
-            include(pd.procoptions,po_global);
-            { by default do not include this routine when looking for overloads }
-            include(pd.procoptions,po_ignore_for_overload_resolution);
-            { generate anonymous inherited call in the implementation }
-            pd.synthetickind:=tsk_anon_inherited;
-            { public }
-            pd.visibility:=vis_public;
-            { result type }
-            pd.returndef:=obj;
-            { calling convention, self, ... (not for advanced records, for those
-              this is handled later) }
-            if obj.typ=recorddef then
-              handle_calling_convention(pd,[hcc_check])
-            else
-              handle_calling_convention(pd,hcc_all);
-            { register forward declaration with procsym }
-            proc_add_definition(pd);
-          end;
-
-        { also add class constructor if class fields that need wrapping, and
-          if none was defined }
-        if obj.find_procdef_bytype(potype_class_constructor)=nil then
-          begin
-            needclassconstructor:=false;
-            for i:=0 to obj.symtable.symlist.count-1 do
-              begin
-                if (tsym(obj.symtable.symlist[i]).typ=staticvarsym) and
-                   jvmimplicitpointertype(tstaticvarsym(obj.symtable.symlist[i]).vardef) then
-                  begin
-                    needclassconstructor:=true;
-                    break;
-                  end;
-              end;
-            if needclassconstructor then
-              begin
-                replace_scanner('custom_class_constructor',sstate);
-                if str_parse_method_dec('constructor fpc_jvm_class_constructor;',potype_class_constructor,true,obj,pd) then
-                  pd.synthetickind:=tsk_empty
-                else
-                  internalerror(2011040501);
-                restore_scanner(sstate);
-              end;
-          end;
-      end;
-
-
     procedure add_java_default_record_methods_intf(def: trecorddef);
       var
         sstate: tscannerstate;

compiler/jvm/symcpu.pas

@@ -109,6 +109,7 @@ type
     exprasmlist      : TAsmList;
     function  jvmmangledbasename(signature: boolean): TSymStr;
     function mangledname: TSymStr; override;
+    function getfuncretsyminfo(out ressym: tsym; out resdef: tdef): boolean; override;
     destructor destroy; override;
   end;
   tcpuprocdefclass = class of tcpuprocdef;
@@ -221,7 +222,7 @@ implementation
   uses
     verbose,cutils,cclasses,globals,
     symconst,symbase,symtable,symcreat,jvmdef,
-    pdecsub,pjvm,
+    pdecsub,pparautl,pjvm,
     paramgr;
 
 
@@ -489,9 +490,9 @@ implementation
           begin
             { calling convention, self, ... }
             if obj.typ=recorddef then
-              handle_calling_convention(pd,[hcc_check])
+              handle_calling_convention(pd,[hcc_declaration,hcc_check])
             else
-              handle_calling_convention(pd,hcc_all);
+              handle_calling_convention(pd,hcc_default_actions_intf);
             { register forward declaration with procsym }
             proc_add_definition(pd);
           end;
@@ -751,6 +752,15 @@ implementation
         result:=_mangledname;
     end;
 
+  function tcpuprocdef.getfuncretsyminfo(out ressym: tsym; out resdef: tdef): boolean;
+    begin
+      { constructors don't have a result on the JVM platform }
+      if proctypeoption<>potype_constructor then
+        result:=inherited
+      else
+        result:=false;
+    end;
+
 
   destructor tcpuprocdef.destroy;
     begin

compiler/llvm/agllvm.pas

@@ -979,6 +979,8 @@ implementation
             writer.AsmWrite(' returns_twice');
           if po_inline in pd.procoptions then
             writer.AsmWrite(' inlinehint');
+          if po_noinline in pd.procoptions then
+            writer.AsmWrite(' noinline');
           { ensure that functions that happen to have the same name as a
             standard C library function, but which are implemented in Pascal,
             are not considered to have the same semantics as the C function with

compiler/llvm/hlcgllvm.pas

@@ -434,6 +434,9 @@ implementation
     callparas:=tfplist.Create;
     for i:=0 to high(paras) do
       begin
+        { skip parameters without data }
+        if paras[i]^.isempty then
+          continue;
         paraloc:=paras[i]^.location;
         while assigned(paraloc) do
           begin
@@ -550,8 +553,14 @@ implementation
 
 
   procedure thlcgllvm.a_load_const_reg(list: TAsmList; tosize: tdef; a: tcgint; register: tregister);
+    var
+      fromsize: tdef;
     begin
-      list.concat(taillvm.op_reg_size_const_size(llvmconvop(ptrsinttype,tosize,false),register,ptrsinttype,a,tosize))
+      if tosize.size<=ptrsinttype.size then
+        fromsize:=ptrsinttype
+      else
+        fromsize:=tosize;
+      list.concat(taillvm.op_reg_size_const_size(llvmconvop(fromsize,tosize,false),register,fromsize,a,tosize))
     end;
 
 
@@ -1395,7 +1404,7 @@ implementation
         internalerror(2015122504);
       current_asmdata.getjumplabel(hl);
       a_cmp_const_loc_label(list,llvmbool1type,OC_EQ,0,ovloc,hl);
-      g_call_system_proc(list,'fpc_overflow',[],nil);
+      g_call_system_proc(list,'fpc_overflow',[],nil).resetiftemp;
       a_label(list,hl);
     end;
 
@@ -1621,8 +1630,12 @@ implementation
 
 
   procedure thlcgllvm.gen_load_loc_function_result(list: TAsmList; vardef: tdef; const l: tlocation);
+    var
+      retlocpara: tcgpara;
     begin
-      gen_load_loc_cgpara(list,vardef,l,get_call_result_cgpara(current_procinfo.procdef,nil));
+      retlocpara:=get_call_result_cgpara(current_procinfo.procdef,nil);
+      gen_load_loc_cgpara(list,vardef,l,retlocpara);
+      retlocpara.resetiftemp;
     end;
 
 

compiler/llvm/llvmdef.pas

@@ -682,9 +682,19 @@ implementation
             exit
           end;
         if withparaname then
-          paraloc:=hp.paraloc[calleeside].location
+          begin
+            { don't add parameters that don't take up registers or stack space;
+              clang doesn't either and some LLVM backends don't support them }
+            if hp.paraloc[calleeside].isempty then
+              exit;
+            paraloc:=hp.paraloc[calleeside].location
+          end
         else
-          paraloc:=hp.paraloc[callerside].location;
+          begin
+            if hp.paraloc[callerside].isempty then
+              exit;
+            paraloc:=hp.paraloc[callerside].location;
+          end;
         repeat
           usedef:=paraloc^.def;
           llvmextractvalueextinfo(hp.vardef,usedef,signext);

compiler/llvm/llvmpara.pas

@@ -28,7 +28,7 @@ unit llvmpara;
     uses
       globtype,aasmdata,
       symconst,symtype,symdef,symsym,
-      parabase,
+      parabase,cgbase,
       cpupara;
 
     type
@@ -53,6 +53,8 @@ unit llvmpara;
        private
         procedure set_llvm_paraloc_name(p: tabstractprocdef; hp: tparavarsym; var para: tcgpara);
         procedure add_llvm_callee_paraloc_names(p: tabstractprocdef);
+        procedure reducetosingleregparaloc(paraloc: PCGParaLocation; def: tdef; reg: tregister);
+        procedure reduceparalocs(p: tabstractprocdef; side: tcallercallee);
       end;
 
 
@@ -63,7 +65,7 @@ unit llvmpara;
       aasmbase,
       llvmsym,
       paramgr,defutil,llvmdef,
-      cgbase,cgutils,tgobj,hlcgobj;
+      cgutils,tgobj,hlcgobj;
 
   { tllvmparamanager }
 
@@ -88,10 +90,49 @@ unit llvmpara;
     end;
 
 
-  procedure tllvmparamanager.createtempparaloc(list: TAsmList; calloption: tproccalloption; parasym: tparavarsym; can_use_final_stack_loc: boolean; var cgpara: TCGPara);
+  procedure tllvmparamanager.reducetosingleregparaloc(paraloc: PCGParaLocation; def: tdef; reg: tregister);
     var
-      paraloc,
       nextloc: pcgparalocation;
+    begin
+      paraloc^.def:=def;
+      paraloc^.size:=def_cgsize(def);
+      paraloc^.register:=reg;
+      paraloc^.shiftval:=0;
+      { remove all other paralocs }
+      while assigned(paraloc^.next) do
+        begin
+          nextloc:=paraloc^.next;
+          paraloc^.next:=nextloc^.next;
+          dispose(nextloc);
+        end;
+    end;
+
+
+  procedure tllvmparamanager.reduceparalocs(p: tabstractprocdef; side: tcallercallee);
+    var
+      paranr: longint;
+      hp: tparavarsym;
+      paraloc: PCGParaLocation;
+    begin
+      for paranr:=0 to p.paras.count-1 do
+        begin
+          hp:=tparavarsym(p.paras[paranr]);
+          paraloc:=hp.paraloc[side].location;
+          if assigned(paraloc) and
+             assigned(paraloc^.next) and
+             (hp.paraloc[side].def.typ in [orddef,enumdef,floatdef]) then
+            begin
+              if not(paraloc^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER]) then
+                internalerror(2019011902);
+              reducetosingleregparaloc(paraloc,hp.paraloc[side].def,paraloc^.register);
+            end;
+        end;
+    end;
+
+  procedure tllvmparamanager.createtempparaloc(list: TAsmList; calloption: tproccalloption; parasym: tparavarsym; can_use_final_stack_loc: boolean; var cgpara: TCGPara);
+    var
+      paraloc: pcgparalocation;
+      paralocdef: tdef;
     begin
       inherited;
       paraloc:=cgpara.location;
@@ -101,6 +142,14 @@ unit llvmpara;
         begin
           if vo_is_funcret in parasym.varoptions then
             paraloc^.retvalloc:=true;
+          { ordinal parameters must be passed as a single paraloc }
+          if (cgpara.def.typ in [orddef,enumdef,floatdef]) and
+             assigned(paraloc^.next) then
+            begin
+              paraloc^.loc:=LOC_REGISTER;
+              reducetosingleregparaloc(paraloc,cgpara.def,hlcg.getintregister(list,cgpara.def));
+            end;
+
           { varargs parameters do not have a parasym.owner, but they're always
             by value }
           if (assigned(parasym.owner) and
@@ -149,18 +198,9 @@ unit llvmpara;
                 a pointer to the value that it should place on the stack (or
                 passed in registers, in some cases) }
               paraloc^.llvmvalueloc:=false;
-              paraloc^.def:=cpointerdef.getreusable_no_free(paraloc^.def);
-              paraloc^.size:=def_cgsize(paraloc^.def);
               paraloc^.loc:=LOC_REGISTER;
-              paraloc^.register:=hlcg.getaddressregister(list,paraloc^.def);
-              paraloc^.shiftval:=0;
-              { remove all other paralocs }
-              while assigned(paraloc^.next) do
-                begin
-                  nextloc:=paraloc^.next;
-                  paraloc^.next:=nextloc^.next;
-                  dispose(nextloc);
-                end;
+              paralocdef:=cpointerdef.getreusable_no_free(paraloc^.def);
+              reducetosingleregparaloc(paraloc,paralocdef,hlcg.getaddressregister(list,paralocdef));
             end;
           paraloc^.llvmloc.loc:=paraloc^.loc;
           paraloc^.llvmloc.reg:=paraloc^.register;
@@ -176,8 +216,16 @@ unit llvmpara;
         (a list of parameters and their types), but they correspond more
         closely to parameter locations than to parameters -> add names to the
         locations }
-      if side=calleeside then
-        add_llvm_callee_paraloc_names(p)
+      if (side=calleeside) and
+         not(po_assembler in p.procoptions) then
+        begin
+          add_llvm_callee_paraloc_names(p);
+          reduceparalocs(p,side);
+        end
+      else if side=callerside then
+        begin
+          reduceparalocs(p,side);
+        end;
     end;
 
 
@@ -191,6 +239,16 @@ unit llvmpara;
         paraloc^.llvmvalueloc:=true;
         paraloc:=paraloc^.next;
       until not assigned(paraloc);
+      paraloc:=result.location;
+      if assigned(paraloc^.next) and
+         (result.def.typ in [orddef,enumdef,floatdef]) and
+         ((side=callerside) or
+          not(po_assembler in p.procoptions)) then
+        begin
+          if not(paraloc^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER]) then
+            internalerror(2019011902);
+          reducetosingleregparaloc(paraloc,result.def,paraloc^.register);
+        end;
     end;
 
 

compiler/msg/errore.msg

@@ -1582,6 +1582,18 @@ parser_w_operator_overloaded_hidden_3=03347_W_Operator overload hidden by intern
 % (in case of dynamic arrays that is the modeswitch \var{ArrayOperators}).
 parser_e_threadvar_must_be_class=03348_E_Thread variables inside classes or records must be class variables
 % A \var{threadvar} section inside a class or record was started without it being prefixed by \var{class}.
+parser_e_only_static_members_via_object_type=03349_E_Only static methods and static variables can be referenced through an object type
+% This error occurs in a situation like the following:
+% \begin{verbatim}
+% Type
+%    TObj = object
+%      procedure test;
+%    end;
+%
+% begin
+%   TObj.test;
+% \end{verbatim}
+% \var{test} is not a static method and hence cannot be called through a type, but only using an instance.
 %
 %
 % \end{description}
@@ -2028,7 +2040,7 @@ type_w_empty_constant_range_set=04125_W_The first value of a set constructur ran
 #
 # Symtable
 #
-# 05097 is the last used one
+# 05098 is the last used one
 #
 % \section{Symbol handling}
 % This section lists all the messages that concern the handling of symbols.
@@ -2344,6 +2356,8 @@ sym_e_generic_type_param_mismatch=05096_E_Generic type parameter "$1" does not m
 sym_e_generic_type_param_decl=05097_E_Generic type parameter declared as "$1"
 % Shows what the generic type parameter was originally declared as if a mismatch
 % is found between a declaration and the definition.
+sym_e_type_must_be_rec_or_object=05098_E_Record or object type expected
+% The variable or expression isn't of the type \var{record} or \var{object}.
 % \end{description}
 #
 # Codegenerator
@@ -3007,6 +3021,9 @@ exec_n_backquote_cat_file_not_found=09033_N_File "$1" not found for backquoted c
 exec_w_init_file_not_found=09034_W_"$1" not found, this will probably cause a linking failure
 % The compiler adds certain startup code files to the linker only when they are found.
 % If they are not found, they are not added and this might cause a linking failure.
+% If the system has gcc installed, running \var{gcc --print-file-name <filename>} might return the path to the file.
+% Add this path in your \var{fpc.cfg} using the switch \var{-Fl} to fix this error. This requires though,
+% that gcc targets the same target as FPC.
 %
 %\end{description}
 # EndOfTeX

compiler/msgidx.inc

@@ -459,6 +459,7 @@ const
   parser_e_invalid_internal_function_index=03346;
   parser_w_operator_overloaded_hidden_3=03347;
   parser_e_threadvar_must_be_class=03348;
+  parser_e_only_static_members_via_object_type=03349;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -659,6 +660,7 @@ const
   sym_w_duplicate_id=05095;
   sym_e_generic_type_param_mismatch=05096;
   sym_e_generic_type_param_decl=05097;
+  sym_e_type_must_be_rec_or_object=05098;
   cg_e_parasize_too_big=06009;
   cg_e_file_must_call_by_reference=06012;
   cg_e_cant_use_far_pointer_there=06013;
@@ -1105,9 +1107,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 82667;
+  MsgTxtSize = 82796;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,106,349,126,98,59,142,34,221,67,
+    28,106,350,126,99,59,142,34,221,67,
     62,20,30,1,1,1,1,1,1,1
   );

compiler/nadd.pas

@@ -3694,7 +3694,7 @@ implementation
                    we're done here }
                  expectloc:=LOC_REGISTER;
                end
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
               { is there a 64 bit type ? }
              else if (torddef(ld).ordtype in [s64bit,u64bit,scurrency]) then
                begin
@@ -3706,7 +3706,22 @@ implementation
                   else
                     expectloc:=LOC_JUMP;
                end
-{$endif cpu64bitalu}
+{$else if defined(llvm) and cpu32bitalu}
+            { llvm does not support 128 bit math on 32 bit targets, which is
+              necessary for overflow checking 64 bit operations }
+            else if (torddef(ld).ordtype in [s64bit,u64bit,scurrency]) and
+                    (cs_check_overflow in current_settings.localswitches) and
+                    (nodetype in [addn,subn,muln]) then
+              begin
+                result := first_add64bitint;
+                if assigned(result) then
+                  exit;
+                 if nodetype in [addn,subn,muln,andn,orn,xorn] then
+                   expectloc:=LOC_REGISTER
+                 else
+                   expectloc:=LOC_JUMP;
+              end
+{$endif not(cpu64bitalu) and not(cpuhighleveltarget)}
              { generic 32bit conversion }
              else
                begin
@@ -3740,8 +3755,10 @@ implementation
 {$endif cpuneedsmulhelper}
                   if nodetype in [addn,subn,muln,andn,orn,xorn] then
                     expectloc:=LOC_REGISTER
+{$if not defined(cpuhighleveltarget)}
                   else if torddef(ld).size>sizeof(aint) then
                     expectloc:=LOC_JUMP
+{$endif}
                   else
                     expectloc:=LOC_FLAGS;
               end;

compiler/ncal.pas

@@ -292,7 +292,7 @@ interface
          dct_propput
        );
 
-    function reverseparameters(p: tcallparanode): tcallparanode;
+    procedure reverseparameters(var p: tcallparanode);
     function translate_disp_call(selfnode,parametersnode: tnode; calltype: tdispcalltype; const methodname : ansistring;
       dispid : longint;resultdef : tdef) : tnode;
 
@@ -333,21 +333,23 @@ implementation
                              HELPERS
  ****************************************************************************}
 
-    function reverseparameters(p: tcallparanode): tcallparanode;
+    procedure reverseparameters(var p: tcallparanode);
       var
+        tmpp,
         hp1, hp2: tcallparanode;
       begin
         hp1:=nil;
-        while assigned(p) do
+        tmpp:=p;
+        while assigned(tmpp) do
           begin
              { pull out }
-             hp2:=p;
-             p:=tcallparanode(p.right);
+             hp2:=tmpp;
+             tmpp:=tcallparanode(tmpp.right);
              { pull in }
              hp2.right:=hp1;
              hp1:=hp2;
           end;
-        reverseparameters:=hp1;
+        p:=hp1;
       end;
 
     function translate_disp_call(selfnode,parametersnode: tnode; calltype: tdispcalltype; const methodname : ansistring;
@@ -4627,6 +4629,17 @@ implementation
 
     function tcallnode.paraneedsinlinetemp(para: tcallparanode; const pushconstaddr, complexpara: boolean): boolean;
       begin
+        { We don't need temps for parameters that are already temps, except if
+          the passed temp could be put in a regvar while the parameter inside
+          the routine cannot be (e.g., because its address is taken in the
+          routine), or if the temp is a const and the parameter gets modified }
+        if (para.left.nodetype=temprefn) and
+           (not(ti_may_be_in_reg in ttemprefnode(para.left).tempflags) or
+            not(tparavarsym(para.parasym).varregable in [vr_none,vr_addr])) and
+           (not(ti_const in ttemprefnode(para.left).tempflags) or
+            (tparavarsym(para.parasym).varstate in [vs_initialised,vs_declared,vs_read])) then
+          exit(false);
+
         { We need a temp if the passed value will not be in memory, while
           the parameter inside the routine must be in memory }
         if (tparavarsym(para.parasym).varregable in [vr_none,vr_addr]) and
@@ -4760,17 +4773,6 @@ implementation
            )
           );
 
-        { We don't need temps for parameters that are already temps, except if
-          the passed temp could be put in a regvar while the parameter inside
-          the routine cannot be (e.g., because its address is taken in the
-          routine), or if the temp is a const and the parameter gets modified }
-        if (para.left.nodetype=temprefn) and
-           (not(ti_may_be_in_reg in ttemprefnode(para.left).tempflags) or
-            not(tparavarsym(para.parasym).varregable in [vr_none,vr_addr])) and
-           (not(ti_const in ttemprefnode(para.left).tempflags) or
-            (tparavarsym(para.parasym).varstate in [vs_initialised,vs_declared,vs_read])) then
-          exit;
-
         { check if we have to create a temp, assign the parameter's
           contents to that temp and then substitute the parameter
           with the temp everywhere in the function                  }

compiler/ncgadd.pas

@@ -146,7 +146,7 @@ interface
     procedure tcgaddnode.set_result_location_reg;
       begin
         location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
         if location.size in [OS_64,OS_S64] then
           begin
             location.register64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_32);
@@ -435,7 +435,7 @@ interface
               else
                  internalerror(200203247);
             end;
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
             if right.location.size in [OS_64,OS_S64] then
               begin
                 if right.location.loc <> LOC_CONSTANT then
@@ -522,7 +522,7 @@ interface
           (right.resultdef.typ<>pointerdef) and
           (cs_check_overflow in current_settings.localswitches) and not(nf_internal in flags);
 
-{$ifdef cpu64bitalu}
+{$if defined(cpu64bitalu) or defined(cpuhighleveltarget)}
         case nodetype of
           xorn,orn,andn,addn:
             begin
@@ -563,7 +563,7 @@ interface
           else
             internalerror(2002072803);
         end;
-{$else cpu64bitalu}
+{$else cpu64bitalu or cpuhighleveltarget}
         case nodetype of
           xorn,orn,andn,addn:
             begin
@@ -609,7 +609,7 @@ interface
           else
             internalerror(2002072803);
         end;
-{$endif cpu64bitalu}
+{$endif cpu64bitalu or cpuhighleveltarget}
 
         { emit overflow check if enabled }
         if checkoverflow then

compiler/ncgbas.pas

@@ -625,14 +625,14 @@ interface
                 begin
                   { make sure the register allocator doesn't reuse the }
                   { register e.g. in the middle of a loop              }
-{$if defined(cpu32bitalu)}
+{$if defined(cpu32bitalu) and not defined(cpuhighleveltarget)}
                   if tempinfo^.location.size in [OS_64,OS_S64] then
                     begin
                       cg.a_reg_sync(current_asmdata.CurrAsmList,tempinfo^.location.register64.reghi);
                       cg.a_reg_sync(current_asmdata.CurrAsmList,tempinfo^.location.register64.reglo);
                     end
                   else
-{$elseif defined(cpu16bitalu)}
+{$elseif defined(cpu16bitalu) and not defined(cpuhighleveltarget)}
                   if tempinfo^.location.size in [OS_64,OS_S64] then
                     begin
                       cg.a_reg_sync(current_asmdata.CurrAsmList,tempinfo^.location.register64.reghi);
@@ -647,7 +647,7 @@ interface
                       cg.a_reg_sync(current_asmdata.CurrAsmList,cg.GetNextReg(tempinfo^.location.register));
                     end
                   else
-{$elseif defined(cpu8bitalu)}
+{$elseif defined(cpu8bitalu) and not defined(cpuhighleveltarget)}
                   if tempinfo^.location.size in [OS_64,OS_S64] then
                     begin
                       cg.a_reg_sync(current_asmdata.CurrAsmList,tempinfo^.location.register64.reghi);

compiler/ncgcal.pas

@@ -611,7 +611,7 @@ implementation
             case location.loc of
               LOC_REGISTER :
                 begin
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                   if location.size in [OS_64,OS_S64] then
                     cg64.a_load64_reg_loc(current_asmdata.CurrAsmList,location.register64,funcretnode.location)
                   else

compiler/ncgcnv.pas

@@ -248,7 +248,7 @@ interface
             end;
           LOC_REGISTER,LOC_CREGISTER :
             begin
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
               if left.location.size in [OS_64,OS_S64] then
                begin
                  hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
@@ -256,7 +256,7 @@ interface
                  cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reghi,hregister);
                end
               else
-{$endif cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
                begin
                  cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register);
                end;

compiler/ncgcon.pas

@@ -188,11 +188,11 @@ implementation
     procedure tcgordconstnode.pass_generate_code;
       begin
          location_reset(location,LOC_CONSTANT,def_cgsize(resultdef));
-{$ifdef cpu64bitalu}
+{$if defined(cpu64bitalu) or defined(cpuhighleveltarget)}
          location.value:=value.svalue;
-{$else cpu64bitalu}
+{$else cpu64bitalu or cpuhighleveltarget}
          location.value64:=value.svalue;
-{$endif cpu64bitalu}
+{$endif cpu64bitalu or cpuhighleveltarget}
       end;
 
 

compiler/ncgflw.pas

@@ -198,7 +198,7 @@ implementation
          if not(cs_opt_size in current_settings.optimizerswitches) then
             { align loop target, as an unconditional jump is done before,
               use jump align which assume that the instructions inserted as alignment are never executed }
-            current_asmdata.CurrAsmList.concat(cai_align.create_max(current_settings.alignment.jumpalign,current_settings.alignment.jumpalignmax));
+            current_asmdata.CurrAsmList.concat(cai_align.create_max(current_settings.alignment.jumpalign,current_settings.alignment.jumpalignskipmax));
 
          hlcg.a_label(current_asmdata.CurrAsmList,lloop);
 
@@ -321,7 +321,7 @@ implementation
                    ;
                    hlcg.a_jmp_always(current_asmdata.CurrAsmList,hl);
                    if not(cs_opt_size in current_settings.optimizerswitches) then
-                     current_asmdata.CurrAsmList.concat(cai_align.create_max(current_settings.alignment.jumpalign,current_settings.alignment.jumpalignmax));
+                     current_asmdata.CurrAsmList.concat(cai_align.create_max(current_settings.alignment.jumpalign,current_settings.alignment.jumpalignskipmax));
                 end;
               hlcg.a_label(current_asmdata.CurrAsmList,left.location.falselabel);
               secondpass(t1);
@@ -351,13 +351,13 @@ implementation
                 end;
 *)
               if not(cs_opt_size in current_settings.optimizerswitches) then
-                current_asmdata.CurrAsmList.concat(cai_align.create_max(current_settings.alignment.coalescealign,current_settings.alignment.coalescealignmax));
+                current_asmdata.CurrAsmList.concat(cai_align.create_max(current_settings.alignment.coalescealign,current_settings.alignment.coalescealignskipmax));
               hlcg.a_label(current_asmdata.CurrAsmList,left.location.falselabel);
            end;
          if not(assigned(right)) then
            begin
              if not(cs_opt_size in current_settings.optimizerswitches) then
-               current_asmdata.CurrAsmList.concat(cai_align.create_max(current_settings.alignment.coalescealign,current_settings.alignment.coalescealignmax));
+               current_asmdata.CurrAsmList.concat(cai_align.create_max(current_settings.alignment.coalescealign,current_settings.alignment.coalescealignskipmax));
              hlcg.a_label(current_asmdata.CurrAsmList,left.location.truelabel);
            end;
 

compiler/ncginl.pas

@@ -82,9 +82,9 @@ implementation
       ncon,ncal,
       tgobj,ncgutil,
       cgutils,cgobj,hlcgobj
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
       ,cg64f32
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
       ;
 
 
@@ -322,7 +322,7 @@ implementation
         if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
           hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
 
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
         if def_cgsize(resultdef) in [OS_64,OS_S64] then
           begin
             location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
@@ -330,7 +330,7 @@ implementation
             cg64.a_op64_const_reg_reg(current_asmdata.CurrAsmList,cgop,def_cgsize(resultdef),1,left.location.register64,location.register64);
           end
         else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
           begin
             location.register:=hlcg.getregisterfordef(current_asmdata.CurrAsmList,resultdef);
             hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,cgop,resultdef,1,left.location.register,location.register);
@@ -352,17 +352,17 @@ implementation
         var
          addvalue : TConstExprInt;
          addconstant : boolean;
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
          hregisterhi,
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
          hregister : tregister;
         begin
           { set defaults }
           addconstant:=true;
           hregister:=NR_NO;
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
           hregisterhi:=NR_NO;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
 
           { first secondpass second argument, because if the first arg }
           { is used in that expression then SSL may move it to another }
@@ -398,9 +398,9 @@ implementation
                 begin
                   hlcg.location_force_reg(current_asmdata.CurrAsmList,tcallparanode(tcallparanode(left).right).left.location,tcallparanode(tcallparanode(left).right).left.resultdef,second_incdec_tempregdef,addvalue<=1);
                   hregister:=tcallparanode(tcallparanode(left).right).left.location.register;
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                   hregisterhi:=tcallparanode(tcallparanode(left).right).left.location.register64.reghi;
-{$endif not cpu64bitalu}
+{$endif not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                   { insert multiply with addvalue if its >1 }
                   if addvalue>1 then
                     hlcg.a_op_const_reg(current_asmdata.CurrAsmList,OP_IMUL,left.resultdef,addvalue.svalue,hregister);
@@ -410,11 +410,11 @@ implementation
           { write the add instruction }
           if addconstant then
             begin
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
               if def_cgsize(left.resultdef) in [OS_64,OS_S64] then
                 cg64.a_op64_const_loc(current_asmdata.CurrAsmList,addsubop[inlinenumber],def_cgsize(left.resultdef),addvalue,tcallparanode(left).left.location)
               else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
                 hlcg.a_op_const_loc(current_asmdata.CurrAsmList,addsubop[inlinenumber],left.resultdef,
 {$ifdef cpu64bitalu}
                   aint(addvalue.svalue),
@@ -425,12 +425,12 @@ implementation
             end
            else
              begin
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                if def_cgsize(left.resultdef) in [OS_64,OS_S64] then
                  cg64.a_op64_reg_loc(current_asmdata.CurrAsmList,addsubop[inlinenumber],def_cgsize(left.resultdef),
                    joinreg64(hregister,hregisterhi),tcallparanode(left).left.location)
                else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
                  hlcg.a_op_reg_loc(current_asmdata.CurrAsmList,addsubop[inlinenumber],left.resultdef,
                    hregister,tcallparanode(left).left.location);
              end;
@@ -464,18 +464,18 @@ implementation
         var
           maskvalue : TConstExprInt;
           maskconstant : boolean;
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
           hregisterhi,
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
           hregister : tregister;
         begin
           { set defaults }
           maskconstant:=true;
           hregister:=NR_NO;
           maskvalue:=0;
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
           hregisterhi:=NR_NO;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
 
           { first secondpass first argument, because if the second arg }
           { is used in that expression then SSL may move it to another }
@@ -495,9 +495,9 @@ implementation
               else
                 hlcg.location_force_reg(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).left.resultdef,tcallparanode(left).right.resultdef,true);
               hregister:=tcallparanode(left).left.location.register;
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
               hregisterhi:=tcallparanode(left).left.location.register64.reghi;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
               maskconstant:=false;
             end;
           { write the and/or/xor/sar/shl/shr/rol/ror instruction }
@@ -508,11 +508,11 @@ implementation
                   maskvalue:=maskvalue and 63
                 else
                   maskvalue:=maskvalue and 31;
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
               if def_cgsize(tcallparanode(left).right.resultdef) in [OS_64,OS_S64] then
                 cg64.a_op64_const_loc(current_asmdata.CurrAsmList,andorxorop[inlinenumber],def_cgsize(tcallparanode(left).right.resultdef),maskvalue.svalue,tcallparanode(tcallparanode(left).right).left.location)
               else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
                 hlcg.a_op_const_loc(current_asmdata.CurrAsmList,andorxorop[inlinenumber],tcallparanode(left).right.resultdef,
 {$ifdef cpu64bitalu}
                   aint(maskvalue.svalue),
@@ -523,12 +523,12 @@ implementation
             end
            else
              begin
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                if def_cgsize(tcallparanode(left).right.resultdef) in [OS_64,OS_S64] then
                  cg64.a_op64_reg_loc(current_asmdata.CurrAsmList,andorxorop[inlinenumber],def_cgsize(tcallparanode(left).right.resultdef),
                    joinreg64(hregister,hregisterhi),tcallparanode(tcallparanode(left).right).left.location)
                else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
                  hlcg.a_op_reg_loc(current_asmdata.CurrAsmList,andorxorop[inlinenumber],tcallparanode(left).right.resultdef,
                    hregister,tcallparanode(tcallparanode(left).right).left.location);
              end;
@@ -828,33 +828,33 @@ implementation
         hlcg.location_force_reg(current_asmdata.CurrAsmList,op1.location,op1.resultdef,resultdef,true);
 
         location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
         if def_cgsize(resultdef) in [OS_64,OS_S64] then
           begin
             location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
             location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
           end
         else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
           location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
 
         if assigned(op2) then
           begin
              { rotating by a constant directly coded: }
              if op2.nodetype=ordconstn then
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                if def_cgsize(resultdef) in [OS_64,OS_S64] then
                  cg64.a_op64_const_reg_reg(current_asmdata.CurrAsmList,op,def_cgsize(resultdef),
                    tordconstnode(op2).value.uvalue and (resultdef.size*8-1),
                    op1.location.register64, location.register64)
                else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
                  hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,op,resultdef,
                    tordconstnode(op2).value.uvalue and (resultdef.size*8-1),
                    op1.location.register, location.register)
              else
                begin
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                  if def_cgsize(resultdef) in [OS_64,OS_S64] then
                    begin
                      hlcg.location_force_reg(current_asmdata.CurrAsmList,op2.location,
@@ -864,7 +864,7 @@ implementation
                                              location.register64);
                    end
                  else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
                    begin
                      hlcg.location_force_reg(current_asmdata.CurrAsmList,op2.location,
                                              op2.resultdef,resultdef,true);
@@ -875,12 +875,12 @@ implementation
                end;
           end
         else
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
           if def_cgsize(resultdef) in [OS_64,OS_S64] then
             cg64.a_op64_const_reg_reg(current_asmdata.CurrAsmList,op,def_cgsize(resultdef),1,
                                       op1.location.register64,location.register64)
           else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
             hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,op,resultdef,1,
                                     op1.location.register,location.register);
       end;

compiler/ncgld.pas

@@ -330,8 +330,9 @@ implementation
                begin
                  { Load a pointer to the thread var record into a register. }
                  { This register will be used in both multithreaded and non-multithreaded cases. }
-                 hreg_tv_rec:=hlcg.getaddressregister(current_asmdata.CurrAsmList,fieldptrdef);
-                 hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,resultdef,fieldptrdef,tvref,hreg_tv_rec);
+                 hreg_tv_rec:=hlcg.getaddressregister(current_asmdata.CurrAsmList,cpointerdef.getreusable(tv_rec));
+                 hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,tv_rec,cpointerdef.getreusable(tv_rec),tvref,hreg_tv_rec);
+                 reference_reset_base(tvref,hreg_tv_rec,0,ctempposinvalid,tvref.alignment,tvref.volatility)
                end;
              paraloc1.init;
              paramanager.getintparaloc(current_asmdata.CurrAsmList,tprocvardef(pvd),1,paraloc1);
@@ -346,8 +347,6 @@ implementation
              hlcg.g_set_addr_nonbitpacked_field_ref(current_asmdata.CurrAsmList,
                tv_rec,
                tfieldvarsym(tv_index_field),href);
-             if size_opt then
-               hlcg.reference_reset_base(href,tfieldvarsym(tv_index_field).vardef,hreg_tv_rec,href.offset,href.temppos,href.alignment,[]);
              hlcg.a_load_ref_cgpara(current_asmdata.CurrAsmList,tfieldvarsym(tv_index_field).vardef,href,paraloc1);
              { Dealloc the threadvar record register before calling the helper function to allow  }
              { the register allocator to assign non-mandatory real registers for hreg_tv_rec. }
@@ -377,10 +376,6 @@ implementation
              hlcg.g_set_addr_nonbitpacked_field_ref(current_asmdata.CurrAsmList,
                tv_rec,
                tfieldvarsym(tv_non_mt_data_field),href);
-             { load in the same "hregister" as above, so after this sequence
-               the address of the threadvar is always in hregister }
-             if size_opt then
-               hlcg.reference_reset_base(href,fieldptrdef,hreg_tv_rec,href.offset,href.temppos,href.alignment,[]);
              hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,resultdef,fieldptrdef,href,hregister);
              hlcg.a_label(current_asmdata.CurrAsmList,endrelocatelab);
 
@@ -695,7 +690,7 @@ implementation
          alignmentrequirement,
          len : aint;
          r : tregister;
-         {$if not defined(cpu64bitalu)}
+         {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
          r64 : tregister64;
          {$endif}
          oldflowcontrol : tflowcontrol;
@@ -840,11 +835,11 @@ implementation
             case right.location.loc of
               LOC_CONSTANT :
                 begin
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                   if (left.location.size in [OS_64,OS_S64]) or (right.location.size in [OS_64,OS_S64]) then
                     cg64.a_load64_const_loc(current_asmdata.CurrAsmList,right.location.value64,left.location)
                   else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
                     hlcg.a_load_const_loc(current_asmdata.CurrAsmList,left.resultdef,right.location.value,left.location);
                 end;
               LOC_REFERENCE,
@@ -952,11 +947,11 @@ implementation
                       hlcg.a_load_ref_subsetreg(current_asmdata.CurrAsmList,right.resultdef,left.resultdef,right.location.reference,left.location.sreg);
                     LOC_SUBSETREF,
                     LOC_CSUBSETREF:
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                       if right.location.size in [OS_64,OS_S64] then
                        cg64.a_load64_ref_subsetref(current_asmdata.CurrAsmList,right.location.reference,left.location.sref)
                       else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
                        hlcg.a_load_ref_subsetref(current_asmdata.CurrAsmList,right.resultdef,left.resultdef,right.location.reference,left.location.sref);
                     else
                       internalerror(200203284);
@@ -1055,11 +1050,11 @@ implementation
               LOC_SUBSETREF,
               LOC_CSUBSETREF:
                 begin
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                   if right.location.size in [OS_64,OS_S64] then
                    cg64.a_load64_subsetref_loc(current_asmdata.CurrAsmList,right.location.sref,left.location)
                   else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
                   hlcg.a_load_subsetref_loc(current_asmdata.CurrAsmList,
                       right.resultdef,left.resultdef,right.location.sref,left.location);
                 end;
@@ -1069,30 +1064,30 @@ implementation
                   hlcg.a_label(current_asmdata.CurrAsmList,right.location.truelabel);
                   if is_pasbool(left.resultdef) then
                     begin
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                       if left.location.size in [OS_64,OS_S64] then
                         cg64.a_load64_const_loc(current_asmdata.CurrAsmList,1,left.location)
                       else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
                         hlcg.a_load_const_loc(current_asmdata.CurrAsmList,left.resultdef,1,left.location)
                     end
                   else
                     begin
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                       if left.location.size in [OS_64,OS_S64] then
                         cg64.a_load64_const_loc(current_asmdata.CurrAsmList,-1,left.location)
                       else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
                         hlcg.a_load_const_loc(current_asmdata.CurrAsmList,left.resultdef,-1,left.location);
                     end;
 
                   hlcg.a_jmp_always(current_asmdata.CurrAsmList,hlabel);
                   hlcg.a_label(current_asmdata.CurrAsmList,right.location.falselabel);
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                   if left.location.size in [OS_64,OS_S64] then
                     cg64.a_load64_const_loc(current_asmdata.CurrAsmList,0,left.location)
                   else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
                     hlcg.a_load_const_loc(current_asmdata.CurrAsmList,left.resultdef,0,left.location);
                   hlcg.a_label(current_asmdata.CurrAsmList,hlabel);
                 end;
@@ -1103,7 +1098,7 @@ implementation
                     begin
                       case left.location.loc of
                         LOC_REGISTER,LOC_CREGISTER:
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                           if left.location.size in [OS_S64,OS_64] then
                             begin
                               cg.g_flags2reg(current_asmdata.CurrAsmList,OS_32,right.location.resflags,left.location.register64.reglo);
@@ -1111,7 +1106,7 @@ implementation
                               cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,left.location.register64.reghi);
                             end
                           else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
                             begin
                               cg.g_flags2reg(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,left.location.register);
                               cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
@@ -1119,7 +1114,7 @@ implementation
                         LOC_REFERENCE:
                         { i8086 and i386 have hacks in their code generators so that they can
                           deal with 64 bit locations in this parcticular case }
-{$if not defined(cpu64bitalu) and not defined(x86)}
+{$if not defined(cpu64bitalu) and not defined(x86) and not defined(cpuhighleveltarget)}
                           if left.location.size in [OS_S64,OS_64] then
                             begin
                               r64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
@@ -1130,7 +1125,7 @@ implementation
                               cg64.a_load64_reg_ref(current_asmdata.CurrAsmList,r64,left.location.reference);
                             end
                           else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not x86 and not cpuhighleveltarget}
                             begin
                               cg.g_flags2ref(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,left.location.reference);
                               cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
@@ -1148,7 +1143,7 @@ implementation
                     end
                   else
                     begin
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                       if left.location.size in [OS_S64,OS_64] then
                         begin
                           r64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
@@ -1161,7 +1156,7 @@ implementation
                           cg64.a_load64_reg_loc(current_asmdata.CurrAsmList,r64,left.location);
                         end
                       else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
                         begin
                           r:=cg.getintregister(current_asmdata.CurrAsmList,left.location.size);
                           cg.g_flags2reg(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,r);

compiler/ncgmat.pas

@@ -46,9 +46,9 @@ interface
 {$ifdef SUPPORT_MMX}
          procedure second_mmx;virtual;abstract;
 {$endif SUPPORT_MMX}
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
          procedure second_64bit;virtual;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
          procedure second_integer;virtual;
          procedure second_float;virtual;
          procedure second_float_emulated;virtual;
@@ -83,7 +83,7 @@ interface
            been done and emitted, so this should really a do a modulo.
          }
          procedure emit_mod_reg_reg(signed: boolean;denum,num : tregister);virtual;abstract;
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
          { This routine must do an actual 64-bit division, be it
            signed or unsigned. The result must set into the the
            @var(num) register.
@@ -98,16 +98,16 @@ interface
            64-bit systems, otherwise a helper is called in 1st pass.
          }
          procedure emit64_div_reg_reg(signed: boolean;denum,num : tregister64);virtual;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
       end;
 
       tcgshlshrnode = class(tshlshrnode)
 {$ifdef SUPPORT_MMX}
          procedure second_mmx;virtual;abstract;
 {$endif SUPPORT_MMX}
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
          procedure second_64bit;virtual;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
          procedure second_integer;virtual;
          procedure pass_generate_code;override;
       end;
@@ -119,9 +119,9 @@ interface
 {$ifdef SUPPORT_MMX}
          procedure second_mmx;virtual;abstract;
 {$endif SUPPORT_MMX}
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
          procedure second_64bit;virtual;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
          procedure second_integer;virtual;
       public
          procedure pass_generate_code;override;
@@ -197,7 +197,7 @@ implementation
       end;
 
 
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
     procedure tcgunaryminusnode.second_64bit;
       var
         tr: tregister;
@@ -223,7 +223,7 @@ implementation
             cg.a_label(current_asmdata.CurrAsmList,hl);
           end;
       end;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
 
 
     procedure tcgunaryminusnode.second_float_emulated;
@@ -311,7 +311,7 @@ implementation
           begin
             current_asmdata.getjumplabel(hl);
             hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,OC_NE,torddef(opsize).low.svalue,location.register,hl);
-            hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',[],nil);
+            hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',[],nil).resetiftemp;
             hlcg.a_label(current_asmdata.CurrAsmList,hl);
           end;
       end;
@@ -319,11 +319,11 @@ implementation
 
     procedure tcgunaryminusnode.pass_generate_code;
       begin
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
          if is_64bit(left.resultdef) then
            second_64bit
          else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
 {$ifdef SUPPORT_MMX}
            if (cs_mmx in current_settings.localswitches) and is_mmx_able_array(left.resultdef) then
              second_mmx
@@ -345,7 +345,7 @@ implementation
                              TCGMODDIVNODE
 *****************************************************************************}
 
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
     procedure tcgmoddivnode.emit64_div_reg_reg(signed: boolean; denum,num:tregister64);
       begin
         { handled in pass_1 already, unless pass_1 is
@@ -354,7 +354,7 @@ implementation
         { should be handled in pass_1 (JM) }
         internalerror(200109052);
       end;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
 
 
     procedure tcgmoddivnode.pass_generate_code;
@@ -376,7 +376,7 @@ implementation
           exit;
          location_copy(location,left.location);
 
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
          if is_64bit(resultdef) then
            begin
              if is_signed(left.resultdef) then
@@ -395,7 +395,7 @@ implementation
                joinreg64(location.register64.reglo,location.register64.reghi));
            end
          else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
            begin
               if is_signed(left.resultdef) then
                 begin
@@ -475,13 +475,13 @@ implementation
 *****************************************************************************}
 
 
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
     procedure tcgshlshrnode.second_64bit;
       begin
          { already hanled in 1st pass }
          internalerror(2002081501);
       end;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
 
 
     procedure tcgshlshrnode.second_integer;
@@ -610,11 +610,11 @@ implementation
              second_mmx
          else
 {$endif SUPPORT_MMX}
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
          if is_64bit(left.resultdef) then
            second_64bit
          else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
            second_integer;
       end;
 
@@ -623,7 +623,7 @@ implementation
                                TCGNOTNODE
 *****************************************************************************}
 
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
     procedure tcgnotnode.second_64bit;
       begin
         secondpass(left);
@@ -635,7 +635,7 @@ implementation
         { perform the NOT operation }
         cg64.a_op64_reg_reg(current_asmdata.CurrAsmList,OP_NOT,location.size,left.location.register64,location.register64);
       end;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
 
 
     procedure tcgnotnode.second_integer;
@@ -676,10 +676,10 @@ implementation
         else if (cs_mmx in current_settings.localswitches) and is_mmx_able_array(left.resultdef) then
           second_mmx
 {$endif SUPPORT_MMX}
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
         else if is_64bit(left.resultdef) then
           second_64bit
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
         else
           second_integer;
       end;

compiler/ncgmem.pas

@@ -55,10 +55,6 @@ interface
           procedure pass_generate_code;override;
        end;
 
-       tcgwithnode = class(twithnode)
-          procedure pass_generate_code;override;
-       end;
-
        tcgvecnode = class(tvecnode)
          function get_mul_size : asizeint;
        private
@@ -607,19 +603,6 @@ implementation
       end;
 
 
-{*****************************************************************************
-                            TCGWITHNODE
-*****************************************************************************}
-
-    procedure tcgwithnode.pass_generate_code;
-      begin
-        location_reset(location,LOC_VOID,OS_NO);
-
-        if assigned(left) then
-          secondpass(left);
-       end;
-
-
 {*****************************************************************************
                             TCGVECNODE
 *****************************************************************************}
@@ -1109,6 +1092,5 @@ begin
    caddrnode:=tcgaddrnode;
    cderefnode:=tcgderefnode;
    csubscriptnode:=tcgsubscriptnode;
-   cwithnode:=tcgwithnode;
    cvecnode:=tcgvecnode;
 end.

compiler/ncgnstld.pas

@@ -59,7 +59,7 @@ implementation
       defutil,defcmp,
       htypechk,pass_1,procinfo,paramgr,
       cpuinfo,
-      symconst,symbase,symsym,symdef,symtable,symcreat,
+      symconst,symbase,symsym,symdef,symtable,pparautl,symcreat,
       ncon,ninl,ncnv,nmem,ncal,nutils,nbas,
       pass_2,cgbase
       ;

compiler/ncgnstmm.pas

@@ -40,9 +40,9 @@ implementation
     uses
       systems,
       cutils,cclasses,verbose,globals,constexp,
-      symconst,symdef,symsym,symtable,symcreat,defutil,paramgr,
+      symconst,symdef,symsym,symtable,defutil,procdefutil,pparautl,symcreat,
       aasmbase,aasmtai,aasmdata,
-      procinfo,pass_2,parabase,
+      procinfo,pass_2,parabase,paramgr,
       pass_1,ncnv,nmem,nld,ncon,nadd,nutils,
       cgutils,cgobj,hlcgobj,
       tgobj,ncgutil,objcgutl

compiler/ncgset.pas

@@ -73,6 +73,13 @@ interface
           jumptable_no_range : boolean;
           { has the implementation jumptable support }
           min_label : tconstexprint;
+          { Number of labels }
+          labelcnt: TCgInt;
+          { Number of individual values checked, counting each value in a range
+            individually (e.g. 0..2 counts as 3). }
+          TrueCount: TCgInt;
+
+          function GetBranchLabel(Block: TNode; out _Label: TAsmLabel): Boolean;
 
           function  blocklabel(id:longint):tasmlabel;
           procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);virtual;
@@ -90,9 +97,10 @@ implementation
 
     uses
       verbose,
-      symconst,symdef,defutil,
+      cutils,
+      symconst,symdef,symsym,defutil,
       pass_2,tgobj,
-      ncon,
+      nbas,ncon,ncgflw,
       ncgutil,hlcgobj;
 
 
@@ -524,6 +532,79 @@ implementation
                             TCGCASENODE
 *****************************************************************************}
 
+
+    { Analyse the nodes following the else label - if empty, change to end label }
+    function tcgcasenode.GetBranchLabel(Block: TNode; out _Label: TAsmLabel): Boolean;
+      var
+        LabelSym: TLabelSym;
+      begin
+        Result := True;
+
+        if not Assigned(Block) then
+          begin
+            { Block doesn't exist / is empty }
+            _Label := endlabel;
+            Exit;
+          end;
+
+        { These optimisations aren't particularly debugger friendly }
+        if not (cs_opt_level2 in current_settings.optimizerswitches) then
+          begin
+            Result := False;
+            current_asmdata.getjumplabel(_Label);
+            Exit;
+          end;
+
+        while Assigned(Block) do
+          begin
+            case Block.nodetype of
+              nothingn:
+                begin
+                  _Label := endlabel;
+                  Exit;
+                end;
+              goton:
+                begin
+                  LabelSym := TCGGotoNode(Block).labelsym;
+                  if not Assigned(LabelSym) then
+                    InternalError(2018121131);
+
+                  _Label := TCGLabelNode(TCGGotoNode(Block).labelnode).getasmlabel;
+                  if Assigned(_Label) then
+                    { Keep tabs on the fact that an actual 'goto' was used }
+                    Include(flowcontrol,fc_gotolabel)
+                  else
+                    Break;
+                  Exit;
+                end;
+              blockn:
+                begin
+                  Block := TBlockNode(Block).Left;
+                  Continue;
+                end;
+              statementn:
+                begin
+                  { If the right node is assigned, then it's a compound block
+                    that can't be simplified, so fall through, set Result to
+                    False and make a new label }
+
+                  if Assigned(TStatementNode(Block).right) then
+                    Break;
+
+                  Block := TStatementNode(Block).Left;
+                  Continue;
+                end;
+            end;
+
+            Break;
+          end;
+
+        { Create unique label }
+        Result := False;
+        current_asmdata.getjumplabel(_Label);
+      end;
+
+
     function tcgcasenode.blocklabel(id:longint):tasmlabel;
       begin
         if not assigned(blocks[id]) then
@@ -560,17 +641,18 @@ implementation
          newsize: tcgsize;
          newdef: tdef;
 
-      procedure genitem(t : pcaselabel);
+      procedure gensub(value:tcgint);
+        begin
+          { here, since the sub and cmp are separate we need
+            to move the result before subtract to help
+            the register allocator
+          }
+          hlcg.a_load_reg_reg(current_asmdata.CurrAsmList, opsize, opsize, hregister, scratch_reg);
+          hlcg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, value, hregister);
+        end;
 
-          procedure gensub(value:tcgint);
-            begin
-              { here, since the sub and cmp are separate we need
-                to move the result before subtract to help
-                the register allocator
-              }
-              hlcg.a_load_reg_reg(current_asmdata.CurrAsmList, opsize, opsize, hregister, scratch_reg);
-              hlcg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, value, hregister);
-            end;
+
+      procedure genitem(t : pcaselabel);
 
         begin
            if assigned(t^.less) then
@@ -641,10 +723,25 @@ implementation
                   hregister:=scratch_reg;
                   opsize:=newdef;
                 end;
-              last:=0;
-              first:=true;
-              scratch_reg:=hlcg.getintregister(current_asmdata.CurrAsmList,opsize);
-              genitem(hp);
+              if (labelcnt>1) or not(cs_opt_level1 in current_settings.optimizerswitches) then
+                begin
+                  last:=0;
+                  first:=true;
+                  scratch_reg:=hlcg.getintregister(current_asmdata.CurrAsmList,opsize);
+                  genitem(hp);
+                end
+              else
+                begin
+                  { If only one label exists, we can greatly simplify the checks to a simple comparison }
+                  if hp^._low=hp^._high then
+                    hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_EQ, tcgint(hp^._low.svalue), hregister, blocklabel(hp^.blockid))
+                  else
+                    begin
+                      scratch_reg:=hlcg.getintregister(current_asmdata.CurrAsmList,opsize);
+                      gensub(tcgint(hp^._low.svalue));
+                      hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_BE, tcgint(hp^._high.svalue-hp^._low.svalue), hregister, blocklabel(hp^.blockid))
+                    end;
+                end;
               hlcg.a_jmp_always(current_asmdata.CurrAsmList,elselabel);
            end;
       end;
@@ -658,16 +755,17 @@ implementation
 
       procedure genitem(t : pcaselabel);
 
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
         var
            l1 : tasmlabel;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
 
         begin
            if assigned(t^.less) then
              genitem(t^.less);
            if t^._low=t^._high then
              begin
+{$ifndef cpuhighleveltarget}
 {$if defined(cpu32bitalu)}
                 if def_cgsize(opsize) in [OS_S64,OS_64] then
                   begin
@@ -727,6 +825,7 @@ implementation
                   end
                 else
 {$endif}
+{$endif cpuhighleveltarget}
                   begin
                      hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_EQ, aint(t^._low.svalue),hregister, blocklabel(t^.blockid));
                   end;
@@ -741,6 +840,7 @@ implementation
                 { ELSE-label                                }
                 if not lastwasrange or (t^._low-last>1) then
                   begin
+{$ifndef cpuhighleveltarget}
 {$if defined(cpu32bitalu)}
                      if def_cgsize(opsize) in [OS_64,OS_S64] then
                        begin
@@ -832,11 +932,13 @@ implementation
                        end
                      else
 {$endif}
+{$endif cpuhighleveltarget}
                        begin
                         hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_lt, aint(t^._low.svalue), hregister,
                            elselabel);
                        end;
                   end;
+{$ifndef cpuhighleveltarget}
 {$if defined(cpu32bitalu)}
                 if def_cgsize(opsize) in [OS_S64,OS_64] then
                   begin
@@ -922,6 +1024,7 @@ implementation
                   end
                 else
 {$endif}
+{$endif cpuhighleveltarget}
                   begin
                      hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_le, aint(t^._high.svalue), hregister, blocklabel(t^.blockid));
                   end;
@@ -1043,25 +1146,43 @@ implementation
       end;
 
     procedure tcgcasenode.pass_generate_code;
+
+      { Combines "case_count_labels" and "case_true_count" }
+      procedure CountBoth(p : pcaselabel);
+        begin
+          Inc(labelcnt);
+          Inc(TrueCount, (p^._high.svalue - p^._low.svalue) + 1);
+          if assigned(p^.less) then
+            CountBoth(p^.less);
+          if assigned(p^.greater) then
+            CountBoth(p^.greater);
+        end;
+
       var
          oldflowcontrol: tflowcontrol;
          i : longint;
-         dist,distv,
+         dist : aword;
+         distv,
          lv,hv,
          max_label: tconstexprint;
-         labelcnt : tcgint;
          max_linear_list : aint;
          max_dist : aword;
+         ShortcutElse: Boolean;
       begin
          location_reset(location,LOC_VOID,OS_NO);
 
          oldflowcontrol := flowcontrol;
          include(flowcontrol,fc_inflowcontrol);
          { Allocate labels }
+
          current_asmdata.getjumplabel(endlabel);
-         current_asmdata.getjumplabel(elselabel);
+
+         { Do some optimisation to deal with empty else blocks }
+         ShortcutElse := GetBranchLabel(elseblock, elselabel);
+
          for i:=0 to blocks.count-1 do
-           current_asmdata.getjumplabel(pcaseblock(blocks[i])^.blocklabel);
+           with pcaseblock(blocks[i])^ do
+             shortcut := GetBranchLabel(statement, blocklabel);
 
          with_sign:=is_signed(left.resultdef);
          if with_sign then
@@ -1085,14 +1206,14 @@ implementation
          opsize:=left.resultdef;
          { copy the case expression to a register }
          hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,opsize,false);
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu)}
          if def_cgsize(opsize) in [OS_S64,OS_64] then
            begin
              hregister:=left.location.register64.reglo;
              hregister2:=left.location.register64.reghi;
            end
          else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
            hregister:=left.location.register;
 
          { we need the min_label always to choose between }
@@ -1103,12 +1224,15 @@ implementation
 {$ifdef OLDREGVARS}
          load_all_regvars(current_asmdata.CurrAsmList);
 {$endif OLDREGVARS}
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu)}
          if def_cgsize(opsize) in [OS_64,OS_S64] then
            genlinearcmplist(labels)
          else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
            begin
+              labelcnt := 0;
+              TrueCount := 0;
+
               if cs_opt_level1 in current_settings.optimizerswitches then
                 begin
                    { procedures are empirically passed on }
@@ -1118,8 +1242,11 @@ implementation
                    { moreover can the size only be appro- }
                    { ximated as it is not known if rel8,  }
                    { rel16 or rel32 jumps are used   }
-                   max_label:=case_get_max(labels);
-                   labelcnt:=case_count_labels(labels);
+
+                   CountBoth(labels);
+
+                   max_label := case_get_max(labels);
+
                    { can we omit the range check of the jump table ? }
                    getrange(left.resultdef,lv,hv);
                    jumptable_no_range:=(lv=min_label) and (hv=max_label);
@@ -1128,7 +1255,7 @@ implementation
                    if distv>=0 then
                      dist:=distv.uvalue
                    else
-                     dist:=-distv.svalue;
+                     dist:=aword(-distv.svalue);
 
                    { optimize for size ? }
                    if cs_opt_size in current_settings.optimizerswitches  then
@@ -1137,8 +1264,8 @@ implementation
                           (min_label>=int64(low(aint))) and
                           (max_label<=high(aint)) and
                           not((labelcnt<=2) or
-                              ((max_label-min_label)<0) or
-                              ((max_label-min_label)>3*labelcnt)) then
+                              (distv.svalue<0) or
+                              (dist>3*labelcnt)) then
                          begin
                            { if the labels less or more a continuum then }
                            genjumptable(labels,min_label.svalue,max_label.svalue);
@@ -1151,7 +1278,12 @@ implementation
                      end
                    else
                      begin
-                        max_dist:=4*labelcnt;
+                        max_dist:=4*TrueCount;
+
+                        { Don't allow jump tables to get too large }
+                        if max_dist>4*labelcnt then
+                          max_dist:=min(max_dist,2048);
+
                         if jumptable_no_range then
                           max_linear_list:=4
                         else
@@ -1187,26 +1319,37 @@ implementation
            end;
 
          { generate the instruction blocks }
-         for i:=0 to blocks.count-1 do
+         for i:=0 to blocks.count-1 do with pcaseblock(blocks[i])^ do
            begin
-              current_asmdata.CurrAsmList.concat(cai_align.create(current_settings.alignment.jumpalign));
-              cg.a_label(current_asmdata.CurrAsmList,pcaseblock(blocks[i])^.blocklabel);
-              secondpass(pcaseblock(blocks[i])^.statement);
-              { don't come back to case line }
-              current_filepos:=current_asmdata.CurrAsmList.getlasttaifilepos^;
+             { If the labels are not equal, then the block label has been shortcut to point elsewhere,
+               so there's no need to implement it }
+             if not shortcut then
+               begin
+                 current_asmdata.CurrAsmList.concat(cai_align.create(current_settings.alignment.jumpalign));
+                 cg.a_label(current_asmdata.CurrAsmList,blocklabel);
+                 secondpass(statement);
+                 { don't come back to case line }
+                 current_filepos:=current_asmdata.CurrAsmList.getlasttaifilepos^;
 {$ifdef OLDREGVARS}
-              load_all_regvars(current_asmdata.CurrAsmList);
+                 load_all_regvars(current_asmdata.CurrAsmList);
 {$endif OLDREGVARS}
-              hlcg.a_jmp_always(current_asmdata.CurrAsmList,endlabel);
+                 hlcg.a_jmp_always(current_asmdata.CurrAsmList,endlabel);
+               end;
            end;
-         current_asmdata.CurrAsmList.concat(cai_align.create(current_settings.alignment.jumpalign));
+
          { ...and the else block }
-         hlcg.a_label(current_asmdata.CurrAsmList,elselabel);
-         if assigned(elseblock) then
+         if not ShortcutElse then
            begin
-              secondpass(elseblock);
+             current_asmdata.CurrAsmList.concat(cai_align.create(current_settings.alignment.jumpalign));
+             hlcg.a_label(current_asmdata.CurrAsmList,elselabel);
+           end;
+
+         if Assigned(elseblock) then
+           begin
+
+             secondpass(elseblock);
 {$ifdef OLDREGVARS}
-              load_all_regvars(current_asmdata.CurrAsmList);
+             load_all_regvars(current_asmdata.CurrAsmList);
 {$endif OLDREGVARS}
            end;
 

compiler/ncgutil.pas

@@ -31,9 +31,9 @@ interface
       cpubase,cgbase,parabase,cgutils,
       aasmbase,aasmtai,aasmdata,aasmcpu,
       symconst,symbase,symdef,symsym,symtype
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
       ,cg64f32
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
       ;
 
     type
@@ -63,10 +63,6 @@ interface
     procedure location_force_mmreg(list:TAsmList;var l: tlocation;maybeconst:boolean);
     procedure location_allocate_register(list:TAsmList;out l: tlocation;def: tdef;constant: boolean);
 
-    { loads a cgpara into a tlocation; assumes that loc.loc is already
-      initialised }
-    procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
-
     { allocate registers for a tlocation; assumes that loc.loc is already
       set to LOC_CREGISTER/LOC_CFPUREGISTER/... }
     procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation;def: tdef);
@@ -80,7 +76,6 @@ interface
     procedure gen_proc_exit_code(list:TAsmList);
     procedure gen_save_used_regs(list:TAsmList);
     procedure gen_restore_used_regs(list:TAsmList);
-    procedure gen_load_para_value(list:TAsmList);
 
     procedure get_used_regvars(n: tnode; var rv: tusedregvars);
     { adds the regvars used in n and its children to rv.allregvars,
@@ -101,6 +96,9 @@ interface
 
     procedure gen_load_frame_for_exceptfilter(list : TAsmList);
 
+   procedure gen_alloc_regvar(list:TAsmList;sym: tabstractnormalvarsym; allocreg: boolean);
+
+
 implementation
 
   uses
@@ -142,7 +140,7 @@ implementation
           LOC_REGISTER,
           LOC_CREGISTER:
             begin
-{$ifdef cpu64bitalu}
+{$if defined(cpu64bitalu)}
                 { x86-64 system v abi:
                   structs with up to 16 bytes are returned in registers }
                 if location.size in [OS_128,OS_S128] then
@@ -152,7 +150,8 @@ implementation
                     if getsupreg(location.registerhi)<first_int_imreg then
                       cg.ungetcpuregister(list,location.registerhi);
                   end
-{$else cpu64bitalu}
+                else
+{$elseif not defined(cpuhighleveltarget)}
                 if location.size in [OS_64,OS_S64] then
                   begin
                     if getsupreg(location.register64.reglo)<first_int_imreg then
@@ -160,8 +159,8 @@ implementation
                     if getsupreg(location.register64.reghi)<first_int_imreg then
                       cg.ungetcpuregister(list,location.register64.reghi);
                   end
-{$endif cpu64bitalu}
                 else
+{$endif cpu64bitalu and not cpuhighleveltarget}
                   if getsupreg(location.register)<first_int_imreg then
                     cg.ungetcpuregister(list,location.register);
             end;
@@ -221,7 +220,13 @@ implementation
                  (fcl>0)) or
                 (((fcr=fcl) or
                   (fcr=0)) and
-                 (ncr>ncl)) then
+                 (ncr>ncl)) and
+                { if one tree contains nodes being conditionally executated, we cannot swap the trees
+                  as the other tree might depend on all nodes being executed, this applies for example
+                  for temp. create nodes with init part, they must be executed else things break, see
+                  issue #34653
+                }
+                 not(has_conditional_nodes(p.right)) then
                p.swapleftright
            end;
       end;
@@ -290,7 +295,7 @@ implementation
                        end;
                      LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
                        begin
-{$ifdef cpu64bitalu}
+{$if defined(cpu64bitalu)}
                          if opsize in [OS_128,OS_S128] then
                            begin
                              hlcg.location_force_reg(list,p.location,p.resultdef,cgsize_orddef(opsize),true);
@@ -300,7 +305,7 @@ implementation
                              p.location.register:=tmpreg;
                              opsize:=OS_64;
                            end;
-{$else cpu64bitalu}
+{$elseif not defined(cpuhighleveltarget)}
                          if opsize in [OS_64,OS_S64] then
                            begin
                              hlcg.location_force_reg(list,p.location,p.resultdef,cgsize_orddef(opsize),true);
@@ -310,7 +315,7 @@ implementation
                              p.location.register:=tmpreg;
                              opsize:=OS_32;
                            end;
-{$endif cpu64bitalu}
+{$endif cpu64bitalu and not cpuhighleveltarget}
                          cg.a_cmp_const_loc_label(list,opsize,OC_NE,0,p.location,truelabel);
                          cg.a_jmp_always(list,falselabel);
                        end;
@@ -454,21 +459,21 @@ implementation
               location_reset(l,LOC_CREGISTER,l.size)
             else
               location_reset(l,LOC_REGISTER,l.size);
-{$ifdef cpu64bitalu}
+{$if defined(cpu64bitalu)}
             if l.size in [OS_128,OS_S128,OS_F128] then
               begin
                 l.register128.reglo:=cg.getintregister(list,OS_64);
                 l.register128.reghi:=cg.getintregister(list,OS_64);
               end
             else
-{$else cpu64bitalu}
+{$elseif not defined(cpuhighleveltarget)}
             if l.size in [OS_64,OS_S64,OS_F64] then
               begin
                 l.register64.reglo:=cg.getintregister(list,OS_32);
                 l.register64.reghi:=cg.getintregister(list,OS_32);
               end
             else
-{$endif cpu64bitalu}
+{$endif cpu64bitalu and not cpuhighleveltarget}
             { Note: for widths of records (and maybe objects, classes, etc.) an
                     address register could be set here, but that is later
                     changed to an intregister neverthless when in the
@@ -554,21 +559,21 @@ implementation
         case loc.loc of
           LOC_CREGISTER:
             begin
-{$ifdef cpu64bitalu}
+{$if defined(cpu64bitalu)}
               if loc.size in [OS_128,OS_S128] then
                 begin
                   loc.register128.reglo:=cg.getintregister(list,OS_64);
                   loc.register128.reghi:=cg.getintregister(list,OS_64);
                 end
               else
-{$else cpu64bitalu}
+{$elseif not defined(cpuhighleveltarget)}
               if loc.size in [OS_64,OS_S64] then
                 begin
                   loc.register64.reglo:=cg.getintregister(list,OS_32);
                   loc.register64.reghi:=cg.getintregister(list,OS_32);
                 end
               else
-{$endif cpu64bitalu}
+{$endif cpu64bitalu and not cpuhighleveltarget}
                 if hlcg.def2regtyp(def)=R_ADDRESSREGISTER then
                   loc.register:=hlcg.getaddressregister(list,def)
                 else
@@ -610,14 +615,14 @@ implementation
                 cg.a_reg_sync(list,sym.initialloc.register128.reghi);
               end
             else
-{$elseif defined(cpu32bitalu)}
+{$elseif defined(cpu32bitalu) and not defined(cpuhighleveltarget)}
             if sym.initialloc.size in [OS_64,OS_S64] then
               begin
                 cg.a_reg_sync(list,sym.initialloc.register64.reglo);
                 cg.a_reg_sync(list,sym.initialloc.register64.reghi);
               end
             else
-{$elseif defined(cpu16bitalu)}
+{$elseif defined(cpu16bitalu) and not defined(cpuhighleveltarget)}
             if sym.initialloc.size in [OS_64,OS_S64] then
               begin
                 cg.a_reg_sync(list,sym.initialloc.register64.reglo);
@@ -632,7 +637,7 @@ implementation
                 cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register));
               end
             else
-{$elseif defined(cpu8bitalu)}
+{$elseif defined(cpu8bitalu) and not defined(cpuhighleveltarget)}
             if sym.initialloc.size in [OS_64,OS_S64] then
               begin
                 cg.a_reg_sync(list,sym.initialloc.register64.reglo);
@@ -662,640 +667,20 @@ implementation
 {$endif}
              cg.a_reg_sync(list,sym.initialloc.register);
           end;
-{$ifdef cpu64bitalu}
+{$if defined(cpu64bitalu)}
         if (sym.initialloc.size in [OS_128,OS_S128]) then
           varloc:=tai_varloc.create128(sym,sym.initialloc.register,sym.initialloc.registerhi)
-{$else cpu64bitalu}
+        else
+{$elseif not defined(cpuhighleveltarget)}
         if (sym.initialloc.size in [OS_64,OS_S64]) then
           varloc:=tai_varloc.create64(sym,sym.initialloc.register,sym.initialloc.registerhi)
-{$endif cpu64bitalu}
         else
+{$endif cpu64bitalu and not cpuhighleveltarget}
           varloc:=tai_varloc.create(sym,sym.initialloc.register);
         list.concat(varloc);
       end;
 
 
-    procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
-
-      procedure unget_para(const paraloc:TCGParaLocation);
-        begin
-           case paraloc.loc of
-             LOC_REGISTER :
-               begin
-                 if getsupreg(paraloc.register)<first_int_imreg then
-                   cg.ungetcpuregister(list,paraloc.register);
-               end;
-             LOC_MMREGISTER :
-               begin
-                 if getsupreg(paraloc.register)<first_mm_imreg then
-                   cg.ungetcpuregister(list,paraloc.register);
-               end;
-             LOC_FPUREGISTER :
-               begin
-                 if getsupreg(paraloc.register)<first_fpu_imreg then
-                   cg.ungetcpuregister(list,paraloc.register);
-               end;
-           end;
-        end;
-
-      var
-        paraloc   : pcgparalocation;
-        href      : treference;
-        sizeleft  : aint;
-        tempref   : treference;
-        loadsize  : tcgint;
-        tempreg  : tregister;
-{$ifdef mips}
-        //tmpreg   : tregister;
-{$endif mips}
-{$ifndef cpu64bitalu}
-        reg64    : tregister64;
-{$if defined(cpu8bitalu)}
-        curparaloc : PCGParaLocation;
-{$endif defined(cpu8bitalu)}
-{$endif not cpu64bitalu}
-      begin
-        paraloc:=para.location;
-        if not assigned(paraloc) then
-          internalerror(200408203);
-        { skip e.g. empty records }
-        if (paraloc^.loc = LOC_VOID) then
-          exit;
-        case destloc.loc of
-          LOC_REFERENCE :
-            begin
-              { If the parameter location is reused we don't need to copy
-                anything }
-              if not reusepara then
-                begin
-                  href:=destloc.reference;
-                  sizeleft:=para.intsize;
-                  while assigned(paraloc) do
-                    begin
-                      if (paraloc^.size=OS_NO) then
-                        begin
-                          { Can only be a reference that contains the rest
-                            of the parameter }
-                          if (paraloc^.loc<>LOC_REFERENCE) or
-                             assigned(paraloc^.next) then
-                            internalerror(2005013010);
-                          cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment);
-                          inc(href.offset,sizeleft);
-                          sizeleft:=0;
-                        end
-                      else
-                        begin
-                          { the min(...) call ensures that we do not store more than place is left as
-                             paraloc^.size could be bigger than destloc.size of a parameter occupies a full register
-                             and as on big endian system the parameters might be left aligned, we have to work
-                             with the full register size for paraloc^.size }
-                          if tcgsize2size[destloc.size]<>0 then
-                            loadsize:=min(min(tcgsize2size[paraloc^.size],tcgsize2size[destloc.size]),sizeleft)
-                          else
-                            loadsize:=min(tcgsize2size[paraloc^.size],sizeleft);
-
-                          cg.a_load_cgparaloc_ref(list,paraloc^,href,loadsize,destloc.reference.alignment);
-                          inc(href.offset,loadsize);
-                          dec(sizeleft,loadsize);
-                        end;
-                      unget_para(paraloc^);
-                      paraloc:=paraloc^.next;
-                    end;
-                end;
-            end;
-          LOC_REGISTER,
-          LOC_CREGISTER :
-            begin
-{$ifdef cpu64bitalu}
-              if (para.size in [OS_128,OS_S128,OS_F128]) and
-                 ({ in case of fpu emulation, or abi's that pass fpu values
-                    via integer registers }
-                  (vardef.typ=floatdef) or
-                   is_methodpointer(vardef) or
-                   is_record(vardef)) then
-                begin
-                  case paraloc^.loc of
-                    LOC_REGISTER,
-                    LOC_MMREGISTER:
-                      begin
-                        if not assigned(paraloc^.next) then
-                          internalerror(200410104);
-                        case tcgsize2size[paraloc^.size] of
-                          8:
-                            begin
-                              if (target_info.endian=ENDIAN_BIG) then
-                                begin
-                                  { paraloc^ -> high
-                                    paraloc^.next -> low }
-                                  unget_para(paraloc^);
-                                  gen_alloc_regloc(list,destloc,vardef);
-                                  { reg->reg, alignment is irrelevant }
-                                  cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reghi,8);
-                                  unget_para(paraloc^.next^);
-                                  cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^.next^,destloc.register128.reglo,8);
-                                end
-                              else
-                                begin
-                                  { paraloc^ -> low
-                                    paraloc^.next -> high }
-                                  unget_para(paraloc^);
-                                  gen_alloc_regloc(list,destloc,vardef);
-                                  cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reglo,8);
-                                  unget_para(paraloc^.next^);
-                                  cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^.next^,destloc.register128.reghi,8);
-                                end;
-                            end;
-                          4:
-                            begin
-                              { The 128-bit parameter is located in 4 32-bit MM registers.
-                                It is needed to copy them to 2 64-bit int registers.
-                                A code generator or a target cpu must support loading of a 32-bit MM register to
-                                a 64-bit int register, zero extending it. }
-                              if target_info.endian=ENDIAN_BIG then
-                                internalerror(2018101702);  // Big endian support not implemented yet
-                              gen_alloc_regloc(list,destloc,vardef);
-                              tempreg:=cg.getintregister(list,OS_64);
-                              // Low part of the 128-bit param
-                              unget_para(paraloc^);
-                              cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,tempreg,4);
-                              paraloc:=paraloc^.next;
-                              if paraloc=nil then
-                                internalerror(2018101703);
-                              unget_para(paraloc^);
-                              cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reglo,4);
-                              cg.a_op_const_reg(list,OP_SHL,OS_64,32,destloc.register128.reglo);
-                              cg.a_op_reg_reg(list,OP_OR,OS_64,tempreg,destloc.register128.reglo);
-                              // High part of the 128-bit param
-                              paraloc:=paraloc^.next;
-                              if paraloc=nil then
-                                internalerror(2018101704);
-                              unget_para(paraloc^);
-                              cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,tempreg,4);
-                              paraloc:=paraloc^.next;
-                              if paraloc=nil then
-                                internalerror(2018101705);
-                              unget_para(paraloc^);
-                              cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reghi,4);
-                              cg.a_op_const_reg(list,OP_SHL,OS_64,32,destloc.register128.reghi);
-                              cg.a_op_reg_reg(list,OP_OR,OS_64,tempreg,destloc.register128.reghi);
-                            end
-                          else
-                            internalerror(2018101701);
-                        end;
-                      end;
-                    LOC_REFERENCE:
-                      begin
-                        gen_alloc_regloc(list,destloc,vardef);
-                        reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset,ctempposinvalid,para.alignment,[]);
-                        cg128.a_load128_ref_reg(list,href,destloc.register128);
-                        unget_para(paraloc^);
-                      end;
-                    else
-                      internalerror(2012090607);
-                  end
-                end
-              else
-{$else cpu64bitalu}
-              if (para.size in [OS_64,OS_S64,OS_F64]) and
-                 (is_64bit(vardef) or
-                  { in case of fpu emulation, or abi's that pass fpu values
-                    via integer registers }
-                  (vardef.typ=floatdef) or
-                   is_methodpointer(vardef) or
-                   is_record(vardef)) then
-                begin
-                  case paraloc^.loc of
-                    LOC_REGISTER:
-                      begin
-                        case para.locations_count of
-{$if defined(cpu8bitalu)}
-                          { 8 paralocs? }
-                          8:
-                            if (target_info.endian=ENDIAN_BIG) then
-                              begin
-                                { is there any big endian 8 bit ALU/16 bit Addr CPU? }
-                                internalerror(2015041003);
-                                { paraloc^ -> high
-                                  paraloc^.next^.next^.next^.next -> low }
-                                unget_para(paraloc^);
-                                gen_alloc_regloc(list,destloc,vardef);
-                                { reg->reg, alignment is irrelevant }
-                                cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,cg.GetNextReg(destloc.register64.reghi),1);
-                                unget_para(paraloc^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,destloc.register64.reghi,1);
-                                unget_para(paraloc^.next^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,cg.GetNextReg(destloc.register64.reglo),1);
-                                unget_para(paraloc^.next^.next^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,destloc.register64.reglo,1);
-                              end
-                            else
-                              begin
-                                { paraloc^ -> low
-                                  paraloc^.next^.next^.next^.next -> high }
-                                curparaloc:=paraloc;
-                                unget_para(curparaloc^);
-                                gen_alloc_regloc(list,destloc,vardef);
-                                cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^,destloc.register64.reglo,2);
-                                unget_para(curparaloc^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^,cg.GetNextReg(destloc.register64.reglo),1);
-                                unget_para(curparaloc^.next^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^,cg.GetNextReg(cg.GetNextReg(destloc.register64.reglo)),1);
-                                unget_para(curparaloc^.next^.next^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^.next^,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(destloc.register64.reglo))),1);
-
-                                curparaloc:=paraloc^.next^.next^.next^.next;
-                                unget_para(curparaloc^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^,destloc.register64.reghi,2);
-                                unget_para(curparaloc^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^,cg.GetNextReg(destloc.register64.reghi),1);
-                                unget_para(curparaloc^.next^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^,cg.GetNextReg(cg.GetNextReg(destloc.register64.reghi)),1);
-                                unget_para(curparaloc^.next^.next^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^.next^,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(destloc.register64.reghi))),1);
-                              end;
-{$endif defined(cpu8bitalu)}
-{$if defined(cpu16bitalu) or defined(cpu8bitalu)}
-                          { 4 paralocs? }
-                          4:
-                            if (target_info.endian=ENDIAN_BIG) then
-                              begin
-                                { paraloc^ -> high
-                                  paraloc^.next^.next -> low }
-                                unget_para(paraloc^);
-                                gen_alloc_regloc(list,destloc,vardef);
-                                { reg->reg, alignment is irrelevant }
-                                cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,cg.GetNextReg(destloc.register64.reghi),2);
-                                unget_para(paraloc^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,destloc.register64.reghi,2);
-                                unget_para(paraloc^.next^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,cg.GetNextReg(destloc.register64.reglo),2);
-                                unget_para(paraloc^.next^.next^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,destloc.register64.reglo,2);
-                              end
-                            else
-                              begin
-                                { paraloc^ -> low
-                                  paraloc^.next^.next -> high }
-                                unget_para(paraloc^);
-                                gen_alloc_regloc(list,destloc,vardef);
-                                cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,destloc.register64.reglo,2);
-                                unget_para(paraloc^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,cg.GetNextReg(destloc.register64.reglo),2);
-                                unget_para(paraloc^.next^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,destloc.register64.reghi,2);
-                                unget_para(paraloc^.next^.next^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,cg.GetNextReg(destloc.register64.reghi),2);
-                              end;
-{$endif defined(cpu16bitalu) or defined(cpu8bitalu)}
-                          2:
-                            if (target_info.endian=ENDIAN_BIG) then
-                              begin
-                                { paraloc^ -> high
-                                  paraloc^.next -> low }
-                                unget_para(paraloc^);
-                                gen_alloc_regloc(list,destloc,vardef);
-                                { reg->reg, alignment is irrelevant }
-                                cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reghi,4);
-                                unget_para(paraloc^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reglo,4);
-                              end
-                            else
-                              begin
-                                { paraloc^ -> low
-                                  paraloc^.next -> high }
-                                unget_para(paraloc^);
-                                gen_alloc_regloc(list,destloc,vardef);
-                                cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reglo,4);
-                                unget_para(paraloc^.next^);
-                                cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reghi,4);
-                              end;
-                          else
-                            { unexpected number of paralocs }
-                            internalerror(200410104);
-                        end;
-                      end;
-                    LOC_REFERENCE:
-                      begin
-                        gen_alloc_regloc(list,destloc,vardef);
-                        reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset,ctempposinvalid,para.alignment,[]);
-                        cg64.a_load64_ref_reg(list,href,destloc.register64);
-                        unget_para(paraloc^);
-                      end;
-                    else
-                      internalerror(2005101501);
-                  end
-                end
-              else
-{$endif cpu64bitalu}
-                begin
-                  if assigned(paraloc^.next) then
-                    begin
-                      if (destloc.size in [OS_PAIR,OS_SPAIR]) and
-                        (para.Size in [OS_PAIR,OS_SPAIR]) then
-                        begin
-                          unget_para(paraloc^);
-                          gen_alloc_regloc(list,destloc,vardef);
-                          cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^,destloc.register,sizeof(aint));
-                          unget_para(paraloc^.Next^);
-                          {$if defined(cpu16bitalu) or defined(cpu8bitalu)}
-                            cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^.Next^,cg.GetNextReg(destloc.register),sizeof(aint));
-                          {$else}
-                            cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^.Next^,destloc.registerhi,sizeof(aint));
-                          {$endif}
-                        end
-{$if defined(cpu8bitalu)}
-                      else if (destloc.size in [OS_32,OS_S32]) and
-                        (para.Size in [OS_32,OS_S32]) then
-                        begin
-                          unget_para(paraloc^);
-                          gen_alloc_regloc(list,destloc,vardef);
-                          cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^,destloc.register,sizeof(aint));
-                          unget_para(paraloc^.Next^);
-                          cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^,cg.GetNextReg(destloc.register),sizeof(aint));
-                          unget_para(paraloc^.Next^.Next^);
-                          cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^.Next^,cg.GetNextReg(cg.GetNextReg(destloc.register)),sizeof(aint));
-                          unget_para(paraloc^.Next^.Next^.Next^);
-                          cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^.Next^.Next^,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(destloc.register))),sizeof(aint));
-                        end
-{$endif defined(cpu8bitalu)}
-                      else
-                        begin
-                          { this can happen if a parameter is spread over
-                            multiple paralocs, e.g. if a record with two single
-                            fields must be passed in two single precision
-                            registers }
-                          { does it fit in the register of destloc? }
-                          sizeleft:=para.intsize;
-                          if sizeleft<>vardef.size then
-                            internalerror(2014122806);
-                          if sizeleft<>tcgsize2size[destloc.size] then
-                            internalerror(200410105);
-                          { store everything first to memory, then load it in
-                            destloc }
-                          tg.gettemp(list,sizeleft,sizeleft,tt_persistent,tempref);
-                          gen_alloc_regloc(list,destloc,vardef);
-                          while sizeleft>0 do
-                            begin
-                              if not assigned(paraloc) then
-                                internalerror(2014122807);
-                              unget_para(paraloc^);
-                              cg.a_load_cgparaloc_ref(list,paraloc^,tempref,sizeleft,newalignment(para.alignment,para.intsize-sizeleft));
-                              if (paraloc^.size=OS_NO) and
-                                 assigned(paraloc^.next) then
-                                internalerror(2014122805);
-                              inc(tempref.offset,tcgsize2size[paraloc^.size]);
-                              dec(sizeleft,tcgsize2size[paraloc^.size]);
-                              paraloc:=paraloc^.next;
-                            end;
-                          dec(tempref.offset,para.intsize);
-                          cg.a_load_ref_reg(list,para.size,para.size,tempref,destloc.register);
-                          tg.ungettemp(list,tempref);
-                        end;
-                    end
-                  else
-                    begin
-                      unget_para(paraloc^);
-                      gen_alloc_regloc(list,destloc,vardef);
-                      { we can't directly move regular registers into fpu
-                        registers }
-                      if getregtype(paraloc^.register)=R_FPUREGISTER then
-                        begin
-                          { store everything first to memory, then load it in
-                            destloc }
-                          tg.gettemp(list,tcgsize2size[paraloc^.size],para.intsize,tt_persistent,tempref);
-                          cg.a_load_cgparaloc_ref(list,paraloc^,tempref,tcgsize2size[paraloc^.size],tempref.alignment);
-                          cg.a_load_ref_reg(list,int_cgsize(tcgsize2size[paraloc^.size]),destloc.size,tempref,destloc.register);
-                          tg.ungettemp(list,tempref);
-                        end
-                      else
-                        cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,sizeof(aint));
-                    end;
-                end;
-            end;
-          LOC_FPUREGISTER,
-          LOC_CFPUREGISTER :
-            begin
-{$ifdef mips}
-              if (destloc.size = paraloc^.Size) and
-                 (paraloc^.Loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER,LOC_REFERENCE,LOC_CREFERENCE]) then
-                begin
-                  unget_para(paraloc^);
-                  gen_alloc_regloc(list,destloc,vardef);
-                  cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,para.alignment);
-                end
-              else if (destloc.size = OS_F32) and
-                 (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then
-                begin
-                  gen_alloc_regloc(list,destloc,vardef);
-                  unget_para(paraloc^);
-                  list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.register,destloc.register));
-                end
-{ TODO: Produces invalid code, needs fixing together with regalloc setup. }
-{
-              else if (destloc.size = OS_F64) and
-                      (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) and
-                      (paraloc^.next^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then
-                begin
-                  gen_alloc_regloc(list,destloc,vardef);
-
-                  tmpreg:=destloc.register;
-                  unget_para(paraloc^);
-                  list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.register,tmpreg));
-                  setsupreg(tmpreg,getsupreg(tmpreg)+1);
-                  unget_para(paraloc^.next^);
-                  list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.Next^.register,tmpreg));
-                end
-}
-              else
-                begin
-                  sizeleft := TCGSize2Size[destloc.size];
-                  tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref);
-                  href:=tempref;
-                  while assigned(paraloc) do
-                    begin
-                      unget_para(paraloc^);
-                      cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment);
-                      inc(href.offset,TCGSize2Size[paraloc^.size]);
-                      dec(sizeleft,TCGSize2Size[paraloc^.size]);
-                      paraloc:=paraloc^.next;
-                    end;
-                  gen_alloc_regloc(list,destloc,vardef);
-                  cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register);
-                  tg.UnGetTemp(list,tempref);
-                end;
-{$else mips}
-{$if defined(sparc) or defined(arm)}
-              { Arm and Sparc passes floats in int registers, when loading to fpu register
-                we need a temp }
-              sizeleft := TCGSize2Size[destloc.size];
-              tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref);
-              href:=tempref;
-              while assigned(paraloc) do
-                begin
-                  unget_para(paraloc^);
-                  cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment);
-                  inc(href.offset,TCGSize2Size[paraloc^.size]);
-                  dec(sizeleft,TCGSize2Size[paraloc^.size]);
-                  paraloc:=paraloc^.next;
-                end;
-              gen_alloc_regloc(list,destloc,vardef);
-              cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register);
-              tg.UnGetTemp(list,tempref);
-{$else defined(sparc) or defined(arm)}
-              unget_para(paraloc^);
-              gen_alloc_regloc(list,destloc,vardef);
-              { from register to register -> alignment is irrelevant }
-              cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0);
-              if assigned(paraloc^.next) then
-                internalerror(200410109);
-{$endif defined(sparc) or defined(arm)}
-{$endif mips}
-            end;
-          LOC_MMREGISTER,
-          LOC_CMMREGISTER :
-            begin
-{$ifndef cpu64bitalu}
-              { ARM vfp floats are passed in integer registers }
-              if (para.size=OS_F64) and
-                 (paraloc^.size in [OS_32,OS_S32]) and
-                 use_vectorfpu(vardef) then
-                begin
-                  { we need 2x32bit reg }
-                  if not assigned(paraloc^.next) or
-                     assigned(paraloc^.next^.next) then
-                    internalerror(2009112421);
-                  unget_para(paraloc^.next^);
-                  case paraloc^.next^.loc of
-                    LOC_REGISTER:
-                      tempreg:=paraloc^.next^.register;
-                    LOC_REFERENCE:
-                      begin
-                        tempreg:=cg.getintregister(list,OS_32);
-                        cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,tempreg,4);
-                      end;
-                    else
-                      internalerror(2012051301);
-                  end;
-                  { don't free before the above, because then the getintregister
-                    could reallocate this register and overwrite it }
-                  unget_para(paraloc^);
-                  gen_alloc_regloc(list,destloc,vardef);
-                  if (target_info.endian=endian_big) then
-                    { paraloc^ -> high
-                      paraloc^.next -> low }
-                    reg64:=joinreg64(tempreg,paraloc^.register)
-                  else
-                    reg64:=joinreg64(paraloc^.register,tempreg);
-                  cg64.a_loadmm_intreg64_reg(list,OS_F64,reg64,destloc.register);
-                end
-              else
-{$endif not cpu64bitalu}
-                begin
-                  if not assigned(paraloc^.next) then
-                    begin
-                      unget_para(paraloc^);
-                      gen_alloc_regloc(list,destloc,vardef);
-                      { from register to register -> alignment is irrelevant }
-                      cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0);
-                    end
-                  else
-                    begin
-                      internalerror(200410108);
-                    end;
-                  { data could come in two memory locations, for now
-                    we simply ignore the sanity check (FK)
-                  if assigned(paraloc^.next) then
-                    internalerror(200410108);
-                  }
-                end;
-            end;
-          else
-            internalerror(2010052903);
-        end;
-      end;
-
-
-    procedure gen_load_para_value(list:TAsmList);
-
-       procedure get_para(const paraloc:TCGParaLocation);
-         begin
-            case paraloc.loc of
-              LOC_REGISTER :
-                begin
-                  if getsupreg(paraloc.register)<first_int_imreg then
-                    cg.getcpuregister(list,paraloc.register);
-                end;
-              LOC_MMREGISTER :
-                begin
-                  if getsupreg(paraloc.register)<first_mm_imreg then
-                    cg.getcpuregister(list,paraloc.register);
-                end;
-              LOC_FPUREGISTER :
-                begin
-                  if getsupreg(paraloc.register)<first_fpu_imreg then
-                    cg.getcpuregister(list,paraloc.register);
-                end;
-            end;
-         end;
-
-
-      var
-        i : longint;
-        currpara : tparavarsym;
-        paraloc  : pcgparalocation;
-      begin
-        if (po_assembler in current_procinfo.procdef.procoptions) or
-        { exceptfilters have a single hidden 'parentfp' parameter, which
-          is handled by tcg.g_proc_entry. }
-           (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
-          exit;
-
-        { Allocate registers used by parameters }
-        for i:=0 to current_procinfo.procdef.paras.count-1 do
-          begin
-            currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
-            paraloc:=currpara.paraloc[calleeside].location;
-            while assigned(paraloc) do
-              begin
-                if paraloc^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER] then
-                  get_para(paraloc^);
-                paraloc:=paraloc^.next;
-              end;
-          end;
-
-        { Copy parameters to local references/registers }
-        for i:=0 to current_procinfo.procdef.paras.count-1 do
-          begin
-            currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
-            { don't use currpara.vardef, as this will be wrong in case of
-              call-by-reference parameters (it won't contain the pointerdef) }
-            gen_load_cgpara_loc(list,currpara.paraloc[calleeside].def,currpara.paraloc[calleeside],currpara.initialloc,paramanager.param_use_paraloc(currpara.paraloc[calleeside]));
-            { gen_load_cgpara_loc() already allocated the initialloc
-              -> don't allocate again }
-            if currpara.initialloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER] then
-              begin
-                gen_alloc_regvar(list,currpara,false);
-                hlcg.varsym_set_localloc(list,currpara);
-              end;
-          end;
-
-        { generate copies of call by value parameters, must be done before
-          the initialization and body is parsed because the refcounts are
-          incremented using the local copies }
-        current_procinfo.procdef.parast.SymList.ForEachCall(@hlcg.g_copyvalueparas,list);
-        if not(po_assembler in current_procinfo.procdef.procoptions) then
-          begin
-            { initialize refcounted paras, and trash others. Needed here
-              instead of in gen_initialize_code, because when a reference is
-              intialised or trashed while the pointer to that reference is kept
-              in a regvar, we add a register move and that one again has to
-              come after the parameter loading code as far as the register
-              allocator is concerned }
-            current_procinfo.procdef.parast.SymList.ForEachCall(@init_paras,list);
-          end;
-      end;
-
-
 {****************************************************************************
                                 Entry/Exit
 ****************************************************************************}

compiler/nflw.pas

@@ -29,7 +29,7 @@ interface
     uses
       cclasses,
       node,cpubase,
-      symtype,symbase,symdef,symsym,
+      symconst,symtype,symbase,symdef,symsym,
       optloop;
 
     type
@@ -197,7 +197,6 @@ interface
           function pass_1 : tnode;override;
           function simplify(forinline:boolean): tnode;override;
        protected
-          function create_finalizer_procdef: tprocdef;
           procedure adjust_estimated_stack_size; virtual;
        end;
        ttryfinallynodeclass = class of ttryfinallynode;
@@ -243,9 +242,8 @@ implementation
     uses
       globtype,systems,constexp,compinnr,
       cutils,verbose,globals,
-      symconst,symtable,paramgr,defcmp,defutil,htypechk,pass_1,
+      symtable,paramgr,defcmp,defutil,htypechk,pass_1,
       ncal,nadd,ncon,nmem,nld,ncnv,nbas,nutils,ninl,nset,ngenutil,
-      pdecsub,
     {$ifdef state_tracking}
       nstate,
     {$endif}
@@ -1773,8 +1771,9 @@ implementation
 
     function texitnode.pass_typecheck:tnode;
       var
-        pd: tprocdef;
         newstatement : tstatementnode;
+        ressym: tsym;
+        resdef: tdef;
       begin
         result:=nil;
         newstatement:=nil;
@@ -1790,16 +1789,13 @@ implementation
           because the code to this that we add in tnodeutils.wrap_proc_body()
           gets inserted before the exit label to which this node will jump }
         if (target_info.system in systems_fpnestedstruct) and
-           not(nf_internal in flags) then
+           not(nf_internal in flags) and
+           current_procinfo.procdef.getfuncretsyminfo(ressym,resdef) and
+           (tabstractnormalvarsym(ressym).inparentfpstruct) then
           begin
-            pd:=current_procinfo.procdef;
-            if assigned(pd.funcretsym) and
-               tabstractnormalvarsym(pd.funcretsym).inparentfpstruct then
-              begin
-                if not assigned(result) then
-                  result:=internalstatements(newstatement);
-                cnodeutils.load_parentfpstruct_nested_funcret(current_procinfo.procdef,newstatement);
-              end;
+            if not assigned(result) then
+              result:=internalstatements(newstatement);
+            cnodeutils.load_parentfpstruct_nested_funcret(ressym,newstatement);
           end;
         if assigned(result) then
           begin
@@ -1973,7 +1969,6 @@ implementation
                     if assigned(labelsym.jumpbuf) then
                       begin
                         labelsym.nonlocal:=true;
-                        exclude(current_procinfo.procdef.procoptions,po_inline);
                         result:=ccallnode.createintern('fpc_longjmp',
                           ccallparanode.create(cordconstnode.create(1,sinttype,true),
                           ccallparanode.create(cloadnode.create(labelsym.jumpbuf,labelsym.jumpbuf.owner),
@@ -2108,12 +2103,6 @@ implementation
 
         include(current_procinfo.flags,pi_has_label);
 
-        if assigned(labsym) and labsym.nonlocal then
-          begin
-            include(current_procinfo.flags,pi_has_interproclabel);
-            exclude(current_procinfo.procdef.procoptions,po_inline);
-          end;
-
         if assigned(left) then
           firstpass(left);
         if (m_non_local_goto in current_settings.modeswitches) and
@@ -2360,53 +2349,6 @@ implementation
      end;
 
 
-    var
-      seq: longint=0;
-
-    function ttryfinallynode.create_finalizer_procdef: tprocdef;
-      var
-        st:TSymTable;
-        checkstack: psymtablestackitem;
-        oldsymtablestack: tsymtablestack;
-        sym:tprocsym;
-      begin
-        { get actual procedure symtable (skip withsymtables, etc.) }
-        st:=nil;
-        checkstack:=symtablestack.stack;
-        while assigned(checkstack) do
-          begin
-            st:=checkstack^.symtable;
-            if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
-              break;
-            checkstack:=checkstack^.next;
-          end;
-        { Create a nested procedure, even from main_program_level.
-          Furthermore, force procdef and procsym into the same symtable
-          (by default, defs are registered with symtablestack.top which may be
-          something temporary like exceptsymtable - in that case, procdef can be
-          destroyed before procsym, leaving invalid pointers). }
-        oldsymtablestack:=symtablestack;
-        symtablestack:=nil;
-        result:=cprocdef.create(max(normal_function_level,st.symtablelevel)+1,true);
-        symtablestack:=oldsymtablestack;
-        st.insertdef(result);
-        result.struct:=current_procinfo.procdef.struct;
-        { tabstractprocdef constructor sets po_delphi_nested_cc whenever
-          nested procvars modeswitch is active. We must be independent of this switch. }
-        exclude(result.procoptions,po_delphi_nested_cc);
-        result.proctypeoption:=potype_exceptfilter;
-        handle_calling_convention(result);
-        sym:=cprocsym.create('$fin$'+tostr(seq));
-        st.insert(sym);
-        inc(seq);
-
-        result.procsym:=sym;
-        proc_add_definition(result);
-        result.forwarddef:=false;
-        result.aliasnames.insert(result.mangledname);
-      end;
-
-
     procedure ttryfinallynode.adjust_estimated_stack_size;
       begin
         inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size);

compiler/ngenutil.pas

@@ -74,7 +74,7 @@ interface
         the value to be returned; replacing it with an absolutevarsym that
         redirects to the field in the parentfpstruct doesn't work, as the code
         generator cannot deal with such symbols }
-       class procedure load_parentfpstruct_nested_funcret(pd: tprocdef; var stat: tstatementnode);
+       class procedure load_parentfpstruct_nested_funcret(ressym: tsym; var stat: tstatementnode);
       { called after parsing a routine with the code of the entire routine
         as argument; can be used to modify the node tree. By default handles
         insertion of code for systems that perform the typed constant
@@ -579,17 +579,17 @@ implementation
     end;
 
 
-  class procedure tnodeutils.load_parentfpstruct_nested_funcret(pd: tprocdef; var stat: tstatementnode);
+  class procedure tnodeutils.load_parentfpstruct_nested_funcret(ressym: tsym; var stat: tstatementnode);
     var
       target: tnode;
     begin
-      target:=cloadnode.create(pd.funcretsym, pd.funcretsym.owner);
+      target:=cloadnode.create(ressym, ressym.owner);
       { ensure the target of this assignment doesn't translate the
         funcretsym also to its alias in the parentfpstruct }
       include(target.flags, nf_internal);
       addstatement(stat,
         cassignmentnode.create(
-          target, cloadnode.create(pd.funcretsym, pd.funcretsym.owner)
+          target, cloadnode.create(ressym, ressym.owner)
         )
       );
     end;
@@ -599,7 +599,9 @@ implementation
     var
       stat: tstatementnode;
       block: tnode;
+      ressym,
       psym: tsym;
+      resdef: tdef;
     begin
       result:=maybe_insert_trashing(pd,n);
 
@@ -669,16 +671,14 @@ implementation
             end;
           end;
         end;
-      if target_info.system in systems_fpnestedstruct then
+      if (target_info.system in systems_fpnestedstruct) and
+         pd.getfuncretsyminfo(ressym,resdef) and
+         (tabstractnormalvarsym(ressym).inparentfpstruct) then
         begin
-          if assigned(pd.funcretsym) and
-             tabstractnormalvarsym(pd.funcretsym).inparentfpstruct then
-            begin
-              block:=internalstatements(stat);
-              addstatement(stat,result);
-              load_parentfpstruct_nested_funcret(pd,stat);
-              result:=block;
-            end;
+          block:=internalstatements(stat);
+          addstatement(stat,result);
+          load_parentfpstruct_nested_funcret(ressym,stat);
+          result:=block;
         end;
     end;
 

compiler/ninl.pas

@@ -90,9 +90,9 @@ interface
           function first_seg: tnode; virtual;
           function first_sar: tnode; virtual;
           function first_fma : tnode; virtual;
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
           function first_ShiftRot_assign_64bitint: tnode; virtual;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
           function first_AndOrXorShiftRot_assign: tnode; virtual;
           function first_NegNot_assign: tnode; virtual;
           function first_cpu : tnode; virtual;
@@ -1240,7 +1240,7 @@ implementation
 
         { reverse the parameters (needed to get the colon parameters in the }
         { correct order when processing write(ln)                           }
-        left := reverseparameters(tcallparanode(left));
+        reverseparameters(tcallparanode(left));
 
         if is_rwstr then
           begin
@@ -1526,7 +1526,7 @@ implementation
         valsinttype:=search_system_type('VALSINT').typedef;
 
         { reverse parameters for easier processing }
-        left := reverseparameters(tcallparanode(left));
+        reverseparameters(tcallparanode(left));
 
         { get the parameters }
         tempcode := nil;
@@ -5228,7 +5228,7 @@ implementation
        end;
 
 
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
      function tinlinenode.first_ShiftRot_assign_64bitint: tnode;
        var
          procname: string[31];
@@ -5266,18 +5266,18 @@ implementation
          tcallparanode(left).left := nil;
          firstpass(result);
        end;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and nto cpuhighleveltarget}
 
 
      function tinlinenode.first_AndOrXorShiftRot_assign: tnode;
        begin
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
          { 64 bit ints have their own shift handling }
          if is_64bit(tcallparanode(left).right.resultdef) and
             (inlinenumber in [in_sar_assign_x_y,in_shl_assign_x_y,in_shr_assign_x_y,in_rol_assign_x_y,in_ror_assign_x_y]) then
            result := first_ShiftRot_assign_64bitint
          else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
            begin
              result:=nil;
              expectloc:=tcallparanode(tcallparanode(left).right).left.expectloc;

compiler/nld.pas

@@ -332,7 +332,7 @@ implementation
                      internalerror(200309289);
                    left:=cloadparentfpnode.create(tprocdef(symtable.defowner),lpf_forload);
                    { we can't inline the referenced parent procedure }
-                   exclude(tprocdef(symtable.defowner).procoptions,po_inline);
+                   include(tprocdef(symtable.defowner).implprocoptions,pio_nested_access);
                    { reference in nested procedures, variable needs to be in memory }
                    { and behaves as if its address escapes its parent block         }
                    make_not_regable(self,[ra_different_scope]);

compiler/nmat.pas

@@ -47,14 +47,14 @@ interface
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function simplify(forinline : boolean) : tnode;override;
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
           { override the following if you want to implement }
           { parts explicitely in the code generator (CEC)
             Should return nil, if everything will be handled
             in the code generator
           }
           function first_shlshr64bitint: tnode; virtual;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
        end;
        tshlshrnodeclass = class of tshlshrnode;
 
@@ -183,15 +183,15 @@ implementation
         { not with an ifdef around the call to this routine, because e.g. the
           Java VM has a signed 64 bit division opcode, but not an unsigned
           one }
-{$ifdef cpu64bitalu}
+{$if defined(cpu64bitalu) or defined(cpuhighleveltarget)}
         result:=false;
-{$else cpu64bitalu}
+{$else cpu64bitalu or cpuhighleveltarget}
         result:=
           (left.resultdef.typ=orddef) and
           (right.resultdef.typ=orddef) and
           { include currency as well }
           (is_64bit(left.resultdef) or is_64bit(right.resultdef));
-{$endif cpu64bitaly}
+{$endif cpu64bitalu or cpuhighleveltarget}
       end;
 
 
@@ -503,14 +503,14 @@ implementation
         { divide/mod a number by a constant which is a power of 2? }
         if (right.nodetype = ordconstn) and
           isabspowerof2(tordconstnode(right).value,power) and
-{$ifdef cpu64bitalu}
+{$if defined(cpu64bitalu) or defined(cpuhighleveltarget)}
           { for 64 bit, we leave the optimization to the cg }
             (not is_signed(resultdef)) then
-{$else cpu64bitalu}
+{$else cpu64bitalu or cpuhighleveltarget}
            (((nodetype=divn) and is_oversizedord(resultdef)) or
             (nodetype=modn) or
             not is_signed(resultdef)) then
-{$endif cpu64bitalu}
+{$endif cpu64bitalu or cpuhighleveltarget}
           begin
             if nodetype=divn then
               begin
@@ -848,7 +848,7 @@ implementation
       end;
 
 
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
     function tshlshrnode.first_shlshr64bitint: tnode;
       var
         procname: string[31];
@@ -874,7 +874,7 @@ implementation
         right := nil;
         firstpass(result);
       end;
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
 
 
     function tshlshrnode.pass_1 : tnode;
@@ -887,7 +887,7 @@ implementation
          if codegenerror then
            exit;
 
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
          { 64 bit ints have their own shift handling }
          if is_64bit(left.resultdef) then
            begin
@@ -897,7 +897,7 @@ implementation
              regs:=2;
            end
          else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
            begin
              regs:=1
            end;
@@ -1354,14 +1354,14 @@ implementation
              expectloc:=LOC_MMXREGISTER
          else
 {$endif SUPPORT_MMX}
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
            if is_64bit(left.resultdef) then
              begin
                 if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
                   expectloc:=LOC_REGISTER;
              end
          else
-{$endif not cpu64bitalu}
+{$endif not cpu64bitalu and not cpuhighleveltarget}
            if is_integer(left.resultdef) then
              expectloc:=LOC_REGISTER;
       end;

compiler/nmem.pas

@@ -136,25 +136,12 @@ interface
        end;
        tvecnodeclass = class of tvecnode;
 
-       twithnode = class(tunarynode)
-          constructor create(l:tnode);
-          destructor destroy;override;
-          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function dogetcopy : tnode;override;
-          function pass_1 : tnode;override;
-          function docompare(p: tnode): boolean; override;
-          function pass_typecheck:tnode;override;
-       end;
-       twithnodeclass = class of twithnode;
-
     var
        cloadvmtaddrnode : tloadvmtaddrnodeclass= tloadvmtaddrnode;
        caddrnode : taddrnodeclass= taddrnode;
        cderefnode : tderefnodeclass= tderefnode;
        csubscriptnode : tsubscriptnodeclass= tsubscriptnode;
        cvecnode : tvecnodeclass= tvecnode;
-       cwithnode : twithnodeclass= twithnode;
        cloadparentfpnode : tloadparentfpnodeclass = tloadparentfpnode;
 
     function is_big_untyped_addrnode(p: tnode): boolean;
@@ -1315,66 +1302,6 @@ implementation
     end;
 
 
-{*****************************************************************************
-                               TWITHNODE
-*****************************************************************************}
-
-    constructor twithnode.create(l:tnode);
-      begin
-         inherited create(withn,l);
-         fileinfo:=l.fileinfo;
-      end;
-
-
-    destructor twithnode.destroy;
-      begin
-        inherited destroy;
-      end;
-
-
-    constructor twithnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-      end;
-
-
-    procedure twithnode.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-      end;
-
-
-    function twithnode.dogetcopy : tnode;
-      var
-         p : twithnode;
-      begin
-         p:=twithnode(inherited dogetcopy);
-         result:=p;
-      end;
-
-
-    function twithnode.pass_typecheck:tnode;
-      begin
-        result:=nil;
-        resultdef:=voidtype;
-        if assigned(left) then
-          typecheckpass(left);
-      end;
-
-
-    function twithnode.pass_1 : tnode;
-      begin
-        result:=nil;
-        expectloc:=LOC_VOID;
-      end;
-
-
-    function twithnode.docompare(p: tnode): boolean;
-      begin
-        docompare :=
-          inherited docompare(p);
-      end;
-
     function is_big_untyped_addrnode(p: tnode): boolean;
       begin
         is_big_untyped_addrnode:=(p.nodetype=addrn) and

compiler/nobj.pas

@@ -511,6 +511,7 @@ implementation
         hclass : tobjectdef;
         hashedid : THashedIDString;
         srsym      : tsym;
+        overload: boolean;
       begin
         result:=nil;
         hashedid.id:=name;
@@ -519,11 +520,16 @@ implementation
           begin
             srsym:=tsym(hclass.symtable.FindWithHash(hashedid));
             if assigned(srsym) and
-               (srsym.typ=procsym) then
+               (srsym.typ=procsym) and
+               ((hclass=_class) or
+                is_visible_for_object(srsym,_class)) then
               begin
+                overload:=false;
                 for i:=0 to Tprocsym(srsym).ProcdefList.Count-1 do
                   begin
                     implprocdef:=tprocdef(tprocsym(srsym).ProcdefList[i]);
+                    if po_overload in implprocdef.procoptions then
+                      overload:=true;
                     if (implprocdef.procsym=tprocsym(srsym)) and
                        (compare_paras(proc.paras,implprocdef.paras,cp_all,[cpo_ignorehidden,cpo_ignoreuniv])>=te_equal) and
                        (compare_defs(proc.returndef,implprocdef.returndef,nothingn)>=te_equal) and
@@ -544,6 +550,10 @@ implementation
                         exit;
                       end;
                   end;
+                { like with normal procdef resolution (in htypechk), stop if
+                  we encounter a proc without the overload directive }
+                if not overload then
+                  exit;
               end;
             hclass:=hclass.childof;
           end;

compiler/node.pas

@@ -86,7 +86,6 @@ interface
           whilerepeatn,     {A while or repeat statement}
           forn,             {A for loop}
           exitn,            {An exit statement}
-          withn,            {A with statement}
           casen,            {A case statement}
           labeln,           {A label}
           goton,            {A goto statement}
@@ -171,7 +170,6 @@ interface
           'whilerepeatn',
           'forn',
           'exitn',
-          'withn',
           'casen',
           'labeln',
           'goton',

compiler/nset.pas

@@ -62,6 +62,12 @@ interface
           { label (only used in pass_generate_code) }
           blocklabel : tasmlabel;
 
+          { shortcut - set to true if blocklabel isn't actually unique to the
+            case block due to one of the following conditions:
+            - if the node contains a jump, then the label is set to that jump's destination,
+            - if the node is empty, the label is set to the end label. }
+          shortcut: Boolean;
+
           statementlabel : tlabelnode;
           { instructions }
           statement  : tnode;
@@ -121,6 +127,9 @@ interface
 
     { counts the labels }
     function case_count_labels(root : pcaselabel) : longint;
+    { Returns the true count in a case block, which includes each individual
+      value in a range (e.g. "0..2" counts as 3) }
+    function case_true_count(root : pcaselabel) : longint;
     { searches the highest label }
     function case_get_max(root : pcaselabel) : tconstexprint;
     { searches the lowest label }
@@ -439,6 +448,29 @@ implementation
       end;
 
 
+    { Returns the true count in a case block, which includes each individual
+      value in a range (e.g. "0..2" counts as 3) }
+    function case_true_count(root : pcaselabel) : longint;
+      var
+         _l : longint;
+
+      procedure count(p : pcaselabel);
+        begin
+           inc(_l, (p^._high.svalue - p^._low.svalue) + 1);
+           if assigned(p^.less) then
+             count(p^.less);
+           if assigned(p^.greater) then
+             count(p^.greater);
+        end;
+
+      begin
+        _l:=0;
+        count(root);
+        case_true_count:=_l;
+      end;
+
+
+
     function case_get_max(root : pcaselabel) : tconstexprint;
       var
          hp : pcaselabel;

compiler/nutils.pas

@@ -127,6 +127,9 @@ interface
     { returns true, if the tree given might have side effects }
     function might_have_sideeffects(n : tnode;const flags : tmhs_flags = []) : boolean;
 
+    { returns true, if n contains nodes which might be conditionally executed }
+    function has_conditional_nodes(n : tnode) : boolean;
+
     { count the number of nodes in the node tree,
       rough estimation how large the tree "node" is }
     function node_count(node : tnode) : dword;
@@ -1378,6 +1381,23 @@ implementation
         result:=foreachnodestatic(n,@check_for_sideeffect,@flags);
       end;
 
+
+    function check_for_conditional_nodes(var n: tnode; arg: pointer): foreachnoderesult;
+      begin
+        result:=fen_false;
+        { this check is not complete yet, but sufficent to cover the current use case: swapping
+          of trees in expressions }
+        if (n.nodetype in [ifn,whilerepeatn,forn,tryexceptn]) or
+          ((n.nodetype in [orn,andn]) and is_boolean(n.resultdef) and doshortbooleval(n)) then
+          result:=fen_norecurse_true;
+      end;
+
+
+    function has_conditional_nodes(n : tnode) : boolean;
+      begin
+        result:=foreachnodestatic(n,@check_for_conditional_nodes,nil);
+      end;
+
     var
       nodecount : dword;
 

compiler/ogomf.pas

@@ -1553,6 +1553,8 @@ implementation
         Thread: TOmfSubRecord_THREAD;
         FixuppWithoutLeOrLiData: Boolean=False;
       begin
+        objsec:=nil;
+        EnumeratedDataOffset:=0;
         Result:=False;
         case RawRec.RecordType of
           RT_LEDATA,RT_LEDATA32:
@@ -2684,7 +2686,7 @@ implementation
             ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]);
             if ObjSec.MemPos<Header.LoadableImageSize then
               begin
-                FWriter.WriteZeros(max(0,ObjSec.MemPos-ComFileOffset-FWriter.Size));
+                FWriter.WriteZeros(max(0,int64(ObjSec.MemPos)-ComFileOffset-int64(FWriter.Size)));
                 if assigned(ObjSec.Data) then
                   begin
                     if ObjSec.MemPos<ComFileOffset then

compiler/optconstprop.pas

@@ -92,7 +92,7 @@ unit optconstprop;
           iterate manually here so we have full controll how all nodes are processed }
 
         { We cannot analyze beyond those nodes, so we terminate to be on the safe side }
-        if (n.nodetype in [addrn,derefn,asmn,withn,casen,whilerepeatn,labeln,continuen,breakn,
+        if (n.nodetype in [addrn,derefn,asmn,casen,whilerepeatn,labeln,continuen,breakn,
                            tryexceptn,raisen,tryfinallyn,onn,loadparentfpn,loadvmtaddrn,guidconstn,rttin,addoptn,asn,goton,
                            objcselectorn,objcprotocoln]) then
           exit(false)

compiler/options.pas

@@ -138,8 +138,8 @@ const
                         + [system_i386_wdosx]
                         + [system_riscv32_linux,system_riscv64_linux];
 
-  suppported_targets_x_smallr = systems_linux + systems_solaris
-                             + [system_i386_haiku]
+  suppported_targets_x_smallr = systems_linux + systems_solaris + systems_android
+                             + [system_i386_haiku,system_x86_64_haiku]
                              + [system_i386_beos]
                              + [system_m68k_amiga];
 
@@ -963,15 +963,27 @@ begin
     system_powerpc64_darwin,
     system_i386_darwin:
       begin
+{$ifdef llvm}
+        { We only support libunwind as part of libsystem }
+        set_system_compvar('MAC_OS_X_VERSION_MIN_REQUIRED','1060');
+        MacOSXVersionMin:='10.6';
+{$else llvm}
         set_system_compvar('MAC_OS_X_VERSION_MIN_REQUIRED','1040');
         MacOSXVersionMin:='10.4';
+{$endif llvm}
       end;
     system_x86_64_darwin:
       begin
+{$ifdef llvm}
+        { We only support libunwind as part of libsystem }
+        set_system_compvar('MAC_OS_X_VERSION_MIN_REQUIRED','1060');
+        MacOSXVersionMin:='10.6';
+{$else llvm}
         { actually already works on 10.4, but it's unlikely any 10.4 system
           with an x86-64 is still in use, so don't default to it }
         set_system_compvar('MAC_OS_X_VERSION_MIN_REQUIRED','1050');
         MacOSXVersionMin:='10.5';
+{$endif llvm}
       end;
     system_arm_darwin,
     system_i386_iphonesim:
@@ -4004,11 +4016,17 @@ begin
       Message(option_w_unsupported_debug_format);
 
   { switch assembler if it's binary and we got -a on the cmdline }
-  if (cs_asm_leave in init_settings.globalswitches) and
-     (af_outputbinary in target_asm.flags) then
+  if ((cs_asm_leave in init_settings.globalswitches) and
+     (af_outputbinary in target_asm.flags)) or
+     { if -s is passed, we shouldn't call the internal assembler }
+     (cs_asm_extern in init_settings.globalswitches) then
    begin
      Message(option_switch_bin_to_src_assembler);
+{$ifdef llvm}
+     set_target_asm(as_llvm_clang);
+{$else}
      set_target_asm(target_info.assemextern);
+{$endif}
      { At least i8086 needs that for nasm and -CX
        which is incompatible with internal linker }
      option.checkoptionscompatibility;

compiler/optutils.pas

@@ -318,7 +318,6 @@ unit optutils;
                 { raise never returns }
                 p.successor:=nil;
               end;
-            withn,
             tryexceptn,
             tryfinallyn,
             onn:

compiler/parabase.pas

@@ -118,6 +118,7 @@ unit parabase;
           function    add_location:pcgparalocation;
           procedure   get_location(var newloc:tlocation);
           function    locations_count:integer;
+          function    isempty: boolean; { no data, and not varargs para }
 
           procedure   buildderef;
           procedure   deref;
@@ -161,7 +162,7 @@ implementation
 
     uses
       systems,verbose,
-      symsym;
+      symsym,defutil;
 
 
 {****************************************************************************
@@ -268,7 +269,7 @@ implementation
         case location^.loc of
           LOC_REGISTER :
             begin
-{$ifndef cpu64bitalu}
+{$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
               if size in [OS_64,OS_S64] then
                 begin
                   if not assigned(location^.next) then
@@ -317,6 +318,25 @@ implementation
       end;
 
 
+    function TCGPara.isempty: boolean;
+      var
+        hlocation: pcgparalocation;
+      begin
+        { can happen if e.g. [] is passed to a cdecl varargs para }
+        if not assigned(def) then
+          exit(true);
+        if is_array_of_const(def) then
+          exit(false);
+        hlocation:=location;
+        while assigned(hlocation) do
+          begin
+            if hlocation^.Loc<>LOC_VOID then
+              exit(false);
+            hlocation:=hlocation^.next;
+          end;
+        result:=true;
+      end;
+
     procedure TCGPara.buildderef;
       begin
         defderef.build(def);

compiler/pass_2.pas

@@ -132,7 +132,6 @@ implementation
              'while_repeat', {whilerepeatn}
              'for',         {forn}
              'exitn',       {exitn}
-             'with',        {withn}
              'case',        {casen}
              'label',       {labeln}
              'goto',        {goton}

compiler/pdecl.pas

@@ -61,7 +61,7 @@ implementation
        ninl,ncon,nobj,ngenutil,
        { parser }
        scanner,
-       pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,pgenutil,
+       pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,pgenutil,pparautl,
 {$ifdef jvm}
        pjvm,
 {$endif}
@@ -310,7 +310,7 @@ implementation
                           parse_var_proc_directives(sym);
                        end;
                       { add default calling convention }
-                      handle_calling_convention(tabstractprocdef(hdef));
+                      handle_calling_convention(tabstractprocdef(hdef),hcc_default_actions_intf);
                     end;
                    if not skipequal then
                     begin
@@ -864,7 +864,7 @@ implementation
                                  Comment(V_Error,'Function references are not yet supported, only C blocks (add "cdecl;" at the end)');
                              end
                          end;
-                       handle_calling_convention(tprocvardef(hdef));
+                       handle_calling_convention(tprocvardef(hdef),hcc_default_actions_intf);
                        if try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg) then
                          consume(_SEMICOLON);
                      end;

compiler/pdecobj.pas

@@ -49,9 +49,9 @@ implementation
       symbase,symsym,symtable,symcreat,defcmp,
       node,ncon,
       fmodule,scanner,
-      pbase,pexpr,pdecsub,pdecvar,ptype,pdecl,pgenutil,ppu
+      pbase,pexpr,pdecsub,pdecvar,ptype,pdecl,pgenutil,pparautl,ppu
 {$ifdef jvm}
-      ,pjvm;
+      ,jvmdef,pjvm;
 {$else}
       ;
 {$endif}
@@ -75,12 +75,12 @@ implementation
               // we can't add hidden params here because record is not yet defined
               // and therefore record size which has influence on paramter passing rules may change too
               // look at record_dec to see where calling conventions are applied (issue #0021044)
-              handle_calling_convention(pd,[hcc_check]);
+              handle_calling_convention(pd,[hcc_declaration,hcc_check]);
             end;
           objectdef:
             begin
               parse_object_proc_directives(pd);
-              handle_calling_convention(pd);
+              handle_calling_convention(pd,hcc_default_actions_intf);
             end
           else
             internalerror(2011040502);
@@ -923,7 +923,7 @@ implementation
                      is_classdef and not (po_staticmethod in result.procoptions) then
                     MessagePos(result.fileinfo,parser_e_class_methods_only_static_in_records);
 
-                  handle_calling_convention(result);
+                  handle_calling_convention(result,hcc_default_actions_intf);
 
                   { add definition to procsym }
                   proc_add_definition(result);

compiler/pdecsub.pas

@@ -55,23 +55,11 @@ interface
       );
       tpdflags=set of tpdflag;
 
-      // flags of handle_calling_convention routine
-      thccflag=(
-        hcc_check,                // perform checks and outup errors if found
-        hcc_insert_hidden_paras   // insert hidden parameters
-      );
-      thccflags=set of thccflag;
-    const
-      hcc_all=[hcc_check,hcc_insert_hidden_paras];
-
     function  check_proc_directive(isprocvar:boolean):boolean;
 
-    function  proc_add_definition(var currpd:tprocdef):boolean;
     function  proc_get_importname(pd:tprocdef):string;
     procedure proc_set_mangledname(pd:tprocdef);
 
-    procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
-
     procedure parse_parameter_dec(pd:tabstractprocdef);
     procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
     procedure parse_var_proc_directives(sym:tsym);
@@ -84,8 +72,6 @@ interface
     { parse a record method declaration (not a (class) constructor/destructor) }
     function parse_record_method_dec(astruct: tabstractrecorddef; is_classdef: boolean;hadgeneric:boolean): tprocdef;
 
-    procedure insert_record_hidden_paras(astruct: trecorddef);
-
     { helper functions - they insert nested objects hierarchy to the symtablestack
       with object hierarchy
     }
@@ -107,7 +93,7 @@ implementation
        { assembler }
        aasmbase,
        { symtable }
-       symbase,symcpu,symtable,defutil,defcmp,
+       symbase,symcpu,symtable,symutil,defutil,defcmp,
        { parameter handling }
        paramgr,cpupara,
        { pass 1 }
@@ -128,25 +114,6 @@ implementation
         Declaring it as string here results in an error when compiling (PFV) }
       current_procinfo = 'error';
 
-    { get_first_proc_str - returns the token string of the first option that
-      appears in the list }
-    function get_first_proc_str(Options: TProcOptions): ShortString;
-      var
-        X: TProcOption;
-      begin
-        if Options = [] then
-          InternalError(2018051700);
-
-        get_first_proc_str := '';
-
-        for X := Low(TProcOption) to High(TProcOption) do
-          if X in Options then
-            begin
-              get_first_proc_str := ProcOptionKeywords[X];
-              Exit;
-            end;
-      end;
-
     function push_child_hierarchy(obj:tabstractrecorddef):integer;
       var
         _class,hp : tobjectdef;
@@ -223,19 +190,6 @@ implementation
       end;
 
 
-    procedure set_addr_param_regable(p:TObject;arg:pointer);
-      begin
-        if (tsym(p).typ<>paravarsym) then
-         exit;
-        with tparavarsym(p) do
-         begin
-           if (not needs_finalization) and
-              paramanager.push_addr_param(varspez,vardef,tprocdef(arg).proccalloption) then
-             varregable:=vr_addr;
-         end;
-      end;
-
-
     procedure parse_parameter_dec(pd:tabstractprocdef);
       {
         handle_procvar needs the same changes
@@ -403,7 +357,7 @@ implementation
                   dummytype.free;
                end;
              { Add implicit hidden parameters and function result }
-             handle_calling_convention(pv);
+             handle_calling_convention(pv,hcc_default_actions_intf);
 {$ifdef jvm}
              { anonymous -> no name }
              jvm_create_procvar_class('',pv);
@@ -1735,7 +1689,7 @@ implementation
             // we can't add hidden params here because record is not yet defined
             // and therefore record size which has influence on paramter passing rules may change too
             // look at record_dec to see where calling conventions are applied (issue #0021044)
-            handle_calling_convention(result,[hcc_check]);
+            handle_calling_convention(result,[hcc_declaration,hcc_check]);
 
             { add definition to procsym }
             proc_add_definition(result);
@@ -1750,33 +1704,6 @@ implementation
       end;
 
 
-    procedure insert_record_hidden_paras(astruct: trecorddef);
-      var
-        pd: tdef;
-        i: longint;
-        oldpos : tfileposinfo;
-        oldparse_only: boolean;
-      begin
-        // handle calling conventions of record methods
-        oldpos:=current_filepos;
-        oldparse_only:=parse_only;
-        parse_only:=true;
-        { don't keep track of procdefs in a separate list, because the
-          compiler may add additional procdefs (e.g. property wrappers for
-          the jvm backend) }
-        for i := 0 to astruct.symtable.deflist.count - 1 do
-          begin
-            pd:=tdef(astruct.symtable.deflist[i]);
-            if pd.typ<>procdef then
-              continue;
-            current_filepos:=tprocdef(pd).fileinfo;
-            handle_calling_convention(tprocdef(pd),[hcc_insert_hidden_paras]);
-          end;
-        parse_only:=oldparse_only;
-        current_filepos:=oldpos;
-      end;
-
-
 {****************************************************************************
                         Procedure directive handlers
 ****************************************************************************}
@@ -2442,7 +2369,7 @@ type
    end;
 const
   {Should contain the number of procedure directives we support.}
-  num_proc_directives=51;
+  num_proc_directives=52;
   proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
    (
     (
@@ -2589,7 +2516,16 @@ const
       pooption : [po_inline];
       mutexclpocall : [pocall_safecall];
       mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
-      mutexclpo     : [po_exports,po_external,po_interrupt,po_virtualmethod,po_iocheck]
+      mutexclpo     : [po_noinline,po_exports,po_external,po_interrupt,po_virtualmethod,po_iocheck]
+    ),(
+      idtok:_NOINLINE;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobjintf];
+      handler  : nil;
+      pocall   : pocall_none;
+      pooption : [po_noinline];
+      mutexclpocall : [];
+      mutexclpotype : [];
+      mutexclpo     : [po_inline,po_external]
     ),(
       idtok:_INTERNCONST;
       pd_flags : [pd_interface,pd_body,pd_notobject,pd_notobjintf,pd_notrecord,pd_nothelper];
@@ -2797,7 +2733,7 @@ const
       pooption : [po_virtualmethod];
       mutexclpocall : [pocall_internproc];
       mutexclpotype : [potype_class_constructor,potype_class_destructor];
-      mutexclpo     : [po_interrupt,po_exports,po_overridingmethod,po_inline,po_staticmethod]
+      mutexclpo     : PD_VIRTUAL_MUTEXCLPO
     ),(
       idtok:_CPPDECL;
       pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
@@ -3150,7 +3086,6 @@ const
       end;
 
 
-
     function proc_get_importname(pd:tprocdef):string;
       var
         dllname, importname : string;
@@ -3205,12 +3140,6 @@ const
       end;
 
 
-    procedure compilerproc_set_symbol_name(pd: tprocdef);
-      begin
-        pd.procsym.realname:='$'+lower(pd.procsym.name);
-      end;
-
-
     procedure proc_set_mangledname(pd:tprocdef);
       var
         s : string;
@@ -3234,7 +3163,7 @@ const
                       implementation that needs to match the original symbol
                       again -> immediately convert here }
                     if po_compilerproc in pd.procoptions then
-                      compilerproc_set_symbol_name(pd);
+                      pd.setcompilerprocname;
                   end
               end
             else
@@ -3279,117 +3208,6 @@ const
       end;
 
 
-    procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
-      begin
-        if hcc_check in flags then
-          begin
-            { set the default calling convention if none provided }
-            if (pd.typ=procdef) and
-               (is_objc_class_or_protocol(tprocdef(pd).struct) or
-                is_cppclass(tprocdef(pd).struct)) then
-              begin
-                { none of the explicit calling conventions should be allowed }
-                if (po_hascallingconvention in pd.procoptions) then
-                  internalerror(2009032501);
-                if is_cppclass(tprocdef(pd).struct) then
-                  pd.proccalloption:=pocall_cppdecl
-                else
-                  pd.proccalloption:=pocall_cdecl;
-              end
-            else if not(po_hascallingconvention in pd.procoptions) then
-              pd.proccalloption:=current_settings.defproccall
-            else
-              begin
-                if pd.proccalloption=pocall_none then
-                  internalerror(200309081);
-              end;
-
-            { handle proccall specific settings }
-            case pd.proccalloption of
-              pocall_cdecl,
-              pocall_cppdecl,
-              pocall_sysv_abi_cdecl,
-              pocall_ms_abi_cdecl:
-                begin
-                  { check C cdecl para types }
-                  check_c_para(pd);
-                end;
-              pocall_far16 :
-                begin
-                  { Temporary stub, must be rewritten to support OS/2 far16 }
-                  Message1(parser_w_proc_directive_ignored,'FAR16');
-                end;
-            end;
-
-            { Inlining is enabled and supported? }
-            if (po_inline in pd.procoptions) and
-               not(cs_do_inline in current_settings.localswitches) then
-              begin
-                { Give an error if inline is not supported by the compiler mode,
-                  otherwise only give a hint that this procedure will not be inlined }
-                if not(m_default_inline in current_settings.modeswitches) then
-                  Message(parser_e_proc_inline_not_supported)
-                else
-                  Message(parser_h_inlining_disabled);
-                exclude(pd.procoptions,po_inline);
-              end;
-
-            { For varargs directive also cdecl and external must be defined }
-            if (po_varargs in pd.procoptions) then
-             begin
-               { check first for external in the interface, if available there
-                 then the cdecl must also be there since there is no implementation
-                 available to contain it }
-               if parse_only then
-                begin
-                  { if external is available, then cdecl must also be available,
-                    procvars don't need external }
-                  if not((po_external in pd.procoptions) or
-                         (pd.typ=procvardef) or
-                         { for objcclasses this is checked later, because the entire
-                           class may be external.  }
-                         is_objc_class_or_protocol(tprocdef(pd).struct)) and
-                     not(pd.proccalloption in (cdecl_pocalls + [pocall_stdcall])) then
-                    Message(parser_e_varargs_need_cdecl_and_external);
-                end
-               else
-                begin
-                  { both must be defined now }
-                  if not((po_external in pd.procoptions) or
-                         (pd.typ=procvardef)) or
-                     not(pd.proccalloption in (cdecl_pocalls + [pocall_stdcall])) then
-                    Message(parser_e_varargs_need_cdecl_and_external);
-                end;
-             end;
-          end;
-
-        if hcc_insert_hidden_paras in flags then
-          begin
-            { insert hidden high parameters }
-            pd.parast.SymList.ForEachCall(@insert_hidden_para,pd);
-
-            { insert hidden self parameter }
-            insert_self_and_vmt_para(pd);
-
-            { insert funcret parameter if required }
-            insert_funcret_para(pd);
-
-            { Make var parameters regable, this must be done after the calling
-              convention is set. }
-            { this must be done before parentfp is insert, because getting all cases
-              where parentfp must be in a memory location isn't catched properly so
-              we put parentfp never in a register }
-            pd.parast.SymList.ForEachCall(@set_addr_param_regable,pd);
-
-            { insert parentfp parameter if required }
-            insert_parentfp_para(pd);
-          end;
-
-        { Calculate parameter tlist }
-        pd.calcparas;
-      end;
-
-
     procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
       {
         Parse the procedure directives. It does not matter if procedure directives
@@ -3540,474 +3358,4 @@ const
         parse_proc_directives(pd,pdflags);
       end;
 
-    function proc_add_definition(var currpd:tprocdef):boolean;
-
-
-      function check_generic_parameters(fwpd,currpd:tprocdef):boolean;
-        var
-          i : longint;
-          fwtype,
-          currtype : ttypesym;
-        begin
-          result:=true;
-          if fwpd.genericparas.count<>currpd.genericparas.count then
-            internalerror(2018090101);
-          for i:=0 to fwpd.genericparas.count-1 do
-            begin
-              fwtype:=ttypesym(fwpd.genericparas[i]);
-              currtype:=ttypesym(currpd.genericparas[i]);
-              if fwtype.name<>currtype.name then
-                begin
-                  messagepos1(currtype.fileinfo,sym_e_generic_type_param_mismatch,currtype.realname);
-                  messagepos1(fwtype.fileinfo,sym_e_generic_type_param_decl,fwtype.realname);
-                  result:=false;
-                end;
-            end;
-        end;
-
-
-      function equal_generic_procdefs(fwpd,currpd:tprocdef):boolean;
-        var
-          i : longint;
-          fwtype,
-          currtype : ttypesym;
-          foundretdef : boolean;
-        begin
-          result:=false;
-          if fwpd.genericparas.count<>currpd.genericparas.count then
-            exit;
-          { comparing generic declarations is a bit more cumbersome as the
-            defs of the generic parameter types are not equal, especially if the
-            declaration contains constraints; essentially we have two cases:
-            - proc declared in interface of unit (or in class/record/object)
-              and defined in implementation; here the fwpd might contain
-              constraints while currpd must only contain undefineddefs
-            - forward declaration in implementation }
-          foundretdef:=false;
-          for i:=0 to fwpd.genericparas.count-1 do
-            begin
-              fwtype:=ttypesym(fwpd.genericparas[i]);
-              currtype:=ttypesym(currpd.genericparas[i]);
-              { if the type in the currpd isn't a pure undefineddef, then we can
-                stop right there }
-              if (currtype.typedef.typ<>undefineddef) or (df_genconstraint in currtype.typedef.defoptions) then
-                exit;
-              if not foundretdef then
-                begin
-                  { if the returndef is the same as this parameter's def then this
-                    needs to be the case for both procdefs }
-                  foundretdef:=fwpd.returndef=fwtype.typedef;
-                  if foundretdef xor (currpd.returndef=currtype.typedef) then
-                    exit;
-                end;
-            end;
-          if compare_paras(fwpd.paras,currpd.paras,cp_none,[cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv,cpo_generic])<>te_exact then
-            exit;
-          if not foundretdef then
-            begin
-              if (df_specialization in tstoreddef(fwpd.returndef).defoptions) and (df_specialization in tstoreddef(currpd.returndef).defoptions) then
-                { for specializations we're happy with equal defs instead of exactly the same defs }
-                result:=equal_defs(fwpd.returndef,currpd.returndef)
-              else
-                { the returndef isn't a type parameter, so compare as usual }
-                result:=compare_defs(fwpd.returndef,currpd.returndef,nothingn)=te_exact;
-            end
-          else
-            result:=true;
-        end;
-
-      {
-        Add definition aprocdef to the overloaded definitions of aprocsym. If a
-        forwarddef is found and reused it returns true
-      }
-      var
-        fwpd    : tprocdef;
-        currparasym,
-        fwparasym : tsym;
-        currparacnt,
-        fwparacnt,
-        curridx,
-        fwidx,
-        virtualdirinfo,
-        i       : longint;
-        po_comp : tprocoptions;
-        paracompopt: tcompare_paras_options;
-        forwardfound : boolean;
-        symentry: TSymEntry;
-        item : tlinkedlistitem;
-      begin
-        virtualdirinfo:=-1;
-        forwardfound:=false;
-
-        { check overloaded functions if the same function already exists }
-        for i:=0 to tprocsym(currpd.procsym).ProcdefList.Count-1 do
-         begin
-           fwpd:=tprocdef(tprocsym(currpd.procsym).ProcdefList[i]);
-
-           { can happen for internally generated routines }
-           if (fwpd=currpd) then
-             begin
-               result:=true;
-               exit;
-             end;
-
-           { Skip overloaded definitions that are declared in other units }
-           if fwpd.procsym<>currpd.procsym then
-             continue;
-
-           { check the parameters, for delphi/tp it is possible to
-             leave the parameters away in the implementation (forwarddef=false).
-             But for an overload declared function this is not allowed }
-           if { check if empty implementation arguments match is allowed }
-              (
-               not(m_repeat_forward in current_settings.modeswitches) and
-               not(currpd.forwarddef) and
-               is_bareprocdef(currpd) and
-               not(po_overload in fwpd.procoptions)
-              ) or
-              (
-                fwpd.is_generic and
-                currpd.is_generic and
-                equal_generic_procdefs(fwpd,currpd)
-              ) or
-              { check arguments, we need to check only the user visible parameters. The hidden parameters
-                can be in a different location because of the calling convention, eg. L-R vs. R-L order (PFV)
-
-                don't check default values here, because routines that are the same except for their default
-                values should be reported as mismatches (since you can't overload based on different default
-                parameter values) }
-              (
-               (compare_paras(fwpd.paras,currpd.paras,cp_none,[cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv])=te_exact) and
-               (compare_defs(fwpd.returndef,currpd.returndef,nothingn)=te_exact)
-              ) then
-             begin
-               { Check if we've found the forwarddef, if found then
-                 we need to update the forward def with the current
-                 implementation settings }
-               if fwpd.forwarddef then
-                 begin
-                   forwardfound:=true;
-
-                   if not(m_repeat_forward in current_settings.modeswitches) and
-                      (fwpd.proccalloption<>currpd.proccalloption) then
-                     paracompopt:=[cpo_ignorehidden,cpo_comparedefaultvalue,cpo_openequalisexact,cpo_ignoreuniv]
-                   else
-                     paracompopt:=[cpo_comparedefaultvalue,cpo_openequalisexact,cpo_ignoreuniv];
-
-                   { Check calling convention }
-                   if (fwpd.proccalloption<>currpd.proccalloption) then
-                    begin
-                      { In delphi it is possible to specify the calling
-                        convention in the interface or implementation if
-                        there was no convention specified in the other
-                        part }
-                      if (m_delphi in current_settings.modeswitches) then
-                        begin
-                          if not(po_hascallingconvention in currpd.procoptions) then
-                            currpd.proccalloption:=fwpd.proccalloption
-                          else
-                            if not(po_hascallingconvention in fwpd.procoptions) then
-                              fwpd.proccalloption:=currpd.proccalloption
-                          else
-                            begin
-                              MessagePos(currpd.fileinfo,parser_e_call_convention_dont_match_forward);
-                              tprocsym(currpd.procsym).write_parameter_lists(currpd);
-                              { restore interface settings }
-                              currpd.proccalloption:=fwpd.proccalloption;
-                            end;
-                        end
-                      else
-                        begin
-                          MessagePos(currpd.fileinfo,parser_e_call_convention_dont_match_forward);
-                          tprocsym(currpd.procsym).write_parameter_lists(currpd);
-                          { restore interface settings }
-                          currpd.proccalloption:=fwpd.proccalloption;
-                        end;
-                    end;
-
-                   { Check static }
-                   if (po_staticmethod in fwpd.procoptions) then
-                    begin
-                      if not (po_staticmethod in currpd.procoptions) then
-                       begin
-                         include(currpd.procoptions, po_staticmethod);
-                         if (po_classmethod in currpd.procoptions) then
-                          begin
-                           { remove self from the hidden paras }
-                           symentry:=currpd.parast.Find('self');
-                           if symentry<>nil then
-                            begin
-                              currpd.parast.Delete(symentry);
-                              currpd.calcparas;
-                            end;
-                          end;
-                       end;
-                    end;
-
-                   { Check if the procedure type and return type are correct,
-                     also the parameters must match also with the type and that
-                     if the implementation has default parameters, the interface
-                     also has them and that if they both have them, that they
-                     have the same value }
-                   if ((m_repeat_forward in current_settings.modeswitches) or
-                       not is_bareprocdef(currpd)) and
-                       (
-                         (
-                           fwpd.is_generic and
-                           currpd.is_generic and
-                           not equal_generic_procdefs(fwpd,currpd)
-                         ) or
-                         (
-                           (
-                             not fwpd.is_generic or
-                             not currpd.is_generic
-                           ) and
-                           (
-                             (compare_paras(fwpd.paras,currpd.paras,cp_all,paracompopt)<>te_exact) or
-                             (compare_defs(fwpd.returndef,currpd.returndef,nothingn)<>te_exact)
-                           )
-                         )
-                       ) then
-                     begin
-                       MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
-                                   fwpd.fullprocname(false));
-                       tprocsym(currpd.procsym).write_parameter_lists(currpd);
-                       break;
-                     end;
-
-                   { Check if both are declared forward }
-                   if fwpd.forwarddef and currpd.forwarddef then
-                    begin
-                      MessagePos1(currpd.fileinfo,parser_e_function_already_declared_public_forward,
-                                  currpd.fullprocname(false));
-                    end;
-
-                   { internconst or internproc only need to be defined once }
-                   if (fwpd.proccalloption=pocall_internproc) then
-                    currpd.proccalloption:=fwpd.proccalloption
-                   else
-                    if (currpd.proccalloption=pocall_internproc) then
-                     fwpd.proccalloption:=currpd.proccalloption;
-
-                   { Check procedure options, Delphi requires that class is
-                     repeated in the implementation for class methods }
-                   if (m_fpc in current_settings.modeswitches) then
-                     po_comp:=[po_classmethod,po_varargs,po_methodpointer,po_interrupt]
-                   else
-                     po_comp:=[po_classmethod,po_methodpointer];
-
-                   if ((po_comp * fwpd.procoptions)<>(po_comp * currpd.procoptions)) or
-                      (fwpd.proctypeoption <> currpd.proctypeoption) or
-                      { if the implementation version has an "overload" modifier,
-                        the interface version must also have it (otherwise we can
-                        get annoying crashes due to interface crc changes) }
-                      (not(po_overload in fwpd.procoptions) and
-                       (po_overload in currpd.procoptions)) then
-                     begin
-                       MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
-                                   fwpd.fullprocname(false));
-                       tprocsym(fwpd.procsym).write_parameter_lists(fwpd);
-                       { This error is non-fatal, we can recover }
-                     end;
-
-                   { Forward declaration is external? }
-                   if (po_external in fwpd.procoptions) then
-                     MessagePos(currpd.fileinfo,parser_e_proc_already_external);
-
-                   { check for conflicts with "virtual" if this is a virtual
-                     method, as "virtual" cannot be repeated in the
-                     implementation and hence does not get checked against }
-                   if (po_virtualmethod in fwpd.procoptions) then
-                     begin
-                       if virtualdirinfo=-1 then
-                         begin
-                           virtualdirinfo:=find_proc_directive_index(_VIRTUAL);
-                           if virtualdirinfo=-1 then
-                             internalerror(2018010101);
-                         end;
-                       po_comp := (proc_direcdata[virtualdirinfo].mutexclpo * currpd.procoptions);
-                       if po_comp<>[] then
-                         MessagePos2(currpd.fileinfo,parser_e_proc_dir_conflict,tokeninfo^[_VIRTUAL].str,get_first_proc_str(po_comp));
-                     end;
-                    { Check parameters }
-                   if (m_repeat_forward in current_settings.modeswitches) or
-                      (currpd.minparacount>0) then
-                    begin
-                      { If mangled names are equal then they have the same amount of arguments }
-                      { We can check the names of the arguments }
-                      { both symtables are in the same order from left to right }
-                      curridx:=0;
-                      fwidx:=0;
-                      currparacnt:=currpd.parast.SymList.Count;
-                      fwparacnt:=fwpd.parast.SymList.Count;
-                      repeat
-                        { skip default parameter constsyms }
-                        while (curridx<currparacnt) and
-                              (tsym(currpd.parast.SymList[curridx]).typ<>paravarsym) do
-                          inc(curridx);
-                        while (fwidx<fwparacnt) and
-                              (tsym(fwpd.parast.SymList[fwidx]).typ<>paravarsym) do
-                          inc(fwidx);
-                        { stop when one of the two lists is at the end }
-                        if (fwidx>=fwparacnt) or (curridx>=currparacnt) then
-                          break;
-                        { compare names of parameters, ignore implictly
-                          renamed parameters }
-                        currparasym:=tsym(currpd.parast.SymList[curridx]);
-                        fwparasym:=tsym(fwpd.parast.SymList[fwidx]);
-                        if not(sp_implicitrename in currparasym.symoptions) and
-                           not(sp_implicitrename in fwparasym.symoptions) then
-                          begin
-                            if (currparasym.name<>fwparasym.name) then
-                              begin
-                                MessagePos3(currpd.fileinfo,parser_e_header_different_var_names,
-                                            tprocsym(currpd.procsym).realname,fwparasym.realname,currparasym.realname);
-                                break;
-                              end;
-                          end;
-                        { next parameter }
-                        inc(curridx);
-                        inc(fwidx);
-                      until false;
-                    end;
-                   { check that the type parameter names for generic methods match;
-                     we check this here and not in equal_generic_procdefs as the defs
-                     might still be different due to their parameters, so we'd generate
-                     errors without any need }
-                   if currpd.is_generic and fwpd.is_generic then
-                     { an error here is recoverable, so we simply continue }
-                     check_generic_parameters(fwpd,currpd);
-                   { Everything is checked, now we can update the forward declaration
-                     with the new data from the implementation }
-                   fwpd.forwarddef:=currpd.forwarddef;
-                   fwpd.hasforward:=true;
-                   fwpd.procoptions:=fwpd.procoptions+currpd.procoptions;
-
-                   { marked as local but exported from unit? }
-                   if (po_kylixlocal in fwpd.procoptions) and (fwpd.owner.symtabletype=globalsymtable) then
-                     MessagePos(fwpd.fileinfo,type_e_cant_export_local);
-
-                   if fwpd.extnumber=$ffff then
-                     fwpd.extnumber:=currpd.extnumber;
-                   while not currpd.aliasnames.empty do
-                     fwpd.aliasnames.insert(currpd.aliasnames.getfirst);
-                   { update fileinfo so position references the implementation,
-                     also update funcretsym if it is already generated }
-                   fwpd.fileinfo:=currpd.fileinfo;
-                   if assigned(fwpd.funcretsym) then
-                     fwpd.funcretsym.fileinfo:=currpd.fileinfo;
-                   if assigned(currpd.deprecatedmsg) then
-                     begin
-                       stringdispose(fwpd.deprecatedmsg);
-                       fwpd.deprecatedmsg:=stringdup(currpd.deprecatedmsg^);
-                     end;
-                   { import names }
-                   if assigned(currpd.import_dll) then
-                     begin
-                       stringdispose(fwpd.import_dll);
-                       fwpd.import_dll:=stringdup(currpd.import_dll^);
-                     end;
-                   if assigned(currpd.import_name) then
-                     begin
-                       stringdispose(fwpd.import_name);
-                       fwpd.import_name:=stringdup(currpd.import_name^);
-                     end;
-                   fwpd.import_nr:=currpd.import_nr;
-                   { for compilerproc defines we need to rename and update the
-                     symbolname to lowercase so users can' access it (can't do
-                     it immediately, because then the implementation symbol
-                     won't be matched) }
-                   if po_compilerproc in fwpd.procoptions then
-                     begin
-                       compilerproc_set_symbol_name(fwpd);
-                       current_module.add_public_asmsym(fwpd.procsym.realname,AB_GLOBAL,AT_FUNCTION);
-                     end;
-                   if po_public in fwpd.procoptions then
-                     begin
-                       item:=fwpd.aliasnames.first;
-                       while assigned(item) do
-                         begin
-                           current_module.add_public_asmsym(TCmdStrListItem(item).str,AB_GLOBAL,AT_FUNCTION);
-                           item:=item.next;
-                         end;
-                     end;
-
-                   { Release current procdef }
-                   currpd.owner.deletedef(currpd);
-                   currpd:=fwpd;
-                 end
-               else
-                begin
-                  { abstract methods aren't forward defined, but this }
-                  { needs another error message                   }
-                  if (po_abstractmethod in fwpd.procoptions) then
-                    MessagePos(currpd.fileinfo,parser_e_abstract_no_definition)
-                  else
-                    begin
-                      MessagePos(currpd.fileinfo,parser_e_overloaded_have_same_parameters);
-                      tprocsym(currpd.procsym).write_parameter_lists(currpd);
-                    end;
-                 end;
-
-               { we found one proc with the same arguments, there are no others
-                 so we can stop }
-               break;
-             end;
-
-           { check for allowing overload directive }
-           if not(m_fpc in current_settings.modeswitches) then
-            begin
-              { overload directive turns on overloading }
-              if ((po_overload in currpd.procoptions) or
-                  (po_overload in fwpd.procoptions)) then
-               begin
-                 { check if all procs have overloading, but not if the proc is a method or
-                   already declared forward, then the check is already done }
-                 if not(fwpd.hasforward or
-                        assigned(currpd.struct) or
-                        (currpd.forwarddef<>fwpd.forwarddef) or
-                        ((po_overload in currpd.procoptions) and
-                         (po_overload in fwpd.procoptions))) then
-                  begin
-                    MessagePos1(currpd.fileinfo,parser_e_no_overload_for_all_procs,currpd.procsym.realname);
-                    break;
-                  end
-               end
-              else
-               begin
-                 if not(fwpd.forwarddef) then
-                  begin
-                    if (m_tp7 in current_settings.modeswitches) then
-                      MessagePos(currpd.fileinfo,parser_e_procedure_overloading_is_off)
-                    else
-                      MessagePos1(currpd.fileinfo,parser_e_no_overload_for_all_procs,currpd.procsym.realname);
-                    break;
-                  end;
-               end;
-            end; { equal arguments }
-         end;
-
-        { if we didn't reuse a forwarddef then we add the procdef to the overloaded
-          list }
-        if not forwardfound then
-          begin
-            { can happen in Delphi mode }
-            if (currpd.proctypeoption = potype_function) and
-               is_void(currpd.returndef) then
-              MessagePos1(currpd.fileinfo,parser_e_no_funcret_specified,currpd.procsym.realname);
-            tprocsym(currpd.procsym).ProcdefList.Add(currpd);
-            if not currpd.forwarddef and (po_public in currpd.procoptions) then
-              begin
-                item:=currpd.aliasnames.first;
-                while assigned(item) do
-                  begin
-                    current_module.add_public_asmsym(TCmdStrListItem(item).str,AB_GLOBAL,AT_FUNCTION);
-                    item:=item.next;
-                  end;
-              end;
-          end;
-
-        proc_add_definition:=forwardfound;
-      end;
-
 end.

compiler/pdecvar.pas

@@ -56,7 +56,7 @@ implementation
        globtype,globals,tokens,verbose,constexp,
        systems,
        { symtable }
-       symconst,symbase,defutil,defcmp,symcreat,
+       symconst,symbase,defutil,defcmp,symutil,symcreat,
 {$if defined(i386) or defined(i8086)}
        symcpu,
 {$endif}
@@ -68,7 +68,7 @@ implementation
        ngenutil,
        { parser }
        scanner,
-       pbase,pexpr,ptype,ptconst,pdecsub;
+       pbase,pexpr,ptype,ptconst,pdecsub,pparautl;
 
 
     function read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym;
@@ -132,6 +132,8 @@ implementation
                      end;
                    _POINT :
                      begin
+                       if not is_object(def) and not is_record(def) then
+                         message(sym_e_type_must_be_rec_or_object);
                        consume(_POINT);
                        if assigned(def) then
                         begin
@@ -258,7 +260,7 @@ implementation
             var
               sym: tprocsym;
             begin
-              handle_calling_convention(pd);
+              handle_calling_convention(pd,hcc_default_actions_intf);
               sym:=cprocsym.create(prefix+lower(p.realname));
               symtablestack.top.insert(sym);
               pd.procsym:=sym;
@@ -537,7 +539,7 @@ implementation
                       begin
                         readprocdef.returndef:=p.propdef;
                         { Insert hidden parameters }
-                        handle_calling_convention(readprocdef);
+                        handle_calling_convention(readprocdef,hcc_default_actions_intf);
                       end;
                     p.add_getter_or_setter_for_sym(palt_read,sym,def,readprocdef);
                   end;
@@ -560,7 +562,7 @@ implementation
                         hparavs:=cparavarsym.create('$value',10*paranr,vs_value,p.propdef,[]);
                         writeprocdef.parast.insert(hparavs);
                         { Insert hidden parameters }
-                        handle_calling_convention(writeprocdef);
+                        handle_calling_convention(writeprocdef,hcc_default_actions_intf);
                       end;
                     p.add_getter_or_setter_for_sym(palt_write,sym,def,writeprocdef);
                   end;
@@ -648,7 +650,7 @@ implementation
                                    end;
 
                                  { Insert hidden parameters }
-                                 handle_calling_convention(storedprocdef);
+                                 handle_calling_convention(storedprocdef,hcc_default_actions_intf);
                                  p.propaccesslist[palt_stored].procdef:=Tprocsym(sym).Find_procdef_bypara(storedprocdef.paras,storedprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]);
                                  if not assigned(p.propaccesslist[palt_stored].procdef) then
                                    message(parser_e_ill_property_storage_sym);
@@ -1457,7 +1459,7 @@ implementation
                  { Add calling convention for procvar }
                  if (hdef.typ=procvardef) and
                     (hdef.typesym=nil) then
-                   handle_calling_convention(tprocvardef(hdef));
+                   handle_calling_convention(tprocvardef(hdef),hcc_default_actions_intf);
                  read_default_value(sc);
                  hasdefaultvalue:=true;
                end
@@ -1475,7 +1477,7 @@ implementation
                  { Parse procvar directives after ; }
                  maybe_parse_proc_directives(hdef);
                  { Add calling convention for procvar }
-                 handle_calling_convention(tprocvardef(hdef));
+                 handle_calling_convention(tprocvardef(hdef),hcc_default_actions_intf);
                  { Handling of Delphi typed const = initialized vars }
                  if (token=_EQ) and
                     not(m_tp7 in current_settings.modeswitches) and
@@ -1766,7 +1768,7 @@ implementation
              { Add calling convention for procvar }
              if (hdef.typ=procvardef) and
                 (hdef.typesym=nil) then
-               handle_calling_convention(tprocvardef(hdef));
+               handle_calling_convention(tprocvardef(hdef),hcc_default_actions_intf);
 
              if (vd_object in options) then
                begin

compiler/pexpr.pas

@@ -1281,6 +1281,7 @@ implementation
       var
         isclassref:boolean;
         isrecordtype:boolean;
+        isobjecttype:boolean;
       begin
          if sym=nil then
            begin
@@ -1301,11 +1302,13 @@ implementation
                    do_typecheckpass(p1);
                  isclassref:=(p1.resultdef.typ=classrefdef);
                  isrecordtype:=(p1.nodetype=typen) and (p1.resultdef.typ=recorddef);
+                 isobjecttype:=(p1.nodetype=typen) and is_object(p1.resultdef);
                end
               else
                 begin
                   isclassref:=false;
                   isrecordtype:=false;
+                  isobjecttype:=false;
                 end;
 
               if assigned(spezcontext) and not (sym.typ=procsym) then
@@ -1325,16 +1328,47 @@ implementation
                       if (
                             isclassref or
                             (
-                              isrecordtype and
+                              (isobjecttype or
+                               isrecordtype) and
                               not (cnf_inherited in callflags)
                             )
                           ) and
                          (p1.nodetype=calln) and
                          assigned(tcallnode(p1).procdefinition) then
                         begin
-                          if not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
-                             not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
-                            Message(parser_e_only_class_members_via_class_ref);
+                          if not isobjecttype then
+                            begin
+                              if not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
+                                 not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
+                                Message(parser_e_only_class_members_via_class_ref);
+                            end
+                          else
+                            begin
+                              { with objects, you can also do this:
+                                  type
+                                    tparent = object
+                                      procedure test;
+                                    end;
+
+                                    tchild = object(tchild)
+                                      procedure test;
+                                    end;
+
+                                    procedure tparent.test;
+                                      begin
+                                      end;
+
+                                    procedure tchild.test;
+                                      begin
+                                        tparent.test;
+                                      end;
+                              }
+                              if (tcallnode(p1).procdefinition.proctypeoption<>potype_constructor) and
+                                 not(po_staticmethod in tcallnode(p1).procdefinition.procoptions) and
+                                 (not assigned(current_structdef) or
+                                  not def_is_related(current_structdef,structh)) then
+                                Message(parser_e_only_static_members_via_object_type);
+                            end;
                           { in Java, constructors are not automatically inherited
                             -> calling a constructor from a parent type will create
                                an instance of that parent type! }
@@ -1352,7 +1386,7 @@ implementation
                               assigned(tcallnode(p1).methodpointer) and
                               (tcallnode(p1).methodpointer.nodetype=loadvmtaddrn) then
                             Message1(type_w_instance_abstract_class,structh.RttiName);
-                        end;
+                        end
                    end;
                  fieldvarsym:
                    begin
@@ -1366,7 +1400,9 @@ implementation
                                 (current_procinfo.procdef.struct=structh))) then
                               Message(parser_e_only_class_members)
                             else
-                              Message(parser_e_only_class_members_via_class_ref);
+                              Message(parser_e_only_class_members_via_class_ref)
+                          else if isobjecttype then
+                            Message(parser_e_only_static_members_via_object_type);
                           p1:=csubscriptnode.create(sym,p1);
                         end;
                    end;
@@ -3246,7 +3282,7 @@ implementation
                         if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
                           begin
                             tlabelsym(srsym).nonlocal:=true;
-                            exclude(current_procinfo.procdef.procoptions,po_inline);
+                            include(current_procinfo.flags,pi_has_interproclabel);
                           end;
                         if tlabelsym(srsym).nonlocal and
                           (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then

compiler/pgenutil.pas

@@ -73,7 +73,7 @@ uses
   node,nobj,
   { parser }
   scanner,
-  pbase,pexpr,pdecsub,ptype,psub;
+  pbase,pexpr,pdecsub,ptype,psub,pparautl;
 
 
     procedure maybe_add_waiting_unit(tt:tdef);
@@ -1077,7 +1077,7 @@ uses
                         end;
                       if replaydepth>current_scanner.replay_stack_depth then
                         parse_var_proc_directives(ttypesym(srsym));
-                      handle_calling_convention(tprocvardef(result));
+                      handle_calling_convention(tprocvardef(result),hcc_default_actions_intf);
                       if not hintsprocessed and (replaydepth>current_scanner.replay_stack_depth) then
                         begin
                           try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg);
@@ -1095,7 +1095,10 @@ uses
                       parse_proc_directives(pd,pdflags);
                       while try_consume_hintdirective(pd.symoptions,pd.deprecatedmsg) do
                         consume(_SEMICOLON);
-                      handle_calling_convention(tprocdef(result),hcc_all);
+                      if parse_generic then
+                        handle_calling_convention(tprocdef(result),hcc_default_actions_intf)
+                      else
+                        handle_calling_convention(tprocdef(result),hcc_default_actions_impl);
                       proc_add_definition(tprocdef(result));
                       { for partial specializations we implicitely declare the routine as
                         having its implementation although we'll not specialize it in reality }

compiler/pmodules.pas

@@ -46,7 +46,7 @@ implementation
        objcgutl,
        pkgutil,
        wpobase,
-       scanner,pbase,pexpr,psystem,psub,pdecsub,pgenutil,ncgvmt,ncgrtti,
+       scanner,pbase,pexpr,psystem,psub,pdecsub,pgenutil,pparautl,ncgvmt,ncgrtti,
        cpuinfo;
 
 
@@ -676,7 +676,7 @@ implementation
           pd.proccalloption:=pocall_stdcall
         else
           pd.proccalloption:=pocall_cdecl;
-        handle_calling_convention(pd);
+        handle_calling_convention(pd,hcc_default_actions_impl);
         { set procinfo and current_procinfo.procdef }
         result:=tcgprocinfo(cprocinfo.create(nil));
         result.procdef:=pd;

compiler/pparautl.pas

@@ -26,7 +26,7 @@ unit pparautl;
 interface
 
     uses
-      symdef;
+      symconst,symdef;
 
     procedure insert_funcret_para(pd:tabstractprocdef);
     procedure insert_parentfp_para(pd:tabstractprocdef);
@@ -34,12 +34,42 @@ interface
     procedure insert_funcret_local(pd:tprocdef);
     procedure insert_hidden_para(p:TObject;arg:pointer);
     procedure check_c_para(pd:Tabstractprocdef);
+    procedure insert_record_hidden_paras(astruct: trecorddef);
+
+    type
+      // flags of the *handle_calling_convention routines
+      thccflag=(
+        hcc_declaration,          // declaration (as opposed to definition, i.e. interface rather than implementation)
+        hcc_check,                // perform checks and outup errors if found
+        hcc_insert_hidden_paras   // insert hidden parameters
+      );
+      thccflags=set of thccflag;
+
+    const
+      hcc_default_actions_intf=[hcc_declaration,hcc_check,hcc_insert_hidden_paras];
+      hcc_default_actions_impl=[hcc_check,hcc_insert_hidden_paras];
+      hcc_default_actions_parse=[hcc_check,hcc_insert_hidden_paras];
+      PD_VIRTUAL_MUTEXCLPO = [po_interrupt,po_exports,po_overridingmethod,po_inline,po_staticmethod];
+
+    procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags);
+    function proc_add_definition(var currpd:tprocdef):boolean;
+
+    { create "parent frame pointer" record skeleton for procdef, in which local
+      variables and parameters from pd accessed from nested routines can be
+      stored }
+    procedure build_parentfpstruct(pd: tprocdef);
 
 implementation
 
     uses
-      globals,globtype,verbose,systems,
-      symconst,symtype,symbase,symsym,symtable,symcreat,defutil,blockutl,
+      globals,globtype,cclasses,cutils,verbose,systems,fmodule,
+      tokens,
+      symtype,symbase,symsym,symtable,symutil,defutil,defcmp,blockutl,
+{$ifdef jvm}
+      jvmdef,
+{$endif jvm}
+      node,nbas,
+      aasmbase,
       paramgr;
 
 
@@ -128,8 +158,8 @@ implementation
               begin
                 if not assigned(tprocdef(pd.owner.defowner).parentfpstruct) then
                   build_parentfpstruct(tprocdef(pd.owner.defowner));
-                vs:=cparavarsym.create('$parentfp',paranr,vs_value
-                      ,tprocdef(pd.owner.defowner).parentfpstructptrtype,[vo_is_parentfp,vo_is_hidden_para]);
+                vs:=cparavarsym.create('$parentfp',paranr,vs_value,
+                      tprocdef(pd.owner.defowner).parentfpstructptrtype,[vo_is_parentfp,vo_is_hidden_para]);
               end;
             pd.parast.insert(vs);
 
@@ -418,4 +448,662 @@ implementation
       end;
 
 
+    procedure insert_record_hidden_paras(astruct: trecorddef);
+      var
+        pd: tdef;
+        i: longint;
+        oldpos: tfileposinfo;
+      begin
+        // handle calling conventions of record methods
+        oldpos:=current_filepos;
+        { don't keep track of procdefs in a separate list, because the
+          compiler may add additional procdefs (e.g. property wrappers for
+          the jvm backend) }
+        for i := 0 to astruct.symtable.deflist.count - 1 do
+          begin
+            pd:=tdef(astruct.symtable.deflist[i]);
+            if pd.typ<>procdef then
+              continue;
+            current_filepos:=tprocdef(pd).fileinfo;
+            handle_calling_convention(tprocdef(pd),[hcc_declaration,hcc_insert_hidden_paras]);
+          end;
+        current_filepos:=oldpos;
+      end;
+
+
+    procedure set_addr_param_regable(p:TObject;arg:pointer);
+      begin
+        if (tsym(p).typ<>paravarsym) then
+         exit;
+        with tparavarsym(p) do
+         begin
+           if (not needs_finalization) and
+              paramanager.push_addr_param(varspez,vardef,tprocdef(arg).proccalloption) then
+             varregable:=vr_addr;
+         end;
+      end;
+
+
+    procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags);
+      begin
+        if hcc_check in flags then
+          begin
+            { set the default calling convention if none provided }
+            if (pd.typ=procdef) and
+               (is_objc_class_or_protocol(tprocdef(pd).struct) or
+                is_cppclass(tprocdef(pd).struct)) then
+              begin
+                { none of the explicit calling conventions should be allowed }
+                if (po_hascallingconvention in pd.procoptions) then
+                  internalerror(2009032501);
+                if is_cppclass(tprocdef(pd).struct) then
+                  pd.proccalloption:=pocall_cppdecl
+                else
+                  pd.proccalloption:=pocall_cdecl;
+              end
+            else if not(po_hascallingconvention in pd.procoptions) then
+              pd.proccalloption:=current_settings.defproccall
+            else
+              begin
+                if pd.proccalloption=pocall_none then
+                  internalerror(200309081);
+              end;
+
+            { handle proccall specific settings }
+            case pd.proccalloption of
+              pocall_cdecl,
+              pocall_cppdecl,
+              pocall_sysv_abi_cdecl,
+              pocall_ms_abi_cdecl:
+                begin
+                  { check C cdecl para types }
+                  check_c_para(pd);
+                end;
+              pocall_far16 :
+                begin
+                  { Temporary stub, must be rewritten to support OS/2 far16 }
+                  Message1(parser_w_proc_directive_ignored,'FAR16');
+                end;
+            end;
+
+            { Inlining is enabled and supported? }
+            if (po_inline in pd.procoptions) and
+               not(cs_do_inline in current_settings.localswitches) then
+              begin
+                { Give an error if inline is not supported by the compiler mode,
+                  otherwise only give a hint that this procedure will not be inlined }
+                if not(m_default_inline in current_settings.modeswitches) then
+                  Message(parser_e_proc_inline_not_supported)
+                else
+                  Message(parser_h_inlining_disabled);
+                exclude(pd.procoptions,po_inline);
+              end;
+
+            { For varargs directive also cdecl and external must be defined }
+            if (po_varargs in pd.procoptions) then
+             begin
+               { check first for external in the interface, if available there
+                 then the cdecl must also be there since there is no implementation
+                 available to contain it }
+               if hcc_declaration in flags then
+                begin
+                  { if external is available, then cdecl must also be available,
+                    procvars don't need external }
+                  if not((po_external in pd.procoptions) or
+                         (pd.typ=procvardef) or
+                         { for objcclasses this is checked later, because the entire
+                           class may be external.  }
+                         is_objc_class_or_protocol(tprocdef(pd).struct)) and
+                     not(pd.proccalloption in (cdecl_pocalls + [pocall_stdcall])) then
+                    Message(parser_e_varargs_need_cdecl_and_external);
+                end
+               else
+                begin
+                  { both must be defined now }
+                  if not((po_external in pd.procoptions) or
+                         (pd.typ=procvardef)) or
+                     not(pd.proccalloption in (cdecl_pocalls + [pocall_stdcall])) then
+                    Message(parser_e_varargs_need_cdecl_and_external);
+                end;
+             end;
+          end;
+
+        if hcc_insert_hidden_paras in flags then
+          begin
+            { insert hidden high parameters }
+            pd.parast.SymList.ForEachCall(@insert_hidden_para,pd);
+
+            { insert hidden self parameter }
+            insert_self_and_vmt_para(pd);
+
+            { insert funcret parameter if required }
+            insert_funcret_para(pd);
+
+            { Make var parameters regable, this must be done after the calling
+              convention is set. }
+            { this must be done before parentfp is insert, because getting all cases
+              where parentfp must be in a memory location isn't catched properly so
+              we put parentfp never in a register }
+            pd.parast.SymList.ForEachCall(@set_addr_param_regable,pd);
+
+            { insert parentfp parameter if required }
+            insert_parentfp_para(pd);
+          end;
+
+        { Calculate parameter tlist }
+        pd.calcparas;
+      end;
+
+
+    function proc_add_definition(var currpd:tprocdef):boolean;
+
+      function check_generic_parameters(fwpd,currpd:tprocdef):boolean;
+        var
+          i : longint;
+          fwtype,
+          currtype : ttypesym;
+        begin
+          result:=true;
+          if fwpd.genericparas.count<>currpd.genericparas.count then
+            internalerror(2018090101);
+          for i:=0 to fwpd.genericparas.count-1 do
+            begin
+              fwtype:=ttypesym(fwpd.genericparas[i]);
+              currtype:=ttypesym(currpd.genericparas[i]);
+              if fwtype.name<>currtype.name then
+                begin
+                  messagepos1(currtype.fileinfo,sym_e_generic_type_param_mismatch,currtype.realname);
+                  messagepos1(fwtype.fileinfo,sym_e_generic_type_param_decl,fwtype.realname);
+                  result:=false;
+                end;
+            end;
+        end;
+
+
+      function equal_generic_procdefs(fwpd,currpd:tprocdef):boolean;
+        var
+          i : longint;
+          fwtype,
+          currtype : ttypesym;
+          foundretdef : boolean;
+        begin
+          result:=false;
+          if fwpd.genericparas.count<>currpd.genericparas.count then
+            exit;
+          { comparing generic declarations is a bit more cumbersome as the
+            defs of the generic parameter types are not equal, especially if the
+            declaration contains constraints; essentially we have two cases:
+            - proc declared in interface of unit (or in class/record/object)
+              and defined in implementation; here the fwpd might contain
+              constraints while currpd must only contain undefineddefs
+            - forward declaration in implementation }
+          foundretdef:=false;
+          for i:=0 to fwpd.genericparas.count-1 do
+            begin
+              fwtype:=ttypesym(fwpd.genericparas[i]);
+              currtype:=ttypesym(currpd.genericparas[i]);
+              { if the type in the currpd isn't a pure undefineddef, then we can
+                stop right there }
+              if (currtype.typedef.typ<>undefineddef) or (df_genconstraint in currtype.typedef.defoptions) then
+                exit;
+              if not foundretdef then
+                begin
+                  { if the returndef is the same as this parameter's def then this
+                    needs to be the case for both procdefs }
+                  foundretdef:=fwpd.returndef=fwtype.typedef;
+                  if foundretdef xor (currpd.returndef=currtype.typedef) then
+                    exit;
+                end;
+            end;
+          if compare_paras(fwpd.paras,currpd.paras,cp_none,[cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv,cpo_generic])<>te_exact then
+            exit;
+          if not foundretdef then
+            begin
+              if (df_specialization in tstoreddef(fwpd.returndef).defoptions) and (df_specialization in tstoreddef(currpd.returndef).defoptions) then
+                { for specializations we're happy with equal defs instead of exactly the same defs }
+                result:=equal_defs(fwpd.returndef,currpd.returndef)
+              else
+                { the returndef isn't a type parameter, so compare as usual }
+                result:=compare_defs(fwpd.returndef,currpd.returndef,nothingn)=te_exact;
+            end
+          else
+            result:=true;
+        end;
+
+      {
+        Add definition aprocdef to the overloaded definitions of aprocsym. If a
+        forwarddef is found and reused it returns true
+      }
+      var
+        fwpd    : tprocdef;
+        currparasym,
+        fwparasym : tsym;
+        currparacnt,
+        fwparacnt,
+        curridx,
+        fwidx,
+        i       : longint;
+        po_comp : tprocoptions;
+        paracompopt: tcompare_paras_options;
+        forwardfound : boolean;
+        symentry: TSymEntry;
+        item : tlinkedlistitem;
+      begin
+        forwardfound:=false;
+
+        { check overloaded functions if the same function already exists }
+        for i:=0 to tprocsym(currpd.procsym).ProcdefList.Count-1 do
+         begin
+           fwpd:=tprocdef(tprocsym(currpd.procsym).ProcdefList[i]);
+
+           { can happen for internally generated routines }
+           if (fwpd=currpd) then
+             begin
+               result:=true;
+               exit;
+             end;
+
+           { Skip overloaded definitions that are declared in other units }
+           if fwpd.procsym<>currpd.procsym then
+             continue;
+
+           { check the parameters, for delphi/tp it is possible to
+             leave the parameters away in the implementation (forwarddef=false).
+             But for an overload declared function this is not allowed }
+           if { check if empty implementation arguments match is allowed }
+              (
+               not(m_repeat_forward in current_settings.modeswitches) and
+               not(currpd.forwarddef) and
+               is_bareprocdef(currpd) and
+               not(po_overload in fwpd.procoptions)
+              ) or
+              (
+                fwpd.is_generic and
+                currpd.is_generic and
+                equal_generic_procdefs(fwpd,currpd)
+              ) or
+              { check arguments, we need to check only the user visible parameters. The hidden parameters
+                can be in a different location because of the calling convention, eg. L-R vs. R-L order (PFV)
+
+                don't check default values here, because routines that are the same except for their default
+                values should be reported as mismatches (since you can't overload based on different default
+                parameter values) }
+              (
+               (compare_paras(fwpd.paras,currpd.paras,cp_none,[cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv])=te_exact) and
+               (compare_defs(fwpd.returndef,currpd.returndef,nothingn)=te_exact)
+              ) then
+             begin
+               { Check if we've found the forwarddef, if found then
+                 we need to update the forward def with the current
+                 implementation settings }
+               if fwpd.forwarddef then
+                 begin
+                   forwardfound:=true;
+
+                   if not(m_repeat_forward in current_settings.modeswitches) and
+                      (fwpd.proccalloption<>currpd.proccalloption) then
+                     paracompopt:=[cpo_ignorehidden,cpo_comparedefaultvalue,cpo_openequalisexact,cpo_ignoreuniv]
+                   else
+                     paracompopt:=[cpo_comparedefaultvalue,cpo_openequalisexact,cpo_ignoreuniv];
+
+                   { Check calling convention }
+                   if (fwpd.proccalloption<>currpd.proccalloption) then
+                    begin
+                      { In delphi it is possible to specify the calling
+                        convention in the interface or implementation if
+                        there was no convention specified in the other
+                        part }
+                      if (m_delphi in current_settings.modeswitches) then
+                        begin
+                          if not(po_hascallingconvention in currpd.procoptions) then
+                            currpd.proccalloption:=fwpd.proccalloption
+                          else
+                            if not(po_hascallingconvention in fwpd.procoptions) then
+                              fwpd.proccalloption:=currpd.proccalloption
+                          else
+                            begin
+                              MessagePos(currpd.fileinfo,parser_e_call_convention_dont_match_forward);
+                              tprocsym(currpd.procsym).write_parameter_lists(currpd);
+                              { restore interface settings }
+                              currpd.proccalloption:=fwpd.proccalloption;
+                            end;
+                        end
+                      else
+                        begin
+                          MessagePos(currpd.fileinfo,parser_e_call_convention_dont_match_forward);
+                          tprocsym(currpd.procsym).write_parameter_lists(currpd);
+                          { restore interface settings }
+                          currpd.proccalloption:=fwpd.proccalloption;
+                        end;
+                    end;
+
+                   { Check static }
+                   if (po_staticmethod in fwpd.procoptions) then
+                    begin
+                      if not (po_staticmethod in currpd.procoptions) then
+                       begin
+                         include(currpd.procoptions, po_staticmethod);
+                         if (po_classmethod in currpd.procoptions) then
+                          begin
+                           { remove self from the hidden paras }
+                           symentry:=currpd.parast.Find('self');
+                           if symentry<>nil then
+                            begin
+                              currpd.parast.Delete(symentry);
+                              currpd.calcparas;
+                            end;
+                          end;
+                       end;
+                    end;
+
+                   { Check if the procedure type and return type are correct,
+                     also the parameters must match also with the type and that
+                     if the implementation has default parameters, the interface
+                     also has them and that if they both have them, that they
+                     have the same value }
+                   if ((m_repeat_forward in current_settings.modeswitches) or
+                       not is_bareprocdef(currpd)) and
+                       (
+                         (
+                           fwpd.is_generic and
+                           currpd.is_generic and
+                           not equal_generic_procdefs(fwpd,currpd)
+                         ) or
+                         (
+                           (
+                             not fwpd.is_generic or
+                             not currpd.is_generic
+                           ) and
+                           (
+                             (compare_paras(fwpd.paras,currpd.paras,cp_all,paracompopt)<>te_exact) or
+                             (compare_defs(fwpd.returndef,currpd.returndef,nothingn)<>te_exact)
+                           )
+                         )
+                       ) then
+                     begin
+                       MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
+                                   fwpd.fullprocname(false));
+                       tprocsym(currpd.procsym).write_parameter_lists(currpd);
+                       break;
+                     end;
+
+                   { Check if both are declared forward }
+                   if fwpd.forwarddef and currpd.forwarddef then
+                    begin
+                      MessagePos1(currpd.fileinfo,parser_e_function_already_declared_public_forward,
+                                  currpd.fullprocname(false));
+                    end;
+
+                   { internconst or internproc only need to be defined once }
+                   if (fwpd.proccalloption=pocall_internproc) then
+                    currpd.proccalloption:=fwpd.proccalloption
+                   else
+                    if (currpd.proccalloption=pocall_internproc) then
+                     fwpd.proccalloption:=currpd.proccalloption;
+
+                   { Check procedure options, Delphi requires that class is
+                     repeated in the implementation for class methods }
+                   if (m_fpc in current_settings.modeswitches) then
+                     po_comp:=[po_classmethod,po_varargs,po_methodpointer,po_interrupt]
+                   else
+                     po_comp:=[po_classmethod,po_methodpointer];
+
+                   if ((po_comp * fwpd.procoptions)<>(po_comp * currpd.procoptions)) or
+                      (fwpd.proctypeoption <> currpd.proctypeoption) or
+                      { if the implementation version has an "overload" modifier,
+                        the interface version must also have it (otherwise we can
+                        get annoying crashes due to interface crc changes) }
+                      (not(po_overload in fwpd.procoptions) and
+                       (po_overload in currpd.procoptions)) or
+                      { same with noreturn }
+                      (not(po_noreturn in fwpd.procoptions) and
+                       (po_noreturn in currpd.procoptions)) then
+                     begin
+                       MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
+                                   fwpd.fullprocname(false));
+                       tprocsym(fwpd.procsym).write_parameter_lists(fwpd);
+                       { This error is non-fatal, we can recover }
+                     end;
+
+                   { Forward declaration is external? }
+                   if (po_external in fwpd.procoptions) then
+                     MessagePos(currpd.fileinfo,parser_e_proc_already_external);
+
+                   { check for conflicts with "virtual" if this is a virtual
+                     method, as "virtual" cannot be repeated in the
+                     implementation and hence does not get checked against }
+                   if (po_virtualmethod in fwpd.procoptions) then
+                     begin
+                       po_comp:=currpd.procoptions*PD_VIRTUAL_MUTEXCLPO;
+                       if po_comp<>[] then
+                         MessagePos2(currpd.fileinfo,parser_e_proc_dir_conflict,tokeninfo^[_VIRTUAL].str,get_first_proc_str(po_comp));
+                     end;
+                    { Check parameters }
+                   if (m_repeat_forward in current_settings.modeswitches) or
+                      (currpd.minparacount>0) then
+                    begin
+                      { If mangled names are equal then they have the same amount of arguments }
+                      { We can check the names of the arguments }
+                      { both symtables are in the same order from left to right }
+                      curridx:=0;
+                      fwidx:=0;
+                      currparacnt:=currpd.parast.SymList.Count;
+                      fwparacnt:=fwpd.parast.SymList.Count;
+                      repeat
+                        { skip default parameter constsyms }
+                        while (curridx<currparacnt) and
+                              (tsym(currpd.parast.SymList[curridx]).typ<>paravarsym) do
+                          inc(curridx);
+                        while (fwidx<fwparacnt) and
+                              (tsym(fwpd.parast.SymList[fwidx]).typ<>paravarsym) do
+                          inc(fwidx);
+                        { stop when one of the two lists is at the end }
+                        if (fwidx>=fwparacnt) or (curridx>=currparacnt) then
+                          break;
+                        { compare names of parameters, ignore implictly
+                          renamed parameters }
+                        currparasym:=tsym(currpd.parast.SymList[curridx]);
+                        fwparasym:=tsym(fwpd.parast.SymList[fwidx]);
+                        if not(sp_implicitrename in currparasym.symoptions) and
+                           not(sp_implicitrename in fwparasym.symoptions) then
+                          begin
+                            if (currparasym.name<>fwparasym.name) then
+                              begin
+                                MessagePos3(currpd.fileinfo,parser_e_header_different_var_names,
+                                            tprocsym(currpd.procsym).realname,fwparasym.realname,currparasym.realname);
+                                break;
+                              end;
+                          end;
+                        { next parameter }
+                        inc(curridx);
+                        inc(fwidx);
+                      until false;
+                    end;
+                   { check that the type parameter names for generic methods match;
+                     we check this here and not in equal_generic_procdefs as the defs
+                     might still be different due to their parameters, so we'd generate
+                     errors without any need }
+                   if currpd.is_generic and fwpd.is_generic then
+                     { an error here is recoverable, so we simply continue }
+                     check_generic_parameters(fwpd,currpd);
+                   { Everything is checked, now we can update the forward declaration
+                     with the new data from the implementation }
+                   fwpd.forwarddef:=currpd.forwarddef;
+                   fwpd.hasforward:=true;
+                   fwpd.procoptions:=fwpd.procoptions+currpd.procoptions;
+
+                   { marked as local but exported from unit? }
+                   if (po_kylixlocal in fwpd.procoptions) and (fwpd.owner.symtabletype=globalsymtable) then
+                     MessagePos(fwpd.fileinfo,type_e_cant_export_local);
+
+                   if fwpd.extnumber=$ffff then
+                     fwpd.extnumber:=currpd.extnumber;
+                   while not currpd.aliasnames.empty do
+                     fwpd.aliasnames.insert(currpd.aliasnames.getfirst);
+                   { update fileinfo so position references the implementation,
+                     also update funcretsym if it is already generated }
+                   fwpd.fileinfo:=currpd.fileinfo;
+                   if assigned(fwpd.funcretsym) then
+                     fwpd.funcretsym.fileinfo:=currpd.fileinfo;
+                   if assigned(currpd.deprecatedmsg) then
+                     begin
+                       stringdispose(fwpd.deprecatedmsg);
+                       fwpd.deprecatedmsg:=stringdup(currpd.deprecatedmsg^);
+                     end;
+                   { import names }
+                   if assigned(currpd.import_dll) then
+                     begin
+                       stringdispose(fwpd.import_dll);
+                       fwpd.import_dll:=stringdup(currpd.import_dll^);
+                     end;
+                   if assigned(currpd.import_name) then
+                     begin
+                       stringdispose(fwpd.import_name);
+                       fwpd.import_name:=stringdup(currpd.import_name^);
+                     end;
+                   fwpd.import_nr:=currpd.import_nr;
+                   { for compilerproc defines we need to rename and update the
+                     symbolname to lowercase so users can' access it (can't do
+                     it immediately, because then the implementation symbol
+                     won't be matched) }
+                   if po_compilerproc in fwpd.procoptions then
+                     begin
+                       fwpd.setcompilerprocname;
+                       current_module.add_public_asmsym(fwpd.procsym.realname,AB_GLOBAL,AT_FUNCTION);
+                     end;
+                   if po_public in fwpd.procoptions then
+                     begin
+                       item:=fwpd.aliasnames.first;
+                       while assigned(item) do
+                         begin
+                           current_module.add_public_asmsym(TCmdStrListItem(item).str,AB_GLOBAL,AT_FUNCTION);
+                           item:=item.next;
+                         end;
+                     end;
+
+                   { Release current procdef }
+                   currpd.owner.deletedef(currpd);
+                   currpd:=fwpd;
+                 end
+               else
+                begin
+                  { abstract methods aren't forward defined, but this }
+                  { needs another error message                   }
+                  if (po_abstractmethod in fwpd.procoptions) then
+                    MessagePos(currpd.fileinfo,parser_e_abstract_no_definition)
+                  else
+                    begin
+                      MessagePos(currpd.fileinfo,parser_e_overloaded_have_same_parameters);
+                      tprocsym(currpd.procsym).write_parameter_lists(currpd);
+                    end;
+                 end;
+
+               { we found one proc with the same arguments, there are no others
+                 so we can stop }
+               break;
+             end;
+
+           { check for allowing overload directive }
+           if not(m_fpc in current_settings.modeswitches) then
+            begin
+              { overload directive turns on overloading }
+              if ((po_overload in currpd.procoptions) or
+                  (po_overload in fwpd.procoptions)) then
+               begin
+                 { check if all procs have overloading, but not if the proc is a method or
+                   already declared forward, then the check is already done }
+                 if not(fwpd.hasforward or
+                        assigned(currpd.struct) or
+                        (currpd.forwarddef<>fwpd.forwarddef) or
+                        ((po_overload in currpd.procoptions) and
+                         (po_overload in fwpd.procoptions))) then
+                  begin
+                    MessagePos1(currpd.fileinfo,parser_e_no_overload_for_all_procs,currpd.procsym.realname);
+                    break;
+                  end
+               end
+              else
+               begin
+                 if not(fwpd.forwarddef) then
+                  begin
+                    if (m_tp7 in current_settings.modeswitches) then
+                      MessagePos(currpd.fileinfo,parser_e_procedure_overloading_is_off)
+                    else
+                      MessagePos1(currpd.fileinfo,parser_e_no_overload_for_all_procs,currpd.procsym.realname);
+                    break;
+                  end;
+               end;
+            end; { equal arguments }
+         end;
+
+        { if we didn't reuse a forwarddef then we add the procdef to the overloaded
+          list }
+        if not forwardfound then
+          begin
+            { can happen in Delphi mode }
+            if (currpd.proctypeoption = potype_function) and
+               is_void(currpd.returndef) then
+              MessagePos1(currpd.fileinfo,parser_e_no_funcret_specified,currpd.procsym.realname);
+            tprocsym(currpd.procsym).ProcdefList.Add(currpd);
+            if not currpd.forwarddef and (po_public in currpd.procoptions) then
+              begin
+                item:=currpd.aliasnames.first;
+                while assigned(item) do
+                  begin
+                    current_module.add_public_asmsym(TCmdStrListItem(item).str,AB_GLOBAL,AT_FUNCTION);
+                    item:=item.next;
+                  end;
+              end;
+          end;
+
+        proc_add_definition:=forwardfound;
+      end;
+
+
+    procedure build_parentfpstruct(pd: tprocdef);
+      var
+        nestedvars: tsym;
+        nestedvarsst: tsymtable;
+        pnestedvarsdef,
+        nestedvarsdef: tdef;
+        old_symtablestack: tsymtablestack;
+      begin
+        { make sure the defs are not registered in the current symtablestack,
+          because they may be for a parent procdef (changeowner does remove a def
+          from the symtable in which it was originally created, so that by itself
+          is not enough) }
+        old_symtablestack:=symtablestack;
+        symtablestack:=old_symtablestack.getcopyuntil(current_module.localsymtable);
+        { create struct to hold local variables and parameters that are
+          accessed from within nested routines (start with extra dollar to prevent
+          the JVM from thinking this is a nested class in the unit) }
+        nestedvarsst:=trecordsymtable.create('$'+current_module.realmodulename^+'$$_fpc_nestedvars$'+pd.unique_id_str,
+          current_settings.alignment.localalignmax,current_settings.alignment.localalignmin,current_settings.alignment.maxCrecordalign);
+        nestedvarsdef:=crecorddef.create(nestedvarsst.name^,nestedvarsst);
+  {$ifdef jvm}
+        maybe_guarantee_record_typesym(nestedvarsdef,nestedvarsdef.owner);
+        { don't add clone/FpcDeepCopy, because the field names are not all
+          representable in source form and we don't need them anyway }
+        symtablestack.push(trecorddef(nestedvarsdef).symtable);
+        maybe_add_public_default_java_constructor(trecorddef(nestedvarsdef));
+        insert_record_hidden_paras(trecorddef(nestedvarsdef));
+        symtablestack.pop(trecorddef(nestedvarsdef).symtable);
+  {$endif}
+        symtablestack.free;
+        symtablestack:=old_symtablestack.getcopyuntil(pd.localst);
+        pnestedvarsdef:=cpointerdef.getreusable(nestedvarsdef);
+        if not(po_assembler in pd.procoptions) then
+          begin
+            nestedvars:=clocalvarsym.create('$nestedvars',vs_var,nestedvarsdef,[],true);
+            include(nestedvars.symoptions,sp_internal);
+            pd.localst.insert(nestedvars);
+            pd.parentfpstruct:=nestedvars;
+            pd.parentfpinitblock:=cblocknode.create(nil);
+          end;
+        symtablestack.free;
+        pd.parentfpstructptrtype:=pnestedvarsdef;
+
+        symtablestack:=old_symtablestack;
+      end;
+
 end.

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 205;
+  CurrentPPUVersion = 206;
 
 { unit flags }
   uf_init                = $000001; { unit has initialization section }

compiler/procdefutil.pas

@@ -0,0 +1,91 @@
+{
+    Copyright (c) 2018 by Jonas Maebe
+
+    This unit provides helpers for creating procdefs
+
+    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.
+
+ ****************************************************************************
+}
+{$i fpcdefs.inc}
+unit procdefutil;
+
+interface
+
+uses
+  symconst,symtype,symdef;
+
+{ create a nested procdef that will be used to outline code from a procedure;
+  astruct should usually be nil, except in special cases like the Windows SEH
+  exception handling funclets }
+function create_outline_procdef(const basesymname: string; astruct: tabstractrecorddef; potype: tproctypeoption; resultdef: tdef): tprocdef;
+
+implementation
+
+  uses
+    cutils,
+    symbase,symsym,symtable,pparautl,globtype;
+
+
+  function create_outline_procdef(const basesymname: string; astruct: tabstractrecorddef; potype: tproctypeoption; resultdef: tdef): tprocdef;
+    var
+      st:TSymTable;
+      checkstack: psymtablestackitem;
+      oldsymtablestack: tsymtablestack;
+      sym:tprocsym;
+    begin
+      { get actual procedure symtable (skip withsymtables, etc.) }
+      st:=nil;
+      checkstack:=symtablestack.stack;
+      while assigned(checkstack) do
+        begin
+          st:=checkstack^.symtable;
+          if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
+            break;
+          checkstack:=checkstack^.next;
+        end;
+      { Create a nested procedure, even from main_program_level.
+        Furthermore, force procdef and procsym into the same symtable
+        (by default, defs are registered with symtablestack.top which may be
+        something temporary like exceptsymtable - in that case, procdef can be
+        destroyed before procsym, leaving invalid pointers). }
+      oldsymtablestack:=symtablestack;
+      symtablestack:=nil;
+      result:=cprocdef.create(max(normal_function_level,st.symtablelevel)+1,true);
+      result.returndef:=resultdef;
+      symtablestack:=oldsymtablestack;
+      st.insertdef(result);
+      result.struct:=astruct;
+      { tabstractprocdef constructor sets po_delphi_nested_cc whenever
+        nested procvars modeswitch is active. We must be independent of this switch. }
+      exclude(result.procoptions,po_delphi_nested_cc);
+      result.proctypeoption:=potype;
+      { always use the default calling convention }
+      result.proccalloption:=pocall_default;
+      include(result.procoptions,po_hascallingconvention);
+      handle_calling_convention(result,hcc_default_actions_impl);
+      sym:=cprocsym.create(basesymname+result.unique_id_str);
+      st.insert(sym);
+
+      result.procsym:=sym;
+      proc_add_definition(result);
+      { the code will be assigned directly to the "code" field later }
+      result.forwarddef:=false;
+      result.aliasnames.insert(result.mangledname);
+    end;
+
+
+end.
+

compiler/procinfo.pas

@@ -31,7 +31,8 @@ unit procinfo;
       { global }
       globtype,
       { symtable }
-      symconst,symdef,symsym,
+      symconst,symtype,symdef,symsym,
+      node,
       { aasm }
       cpubase,cgbase,cgutils,
       aasmbase,aasmdata;
@@ -168,6 +169,8 @@ unit procinfo;
           function has_nestedprocs: boolean;
           function get_normal_proc: tprocinfo;
 
+          function create_for_outlining(const basesymname: string; astruct: tabstractrecorddef; potype: tproctypeoption; resultdef: tdef; entrynodeinfo: tnode): tprocinfo;
+
           { Add to parent's list of nested procedures even if parent is a 'main' procedure }
           procedure force_nested;
 
@@ -189,7 +192,8 @@ unit procinfo;
 implementation
 
     uses
-      cutils,systems;
+      globals,cutils,systems,
+      procdefutil;
 
 {****************************************************************************
                                  TProcInfo
@@ -273,6 +277,17 @@ implementation
           result:=result.parent;
       end;
 
+    function tprocinfo.create_for_outlining(const basesymname: string; astruct: tabstractrecorddef; potype: tproctypeoption; resultdef: tdef; entrynodeinfo: tnode): tprocinfo;
+      begin
+        result:=cprocinfo.create(self);
+        result.force_nested;
+        result.procdef:=create_outline_procdef(basesymname,astruct,potype,resultdef);
+        result.entrypos:=entrynodeinfo.fileinfo;
+        result.entryswitches:=entrynodeinfo.localswitches;
+        result.exitpos:=current_filepos; // filepos of last node?
+        result.exitswitches:=current_settings.localswitches; // localswitches of last node?
+      end;
+
     procedure tprocinfo.allocate_push_parasize(size:longint);
       begin
         if size>maxpushedparasize then

compiler/pstatmnt.pas

@@ -776,8 +776,6 @@ implementation
               symtablestack.pop(TSymtable(withsymtablelist[i]));
             withsymtablelist.free;
 
-//            p:=cwithnode.create(right,twithsymtable(withsymtable),levelcount,refnode);
-
             { Finalize complex withnode with destroy of temp }
             if assigned(newblock) then
              begin
@@ -1217,6 +1215,11 @@ implementation
                  Message(parser_e_no_assembler_in_generic);
                code:=_asm_statement;
              end;
+           _PLUS:
+             begin
+               Message(parser_e_syntax_error);
+               consume(_PLUS);
+             end;
            _EOF :
              Message(scan_f_end_of_file);
          else
@@ -1252,7 +1255,7 @@ implementation
                    if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
                      begin
                        tlabelsym(srsym).nonlocal:=true;
-                       exclude(current_procinfo.procdef.procoptions,po_inline);
+                       include(current_procinfo.flags,pi_has_interproclabel);
                      end;
                    if tlabelsym(srsym).nonlocal and
                      (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then