synchronized with r33113

git-svn-id: branches/maciej/smart_pointers@33114 -

.gitattributes

@@ -121,6 +121,7 @@ compiler/avr/itcpugas.pas svneol=native#text/plain
 compiler/avr/navradd.pas svneol=native#text/plain
 compiler/avr/navrcnv.pas svneol=native#text/plain
 compiler/avr/navrmat.pas svneol=native#text/plain
+compiler/avr/navrutil.pas svneol=native#text/pascal
 compiler/avr/raavr.pas svneol=native#text/plain
 compiler/avr/raavrgas.pas svneol=native#text/plain
 compiler/avr/ravrcon.inc svneol=native#text/plain
@@ -166,6 +167,7 @@ compiler/defcmp.pas svneol=native#text/plain
 compiler/defutil.pas svneol=native#text/plain
 compiler/dirparse.pas svneol=native#text/plain
 compiler/elfbase.pas svneol=native#text/plain
+compiler/entfile.pas svneol=native#text/plain
 compiler/export.pas svneol=native#text/plain
 compiler/expunix.pas svneol=native#text/plain
 compiler/finput.pas svneol=native#text/plain
@@ -337,6 +339,7 @@ compiler/llvm/llvmsym.pas svneol=native#text/plain
 compiler/llvm/llvmtarg.pas svneol=native#text/plain
 compiler/llvm/llvmtype.pas svneol=native#text/plain
 compiler/llvm/nllvmadd.pas svneol=native#text/plain
+compiler/llvm/nllvmbas.pas svneol=native#text/plain
 compiler/llvm/nllvmcal.pas svneol=native#text/plain
 compiler/llvm/nllvmcnv.pas svneol=native#text/plain
 compiler/llvm/nllvmcon.pas svneol=native#text/plain
@@ -346,6 +349,7 @@ compiler/llvm/nllvmmat.pas svneol=native#text/plain
 compiler/llvm/nllvmmem.pas svneol=native#text/plain
 compiler/llvm/nllvmtcon.pas svneol=native#text/plain
 compiler/llvm/nllvmutil.pas svneol=native#text/plain
+compiler/llvm/nllvmvmt.pas svneol=native#text/plain
 compiler/llvm/rgllvm.pas svneol=native#text/plain
 compiler/llvm/symllvm.pas svneol=native#text/plain
 compiler/llvm/tgllvm.pas svneol=native#text/plain
@@ -370,6 +374,7 @@ compiler/m68k/n68kcnv.pas svneol=native#text/plain
 compiler/m68k/n68kinl.pas svneol=native#text/plain
 compiler/m68k/n68kmat.pas svneol=native#text/plain
 compiler/m68k/n68kmem.pas svneol=native#text/plain
+compiler/m68k/r68kbss.inc svneol=native#text/plain
 compiler/m68k/r68kcon.inc svneol=native#text/plain
 compiler/m68k/r68kgas.inc svneol=native#text/plain
 compiler/m68k/r68kgri.inc svneol=native#text/plain
@@ -486,6 +491,7 @@ compiler/nopt.pas svneol=native#text/plain
 compiler/nset.pas svneol=native#text/plain
 compiler/nstate.pas svneol=native#text/plain
 compiler/nutils.pas svneol=native#text/plain
+compiler/objcasm.pas svneol=native#text/plain
 compiler/objcdef.pas svneol=native#text/plain
 compiler/objcgutl.pas svneol=native#text/plain
 compiler/objcutil.pas svneol=native#text/plain
@@ -1934,6 +1940,7 @@ packages/fcl-base/examples/fpdoc.dtd -text
 packages/fcl-base/examples/fpexprpars.txt svneol=native#text/plain
 packages/fcl-base/examples/fstream.pp svneol=native#text/plain
 packages/fcl-base/examples/htdump.pp svneol=native#text/plain
+packages/fcl-base/examples/inifmt.pp svneol=native#text/plain
 packages/fcl-base/examples/intl/Makefile svneol=native#text/plain
 packages/fcl-base/examples/intl/README.txt svneol=native#text/plain
 packages/fcl-base/examples/intl/restest.cs.mo -text
@@ -1966,6 +1973,7 @@ packages/fcl-base/examples/showver.pp svneol=native#text/plain
 packages/fcl-base/examples/showver.rc -text
 packages/fcl-base/examples/showver.res -text
 packages/fcl-base/examples/simple.xml -text
+packages/fcl-base/examples/sitest.pp svneol=native#text/plain
 packages/fcl-base/examples/sockcli.pp svneol=native#text/plain
 packages/fcl-base/examples/socksvr.pp svneol=native#text/plain
 packages/fcl-base/examples/sstream.pp svneol=native#text/plain
@@ -1981,6 +1989,7 @@ packages/fcl-base/examples/testcont.pp svneol=native#text/plain
 packages/fcl-base/examples/testexprpars.pp svneol=native#text/plain
 packages/fcl-base/examples/testez.pp svneol=native#text/plain
 packages/fcl-base/examples/testhres.pp svneol=native#text/plain
+packages/fcl-base/examples/testini.pp svneol=native#text/plain
 packages/fcl-base/examples/testipc_client.pp svneol=native#text/plain
 packages/fcl-base/examples/testipc_server.pp svneol=native#text/plain
 packages/fcl-base/examples/testmime.pp svneol=native#text/plain
@@ -2045,6 +2054,7 @@ packages/fcl-base/src/pooledmm.pp svneol=native#text/plain
 packages/fcl-base/src/rtfdata.inc svneol=native#text/plain
 packages/fcl-base/src/rtfpars.pp svneol=native#text/plain
 packages/fcl-base/src/rttiutils.pp svneol=native#text/plain
+packages/fcl-base/src/singleinstance.pp svneol=native#text/plain
 packages/fcl-base/src/streamcoll.pp svneol=native#text/plain
 packages/fcl-base/src/streamex.pp svneol=native#text/plain
 packages/fcl-base/src/streamio.pp svneol=native#text/plain
@@ -2119,6 +2129,7 @@ packages/fcl-db/src/datadict/fpdatadict.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpdddbf.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpdddiff.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpddfb.pp svneol=native#text/plain
+packages/fcl-db/src/datadict/fpddmssql.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpddmysql40.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpddmysql41.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpddmysql50.pp svneol=native#text/plain
@@ -2371,6 +2382,7 @@ packages/fcl-fpcunit/src/exampletests/Makefile.fpc svneol=native#text/plain
 packages/fcl-fpcunit/src/exampletests/fpcunittests.pp svneol=native#text/plain
 packages/fcl-fpcunit/src/exampletests/money.pp svneol=native#text/plain
 packages/fcl-fpcunit/src/exampletests/moneytest.pp svneol=native#text/plain
+packages/fcl-fpcunit/src/exampletests/needassert.pp svneol=native#text/plain
 packages/fcl-fpcunit/src/exampletests/testmockobject.pp svneol=native#text/plain
 packages/fcl-fpcunit/src/fpcunit.pp svneol=native#text/plain
 packages/fcl-fpcunit/src/fpcunitreport.pp svneol=native#text/plain
@@ -2493,6 +2505,7 @@ packages/fcl-json/src/jsonconf.pp svneol=native#text/plain
 packages/fcl-json/src/jsonparser.pp svneol=native#text/plain
 packages/fcl-json/src/jsonscanner.pp svneol=native#text/plain
 packages/fcl-json/tests/jsonconftest.pp svneol=native#text/plain
+packages/fcl-json/tests/testcomps.pp svneol=native#text/plain
 packages/fcl-json/tests/testjson.lpi svneol=native#text/plain
 packages/fcl-json/tests/testjson.pp svneol=native#text/plain
 packages/fcl-json/tests/testjsonconf.lpi svneol=native#text/plain
@@ -2564,6 +2577,16 @@ packages/fcl-passrc/tests/testpassrc.lpr svneol=native#text/plain
 packages/fcl-process/Makefile svneol=native#text/plain
 packages/fcl-process/Makefile.fpc svneol=native#text/plain
 packages/fcl-process/Makefile.fpc.fpcmake svneol=native#text/plain
+packages/fcl-process/examples/demoproject.ico -text
+packages/fcl-process/examples/demoproject.lpi svneol=native#text/plain
+packages/fcl-process/examples/demoproject.pp svneol=native#text/plain
+packages/fcl-process/examples/demoproject.res -text
+packages/fcl-process/examples/demoruncommand.lpi svneol=native#text/plain
+packages/fcl-process/examples/demoruncommand.pp svneol=native#text/plain
+packages/fcl-process/examples/echoparams.pp svneol=native#text/plain
+packages/fcl-process/examples/empty.pp svneol=native#text/pascal
+packages/fcl-process/examples/infinity.pp svneol=native#text/pascal
+packages/fcl-process/examples/waitonexit.pp svneol=native#text/pascal
 packages/fcl-process/fpmake.pp svneol=native#text/plain
 packages/fcl-process/src/amicommon/pipes.inc svneol=native#text/plain
 packages/fcl-process/src/amicommon/process.inc svneol=native#text/plain
@@ -2585,9 +2608,8 @@ packages/fcl-process/src/unix/process.inc svneol=native#text/plain
 packages/fcl-process/src/unix/simpleipc.inc svneol=native#text/plain
 packages/fcl-process/src/win/pipes.inc svneol=native#text/plain
 packages/fcl-process/src/win/process.inc svneol=native#text/plain
-packages/fcl-process/src/win/simpleipc.inc svneol=native#text/plain
+packages/fcl-process/src/winall/simpleipc.inc svneol=native#text/plain
 packages/fcl-process/src/wince/process.inc svneol=native#text/plain
-packages/fcl-process/src/wince/simpleipc.inc svneol=native#text/plain
 packages/fcl-registry/Makefile svneol=native#text/plain
 packages/fcl-registry/Makefile.fpc svneol=native#text/plain
 packages/fcl-registry/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -3141,6 +3163,8 @@ packages/fcl-web/src/base/Makefile.fpc svneol=native#text/plain
 packages/fcl-web/src/base/README.txt svneol=native#text/plain
 packages/fcl-web/src/base/cgiapp.pp svneol=native#text/plain
 packages/fcl-web/src/base/cgiprotocol.pp svneol=native#text/plain
+packages/fcl-web/src/base/custapache.pp svneol=native#text/plain
+packages/fcl-web/src/base/custapache24.pp svneol=native#text/plain
 packages/fcl-web/src/base/custcgi.pp svneol=native#text/plain
 packages/fcl-web/src/base/custfcgi.pp svneol=native#text/plain
 packages/fcl-web/src/base/custhttpapp.pp svneol=native#text/plain
@@ -4955,6 +4979,37 @@ packages/libgd/examples/gdtest.pp svneol=native#text/plain
 packages/libgd/examples/gdtestcgi.pp svneol=native#text/plain
 packages/libgd/fpmake.pp svneol=native#text/plain
 packages/libgd/src/gd.pas svneol=native#text/plain
+packages/libmicrohttpd/Makefile svneol=native#text/plain
+packages/libmicrohttpd/Makefile.fpc svneol=native#text/plain
+packages/libmicrohttpd/examples/basicauthentication.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/benchmark.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/benchmark_https.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/chunked_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/cutils.pas svneol=native#text/plain
+packages/libmicrohttpd/examples/demo.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/demo_https.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/digest_auth_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/dual_stack_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/event_and_thread.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/fileserver_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/fileserver_example_dirs.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/fileserver_example_external_select.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/hellobrowser.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/https_fileserver_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/largepost.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/logging.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/magic.inc svneol=native#text/plain
+packages/libmicrohttpd/examples/minimal_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/minimal_example_comet.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/post_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/querystring_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/refuse_post_example.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/responseheaders.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/sessions.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/simplepost.pp svneol=native#text/plain
+packages/libmicrohttpd/examples/tlsauthentication.pp svneol=native#text/plain
+packages/libmicrohttpd/fpmake.pp svneol=native#text/plain
+packages/libmicrohttpd/src/libmicrohttpd.pp svneol=native#text/plain
 packages/libndsfpc/Makefile svneol=native#text/plain
 packages/libndsfpc/Makefile.fpc svneol=native#text/plain
 packages/libndsfpc/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -5768,19 +5823,24 @@ packages/morphunits/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/morphunits/fpmake.pp svneol=native#text/plain
 packages/morphunits/src/agraphics.pas svneol=native#text/plain
 packages/morphunits/src/ahi.pas svneol=native#text/plain
+packages/morphunits/src/akeyboard.pas svneol=native#text/plain
 packages/morphunits/src/amigados.pas svneol=native#text/plain
 packages/morphunits/src/amigalib.pas svneol=native#text/plain
 packages/morphunits/src/asl.pas svneol=native#text/plain
+packages/morphunits/src/cgxvideo.pas svneol=native#text/plain
 packages/morphunits/src/clipboard.pas svneol=native#text/plain
+packages/morphunits/src/cybergraphics.pas svneol=native#text/plain
 packages/morphunits/src/datatypes.pas svneol=native#text/plain
+packages/morphunits/src/diskfont.pas svneol=native#text/plain
 packages/morphunits/src/exec.pas svneol=native#text/plain
+packages/morphunits/src/gadtools.pas svneol=native#text/pascal
 packages/morphunits/src/get9.pas svneol=native#text/plain
 packages/morphunits/src/hardware.pas svneol=native#text/plain
 packages/morphunits/src/iffparse.pas svneol=native#text/plain
+packages/morphunits/src/input.pas svneol=native#text/plain
 packages/morphunits/src/inputevent.pas svneol=native#text/plain
 packages/morphunits/src/intuition.pas svneol=native#text/plain
 packages/morphunits/src/keymap.pas svneol=native#text/plain
-packages/morphunits/src/kvm.pas svneol=native#text/plain
 packages/morphunits/src/layers.pas svneol=native#text/plain
 packages/morphunits/src/mui.pas svneol=native#text/plain
 packages/morphunits/src/muihelper.pas svneol=native#text/plain
@@ -6437,6 +6497,10 @@ packages/paszlib/examples/Makefile.fpc svneol=native#text/plain
 packages/paszlib/examples/example.pas svneol=native#text/plain
 packages/paszlib/examples/example2.pas svneol=native#text/plain
 packages/paszlib/examples/extractodt.pas svneol=native#text/plain
+packages/paszlib/examples/fpunzipper.lpi svneol=native#text/plain
+packages/paszlib/examples/fpunzipper.lpr svneol=native#text/plain
+packages/paszlib/examples/fpzipper.lpi svneol=native#text/plain
+packages/paszlib/examples/fpzipper.lpr svneol=native#text/plain
 packages/paszlib/examples/minigzip.pas svneol=native#text/plain
 packages/paszlib/examples/miniunz.pas svneol=native#text/plain
 packages/paszlib/examples/minizip.pas svneol=native#text/plain
@@ -6916,6 +6980,7 @@ packages/rtl-objpas/src/inc/varerror.inc svneol=native#text/plain
 packages/rtl-objpas/src/inc/variants.pp svneol=native#text/plain
 packages/rtl-objpas/src/inc/varutilh.inc svneol=native#text/plain
 packages/rtl-objpas/src/inc/varutils.inc svneol=native#text/plain
+packages/rtl-objpas/src/inc/widestrutils.pp svneol=native#text/plain
 packages/rtl-objpas/src/morphos/varutils.pp svneol=native#text/plain
 packages/rtl-objpas/src/msdos/varutils.pp svneol=native#text/plain
 packages/rtl-objpas/src/nativent/varutils.pp svneol=native#text/pascal
@@ -8113,6 +8178,7 @@ rtl/android/jvm/java_sysh_android.inc svneol=native#text/plain
 rtl/android/jvm/rtl.cfg svneol=native#text/plain
 rtl/android/mipsel/dllprt0.as svneol=native#text/plain
 rtl/android/mipsel/prt0.as svneol=native#text/plain
+rtl/android/sysandroid.inc svneol=native#text/plain
 rtl/arm/arm.inc svneol=native#text/plain
 rtl/arm/armdefines.inc svneol=native#text/plain
 rtl/arm/divide.inc svneol=native#text/plain
@@ -8318,7 +8384,11 @@ rtl/embedded/arm/lpc13xx.pp svneol=native#text/pascal
 rtl/embedded/arm/lpc1768.pp svneol=native#text/pascal
 rtl/embedded/arm/lpc21x4.pp svneol=native#text/plain
 rtl/embedded/arm/lpc8xx.pp svneol=native#text/pascal
+rtl/embedded/arm/mk20d5.pp svneol=native#text/pascal
 rtl/embedded/arm/mk20d7.pp svneol=native#text/plain
+rtl/embedded/arm/mk22f51212.pp svneol=native#text/pascal
+rtl/embedded/arm/mk64f12.pp svneol=native#text/pascal
+rtl/embedded/arm/sam3x8e.pp svneol=native#text/pascal
 rtl/embedded/arm/sc32442b.pp svneol=native#text/pascal
 rtl/embedded/arm/stm32f0xx.pp svneol=native#text/plain
 rtl/embedded/arm/stm32f10x_cl.pp svneol=native#text/plain
@@ -8327,7 +8397,12 @@ rtl/embedded/arm/stm32f10x_hd.pp svneol=native#text/pascal
 rtl/embedded/arm/stm32f10x_ld.pp svneol=native#text/pascal
 rtl/embedded/arm/stm32f10x_md.pp svneol=native#text/pascal
 rtl/embedded/arm/stm32f10x_xl.pp svneol=native#text/pascal
+rtl/embedded/arm/stm32f401xx.pp svneol=native#text/pascal
+rtl/embedded/arm/stm32f407xx.pp svneol=native#text/pascal
+rtl/embedded/arm/stm32f411xe.pp svneol=native#text/pascal
 rtl/embedded/arm/stm32f429.pp svneol=native#text/pascal
+rtl/embedded/arm/stm32f429xx.pp svneol=native#text/pascal
+rtl/embedded/arm/stm32f446xx.pp svneol=native#text/pascal
 rtl/embedded/arm/stm32f745.pp svneol=native#text/plain
 rtl/embedded/arm/stm32f746.pp svneol=native#text/plain
 rtl/embedded/arm/stm32f756.pp svneol=native#text/plain
@@ -8479,6 +8554,7 @@ rtl/embedded/avr/attiny9.pp svneol=native#text/plain
 rtl/embedded/avr/avrcommon.inc svneol=native#text/plain
 rtl/embedded/avr/avrsim.pp svneol=native#text/plain
 rtl/embedded/avr/start.inc svneol=native#text/plain
+rtl/embedded/avr/start_noram.inc svneol=native#text/pascal
 rtl/embedded/buildrtl.lpi svneol=native#text/plain
 rtl/embedded/buildrtl.pp svneol=native#text/plain
 rtl/embedded/check.inc svneol=native#text/plain
@@ -8697,6 +8773,7 @@ rtl/inc/dynlibs.pas svneol=native#text/plain
 rtl/inc/except.inc svneol=native#text/plain
 rtl/inc/excepth.inc svneol=native#text/plain
 rtl/inc/exeinfo.pp svneol=native#text/plain
+rtl/inc/extpas.pp svneol=native#text/pascal
 rtl/inc/extres.inc svneol=native#text/plain
 rtl/inc/fexpand.inc svneol=native#text/plain
 rtl/inc/file.inc svneol=native#text/plain
@@ -8757,6 +8834,8 @@ rtl/inc/threadvr.inc svneol=native#text/plain
 rtl/inc/tinyheap.inc svneol=native#text/plain
 rtl/inc/tnyheaph.inc svneol=native#text/plain
 rtl/inc/typefile.inc svneol=native#text/plain
+rtl/inc/typshrd.inc svneol=native#text/plain
+rtl/inc/typshrdh.inc svneol=native#text/plain
 rtl/inc/ufloat128.pp svneol=native#text/plain
 rtl/inc/ustringh.inc svneol=native#text/plain
 rtl/inc/ustrings.inc svneol=native#text/plain
@@ -8846,15 +8925,8 @@ rtl/linux/errnostr.inc svneol=native#text/plain
 rtl/linux/fpcylix.pp svneol=native#text/plain
 rtl/linux/fpmake.inc svneol=native#text/plain
 rtl/linux/i386/bsyscall.inc svneol=native#text/plain
-rtl/linux/i386/cprt0.as svneol=native#text/plain
-rtl/linux/i386/cprt21.as svneol=native#text/plain
-rtl/linux/i386/dllprt0.as svneol=native#text/plain
-rtl/linux/i386/gprt0.as svneol=native#text/plain
-rtl/linux/i386/gprt21.as svneol=native#text/plain
-rtl/linux/i386/prt0.as svneol=native#text/plain
 rtl/linux/i386/si_c.inc svneol=native#text/plain
 rtl/linux/i386/si_c21.inc svneol=native#text/plain
-rtl/linux/i386/si_c21g.inc svneol=native#text/plain
 rtl/linux/i386/si_dll.inc svneol=native#text/plain
 rtl/linux/i386/si_g.inc svneol=native#text/plain
 rtl/linux/i386/si_prc.inc svneol=native#text/plain
@@ -9318,10 +9390,16 @@ rtl/objpas/sysutils/syscodepagesh.inc svneol=native#text/pascal
 rtl/objpas/sysutils/sysencoding.inc svneol=native#text/pascal
 rtl/objpas/sysutils/sysencodingh.inc svneol=native#text/pascal
 rtl/objpas/sysutils/sysformt.inc svneol=native#text/plain
+rtl/objpas/sysutils/syshelp.inc svneol=native#text/plain
+rtl/objpas/sysutils/syshelpb.inc svneol=native#text/plain
+rtl/objpas/sysutils/syshelpf.inc svneol=native#text/plain
+rtl/objpas/sysutils/syshelph.inc svneol=native#text/plain
+rtl/objpas/sysutils/syshelpo.inc svneol=native#text/plain
 rtl/objpas/sysutils/sysint.inc svneol=native#text/plain
 rtl/objpas/sysutils/sysinth.inc svneol=native#text/plain
 rtl/objpas/sysutils/syspch.inc svneol=native#text/plain
 rtl/objpas/sysutils/syspchh.inc svneol=native#text/plain
+rtl/objpas/sysutils/syssr.inc svneol=native#text/plain
 rtl/objpas/sysutils/sysstr.inc svneol=native#text/plain
 rtl/objpas/sysutils/sysstrh.inc svneol=native#text/plain
 rtl/objpas/sysutils/systhrdh.inc svneol=native#text/plain
@@ -9739,7 +9817,6 @@ rtl/win32/Makefile.fpc svneol=native#text/plain
 rtl/win32/buildrtl.lpi svneol=native#text/plain
 rtl/win32/buildrtl.pp svneol=native#text/plain
 rtl/win32/classes.pp svneol=native#text/plain
-rtl/win32/gprt0.as svneol=native#text/plain
 rtl/win32/initc.pp svneol=native#text/plain
 rtl/win32/objinc.inc svneol=native#text/plain
 rtl/win32/rtldefs.inc svneol=native#text/plain
@@ -9750,11 +9827,8 @@ rtl/win32/sysinitcyg.pp svneol=native#text/plain
 rtl/win32/sysinitgprof.pp svneol=native#text/plain
 rtl/win32/sysinitpas.pp svneol=native#text/plain
 rtl/win32/system.pp svneol=native#text/plain
-rtl/win32/wcygprt0.as svneol=native#text/plain
-rtl/win32/wdllprt0.as svneol=native#text/plain
 rtl/win32/windows.pp svneol=native#text/plain
 rtl/win32/winsysut.pp svneol=native#text/plain
-rtl/win32/wprt0.as svneol=native#text/plain
 rtl/win64/Makefile svneol=native#text/plain
 rtl/win64/Makefile.fpc svneol=native#text/plain
 rtl/win64/buildrtl.lpi svneol=native#text/plain
@@ -9889,6 +9963,7 @@ tests/bench/shortbench.pp svneol=native#text/plain
 tests/bench/stream.pp svneol=native#text/plain
 tests/bench/timer.pas svneol=native#text/plain
 tests/bench/whet.pas svneol=native#text/plain
+tests/createlst.mak svneol=native#text/plain
 tests/dbdigest.cfg.example -text
 tests/readme.txt svneol=native#text/plain
 tests/tbf/tb0001.pp svneol=native#text/plain
@@ -10766,10 +10841,13 @@ tests/tbs/tb0609.pp svneol=native#text/plain
 tests/tbs/tb0610.pp svneol=native#text/pascal
 tests/tbs/tb0611.pp svneol=native#text/pascal
 tests/tbs/tb0612.pp svneol=native#text/pascal
+tests/tbs/tb0613.pp svneol=native#text/pascal
+tests/tbs/tb0614.pp svneol=native#text/pascal
+tests/tbs/tb0615.pp svneol=native#text/pascal
+tests/tbs/tb0616.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain
-tests/tbs/tbs0594.pp svneol=native#text/pascal
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain
@@ -10946,6 +11024,13 @@ tests/test/cg/obj/haiku/i386/tcext3.o -text
 tests/test/cg/obj/haiku/i386/tcext4.o -text
 tests/test/cg/obj/haiku/i386/tcext5.o -text
 tests/test/cg/obj/haiku/i386/tcext6.o -text
+tests/test/cg/obj/linux/aarch64/cpptcl1.o -text
+tests/test/cg/obj/linux/aarch64/cpptcl2.o -text
+tests/test/cg/obj/linux/aarch64/ctest.o -text
+tests/test/cg/obj/linux/aarch64/tcext3.o -text
+tests/test/cg/obj/linux/aarch64/tcext4.o -text
+tests/test/cg/obj/linux/aarch64/tcext5.o -text
+tests/test/cg/obj/linux/aarch64/tcext6.o -text
 tests/test/cg/obj/linux/arm-eabi/cpptcl1.o -text
 tests/test/cg/obj/linux/arm-eabi/cpptcl2.o -text
 tests/test/cg/obj/linux/arm-eabi/ctest.o -text
@@ -11022,6 +11107,7 @@ tests/test/cg/obj/linux/x86_64/tcext4.o -text
 tests/test/cg/obj/linux/x86_64/tcext5.o -text
 tests/test/cg/obj/linux/x86_64/tcext6.o -text
 tests/test/cg/obj/macos/powerpc/ctest.o -text
+tests/test/cg/obj/msdos/i8086/ttasm1.obj -text
 tests/test/cg/obj/netbsd/i386/cpptcl1.o -text
 tests/test/cg/obj/netbsd/i386/cpptcl2.o -text
 tests/test/cg/obj/netbsd/i386/ctest.o -text
@@ -11085,6 +11171,7 @@ tests/test/cg/obj/tcext3.c -text
 tests/test/cg/obj/tcext4.c -text
 tests/test/cg/obj/tcext5.c -text
 tests/test/cg/obj/tcext6.c svneol=native#text/plain
+tests/test/cg/obj/ttasm1.asm svneol=native#text/plain
 tests/test/cg/obj/win32/i386/cpptcl1.o -text
 tests/test/cg/obj/win32/i386/cpptcl2.o -text
 tests/test/cg/obj/win32/i386/ctest.o -text
@@ -11111,6 +11198,7 @@ tests/test/cg/taddint.pp svneol=native#text/plain
 tests/test/cg/taddlong.pp svneol=native#text/plain
 tests/test/cg/taddr1.pp svneol=native#text/plain
 tests/test/cg/taddr2.pp svneol=native#text/plain
+tests/test/cg/taddr3.pp svneol=native#text/plain
 tests/test/cg/taddreal1.pp svneol=native#text/plain
 tests/test/cg/taddreal2.pp svneol=native#text/plain
 tests/test/cg/taddreal3.pp svneol=native#text/plain
@@ -11417,7 +11505,12 @@ tests/test/cg/variants/tvarol9.pp svneol=native#text/plain
 tests/test/cg/variants/tvarol91.pp svneol=native#text/plain
 tests/test/cg/variants/tvarol94.pp svneol=native#text/plain
 tests/test/cg/variants/tvarol96.pp svneol=native#text/plain
+tests/test/cpu16/i8086/tasmseg1.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tfarcal1.pp svneol=native#text/pascal
+tests/test/cpu16/i8086/tfarcal2.pp svneol=native#text/pascal
+tests/test/cpu16/i8086/tfarcal3.pp svneol=native#text/plain
+tests/test/cpu16/i8086/tfarcal4.pp svneol=native#text/plain
+tests/test/cpu16/i8086/tfarjmp2.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tfarptr1.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tfarptr2.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tfarptr3.pp svneol=native#text/pascal
@@ -11432,12 +11525,18 @@ tests/test/cpu16/i8086/thugeptr5.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/thugeptr5a.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tintr1.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tintr2.pp svneol=native#text/pascal
+tests/test/cpu16/i8086/tlbldat1.pp svneol=native#text/plain
 tests/test/cpu16/i8086/tmmc.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tmml.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tmmm.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tmms.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tmmt.pp svneol=native#text/pascal
+tests/test/cpu16/i8086/tprcdat1.pp svneol=native#text/plain
+tests/test/cpu16/i8086/tptrcon.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/tptrsize.pp svneol=native#text/pascal
+tests/test/cpu16/i8086/tretf1.pp svneol=native#text/plain
+tests/test/cpu16/i8086/tretf2.pp svneol=native#text/plain
+tests/test/cpu16/i8086/ttasm1.pp svneol=native#text/plain
 tests/test/cpu16/i8086/ttheap1.pp svneol=native#text/pascal
 tests/test/cpu16/taddint1.pp svneol=native#text/pascal
 tests/test/dumpclass.pp svneol=native#text/plain
@@ -11489,6 +11588,7 @@ tests/test/jvm/tnestproc.pp svneol=native#text/plain
 tests/test/jvm/topovl.pp svneol=native#text/plain
 tests/test/jvm/toverload.pp svneol=native#text/plain
 tests/test/jvm/toverload2.pp svneol=native#text/plain
+tests/test/jvm/tprocvaranon.pp svneol=native#text/plain
 tests/test/jvm/tprop.pp svneol=native#text/plain
 tests/test/jvm/tprop2.pp svneol=native#text/plain
 tests/test/jvm/tprop3.pp svneol=native#text/plain
@@ -11985,6 +12085,7 @@ tests/test/texception6.pp svneol=native#text/plain
 tests/test/texception7.pp svneol=native#text/plain
 tests/test/texception8.pp svneol=native#text/plain
 tests/test/texception9.pp svneol=native#text/plain
+tests/test/textpas01.pp svneol=native#text/pascal
 tests/test/textthr.pp svneol=native#text/plain
 tests/test/tfillchr.pp svneol=native#text/plain
 tests/test/tfinal1.pp svneol=native#text/pascal
@@ -12166,6 +12267,21 @@ tests/test/tgeneric96.pp svneol=native#text/pascal
 tests/test/tgeneric97.pp svneol=native#text/pascal
 tests/test/tgeneric98.pp svneol=native#text/pascal
 tests/test/tgeneric99.pp svneol=native#text/pascal
+tests/test/tgenfunc1.pp svneol=native#text/pascal
+tests/test/tgenfunc10.pp svneol=native#text/pascal
+tests/test/tgenfunc11.pp svneol=native#text/pascal
+tests/test/tgenfunc12.pp svneol=native#text/pascal
+tests/test/tgenfunc13.pp svneol=native#text/pascal
+tests/test/tgenfunc14.pp svneol=native#text/pascal
+tests/test/tgenfunc15.pp svneol=native#text/pascal
+tests/test/tgenfunc2.pp svneol=native#text/pascal
+tests/test/tgenfunc3.pp svneol=native#text/pascal
+tests/test/tgenfunc4.pp svneol=native#text/pascal
+tests/test/tgenfunc5.pp svneol=native#text/pascal
+tests/test/tgenfunc6.pp svneol=native#text/pascal
+tests/test/tgenfunc7.pp svneol=native#text/pascal
+tests/test/tgenfunc8.pp svneol=native#text/pascal
+tests/test/tgenfunc9.pp svneol=native#text/pascal
 tests/test/tgoto.pp svneol=native#text/plain
 tests/test/theap.pp svneol=native#text/plain
 tests/test/theapthread.pp svneol=native#text/plain
@@ -12254,6 +12370,7 @@ tests/test/tinterface3.pp svneol=native#text/plain
 tests/test/tinterface4.pp svneol=native#text/plain
 tests/test/tinterface5.pp svneol=native#text/plain
 tests/test/tinterface6.pp svneol=native#text/plain
+tests/test/tinterlockedmt.pp svneol=native#text/plain
 tests/test/tinterrupt.pp svneol=native#text/plain
 tests/test/tintfcdecl1.pp svneol=native#text/plain
 tests/test/tintfcdecl2.pp svneol=native#text/plain
@@ -12819,6 +12936,7 @@ tests/test/ugeneric96b.pp svneol=native#text/pascal
 tests/test/ugeneric96c.pp svneol=native#text/pascal
 tests/test/ugeneric96d.pp svneol=native#text/pascal
 tests/test/ugeneric99.pp svneol=native#text/pascal
+tests/test/ugenfunc7.pp svneol=native#text/pascal
 tests/test/uhintdir.pp svneol=native#text/plain
 tests/test/uhlp3.pp svneol=native#text/pascal
 tests/test/uhlp31.pp svneol=native#text/pascal
@@ -12878,6 +12996,7 @@ 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
 tests/test/units/crt/tctrlc.pp svneol=native#text/plain
+tests/test/units/dateutil/testscandatetime.pas svneol=native#text/plain
 tests/test/units/dos/hello.pp svneol=native#text/plain
 tests/test/units/dos/tbreak.pp svneol=native#text/plain
 tests/test/units/dos/tdisk.pp svneol=native#text/plain
@@ -14670,6 +14789,7 @@ tests/webtbs/tw2708.pp svneol=native#text/plain
 tests/webtbs/tw2710.pp svneol=native#text/plain
 tests/webtbs/tw27120.pp svneol=native#text/pascal
 tests/webtbs/tw2713.pp svneol=native#text/plain
+tests/webtbs/tw27149.pp svneol=native#text/plain
 tests/webtbs/tw27153.pp svneol=native#text/pascal
 tests/webtbs/tw27173.pp svneol=native#text/pascal
 tests/webtbs/tw27185.pp svneol=native#text/pascal
@@ -14691,6 +14811,7 @@ tests/webtbs/tw2736.pp svneol=native#text/plain
 tests/webtbs/tw2737.pp svneol=native#text/plain
 tests/webtbs/tw2738.pp svneol=native#text/plain
 tests/webtbs/tw2739.pp svneol=native#text/plain
+tests/webtbs/tw27414.pp svneol=native#text/plain
 tests/webtbs/tw27424.pp svneol=native#text/pascal
 tests/webtbs/tw27515.pp svneol=native#text/pascal
 tests/webtbs/tw27517.pp svneol=native#text/pascal
@@ -14751,41 +14872,72 @@ tests/webtbs/tw2853e.pp svneol=native#text/plain
 tests/webtbs/tw2859.pp svneol=native#text/plain
 tests/webtbs/tw28593.pp svneol=native#text/plain
 tests/webtbs/tw28632.pp -text svneol=native#text/plain
+tests/webtbs/tw28641.pp svneol=native#text/plain
 tests/webtbs/tw2865.pp svneol=native#text/plain
 tests/webtbs/tw28650.pp svneol=native#text/pascal
+tests/webtbs/tw28667.pp svneol=native#text/plain
+tests/webtbs/tw28668.pp svneol=native#text/plain
 tests/webtbs/tw28674.pp svneol=native#text/pascal
+tests/webtbs/tw28702.pp svneol=native#text/plain
+tests/webtbs/tw28713.pp svneol=native#text/pascal
+tests/webtbs/tw28713b.pp svneol=native#text/pascal
 tests/webtbs/tw28718a.pp svneol=native#text/plain
 tests/webtbs/tw28718b.pp svneol=native#text/plain
 tests/webtbs/tw28718c.pp svneol=native#text/plain
 tests/webtbs/tw28718d.pp svneol=native#text/plain
+tests/webtbs/tw28748.pp svneol=native#text/plain
 tests/webtbs/tw2876.pp svneol=native#text/plain
 tests/webtbs/tw28766.pp svneol=native#text/pascal
+tests/webtbs/tw28801.pp svneol=native#text/plain
 tests/webtbs/tw2883.pp svneol=native#text/plain
 tests/webtbs/tw2885.pp svneol=native#text/plain
+tests/webtbs/tw28850.pp svneol=native#text/plain
 tests/webtbs/tw2886.pp svneol=native#text/plain
 tests/webtbs/tw2891.pp svneol=native#text/plain
+tests/webtbs/tw28916.pp svneol=native#text/pascal
 tests/webtbs/tw2892.pp svneol=native#text/plain
+tests/webtbs/tw28934.pp svneol=native#text/plain
+tests/webtbs/tw28964.pp svneol=native#text/plain
 tests/webtbs/tw2897.pp svneol=native#text/plain
 tests/webtbs/tw2899.pp svneol=native#text/plain
+tests/webtbs/tw29010a.pp svneol=native#text/plain
+tests/webtbs/tw29010b.pp svneol=native#text/plain
+tests/webtbs/tw29010c.pp svneol=native#text/plain
+tests/webtbs/tw29030.pp svneol=native#text/plain
 tests/webtbs/tw2904.pp svneol=native#text/plain
+tests/webtbs/tw29040.pp svneol=native#text/plain
+tests/webtbs/tw29053.pp svneol=native#text/pascal
+tests/webtbs/tw29053b.pp svneol=native#text/pascal
+tests/webtbs/tw29064.pp svneol=native#text/plain
 tests/webtbs/tw2908.pp svneol=native#text/plain
+tests/webtbs/tw29086.pp -text svneol=native#text/plain
+tests/webtbs/tw29096.pp svneol=native#text/plain
 tests/webtbs/tw2911.pp svneol=native#text/plain
 tests/webtbs/tw2912.pp svneol=native#text/plain
 tests/webtbs/tw2913.pp svneol=native#text/plain
+tests/webtbs/tw29153.pp svneol=native#text/plain
 tests/webtbs/tw2916.pp svneol=native#text/plain
 tests/webtbs/tw2920.pp svneol=native#text/plain
 tests/webtbs/tw2923.pp svneol=native#text/plain
+tests/webtbs/tw29244.pp svneol=native#text/pascal
+tests/webtbs/tw29250.pp svneol=native#text/pascal
 tests/webtbs/tw2926.pp svneol=native#text/plain
 tests/webtbs/tw2927.pp svneol=native#text/plain
+tests/webtbs/tw29321.pp svneol=native#text/pascal
+tests/webtbs/tw29353.pp -text svneol=native#text/plain
+tests/webtbs/tw29372.pp svneol=native#text/pascal
 tests/webtbs/tw2942a.pp svneol=native#text/plain
 tests/webtbs/tw2942b.pp svneol=native#text/plain
 tests/webtbs/tw2943.pp svneol=native#text/plain
 tests/webtbs/tw2944.pp svneol=native#text/plain
 tests/webtbs/tw2946.pp svneol=native#text/plain
+tests/webtbs/tw29471.pp svneol=native#text/plain
 tests/webtbs/tw2949.pp svneol=native#text/plain
 tests/webtbs/tw2953.pp svneol=native#text/plain
+tests/webtbs/tw29546.pp svneol=native#text/pascal
 tests/webtbs/tw2956.pp svneol=native#text/plain
 tests/webtbs/tw2958.pp svneol=native#text/plain
+tests/webtbs/tw29609.pp svneol=native#text/pascal
 tests/webtbs/tw2966.pp svneol=native#text/plain
 tests/webtbs/tw2975.pp svneol=native#text/plain
 tests/webtbs/tw2976.pp svneol=native#text/plain
@@ -15471,6 +15623,7 @@ tests/webtbs/uw2738.pp svneol=native#text/plain
 tests/webtbs/uw2834.pp svneol=native#text/plain
 tests/webtbs/uw28442.pp svneol=native#text/pascal
 tests/webtbs/uw28766.pp svneol=native#text/pascal
+tests/webtbs/uw28964.pp svneol=native#text/plain
 tests/webtbs/uw2920.pp svneol=native#text/plain
 tests/webtbs/uw2956.pp svneol=native#text/plain
 tests/webtbs/uw2984.pp svneol=native#text/plain
@@ -15629,6 +15782,16 @@ utils/fpdoc/dw_txt.pp svneol=native#text/plain
 utils/fpdoc/dw_xml.pp svneol=native#text/plain
 utils/fpdoc/dwlinear.pp svneol=native#text/plain
 utils/fpdoc/dwriter.pp svneol=native#text/plain
+utils/fpdoc/examples/basedir/readme.txt svneol=native#text/plain
+utils/fpdoc/examples/basedir/sample-project.xml svneol=native#text/plain
+utils/fpdoc/examples/gentest.sh svneol=native#text/plain
+utils/fpdoc/examples/project/readme.txt svneol=native#text/plain
+utils/fpdoc/examples/project/sample-project.xml svneol=native#text/plain
+utils/fpdoc/examples/simple/html.bat svneol=native#text/plain
+utils/fpdoc/examples/simple/html.sh svneol=native#text/plain
+utils/fpdoc/examples/simple/readme.txt svneol=native#text/plain
+utils/fpdoc/examples/simple/testunit.pp svneol=native#text/plain
+utils/fpdoc/examples/simple/testunit.xml svneol=native#text/plain
 utils/fpdoc/fpclasschart.lpi svneol=native#text/plain
 utils/fpdoc/fpclasschart.pp svneol=native#text/plain
 utils/fpdoc/fpde/Makefile svneol=native#text/plain
@@ -15670,7 +15833,6 @@ utils/fpdoc/fpdocstripper.lpi svneol=native#text/plain
 utils/fpdoc/fpdocstripper.pp svneol=native#text/plain
 utils/fpdoc/fpdocxmlopts.pas svneol=native#text/plain
 utils/fpdoc/fpmake.pp svneol=native#text/plain
-utils/fpdoc/gentest.sh svneol=native#text/plain
 utils/fpdoc/images/minus.png -text svneol=unset#image/png
 utils/fpdoc/images/plus.png -text svneol=unset#image/png
 utils/fpdoc/intl/Makefile svneol=native#text/plain
@@ -15691,8 +15853,6 @@ utils/fpdoc/mkfpdocproj.pp svneol=native#text/plain
 utils/fpdoc/plusimage.inc svneol=native#text/plain
 utils/fpdoc/sample-project.xml svneol=native#text/plain
 utils/fpdoc/sh_pas.pp svneol=native#text/plain
-utils/fpdoc/testunit.pp svneol=native#text/plain
-utils/fpdoc/testunit.xml svneol=native#text/plain
 utils/fpdoc/unitdiff.pp svneol=native#text/plain
 utils/fpgmake/fpgmake.pp svneol=native#text/plain
 utils/fpgmake/fpmake.cft svneol=native#text/plain

Makefile

@@ -333,8 +333,7 @@ endif
 endif
 override PACKAGE_NAME=fpc
 override PACKAGE_VERSION=3.1.1
-REQUIREDVERSION=2.6.4
-REQUIREDVERSION2=3.0.0
+REQUIREDVERSION=3.0.0
 ifndef inOS2
 override FPCDIR:=$(BASEDIR)
 export FPCDIR

Makefile.fpc

@@ -20,11 +20,7 @@ fpcdir=.
 rule=help
 
 [prerules]
-REQUIREDVERSION=2.6.4
-# Accept 3.0.0, without requiring to using OVERRIDEVERSIONCHECK=1
-# 3.0.0 should become REQUIREDVERSION after 3.0.0 final release
-# and 2.6.4 should be moved to REQUIREDVERSION2
-REQUIREDVERSION2=3.0.0
+REQUIREDVERSION=3.0.0
 
 
 # make versions < 3.77 (OS2 version) are buggy

compiler/Makefile

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

compiler/Makefile.fpc

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

compiler/aarch64/cpupara.pas

@@ -318,7 +318,7 @@ unit cpupara;
                 hp.paraloc[side].size:=OS_ADDR;
                 hp.paraloc[side].alignment:=voidpointertype.alignment;
                 hp.paraloc[side].intsize:=voidpointertype.size;
-                hp.paraloc[side].def:=cpointerdef.getreusable(hp.vardef);
+                hp.paraloc[side].def:=cpointerdef.getreusable_no_free(hp.vardef);
                 with hp.paraloc[side].add_location^ do
                   begin
                     size:=OS_ADDR;
@@ -397,7 +397,7 @@ unit cpupara;
 
         if push_addr_param(varspez,paradef,p.proccalloption) then
           begin
-            paradef:=cpointerdef.getreusable(paradef);
+            paradef:=cpointerdef.getreusable_no_free(paradef);
             loc:=LOC_REGISTER;
             paracgsize:=OS_ADDR;
             paralen:=tcgsize2size[OS_ADDR];

compiler/aasmbase.pas

@@ -151,6 +151,8 @@ interface
          sec_heap
        );
 
+       TObjCAsmSectionType = sec_objc_class..sec_objc_protolist;
+
        TAsmSectionOrder = (secorder_begin,secorder_default,secorder_end);
 
        TAsmSymbol = class(TFPHashObject)

compiler/aasmcnst.pas

@@ -29,7 +29,7 @@ interface
 uses
   cclasses,globtype,constexp,
   aasmbase,aasmdata,aasmtai,
-  symconst,symtype,symdef,symsym;
+  symconst,symbase,symtype,symdef,symsym;
 
 type
    { typed const: integer/floating point/string/pointer/... const along with
@@ -93,6 +93,9 @@ type
      function valuecount: longint;
      procedure insertvaluebeforepos(val: tai_abstracttypedconst; pos: longint);
      function replacevalueatpos(val: tai_abstracttypedconst; pos: longint): tai_abstracttypedconst;
+     { change the type to a record, regardless of how the aggregate was created;
+       the size of the original type and the record must match }
+     procedure changetorecord(_def: trecorddef);
      procedure finish;
      destructor destroy; override;
    end;
@@ -115,7 +118,17 @@ type
        not necessarily (depends on what the platform requirements are) }
      tcalo_make_dead_strippable,
      { this symbol should never be removed by the linker }
-     tcalo_no_dead_strip
+     tcalo_no_dead_strip,
+     { start of a vectorized but individually dead strippable list of elements,
+       like the resource strings of a unit: they have to stay in this order,
+       but individual elements can be removed }
+     tcalo_vectorized_dead_strip_start,
+     { item in the above list }
+     tcalo_vectorized_dead_strip_item,
+     { end of the above list }
+     tcalo_vectorized_dead_strip_end,
+     { symbol should be weakle defined }
+     tcalo_weak
    );
    ttcasmlistoptions = set of ttcasmlistoption;
 
@@ -125,7 +138,6 @@ type
     private
      fnextfieldname: TIDString;
      function getcuroffset: asizeint;
-     function getfieldoffset(l: longint): asizeint;
      procedure setnextfieldname(AValue: TIDString);
     protected
      { type of the aggregate }
@@ -165,7 +177,6 @@ type
      property curfield: tfieldvarsym read fcurfield write fcurfield;
      property nextfield: tfieldvarsym read fnextfield write fnextfield;
      property nextfieldname: TIDString write setnextfieldname;
-     property fieldoffset[l: longint]: asizeint read getfieldoffset;
      property curoffset: asizeint read getcuroffset;
      property anonrecord: boolean read fanonrecord write fanonrecord;
    end;
@@ -176,6 +187,7 @@ type
    ttypedconstplaceholder = class abstract
      def: tdef;
      constructor create(d: tdef);
+     { same usage as ttai_typedconstbuilder.emit_tai }
      procedure replace(ai: tai; d: tdef); virtual; abstract;
    end;
 
@@ -231,12 +243,17 @@ type
 
      { ensure that finalize_asmlist is called only once }
      fasmlist_finalized: boolean;
+     { ensure that if it's vectorized dead strippable data, we called
+       finalize_vectorized_dead_strip_asmlist instead of finalize_asmlist }
+     fvectorized_finalize_called: boolean;
 
      { returns whether def must be handled as an aggregate on the current
        platform }
      function aggregate_kind(def: tdef): ttypedconstkind; virtual;
      { finalize the asmlist: add the necessary symbols etc }
      procedure finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions); virtual;
+     { functionality of the above for vectorized dead strippable sections }
+     procedure finalize_vectorized_dead_strip_asmlist(def: tdef; const basename, itemname: TSymStr; st: tsymtable; alignment: shortint; options: ttcasmlistoptions); virtual;
 
      { called by the public emit_tai() routines to actually add the typed
        constant data; the public ones also take care of adding extra padding
@@ -287,6 +304,7 @@ type
     protected
      procedure maybe_emit_tail_padding(def: tdef); virtual;
      function emit_string_const_common(stringtype: tstringtype; len: asizeint; encoding: tstringencoding; var startlab: tasmlabel):tasmlabofs;
+     function get_dynstring_def_for_type(stringtype: tstringtype; winlikewidestring: boolean): tstringdef;
      procedure begin_aggregate_internal(def: tdef; anonymous: boolean); virtual;
      procedure end_aggregate_internal(def: tdef; anonymous: boolean); virtual;
      { when building an anonymous record, we cannot immediately insert the
@@ -295,7 +313,14 @@ type
        the anonymous record, and insert the alignment once it's finished }
      procedure mark_anon_aggregate_alignment; virtual; abstract;
      procedure insert_marked_aggregate_alignment(def: tdef); virtual; abstract;
+     class function get_vectorized_dead_strip_section_symbol(const basename: string; st: tsymtable; define, start: boolean): tasmsymbol; virtual;
     public
+     class function get_vectorized_dead_strip_custom_section_name(const basename: TSymStr; st: tsymtable; out secname: TSymStr): boolean; virtual;
+     { get the start/end symbol for a dead stripable vectorized section, such
+       as the resourcestring data of a unit }
+     class function get_vectorized_dead_strip_section_symbol_start(const basename: string; st: tsymtable; define: boolean): tasmsymbol; virtual;
+     class function get_vectorized_dead_strip_section_symbol_end(const basename: string; st: tsymtable; define: boolean): tasmsymbol; virtual;
+
      class function get_dynstring_rec_name(typ: tstringtype; winlike: boolean; len: asizeint): string;
      { the datalist parameter specifies where the data for the string constant
        will be emitted (via an internal data builder) }
@@ -306,6 +331,8 @@ type
 
      { emit a shortstring constant, and return its def }
      function emit_shortstring_const(const str: shortstring): tdef;
+     { emit a pchar string constant (the characters, not a pointer to them), and return its def }
+     function emit_pchar_const(str: pchar; len: pint): tdef;
      { emit a guid constant }
      procedure emit_guid_const(const guid: tguid);
      { emit a procdef constant }
@@ -344,10 +371,11 @@ type
        useful in case you have table preceded by the number of elements, and
        you cound the elements while building the table }
      function emit_placeholder(def: tdef): ttypedconstplaceholder; virtual; abstract;
+    protected
      { common code to check whether a placeholder can be added at the current
        position }
      procedure check_add_placeholder(def: tdef);
-
+    public
      { The next group of routines are for constructing complex expressions.
        While parsing a typed constant these operators are encountered from
        outer to inner, so that is also the order in which they should be
@@ -389,6 +417,7 @@ type
        contents to another list first. This property should only be accessed
        once all data has been added. }
      function get_final_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: longint): tasmlist;
+     function get_final_asmlist_vectorized_dead_strip(def: tdef; const basename, itemname: TSymStr; st: TSymtable; alignment: longint): tasmlist;
 
      { returns the offset of the string data relative to ansi/unicode/widestring
        constant labels. On most platforms, this is 0 (with the header at a
@@ -402,7 +431,7 @@ type
        over the symtables of the entire inheritance tree }
      property next_field: tfieldvarsym write set_next_field;
      { set the name of the next field that will be emitted for an anonymous
-       record (or the next of the next started anonymous record) }
+       record (also if that field is a nested anonymous record) }
      property next_field_name: TIDString write set_next_field_name;
     protected
      { this one always return the actual offset, called by the above (and
@@ -429,6 +458,7 @@ type
     protected
      procedure mark_anon_aggregate_alignment; override;
      procedure insert_marked_aggregate_alignment(def: tdef); override;
+     procedure finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions); override;
     public
      { set the default value for caggregateinformation (= tlowlevelaggregateinformation) }
      class constructor classcreate;
@@ -443,7 +473,7 @@ implementation
    uses
      verbose,globals,systems,widestr,
      fmodule,
-     symbase,symtable,defutil;
+     symtable,defutil;
 
 {****************************************************************************
                        taggregateinformation
@@ -465,15 +495,6 @@ implementation
       end;
 
 
-    function taggregateinformation.getfieldoffset(l: longint): asizeint;
-      var
-        field: tfieldvarsym;
-      begin
-        field:=tfieldvarsym(tabstractrecorddef(def).symtable.symlist[l]);
-        result:=field.fieldoffset;
-      end;
-
-
     procedure taggregateinformation.setnextfieldname(AValue: TIDString);
       begin
         if (fnextfieldname<>'') or
@@ -494,6 +515,7 @@ implementation
 
     function taggregateinformation.prepare_next_field(nextfielddef: tdef): asizeint;
       var
+        sym: tsym;
         currentoffset,nextoffset: asizeint;
         i: longint;
       begin
@@ -522,14 +544,16 @@ implementation
               end
             else if fnextfieldname<>'' then
               internalerror(2015071501);
+            currentoffset:=curoffset;
             { find next field }
             i:=curindex;
             repeat
               inc(i);
-            until (tsym(tabstractrecorddef(def).symtable.symlist[i]).typ=fieldvarsym) and
-              not(sp_static in tsym(tabstractrecorddef(def).symtable.symlist[i]).symoptions);
-            nextoffset:=fieldoffset[i];
-            currentoffset:=curoffset;
+              sym:=tsym(tabstractrecorddef(def).symtable.symlist[i]);
+            until (sym.typ=fieldvarsym) and
+              not(sp_static in sym.symoptions);
+            curfield:=tfieldvarsym(sym);
+            nextoffset:=curfield.fieldoffset;
             curindex:=i;
           end;
         { need padding? }
@@ -730,6 +754,17 @@ implementation
      end;
 
 
+   procedure tai_aggregatetypedconst.changetorecord(_def: trecorddef);
+     begin
+       { must be a record of the same size as the current data }
+       if assigned(fdef) and
+          (fdef.size<>_def.size) then
+         internalerror(2015122402);
+       fdef:=_def;
+       fadetyp:=tck_record;
+     end;
+
+
    procedure tai_aggregatetypedconst.finish;
      begin
        if fisstring then
@@ -864,6 +899,14 @@ implementation
           { in case of syntax errors, the aggregate may not have been finished }
           (ErrorCount=0) then
          internalerror(2015072301);
+
+       { must call finalize_vectorized_dead_strip_asmlist() instead }
+       if (([tcalo_vectorized_dead_strip_start,
+             tcalo_vectorized_dead_strip_item,
+             tcalo_vectorized_dead_strip_end]*options)<>[]) and
+          not fvectorized_finalize_called then
+         internalerror(2015110602);
+
        prelist:=tasmlist.create;
        { only now add items based on the symbolname, because it may be
          modified by the "section" specifier in case of a typed constant }
@@ -896,12 +939,15 @@ implementation
          end;
 
        if not(tcalo_is_lab in options) then
-         if sym.bind=AB_GLOBAL then
-           prelist.concat(tai_symbol.Create_Global(sym,0))
-         else
+         if sym.bind=AB_LOCAL then
            prelist.concat(tai_symbol.Create(sym,0))
+         else
+           prelist.concat(tai_symbol.Create_Global(sym,0))
        else
          prelist.concat(tai_label.Create(tasmlabel(sym)));
+
+       if tcalo_weak in options then
+         prelist.concat(tai_directive.Create(asd_weak_definition,sym.name));
        { insert the symbol information before the data }
        fasmlist.insertlist(prelist);
        { end of the symbol }
@@ -911,6 +957,49 @@ implementation
      end;
 
 
+   procedure ttai_typedconstbuilder.finalize_vectorized_dead_strip_asmlist(def: tdef; const basename, itemname: TSymStr; st: tsymtable; alignment: shortint; options: ttcasmlistoptions);
+     var
+       sym: tasmsymbol;
+       secname: TSymStr;
+       sectype: TAsmSectiontype;
+       customsecname: boolean;
+     begin
+       fvectorized_finalize_called:=true;
+       sym:=nil;
+       customsecname:=get_vectorized_dead_strip_custom_section_name(basename,st,secname);
+       if customsecname then
+         sectype:=sec_user
+       else
+         sectype:=sec_data;
+       if tcalo_vectorized_dead_strip_start in options then
+         begin
+           { the start and end names are predefined }
+           if itemname<>'' then
+             internalerror(2015110801);
+           sym:=get_vectorized_dead_strip_section_symbol_start(basename,st,true);
+           if not customsecname then
+             secname:=make_mangledname(basename,st,'1_START');
+         end
+       else if tcalo_vectorized_dead_strip_end in options then
+         begin
+           { the start and end names are predefined }
+           if itemname<>'' then
+             internalerror(2015110802);
+           sym:=get_vectorized_dead_strip_section_symbol_end(basename,st,true);
+           if not customsecname then
+             secname:=make_mangledname(basename,st,'3_END');
+         end
+       else if tcalo_vectorized_dead_strip_item in options then
+         begin
+           sym:=current_asmdata.DefineAsmSymbol(make_mangledname(basename,st,itemname),AB_GLOBAL,AT_DATA);
+           if not customsecname then
+             secname:=make_mangledname(basename,st,'2_'+itemname);
+           exclude(options,tcalo_vectorized_dead_strip_item);
+         end;
+       finalize_asmlist(sym,def,sectype,secname,alignment,options);
+     end;
+
+
    procedure ttai_typedconstbuilder.do_emit_tai(p: tai; def: tdef);
      begin
        { by default we don't care about the type }
@@ -929,6 +1018,17 @@ implementation
      end;
 
 
+   function ttai_typedconstbuilder.get_final_asmlist_vectorized_dead_strip(def: tdef; const basename, itemname: TSymStr; st: TSymtable; alignment: longint): tasmlist;
+     begin
+       if not fasmlist_finalized then
+         begin
+           finalize_vectorized_dead_strip_asmlist(def,basename,itemname,st,alignment,foptions);
+           fasmlist_finalized:=true;
+         end;
+       result:=fasmlist;
+     end;
+
+
    class function ttai_typedconstbuilder.get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint;
      begin
        { darwin's linker does not support negative offsets }
@@ -1202,6 +1302,21 @@ implementation
      end;
 
 
+   function ttai_typedconstbuilder.get_dynstring_def_for_type(stringtype: tstringtype; winlikewidestring: boolean): tstringdef;
+     begin
+       if stringtype=st_ansistring then
+         result:=tstringdef(cansistringtype)
+       else if (stringtype=st_unicodestring) or
+               ((stringtype=st_widestring) and
+                not winlikewidestring) then
+         result:=tstringdef(cunicodestringtype)
+       else if stringtype=st_widestring then
+         result:=tstringdef(cwidestringtype)
+       else
+         internalerror(2015122101);
+     end;
+
+
    procedure ttai_typedconstbuilder.begin_aggregate_internal(def: tdef; anonymous: boolean);
      var
        info: taggregateinformation;
@@ -1256,6 +1371,39 @@ implementation
      end;
 
 
+   class function ttai_typedconstbuilder.get_vectorized_dead_strip_section_symbol(const basename: string; st: tsymtable; define, start: boolean): tasmsymbol;
+     var
+       name: TSymStr;
+     begin
+       if start then
+         name:=make_mangledname(basename,st,'START')
+       else
+         name:=make_mangledname(basename,st,'END');
+       if define then
+         result:=current_asmdata.DefineAsmSymbol(name,AB_GLOBAL,AT_DATA)
+       else
+         result:=current_asmdata.RefAsmSymbol(name,AT_DATA)
+     end;
+
+
+   class function ttai_typedconstbuilder.get_vectorized_dead_strip_custom_section_name(const basename: TSymStr; st: tsymtable; out secname: TSymStr): boolean;
+     begin
+       result:=false;
+     end;
+
+
+   class function ttai_typedconstbuilder.get_vectorized_dead_strip_section_symbol_start(const basename: string; st: tsymtable; define: boolean): tasmsymbol;
+     begin
+       result:=get_vectorized_dead_strip_section_symbol(basename,st,define,true);
+     end;
+
+
+   class function ttai_typedconstbuilder.get_vectorized_dead_strip_section_symbol_end(const basename: string; st: tsymtable; define: boolean): tasmsymbol;
+     begin
+       result:=get_vectorized_dead_strip_section_symbol(basename,st,define,false);
+     end;
+
+
    class function ttai_typedconstbuilder.get_dynstring_rec_name(typ: tstringtype; winlike: boolean; len: asizeint): string;
      begin
        case typ of
@@ -1306,6 +1454,7 @@ implementation
        startlab: tasmlabel;
        datadef: tdef;
        datatcb: ttai_typedconstbuilder;
+       unicodestrrecdef: trecorddef;
      begin
        start_internal_data_builder(datalist,sec_rodata_norel,'',datatcb,startlab);
        strlength:=getlengthwidestring(pcompilerwidestring(data));
@@ -1345,18 +1494,18 @@ implementation
            { ending #0 }
            datatcb.emit_tai(Tai_const.Create_16bit(0),cwidechartype);
            datatcb.maybe_end_aggregate(datadef);
-           datatcb.end_anonymous_record;
+           unicodestrrecdef:=datatcb.end_anonymous_record;
          end
        else
          { code generation for other sizes must be written }
          internalerror(200904271);
-       finish_internal_data_builder(datatcb,startlab,datadef,const_align(sizeof(pint)));
+       finish_internal_data_builder(datatcb,startlab,unicodestrrecdef,const_align(sizeof(pint)));
      end;
 
 
    procedure ttai_typedconstbuilder.emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);
      begin
-       emit_tai(Tai_const.Create_sym_offset(ll.lab,ll.ofs),charptrdef);
+       emit_tai(Tai_const.Create_sym_offset(ll.lab,ll.ofs),get_dynstring_def_for_type(st,winlikewidestring));
      end;
 
 
@@ -1375,6 +1524,18 @@ implementation
      end;
 
 
+   function ttai_typedconstbuilder.emit_pchar_const(str: pchar; len: pint): tdef;
+     begin
+       result:=carraydef.getreusable(cansichartype,len+1);
+       maybe_begin_aggregate(result);
+       if len=0 then
+         emit_tai(Tai_const.Create_8bit(0),cansichartype)
+       else
+         emit_tai(Tai_string.Create_pchar(str,len+1),result);
+       maybe_end_aggregate(result);
+     end;
+
+
    procedure ttai_typedconstbuilder.emit_guid_const(const guid: tguid);
      var
        i: longint;
@@ -1639,6 +1800,8 @@ implementation
 
 
    procedure ttai_typedconstbuilder.queue_emit_const(cs: tconstsym);
+     var
+       resourcestrrec: trecorddef;
      begin
        if cs.consttyp<>constresourcestring then
          internalerror(2014062102);
@@ -1647,7 +1810,13 @@ implementation
        { warning: update if/when the type of resource strings changes }
        case cs.consttyp of
          constresourcestring:
-           emit_tai(Tai_const.Createname(make_mangledname('RESSTR',cs.owner,cs.name),AT_DATA,sizeof(pint)),cpointerdef.getreusable(cansistringtype));
+           begin
+             resourcestrrec:=trecorddef(search_system_type('TRESOURCESTRINGRECORD').typedef);
+             queue_subscriptn_multiple_by_name(resourcestrrec,['CURRENTVALUE']);
+             queue_emit_asmsym(current_asmdata.RefAsmSymbol(
+               make_mangledname('RESSTR',cs.owner,cs.name),AT_DATA),resourcestrrec
+             );
+           end;
          { can these occur? }
          constord,
          conststring,constreal,
@@ -1756,6 +1925,23 @@ implementation
        info.anonrecmarker:=nil;
      end;
 
+   procedure ttai_lowleveltypedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions);
+     begin
+       inherited;
+       { The darwin/ppc64 assembler or linker seems to have trouble       }
+       { if a section ends with a global label without any data after it. }
+       { So for safety, just put a dummy value here.                      }
+       { Further, the regular linker also kills this symbol when turning  }
+       { on smart linking in case no value appears after it, so put the   }
+       { dummy byte there always                                          }
+       { Update: the Mac OS X 10.6 linker orders data that needs to be    }
+       { relocated before all other data, so make this data relocatable,  }
+       { otherwise the end label won't be moved with the rest             }
+       if (tcalo_vectorized_dead_strip_end in options) and
+          (target_info.system in (systems_darwin+systems_aix)) then
+         fasmlist.concat(Tai_const.create_sym(sym));
+     end;
+
 
 
 begin

compiler/aasmtai.pas

@@ -69,11 +69,7 @@ interface
           ait_stab,
           ait_force_line,
           ait_function_name,
-{$ifdef m68k}
-          ait_labeled_instruction,
-{$endif m68k}
           ait_symbolpair,
-          ait_weak,
           { used to split into tiny assembler files }
           ait_cutobject,
           ait_regalloc,
@@ -135,6 +131,17 @@ interface
           aitconst_farptr,
           { i8086 segment of symbol; emits: 'DW SEG symbol' }
           aitconst_seg,
+          { i8086 data segment group; emits: 'DW dgroup'
+            generated by the this inline asm:
+              DW SEG @DATA
+            in all memory models, except huge }
+          aitconst_dgroup,
+          { i8086 far data segment of the current pascal module (unit or program);
+            emits: 'DW CURRENTMODULENAME_DATA'
+            generated by the this inline asm:
+              DW SEG @DATA
+            in the huge memory model }
+          aitconst_fardataseg,
           { offset of symbol's GOT slot in GOT }
           aitconst_got,
           { offset of symbol itself from GOT }
@@ -189,11 +196,7 @@ interface
           'stab',
           'force_line',
           'function_name',
-{$ifdef m68k}
-          'labeled_instr',
-{$endif m68k}
           'symbolpair',
-          'weak',
           'cut',
           'regalloc',
           'tempalloc',
@@ -287,7 +290,7 @@ interface
                      ait_stab,ait_function_name,
                      ait_cutobject,ait_marker,ait_varloc,ait_align,ait_section,ait_comment,
                      ait_const,ait_directive,
-                     ait_symbolpair,ait_weak,
+                     ait_symbolpair,
                      ait_realconst,
                      ait_symbol,
 {$ifdef JVM}
@@ -336,8 +339,8 @@ interface
         asd_ent,asd_ent_end,
         { supported by recent clang-based assemblers for data-in-code  }
         asd_data_region, asd_end_data_region,
-        { .thumb_func for ARM }
-        asd_thumb_func
+        { ARM }
+        asd_thumb_func,asd_code
       );
 
       TAsmSehDirective=(
@@ -364,15 +367,16 @@ interface
       directivestr : array[TAsmDirective] of string[23]=(
         'indirect_symbol',
         'extern','nasm_import', 'tc', 'reference',
-        'no_dead_strip','weak_reference','lazy_reference','weak_definition',
+        'no_dead_strip','weak','lazy_reference','weak',
         { for Jasmin }
         'class','interface','super','field','limit','line',
         { .ent/.end for MIPS }
         'ent','end',
         { supported by recent clang-based assemblers for data-in-code }
         'data_region','end_data_region',
-        { .thumb_func for ARM }
-        'thumb_func'
+        { ARM }
+        'thumb_func',
+        'code'
       );
       sehdirectivestr : array[TAsmSehDirective] of string[16]=(
         '.seh_proc','.seh_endproc',
@@ -620,6 +624,8 @@ interface
           constructor Create_int_dataptr(_value: int64);
 {$ifdef i8086}
           constructor Create_seg_name(const name:string);
+          constructor Create_dgroup;
+          constructor Create_fardataseg;
 {$endif i8086}
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -885,14 +891,6 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
         end;
 
-        tai_weak = class(tai)
-          sym: pshortstring;
-          constructor create(const asym: string);
-          destructor destroy;override;
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-        end;
-
     var
       { array with all class types for tais }
       aiclass : taiclassarray;
@@ -1005,31 +1003,6 @@ implementation
       end;
 
 
-    constructor tai_weak.create(const asym: string);
-      begin
-        inherited create;
-        typ:=ait_weak;
-        sym:=stringdup(asym);
-      end;
-
-    destructor tai_weak.destroy;
-      begin
-        stringdispose(sym);
-        inherited destroy;
-      end;
-
-    constructor tai_weak.ppuload(t: taitype; ppufile: tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        sym:=stringdup(ppufile.getstring);
-      end;
-
-    procedure tai_weak.ppuwrite(ppufile: tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putstring(sym^);
-      end;
-
     constructor tai_symbolpair.create(akind: TSymbolPairKind; const asym, avalue: string);
       begin
         inherited create;
@@ -1817,6 +1790,20 @@ implementation
         self.Createname(name,0);
         self.consttype:=aitconst_seg;
       end;
+
+
+    constructor tai_const.Create_dgroup;
+      begin
+        self.Create_16bit(0);
+        self.consttype:=aitconst_dgroup;
+      end;
+
+
+    constructor tai_const.Create_fardataseg;
+      begin
+        self.Create_16bit(0);
+        self.consttype:=aitconst_fardataseg;
+      end;
 {$endif i8086}
 
 
@@ -1884,6 +1871,8 @@ implementation
             result:=2;
           aitconst_farptr:
             result:=4;
+          aitconst_dgroup,
+          aitconst_fardataseg,
           aitconst_seg:
             result:=2;
           aitconst_got:

compiler/aggas.pas

@@ -52,7 +52,7 @@ interface
         procedure WriteExtraHeader;virtual;
         procedure WriteExtraFooter;virtual;
         procedure WriteInstruction(hp: tai);
-        procedure WriteWeakSymbolDef(s: tasmsymbol); virtual;
+        procedure WriteWeakSymbolRef(s: tasmsymbol); virtual;
         procedure WriteAixStringConst(hp: tai_string);
         procedure WriteAixIntConst(hp: tai_const);
         procedure WriteUnalignedIntConst(hp: tai_const);
@@ -91,8 +91,8 @@ interface
       TAppleGNUAssembler=class(TGNUAssembler)
        protected
         function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
-        procedure WriteWeakSymbolDef(s: tasmsymbol); override;
-
+        procedure WriteWeakSymbolRef(s: tasmsymbol); override;
+        procedure WriteDirectiveName(dir: TAsmDirective); override;
        end;
 
 
@@ -113,7 +113,7 @@ implementation
 {$ifdef m68k}
       cpuinfo,aasmcpu,
 {$endif m68k}
-      cpubase;
+      cpubase,objcasm;
 
     const
       line_length = 70;
@@ -133,6 +133,13 @@ implementation
         #9'.short'#9,#9'.long'#9,#9'.quad'#9
       );
 
+      ait_solaris_const2str : array[aitconst_128bit..aitconst_64bit_unaligned] of string[20]=(
+        #9'.fixme128'#9,#9'.8byte'#9,#9'.4byte'#9,#9'.2byte'#9,#9'.byte'#9,
+        #9'.sleb128'#9,#9'.uleb128'#9,
+        #9'.rva'#9,#9'.secrel32'#9,#9'.8byte'#9,#9'.4byte'#9,#9'.2byte'#9,#9'.2byte'#9,
+        #9'.2byte'#9,#9'.4byte'#9,#9'.8byte'#9
+      );
+
       ait_unaligned_consts = [aitconst_16bit_unaligned..aitconst_64bit_unaligned];
 
       { Sparc type of unaligned pseudo-instructions }
@@ -453,7 +460,7 @@ implementation
          system_powerpc_aix,
          system_powerpc64_aix:
            begin
-             if (atype in [sec_stub,sec_objc_data,sec_objc_const,sec_data_coalesced]) then
+             if (atype in [sec_stub]) then
                writer.AsmWrite('.section ');
            end
          else
@@ -595,7 +602,7 @@ implementation
                     writer.AsmWrite(','+tostr(fillop))
 {$ifdef x86}
                   { force NOP as alignment op code }
-                  else if LastSecType=sec_code then
+                  else if (LastSecType=sec_code) and (asminfo^.id<>as_solaris_as) then
                     writer.AsmWrite(',0x90');
 {$endif x86}
 {$ifdef m68k}
@@ -886,7 +893,7 @@ implementation
                        cpu_i386:
                          begin
                            writer.AsmWrite(ait_const2str[aitconst_32bit]);
-                           writer.AsmWrite(tai_const(hp).sym.name);
+                           writer.AsmWrite(tai_const(hp).sym.name+'-_GLOBAL_OFFSET_TABLE_');
                          end;
                      else
                        InternalError(2014022602);
@@ -951,6 +958,8 @@ implementation
                            unaligned tai -> always use vbyte }
                          else if target_info.system in systems_aix then
                             writer.AsmWrite(#9'.vbyte'#9+tostr(tai_const(hp).size)+',')
+                         else if (asminfo^.id=as_solaris_as) then
+                           writer.AsmWrite(ait_solaris_const2str[constdef])
                          else
                            writer.AsmWrite(ait_const2str[constdef]);
                          l:=0;
@@ -1197,13 +1206,6 @@ implementation
                    writer.AsmWriteLn(tai_symbolpair(hp).value^);
                  end;
              end;
-           ait_weak:
-             begin
-               if replaceforbidden then
-                 writer.AsmWriteLn(#9'.weak '+ReplaceForbiddenAsmSymbolChars(tai_weak(hp).sym^))
-               else
-                 writer.AsmWriteLn(#9'.weak '+tai_weak(hp).sym^);
-             end;
            ait_symbol_end :
              begin
                if tf_needs_symbol_size in target_info.flags then
@@ -1369,7 +1371,7 @@ implementation
       end;
 
 
-    procedure TGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
+    procedure TGNUAssembler.WriteWeakSymbolRef(s: tasmsymbol);
       begin
         writer.AsmWriteLn(#9'.weak '+s.name);
       end;
@@ -1563,7 +1565,7 @@ implementation
       { add weak symbol markers }
       for i:=0 to current_asmdata.asmsymboldict.count-1 do
         if (tasmsymbol(current_asmdata.asmsymboldict[i]).bind=AB_WEAK_EXTERNAL) then
-          writeweaksymboldef(tasmsymbol(current_asmdata.asmsymboldict[i]));
+          WriteWeakSymbolRef(tasmsymbol(current_asmdata.asmsymboldict[i]));
 
       if create_smartlink_sections and
          (target_info.system in systems_darwin) then
@@ -1594,6 +1596,11 @@ implementation
       begin
         if (target_info.system in systems_darwin) then
           case atype of
+            sec_user:
+              begin
+                result:='.section '+aname;
+                exit;
+              end;
             sec_bss:
               { all bss (lcomm) symbols are automatically put in the right }
               { place by using the lcomm assembler directive               }
@@ -1664,139 +1671,33 @@ implementation
                 result:='.section __DATA, __mod_term_func, mod_term_funcs';
                 exit;
               end;
-            sec_objc_protocol_ext:
-              begin
-                result:='.section __OBJC, __protocol_ext, regular, no_dead_strip';
-                exit;
-              end;
-            sec_objc_class_ext:
-              begin
-                result:='.section __OBJC, __class_ext, regular, no_dead_strip';
-                exit;
-              end;
-            sec_objc_property:
-              begin
-                result:='.section __OBJC, __property, regular, no_dead_strip';
-                exit;
-              end;
-            sec_objc_image_info:
+            low(TObjCAsmSectionType)..high(TObjCAsmSectionType):
               begin
-                if (target_info.system in systems_objc_nfabi) then
-                  result:='.section __DATA,__objc_imageinfo,regular,no_dead_strip'
-                else
-                  result:='.section __OBJC, __image_info, regular, no_dead_strip';
-                exit;
-              end;
-            sec_objc_cstring_object:
-              begin
-                result:='.section __OBJC, __cstring_object, regular, no_dead_strip';
-                exit;
-              end;
-            sec_objc_sel_fixup:
-              begin
-                result:='.section __OBJC, __sel_fixup, regular, no_dead_strip';
-                exit;
-              end;
-            sec_objc_message_refs:
-              begin
-                if (target_info.system in systems_objc_nfabi) then
-                  begin
-                    result:='.section __DATA, __objc_selrefs, literal_pointers, no_dead_strip';
-                    exit;
-                  end;
-              end;
-            sec_objc_cls_refs:
-              begin
-                if (target_info.system in systems_objc_nfabi) then
-                  begin
-                    result:='.section __DATA, __objc_clsrefs, regular, no_dead_strip';
-                    exit;
-                  end;
-              end;
-            sec_objc_meth_var_types:
-              begin
-                if (target_info.system in systems_objc_nfabi) then
-                  begin
-                    result:='.section __TEXT,__objc_methtype,cstring_literals';
-                    exit
-                  end;
-              end;
-            sec_objc_meth_var_names:
-              begin
-                if (target_info.system in systems_objc_nfabi) then
-                  begin
-                    result:='.section __TEXT,__objc_methname,cstring_literals';
-                    exit
-                  end;
-              end;
-            sec_objc_class_names:
-              begin
-                if (target_info.system in systems_objc_nfabi) then
-                  begin
-                    result:='.section __TEXT,__objc_classname,cstring_literals';
-                    exit
-                  end;
-              end;
-            sec_objc_inst_meth,
-            sec_objc_cls_meth,
-            sec_objc_cat_inst_meth,
-            sec_objc_cat_cls_meth:
-              begin
-                if (target_info.system in systems_objc_nfabi) then
-                  begin
-                    result:='.section __DATA, __objc_const';
-                    exit;
-                  end;
-              end;
-            sec_objc_meta_class,
-            sec_objc_class:
-              begin
-                if (target_info.system in systems_objc_nfabi) then
-                  begin
-                    result:='.section __DATA, __objc_data';
-                    exit;
-                  end;
-              end;
-            sec_objc_sup_refs:
-              begin
-                result:='.section __DATA, __objc_superrefs, regular, no_dead_strip';
+                result:='.section '+objc_section_name(atype);
                 exit
               end;
-            sec_objc_classlist:
-              begin
-                result:='.section __DATA, __objc_classlist, regular, no_dead_strip';
-                exit
-              end;
-            sec_objc_nlclasslist:
-              begin
-                result:='.section __DATA, __objc_nlclasslist, regular, no_dead_strip';
-                exit
-              end;
-            sec_objc_catlist:
-              begin
-                result:='.section __DATA, __objc_catlist, regular, no_dead_strip';
-                exit
-              end;
-            sec_objc_nlcatlist:
-              begin
-                result:='.section __DATA, __objc_nlcatlist, regular, no_dead_strip';
-                exit
-              end;
-            sec_objc_protolist:
-              begin
-                result:='.section __DATA, __objc_protolist, coalesced, no_dead_strip';
-                exit;
-              end;
           end;
         result := inherited sectionname(atype,aname,aorder);
       end;
 
 
-    procedure TAppleGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
+    procedure TAppleGNUAssembler.WriteWeakSymbolRef(s: tasmsymbol);
       begin
         writer.AsmWriteLn(#9'.weak_reference '+s.name);
       end;
 
+    procedure TAppleGNUAssembler.WriteDirectiveName(dir: TAsmDirective);
+      begin
+        case dir of
+          asd_weak_reference:
+            writer.AsmWrite('.weak_reference ');
+          asd_weak_definition:
+            writer.AsmWrite('.weak_definition ');
+          else
+            inherited;
+        end;
+      end;
+
 
 {****************************************************************************}
 {                       a.out/GNU Assembler writer                           }

compiler/aoptbase.pas

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

compiler/aoptobj.pas

@@ -315,6 +315,10 @@ Unit AoptObj;
         { reg used after p? }
         function RegUsedAfterInstruction(reg: Tregister; p: tai; var AllUsedRegs: TAllUsedRegs): Boolean;
 
+        { returns true if reg reaches it's end of life at p, this means it is either
+          reloaded with a new value or it is deallocated afterwards }
+        function RegEndOfLife(reg: TRegister;p: taicpu): boolean;
+
        { traces sucessive jumps to their final destination and sets it, e.g.
          je l1                je l3
          <code>               <code>
@@ -1117,15 +1121,25 @@ Unit AoptObj;
        End;
 
 
-      function TAOptObj.RegUsedAfterInstruction(reg: Tregister; p: tai;
-       var AllUsedRegs: TAllUsedRegs): Boolean;
-       begin
-         AllUsedRegs[getregtype(reg)].Update(tai(p.Next),true);
-         RegUsedAfterInstruction :=
-           (AllUsedRegs[getregtype(reg)].IsUsed(reg)); { optimization and
-              (not(getNextInstruction(p,p)) or
-               not(regLoadedWithNewValue(supreg,false,p))); }
-       end;
+    function TAOptObj.RegUsedAfterInstruction(reg: Tregister; p: tai;var AllUsedRegs: TAllUsedRegs): Boolean;
+      begin
+        AllUsedRegs[getregtype(reg)].Update(tai(p.Next),true);
+        RegUsedAfterInstruction :=
+          AllUsedRegs[getregtype(reg)].IsUsed(reg) and
+          not(regLoadedWithNewValue(reg,p)) and
+          (
+            not(GetNextInstruction(p,p)) or
+            InstructionLoadsFromReg(reg,p) or
+            not(regLoadedWithNewValue(reg,p))
+          );
+      end;
+
+
+    function TAOptObj.RegEndOfLife(reg : TRegister;p : taicpu) : boolean;
+      begin
+         Result:=assigned(FindRegDealloc(reg,tai(p.Next))) or
+           RegLoadedWithNewValue(reg,p);
+      end;
 
 
     function SkipLabels(hp: tai; var hp2: tai): boolean;
@@ -1174,7 +1188,9 @@ Unit AoptObj;
       end;
 {$pop}
 
-    function IsJumpToLabel(hp: taicpu): boolean;
+
+    { Returns True if hp is an unconditional jump to a label }
+    function IsJumpToLabelUncond(hp: taicpu): boolean;
       begin
 {$if defined(avr)}
         result:=(hp.opcode in aopt_uncondjmp) and
@@ -1190,6 +1206,16 @@ Unit AoptObj;
       end;
 
 
+    { Returns True if hp is any jump to a label }
+    function IsJumpToLabel(hp: taicpu): boolean;
+      begin
+        result:=hp.is_jmp and
+          (hp.ops>0) and
+          (JumpTargetOp(hp)^.typ = top_ref) and
+          (JumpTargetOp(hp)^.ref^.symbol is TAsmLabel);
+      end;
+
+
     procedure TAOptObj.RemoveDelaySlot(hp1:tai);
       var
         hp2: tai;
@@ -1239,7 +1265,7 @@ Unit AoptObj;
                (taicpu(p1).is_jmp) then
               if { the next instruction after the label where the jump hp arrives}
                  { is unconditional or of the same type as hp, so continue       }
-                 IsJumpToLabel(taicpu(p1))
+                 IsJumpToLabelUncond(taicpu(p1))
 {$if not defined(MIPS) and not defined(JVM)}
 { for MIPS, it isn't enough to check the condition; first operands must be same, too. }
                  or
@@ -1254,7 +1280,7 @@ Unit AoptObj;
                   SkipLabels(p1,p2) and
                   (p2.typ = ait_instruction) and
                   (taicpu(p2).is_jmp) and
-                   (IsJumpToLabel(taicpu(p2)) or
+                   (IsJumpToLabelUncond(taicpu(p2)) or
                    (conditions_equal(taicpu(p2).condition,hp.condition))) and
                   SkipLabels(p1,p1))
 {$endif not MIPS and not JVM}
@@ -1354,7 +1380,7 @@ Unit AoptObj;
                         { the following if-block removes all code between a jmp and the next label,
                           because it can never be executed
                         }
-                        if IsJumpToLabel(taicpu(p)) then
+                        if IsJumpToLabelUncond(taicpu(p)) then
                           begin
                             hp2:=p;
                             while GetNextInstruction(hp2, hp1) and
@@ -1387,11 +1413,11 @@ Unit AoptObj;
                                 end
                               else break;
                             end;
-                        { remove jumps to a label coming right after them }
                         if GetNextInstruction(p, hp1) then
                           begin
                             SkipEntryExitMarker(hp1,hp1);
-                            if IsJumpToLabel(taicpu(p)) and
+                            { remove unconditional jumps to a label coming right after them }
+                            if IsJumpToLabelUncond(taicpu(p)) and
                               FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp1) and
           { TODO: FIXME removing the first instruction fails}
                                 (p<>blockstart) then
@@ -1409,10 +1435,17 @@ Unit AoptObj;
                               end
                             else if assigned(hp1) then
                               begin
+                                { change the following jumps:
+                                    jmp<cond> lab_1         jmp<cond_inverted> lab_2
+                                    jmp       lab_2  >>>    <code>
+                                  lab_1:                  lab_2:
+                                    <code>
+                                  lab_2:
+                                }
                                 if hp1.typ = ait_label then
                                   SkipLabels(hp1,hp1);
                                 if (tai(hp1).typ=ait_instruction) and
-                                  IsJumpToLabel(taicpu(hp1)) and
+                                  IsJumpToLabelUncond(taicpu(hp1)) and
                                   GetNextInstruction(hp1, hp2) and
                                   IsJumpToLabel(taicpu(p)) and
                                   FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp2) then

compiler/arm/aasmcpu.pas

@@ -275,7 +275,7 @@ uses
          insoffset : longint;
          LastInsOffset : longint; { need to be public to be reset }
          insentry  : PInsEntry;
-         procedure BuildArmMasks;
+         procedure BuildArmMasks(objdata:TObjData);
          function  InsEnd:longint;
          procedure create_ot(objdata:TObjData);
          function  Matches(p:PInsEntry):longint;
@@ -715,91 +715,178 @@ implementation
 
     function taicpu.spilling_get_operation_type(opnr: longint): topertype;
       begin
-        case opcode of
-          A_ADC,A_ADD,A_AND,A_BIC,
-          A_EOR,A_CLZ,A_RBIT,
-          A_LDR,A_LDRB,A_LDRBT,A_LDRH,A_LDRSB,
-          A_LDRSH,A_LDRT,
-          A_MOV,A_MVN,A_MLA,A_MUL,
-          A_ORR,A_RSB,A_RSC,A_SBC,A_SUB,
-          A_SWP,A_SWPB,
-          A_LDF,A_FLT,A_FIX,
-          A_ADF,A_DVF,A_FDV,A_FML,
-          A_RFS,A_RFC,A_RDF,
-          A_RMF,A_RPW,A_RSF,A_SUF,A_ABS,A_ACS,A_ASN,A_ATN,A_COS,
-          A_EXP,A_LOG,A_LGN,A_MVF,A_MNF,A_FRD,A_MUF,A_POL,A_RND,A_SIN,A_SQT,A_TAN,
-          A_LFM,
-          A_FLDS,A_FLDD,
-          A_FMRX,A_FMXR,A_FMSTAT,
-          A_FMSR,A_FMRS,A_FMDRR,
-          A_FCPYS,A_FCPYD,A_FCVTSD,A_FCVTDS,
-          A_FABSS,A_FABSD,A_FSQRTS,A_FSQRTD,A_FMULS,A_FMULD,
-          A_FADDS,A_FADDD,A_FSUBS,A_FSUBD,A_FDIVS,A_FDIVD,
-          A_FMACS,A_FMACD,A_FMSCS,A_FMSCD,A_FNMACS,A_FNMACD,
-          A_FNMSCS,A_FNMSCD,A_FNMULS,A_FNMULD,
-          A_FMDHR,A_FMRDH,A_FMDLR,A_FMRDL,
-          A_FNEGS,A_FNEGD,
-          A_FSITOS,A_FSITOD,A_FTOSIS,A_FTOSID,
-          A_FTOUIS,A_FTOUID,A_FUITOS,A_FUITOD,
-          A_SXTB16,A_UXTB16,
-          A_UXTB,A_UXTH,A_SXTB,A_SXTH,
-          A_NEG,
-          A_VABS,A_VADD,A_VCVT,A_VDIV,A_VLDR,A_VMOV,A_VMUL,A_VNEG,A_VSQRT,A_VSUB,
-          A_MRS,A_MSR:
-            if opnr=0 then
-              result:=operand_write
-            else
-              result:=operand_read;
-          A_BKPT,A_B,A_BL,A_BLX,A_BX,
-          A_CMN,A_CMP,A_TEQ,A_TST,
-          A_CMF,A_CMFE,A_WFS,A_CNF,
-          A_FCMPS,A_FCMPD,A_FCMPES,A_FCMPED,A_FCMPEZS,A_FCMPEZD,
-          A_FCMPZS,A_FCMPZD,
-          A_VCMP,A_VCMPE:
-            result:=operand_read;
-          A_SMLAL,A_UMLAL:
-            if opnr in [0,1] then
-              result:=operand_readwrite
-            else
-              result:=operand_read;
-           A_SMULL,A_UMULL,
-           A_FMRRD:
-            if opnr in [0,1] then
-              result:=operand_write
-            else
-              result:=operand_read;
-          A_STR,A_STRB,A_STRBT,
-          A_STRH,A_STRT,A_STF,A_SFM,
-          A_FSTS,A_FSTD,
-          A_VSTR:
-            { important is what happens with the involved registers }
-            if opnr=0 then
-              result := operand_read
-            else
-              { check for pre/post indexed }
-              result := operand_read;
-          //Thumb2
-          A_LSL, A_LSR, A_ROR, A_ASR, A_SDIV, A_UDIV, A_MOVW, A_MOVT, A_MLS, A_BFI,
-          A_SMMLA,A_SMMLS:
-            if opnr in [0] then
-              result:=operand_write
-            else
+        if GenerateThumbCode then
+          case opcode of
+            A_ADC,A_ADD,A_AND,A_BIC,
+            A_EOR,A_CLZ,A_RBIT,
+            A_LDR,A_LDRB,A_LDRBT,A_LDRH,A_LDRSB,
+            A_LDRSH,A_LDRT,
+            A_MOV,A_MVN,A_MLA,A_MUL,
+            A_ORR,A_RSB,A_RSC,A_SBC,A_SUB,
+            A_SWP,A_SWPB,
+            A_LDF,A_FLT,A_FIX,
+            A_ADF,A_DVF,A_FDV,A_FML,
+            A_RFS,A_RFC,A_RDF,
+            A_RMF,A_RPW,A_RSF,A_SUF,A_ABS,A_ACS,A_ASN,A_ATN,A_COS,
+            A_EXP,A_LOG,A_LGN,A_MVF,A_MNF,A_FRD,A_MUF,A_POL,A_RND,A_SIN,A_SQT,A_TAN,
+            A_LFM,
+            A_FLDS,A_FLDD,
+            A_FMRX,A_FMXR,A_FMSTAT,
+            A_FMSR,A_FMRS,A_FMDRR,
+            A_FCPYS,A_FCPYD,A_FCVTSD,A_FCVTDS,
+            A_FABSS,A_FABSD,A_FSQRTS,A_FSQRTD,A_FMULS,A_FMULD,
+            A_FADDS,A_FADDD,A_FSUBS,A_FSUBD,A_FDIVS,A_FDIVD,
+            A_FMACS,A_FMACD,A_FMSCS,A_FMSCD,A_FNMACS,A_FNMACD,
+            A_FNMSCS,A_FNMSCD,A_FNMULS,A_FNMULD,
+            A_FMDHR,A_FMRDH,A_FMDLR,A_FMRDL,
+            A_FNEGS,A_FNEGD,
+            A_FSITOS,A_FSITOD,A_FTOSIS,A_FTOSID,
+            A_FTOUIS,A_FTOUID,A_FUITOS,A_FUITOD,
+            A_SXTB16,A_UXTB16,
+            A_UXTB,A_UXTH,A_SXTB,A_SXTH,
+            A_NEG,
+            A_VABS,A_VADD,A_VCVT,A_VDIV,A_VLDR,A_VMOV,A_VMUL,A_VNEG,A_VSQRT,A_VSUB,
+            A_MRS,A_MSR:
+              if opnr=0 then
+                result:=operand_readwrite
+              else
+                result:=operand_read;
+            A_BKPT,A_B,A_BL,A_BLX,A_BX,
+            A_CMN,A_CMP,A_TEQ,A_TST,
+            A_CMF,A_CMFE,A_WFS,A_CNF,
+            A_FCMPS,A_FCMPD,A_FCMPES,A_FCMPED,A_FCMPEZS,A_FCMPEZD,
+            A_FCMPZS,A_FCMPZD,
+            A_VCMP,A_VCMPE:
               result:=operand_read;
-          A_BFC:
-            if opnr in [0] then
-              result:=operand_readwrite
+            A_SMLAL,A_UMLAL:
+              if opnr in [0,1] then
+                result:=operand_readwrite
+              else
+                result:=operand_read;
+             A_SMULL,A_UMULL,
+             A_FMRRD:
+              if opnr in [0,1] then
+                result:=operand_readwrite
+              else
+                result:=operand_read;
+            A_STR,A_STRB,A_STRBT,
+            A_STRH,A_STRT,A_STF,A_SFM,
+            A_FSTS,A_FSTD,
+            A_VSTR:
+              { important is what happens with the involved registers }
+              if opnr=0 then
+                result := operand_read
+              else
+                { check for pre/post indexed }
+                result := operand_read;
+            //Thumb2
+            A_LSL, A_LSR, A_ROR, A_ASR, A_SDIV, A_UDIV, A_MOVW, A_MOVT, A_MLS, A_BFI,
+            A_SMMLA,A_SMMLS:
+              if opnr in [0] then
+                result:=operand_readwrite
+              else
+                result:=operand_read;
+            A_BFC:
+              if opnr in [0] then
+                result:=operand_readwrite
+              else
+                result:=operand_read;
+            A_LDREX:
+              if opnr in [0] then
+                result:=operand_readwrite
+              else
+                result:=operand_read;
+            A_STREX:
+              result:=operand_write;
             else
+              internalerror(200403151);
+          end
+        else
+          case opcode of
+            A_ADC,A_ADD,A_AND,A_BIC,
+            A_EOR,A_CLZ,A_RBIT,
+            A_LDR,A_LDRB,A_LDRBT,A_LDRH,A_LDRSB,
+            A_LDRSH,A_LDRT,
+            A_MOV,A_MVN,A_MLA,A_MUL,
+            A_ORR,A_RSB,A_RSC,A_SBC,A_SUB,
+            A_SWP,A_SWPB,
+            A_LDF,A_FLT,A_FIX,
+            A_ADF,A_DVF,A_FDV,A_FML,
+            A_RFS,A_RFC,A_RDF,
+            A_RMF,A_RPW,A_RSF,A_SUF,A_ABS,A_ACS,A_ASN,A_ATN,A_COS,
+            A_EXP,A_LOG,A_LGN,A_MVF,A_MNF,A_FRD,A_MUF,A_POL,A_RND,A_SIN,A_SQT,A_TAN,
+            A_LFM,
+            A_FLDS,A_FLDD,
+            A_FMRX,A_FMXR,A_FMSTAT,
+            A_FMSR,A_FMRS,A_FMDRR,
+            A_FCPYS,A_FCPYD,A_FCVTSD,A_FCVTDS,
+            A_FABSS,A_FABSD,A_FSQRTS,A_FSQRTD,A_FMULS,A_FMULD,
+            A_FADDS,A_FADDD,A_FSUBS,A_FSUBD,A_FDIVS,A_FDIVD,
+            A_FMACS,A_FMACD,A_FMSCS,A_FMSCD,A_FNMACS,A_FNMACD,
+            A_FNMSCS,A_FNMSCD,A_FNMULS,A_FNMULD,
+            A_FMDHR,A_FMRDH,A_FMDLR,A_FMRDL,
+            A_FNEGS,A_FNEGD,
+            A_FSITOS,A_FSITOD,A_FTOSIS,A_FTOSID,
+            A_FTOUIS,A_FTOUID,A_FUITOS,A_FUITOD,
+            A_SXTB16,A_UXTB16,
+            A_UXTB,A_UXTH,A_SXTB,A_SXTH,
+            A_NEG,
+            A_VABS,A_VADD,A_VCVT,A_VDIV,A_VLDR,A_VMOV,A_VMUL,A_VNEG,A_VSQRT,A_VSUB,
+            A_MRS,A_MSR:
+              if opnr=0 then
+                result:=operand_write
+              else
+                result:=operand_read;
+            A_BKPT,A_B,A_BL,A_BLX,A_BX,
+            A_CMN,A_CMP,A_TEQ,A_TST,
+            A_CMF,A_CMFE,A_WFS,A_CNF,
+            A_FCMPS,A_FCMPD,A_FCMPES,A_FCMPED,A_FCMPEZS,A_FCMPEZD,
+            A_FCMPZS,A_FCMPZD,
+            A_VCMP,A_VCMPE:
               result:=operand_read;
-          A_LDREX:
-            if opnr in [0] then
-              result:=operand_write
+            A_SMLAL,A_UMLAL:
+              if opnr in [0,1] then
+                result:=operand_readwrite
+              else
+                result:=operand_read;
+             A_SMULL,A_UMULL,
+             A_FMRRD:
+              if opnr in [0,1] then
+                result:=operand_write
+              else
+                result:=operand_read;
+            A_STR,A_STRB,A_STRBT,
+            A_STRH,A_STRT,A_STF,A_SFM,
+            A_FSTS,A_FSTD,
+            A_VSTR:
+              { important is what happens with the involved registers }
+              if opnr=0 then
+                result := operand_read
+              else
+                { check for pre/post indexed }
+                result := operand_read;
+            //Thumb2
+            A_LSL, A_LSR, A_ROR, A_ASR, A_SDIV, A_UDIV, A_MOVW, A_MOVT, A_MLS, A_BFI,
+            A_SMMLA,A_SMMLS:
+              if opnr in [0] then
+                result:=operand_write
+              else
+                result:=operand_read;
+            A_BFC:
+              if opnr in [0] then
+                result:=operand_readwrite
+              else
+                result:=operand_read;
+            A_LDREX:
+              if opnr in [0] then
+                result:=operand_write
+              else
+                result:=operand_read;
+            A_STREX:
+              result:=operand_write;
             else
-              result:=operand_read;
-          A_STREX:
-            result:=operand_write;
-          else
-            internalerror(200403151);
-        end;
+              internalerror(200403151);
+          end;
       end;
 
 
@@ -1329,6 +1416,36 @@ implementation
               ait_instruction:
                 begin
                   case taicpu(curtai).opcode of
+                    A_STM:
+                      begin
+                        if (taicpu(curtai).ops=2) and
+                           (taicpu(curtai).oper[0]^.typ=top_ref) and
+                           (taicpu(curtai).oper[0]^.ref^.index=NR_STACK_POINTER_REG) and
+                           (taicpu(curtai).oper[0]^.ref^.addressmode=AM_PREINDEXED) and
+                           (taicpu(curtai).oppostfix in [PF_FD,PF_DB]) then
+                          begin
+                            taicpu(curtai).oppostfix:=PF_None;
+                            taicpu(curtai).loadregset(0, taicpu(curtai).oper[1]^.regtyp, taicpu(curtai).oper[1]^.subreg, taicpu(curtai).oper[1]^.regset^);
+                            taicpu(curtai).ops:=1;
+                            taicpu(curtai).opcode:=A_PUSH;
+                          end;
+                      end;
+
+                    A_LDM:
+                      begin
+                        if (taicpu(curtai).ops=2) and
+                           (taicpu(curtai).oper[0]^.typ=top_ref) and
+                           (taicpu(curtai).oper[0]^.ref^.index=NR_STACK_POINTER_REG) and
+                           (taicpu(curtai).oper[0]^.ref^.addressmode=AM_PREINDEXED) and
+                           (taicpu(curtai).oppostfix in [PF_FD,PF_IA]) then
+                          begin
+                            taicpu(curtai).oppostfix:=PF_None;
+                            taicpu(curtai).loadregset(0, taicpu(curtai).oper[1]^.regtyp, taicpu(curtai).oper[1]^.subreg, taicpu(curtai).oper[1]^.regset^);
+                            taicpu(curtai).ops:=1;
+                            taicpu(curtai).opcode:=A_POP;
+                          end;
+                      end;
+
                     A_ADD,
                     A_AND,A_EOR,A_ORR,A_BIC,
                     A_LSL,A_LSR,A_ASR,A_ROR,
@@ -2007,7 +2124,7 @@ implementation
       end;
 
 
-    procedure taicpu.BuildArmMasks;
+    procedure taicpu.BuildArmMasks(objdata:TObjData);
       const
         Masks: array[tcputype] of longint =
           (
@@ -2048,7 +2165,8 @@ implementation
       begin
         fArmVMask:=Masks[current_settings.cputype] or FPUMasks[current_settings.fputype];
 
-        if current_settings.instructionset=is_thumb then
+        if objdata.ThumbFunc then
+        //if current_settings.instructionset=is_thumb then
           begin
             fArmMask:=IF_THUMB;
             if CPUARM_HAS_THUMB2 in cpu_capabilities[current_settings.cputype] then
@@ -2549,7 +2667,7 @@ implementation
            { create the .ot fields }
            create_ot(objdata);
 
-           BuildArmMasks;
+           BuildArmMasks(objdata);
            { set the file postion }
            current_filepos:=fileinfo;
          end
@@ -2857,13 +2975,15 @@ implementation
               else
                 begin
                   currsym:=objdata.symbolref(oper[0]^.ref^.symbol);
-                  if (currsym.bind<>AB_LOCAL) and (currsym.objsection<>objdata.CurrObjSec) then
-                    begin
-                      objdata.writereloc(oper[0]^.ref^.offset,0,currsym,RELOC_RELATIVE_24);
-                      bytes:=bytes or $fffffe; // TODO: Not sure this is right, but it matches the output of gas
-                    end
+
+                  bytes:=bytes or (((oper[0]^.ref^.offset-8) shr 2) and $ffffff);
+
+                  if (opcode<>A_BL) or (condition<>C_None) then
+                    objdata.writereloc(bytes,4,currsym,RELOC_RELATIVE_24)
                   else
-                    bytes:=bytes or (((currsym.offset-insoffset-8) shr 2) and $ffffff);
+                    objdata.writereloc(bytes,4,currsym,RELOC_RELATIVE_CALL);
+
+                  exit;
                 end;
             end;
           #$02:
@@ -4400,11 +4520,9 @@ implementation
               bytes:=bytes or (ord(insentry^.code[1]) shl 8);
               bytes:=bytes or ord(insentry^.code[2]);
 
-
               case opcode of
                 A_SUB:
                   begin
-                    bytes:=bytes or (getsupreg(oper[0]^.reg) and $7);
                     if (ops=3) and
                        (oper[2]^.typ=top_const) then
                       bytes:=bytes or ((oper[2]^.val shr 2) and $7F)
@@ -4564,7 +4682,7 @@ implementation
                         bytes:=bytes or (1 shl r);
 
                     if oper[0]^.typ=top_ref then
-                      bytes:=bytes or (getsupreg(oper[0]^.ref^.base) shl 8)
+                      bytes:=bytes or (getsupreg(oper[0]^.ref^.index) shl 8)
                     else
                       bytes:=bytes or (getsupreg(oper[0]^.reg) shl 8);
                   end;
@@ -4575,7 +4693,7 @@ implementation
                         bytes:=bytes or (1 shl r);
 
                     if oper[0]^.typ=top_ref then
-                      bytes:=bytes or (getsupreg(oper[0]^.ref^.base) shl 8)
+                      bytes:=bytes or (getsupreg(oper[0]^.ref^.index) shl 8)
                     else
                       bytes:=bytes or (getsupreg(oper[0]^.reg) shl 8);
                   end;

compiler/arm/agarmgas.pas

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

compiler/arm/aoptcpu.pas

@@ -39,11 +39,7 @@ Type
     procedure PeepHoleOptPass2;override;
     Function RegInInstruction(Reg: TRegister; p1: tai): Boolean;override;
     function RemoveSuperfluousMove(const p: tai; movp: tai; const optimizer: string): boolean;
-    function RegUsedAfterInstruction(reg: Tregister; p: tai;
-                                     var AllUsedRegs: TAllUsedRegs): Boolean;
-    { returns true if reg reaches it's end of life at p, this means it is either
-      reloaded with a new value or it is deallocated afterwards }
-    function RegEndOfLife(reg: TRegister;p: taicpu): boolean;
+
     { gets the next tai object after current that contains info relevant
       to the optimizer in p1 which used the given register or does a
       change in program flow.
@@ -55,6 +51,9 @@ Type
     { outputs a debug message into the assembler file }
     procedure DebugMsg(const s: string; p: tai);
 
+    function InstructionLoadsFromReg(const reg : TRegister; const hp : tai) : boolean; override;
+
+    function RegLoadedWithNewValue(reg : tregister; hp : tai) : boolean; override;
   protected
     function LookForPreindexedPattern(p: taicpu): boolean;
     function LookForPostindexedPattern(p: taicpu): boolean;
@@ -167,67 +166,6 @@ Implementation
       end;
     end;
 
-  function regLoadedWithNewValue(reg: tregister; hp: tai): boolean;
-  var
-    p: taicpu;
-  begin
-    p := taicpu(hp);
-    regLoadedWithNewValue := false;
-    if not ((assigned(hp)) and (hp.typ = ait_instruction)) then
-      exit;
-
-    case p.opcode of
-      { These operands do not write into a register at all }
-      A_CMP, A_CMN, A_TST, A_TEQ, A_B, A_BL, A_BX, A_BLX, A_SWI, A_MSR, A_PLD:
-        exit;
-      {Take care of post/preincremented store and loads, they will change their base register}
-      A_STR, A_LDR:
-        begin
-          regLoadedWithNewValue :=
-            (taicpu(p).oper[1]^.typ=top_ref) and
-            (taicpu(p).oper[1]^.ref^.addressmode in [AM_PREINDEXED,AM_POSTINDEXED]) and
-            (taicpu(p).oper[1]^.ref^.base = reg);
-          {STR does not load into it's first register}
-          if p.opcode = A_STR then exit;
-        end;
-      { These four are writing into the first 2 register, UMLAL and SMLAL will also read from them }
-      A_UMLAL, A_UMULL, A_SMLAL, A_SMULL:
-        regLoadedWithNewValue :=
-          (p.oper[1]^.typ = top_reg) and
-          (p.oper[1]^.reg = reg);
-      {Loads to oper2 from coprocessor}
-      {
-      MCR/MRC is currently not supported in FPC
-      A_MRC:
-        regLoadedWithNewValue :=
-          (p.oper[2]^.typ = top_reg) and
-          (p.oper[2]^.reg = reg);
-      }
-      {Loads to all register in the registerset}
-      A_LDM:
-        regLoadedWithNewValue := (getsupreg(reg) in p.oper[1]^.regset^);
-      A_POP:
-        regLoadedWithNewValue := (getsupreg(reg) in p.oper[0]^.regset^) or
-                                 (reg=NR_STACK_POINTER_REG);
-    end;
-
-    if regLoadedWithNewValue then
-      exit;
-
-    case p.oper[0]^.typ of
-      {This is the case}
-      top_reg:
-        regLoadedWithNewValue := (p.oper[0]^.reg = reg) or
-          { LDRD }
-          (p.opcode=A_LDR) and (p.oppostfix=PF_D) and (getsupreg(p.oper[0]^.reg)+1=getsupreg(reg));
-      {LDM/STM might write a new value to their index register}
-      top_ref:
-        regLoadedWithNewValue :=
-          (taicpu(p).oper[0]^.ref^.addressmode in [AM_PREINDEXED,AM_POSTINDEXED]) and
-          (taicpu(p).oper[0]^.ref^.base = reg);
-    end;
-  end;
-
 
   function AlignedToQWord(const ref : treference) : boolean;
     begin
@@ -249,44 +187,6 @@ Implementation
     end;
 
 
-  function instructionLoadsFromReg(const reg: TRegister; const hp: tai): boolean;
-  var
-    p: taicpu;
-    i: longint;
-  begin
-    instructionLoadsFromReg := false;
-    if not (assigned(hp) and (hp.typ = ait_instruction)) then
-      exit;
-    p:=taicpu(hp);
-
-    i:=1;
-    {For these instructions we have to start on oper[0]}
-    if (p.opcode in [A_STR, A_LDM, A_STM, A_PLD,
-                        A_CMP, A_CMN, A_TST, A_TEQ,
-                        A_B, A_BL, A_BX, A_BLX,
-                        A_SMLAL, A_UMLAL]) then i:=0;
-
-    while(i<p.ops) do
-      begin
-        case p.oper[I]^.typ of
-          top_reg:
-            instructionLoadsFromReg := (p.oper[I]^.reg = reg) or
-              { STRD }
-              ((i=0) and (p.opcode=A_STR) and (p.oppostfix=PF_D) and (getsupreg(p.oper[0]^.reg)+1=getsupreg(reg)));
-          top_regset:
-            instructionLoadsFromReg := (getsupreg(reg) in p.oper[I]^.regset^);
-          top_shifterop:
-            instructionLoadsFromReg := p.oper[I]^.shifterop^.rs = reg;
-          top_ref:
-            instructionLoadsFromReg :=
-              (p.oper[I]^.ref^.base = reg) or
-              (p.oper[I]^.ref^.index = reg);
-        end;
-        if instructionLoadsFromReg then exit; {Bailout if we found something}
-        Inc(I);
-      end;
-  end;
-
   function isValidConstLoadStoreOffset(const aoffset: longint; const pf: TOpPostfix) : boolean;
     begin
       if GenerateThumb2Code then
@@ -297,27 +197,112 @@ Implementation
                   (abs(aoffset)<256);
     end;
 
-  function TCpuAsmOptimizer.RegUsedAfterInstruction(reg: Tregister; p: tai;
-    var AllUsedRegs: TAllUsedRegs): Boolean;
+
+  function TCpuAsmOptimizer.InstructionLoadsFromReg(const reg: TRegister; const hp: tai): boolean;
+    var
+      p: taicpu;
+      i: longint;
     begin
-      AllUsedRegs[getregtype(reg)].Update(tai(p.Next),true);
-      RegUsedAfterInstruction :=
-        AllUsedRegs[getregtype(reg)].IsUsed(reg) and
-        not(regLoadedWithNewValue(reg,p)) and
-        (
-          not(GetNextInstruction(p,p)) or
-          instructionLoadsFromReg(reg,p) or
-          not(regLoadedWithNewValue(reg,p))
-        );
+      instructionLoadsFromReg := false;
+      if not (assigned(hp) and (hp.typ = ait_instruction)) then
+        exit;
+      p:=taicpu(hp);
+
+      i:=1;
+      {For these instructions we have to start on oper[0]}
+      if (p.opcode in [A_STR, A_LDM, A_STM, A_PLD,
+                          A_CMP, A_CMN, A_TST, A_TEQ,
+                          A_B, A_BL, A_BX, A_BLX,
+                          A_SMLAL, A_UMLAL]) then i:=0;
+
+      while(i<p.ops) do
+        begin
+          case p.oper[I]^.typ of
+            top_reg:
+              instructionLoadsFromReg := (p.oper[I]^.reg = reg) or
+                { STRD }
+                ((i=0) and (p.opcode=A_STR) and (p.oppostfix=PF_D) and (getsupreg(p.oper[0]^.reg)+1=getsupreg(reg)));
+            top_regset:
+              instructionLoadsFromReg := (getsupreg(reg) in p.oper[I]^.regset^);
+            top_shifterop:
+              instructionLoadsFromReg := p.oper[I]^.shifterop^.rs = reg;
+            top_ref:
+              instructionLoadsFromReg :=
+                (p.oper[I]^.ref^.base = reg) or
+                (p.oper[I]^.ref^.index = reg);
+          end;
+          if instructionLoadsFromReg then exit; {Bailout if we found something}
+          Inc(I);
+        end;
     end;
 
 
-  function TCpuAsmOptimizer.RegEndOfLife(reg : TRegister;p : taicpu) : boolean;
+  function TCpuAsmOptimizer.RegLoadedWithNewValue(reg: tregister; hp: tai): boolean;
+    var
+      p: taicpu;
     begin
-       Result:=assigned(FindRegDealloc(reg,tai(p.Next))) or
-         RegLoadedWithNewValue(reg,p);
+      p := taicpu(hp);
+      Result := false;
+      if not ((assigned(hp)) and (hp.typ = ait_instruction)) then
+        exit;
+
+      case p.opcode of
+        { These operands do not write into a register at all }
+        A_CMP, A_CMN, A_TST, A_TEQ, A_B, A_BL, A_BX, A_BLX, A_SWI, A_MSR, A_PLD:
+          exit;
+        {Take care of post/preincremented store and loads, they will change their base register}
+        A_STR, A_LDR:
+          begin
+            Result := false;
+            { actually, this does not apply here because post-/preindexed does not mean that a register
+              is loaded with a new value, it is only modified
+              (taicpu(p).oper[1]^.typ=top_ref) and
+              (taicpu(p).oper[1]^.ref^.addressmode in [AM_PREINDEXED,AM_POSTINDEXED]) and
+              (taicpu(p).oper[1]^.ref^.base = reg);
+            }
+            { STR does not load into it's first register }
+            if p.opcode = A_STR then
+              exit;
+          end;
+        { These four are writing into the first 2 register, UMLAL and SMLAL will also read from them }
+        A_UMLAL, A_UMULL, A_SMLAL, A_SMULL:
+          Result :=
+            (p.oper[1]^.typ = top_reg) and
+            (p.oper[1]^.reg = reg);
+        {Loads to oper2 from coprocessor}
+        {
+        MCR/MRC is currently not supported in FPC
+        A_MRC:
+          Result :=
+            (p.oper[2]^.typ = top_reg) and
+            (p.oper[2]^.reg = reg);
+        }
+        {Loads to all register in the registerset}
+        A_LDM:
+          Result := (getsupreg(reg) in p.oper[1]^.regset^);
+        A_POP:
+          Result := (getsupreg(reg) in p.oper[0]^.regset^) or
+                                   (reg=NR_STACK_POINTER_REG);
+      end;
+
+      if Result then
+        exit;
+
+      case p.oper[0]^.typ of
+        {This is the case}
+        top_reg:
+          Result := (p.oper[0]^.reg = reg) or
+            { LDRD }
+            (p.opcode=A_LDR) and (p.oppostfix=PF_D) and (getsupreg(p.oper[0]^.reg)+1=getsupreg(reg));
+        {LDM/STM might write a new value to their index register}
+        top_ref:
+          Result :=
+            (taicpu(p).oper[0]^.ref^.addressmode in [AM_PREINDEXED,AM_POSTINDEXED]) and
+            (taicpu(p).oper[0]^.ref^.base = reg);
+      end;
     end;
 
+
   function TCpuAsmOptimizer.GetNextInstructionUsingReg(Current: tai;
     Out Next: tai; reg: TRegister): Boolean;
     begin
@@ -1442,6 +1427,9 @@ Implementation
                            (not GenerateThumb2Code)
                          )
                        ) and
+                       { Only fold if both registers are used. Otherwise we are folding p with itself }
+                       (taicpu(hp1).oper[1]^.ref^.index<>NR_NO) and
+                       (taicpu(hp1).oper[1]^.ref^.base<>NR_NO) and
                        { Only fold if there isn't another shifterop already, and offset is zero. }
                        (taicpu(hp1).oper[1]^.ref^.offset = 0) and
                        (taicpu(hp1).oper[1]^.ref^.shiftmode = SM_None) and

compiler/arm/armatt.inc

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

compiler/arm/armatts.inc

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

compiler/arm/armins.dat

@@ -1030,6 +1030,7 @@ reg32,reg32,reg32          \x80\xFB\x40\xF0\x0                 THUMB32,ARMv6T2
 reg32,reg32,reg32          \x15\x7\x00\x5\xF                   ARM32,ARMv6
 
 [SRScc]
+[RFEcc]
 
 [SSATcc]
 reg32,immshifter,reg32            \x83\xF3\x00\x0\x0          THUMB32,ARMv6T2

compiler/arm/armop.inc

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

compiler/arm/cgcpu.pas

@@ -646,11 +646,13 @@ unit cgcpu;
         sym : TAsmSymbol;
       begin
         { check not really correct: should only be used for non-Thumb cpus }
-        if (CPUARM_HAS_BLX_LABEL in cpu_capabilities[current_settings.cputype]) and
-          { WinCE GNU AS (not sure if this applies in general) does not support BLX imm }
-          (target_info.system<>system_arm_wince) then
-          branchopcode:=A_BLX
-        else
+        // if (CPUARM_HAS_BLX_LABEL in cpu_capabilities[current_settings.cputype]) and
+        //   { WinCE GNU AS (not sure if this applies in general) does not support BLX imm }
+        // (target_info.system<>system_arm_wince) then
+        //   branchopcode:=A_BLX
+        // else
+        { use always BL as newer binutils do not translate blx apparently
+          generating BL is also what clang and gcc do by default }
           branchopcode:=A_BL;
         if not(weak) then
           sym:=current_asmdata.RefAsmSymbol(s)

compiler/arm/cpuelf.pas

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

compiler/arm/cpuinfo.pas

@@ -251,9 +251,60 @@ Type
       ct_stm32f107vb,
       ct_stm32f107vc,
       
-      ct_stm32f429xe, // 512K flash
-      ct_stm32f429xg, // 1M flash
-      ct_stm32f429xi, // 2M flash
+      ct_stm32f401cb,
+      ct_stm32f401rb,
+      ct_stm32f401vb,
+      ct_stm32f401cc,
+      ct_stm32f401rc,
+      ct_stm32f401vc,
+      ct_discoveryf401vc,
+      ct_stm32f401cd,
+      ct_stm32f401rd,
+      ct_stm32f401vd,
+      ct_stm32f401ce,
+      ct_stm32f401re,
+      ct_nucleof401re,
+      ct_stm32f401ve,
+      ct_stm32f407vg,
+      ct_discoveryf407vg,
+      ct_stm32f407ig,
+      ct_stm32f407zg,
+      ct_stm32f407ve,
+      ct_stm32f407ze,
+      ct_stm32f407ie,
+      ct_stm32f411cc,
+      ct_stm32f411rc,
+      ct_stm32f411vc,
+      ct_stm32f411ce,
+      ct_stm32f411re,
+      ct_nucleof411re,
+      ct_stm32f411ve,
+      ct_discoveryf411ve,
+      ct_stm32f429vg,
+      ct_stm32f429zg,
+      ct_stm32f429ig,
+      ct_stm32f429vi,
+      ct_stm32f429zi,
+      ct_discoveryf429zi,
+      ct_stm32f429ii,
+      ct_stm32f429ve,
+      ct_stm32f429ze,
+      ct_stm32f429ie,
+      ct_stm32f429bg,
+      ct_stm32f429bi,
+      ct_stm32f429be,
+      ct_stm32f429ng,
+      ct_stm32f429ni,
+      ct_stm32f429ne,
+      ct_stm32f446mc,
+      ct_stm32f446rc,
+      ct_stm32f446vc,
+      ct_stm32f446zc,
+      ct_stm32f446me,
+      ct_stm32f446re,
+      ct_nucleof446re,
+      ct_stm32f446ve,
+      ct_stm32f446ze,
 
       ct_stm32f745xe,
       ct_stm32f745xg,
@@ -353,9 +404,64 @@ Type
       ct_allwinner_a20,
 
       { Freescale }
-      ct_mk20dx128xxx7,
-      ct_mk20dx256xxx7,
-      ct_mk20dx64xxx7,
+      ct_mk20dx128vfm5,
+      ct_mk20dx128vft5,
+      ct_mk20dx128vlf5,
+      ct_mk20dx128vlh5,
+      ct_teensy30,
+      ct_mk20dx128vmp5,
+
+      ct_mk20dx32vfm5,
+      ct_mk20dx32vft5,
+      ct_mk20dx32vlf5,
+      ct_mk20dx32vlh5,
+      ct_mk20dx32vmp5,
+
+      ct_mk20dx64vfm5,
+      ct_mk20dx64vft5,
+      ct_mk20dx64vlf5,
+      ct_mk20dx64vlh5,
+      ct_mk20dx64vmp5,
+
+      ct_mk20dx128vlh7,
+      ct_mk20dx128vlk7,
+      ct_mk20dx128vll7,
+      ct_mk20dx128vmc7,
+
+      ct_mk20dx256vlh7,
+      ct_mk20dx256vlk7,
+      ct_mk20dx256vll7,
+      ct_mk20dx256vmc7,
+      ct_teensy31,
+      ct_teensy32,
+
+      ct_mk20dx64vlh7,
+      ct_mk20dx64vlk7,
+      ct_mk20dx64vmc7,
+
+      ct_mk22fn512cap12,
+      ct_mk22fn512cbp12,
+      ct_mk22fn512vdc12,
+      ct_mk22fn512vlh12,
+      ct_mk22fn512vll12,
+      ct_mk22fn512vmp12,
+      ct_freedom_k22f,
+
+      ct_mk64fn1m0vdc12,
+      ct_mk64fn1m0vll12,
+      ct_freedom_k64f,
+      ct_mk64fn1m0vlq12,
+      ct_mk64fn1m0vmd12,
+
+      ct_mk64fx512vdc12,
+      ct_mk64fx512vll12,
+      ct_mk64fx512vlq12,
+      ct_mk64fx512vmd12,
+
+      { Atmel }
+      ct_sam3x8e,
+      ct_arduino_due,
+      ct_flip_n_click,
 
       // generic Thumb2 target
       ct_thumb2bare
@@ -644,11 +750,62 @@ Const
       (controllertypestr:'STM32F107RC';     controllerunitstr:'STM32F10X_CL';     cputype:cpu_armv7m; fputype:fpu_soft; flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
       (controllertypestr:'STM32F107VB';     controllerunitstr:'STM32F10X_CL';     cputype:cpu_armv7m; fputype:fpu_soft; flashbase:$08000000; flashsize:$00020000; srambase:$20000000; sramsize:$00010000),
       (controllertypestr:'STM32F107VC';     controllerunitstr:'STM32F10X_CL';     cputype:cpu_armv7m; fputype:fpu_soft; flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
-      
-      (controllertypestr:'STM32F429XE';     controllerunitstr:'STM32F429';        cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00030000),
-      (controllertypestr:'STM32F429XG';     controllerunitstr:'STM32F429';        cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00100000; srambase:$20000000; sramsize:$00030000),
-      (controllertypestr:'STM32F429XI';     controllerunitstr:'STM32F429';        cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00200000; srambase:$20000000; sramsize:$00030000),
-
+    
+      (controllertypestr:'STM32F401CB';     controllerunitstr:'STM32F401XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00020000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'STM32F401RB';     controllerunitstr:'STM32F401XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00020000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'STM32F401VB';     controllerunitstr:'STM32F401XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00020000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'STM32F401CC';     controllerunitstr:'STM32F401XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'STM32F401RC';     controllerunitstr:'STM32F401XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'STM32F401VC';     controllerunitstr:'STM32F401XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'DISCOVERYF401VC'; controllerunitstr:'STM32F401XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'STM32F401CD';     controllerunitstr:'STM32F401XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00060000; srambase:$20000000; sramsize:$00018000),
+      (controllertypestr:'STM32F401RD';     controllerunitstr:'STM32F401XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00060000; srambase:$20000000; sramsize:$00018000),
+      (controllertypestr:'STM32F401VD';     controllerunitstr:'STM32F401XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00060000; srambase:$20000000; sramsize:$00018000),
+      (controllertypestr:'STM32F401CE';     controllerunitstr:'STM32F401XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00018000),
+      (controllertypestr:'STM32F401RE';     controllerunitstr:'STM32F401XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00018000),
+      (controllertypestr:'NUCLEOF401RE';    controllerunitstr:'STM32F401XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00018000),
+      (controllertypestr:'STM32F401VE';     controllerunitstr:'STM32F401XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00018000),
+      (controllertypestr:'STM32F407VG';     controllerunitstr:'STM32F407XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00100000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'DISCOVERYF407VG'; controllerunitstr:'STM32F407XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00100000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F407IG';     controllerunitstr:'STM32F407XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00100000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F407ZG';     controllerunitstr:'STM32F407XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00100000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F407VE';     controllerunitstr:'STM32F407XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F407ZE';     controllerunitstr:'STM32F407XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F407IE';     controllerunitstr:'STM32F407XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F411CC';     controllerunitstr:'STM32F411XE';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F411RC';     controllerunitstr:'STM32F411XE';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F411VC';     controllerunitstr:'STM32F411XE';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F411CE';     controllerunitstr:'STM32F411XE';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F411RE';     controllerunitstr:'STM32F411XE';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'NUCLEOF411RE';    controllerunitstr:'STM32F411XE';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F411VE';     controllerunitstr:'STM32F411XE';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'DISCOVERYF411VE'; controllerunitstr:'STM32F411XE';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F429VG';     controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00100000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429ZG';     controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00100000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429IG';     controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00100000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429VI';     controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00200000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429ZI';     controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00200000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'DISCOVERYF429ZI'; controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00200000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429II';     controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00200000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429VE';     controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429ZE';     controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429IE';     controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429BG';     controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00100000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429BI';     controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00200000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429BE';     controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429NG';     controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00100000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429NI';     controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00200000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429NE';     controllerunitstr:'STM32F429XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F446MC';     controllerunitstr:'STM32F446XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F446RC';     controllerunitstr:'STM32F446XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F446VC';     controllerunitstr:'STM32F446XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F446ZC';     controllerunitstr:'STM32F446XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F446ME';     controllerunitstr:'STM32F446XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F446RE';     controllerunitstr:'STM32F446XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'NUCLEOF446RE';    controllerunitstr:'STM32F446XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F446VE';     controllerunitstr:'STM32F446XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'STM32F446ZE';     controllerunitstr:'STM32F446XX';      cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00020000),
+ 
       (controllertypestr:'STM32F745XE';     controllerunitstr:'STM32F745';        cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20010000; sramsize:$00040000),
       (controllertypestr:'STM32F745XG';     controllerunitstr:'STM32F745';        cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00100000; srambase:$20010000; sramsize:$00040000),
       (controllertypestr:'STM32F746XE';     controllerunitstr:'STM32F746';        cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$08000000; flashsize:$00080000; srambase:$20010000; sramsize:$00040000),
@@ -745,9 +902,64 @@ Const
       (controllertypestr:'ALLWINNER_A20'; controllerunitstr:'ALLWINNER_A20'; cputype:cpu_armv7a; fputype:fpu_vfpv4; flashbase:$00000000; flashsize:$00000000;  srambase:$40000000; sramsize:$80000000),
 
       { Freescale }
-      (controllertypestr:'MK20DX128XXX7'; controllerunitstr:'MK20D7'; cputype:cpu_armv7m; fputype:fpu_soft; flashbase:$00000000; flashsize:$00020000; srambase:$20000000; sramsize:$00004000),
-      (controllertypestr:'MK20DX256XXX7'; controllerunitstr:'MK20D7'; cputype:cpu_armv7m; fputype:fpu_soft; flashbase:$00000000; flashsize:$00040000; srambase:$20000000; sramsize:$00008000),
-      (controllertypestr:'MK20DX64XXX7';  controllerunitstr:'MK20D7'; cputype:cpu_armv7m; fputype:fpu_soft; flashbase:$00000000; flashsize:$00010000; srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'MK20DX128VFM5'; controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00020000;   srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'MK20DX128VFT5'; controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00020000;   srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'MK20DX128VLF5'; controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00020000;   srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'MK20DX128VLH5'; controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00020000;   srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'TEENSY30'     ; controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00020000;   srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'MK20DX128VMP5'; controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00020000;   srambase:$20000000; sramsize:$00002000),
+
+      (controllertypestr:'MK20DX32VFM5';  controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00008000;   srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'MK20DX32VFT5';  controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00008000;   srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'MK20DX32VLF5';  controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00008000;   srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'MK20DX32VLH5';  controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00008000;   srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'MK20DX32VMP5';  controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00008000;   srambase:$20000000; sramsize:$00001000),
+
+      (controllertypestr:'MK20DX64VFM5';  controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00010000;   srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'MK20DX64VFT5';  controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00010000;   srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'MK20DX64VLF5';  controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00010000;   srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'MK20DX64VLH5';  controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00010000;   srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'MK20DX64VMP5';  controllerunitstr:'MK20D5';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00010000;   srambase:$20000000; sramsize:$00002000),
+
+      (controllertypestr:'MK20DX128VLH7'; controllerunitstr:'MK20D7';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00020000;   srambase:$20000000; sramsize:$00004000),
+      (controllertypestr:'MK20DX128VLK7'; controllerunitstr:'MK20D7';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00020000;   srambase:$20000000; sramsize:$00004000),
+      (controllertypestr:'MK20DX128VLL7'; controllerunitstr:'MK20D7';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00020000;   srambase:$20000000; sramsize:$00004000),
+      (controllertypestr:'MK20DX128VMC7'; controllerunitstr:'MK20D7';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00020000;   srambase:$20000000; sramsize:$00004000),
+
+      (controllertypestr:'MK20DX256VLH7'; controllerunitstr:'MK20D7';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00040000;   srambase:$20000000; sramsize:$00008000),
+      (controllertypestr:'MK20DX256VLK7'; controllerunitstr:'MK20D7';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00040000;   srambase:$20000000; sramsize:$00008000),
+      (controllertypestr:'MK20DX256VLL7'; controllerunitstr:'MK20D7';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00040000;   srambase:$20000000; sramsize:$00008000),
+      (controllertypestr:'MK20DX256VMC7'; controllerunitstr:'MK20D7';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00040000;   srambase:$20000000; sramsize:$00008000),
+      (controllertypestr:'TEENSY31';      controllerunitstr:'MK20D7';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00040000;   srambase:$20000000; sramsize:$00008000),
+      (controllertypestr:'TEENSY32';      controllerunitstr:'MK20D7';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00040000;   srambase:$20000000; sramsize:$00008000),
+
+      (controllertypestr:'MK20DX64VLH7';  controllerunitstr:'MK20D7';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00010000;   srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'MK20DX64VLK7';  controllerunitstr:'MK20D7';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00010000;   srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'MK20DX64VMC7';  controllerunitstr:'MK20D7';  cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00010000;   srambase:$20000000; sramsize:$00002000),
+
+      (controllertypestr:'MK22FN512CAP12';controllerunitstr:'MK22F51212'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;   flashsize:$00080000;   srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'MK22FN512CBP12';controllerunitstr:'MK22F51212'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;   flashsize:$00080000;   srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'MK22FN512VDC12';controllerunitstr:'MK22F51212'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;   flashsize:$00080000;   srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'MK22FN512VLH12';controllerunitstr:'MK22F51212'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;   flashsize:$00080000;   srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'MK22FN512VLL12';controllerunitstr:'MK22F51212'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;   flashsize:$00080000;   srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'MK22FN512VMP12';controllerunitstr:'MK22F51212'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;   flashsize:$00080000;   srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'FREEDOM_K22F';  controllerunitstr:'MK22F51212'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;   flashsize:$00080000;   srambase:$20000000; sramsize:$00010000),
+
+      (controllertypestr:'MK64FN1M0VDC12';controllerunitstr:'MK64F12'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00100000;   srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'MK64FN1M0VLL12';controllerunitstr:'MK64F12'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00100000;   srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'FREEDOM_K64F';  controllerunitstr:'MK64F12'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00100000;   srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'MK64FN1M0VLQ12';controllerunitstr:'MK64F12'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00100000;   srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'MK64FN1M0VMD12';controllerunitstr:'MK64F12'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00100000;   srambase:$20000000; sramsize:$00030000),
+
+      (controllertypestr:'MK64FX512VDC12';controllerunitstr:'MK64F12'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00080000;   srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'MK64FX512VLL12';controllerunitstr:'MK64F12'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00080000;   srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'MK64FX512VLQ12';controllerunitstr:'MK64F12'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00080000;   srambase:$20000000; sramsize:$00020000),
+      (controllertypestr:'MK64FX512VMD12';controllerunitstr:'MK64F12'; cputype:cpu_armv7em; fputype:fpu_soft; flashbase:$00000000;      flashsize:$00080000;   srambase:$20000000; sramsize:$00020000),
+
+      { Atmel }
+      (controllertypestr:'ATSAM3X8E';     controllerunitstr:'SAM3X8E'; cputype:cpu_armv7m; fputype:fpu_soft; flashbase:$00080000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'ARDUINO_DUE';   controllerunitstr:'SAM3X8E'; cputype:cpu_armv7m; fputype:fpu_soft; flashbase:$00080000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'FLIP_N_CLICK';  controllerunitstr:'SAM3X8E'; cputype:cpu_armv7m; fputype:fpu_soft; flashbase:$00080000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
 
       { Bare bones }
       (controllertypestr:'THUMB2_BARE';	controllerunitstr:'THUMB2_BARE';	cputype:cpu_armv7m; fputype:fpu_soft; flashbase:$00000000;	flashsize:$00002000;	srambase:$20000000;	sramsize:$00000400)

compiler/arm/cpupara.pas

@@ -92,7 +92,7 @@ unit cpupara;
         psym:=tparavarsym(pd.paras[nr-1]);
         pdef:=psym.vardef;
         if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
-          pdef:=cpointerdef.getreusable(pdef);
+          pdef:=cpointerdef.getreusable_no_free(pdef);
         cgpara.reset;
         cgpara.size:=def_cgsize(pdef);
         cgpara.intsize:=tcgsize2size[cgpara.size];
@@ -378,7 +378,7 @@ unit cpupara;
 
             if push_addr_param(hp.varspez,paradef,p.proccalloption) then
               begin
-                paradef:=cpointerdef.getreusable(paradef);
+                paradef:=cpointerdef.getreusable_no_free(paradef);
                 loc:=LOC_REGISTER;
                 paracgsize := OS_ADDR;
                 paralen := tcgsize2size[OS_ADDR];
@@ -472,7 +472,7 @@ unit cpupara;
                             { LOC_REFERENCE always contains everything that's left }
                             paraloc^.loc:=LOC_REFERENCE;
                             paraloc^.size:=int_cgsize(paralen);
-                            paraloc^.def:=carraydef.getreusable(u8inttype,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;
@@ -546,7 +546,7 @@ unit cpupara;
                             { LOC_REFERENCE always contains everything that's left }
                             paraloc^.loc:=LOC_REFERENCE;
                             paraloc^.size:=int_cgsize(paralen);
-                            paraloc^.def:=carraydef.getreusable(u8inttype,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;
@@ -559,7 +559,7 @@ unit cpupara;
                         if push_addr_param(hp.varspez,paradef,p.proccalloption) then
                           begin
                             paraloc^.size:=OS_ADDR;
-                            paraloc^.def:=cpointerdef.getreusable(paradef);
+                            paraloc^.def:=cpointerdef.getreusable_no_free(paradef);
                             assignintreg
                           end
                         else

compiler/arm/narmset.pas

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

compiler/arm/raarmgas.pas

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

compiler/assemble.pas

@@ -735,7 +735,7 @@ Implementation
       begin
         DoPipe:=(cs_asm_pipe in current_settings.globalswitches) and
                 (([cs_asm_extern,cs_asm_leave,cs_link_on_target] * current_settings.globalswitches) = []) and
-                ((asminfo^.id in [as_gas,as_ggas,as_darwin,as_powerpc_xcoff,as_clang]));
+                ((asminfo^.id in [as_gas,as_ggas,as_darwin,as_powerpc_xcoff,as_clang,as_solaris_as]));
       end;
 
 
@@ -927,14 +927,22 @@ Implementation
              Replace(result,'$ASM',maybequoted(AsmFileName));
            Replace(result,'$OBJ',maybequoted(ObjFileName));
          end;
+
          if (cs_create_pic in current_settings.moduleswitches) then
            Replace(result,'$PIC','-KPIC')
          else
            Replace(result,'$PIC','');
+
          if (cs_asm_source in current_settings.globalswitches) then
            Replace(result,'$NOWARN','')
          else
            Replace(result,'$NOWARN','-W');
+
+         if target_info.endian=endian_little then
+           Replace(result,'$ENDIAN','-mlittle')
+         else
+           Replace(result,'$ENDIAN','-mbig');
+
          Replace(result,'$EXTRAOPT',asmextraopt);
       end;
 
@@ -1557,6 +1565,9 @@ Implementation
 {$ifdef ARM}
                    asd_thumb_func:
                      ObjData.ThumbFunc:=true;
+                   asd_code:
+                     { ai_directive(hp).name can be only 16 or 32, this is checked by the reader }
+                     ObjData.ThumbFunc:=tai_directive(hp).name='16';
 {$endif ARM}
                    else
                      internalerror(2010011101);
@@ -1700,6 +1711,9 @@ Implementation
                    asd_thumb_func:
                      { ignore for now, but should be added}
                      ;
+                   asd_code:
+                     { ignore for now, but should be added}
+                     ;
                    else
                      internalerror(2010011102);
                  end;
@@ -1861,6 +1875,15 @@ Implementation
                        internalerror(2015040601)
                      else
                        ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
+                   aitconst_seg:
+                     if assigned(tai_const(hp).sym) and (tai_const(hp).size=2) then
+                       ObjData.writereloc(0,2,Objdata.SymbolRef(tai_const(hp).sym),RELOC_SEG)
+                     else
+                       internalerror(2015110502);
+                   aitconst_dgroup:
+                     ObjData.writereloc(0,2,nil,RELOC_DGROUP);
+                   aitconst_fardataseg:
+                     ObjData.writereloc(0,2,nil,RELOC_FARDATASEG);
 {$endif i8086}
 {$ifdef arm}
                    aitconst_got:
@@ -1907,10 +1930,21 @@ Implementation
              ait_cutobject :
                if SmartAsm then
                 break;
-             ait_weak:
+             ait_directive :
                begin
-                 objsym:=ObjData.symbolref(tai_weak(hp).sym^);
-                 objsym.bind:=AB_WEAK_EXTERNAL;
+                 case tai_directive(hp).directive of
+                   asd_weak_definition,
+                   asd_weak_reference:
+                     begin
+                       objsym:=ObjData.symbolref(tai_directive(hp).name);
+                       if objsym.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL] then
+                         objsym.bind:=AB_WEAK_EXTERNAL
+                       else
+                         { TODO: should become a weak definition; for now, do
+                             the same as what was done for ait_weak }
+                         objsym.bind:=AB_WEAK_EXTERNAL;
+                     end
+                 end
                end;
              ait_symbolpair:
                begin

compiler/avr/aasmcpu.pas

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

compiler/avr/aoptcpu.pas

@@ -171,14 +171,19 @@ Implementation
                                     A_INC,A_LSL,A_LSR,
                                     A_OR,A_ORI,A_ROL,A_ROR,A_SBC,A_SBCI,A_SUB,A_SUBI]) and
               GetNextInstruction(p, hp1) and
-              MatchInstruction(hp1, A_CP) and
-              (((taicpu(p).oper[0]^.reg = taicpu(hp1).oper[0]^.reg) and
-                (taicpu(hp1).oper[1]^.reg = NR_R1)) or
-               ((taicpu(p).oper[0]^.reg = taicpu(hp1).oper[1]^.reg) and
-                (taicpu(hp1).oper[0]^.reg = NR_R1) and
-                (taicpu(p).opcode in [A_ADC,A_ADD,A_AND,A_ANDI,A_ASR,A_COM,A_EOR,
-                                      A_LSL,A_LSR,
-                                      A_OR,A_ORI,A_ROL,A_ROR]))) and
+              ((MatchInstruction(hp1, A_CP) and
+                (((taicpu(p).oper[0]^.reg = taicpu(hp1).oper[0]^.reg) and
+                  (taicpu(hp1).oper[1]^.reg = NR_R1)) or
+                 ((taicpu(p).oper[0]^.reg = taicpu(hp1).oper[1]^.reg) and
+                  (taicpu(hp1).oper[0]^.reg = NR_R1) and
+                  (taicpu(p).opcode in [A_ADC,A_ADD,A_AND,A_ANDI,A_ASR,A_COM,A_EOR,
+                                        A_LSL,A_LSR,
+                                        A_OR,A_ORI,A_ROL,A_ROR])))) or
+               (MatchInstruction(hp1, A_CPI) and
+                (taicpu(p).opcode = A_ANDI) and
+                (taicpu(p).oper[1]^.typ=top_const) and
+                (taicpu(hp1).oper[1]^.typ=top_const) and
+                (taicpu(p).oper[1]^.val=taicpu(hp1).oper[1]^.val))) and
               GetNextInstruction(hp1, hp2) and
               { be careful here, following instructions could use other flags
                 however after a jump fpc never depends on the value of flags }
@@ -203,6 +208,14 @@ Implementation
                   end;
                 }
 
+                // If we compare to the same value we are masking then invert the comparison
+                if (taicpu(hp1).opcode=A_CPI) then
+                  taicpu(hp2).condition:=inverse_cond(taicpu(hp2).condition);
+
+                asml.InsertBefore(tai_regalloc.alloc(NR_DEFAULTFLAGS,p), p);
+                asml.InsertAfter(tai_regalloc.dealloc(NR_DEFAULTFLAGS,hp2), hp2);
+                IncludeRegInUsedRegs(NR_DEFAULTFLAGS,UsedRegs);
+
                 DebugMsg('Peephole OpCp2Op performed', p);
 
                 asml.remove(hp1);
@@ -584,6 +597,7 @@ Implementation
                        (not RegModifiedBetween(taicpu(p).oper[1]^.reg, p, hp1)) and
                        (hp1.typ = ait_instruction) and
                        (taicpu(hp1).opcode in [A_PUSH,A_MOV,A_CP,A_CPC,A_ADD,A_SUB,A_ADC,A_SBC,A_EOR,A_AND,A_OR,
+                                               A_STD,A_ST,
                                                A_OUT,A_IN]) and
                        RegInInstruction(taicpu(p).oper[0]^.reg, hp1) and
                        (not RegModifiedByInstruction(taicpu(p).oper[0]^.reg, hp1)) and

compiler/avr/cgcpu.pas

@@ -308,16 +308,19 @@ unit cgcpu;
       var
         i : longint;
         hp : PCGParaLocation;
+        ref: treference;
       begin
         if not(tcgsize2size[paraloc.Size] in [1..4]) then
           internalerror(2014011101);
 
         hp:=paraloc.location;
 
-        for i:=1 to tcgsize2size[paraloc.Size] do
+        i:=1;
+        while i<=tcgsize2size[paraloc.Size] do
           begin
             if not(assigned(hp)) then
               internalerror(2014011105);
+             //paramanager.allocparaloc(list,hp);
              case hp^.loc of
                LOC_REGISTER,LOC_CREGISTER:
                  begin
@@ -325,10 +328,20 @@ unit cgcpu;
                      (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:
-                 list.concat(taicpu.op_const(A_PUSH,(a shr (8*(i-1))) and $ff));
+                 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);
             end;
@@ -389,11 +402,18 @@ unit cgcpu;
 
 
     procedure tcgavr.a_call_name(list : TAsmList;const s : string; weak: boolean);
+      var
+        sym: TAsmSymbol;
       begin
+        if weak then
+          sym:=current_asmdata.WeakRefAsmSymbol(s)
+        else
+          sym:=current_asmdata.RefAsmSymbol(s);
+
         if CPUAVR_HAS_JMP_CALL in cpu_capabilities[current_settings.cputype] then
-          list.concat(taicpu.op_sym(A_CALL,current_asmdata.RefAsmSymbol(s)))
+          list.concat(taicpu.op_sym(A_CALL,sym))
         else
-          list.concat(taicpu.op_sym(A_RCALL,current_asmdata.RefAsmSymbol(s)));
+          list.concat(taicpu.op_sym(A_RCALL,sym));
 
         include(current_procinfo.flags,pi_do_call);
       end;
@@ -765,7 +785,8 @@ unit cgcpu;
              begin
                for i:=1 to tcgsize2size[size] do
                  begin
-                   list.concat(taicpu.op_reg_const(A_ORI,reg,(qword(a) and mask) shr shift));
+                   if ((qword(a) and mask) shr shift)<>0 then
+                     list.concat(taicpu.op_reg_const(A_ORI,reg,(qword(a) and mask) shr shift));
                    NextReg;
                    mask:=mask shl 8;
                    inc(shift,8);
@@ -775,7 +796,10 @@ unit cgcpu;
              begin
                for i:=1 to tcgsize2size[size] do
                  begin
-                   list.concat(taicpu.op_reg_const(A_ANDI,reg,(qword(a) and mask) shr shift));
+                   if ((qword(a) and mask) shr shift)=0 then
+                     list.concat(taicpu.op_reg_reg(A_MOV,reg,NR_R1))
+                   else
+                     list.concat(taicpu.op_reg_const(A_ANDI,reg,(qword(a) and mask) shr shift));
                    NextReg;
                    mask:=mask shl 8;
                    inc(shift,8);
@@ -783,7 +807,10 @@ unit cgcpu;
              end;
            OP_SUB:
              begin
-               list.concat(taicpu.op_reg_const(A_SUBI,reg,a and mask));
+               if ((a and mask)=1) and (tcgsize2size[size]=1) then
+                 list.concat(taicpu.op_reg(A_DEC,reg))
+               else
+                 list.concat(taicpu.op_reg_const(A_SUBI,reg,a and mask));
                if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then
                  begin
                    for i:=2 to tcgsize2size[size] do
@@ -871,6 +898,8 @@ unit cgcpu;
                curvalue:=a and mask;
                if curvalue=0 then
                  list.concat(taicpu.op_reg_reg(A_ADD,reg,NR_R1))
+               else if (curvalue=1) and (tcgsize2size[size]=1) then
+                 list.concat(taicpu.op_reg(A_INC,reg))
                else
                  begin
                    tmpreg:=getintregister(list,OS_8);
@@ -946,7 +975,12 @@ unit cgcpu;
              if ((qword(a) and mask) shr shift)=0 then
                emit_mov(list,reg,NR_R1)
              else
-               list.concat(taicpu.op_reg_const(A_LDI,reg,(qword(a) and mask) shr shift));
+               begin
+                 getcpuregister(list,NR_R26);
+                 list.concat(taicpu.op_reg_const(A_LDI,NR_R26,(qword(a) and mask) shr shift));
+                 a_load_reg_reg(list,OS_8,OS_8,NR_R26,reg);
+                 ungetcpuregister(list,NR_R26);
+               end;
 
              mask:=mask shl 8;
              inc(shift,8);
@@ -1565,17 +1599,17 @@ unit cgcpu;
             end;
 
             if swapped then
-              list.concat(taicpu.op_reg_reg(A_CP,reg,NR_R1))
+              list.concat(taicpu.op_reg_reg(A_CP,NR_R1,reg))
             else
-              list.concat(taicpu.op_reg_reg(A_CP,NR_R1,reg));
+              list.concat(taicpu.op_reg_reg(A_CP,reg,NR_R1));
 
             for i:=2 to tcgsize2size[size] do
               begin
                 reg:=GetNextReg(reg);
                 if swapped then
-                  list.concat(taicpu.op_reg_reg(A_CPC,reg,NR_R1))
+                  list.concat(taicpu.op_reg_reg(A_CPC,NR_R1,reg))
                 else
-                  list.concat(taicpu.op_reg_reg(A_CPC,NR_R1,reg));
+                  list.concat(taicpu.op_reg_reg(A_CPC,reg,NR_R1));
               end;
 
             a_jmp_cond(list,cmp_op,l);

compiler/avr/cpuinfo.pas

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

compiler/avr/cpunode.pas

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

compiler/avr/cpupara.pas

@@ -255,7 +255,7 @@ unit cpupara;
 
             if push_addr_param(hp.varspez,paradef,p.proccalloption) then
               begin
-                paradef:=cpointerdef.getreusable(paradef);
+                paradef:=cpointerdef.getreusable_no_free(paradef);
                 loc:=LOC_REGISTER;
                 paracgsize:=OS_ADDR;
                 paralen:=tcgsize2size[OS_ADDR];
@@ -353,7 +353,7 @@ unit cpupara;
                         if push_addr_param(hp.varspez,paradef,p.proccalloption) then
                           begin
                             paraloc^.size:=OS_ADDR;
-                            paraloc^.def:=cpointerdef.getreusable(paradef);
+                            paraloc^.def:=cpointerdef.getreusable_no_free(paradef);
                             assignintreg
                           end
                         else

compiler/avr/navrutil.pas

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

compiler/blockutl.pas

@@ -160,9 +160,9 @@ implementation
       { must be a valid Pascal identifier, because we will reference it when
         constructing the block initialiser }
       { we don't have to include the moduleid in this mangledname, because
-        the invokepd is a local procedure in the current unit -> defid by
-        itself is unique }
-      name:='__FPC_BLOCK_DESCRIPTOR_SIMPLE_'+tostr(invokepd.defid);
+        the invokepd is a local procedure in the current unit -> unique_id_str
+        by itself is unique }
+      name:='__FPC_BLOCK_DESCRIPTOR_SIMPLE_'+invokepd.unique_id_str;
       { already exists -> return }
       if searchsym(name,srsym,srsymtable) then
         begin
@@ -174,7 +174,7 @@ implementation
       { find the type of the descriptor structure }
       descriptordef:=search_named_unit_globaltype('BLOCKRTL','FPC_BLOCK_DESCRIPTOR_SIMPLE',true).typedef;
       { create new static variable }
-      descriptor:=cstaticvarsym.create(name,vs_value,descriptordef,[]);
+      descriptor:=cstaticvarsym.create(name,vs_value,descriptordef,[],true);
       symtablestack.top.insert(descriptor);
       include(descriptor.symoptions,sp_internal);
       { create typed constant for the descriptor }
@@ -196,7 +196,7 @@ implementation
     begin
       { the copy() is to ensure we don't overflow the maximum identifier length;
         the combination of owner.moduleid and defid will make the name unique }
-      wrappername:='__FPC_BLOCK_INVOKE_'+upper(copy(orgpd.procsym.realname,1,60))+'_'+tostr(orgpd.owner.moduleid)+'_'+tostr(orgpd.defid);
+      wrappername:='__FPC_BLOCK_INVOKE_'+upper(copy(orgpd.procsym.realname,1,60))+'_'+tostr(orgpd.owner.moduleid)+'_'+orgpd.unique_id_str;
       { already an invoke wrapper for this procsym -> reuse }
       if searchsym(wrappername,srsym,srsymtable) then
         begin
@@ -253,7 +253,7 @@ implementation
       result:=cstaticvarsym.create(
         '$'+literalname,
         vs_value,
-        blockliteraldef,[]);
+        blockliteraldef,[],true);
       include(result.symoptions,sp_internal);
       symtablestack.top.insert(result);
       { initialise it }

compiler/cclasses.pas

@@ -2881,7 +2881,7 @@ end;
         h: LongWord;
       begin
         h := FPHash(Key, KeyLen);
-        Entry := @FBucket[h mod FBucketCount];
+        Entry := @FBucket[h and (FBucketCount-1)];
         while Assigned(Entry^) and
           not ((Entry^^.HashValue = h) and (Entry^^.KeyLength = KeyLen) and
             (CompareByte(Entry^^.Key^, Key^, KeyLen) = 0)) do
@@ -2900,7 +2900,7 @@ end;
           end
         else
           begin
-            New(Result);
+            GetMem(Result,SizeOfItem);
             if FOwnsKeys then
             begin
               GetMem(Result^.Key, KeyLen);
@@ -2924,13 +2924,13 @@ end;
         i: Integer;
         e, n: PHashSetItem;
       begin
-        p := AllocMem(NewCapacity * SizeOfItem);
+        p := AllocMem(NewCapacity * SizeOf(PHashSetItem));
         for i := 0 to FBucketCount-1 do
           begin
             e := FBucket[i];
             while Assigned(e) do
             begin
-              chain := @p[e^.HashValue mod NewCapacity];
+              chain := @p[e^.HashValue and (NewCapacity-1)];
               n := e^.Next;
               e^.Next := chain^;
               chain^ := e;
@@ -2988,7 +2988,7 @@ end;
         h: LongWord;
       begin
         h := FPHash(Key, KeyLen, Tag);
-        Entry := @PPTagHashSetItem(FBucket)[h mod FBucketCount];
+        Entry := @PPTagHashSetItem(FBucket)[h and (FBucketCount-1)];
         while Assigned(Entry^) and
           not ((Entry^^.HashValue = h) and (Entry^^.KeyLength = KeyLen) and
             (Entry^^.Tag = Tag) and (CompareByte(Entry^^.Key^, Key^, KeyLen) = 0)) do
@@ -3007,7 +3007,7 @@ end;
           end
         else
           begin
-            New(Result);
+            Getmem(Result,SizeOfItem);
             if FOwnsKeys then
             begin
               GetMem(Result^.Key, KeyLen);

compiler/cfileutl.pas

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

compiler/cg64f32.pas

@@ -931,7 +931,7 @@ unit cg64f32;
              { if the high dword = 0, the low dword can be considered a }
              { simple cardinal                                          }
              cg.a_label(list,poslabel);
-             hdef:=corddef.create(u32bit,0,$ffffffff);
+             hdef:=corddef.create(u32bit,0,$ffffffff,false);
 
              location_copy(temploc,l);
              temploc.size:=OS_32;
@@ -944,7 +944,7 @@ unit cg64f32;
                end;
 
              hlcg.g_rangecheck(list,temploc,hdef,todef);
-             hdef.owner.deletedef(hdef);
+             hdef.free;
 
              if from_signed and to_signed then
                begin
@@ -971,11 +971,11 @@ unit cg64f32;
                  { if we get here, the 64bit value lies between }
                  { longint($80000000) and -1 (JM)               }
                  cg.a_label(list,neglabel);
-                 hdef:=corddef.create(s32bit,int64(longint($80000000)),int64(-1));
+                 hdef:=corddef.create(s32bit,int64(longint($80000000)),int64(-1),false);
                  location_copy(temploc,l);
                  temploc.size:=OS_32;
                  hlcg.g_rangecheck(list,temploc,hdef,todef);
-                 hdef.owner.deletedef(hdef);
+                 hdef.free;
                  cg.a_label(list,endlabel);
                end;
            end

compiler/cgobj.pas

@@ -1096,8 +1096,12 @@ implementation
                cgsize:=paraloc.size;
                if paraloc.shiftval>0 then
                  a_op_const_reg_reg(list,OP_SHL,OS_INT,paraloc.shiftval,paraloc.register,paraloc.register)
+               { in case the original size was 3 or 5/6/7 bytes, the value was
+                 shifted to the top of the to 4 resp. 8 byte register on the
+                 caller side and needs to be stored with those bytes at the
+                 start of the reference -> don't shift right }
                else if (paraloc.shiftval<0) and
-                       (sizeleft in [1,2,4]) then
+                       ((-paraloc.shiftval) in [1,2,4]) then
                  begin
                    a_op_const_reg_reg(list,OP_SHR,OS_INT,-paraloc.shiftval,paraloc.register,paraloc.register);
                    { convert to a register of 1/2/4 bytes in size, since the

compiler/constexp.pas

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

compiler/cresstr.pas

@@ -37,7 +37,7 @@ uses
 {$endif}
    cclasses,widestr,
    cutils,globtype,globals,systems,
-   symbase,symconst,symtype,symdef,symsym,
+   symbase,symconst,symtype,symdef,symsym,symtable,
    verbose,fmodule,ppu,
    aasmbase,aasmtai,aasmdata,aasmcnst,
    aasmcpu;
@@ -133,39 +133,36 @@ uses
       Var
         namelab,
         valuelab : tasmlabofs;
-        resstrlab : tasmsymbol;
-        endsymlab : tasmsymbol;
         R : TResourceStringItem;
+        resstrdef: tdef;
         tcb : ttai_typedconstbuilder;
       begin
+        resstrdef:=search_system_type('TRESOURCESTRINGRECORD').typedef;
+
         { Put resourcestrings in a new objectfile. Putting it in multiple files
           makes the linking too dependent on the linker script requiring a SORT(*) for
           the data sections }
-        tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable,tcalo_new_section]);
-        maybe_new_object_file(current_asmdata.asmlists[al_const]);
-        new_section(current_asmdata.asmlists[al_const],sec_rodata_norel,make_mangledname('RESSTRTABLE',current_module.localsymtable,''),sizeof(pint));
-
-        maybe_new_object_file(current_asmdata.asmlists[al_resourcestrings]);
-        new_section(current_asmdata.asmlists[al_resourcestrings],sec_data,make_mangledname('RESSTR',current_module.localsymtable,'1_START'),sizeof(pint));
-        current_asmdata.AsmLists[al_resourcestrings].concat(tai_symbol.createname_global(
-          make_mangledname('RESSTR',current_module.localsymtable,'START'),AT_DATA,0));
-
+        tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable,tcalo_new_section,tcalo_vectorized_dead_strip_start]);
         { Write unitname entry }
+        tcb.maybe_begin_aggregate(resstrdef);
         namelab:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_const],@current_module.localsymtable.name^[1],length(current_module.localsymtable.name^),getansistringcodepage);
-        current_asmdata.asmlists[al_resourcestrings].concat(tai_const.Create_sym_offset(namelab.lab,namelab.ofs));
-        current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_nil_dataptr);
-        current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_nil_dataptr);
-        current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_32bit(0));
-{$ifdef cpu64bitaddr}
-        current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_32bit(0));
-{$endif cpu64bitaddr}
+        tcb.emit_string_offset(namelab,length(current_module.localsymtable.name^),st_ansistring,false,charpointertype);
+        tcb.emit_tai(tai_const.create_nil_dataptr,cansistringtype);
+        tcb.emit_tai(tai_const.create_nil_dataptr,cansistringtype);
+        tcb.emit_ord_const(0,u32inttype);
+        tcb.maybe_end_aggregate(resstrdef);
+        current_asmdata.asmlists[al_resourcestrings].concatList(
+          tcb.get_final_asmlist_vectorized_dead_strip(
+            resstrdef,'RESSTR','',current_module.localsymtable,sizeof(pint)
+          )
+        );
+        tcb.free;
 
         { Add entries }
         R:=TResourceStringItem(List.First);
         while assigned(R) do
           begin
-            new_section(current_asmdata.asmlists[al_const],sec_rodata_norel,make_mangledname('RESSTR',current_module.localsymtable,'d_'+r.name),sizeof(pint));
-            { Write default value }
+            tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_vectorized_dead_strip_item]);
             if assigned(R.value) and (R.len<>0) then
               valuelab:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_const],R.Value,R.Len,getansistringcodepage)
             else
@@ -173,10 +170,8 @@ uses
                 valuelab.lab:=nil;
                 valuelab.ofs:=0;
               end;
-            { Append the name as a ansistring. }
             current_asmdata.asmlists[al_const].concat(cai_align.Create(const_align(sizeof(pint))));
             namelab:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_const],@R.Name[1],length(R.name),getansistringcodepage);
-
             {
               Resourcestring index:
                   TResourceStringRecord = Packed Record
@@ -186,35 +181,30 @@ uses
                      HashValue    : LongWord;
                    end;
             }
-            new_section(current_asmdata.asmlists[al_resourcestrings],sec_data,make_mangledname('RESSTR',current_module.localsymtable,'2_'+r.name),sizeof(pint));
-            resstrlab:=current_asmdata.DefineAsmSymbol(make_mangledname('RESSTR',R.Sym.owner,R.Sym.name),AB_GLOBAL,AT_DATA);
-            current_asmdata.asmlists[al_resourcestrings].concat(tai_symbol.Create_global(resstrlab,0));
-            current_asmdata.asmlists[al_resourcestrings].concat(tai_const.Create_sym_offset(namelab.lab,namelab.ofs));
-            current_asmdata.asmlists[al_resourcestrings].concat(tai_const.Create_sym_offset(valuelab.lab,valuelab.ofs));
-            current_asmdata.asmlists[al_resourcestrings].concat(tai_const.Create_sym_offset(valuelab.lab,valuelab.ofs));
-            current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_32bit(longint(R.Hash)));
-{$ifdef cpu64bitaddr}
-            current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_32bit(0));
-{$endif cpu64bitaddr}
-            current_asmdata.asmlists[al_resourcestrings].concat(tai_symbol_end.create(resstrlab));
+            tcb.maybe_begin_aggregate(resstrdef);
+            tcb.emit_string_offset(namelab,length(current_module.localsymtable.name^),st_ansistring,false,charpointertype);
+            tcb.emit_string_offset(valuelab,R.Len,st_ansistring,false,charpointertype);
+            tcb.emit_string_offset(valuelab,R.Len,st_ansistring,false,charpointertype);
+            tcb.emit_ord_const(R.hash,u32inttype);
+            tcb.maybe_end_aggregate(resstrdef);
+            current_asmdata.asmlists[al_resourcestrings].concatList(
+              tcb.get_final_asmlist_vectorized_dead_strip(
+                resstrdef,'RESSTR',R.Sym.Name,R.Sym.Owner,sizeof(pint))
+            );
             R:=TResourceStringItem(R.Next);
+            tcb.free;
           end;
-        { nothing has been emited to the tcb itself }
+        tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_vectorized_dead_strip_end]);
+        tcb.begin_anonymous_record(internaltypeprefixName[itp_emptyrec],
+          default_settings.packrecords,sizeof(pint),
+          targetinfos[target_info.system]^.alignment.recordalignmin,
+          targetinfos[target_info.system]^.alignment.maxCrecordalign);
+        current_asmdata.AsmLists[al_resourcestrings].concatList(
+          tcb.get_final_asmlist_vectorized_dead_strip(
+            tcb.end_anonymous_record,'RESSTR','',current_module.localsymtable,sizeof(pint)
+          )
+        );
         tcb.free;
-        new_section(current_asmdata.asmlists[al_resourcestrings],sec_data,make_mangledname('RESSTR',current_module.localsymtable,'3_END'),sizeof(pint));
-        endsymlab:=current_asmdata.DefineAsmSymbol(make_mangledname('RESSTR',current_module.localsymtable,'END'),AB_GLOBAL,AT_DATA);
-        current_asmdata.AsmLists[al_resourcestrings].concat(tai_symbol.create_global(endsymlab,0));
-        { The darwin/ppc64 assembler or linker seems to have trouble       }
-        { if a section ends with a global label without any data after it. }
-        { So for safety, just put a dummy value here.                      }
-        { Further, the regular linker also kills this symbol when turning  }
-        { on smart linking in case no value appears after it, so put the   }
-        { dummy byte there always                                          }
-        { Update: the Mac OS X 10.6 linker orders data that needs to be    }
-        { relocated before all other data, so make this data relocatable,  }
-        { otherwise the end label won't be moved with the rest             }
-        if (target_info.system in (systems_darwin+systems_aix)) then
-          current_asmdata.asmlists[al_resourcestrings].concat(Tai_const.create_sym(endsymlab));
       end;
 
     procedure Tresourcestrings.WriteRSJFile;

compiler/cstreams.pas

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

compiler/dbgdwarf.pas

@@ -276,6 +276,17 @@ interface
         bit8: boolean;
       end;
 
+      TDwarfHashSetItem = record
+        HashSetItem: THashSetItem;
+        lab, ref_lab: tasmsymbol;
+        struct_lab: tasmsymbol;
+      end;
+      PDwarfHashSetItem = ^TDwarfHashSetItem;
+
+      TDwarfLabHashSet = class(THashSet)
+        class function SizeOfItem: Integer; override;
+      end;
+
       { TDebugInfoDwarf }
 
       TDebugInfoDwarf = class(TDebugInfo)
@@ -293,6 +304,9 @@ interface
         loclist: tdynamicarray;
         asmline: TAsmList;
 
+        { lookup table for def -> DWARF-labels }
+        dwarflabels: TDwarfLabHashSet;
+
         // The current entry in dwarf_info with the link to the abbrev-section
         dwarf_info_abbref_tai: tai_const;
         // Empty start-item of the abbrev-searchtree
@@ -328,7 +342,7 @@ interface
         procedure set_use_64bit_headers(state: boolean);
         property use_64bit_headers: Boolean read _use_64bit_headers write set_use_64bit_headers;
 
-        procedure set_def_dwarf_labs(def:tdef);
+        function get_def_dwarf_labs(def:tdef): PDwarfHashSetItem;
 
         { Convenience version of the method below, so the compiler creates the
           tvarrec for us (must only pass one element in the last parameter).  }
@@ -719,6 +733,16 @@ implementation
         Dispose(SI);
       end;
 
+
+{****************************************************************************
+                              TDwarfLabHashSet
+****************************************************************************}
+
+    class function TDwarfLabHashSet.SizeOfItem: Integer;
+      begin
+        Result:=sizeof(TDwarfHashSetItem);
+      end;
+
 {****************************************************************************
                               TDirIndexItem
 ****************************************************************************}
@@ -915,7 +939,9 @@ implementation
       end;
 
 
-    procedure TDebugInfoDwarf.set_def_dwarf_labs(def:tdef);
+    function TDebugInfoDwarf.get_def_dwarf_labs(def:tdef): PDwarfHashSetItem;
+      var
+        needstructdeflab: boolean;
       begin
         { Keep track of used dwarf entries, this info is only useful for dwarf entries
           referenced by the symbols. Definitions will always include all
@@ -923,18 +949,23 @@ implementation
         if def.dbg_state=dbg_state_unused then
           def.dbg_state:=dbg_state_used;
         { Need a new label? }
-        if not assigned(def.dwarf_lab) then
+        result:=PDwarfHashSetItem(dwarflabels.FindOrAdd(@def,sizeof(def)));
+        { the other fields besides  Data are not initialised }
+        if not assigned(result^.HashSetItem.Data) then
           begin
+            { Mark as initialised }
+            result^.HashSetItem.Data:=self;
+            needstructdeflab:=is_implicit_pointer_object_type(def);
             if not(tf_dwarf_only_local_labels in target_info.flags) then
               begin
                 if (ds_dwarf_dbg_info_written in def.defstates) then
                   begin
                     if not assigned(def.typesym) then
                       internalerror(200610011);
-                    def.dwarf_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym, true)),AT_DATA);
-                    def.dwarf_ref_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym, true)),AT_DATA);
-                    if is_class_or_interface_or_dispinterface(def) or is_objectpascal_helper(def) then
-                      tobjectdef(def).dwarf_struct_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym, true)),AT_DATA);
+                    result^.lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym, true)),AT_DATA);
+                    result^.ref_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym, true)),AT_DATA);
+                    if needstructdeflab then
+                      result^.struct_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym, true)),AT_DATA);
                     def.dbg_state:=dbg_state_written;
                   end
                 else
@@ -945,20 +976,20 @@ implementation
                        (def.owner.symtabletype=globalsymtable) and
                        (def.owner.iscurrentunit) then
                       begin
-                        def.dwarf_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_DATA);
-                        def.dwarf_ref_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_DATA);
-                        if is_class_or_interface_or_dispinterface(def) or is_objectpascal_helper(def) then
-                          tobjectdef(def).dwarf_struct_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_DATA);
+                        result^.lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_DATA);
+                        result^.ref_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_DATA);
+                        if needstructdeflab then
+                          result^.struct_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_DATA);
                         include(def.defstates,ds_dwarf_dbg_info_written);
                       end
                     else
                       begin
                         { The pointer typecast is needed to prevent a problem with range checking
                           on when the typecast is changed to 'as' }
-                        current_asmdata.getglobaldatalabel(TAsmLabel(pointer(def.dwarf_lab)));
-                        current_asmdata.getglobaldatalabel(TAsmLabel(pointer(def.dwarf_ref_lab)));
-                        if is_implicit_pointer_object_type(def) then
-                          current_asmdata.getglobaldatalabel(TAsmLabel(pointer(tobjectdef(def).dwarf_struct_lab)));
+                        current_asmdata.getglobaldatalabel(TAsmLabel(pointer(result^.lab)));
+                        current_asmdata.getglobaldatalabel(TAsmLabel(pointer(result^.ref_lab)));
+                        if needstructdeflab then
+                          current_asmdata.getglobaldatalabel(TAsmLabel(pointer(result^.struct_lab)));
                       end;
                   end;
               end
@@ -967,10 +998,10 @@ implementation
                 { The pointer typecast is needed to prevent a problem with range checking
                   on when the typecast is changed to 'as' }
                 { addrlabel instead of datalabel because it must be a local one }
-                current_asmdata.getaddrlabel(TAsmLabel(pointer(def.dwarf_lab)));
-                current_asmdata.getaddrlabel(TAsmLabel(pointer(def.dwarf_ref_lab)));
-                if is_implicit_pointer_object_type(def) then
-                  current_asmdata.getaddrlabel(TAsmLabel(pointer(tobjectdef(def).dwarf_struct_lab)));
+                current_asmdata.getaddrlabel(TAsmLabel(pointer(result^.lab)));
+                current_asmdata.getaddrlabel(TAsmLabel(pointer(result^.ref_lab)));
+                if needstructdeflab then
+                  current_asmdata.getaddrlabel(TAsmLabel(pointer(result^.struct_lab)));
               end;
             if def.dbg_state=dbg_state_used then
               deftowritelist.Add(def);
@@ -980,20 +1011,17 @@ implementation
 
     function TDebugInfoDwarf.def_dwarf_lab(def: tdef): tasmsymbol;
       begin
-        set_def_dwarf_labs(def);
-        result:=def.dwarf_lab;
+        result:=get_def_dwarf_labs(def)^.lab;
       end;
 
     function TDebugInfoDwarf.def_dwarf_class_struct_lab(def: tobjectdef): tasmsymbol;
       begin
-        set_def_dwarf_labs(def);
-        result:=def.dwarf_struct_lab;
+        result:=get_def_dwarf_labs(def)^.struct_lab;
       end;
 
     function TDebugInfoDwarf.def_dwarf_ref_lab(def: tdef): tasmsymbol;
       begin
-        set_def_dwarf_labs(def);
-        result:=def.dwarf_ref_lab;
+        result:=get_def_dwarf_labs(def)^.ref_lab;
       end;
 
     constructor TDebugInfoDwarf.Create;
@@ -1529,6 +1557,24 @@ implementation
                 ]);
               finish_entry;
             end;
+          u128bit:
+            begin
+              append_entry(DW_TAG_base_type,false,[
+                DW_AT_name,DW_FORM_string,'Int128'#0,
+                DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
+                DW_AT_byte_size,DW_FORM_data1,16
+                ]);
+              finish_entry;
+            end;
+          s128bit:
+            begin
+              append_entry(DW_TAG_base_type,false,[
+                DW_AT_name,DW_FORM_string,'Int128'#0,
+                DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
+                DW_AT_byte_size,DW_FORM_data1,16
+                ]);
+              finish_entry;
+            end;
           else
             internalerror(200601287);
         end;
@@ -3117,6 +3163,15 @@ implementation
         storefilepos:=current_filepos;
         current_filepos:=current_module.mainfilepos;
 
+        if assigned(dwarflabels) then
+          internalerror(2015100301);
+        { one item per def, plus some extra space in case of nested types,
+          externally used types etc (it will grow further if necessary) }
+        i:=current_module.localsymtable.DefList.count*4;
+        if assigned(current_module.globalsymtable) then
+          inc(i,current_module.globalsymtable.DefList.count*2);
+        dwarflabels:=TDwarfLabHashSet.Create(i,true,false);
+
         currabbrevnumber:=0;
 
         defnumberlist:=TFPObjectList.create(false);
@@ -3231,16 +3286,15 @@ implementation
         { end of abbrev table }
         current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
 
-        { reset all def labels }
+        { reset all def debug states }
         for i:=0 to defnumberlist.count-1 do
           begin
             def := tdef(defnumberlist[i]);
             if assigned(def) then
-              begin
-                def.dwarf_lab:=nil;
-                def.dbg_state:=dbg_state_unused;
-              end;
+              def.dbg_state:=dbg_state_unused;
           end;
+        dwarflabels.free;
+        dwarflabels:=nil;
 
         defnumberlist.free;
         defnumberlist:=nil;
@@ -3436,7 +3490,9 @@ implementation
                     if (prevlabel = nil) or
                        { darwin's assembler cannot create an uleb128 of the difference }
                        { between to symbols                                            }
-                       (target_info.system in systems_darwin) then
+                       { same goes for Solaris native assembler                        }
+                       (target_info.system in systems_darwin) or
+                       (target_asm.id=as_solaris_as) then
                       begin
                         asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
                         asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint)));

compiler/dbgstabs.pas

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

compiler/defcmp.pas

@@ -193,8 +193,8 @@ implementation
       const
         basedeftbl:array[tordtype] of tbasedef =
           (bvoid,
-           bint,bint,bint,bint,
-           bint,bint,bint,bint,
+           bint,bint,bint,bint,bint,
+           bint,bint,bint,bint,bint,
            bbool,bbool,bbool,bbool,
            bbool,bbool,bbool,bbool,
            bchar,bchar,bint);
@@ -990,11 +990,16 @@ implementation
                                       eq:=te_convert_l1;
                                     end
                                   else
-                                   if (subeq>te_incompatible) then
-                                    begin
-                                      doconv:=hct;
-                                      eq:=te_convert_l2;
-                                    end;
+                                    { an array constructor is not an open array, so
+                                      use a lower level of compatibility than that one of
+                                      of the elements }
+                                    if subeq>te_convert_l6 then
+                                     begin
+                                       doconv:=hct;
+                                       eq:=pred(subeq);
+                                     end
+                                   else
+                                     eq:=subeq;
                                 end;
                              end
                             else
@@ -1339,18 +1344,16 @@ implementation
                    end;
                  pointerdef :
                    begin
-{$ifdef x86}
                      { check for far pointers }
-                     if (tcpupointerdef(def_from).x86pointertyp<>tcpupointerdef(def_to).x86pointertyp) then
+                     if not tpointerdef(def_from).compatible_with_pointerdef_size(tpointerdef(def_to)) then
                        begin
                          if fromtreetype=niln then
                            eq:=te_equal
                          else
                            eq:=te_incompatible;
                        end
+                     { the types can be forward type, handle before normal type check !! }
                      else
-{$endif x86}
-                      { the types can be forward type, handle before normal type check !! }
                       if assigned(def_to.typesym) and
                          ((tpointerdef(def_to).pointeddef.typ=forwarddef) or
                           (tpointerdef(def_from).pointeddef.typ=forwarddef)) then
@@ -1422,7 +1425,7 @@ implementation
                        this is not allowed for complex procvars }
                      if (is_void(tpointerdef(def_to).pointeddef) or
                          (m_mac_procvar in current_settings.modeswitches)) and
-                        tprocvardef(def_from).is_addressonly then
+                        tprocvardef(def_from).compatible_with_pointerdef_size(tpointerdef(def_to)) then
                       begin
                         doconv:=tc_equal;
                         eq:=te_convert_l1;
@@ -1433,7 +1436,7 @@ implementation
                      { procedure variable can be assigned to an void pointer,
                        this not allowed for methodpointers }
                      if (m_mac_procvar in current_settings.modeswitches) and
-                        tprocdef(def_from).is_addressonly then
+                        tprocdef(def_from).compatible_with_pointerdef_size(tpointerdef(def_to)) then
                       begin
                         doconv:=tc_proc_2_procvar;
                         eq:=te_convert_l2;
@@ -2228,6 +2231,7 @@ implementation
          { check for method pointer and local procedure pointer:
              a) anything but procvars can be assigned to blocks
              b) if one is a procedure of object, the other also has to be one
+                ("object static procedure" is equal to procedure as well)
                 (except for block)
              c) if one is a pure address, the other also has to be one
                 except if def1 is a global proc and def2 is a nested procdef
@@ -2244,7 +2248,9 @@ implementation
            { can't explicitly check against procvars here, because
              def1 may already be a procvar due to a proc_to_procvar;
              this is checked in the type conversion node itself -> ok }
-         else if (def1.is_methodpointer<>def2.is_methodpointer) or  { b) }
+         else if
+            ((def1.is_methodpointer and not (po_staticmethod in def1.procoptions))<> { b) }
+             (def2.is_methodpointer and not (po_staticmethod in def2.procoptions))) or
             ((def1.is_addressonly<>def2.is_addressonly) and         { c) }
              (is_nested_pd(def1) or
               not is_nested_pd(def2))) or
@@ -2263,7 +2269,7 @@ implementation
          { check return value and options, methodpointer is already checked }
          po_comp:=[po_interrupt,po_iocheck,po_varargs];
          { check static only if we compare method pointers }
-         if def1.is_methodpointer then
+         if def1.is_methodpointer and def2.is_methodpointer then
            include(po_comp,po_staticmethod);
          if (m_delphi in current_settings.modeswitches) then
            exclude(po_comp,po_varargs);

compiler/entfile.pas

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

compiler/export.pas

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

compiler/expunix.pas

@@ -88,7 +88,7 @@ var
   hp2 : texported_item;
 begin
   { first test the index value }
-  if (hp.options and eo_index)<>0 then
+  if eo_index in hp.options then
    begin
      Message1(parser_e_no_export_with_index_for_target,target_info.shortname);
      exit;
@@ -102,7 +102,7 @@ begin
   if assigned(hp2) and (hp2.name^=hp.name^) then
     begin
       { this is not allowed !! }
-      Message1(parser_e_export_name_double,hp.name^);
+      duplicatesymbol(hp.name^);
       exit;
     end;
   if hp2=texported_item(current_module._exports.first) then
@@ -142,6 +142,7 @@ begin
   while assigned(hp2) do
    begin
      if (not hp2.is_var) and
+        assigned(hp2.sym) and
         (hp2.sym.typ=procsym) then
       begin
         { the manglednames can already be the same when the procedure

compiler/fmodule.pas

@@ -1038,6 +1038,38 @@ implementation
             macrosymtablestack.free;
             macrosymtablestack:=nil;
           end;
+        extendeddefs.free;
+        extendeddefs:=nil;
+        genericdummysyms.free;
+        genericdummysyms:=nil;
+        waitingforunit.free;
+        waitingforunit:=nil;
+        localmacrosymtable.free;
+        localmacrosymtable:=nil;
+        ptrdefs.free;
+        ptrdefs:=nil;
+        arraydefs.free;
+        arraydefs:=nil;
+        procaddrdefs.free;
+        procaddrdefs:=nil;
+{$ifdef llvm}
+        llvmdefs.free;
+        llvmdefs:=nil;
+{$endif llvm}
+        checkforwarddefs.free;
+        checkforwarddefs:=nil;
+        tcinitcode.free;
+        tcinitcode:=nil;
+        localunitsearchpath.free;
+        localunitsearchpath:=nil;
+        localobjectsearchpath.free;
+        localobjectsearchpath:=nil;
+        localincludesearchpath.free;
+        localincludesearchpath:=nil;
+        locallibrarysearchpath.free;
+        locallibrarysearchpath:=nil;
+        localframeworksearchpath.free;
+        localframeworksearchpath:=nil;
       end;
 
 

compiler/fpcdefs.inc

@@ -237,8 +237,10 @@
   (but there we don't support it)
 }
 {$ifdef cpu64bitaddr}
+{$ifndef USE_STABS_64}
 {$define NoDbgStabs}
 {$endif}
+{$endif}
 
 {$if not defined(FPC_HAS_TYPE_EXTENDED) and defined(i386)}
 {$error Cross-compiling from systems without support for an 80 bit extended floating point type to i386 is not yet supported at this time }

compiler/fppu.pas

@@ -38,7 +38,7 @@ interface
 
     uses
       cmsgs,verbose,
-      cutils,cclasses,
+      cutils,cclasses,cstreams,
       globtype,globals,finput,fmodule,
       symbase,ppu,symtype;
 
@@ -59,7 +59,8 @@ interface
           constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
           destructor destroy;override;
           procedure reset;override;
-          function  openppu:boolean;
+          function  openppufile:boolean;
+          function  openppustream(strm:TCStream):boolean;
           procedure getppucrc;
           procedure writeppu;
           procedure loadppu;
@@ -75,6 +76,7 @@ interface
            avoid endless resolving loops in case of cyclic dependencies. }
           defsgeneration : longint;
 
+          function  openppu(ppufiletime:longint):boolean;
           function  search_unit_files(onlysource:boolean):boolean;
           function  search_unit(onlysource,shortname:boolean):boolean;
           procedure load_interface;
@@ -118,7 +120,8 @@ uses
   scanner,
   aasmbase,ogbase,
   parser,
-  comphook;
+  comphook,
+  entfile;
 
 
 var
@@ -180,11 +183,11 @@ var
       until false;
     end;
 
-    function tppumodule.openppu:boolean;
+    function tppumodule.openppufile:boolean;
       var
         ppufiletime : longint;
       begin
-        openppu:=false;
+        openppufile:=false;
         Message1(unit_t_ppu_loading,ppufilename,@queuecomment);
       { Get ppufile time (also check if the file exists) }
         ppufiletime:=getnamedfiletime(ppufilename);
@@ -200,6 +203,29 @@ var
            Message(unit_u_ppu_file_too_short);
            exit;
          end;
+        result:=openppu(ppufiletime);
+      end;
+
+
+    function tppumodule.openppustream(strm:TCStream):boolean;
+      begin
+      { Open the ppufile }
+        Message1(unit_u_ppu_name,ppufilename);
+        ppufile:=tcompilerppufile.create(ppufilename);
+        if not ppufile.openstream(strm) then
+         begin
+           ppufile.free;
+           ppufile:=nil;
+           Message(unit_u_ppu_file_too_short);
+           exit;
+         end;
+        result:=openppu(-1);
+      end;
+
+
+    function tppumodule.openppu(ppufiletime:longint):boolean;
+      begin
+        openppu:=false;
       { check for a valid PPU file }
         if not ppufile.CheckPPUId then
          begin
@@ -209,15 +235,15 @@ var
            exit;
          end;
       { check for allowed PPU versions }
-        if not (ppufile.GetPPUVersion = CurrentPPUVersion) then
+        if not (ppufile.getversion = CurrentPPUVersion) then
          begin
-           Message1(unit_u_ppu_invalid_version,tostr(ppufile.GetPPUVersion),@queuecomment);
+           Message1(unit_u_ppu_invalid_version,tostr(ppufile.getversion),@queuecomment);
            ppufile.free;
            ppufile:=nil;
            exit;
          end;
       { check the target processor }
-        if tsystemcpu(ppufile.header.cpu)<>target_cpu then
+        if tsystemcpu(ppufile.header.common.cpu)<>target_cpu then
          begin
            ppufile.free;
            ppufile:=nil;
@@ -225,7 +251,7 @@ var
            exit;
          end;
       { check target }
-        if tsystem(ppufile.header.target)<>target_info.system then
+        if tsystem(ppufile.header.common.target)<>target_info.system then
          begin
            ppufile.free;
            ppufile:=nil;
@@ -234,7 +260,7 @@ var
          end;
 {$ifdef i8086}
       { check i8086 memory model flags }
-        if ((ppufile.header.flags and uf_i8086_far_code)<>0) xor
+        if ((ppufile.header.common.flags and uf_i8086_far_code)<>0) xor
             (current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge]) then
          begin
            ppufile.free;
@@ -242,7 +268,7 @@ var
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            exit;
          end;
-        if ((ppufile.header.flags and uf_i8086_far_data)<>0) xor
+        if ((ppufile.header.common.flags and uf_i8086_far_data)<>0) xor
             (current_settings.x86memorymodel in [mm_compact,mm_large]) then
          begin
            ppufile.free;
@@ -250,7 +276,7 @@ var
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            exit;
          end;
-        if ((ppufile.header.flags and uf_i8086_huge_data)<>0) xor
+        if ((ppufile.header.common.flags and uf_i8086_huge_data)<>0) xor
             (current_settings.x86memorymodel=mm_huge) then
          begin
            ppufile.free;
@@ -258,7 +284,7 @@ var
            Message(unit_u_ppu_invalid_memory_model,@queuecomment);
            exit;
          end;
-        if ((ppufile.header.flags and uf_i8086_cs_equals_ds)<>0) xor
+        if ((ppufile.header.common.flags and uf_i8086_cs_equals_ds)<>0) xor
             (current_settings.x86memorymodel=mm_tiny) then
          begin
            ppufile.free;
@@ -270,7 +296,7 @@ var
 {$ifdef cpufpemu}
        { check if floating point emulation is on?
          fpu emulation isn't unit levelwise because it affects calling convention }
-       if ((ppufile.header.flags and uf_fpu_emulation)<>0) xor
+       if ((ppufile.header.common.flags and uf_fpu_emulation)<>0) xor
             (cs_fp_emulation in current_settings.moduleswitches) then
          begin
            ppufile.free;
@@ -281,12 +307,15 @@ var
 {$endif cpufpemu}
 
       { Load values to be access easier }
-        flags:=ppufile.header.flags;
+        flags:=ppufile.header.common.flags;
         crc:=ppufile.header.checksum;
         interface_crc:=ppufile.header.interface_checksum;
         indirect_crc:=ppufile.header.indirect_checksum;
       { Show Debug info }
-        Message1(unit_u_ppu_time,filetimestring(ppufiletime));
+        if ppufiletime<>-1 then
+          Message1(unit_u_ppu_time,filetimestring(ppufiletime))
+        else
+          Message1(unit_u_ppu_time,'unknown');
         Message1(unit_u_ppu_flags,tostr(flags));
         Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8));
         Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
@@ -337,7 +366,7 @@ var
            if Found then
             Begin
               SetFileName(hs,false);
-              Found:=OpenPPU;
+              Found:=openppufile;
             End;
            PPUSearchPath:=Found;
          end;
@@ -1197,13 +1226,10 @@ var
              position in derefdata is not necessarily at the end }
             derefdata.seek(derefdata.size);
          tstoredsymtable(globalsymtable).buildderefimpl;
-         if (flags and uf_local_symtable)<>0 then
-           begin
-             tstoredsymtable(localsymtable).buildderef;
-             tstoredsymtable(localsymtable).buildderefimpl;
-           end;
          tunitwpoinfo(wpoinfo).buildderef;
          tunitwpoinfo(wpoinfo).buildderefimpl;
+         if (flags and uf_local_symtable)<>0 then
+           tstoredsymtable(localsymtable).buildderef_registered;
          writederefmap;
          writederefdata;
 
@@ -1246,14 +1272,14 @@ var
          { flush to be sure }
          ppufile.flush;
          { create and write header }
-         ppufile.header.size:=ppufile.size;
+         ppufile.header.common.size:=ppufile.size;
          ppufile.header.checksum:=ppufile.crc;
          ppufile.header.interface_checksum:=ppufile.interface_crc;
          ppufile.header.indirect_checksum:=ppufile.indirect_crc;
-         ppufile.header.compiler:=wordversion;
-         ppufile.header.cpu:=word(target_cpu);
-         ppufile.header.target:=word(target_info.system);
-         ppufile.header.flags:=flags;
+         ppufile.header.common.compiler:=wordversion;
+         ppufile.header.common.cpu:=word(target_cpu);
+         ppufile.header.common.target:=word(target_info.system);
+         ppufile.header.common.flags:=flags;
          ppufile.header.deflistsize:=current_module.deflist.count;
          ppufile.header.symlistsize:=current_module.symlist.count;
          ppufile.writeheader;
@@ -1352,14 +1378,14 @@ var
 
          { create and write header, this will only be used
            for debugging purposes }
-         ppufile.header.size:=ppufile.size;
+         ppufile.header.common.size:=ppufile.size;
          ppufile.header.checksum:=ppufile.crc;
          ppufile.header.interface_checksum:=ppufile.interface_crc;
          ppufile.header.indirect_checksum:=ppufile.indirect_crc;
-         ppufile.header.compiler:=wordversion;
-         ppufile.header.cpu:=word(target_cpu);
-         ppufile.header.target:=word(target_info.system);
-         ppufile.header.flags:=flags;
+         ppufile.header.common.compiler:=wordversion;
+         ppufile.header.common.cpu:=word(target_cpu);
+         ppufile.header.common.target:=word(target_info.system);
+         ppufile.header.common.flags:=flags;
          ppufile.writeheader;
 
          ppufile.closefile;
@@ -1394,7 +1420,7 @@ var
               if (pu.u.interface_crc<>pu.interface_checksum) or
                  (pu.u.indirect_crc<>pu.indirect_checksum) or
                  (
-                  ((ppufile.header.flags and uf_release)=0) and
+                  ((ppufile.header.common.flags and uf_release)=0) and
                   (pu.u.crc<>pu.checksum)
                  ) then
                begin
@@ -1477,9 +1503,12 @@ var
           end;
 
         { we can now derefence all pointers to the implementation parts }
-        tstoredsymtable(globalsymtable).derefimpl;
+        tstoredsymtable(globalsymtable).derefimpl(false);
+        { we've just loaded the localsymtable from the ppu file, so everything
+          in it was registered by definition (otherwise it wouldn't have been in
+          there) }
         if assigned(localsymtable) then
-            tstoredsymtable(localsymtable).derefimpl;
+          tstoredsymtable(localsymtable).derefimpl(false);
 
          { read whole program optimisation-related information }
          wpoinfo:=tunitwpoinfo.ppuload(ppufile);
@@ -1608,12 +1637,14 @@ var
                if interface_compiled then
                  begin
                    Message1(unit_u_reresolving_unit,modulename^);
-                   tstoredsymtable(globalsymtable).deref;
-                   tstoredsymtable(globalsymtable).derefimpl;
+                   tstoredsymtable(globalsymtable).deref(false);
+                   tstoredsymtable(globalsymtable).derefimpl(false);
                    if assigned(localsymtable) then
                     begin
-                      tstoredsymtable(localsymtable).deref;
-                      tstoredsymtable(localsymtable).derefimpl;
+                      { we have only builderef(impl)'d the registered symbols of
+                        the localsymtable -> also only deref those again }
+                      tstoredsymtable(localsymtable).deref(true);
+                      tstoredsymtable(localsymtable).derefimpl(true);
                     end;
                    if assigned(wpoinfo) then
                      begin

compiler/globals.pas

@@ -44,6 +44,9 @@ interface
       { comphook pulls in sysutils anyways }
       cutils,cclasses,cfileutl,
       cpuinfo,
+{$if defined(LLVM) and not defined(GENERIC_CPU)}
+      llvminfo,
+{$endif LLVM and not GENERIC_CPU}
       globtype,version,systems;
 
     const
@@ -70,7 +73,13 @@ interface
        macmodeswitches =
          [m_mac,m_cvar_support,m_mac_procvar,m_nested_procvars,m_non_local_goto,m_isolike_unary_minus,m_default_inline];
        isomodeswitches =
-         [m_iso,m_tp_procvar,m_duplicate_names,m_nested_procvars,m_non_local_goto,m_isolike_unary_minus];
+         [m_iso,m_tp_procvar,m_duplicate_names,m_nested_procvars,m_non_local_goto,m_isolike_unary_minus,m_isolike_io,
+          m_isolike_program_para,
+          m_isolike_mod];
+       extpasmodeswitches =
+         [m_extpas,m_tp_procvar,m_duplicate_names,m_nested_procvars,m_non_local_goto,m_isolike_unary_minus,m_isolike_io,
+          m_isolike_program_para,
+          m_isolike_mod];
 
        { maximum nesting of routines }
        maxnesting = 32;
@@ -161,6 +170,10 @@ interface
          instructionset : tinstructionset;
 {$endif defined(ARM)}
 
+{$if defined(LLVM) and not defined(GENERIC_CPU)}
+         llvmversion: tllvmversion;
+{$endif defined(LLVM) and not defined(GENERIC_CPU)}
+
         { CPU targets with microcontroller support can add a controller specific unit }
          controllertype   : tcontrollertype;
 
@@ -266,8 +279,6 @@ interface
        autoloadunits      : string;
 
        { linking }
-       usegnubinutils : boolean;
-       forceforwardslash : boolean;
        usewindowapi  : boolean;
        description   : string;
        SetPEFlagsSetExplicity,
@@ -340,8 +351,6 @@ interface
        prop_auto_setter_prefix : string;
 
     const
-       DLLsource : boolean = false;
-
        Inside_asm_statement : boolean = false;
 
        global_unit_count : word = 0;
@@ -488,6 +497,9 @@ interface
 {$if defined(ARM)}
         instructionset : is_arm;
 {$endif defined(ARM)}
+{$if defined(LLVM) and not defined(GENERIC_CPU)}
+        llvmversion    : llvmver_3_6_0;
+{$endif defined(LLVM) and not defined(GENERIC_CPU)}
         controllertype : ct_none;
         pmessage : nil;
       );
@@ -511,6 +523,7 @@ interface
 
     procedure InitGlobals;
     procedure DoneGlobals;
+    procedure register_initdone_proc(init,done:tprocedure);
 
     function  string2guid(const s: string; var GUID: TGUID): boolean;
     function  guid2string(const GUID: TGUID): string;
@@ -740,10 +753,10 @@ implementation
      get the current time in a string HH:MM:SS
    }
       var
-        hour,min,sec,hsec : word;
+        st: TSystemTime;
       begin
-        DecodeTime(Time,hour,min,sec,hsec);
-        gettimestr:=L0(Hour)+':'+L0(min)+':'+L0(sec);
+        GetLocalTime(st);
+        gettimestr:=L0(st.Hour)+':'+L0(st.Minute)+':'+L0(st.Second);
       end;
 
 
@@ -752,10 +765,10 @@ implementation
      get the current date in a string YY/MM/DD
    }
       var
-        Year,Month,Day: Word;
+        st: TSystemTime;
       begin
-        DecodeDate(Date,year,month,day);
-        getdatestr:=L0(Year)+'/'+L0(Month)+'/'+L0(Day);
+        GetLocalTime(st);
+        getdatestr:=L0(st.Year)+'/'+L0(st.Month)+'/'+L0(st.Day);
       end;
 
 
@@ -783,10 +796,10 @@ implementation
 
    function getrealtime : real;
      var
-       h,m,s,s1000 : word;
+       st:TSystemTime;
      begin
-       DecodeTime(Time,h,m,s,s1000);
-       result:=h*3600.0+m*60.0+s+s1000/1000.0;
+       GetLocalTime(st);
+       result:=st.Hour*3600.0+st.Minute*60.0+st.Second+st.MilliSecond/1000.0;
      end;
 
 {****************************************************************************
@@ -1337,8 +1350,70 @@ implementation
 
 
 
+   type
+     tinitdoneentry=record
+       init:tprocedure;
+       done:tprocedure;
+     end;
+     pinitdoneentry=^tinitdoneentry;
+
+
+   var
+     initdoneprocs : TFPList;
+
+
+   procedure register_initdone_proc(init,done:tprocedure);
+     var
+       entry : pinitdoneentry;
+     begin
+       new(entry);
+       entry^.init:=init;
+       entry^.done:=done;
+       initdoneprocs.add(entry);
+     end;
+
+
+   procedure callinitprocs;
+     var
+       i : longint;
+     begin
+       for i:=0 to initdoneprocs.count-1 do
+         with pinitdoneentry(initdoneprocs[i])^ do
+           if assigned(init) then
+             init();
+     end;
+
+
+   procedure calldoneprocs;
+     var
+       i : longint;
+     begin
+       for i:=0 to initdoneprocs.count-1 do
+         with pinitdoneentry(initdoneprocs[i])^ do
+           if assigned(done) then
+             done();
+     end;
+
+
+   procedure allocinitdoneprocs;
+     begin
+       initdoneprocs:=tfplist.create;
+     end;
+
+
+   procedure freeinitdoneprocs;
+     var
+       i : longint;
+     begin
+       for i:=0 to initdoneprocs.count-1 do
+         dispose(pinitdoneentry(initdoneprocs[i]));
+       initdoneprocs.free;
+     end;
+
+
    procedure DoneGlobals;
      begin
+       calldoneprocs;
        librarysearchpath.Free;
        unitsearchpath.Free;
        objectsearchpath.Free;
@@ -1358,7 +1433,6 @@ implementation
         do_make:=true;
         compile_level:=0;
         codegenerror:=false;
-        DLLsource:=false;
 
         { Output }
         OutputFileName:='';
@@ -1423,6 +1497,12 @@ implementation
 
         { enable all features by default }
         features:=[low(Tfeature)..high(Tfeature)];
+
+        callinitprocs;
      end;
 
+initialization
+  allocinitdoneprocs;
+finalization
+  freeinitdoneprocs;
 end.

compiler/globtype.pas

@@ -92,8 +92,16 @@ interface
        PAInt = ^AInt;
 
        { target cpu specific type used to store data sizes }
+{$ifdef cpu16bitaddr}
+       { on small CPUs such as i8086, we use LongInt to support data structures
+         larger than 32767 bytes and up to 65535 bytes in size. Since asizeint
+         must be signed, we use LongInt/LongWord. }
+       ASizeInt = LongInt;
+       ASizeUInt = LongWord;
+{$else cpu16bitaddr}
        ASizeInt = PInt;
        ASizeUInt = PUInt;
+{$endif cpu16bitaddr}
 
        { type used for handling constants etc. in the code generator }
        TCGInt = Int64;
@@ -106,7 +114,7 @@ interface
 {$ifdef i8086}
        TConstPtrUInt = LongWord;  { 32-bit for far pointers support }
 {$else i8086}
-       TConstPtrUInt = AWord;
+       TConstPtrUInt = PUint;
 {$endif i8086}
 
        { Use a variant record to be sure that the array if aligned correctly }
@@ -196,8 +204,9 @@ interface
          cs_link_strip,cs_link_staticflag,cs_link_on_target,cs_link_extern,cs_link_opt_vtable,
          cs_link_opt_used_sections,cs_link_separate_dbg_file,
          cs_link_map,cs_link_pthread,cs_link_no_default_lib_order,
-	 cs_link_native,
-         cs_link_pre_binutils_2_19
+         cs_link_native,
+         cs_link_pre_binutils_2_19,
+         cs_link_vlink
        );
        tglobalswitches = set of tglobalswitch;
 
@@ -373,7 +382,7 @@ interface
        { Switches which can be changed by a mode (fpc,tp7,delphi) }
        tmodeswitch = (m_none,
          { generic }
-         m_fpc,m_objfpc,m_delphi,m_tp7,m_mac,m_iso,
+         m_fpc,m_objfpc,m_delphi,m_tp7,m_mac,m_iso,m_extpas,
          {$ifdef fpc_mode}m_gpc,{$endif}
          { more specific }
          m_class,               { delphi class model }
@@ -411,12 +420,15 @@ interface
                                     ansistring; similarly, char becomes unicodechar rather than ansichar }
          m_type_helpers,        { allows the declaration of "type helper" (non-Delphi) or "record helper"
                                   (Delphi) for primitive types }
-         m_blocks               { support for http://en.wikipedia.org/wiki/Blocks_(C_language_extension) }
+         m_blocks,              { support for http://en.wikipedia.org/wiki/Blocks_(C_language_extension) }
+         m_isolike_io,          { I/O as it required by an ISO compatible compiler }
+         m_isolike_program_para, { program parameters as it required by an ISO compatible compiler }
+         m_isolike_mod          { mod operation as it is required by an iso compatible compiler }
        );
        tmodeswitches = set of tmodeswitch;
 
     const
-       alllanguagemodes = [m_fpc,m_objfpc,m_delphi,m_tp7,m_mac,m_iso];
+       alllanguagemodes = [m_fpc,m_objfpc,m_delphi,m_tp7,m_mac,m_iso,m_extpas];
 
     type
        { Application types (platform specific) }
@@ -544,7 +556,7 @@ interface
        cstylearrayofconst = [pocall_cdecl,pocall_cppdecl,pocall_mwpascal];
 
        modeswitchstr : array[tmodeswitch] of string[18] = ('',
-         '','','','','','',
+         '','','','','','','',
          {$ifdef fpc_mode}'',{$endif}
          { more specific }
          'CLASS',
@@ -577,7 +589,11 @@ interface
          'FINALFIELDS',
          'UNICODESTRINGS',
          'TYPEHELPERS',
-         'CBLOCKS');
+         'CBLOCKS',
+         'ISOIO',
+         'ISOPROGRAMPARAS',
+         'ISOMOD'
+         );
 
 
      type
@@ -628,7 +644,12 @@ interface
          { set if the stack frame of the procedure is estimated }
          pi_estimatestacksize,
          { the routine calls a C-style varargs function }
-         pi_calls_c_varargs
+         pi_calls_c_varargs,
+         { the routine has an open array parameter,
+           for i8086 cpu huge memory model,
+           as this changes SP register it requires special handling
+           to restore DS segment register  }
+         pi_has_open_array_parameter
        );
        tprocinfoflags=set of tprocinfoflag;
 

compiler/hlcg2ll.pas

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

compiler/hlcgobj.pas

@@ -532,16 +532,32 @@ unit hlcgobj;
           procedure g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation); virtual;
 
           { typecasts the pointer in reg to a new pointer. By default it does
-            nothing, only required for type-aware platforms like LLVM }
-          procedure g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tpointerdef; reg: tregister); virtual;
+            nothing, only required for type-aware platforms like LLVM.
+            fromdef/todef are not typed as pointerdef, because they may also be
+            a procvardef or classrefdef. Replaces reg with a new register if
+            necessary }
+          procedure g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tdef; var reg: tregister); virtual;
           { same but for a treference (considers the reference itself, not the
             value stored at that place in memory). Replaces ref with a new
-            reference if necessary }
-          procedure g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tpointerdef; var ref: treference); virtual;
-
-          { update a reference pointing to the start address of a record so it
-            refers to the indicated field }
-          procedure g_set_addr_nonbitpacked_record_field_ref(list: TAsmList; recdef: trecorddef; field: tfieldvarsym; var recref: treference); virtual;
+            reference if necessary. fromdef needs to be a pointerdef because
+            it may have to be passed as fromdef to a_loadaddr_ref_reg, which
+            needs the "pointeddef" of fromdef }
+          procedure g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tdef; var ref: treference); virtual;
+
+          { update a reference pointing to the start address of a record/object/
+            class (contents) so it refers to the indicated field }
+          procedure g_set_addr_nonbitpacked_field_ref(list: TAsmList; recdef: tabstractrecorddef; field: tfieldvarsym; var recref: treference); virtual;
+          { load a register/constant into a record field by name }
+         protected
+          procedure g_setup_load_field_by_name(list: TAsmList; recdef: trecorddef; const name: TIDString; const recref: treference; out fref: treference; out fielddef: tdef);
+         public
+          procedure g_load_reg_field_by_name(list: TAsmList; regsize: tdef; recdef: trecorddef; reg: tregister; const name: TIDString; const recref: treference);
+          procedure g_load_const_field_by_name(list: TAsmList; recdef: trecorddef; a: tcgint; const name: TIDString; const recref: treference);
+          { laod a named field into a register }
+          procedure g_load_field_reg_by_name(list: TAsmList; recdef: trecorddef; regsize: tdef; const name: TIDString; const recref: treference; reg: tregister);
+          { same as above, but allocates the register and determines the def
+            based on the type of the field }
+          procedure g_force_field_reg_by_name(list: TAsmList; recdef: trecorddef; const name: TIDString; const recref: treference; out regdef: tdef; out reg: tregister);
 
           { routines migrated from ncgutil }
 
@@ -1757,7 +1773,7 @@ implementation
     begin
       href:=ref;
       g_ptrtypecast_ref(list,cpointerdef.getreusable(tosize),cpointerdef.getreusable(u8inttype),href);
-      a_load_const_subsetref(list,u8inttype,ord(doset),get_bit_reg_ref_sref(list,fromsize,tosize,bitnumber,ref));
+      a_load_const_subsetref(list,u8inttype,ord(doset),get_bit_reg_ref_sref(list,fromsize,tosize,bitnumber,href));
     end;
 
   procedure thlcgobj.a_bit_set_reg_loc(list: TAsmList; doset: boolean; regsize, tosize: tdef; bitnumber: tregister; const loc: tlocation);
@@ -3669,6 +3685,7 @@ implementation
       { because some abis don't support dynamic stack allocation properly
         open array value parameters are copied onto the heap
       }
+      include(current_procinfo.flags, pi_has_open_array_parameter);
 
       { calculate necessary memory }
 
@@ -3828,22 +3845,79 @@ implementation
       end;
     end;
 
-  procedure thlcgobj.g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tpointerdef; reg: tregister);
+  procedure thlcgobj.g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tdef; var reg: tregister);
     begin
       { nothing to do }
     end;
 
-  procedure thlcgobj.g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tpointerdef; var ref: treference);
+  procedure thlcgobj.g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tdef; var ref: treference);
     begin
       { nothing to do }
     end;
 
-  procedure thlcgobj.g_set_addr_nonbitpacked_record_field_ref(list: TAsmList; recdef: trecorddef; field: tfieldvarsym; var recref: treference);
+  procedure thlcgobj.g_set_addr_nonbitpacked_field_ref(list: TAsmList; recdef: tabstractrecorddef; field: tfieldvarsym; var recref: treference);
     begin
       inc(recref.offset,field.fieldoffset);
       recref.alignment:=newalignment(recref.alignment,field.fieldoffset);
     end;
 
+
+  procedure thlcgobj.g_setup_load_field_by_name(list: TAsmList; recdef: trecorddef; const name: TIDString; const recref: treference; out fref: treference; out fielddef: tdef);
+    var
+      sym: tsym;
+      field: tfieldvarsym;
+    begin
+      sym:=search_struct_member(recdef,name);
+      if not assigned(sym) or
+         (sym.typ<>fieldvarsym) then
+        internalerror(2015111901);
+      field:=tfieldvarsym(sym);
+      fref:=recref;
+      fielddef:=field.vardef;
+      g_set_addr_nonbitpacked_field_ref(list,recdef,field,fref);
+    end;
+
+
+  procedure thlcgobj.g_load_reg_field_by_name(list: TAsmList; regsize: tdef; recdef: trecorddef; reg: tregister; const name: TIDString; const recref: treference);
+    var
+      fref: treference;
+      fielddef: tdef;
+    begin
+      g_setup_load_field_by_name(list,recdef,name,recref,fref,fielddef);
+      a_load_reg_ref(list,regsize,fielddef,reg,fref);
+    end;
+
+
+  procedure thlcgobj.g_load_const_field_by_name(list: TAsmList; recdef: trecorddef; a: tcgint; const name: TIDString; const recref: treference);
+    var
+      fref: treference;
+      fielddef: tdef;
+    begin
+      g_setup_load_field_by_name(list,recdef,name,recref,fref,fielddef);
+      a_load_const_ref(list,fielddef,a,fref);
+    end;
+
+
+  procedure thlcgobj.g_load_field_reg_by_name(list: TAsmList; recdef: trecorddef; regsize: tdef; const name: TIDString; const recref: treference; reg: tregister);
+    var
+      fref: treference;
+      fielddef: tdef;
+    begin
+      g_setup_load_field_by_name(list,recdef,name,recref,fref,fielddef);
+      a_load_ref_reg(list,fielddef,regsize,fref,reg);
+    end;
+
+
+  procedure thlcgobj.g_force_field_reg_by_name(list: TAsmList; recdef: trecorddef; const name: TIDString; const recref: treference; out regdef: tdef; out reg: tregister);
+    var
+      fref: treference;
+    begin
+      g_setup_load_field_by_name(list,recdef,name,recref,fref,regdef);
+      reg:=getregisterfordef(list,regdef);
+      a_load_ref_reg(list,regdef,regdef,fref,reg);
+    end;
+
+
   procedure thlcgobj.location_force_reg(list: TAsmList; var l: tlocation; src_size, dst_size: tdef; maybeconst: boolean);
     var
       hregister,
@@ -4557,7 +4631,11 @@ implementation
        begin
          { initialize units }
          if not(current_module.islibrary) then
+{$ifdef AVR}
+           cg.a_call_name(list,'FPC_INIT_FUNC_TABLE',false)
+{$else AVR}
            g_call_system_proc(list,'fpc_initializeunits',[],nil)
+{$endif AVR}
          else
            g_call_system_proc(list,'fpc_libinitializeunits',[],nil);
        end;
@@ -4575,7 +4653,7 @@ implementation
           look up procdef, use hlcgobj.a_call_name()) }
 
       { call __EXIT for main program }
-      if (not DLLsource) and
+      if (not current_module.islibrary) and
          (current_procinfo.procdef.proctypeoption=potype_proginit) then
         g_call_system_proc(list,'fpc_do_exit',[],nil);
     end;
@@ -4801,6 +4879,7 @@ implementation
                 else
                   highloc.loc:=LOC_INVALID;
                 eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
+                g_ptrtypecast_ref(list,cpointerdef.getreusable(tparavarsym(p).vardef),cpointerdef.getreusable(eldef),href);
                 g_array_rtti_helper(list,eldef,href,highloc,'fpc_finalize_array');
               end
             else
@@ -4866,6 +4945,7 @@ implementation
                          { open arrays do not contain correct element count in their rtti,
                            the actual count must be passed separately. }
                          eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
+                         g_ptrtypecast_ref(list,cpointerdef.getreusable(tparavarsym(p).vardef),cpointerdef.getreusable(eldef),href);
                          g_array_rtti_helper(list,eldef,href,highloc,'fpc_addref_array');
                        end
                      else
@@ -4984,7 +5064,7 @@ implementation
                   else
                     internalerror(2011020507);
 //                      cg.g_copyvaluepara_packedopenarray(list,href,hsym.intialloc,tarraydef(tparavarsym(p).vardef).elepackedbitsize,hreg);
-                  a_load_reg_loc(list,tparavarsym(p).vardef,tparavarsym(p).vardef,hreg,tparavarsym(p).initialloc);
+                  a_load_reg_loc(list,cpointerdef.getreusable(tparavarsym(p).vardef),cpointerdef.getreusable(tparavarsym(p).vardef),hreg,tparavarsym(p).initialloc);
                 end;
             end
           else
@@ -5107,6 +5187,8 @@ implementation
     end;
 
   procedure thlcgobj.gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);
+    var
+      tmploc: tlocation;
     begin
       { Handle Floating point types differently
 
@@ -5122,6 +5204,18 @@ implementation
           exit;
         end;
 
+      { in case of multiple locations, force the source to memory as only
+        a_load_ref_cgpara supports multiple locations }
+      if assigned(cgpara.location^.next) and
+         not(l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+        begin
+          tmploc:=l;
+          location_force_mem(list,tmploc,vardef);
+          a_load_loc_cgpara(list,vardef,tmploc,cgpara);
+          location_freetemp(list,tmploc);
+          exit;
+        end;
+
       case l.loc of
         LOC_CONSTANT,
         LOC_REGISTER,

compiler/htypechk.pas

@@ -2472,10 +2472,7 @@ implementation
                   )
                 ) or
                 (
-                  (
-                    not pd.is_specialization or
-                    assigned(pd.owner)
-                  ) and
+                  assigned(pd.owner) and
                   (
                     not (pd.owner.symtabletype in [objectsymtable,recordsymtable]) or
                     is_visible_for_object(pd,contextstructdef)
@@ -2999,8 +2996,8 @@ implementation
     function get_variantequaltype(def: tdef): tvariantequaltype;
       const
         variantorddef_cl: array[tordtype] of tvariantequaltype =
-          (tve_incompatible,tve_byte,tve_word,tve_cardinal,tve_chari64,
-           tve_shortint,tve_smallint,tve_longint,tve_chari64,
+          (tve_incompatible,tve_byte,tve_word,tve_cardinal,tve_chari64,tve_incompatible,
+           tve_shortint,tve_smallint,tve_longint,tve_chari64,tve_incompatible,
            tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
            tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
            tve_chari64,tve_chari64,tve_dblcurrency);

compiler/i386/cpupara.pas

@@ -422,7 +422,7 @@ unit cpupara;
               begin
                 paralen:=sizeof(aint);
                 paracgsize:=OS_ADDR;
-                paradef:=cpointerdef.getreusable(paradef);
+                paradef:=cpointerdef.getreusable_no_free(paradef);
               end
             else
               begin
@@ -574,7 +574,7 @@ unit cpupara;
                       begin
                         paralen:=sizeof(aint);
                         paracgsize:=OS_ADDR;
-                        paradef:=cpointerdef.getreusable(paradef);
+                        paradef:=cpointerdef.getreusable_no_free(paradef);
                       end
                     else
                       begin

compiler/i386/hlcgcpu.pas

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

compiler/i386/i386att.inc

@@ -670,6 +670,7 @@
 'aesdeclast',
 'aesimc',
 'aeskeygenassist',
+'rdtscp',
 'vaddpd',
 'vaddps',
 'vaddsd',

compiler/i386/i386atts.inc

@@ -45,8 +45,8 @@ attsufNONE,
 attsufNONE,
 attsufFPU,
 attsufFPU,
-attsufFPU,
-attsufFPU,
+attsufNONE,
+attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufFPU,
@@ -701,6 +701,7 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufNONE,
 attsufMM,
 attsufMM,
 attsufNONE,

compiler/i386/i386int.inc

@@ -670,6 +670,7 @@
 'aesdeclast',
 'aesimc',
 'aeskeygenassist',
+'rdtscp',
 'vaddpd',
 'vaddps',
 'vaddsd',

compiler/i386/i386nop.inc

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

compiler/i386/i386op.inc

@@ -670,6 +670,7 @@ A_AESDEC,
 A_AESDECLAST,
 A_AESIMC,
 A_AESKEYGENASSIST,
+A_RDTSCP,
 A_VADDPD,
 A_VADDPS,
 A_VADDSD,

compiler/i386/i386prop.inc

@@ -670,6 +670,7 @@
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_WEAX, Ch_WEDX, Ch_None)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),

compiler/i386/i386tab.inc

@@ -2308,56 +2308,56 @@
     ops     : 3;
     optypes : (ot_reg32 or ot_bits64,ot_rm_gpr,ot_immediate or ot_bits8 or ot_signed,ot_none);
     code    : #208#1#107#72#14;
-    flags   : if_286 or if_sm
+    flags   : if_386 or if_sm
   ),
   (
     opcode  : A_IMUL;
     ops     : 3;
     optypes : (ot_reg32 or ot_bits64,ot_rm_gpr,ot_immediate,ot_none);
     code    : #208#1#105#72#34;
-    flags   : if_286 or if_sm or if_sd or if_ar2
+    flags   : if_386 or if_sm or if_sd or if_ar2
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none);
     code    : #208#1#107#64#13;
-    flags   : if_286
+    flags   : if_386
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg32,ot_immediate,ot_none,ot_none);
     code    : #213#1#105#64#33;
-    flags   : if_286 or if_sd
+    flags   : if_386 or if_sd
   ),
   (
     opcode  : A_IMUL;
     ops     : 3;
     optypes : (ot_reg16,ot_rm_gpr,ot_immediate or ot_bits8 or ot_signed,ot_none);
     code    : #212#1#107#72#14;
-    flags   : if_286 or if_sm
+    flags   : if_186 or if_sm
   ),
   (
     opcode  : A_IMUL;
     ops     : 3;
     optypes : (ot_reg16,ot_rm_gpr,ot_immediate,ot_none);
     code    : #212#1#105#72#26;
-    flags   : if_286 or if_sm or if_sw or if_ar2
+    flags   : if_186 or if_sm or if_sw or if_ar2
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg16,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none);
     code    : #212#1#107#64#13;
-    flags   : if_286
+    flags   : if_186
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg16,ot_immediate,ot_none,ot_none);
     code    : #212#1#105#64#25;
-    flags   : if_286 or if_sw
+    flags   : if_186 or if_sw
   ),
   (
     opcode  : A_IMUL;
@@ -4009,7 +4009,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #215#1#157;
-    flags   : if_186 or if_nox86_64
+    flags   : if_8086 or if_nox86_64
   ),
   (
     opcode  : A_POPFD;
@@ -4023,7 +4023,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #212#1#157;
-    flags   : if_186 or if_nox86_64
+    flags   : if_8086 or if_nox86_64
   ),
   (
     opcode  : A_POR;
@@ -4520,14 +4520,14 @@
     ops     : 1;
     optypes : (ot_immediate or ot_bits16,ot_none,ot_none,ot_none);
     code    : #212#1#104#24#221;
-    flags   : if_286
+    flags   : if_186
   ),
   (
     opcode  : A_PUSH;
     ops     : 1;
     optypes : (ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none,ot_none);
     code    : #1#106#12#221;
-    flags   : if_286
+    flags   : if_186
   ),
   (
     opcode  : A_PUSH;
@@ -4569,7 +4569,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #215#1#156;
-    flags   : if_186
+    flags   : if_8086
   ),
   (
     opcode  : A_PUSHFD;
@@ -4583,7 +4583,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #212#1#156;
-    flags   : if_186
+    flags   : if_8086
   ),
   (
     opcode  : A_PXOR;
@@ -4618,7 +4618,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#130#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_RCL;
@@ -4660,7 +4660,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#131#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_RCR;
@@ -4807,7 +4807,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#128#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_ROL;
@@ -4849,7 +4849,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#129#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_ROR;
@@ -4919,7 +4919,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#132#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_SAL;
@@ -4968,7 +4968,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#135#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_SAR;
@@ -5115,14 +5115,14 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #1#100;
-    flags   : if_8086 or if_pre
+    flags   : if_386 or if_pre
   ),
   (
     opcode  : A_SEGGS;
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #1#101;
-    flags   : if_8086 or if_pre
+    flags   : if_386 or if_pre
   ),
   (
     opcode  : A_SEGSS;
@@ -8449,6 +8449,13 @@
     code    : #241#3#15#58#223#72#22;
     flags   : if_sse4 or if_sb or if_ar2
   ),
+  (
+    opcode  : A_RDTSCP;
+    ops     : 0;
+    optypes : (ot_none,ot_none,ot_none,ot_none);
+    code    : #3#15#1#249;
+    flags   : if_sse4 or if_sm
+  ),
   (
     opcode  : A_VADDPD;
     ops     : 3;

compiler/i386/popt386.pas

@@ -2066,7 +2066,7 @@ begin
                                   (taicpu(hp2).condition=C_None) and
                                   { real label and jump, no further references to the
                                     label are allowed }
-                                  (tasmlabel(taicpu(p).oper[0]^.ref^.symbol).getrefs=2) and
+                                  (tasmlabel(taicpu(p).oper[0]^.ref^.symbol).getrefs=1) and
                                   FindLabel(tasmlabel(taicpu(p).oper[0]^.ref^.symbol),hp1) then
                                    begin
                                      l:=0;

compiler/i8086/cgcpu.pas

@@ -1660,55 +1660,124 @@ unit cgcpu;
         hl_skip: TAsmLabel;
         invf: TResFlags;
         tmpsize: TCgSize;
+        tmpopsize: topsize;
       begin
-        invf := f;
-        inverse_flags(invf);
-
-        case size of
-          OS_8,OS_S8:
-            begin
-              tmpsize:=OS_8;
-              list.concat(Taicpu.op_const_reg(A_MOV, S_B, 0, reg));
+        { optimized case for the carry flag, using ADC/RCL }
+        if f in [F_C,F_B,F_FB] then
+          begin
+            case size of
+              OS_8,OS_S8:
+                begin
+                  tmpsize:=OS_8;
+                  tmpopsize:=S_B;
+                end;
+              OS_16,OS_S16,OS_32,OS_S32:
+                begin
+                  tmpsize:=OS_16;
+                  tmpopsize:=S_W;
+                end;
+              else
+                internalerror(2013123101);
             end;
-          OS_16,OS_S16,OS_32,OS_S32:
-            begin
-              tmpsize:=OS_16;
-              list.concat(Taicpu.op_const_reg(A_MOV, S_W, 0, reg));
+            list.concat(Taicpu.op_const_reg(A_MOV, tmpopsize, 0, reg));
+            hl_skip:=nil;
+            if f=F_FB then
+              begin
+                current_asmdata.getjumplabel(hl_skip);
+                ai:=Taicpu.op_sym(A_Jcc,S_NO,hl_skip);
+                ai.SetCondition(C_P);
+                ai.is_jmp:=true;
+                list.concat(ai);
+              end;
+            { RCL is faster than ADC on 8086/8088. On the 80286, it is
+              equally fast and it also has the same size. In these cases,
+              we still prefer it over ADC, because it's a better choice in
+              case the register is spilled. }
+            if (cs_opt_size in current_settings.optimizerswitches) or
+               (current_settings.optimizecputype<=cpu_286) then
+              list.concat(Taicpu.op_const_reg(A_RCL, tmpopsize, 1, reg))
+            else
+              { ADC is much faster on the 386. }
+              list.concat(Taicpu.op_reg_reg(A_ADC, tmpopsize, reg, reg));
+            if f=F_FB then
+              a_label(list,hl_skip);
+            a_load_reg_reg(list,tmpsize,size,reg,reg);
+          end
+        { optimized case for the inverted carry flag, using SBB }
+        else if f in [F_NC,F_AE,F_FAE] then
+          begin
+            case size of
+              OS_8,OS_S8:
+                begin
+                  tmpsize:=OS_8;
+                  list.concat(Taicpu.op_const_reg(A_MOV, S_B, 1, reg));
+                  list.concat(Taicpu.op_const_reg(A_SBB, S_B, 0, reg));
+                end;
+              OS_16,OS_S16,OS_32,OS_S32:
+                begin
+                  tmpsize:=OS_16;
+                  list.concat(Taicpu.op_const_reg(A_MOV, S_W, 1, reg));
+                  list.concat(Taicpu.op_const_reg(A_SBB, S_W, 0, reg));
+                end;
+              else
+                internalerror(2013123101);
             end;
-          else
-            internalerror(2013123101);
-        end;
+            a_load_reg_reg(list,tmpsize,size,reg,reg);
+          end
+        else
+          begin
+            invf := f;
+            inverse_flags(invf);
 
-        current_asmdata.getjumplabel(hl_skip);
-        { we can't just forward invf to a_jmp_flags for FA,FAE,FB and FBE, because
-          in the case of NaNs:
-           not(F_FA )<>F_FBE
-           not(F_FAE)<>F_FB
-           not(F_FB )<>F_FAE
-           not(F_FBE)<>F_FA
-        }
-        case f of
-          F_FA,F_FAE:
-            invf:=FPUFlags2Flags[invf];
-          F_FB,F_FBE:
-            begin
-              ai:=Taicpu.op_sym(A_Jcc,S_NO,hl_skip);
-              ai.SetCondition(C_P);
-              ai.is_jmp:=true;
-              list.concat(ai);
-              invf:=FPUFlags2Flags[invf];
+            case size of
+              OS_8,OS_S8:
+                begin
+                  tmpsize:=OS_8;
+                  list.concat(Taicpu.op_const_reg(A_MOV, S_B, 0, reg));
+                end;
+              OS_16,OS_S16,OS_32,OS_S32:
+                begin
+                  tmpsize:=OS_16;
+                  list.concat(Taicpu.op_const_reg(A_MOV, S_W, 0, reg));
+                end;
+              else
+                internalerror(2013123101);
             end;
-        end;
-        a_jmp_flags(list,invf,hl_skip);
 
-        { 16-bit INC is shorter than 8-bit }
-        hreg16:=makeregsize(list,reg,OS_16);
-        list.concat(Taicpu.op_reg(A_INC, S_W, hreg16));
-        makeregsize(list,hreg16,tmpsize);
+            current_asmdata.getjumplabel(hl_skip);
+            { we can't just forward invf to a_jmp_flags for FA,FAE,FB and FBE, because
+              in the case of NaNs:
+               not(F_FA )<>F_FBE
+               not(F_FAE)<>F_FB
+               not(F_FB )<>F_FAE
+               not(F_FBE)<>F_FA
+            }
+            case f of
+              F_FA:
+                invf:=FPUFlags2Flags[invf];
+              F_FAE,F_FB:
+                { F_FAE and F_FB are handled above, using ADC/RCL/SBB }
+                internalerror(2015102101);
+              F_FBE:
+                begin
+                  ai:=Taicpu.op_sym(A_Jcc,S_NO,hl_skip);
+                  ai.SetCondition(C_P);
+                  ai.is_jmp:=true;
+                  list.concat(ai);
+                  invf:=FPUFlags2Flags[invf];
+                end;
+            end;
+            a_jmp_flags(list,invf,hl_skip);
 
-        a_label(list,hl_skip);
+            { 16-bit INC is shorter than 8-bit }
+            hreg16:=makeregsize(list,reg,OS_16);
+            list.concat(Taicpu.op_reg(A_INC, S_W, hreg16));
+            makeregsize(list,hreg16,tmpsize);
 
-        a_load_reg_reg(list,tmpsize,size,reg,reg);
+            a_label(list,hl_skip);
+
+            a_load_reg_reg(list,tmpsize,size,reg,reg);
+          end;
       end;
 
 
@@ -1749,6 +1818,24 @@ unit cgcpu;
       var
         stacksize : longint;
         ret_instr: TAsmOp;
+        sp_moved : boolean;
+
+      procedure maybe_move_sp;
+        var
+          ref : treference;
+        begin
+          if sp_moved then 
+            exit;
+          if not(pi_has_open_array_parameter in current_procinfo.flags) then
+            exit;
+          { Restore SP position before SP change }
+          if current_settings.x86memorymodel=mm_huge then
+            stacksize:=stacksize + 2;
+          reference_reset_base(ref,NR_BP,-stacksize,2);
+          list.concat(Taicpu.op_ref_reg(A_LEA,S_W,ref,NR_SP));
+          sp_moved:=true;
+        end;
+
       begin
         if is_proc_far(current_procinfo.procdef) then
           ret_instr:=A_RETF
@@ -1759,12 +1846,22 @@ unit cgcpu;
            (rg[R_MMXREGISTER].uses_registers) then
           list.concat(Taicpu.op_none(A_EMMS,S_NO));
 
+        sp_moved:=false;
         { remove stackframe }
         if not nostackframe then
           begin
+            stacksize:=current_procinfo.calc_stackframe_size;
+            if (target_info.stackalign>4) and
+               ((stacksize <> 0) or
+                (pi_do_call in current_procinfo.flags) or
+                { can't detect if a call in this case -> use nostackframe }
+                { if you (think you) know what you are doing              }
+                (po_assembler in current_procinfo.procdef.procoptions)) then
+              stacksize := align(stacksize+sizeof(aint),target_info.stackalign) - sizeof(aint);
             if (po_exports in current_procinfo.procdef.procoptions) and
                (target_info.system=system_i8086_win16) then
               begin
+                maybe_move_sp;
                 list.concat(Taicpu.Op_reg(A_POP,S_W,NR_DI));
                 list.concat(Taicpu.Op_reg(A_POP,S_W,NR_SI));
               end;
@@ -1772,17 +1869,12 @@ unit cgcpu;
                 not (po_interrupt in current_procinfo.procdef.procoptions)) or
                ((po_exports in current_procinfo.procdef.procoptions) and
                 (target_info.system=system_i8086_win16)) then
-              list.concat(Taicpu.Op_reg(A_POP,S_W,NR_DS));
+              begin
+                maybe_move_sp;
+                list.concat(Taicpu.Op_reg(A_POP,S_W,NR_DS));
+              end;
             if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
               begin
-                stacksize:=current_procinfo.calc_stackframe_size;
-                if (target_info.stackalign>4) and
-                   ((stacksize <> 0) or
-                    (pi_do_call in current_procinfo.flags) or
-                    { can't detect if a call in this case -> use nostackframe }
-                    { if you (think you) know what you are doing              }
-                    (po_assembler in current_procinfo.procdef.procoptions)) then
-                  stacksize := align(stacksize+sizeof(aint),target_info.stackalign) - sizeof(aint);
                 if (stacksize<>0) then
                   cg.a_op_const_reg(list,OP_ADD,OS_ADDR,stacksize,current_procinfo.framepointer);
               end
@@ -1852,6 +1944,8 @@ unit cgcpu;
         a_load_loc_reg(list,OS_INT,lenloc,NR_DI);
         list.concat(Taicpu.op_reg(A_INC,S_W,NR_DI));
         { Now DI contains (high+1). }
+	
+        include(current_procinfo.flags, pi_has_open_array_parameter);
 
         { special case handling for elesize=2:
           set CX = (high+1) instead of CX = (high+1)*elesize.
@@ -1965,7 +2059,7 @@ unit cgcpu;
 
     procedure tcg8086.g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
       begin
-        { Nothing to release }
+        { Nothing to do }
       end;
 
 

compiler/i8086/cpupara.pas

@@ -236,7 +236,7 @@ unit cpupara;
         psym:=tparavarsym(pd.paras[nr-1]);
         pdef:=psym.vardef;
         if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
-          pdef:=cpointerdef.getreusable(pdef);
+          pdef:=cpointerdef.getreusable_no_free(pdef);
         cgpara.reset;
         cgpara.size:=def_cgsize(pdef);
         cgpara.intsize:=tcgsize2size[cgpara.size];
@@ -442,7 +442,7 @@ unit cpupara;
               begin
                 paralen:=voidpointertype.size;
                 paracgsize:=int_cgsize(voidpointertype.size);
-                paradef:=cpointerdef.getreusable(paradef);
+                paradef:=cpointerdef.getreusable_no_free(paradef);
               end
             else
               begin
@@ -602,7 +602,7 @@ unit cpupara;
                       begin
                         paralen:=voidpointertype.size;
                         paracgsize:=int_cgsize(voidpointertype.size);
-                        paradef:=cpointerdef.getreusable(paradef);
+                        paradef:=cpointerdef.getreusable_no_free(paradef);
                       end
                     else
                       begin

compiler/i8086/hlcgcpu.pas

@@ -74,6 +74,8 @@ interface
       procedure a_load_loc_ref(list : TAsmList;fromsize, tosize: tdef; const loc: tlocation; const ref : treference);override;
       procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override;
 
+      procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister); override;
+
       procedure g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister); override;
       procedure g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation); override;
 
@@ -246,6 +248,15 @@ implementation
       if is_implicit_pointer_object_type(size) or is_implicit_array_pointer(size) then
         size:=voidpointertype;
 
+      { procvars follow the default code pointer size for the current memory model }
+      if size.typ=procvardef then
+        if ((po_methodpointer in tprocvardef(size).procoptions) or
+            is_nested_pd(tprocvardef(size))) and
+           not(po_addressonly in tprocvardef(size).procoptions) then
+          internalerror(2015120101)
+        else
+          size:=voidcodepointertype;
+
       if is_farpointer(size) or is_hugepointer(size) then
         Result:=cg.getintregister(list,OS_32)
       else
@@ -380,6 +391,22 @@ implementation
     end;
 
 
+  procedure thlcgcpu.a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister);
+    begin
+      { implicit pointer types on i8086 follow the default data pointer size for
+        the current memory model }
+      if is_implicit_pointer_object_type(size) or is_implicit_array_pointer(size) then
+        size:=voidpointertype;
+
+      if is_hugepointer(size) then
+        internalerror(2015111201)
+      else if is_farpointer(size) then
+        cg.a_op_const_reg(list,Op,OS_16,a,reg)
+      else
+        inherited a_op_const_reg(list,Op,size,a,reg);
+    end;
+
+
   procedure thlcgcpu.g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister);
     begin
       if paramanager.use_fixed_stack then

compiler/i8086/i8086att.inc

@@ -670,6 +670,7 @@
 'aesdeclast',
 'aesimc',
 'aeskeygenassist',
+'rdtscp',
 'vaddpd',
 'vaddps',
 'vaddsd',

compiler/i8086/i8086atts.inc

@@ -45,8 +45,8 @@ attsufNONE,
 attsufNONE,
 attsufFPU,
 attsufFPU,
-attsufFPU,
-attsufFPU,
+attsufNONE,
+attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufFPU,
@@ -701,6 +701,7 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufNONE,
 attsufMM,
 attsufMM,
 attsufNONE,

compiler/i8086/i8086int.inc

@@ -670,6 +670,7 @@
 'aesdeclast',
 'aesimc',
 'aeskeygenassist',
+'rdtscp',
 'vaddpd',
 'vaddps',
 'vaddsd',

compiler/i8086/i8086nop.inc

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

compiler/i8086/i8086op.inc

@@ -670,6 +670,7 @@ A_AESDEC,
 A_AESDECLAST,
 A_AESIMC,
 A_AESKEYGENASSIST,
+A_RDTSCP,
 A_VADDPD,
 A_VADDPS,
 A_VADDSD,

compiler/i8086/i8086prop.inc

@@ -670,6 +670,7 @@
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_WEAX, Ch_WEDX, Ch_None)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),
 (Ch: (Ch_Wop3, Ch_Rop2, Ch_Rop1)),

compiler/i8086/i8086tab.inc

@@ -378,6 +378,13 @@
     code    : #208#2#15#186#133#21;
     flags   : if_386 or if_sb
   ),
+  (
+    opcode  : A_CALL;
+    ops     : 1;
+    optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none);
+    code    : #212#1#255#130;
+    flags   : if_8086 or if_16bitonly
+  ),
   (
     opcode  : A_CALL;
     ops     : 1;
@@ -2308,56 +2315,56 @@
     ops     : 3;
     optypes : (ot_reg32 or ot_bits64,ot_rm_gpr,ot_immediate or ot_bits8 or ot_signed,ot_none);
     code    : #208#1#107#72#14;
-    flags   : if_286 or if_sm
+    flags   : if_386 or if_sm
   ),
   (
     opcode  : A_IMUL;
     ops     : 3;
     optypes : (ot_reg32 or ot_bits64,ot_rm_gpr,ot_immediate,ot_none);
     code    : #208#1#105#72#34;
-    flags   : if_286 or if_sm or if_sd or if_ar2
+    flags   : if_386 or if_sm or if_sd or if_ar2
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none);
     code    : #208#1#107#64#13;
-    flags   : if_286
+    flags   : if_386
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg32,ot_immediate,ot_none,ot_none);
     code    : #213#1#105#64#33;
-    flags   : if_286 or if_sd
+    flags   : if_386 or if_sd
   ),
   (
     opcode  : A_IMUL;
     ops     : 3;
     optypes : (ot_reg16,ot_rm_gpr,ot_immediate or ot_bits8 or ot_signed,ot_none);
     code    : #212#1#107#72#14;
-    flags   : if_286 or if_sm
+    flags   : if_186 or if_sm
   ),
   (
     opcode  : A_IMUL;
     ops     : 3;
     optypes : (ot_reg16,ot_rm_gpr,ot_immediate,ot_none);
     code    : #212#1#105#72#26;
-    flags   : if_286 or if_sm or if_sw or if_ar2
+    flags   : if_186 or if_sm or if_sw or if_ar2
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg16,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none);
     code    : #212#1#107#64#13;
-    flags   : if_286
+    flags   : if_186
   ),
   (
     opcode  : A_IMUL;
     ops     : 2;
     optypes : (ot_reg16,ot_immediate,ot_none,ot_none);
     code    : #212#1#105#64#25;
-    flags   : if_286 or if_sw
+    flags   : if_186 or if_sw
   ),
   (
     opcode  : A_IMUL;
@@ -2541,6 +2548,13 @@
     code    : #208#1#233#52;
     flags   : if_8086 or if_pass2
   ),
+  (
+    opcode  : A_JMP;
+    ops     : 1;
+    optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none);
+    code    : #212#1#255#132;
+    flags   : if_8086 or if_16bitonly
+  ),
   (
     opcode  : A_JMP;
     ops     : 1;
@@ -4009,7 +4023,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #215#1#157;
-    flags   : if_186 or if_nox86_64
+    flags   : if_8086 or if_nox86_64
   ),
   (
     opcode  : A_POPFD;
@@ -4023,7 +4037,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #212#1#157;
-    flags   : if_186 or if_nox86_64
+    flags   : if_8086 or if_nox86_64
   ),
   (
     opcode  : A_POR;
@@ -4520,14 +4534,14 @@
     ops     : 1;
     optypes : (ot_immediate or ot_bits16,ot_none,ot_none,ot_none);
     code    : #212#1#104#24#221;
-    flags   : if_286
+    flags   : if_186
   ),
   (
     opcode  : A_PUSH;
     ops     : 1;
     optypes : (ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none,ot_none);
     code    : #1#106#12#221;
-    flags   : if_286
+    flags   : if_186
   ),
   (
     opcode  : A_PUSH;
@@ -4569,7 +4583,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #215#1#156;
-    flags   : if_186
+    flags   : if_8086
   ),
   (
     opcode  : A_PUSHFD;
@@ -4583,7 +4597,7 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #212#1#156;
-    flags   : if_186
+    flags   : if_8086
   ),
   (
     opcode  : A_PXOR;
@@ -4618,7 +4632,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#130#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_RCL;
@@ -4660,7 +4674,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#131#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_RCR;
@@ -4807,7 +4821,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#128#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_ROL;
@@ -4849,7 +4863,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#129#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_ROR;
@@ -4919,7 +4933,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#132#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_SAL;
@@ -4968,7 +4982,7 @@
     ops     : 2;
     optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none);
     code    : #208#1#193#135#21;
-    flags   : if_8086 or if_sb
+    flags   : if_186 or if_sb
   ),
   (
     opcode  : A_SAR;
@@ -5115,14 +5129,14 @@
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #1#100;
-    flags   : if_8086 or if_pre
+    flags   : if_386 or if_pre
   ),
   (
     opcode  : A_SEGGS;
     ops     : 0;
     optypes : (ot_none,ot_none,ot_none,ot_none);
     code    : #1#101;
-    flags   : if_8086 or if_pre
+    flags   : if_386 or if_pre
   ),
   (
     opcode  : A_SEGSS;
@@ -8463,6 +8477,13 @@
     code    : #241#3#15#58#223#72#22;
     flags   : if_sse4 or if_sb or if_ar2
   ),
+  (
+    opcode  : A_RDTSCP;
+    ops     : 0;
+    optypes : (ot_none,ot_none,ot_none,ot_none);
+    code    : #3#15#1#249;
+    flags   : if_sse4 or if_sm
+  ),
   (
     opcode  : A_VADDPD;
     ops     : 3;

compiler/i8086/n8086add.pas

@@ -88,6 +88,11 @@ interface
             (rt = pointerconstn) and is_farpointer(rd) and
             is_constintnode(left) and
             (nodetype=addn)
+           ) or
+           (
+            (lt in [pointerconstn,niln]) and is_farpointer(ld) and
+            (rt in [pointerconstn,niln]) and is_farpointer(rd) and
+            (nodetype in [ltn,lten,gtn,gten,equaln,unequaln])
            ) then
           begin
             t:=nil;
@@ -143,6 +148,18 @@ interface
                   else
                     internalerror(2014040606);
                 end;
+              ltn:
+                t:=cordconstnode.create(ord(word(qword(lv))<word(qword(rv))),pasbool8type,true);
+              lten:
+                t:=cordconstnode.create(ord(word(qword(lv))<=word(qword(rv))),pasbool8type,true);
+              gtn:
+                t:=cordconstnode.create(ord(word(qword(lv))>word(qword(rv))),pasbool8type,true);
+              gten:
+                t:=cordconstnode.create(ord(word(qword(lv))>=word(qword(rv))),pasbool8type,true);
+              equaln:
+                t:=cordconstnode.create(ord(lv=rv),pasbool8type,true);
+              unequaln:
+                t:=cordconstnode.create(ord(lv<>rv),pasbool8type,true);
               else
                 internalerror(2014040605);
             end;

compiler/i8086/n8086cnv.pas

@@ -34,6 +34,7 @@ interface
 
        t8086typeconvnode = class(tx86typeconvnode)
        protected
+         function typecheck_int_to_int: tnode;override;
          function typecheck_proc_to_procvar: tnode;override;
          procedure second_proc_to_procvar;override;
        end;
@@ -46,11 +47,22 @@ implementation
       aasmbase,aasmtai,aasmdata,aasmcpu,
       symconst,symdef,symcpu,
       cgbase,cga,procinfo,pass_1,pass_2,
-      ncon,ncal,ncnv,
+      ncon,ncal,ncnv,nmem,n8086mem,
       cpubase,cpuinfo,
       cgutils,cgobj,hlcgobj,cgx86,ncgutil,
       tgobj;
 
+    function t8086typeconvnode.typecheck_int_to_int: tnode;
+      begin
+        Result:=inherited typecheck_int_to_int;
+        if (is_16bitint(totypedef) or is_8bitint(totypedef)) and (left.nodetype=addrn) then
+          begin
+            if left.nodetype=addrn then
+              ti8086addrnode(left).get_offset_only:=true;
+          end;
+      end;
+
+
     function t8086typeconvnode.typecheck_proc_to_procvar: tnode;
       begin
         if (current_settings.x86memorymodel in x86_far_code_models) and

compiler/i8086/n8086con.pas

@@ -34,6 +34,7 @@ interface
 
       ti8086pointerconstnode = class(tcgpointerconstnode)
         constructor create(v : TConstPtrUInt;def:tdef);override;
+        procedure printnodedata(var t: text);override;
         procedure pass_generate_code;override;
       end;
 
@@ -44,7 +45,8 @@ implementation
       symconst,symdef,symcpu,
       defutil,
       cpubase,
-      cga,cgx86,cgobj,cgbase,cgutils;
+      cga,cgx86,cgobj,cgbase,cgutils,
+      node;
 
     {*****************************************************************************
                                T8086POINTERCONSTNODE
@@ -60,6 +62,15 @@ implementation
       end;
 
 
+    procedure ti8086pointerconstnode.printnodedata(var t: text);
+      begin
+        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
+          writeln(t,printnodeindention,'value = $',hexstr(word(value shr 16),4),':',hexstr(word(value),4))
+        else
+          inherited printnodedata(t);
+      end;
+
+
     procedure ti8086pointerconstnode.pass_generate_code;
       begin
         { far pointer? }

compiler/i8086/n8086mat.pas

@@ -397,6 +397,8 @@ implementation
         hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef,false);
         hreg64hi:=left.location.register64.reghi;
         hreg64lo:=left.location.register64.reglo;
+        location.register64.reglo:=hreg64lo;
+        location.register64.reghi:=hreg64hi;
 
         v:=0;
         if right.nodetype=ordconstn then
@@ -425,6 +427,44 @@ implementation
                 emit_const_reg(A_RCR,S_W,1,hreg64lo);
               end;
           end
+        { shifting by >=48 }
+        else if (right.nodetype=ordconstn) and (v>=48) then
+          begin
+            if nodetype=shln then
+              begin
+                cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,hreg64lo,GetNextReg(hreg64hi));
+                cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_16,hreg64lo,hreg64lo);
+                cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_16,GetNextReg(hreg64lo),GetNextReg(hreg64lo));
+                cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_16,hreg64hi,hreg64hi);
+                cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHL,OS_16,v-48,GetNextReg(hreg64hi));
+              end
+            else
+              begin
+                cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,GetNextReg(hreg64hi),hreg64lo);
+                cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_16,GetNextReg(hreg64hi),GetNextReg(hreg64hi));
+                cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_16,hreg64hi,hreg64hi);
+                cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_16,GetNextReg(hreg64lo),GetNextReg(hreg64lo));
+                cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,OS_16,v-48,hreg64lo);
+              end;
+          end
+        { shifting by 32..47 }
+        else if (right.nodetype=ordconstn) and (v>=32) and (v<=47) then
+          begin
+            if nodetype=shln then
+              begin
+                cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_16,hreg64hi,hreg64hi);
+                cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_16,GetNextReg(hreg64hi),GetNextReg(hreg64hi));
+                cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHL,OS_32,v-32,hreg64lo);
+              end
+            else
+              begin
+                cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_16,hreg64lo,hreg64lo);
+                cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_16,GetNextReg(hreg64lo),GetNextReg(hreg64lo));
+                cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,OS_32,v-32,hreg64hi);
+              end;
+            location.register64.reghi:=hreg64lo;
+            location.register64.reglo:=hreg64hi;
+          end
         else
           begin
             { load right operators in a register }
@@ -452,14 +492,24 @@ implementation
               we've already handled them earlier as a special case }
             if right.nodetype<>ordconstn then
               begin
+                if (cs_opt_size in current_settings.optimizerswitches) or
+                   (current_settings.optimizecputype<=cpu_386) then
+                  begin
+                    ai:=Taicpu.Op_Sym(A_JCXZ,S_W,l3);
+                    ai.is_jmp := True;
+                    current_asmdata.CurrAsmList.Concat(ai);
+                  end
+                else
+                  begin
+                    emit_reg_reg(A_TEST,S_W,NR_CX,NR_CX);
+                    cg.a_jmp_flags(current_asmdata.CurrAsmList,F_E,l3);
+                  end;
                 emit_const_reg(A_CMP,S_L,64,NR_CX);
                 cg.a_jmp_flags(current_asmdata.CurrAsmList,F_L,l1);
                 cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_32,hreg64lo,hreg64lo);
                 cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_32,hreg64hi,hreg64hi);
                 cg.a_jmp_always(current_asmdata.CurrAsmList,l3);
                 cg.a_label(current_asmdata.CurrAsmList,l1);
-                emit_reg_reg(A_TEST,S_W,NR_CX,NR_CX);
-                cg.a_jmp_flags(current_asmdata.CurrAsmList,F_E,l3);
               end;
             cg.a_label(current_asmdata.CurrAsmList,l2);
             if nodetype=shln then
@@ -483,9 +533,6 @@ implementation
 
             cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_CX);
           end;
-
-        location.register64.reglo:=hreg64lo;
-        location.register64.reghi:=hreg64hi;
       end;
 
 

compiler/i8086/n8086mem.pas

@@ -36,6 +36,9 @@ interface
         protected
          procedure set_absvarsym_resultdef; override;
          function typecheck_non_proc(realsource: tnode; out res: tnode): boolean; override;
+         procedure pass_generate_code;override;
+        public
+         get_offset_only: boolean;
        end;
 
        ti8086derefnode = class(tx86derefnode)
@@ -91,6 +94,23 @@ implementation
           result:=inherited;
       end;
 
+
+    procedure ti8086addrnode.pass_generate_code;
+      begin
+        if get_offset_only then
+          begin
+            secondpass(left);
+
+            location_reset(location,LOC_REGISTER,OS_16);
+            location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidnearpointertype);
+            if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+              internalerror(2015103001);
+            hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,voidnearpointertype,left.location.reference,location.register);
+          end
+        else
+          inherited;
+      end;
+
 {*****************************************************************************
                              TI8086DEREFNODE
 *****************************************************************************}

compiler/i8086/n8086tcon.pas

@@ -35,6 +35,7 @@ interface
 
       ti8086typedconstbuilder = class(tasmlisttypedconstbuilder)
        protected
+        procedure tc_emit_orddef(def: torddef; var node: tnode);override;
         procedure tc_emit_pointerdef(def: tpointerdef; var node: tnode);override;
       end;
 
@@ -42,10 +43,88 @@ interface
 implementation
 
 uses
-  ncnv,defcmp,defutil,aasmtai,symcpu;
+  verbose,
+  ncon,ncnv,ninl,nld,
+  defcmp,defutil,
+  aasmtai,
+  symconst,symtype,symsym,symcpu,
+  htypechk;
 
     { ti8086typedconstbuilder }
 
+    procedure ti8086typedconstbuilder.tc_emit_orddef(def: torddef; var node: tnode);
+      var
+        hp: tnode;
+        srsym: tsym;
+        pd: tprocdef;
+        resourcestrrec: trecorddef;
+      begin
+        { support word/smallint constants, initialized with Seg() }
+        if (def.ordtype in [u16bit,s16bit]) and (node.nodetype=inlinen) and
+           (tinlinenode(node).inlinenumber=in_seg_x) then
+          begin
+            hp:=tunarynode(node).left;
+            if hp.nodetype=loadn then
+              begin
+                srsym:=tloadnode(hp).symtableentry;
+                case srsym.typ of
+                  procsym :
+                    begin
+                      pd:=tprocdef(tprocsym(srsym).ProcdefList[0]);
+                      if Tprocsym(srsym).ProcdefList.Count>1 then
+                        Message(parser_e_no_overloaded_procvars);
+                      if po_abstractmethod in pd.procoptions then
+                        Message(type_e_cant_take_address_of_abstract_method)
+                      else
+                        ftcb.emit_tai(Tai_const.Create_seg_name(pd.mangledname),u16inttype);
+                    end;
+                  staticvarsym :
+                    ftcb.emit_tai(Tai_const.Create_seg_name(tstaticvarsym(srsym).mangledname),u16inttype);
+                  labelsym :
+                    ftcb.emit_tai(Tai_const.Create_seg_name(tlabelsym(srsym).mangledname),u16inttype);
+                  else
+                    Message(type_e_variable_id_expected);
+                end;
+              end
+            else
+              Message(parser_e_illegal_expression);
+          end
+        { support word/smallint constants, initialized with Ofs() or Word(@s) }
+        else if (def.ordtype in [u16bit,s16bit]) and (node.nodetype=typeconvn) and
+          ((Ttypeconvnode(node).left.nodetype=addrn) or
+             is_proc2procvar_load(Ttypeconvnode(node).left,pd)) then
+          begin
+            hp:=tunarynode(Ttypeconvnode(node).left).left;
+            if hp.nodetype=loadn then
+              begin
+                srsym:=tloadnode(hp).symtableentry;
+                case srsym.typ of
+                  procsym :
+                    begin
+                      pd:=tprocdef(tprocsym(srsym).ProcdefList[0]);
+                      if Tprocsym(srsym).ProcdefList.Count>1 then
+                        Message(parser_e_no_overloaded_procvars);
+                      if po_abstractmethod in pd.procoptions then
+                        Message(type_e_cant_take_address_of_abstract_method)
+                      else
+                        ftcb.emit_tai(Tai_const.Createname(pd.mangledname,0),u16inttype);
+                    end;
+                  staticvarsym :
+                    ftcb.emit_tai(Tai_const.Createname(tstaticvarsym(srsym).mangledname,0),u16inttype);
+                  labelsym :
+                    ftcb.emit_tai(Tai_const.Createname(tlabelsym(srsym).mangledname,0),u16inttype);
+                  else
+                    Message(type_e_variable_id_expected);
+                end;
+              end
+            else
+              Message(parser_e_illegal_expression);
+          end
+        else
+          inherited;
+      end;
+
+
     procedure ti8086typedconstbuilder.tc_emit_pointerdef(def: tpointerdef; var node: tnode);
       var
         hp: tnode;
@@ -60,7 +139,22 @@ uses
                 node.free;
                 node:=hp;
               end;
-        if node.nodetype=niln then
+        { const pointer ? }
+        if (node.nodetype = pointerconstn) then
+          begin
+            ftcb.queue_init(def);
+            if is_farpointer(def) or is_hugepointer(def) then
+              begin
+                ftcb.queue_typeconvn(s32inttype,def);
+                ftcb.queue_emit_ordconst(longint(tpointerconstnode(node).value),s32inttype);
+              end
+            else
+              begin
+                ftcb.queue_typeconvn(s16inttype,def);
+                ftcb.queue_emit_ordconst(smallint(tpointerconstnode(node).value),s16inttype);
+              end;
+          end
+        else if node.nodetype=niln then
           begin
             if is_farpointer(def) or is_hugepointer(def) then
               ftcb.emit_tai(Tai_const.Create_32bit(0),u32inttype)

compiler/jvm/agjasmin.pas

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

compiler/jvm/aoptcpu.pas

@@ -174,6 +174,7 @@ Implementation
   function TCpuAsmOptimizer.PostPeepHoleOptsCpu(var p: tai): boolean;
     begin
       result:=
+        (p.typ=ait_instruction) and
         RemoveLoadLoadSwap(p);
     end;
 

compiler/jvm/cpupara.pas

@@ -160,7 +160,7 @@ implementation
         else if jvmimplicitpointertype(result.def) then
           begin
             retcgsize:=OS_ADDR;
-            result.def:=cpointerdef.getreusable(result.def);
+            result.def:=cpointerdef.getreusable_no_free(result.def);
           end
         else
           begin
@@ -237,7 +237,7 @@ implementation
             else if jvmimplicitpointertype(hp.vardef) then
               begin
                 paracgsize:=OS_ADDR;
-                paradef:=cpointerdef.getreusable(hp.vardef);
+                paradef:=cpointerdef.getreusable_no_free(hp.vardef);
               end
             else
               begin

compiler/jvm/jvmdef.pas

@@ -930,8 +930,8 @@ implementation
                         begin
                           if tdef(container.defowner).typ<>procdef then
                             internalerror(2011040303);
-                          { defid is added to prevent problem with overloads }
-                          result:=tprocdef(container.defowner).procsym.realname+'$$'+tostr(tprocdef(container.defowner).defid)+'$'+result;
+                          { unique_id_str is added to prevent problem with overloads }
+                          result:=tprocdef(container.defowner).procsym.realname+'$$'+tprocdef(container.defowner).unique_id_str+'$'+result;
                           container:=container.defowner.owner;
                         end;
                     end;

compiler/jvm/njvmcnv.pas

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

compiler/jvm/njvmcon.pas

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

compiler/jvm/njvminl.pas

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

compiler/jvm/njvmutil.pas

@@ -204,7 +204,7 @@ implementation
         begin
           vs:=cstaticvarsym.create(sym.realname+'$threadvar',sym.varspez,
             jvmgetthreadvardef(sym.vardef),
-            sym.varoptions - [vo_is_thread_var]);
+            sym.varoptions - [vo_is_thread_var],true);
           sym.owner.insert(vs);
           { make sure that the new sym does not get allocated (we will allocate
             it when encountering the original sym, because only then we know

compiler/jvm/pjvm.pas

@@ -297,7 +297,7 @@ implementation
         { create new class (different internal name than enum to prevent name
           clash; at unit level because we don't want its methods to be nested
           inside a function in case its a local type) }
-        enumclass:=cobjectdef.create(odt_javaclass,'$'+current_module.realmodulename^+'$'+name+'$InternEnum$'+tostr(def.defid),java_jlenum,true);
+        enumclass:=cobjectdef.create(odt_javaclass,'$'+current_module.realmodulename^+'$'+name+'$InternEnum$'+def.unique_id_str,java_jlenum,true);
         tcpuenumdef(def).classdef:=enumclass;
         include(enumclass.objectoptions,oo_is_enum_class);
         include(enumclass.objectoptions,oo_is_sealed);
@@ -343,14 +343,14 @@ implementation
         { create static fields representing all enums }
         for i:=0 to tenumdef(def).symtable.symlist.count-1 do
           begin
-            fsym:=cfieldvarsym.create(tenumsym(tenumdef(def).symtable.symlist[i]).realname,vs_final,enumclass,[]);
+            fsym:=cfieldvarsym.create(tenumsym(tenumdef(def).symtable.symlist[i]).realname,vs_final,enumclass,[],true);
             enumclass.symtable.insert(fsym);
             sym:=make_field_static(enumclass.symtable,fsym);
             { add alias for the field representing ordinal(0), for use in
               initialization code }
             if tenumsym(tenumdef(def).symtable.symlist[i]).value=0 then
               begin
-                aliassym:=cstaticvarsym.create('__FPC_Zero_Initializer',vs_final,enumclass,[vo_is_external]);
+                aliassym:=cstaticvarsym.create('__FPC_Zero_Initializer',vs_final,enumclass,[vo_is_external],true);
                 enumclass.symtable.insert(aliassym);
                 aliassym.set_raw_mangledname(sym.mangledname);
               end;
@@ -373,12 +373,12 @@ implementation
         if tenumdef(def).has_jumps then
           begin
             { add field for the value }
-            fsym:=cfieldvarsym.create('__fpc_fenumval',vs_final,s32inttype,[]);
+            fsym:=cfieldvarsym.create('__fpc_fenumval',vs_final,s32inttype,[],true);
             enumclass.symtable.insert(fsym);
             tobjectsymtable(enumclass.symtable).addfield(fsym,vis_strictprivate);
             { add class field with hash table that maps from FPC-declared ordinal value -> enum instance }
             juhashmap:=search_system_type('JUHASHMAP').typedef;
-            fsym:=cfieldvarsym.create('__fpc_ord2enum',vs_final,juhashmap,[]);
+            fsym:=cfieldvarsym.create('__fpc_ord2enum',vs_final,juhashmap,[],true);
             enumclass.symtable.insert(fsym);
             make_field_static(enumclass.symtable,fsym);
             { add custom constructor }
@@ -435,7 +435,7 @@ implementation
           "Values" instance method -- that's also the reason why we insert the
           field only now, because we cannot disable duplicate identifier
           checking when creating the "Values" method }
-        fsym:=cfieldvarsym.create('$VALUES',vs_final,arrdef,[]);
+        fsym:=cfieldvarsym.create('$VALUES',vs_final,arrdef,[],true);
         fsym.visibility:=vis_strictprivate;
         enumclass.symtable.insert(fsym,false);
         sym:=make_field_static(enumclass.symtable,fsym);
@@ -475,14 +475,17 @@ implementation
           FpcBaseNestedProcVarType, pass nestedfpstruct to constructor and
           copy it }
         if name='' then
-          internalerror(2011071901);
+          begin
+            if is_nested_pd(tabstractprocdef(def)) then
+              internalerror(2011071901);
+          end;
 
         setup_for_new_class('jvm_pvar_class',sstate,islocal,oldsymtablestack);
 
         { create new class (different internal name than pvar to prevent name
           clash; at unit level because we don't want its methods to be nested
           inside a function in case its a local type) }
-        pvclass:=cobjectdef.create(odt_javaclass,'$'+current_module.realmodulename^+'$'+name+'$InternProcvar$'+tostr(def.defid),java_procvarbase,true);
+        pvclass:=cobjectdef.create(odt_javaclass,'$'+current_module.realmodulename^+'$'+name+'$InternProcvar$'+def.unique_id_str,java_procvarbase,true);
         tcpuprocvardef(def).classdef:=pvclass;
         include(pvclass.objectoptions,oo_is_sealed);
         if df_generic in def.defoptions then
@@ -640,10 +643,10 @@ implementation
         wrapperpv.calcparas;
         { no use in creating a callback wrapper here, this procvar type isn't
           for public consumption }
-        jvm_create_procvar_class_intern('__fpc_virtualclassmethod_pv_t'+tostr(wrapperpd.defid),wrapperpv,true);
+        jvm_create_procvar_class_intern('__fpc_virtualclassmethod_pv_t'+wrapperpd.unique_id_str,wrapperpv,true);
         { create alias for the procvar type so we can use it in generated
           Pascal code }
-        typ:=ctypesym.create('__fpc_virtualclassmethod_pv_t'+tostr(wrapperpd.defid),wrapperpv,true);
+        typ:=ctypesym.create('__fpc_virtualclassmethod_pv_t'+wrapperpd.unique_id_str,wrapperpv,true);
         wrapperpv.classdef.typesym.visibility:=vis_strictprivate;
         symtablestack.top.insert(typ);
         symtablestack.pop(pd.owner);
@@ -737,7 +740,7 @@ implementation
             begin
               { make sure we don't emit a definition for this field (we'll do
                 that for the constsym already) -> mark as external }
-              ssym:=cstaticvarsym.create(internal_static_field_name(csym.realname),vs_final,csym.constdef,[vo_is_external]);
+              ssym:=cstaticvarsym.create(internal_static_field_name(csym.realname),vs_final,csym.constdef,[vo_is_external],true);
               csym.owner.insert(ssym);
               { alias storage to the constsym }
               ssym.set_mangledname(csym.realname);
@@ -775,7 +778,7 @@ implementation
                 has been compiler -> insert a copy in the unit's staticsymtable
               }
               symtablestack.push(current_module.localsymtable);
-              ssym:=cstaticvarsym.create(internal_static_field_name(csym.realname),vs_final,tsetdef(csym.constdef).getcopy,[vo_is_external,vo_has_local_copy]);
+              ssym:=cstaticvarsym.create(internal_static_field_name(csym.realname),vs_final,tsetdef(csym.constdef).getcopy,[vo_is_external,vo_has_local_copy],true);
               symtablestack.top.insert(ssym);
               symtablestack.pop(current_module.localsymtable);
               { alias storage to the constsym }
@@ -836,8 +839,8 @@ implementation
         visname:=visibilityName[vis];
         replace(visname,' ','_');
         { create a name that is unique amongst all units (start with '$unitname$$') and
-          unique in this unit (result.defid) }
-        finish_copied_procdef(result,'$'+current_module.realmodulename^+'$$'+tostr(result.defid)+pd.procsym.realname+'$'+visname,obj.symtable,obj);
+          unique in this unit (result.unique_id_str) }
+        finish_copied_procdef(result,'$'+current_module.realmodulename^+'$$'+result.unique_id_str+pd.procsym.realname+'$'+visname,obj.symtable,obj);
         { in case the referred method is from an external class }
         exclude(result.procoptions,po_external);
         { not virtual/override/abstract/... }

compiler/jvm/symcpu.pas

@@ -385,9 +385,9 @@ implementation
             { method of this objectdef }
             pd.struct:=obj;
             { can only construct the artificial accessorname now, because it requires
-              pd.defid }
+              pd.unique_id_str }
             if not explicitwrapper then
-              accessorname:='$'+obj.symtable.realname^+'$'+realname+'$'+accessorname+'$'+tostr(pd.defid);
+              accessorname:='$'+obj.symtable.realname^+'$'+realname+'$'+accessorname+'$'+pd.unique_id_str;
           end
         else
           begin
@@ -397,9 +397,9 @@ implementation
             exclude(pd.procoptions,po_abstractmethod);
             exclude(pd.procoptions,po_overridingmethod);
             { can only construct the artificial accessorname now, because it requires
-              pd.defid }
+              pd.unique_id_str }
             if not explicitwrapper then
-              accessorname:='$'+obj.symtable.realname^+'$'+realname+'$'+accessorname+'$'+tostr(pd.defid);
+              accessorname:='$'+obj.symtable.realname^+'$'+realname+'$'+accessorname+'$'+pd.unique_id_str;
             finish_copied_procdef(pd,accessorname,obj.symtable,obj);
             sym:=pd.procsym;
           end;

compiler/link.pas

@@ -754,7 +754,7 @@ Implementation
          begin
            if showinfo then
              begin
-               if DLLsource then
+               if current_module.islibrary then
                  AsmRes.AddLinkCommand(Command,Para,current_module.sharedlibfilename)
                else
                  AsmRes.AddLinkCommand(Command,Para,current_module.exefilename);

compiler/llvm/aasmllvm.pas

@@ -101,6 +101,8 @@ interface
         constructor getelementptr_reg_size_ref_size_const(dst:tregister;ptrsize:tdef;const ref:treference;indextype:tdef;index1:ptrint;indirect:boolean);
         constructor getelementptr_reg_tai_size_const(dst:tregister;const ai:tai;indextype:tdef;index1:ptrint;indirect:boolean);
 
+        constructor blockaddress(dstreg: tregister; fun, lab: tasmsymbol);
+
         { e.g. dst = call retsize name (paras) }
         constructor call_size_name_paras(callpd: tdef; dst: tregister;retsize: tdef;name:tasmsymbol;paras: tfplist);
         { e.g. dst = call retsize reg (paras) }
@@ -151,7 +153,9 @@ interface
     (
       ldf_definition,   { definition as opposed to (an external) declaration }
       ldf_tls,          { tls definition }
-      ldf_unnamed_addr  { address doesn't matter, only content }
+      ldf_unnamed_addr, { address doesn't matter, only content }
+      ldf_vectorized,   { vectorized, dead-strippable data }
+      ldf_weak          { weak definition }
     );
     taillvmdeclflags = set of taillvmdeclflag;
 
@@ -165,9 +169,11 @@ interface
       sec: TAsmSectiontype;
       alignment: shortint;
       flags: taillvmdeclflags;
+      secname: TSymStr;
       constructor createdecl(_namesym: tasmsymbol; _def: tdef; _initdata: tasmlist; _sec: tasmsectiontype; _alignment: shortint);
       constructor createdef(_namesym: tasmsymbol; _def: tdef; _initdata: tasmlist; _sec: tasmsectiontype; _alignment: shortint);
       constructor createtls(_namesym: tasmsymbol; _def: tdef; _alignment: shortint);
+      procedure setsecname(const name: TSymStr);
       destructor destroy; override;
     end;
 
@@ -181,6 +187,7 @@ interface
         LOC_REGISTER,
         LOC_FPUREGISTER,
         LOC_MMREGISTER: (reg: tregister);
+        LOC_CONSTANT: (value: tcgint);
     end;
 
 
@@ -221,6 +228,14 @@ uses
       end;
 
 
+    procedure taillvmdecl.setsecname(const name: TSymStr);
+      begin
+        if sec<>sec_user then
+          internalerror(2015111501);
+        secname:=name;
+      end;
+
+
     destructor taillvmdecl.destroy;
       begin
         initdata.free;
@@ -421,7 +436,7 @@ uses
       begin
         case llvmopcode of
           la_ret, la_br, la_switch, la_indirectbr,
-          la_invoke, la_resume,
+          la_resume,
           la_unreachable,
           la_store,
           la_fence,
@@ -444,7 +459,7 @@ uses
           la_getelementptr,
           la_load,
           la_icmp, la_fcmp,
-          la_phi, la_select, la_call,
+          la_phi, la_select,
           la_va_arg, la_landingpad:
             begin
               if opnr=0 then
@@ -452,6 +467,19 @@ uses
               else
                 result:=operand_read;
             end;
+          la_invoke, la_call:
+            begin
+              if opnr=1 then
+                result:=operand_write
+              else
+                result:=operand_read;
+            end;
+          la_blockaddress:
+            case opnr of
+              0: result:=operand_write
+              else
+                result:=operand_read;
+            end
           else
             internalerror(2013103101)
         end;
@@ -485,10 +513,18 @@ uses
             end;
           la_invoke, la_call:
             begin
-              if opnr=0 then
-                result:=oper[1]^.def
-              else
-                internalerror(2013110102);
+              case opnr of
+                1: result:=oper[0]^.def;
+                3:
+                  begin
+                    if oper[3]^.typ=top_reg then
+                      result:=oper[2]^.def
+                    else
+                      internalerror(2015112001)
+                  end
+                else
+                  internalerror(2013110102);
+              end;
             end;
           la_br,
           la_unreachable:
@@ -568,6 +604,12 @@ uses
                   internalerror(2013110110);
               end;
             end;
+          la_blockaddress:
+            case opnr of
+              0: result:=voidcodepointertype
+              else
+                internalerror(2015111904);
+            end
           else
             internalerror(2013103101)
         end;
@@ -913,6 +955,15 @@ uses
         loadconst(index+1,index1);
       end;
 
+    constructor taillvm.blockaddress(dstreg: tregister; fun, lab: tasmsymbol);
+      begin
+        create_llvm(la_blockaddress);
+        ops:=3;
+        loadreg(0,dstreg);
+        loadsymbol(1,fun,0);
+        loadsymbol(2,lab,0);
+      end;
+
 
     constructor taillvm.call_size_name_paras(callpd: tdef; dst: tregister; retsize: tdef; name:tasmsymbol; paras: tfplist);
       begin
@@ -923,9 +974,9 @@ uses
           have to insert a type conversion later from the alias def to the
           call def here; we can't always do that at the point the call itself
           is generated, because the alias declaration may occur anywhere }
-        loaddef(0,callpd);
+        loaddef(0,retsize);
         loadreg(1,dst);
-        loaddef(2,retsize);
+        loaddef(2,callpd);
         loadsymbol(3,name,0);
         loadparas(4,paras);
       end;
@@ -935,9 +986,9 @@ uses
       begin
         create_llvm(la_call);
         ops:=5;
-        loaddef(0,callpd);
+        loaddef(0,retsize);
         loadreg(1,dst);
-        loaddef(2,retsize);
+        loaddef(2,callpd);
         loadreg(3,reg);
         loadparas(4,paras);
       end;

compiler/llvm/agllvm.pas

@@ -85,9 +85,10 @@ implementation
       SysUtils,
       cutils,cfileutl,
       fmodule,verbose,
+      objcasm,
       aasmcnst,symconst,symdef,symtable,
       llvmbase,aasmllvm,itllvm,llvmdef,
-      cgbase,cgutils,cpubase;
+      cgbase,cgutils,cpubase,llvminfo;
 
     const
       line_length = 70;
@@ -199,7 +200,7 @@ implementation
       begin
         result:='';
         if assigned(ref.relsymbol) or
-           (assigned(ref.symbol) =
+           (assigned(ref.symbol) and
             (ref.base<>NR_NO)) or
            (ref.index<>NR_NO) or
            (ref.offset<>0) then
@@ -215,13 +216,15 @@ implementation
               result:=result+'index<>NR_NO, ';
             if ref.offset<>0 then
               result:=result+'offset='+tostr(ref.offset);
-            result:=result+')**'
-//            internalerror(2013060225);
+            result:=result+')**';
+            internalerror(2013060225);
           end;
          if ref.base<>NR_NO then
            result:=result+getregisterstring(ref.base)
+         else if assigned(ref.symbol) then
+           result:=result+LlvmAsmSymName(ref.symbol)
          else
-           result:=result+LlvmAsmSymName(ref.symbol);
+           result:=result+'null';
          if withalign then
            result:=result+getreferencealignstring(ref);
       end;
@@ -246,6 +249,8 @@ implementation
              LOC_FPUREGISTER,
              LOC_MMREGISTER:
                result:=result+' '+getregisterstring(para^.reg);
+             LOC_CONSTANT:
+               result:=result+' '+tostr(int64(para^.value));
              else
                internalerror(2014010801);
            end;
@@ -419,6 +424,16 @@ implementation
             sep:=' ';
             opstart:=2;
           end;
+        la_blockaddress:
+          begin
+            owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,false));
+            owner.writer.AsmWrite(' = blockaddress(');
+            owner.writer.AsmWrite(getopstr(taillvm(hp).oper[1]^,false));
+            owner.writer.AsmWrite(',');
+            owner.writer.AsmWrite(getopstr(taillvm(hp).oper[2]^,false));
+            owner.writer.AsmWrite(')');
+            done:=true;
+          end;
         la_alloca:
           begin
             owner.writer.AsmWrite(getreferencestring(taillvm(hp).oper[0]^.ref^,false)+' = ');
@@ -713,6 +728,32 @@ implementation
 
     procedure TLLVMAssember.WriteTai(const replaceforbidden: boolean; const do_line: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
 
+      procedure WriteLinkageVibilityFlags(bind: TAsmSymBind);
+        begin
+          case bind of
+             AB_EXTERNAL:
+               writer.AsmWrite(' external');
+             AB_COMMON:
+               writer.AsmWrite(' common');
+             AB_LOCAL:
+               writer.AsmWrite(' internal');
+             AB_GLOBAL:
+               writer.AsmWrite('');
+             AB_WEAK_EXTERNAL:
+               writer.AsmWrite(' extern_weak');
+             AB_PRIVATE_EXTERN:
+               begin
+                 if not(llvmflag_linker_private in llvmversion_properties[current_settings.llvmversion]) then
+                   writer.AsmWrite(' hidden')
+                 else
+                   writer.AsmWrite(' linker_private');
+               end
+             else
+               internalerror(2014020104);
+           end;
+        end;
+
+
       procedure WriteFunctionFlags(pd: tprocdef);
         begin
           if (pos('FPC_SETJMP',upper(pd.mangledname))<>0) or
@@ -744,11 +785,7 @@ implementation
             tck_record:
               begin
                 writer.AsmWrite(defstr);
-                writer.AsmWrite(' ');
-                if tabstractrecordsymtable(tabstractrecorddef(hp.def).symtable).usefieldalignment<>C_alignment then
-                  writer.AsmWrite('<{')
-                else
-                  writer.AsmWrite('{');
+                writer.AsmWrite(' <{');
                 first:=true;
                 for p in tai_aggregatetypedconst(hp) do
                   begin
@@ -758,10 +795,7 @@ implementation
                       first:=false;
                     WriteTypedConstData(p);
                   end;
-                if tabstractrecordsymtable(tabstractrecorddef(hp.def).symtable).usefieldalignment<>C_alignment then
-                  writer.AsmWrite('}>')
-                else
-                  writer.AsmWrite('}');
+                writer.AsmWrite('}>');
               end;
             tck_array:
               begin
@@ -943,7 +977,10 @@ implementation
                   else
                     begin
                       writer.AsmWrite('define');
-                      writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), '', lpd_decl));
+                      if ldf_weak in taillvmdecl(hp).flags then
+                        writer.AsmWrite(' weak');
+                      WriteLinkageVibilityFlags(taillvmdecl(hp).namesym.bind);
+                      writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), '', lpd_def));
                       WriteFunctionFlags(tprocdef(taillvmdecl(hp).def));
                       writer.AsmWriteln(' {');
                     end;
@@ -951,28 +988,15 @@ implementation
               else
                 begin
                   writer.AsmWrite(LlvmAsmSymName(taillvmdecl(hp).namesym));
-                  case taillvmdecl(hp).namesym.bind of
-                    AB_EXTERNAL:
-                      writer.AsmWrite(' = external ');
-                    AB_COMMON:
-                      writer.AsmWrite(' = common ');
-                    AB_LOCAL:
-                      writer.AsmWrite(' = internal ');
-                    AB_GLOBAL:
-                      writer.AsmWrite(' = ');
-                    AB_WEAK_EXTERNAL:
-                      writer.AsmWrite(' = extern_weak ');
-                    AB_PRIVATE_EXTERN:
-                      writer.AsmWrite('= linker_private ');
-                    else
-                      internalerror(2014020104);
-                  end;
+                  writer.AsmWrite(' =');
+                  if ldf_weak in taillvmdecl(hp).flags then
+                    writer.AsmWrite(' weak');
+                  WriteLinkageVibilityFlags(taillvmdecl(hp).namesym.bind);
+                  writer.AsmWrite(' ');
                   if (ldf_tls in taillvmdecl(hp).flags) then
                     writer.AsmWrite('thread_local ');
                   if ldf_unnamed_addr in taillvmdecl(hp).flags then
                     writer.AsmWrite('unnamed_addr ');
-                  { todo: handle more different section types (mainly
-                      Objective-C }
                   if taillvmdecl(hp).sec in [sec_rodata,sec_rodata_norel] then
                     writer.AsmWrite('constant ')
                   else
@@ -999,6 +1023,21 @@ implementation
                         end;
                       dec(fdecllevel);
                     end;
+                  { custom section name? }
+                  case taillvmdecl(hp).sec of
+                    sec_user:
+                      begin
+                        writer.AsmWrite(', section "');
+                        writer.AsmWrite(taillvmdecl(hp).secname);
+                        writer.AsmWrite('"');
+                      end;
+                    low(TObjCAsmSectionType)..high(TObjCAsmSectionType):
+                      begin
+                        writer.AsmWrite(', section "');
+                        writer.AsmWrite(objc_section_name(taillvmdecl(hp).sec));
+                        writer.AsmWrite('"');
+                      end;
+                  end;
                   { alignment }
                   writer.AsmWrite(', align ');
                   writer.AsmWriteln(tostr(taillvmdecl(hp).alignment));
@@ -1033,12 +1072,6 @@ implementation
               internalerror(2013010708);
             end;
 
-          ait_weak:
-            begin
-              { should be emitted as part of the symbol def }
-              internalerror(2013010709);
-            end;
-
           ait_symbol_end :
             begin
               if tai_symbol_end(hp).sym.typ=AT_FUNCTION then

compiler/llvm/hlcgllvm.pas

@@ -42,6 +42,7 @@ uses
       procedure temp_to_ref(p: ptemprecord; out ref: treference); override;
 
       procedure a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara); override;
+      procedure a_load_const_cgpara(list: TAsmList; tosize: tdef; a: tcgint; const cgpara: TCGPara); override;
      protected
        procedure a_load_ref_cgpara_init_src(list: TAsmList; const para: tcgpara; const initialref: treference; var refsize: tdef; out newref: treference);
      public
@@ -51,7 +52,7 @@ uses
       procedure deallocallcpuregisters(list: TAsmList); override;
 
      protected
-      procedure a_call_common(list: TAsmList; pd: tabstractprocdef; const paras: array of pcgpara; const forceresdef: tdef; out res: tregister; out calldef: tdef; out hlretdef: tdef; out llvmretdef: tdef; out callparas: tfplist);
+      procedure a_call_common(list: TAsmList; pd: tabstractprocdef; const paras: array of pcgpara; const forceresdef: tdef; out res: tregister; out hlretdef: tdef; out llvmretdef: tdef; out callparas: tfplist);
      public
       function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;override;
       function a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; override;
@@ -62,6 +63,9 @@ uses
       procedure a_load_reg_reg(list : TAsmList;fromsize, tosize : tdef;reg1,reg2 : tregister);override;
       procedure a_load_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);override;
       procedure a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference); override;
+     protected
+      procedure a_loadaddr_ref_reg_intern(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister; makefromsizepointer: boolean);
+     public
       procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override;
 
       procedure a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister); override;
@@ -94,10 +98,10 @@ uses
       procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override;
       procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation); override;
 
-      procedure g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tpointerdef; reg: tregister); override;
-      procedure g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tpointerdef; var ref: treference); override;
+      procedure g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tdef; var reg: tregister); override;
+      procedure g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tdef; var ref: treference); override;
 
-      procedure g_set_addr_nonbitpacked_record_field_ref(list: TAsmList; recdef: trecorddef; field: tfieldvarsym; var recref: treference); override;
+      procedure g_set_addr_nonbitpacked_field_ref(list: TAsmList; recdef: tabstractrecorddef; field: tfieldvarsym; var recref: treference); override;
 
       procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle); override;
       procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle); override;
@@ -133,6 +137,9 @@ uses
 
       procedure g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string); override;
 
+     { def is a pointerdef or implicit pointer type (class, classref, procvar,
+       dynamic array, ...).  }
+     function make_simple_ref_ptr(list: TAsmList; const ref: treference; ptrdef: tdef): treference;
       { def is the type of the data stored in memory pointed to by ref, not
         a pointer to this type }
       function make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference;
@@ -183,16 +190,13 @@ implementation
   procedure thlcgllvm.a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara);
     var
       tmpref, initialref, ref: treference;
+      fielddef,
       orgsize: tdef;
-      tmpreg: tregister;
-      hloc: tlocation;
       location: pcgparalocation;
-      orgsizeleft,
       sizeleft,
       totaloffset: asizeint;
       paralocidx: longint;
-      userecord,
-      reghasvalue: boolean;
+      userecord: boolean;
     begin
       location:=cgpara.location;
       sizeleft:=cgpara.intsize;
@@ -207,12 +211,10 @@ implementation
         begin
           if userecord then
             begin
-              { llvmparadef is a record in this case, with every field corresponding
-                to a single paraloc }
-              paraloctoloc(location,hloc);
-              tmpreg:=getaddressregister(list,cpointerdef.getreusable(location^.def));
-              list.concat(taillvm.getelementptr_reg_size_ref_size_const(tmpreg,cpointerdef.getreusable(size),initialref,s32inttype,paralocidx,true));
-              reference_reset_base(tmpref,cpointerdef.getreusable(location^.def),tmpreg,0,newalignment(initialref.alignment,totaloffset));
+              { llvmparadef is a record in this case, with every field
+                corresponding to a single paraloc (fielddef is unused, because
+                it will be equivalent to location^.def -- see below) }
+              g_setup_load_field_by_name(list,trecorddef(size),'F'+tostr(paralocidx),initialref,tmpref,fielddef);
             end
           else
             tmpref:=initialref;
@@ -259,7 +261,11 @@ implementation
                    OS_F128:
                      a_loadmm_ref_reg(list,location^.def,location^.def,tmpref,location^.register,mms_movescalar);
                    OS_M8..OS_M128,
-                   OS_MS8..OS_MS128:
+                   OS_MS8..OS_MS128,
+                   OS_32..OS_128,
+                   { OS_NO is for records of non-power-of-two sizes that have to
+                     be passed in MM registers -> never scalar floats }
+                   OS_NO:
                      a_loadmm_ref_reg(list,location^.def,location^.def,tmpref,location^.register,nil);
                    else
                      internalerror(2010053101);
@@ -276,6 +282,22 @@ implementation
     end;
 
 
+  procedure thlcgllvm.a_load_const_cgpara(list: TAsmList; tosize: tdef; a: tcgint; const cgpara: TCGPara);
+    begin
+      if is_ordinal(cgpara.def) then
+        begin
+          cgpara.check_simple_location;
+          paramanager.alloccgpara(list,cgpara);
+          if cgpara.location^.shiftval<0 then
+            a:=a shl -cgpara.location^.shiftval;
+          cgpara.location^.llvmloc.loc:=LOC_CONSTANT;
+          cgpara.location^.llvmloc.value:=a;
+        end
+      else
+        inherited;
+    end;
+
+
   procedure thlcgllvm.a_load_ref_cgpara_init_src(list: TAsmList; const para: tcgpara; const initialref: treference; var refsize: tdef; out newref: treference);
     var
       newrefsize: tdef;
@@ -335,7 +357,7 @@ implementation
     end;
 
 
-  procedure thlcgllvm.a_call_common(list: TAsmList; pd: tabstractprocdef; const paras: array of pcgpara; const forceresdef: tdef; out res: tregister; out calldef: tdef; out hlretdef: tdef; out llvmretdef: tdef; out callparas: tfplist);
+  procedure thlcgllvm.a_call_common(list: TAsmList; pd: tabstractprocdef; const paras: array of pcgpara; const forceresdef: tdef; out res: tregister; out hlretdef: tdef; out llvmretdef: tdef; out callparas: tfplist);
 
     procedure load_ref_anyreg(def: tdef; const ref: treference; reg: tregister; var callpara: pllvmcallpara);
       begin
@@ -377,36 +399,44 @@ implementation
             new(callpara);
             callpara^.def:=paraloc^.def;
             llvmextractvalueextinfo(paras[i]^.def, callpara^.def, callpara^.valueext);
-            callpara^.loc:=paraloc^.loc;
-            case callpara^.loc of
-              LOC_REFERENCE:
-                begin
-                  if paraloc^.llvmvalueloc then
-                    internalerror(2014012307)
-                  else
+            if paraloc^.llvmloc.loc=LOC_CONSTANT then
+              begin
+                callpara^.loc:=LOC_CONSTANT;
+                callpara^.value:=paraloc^.llvmloc.value;
+              end
+            else
+              begin
+                callpara^.loc:=paraloc^.loc;
+                case callpara^.loc of
+                  LOC_REFERENCE:
                     begin
-                      reference_reset_base(href, cpointerdef.getreusable(callpara^.def), paraloc^.reference.index, paraloc^.reference.offset, paraloc^.def.alignment);
-                      res:=getregisterfordef(list, paraloc^.def);
-                      load_ref_anyreg(callpara^.def, href, res, callpara);
+                      if paraloc^.llvmvalueloc then
+                        internalerror(2014012307)
+                      else
+                        begin
+                          reference_reset_base(href, cpointerdef.getreusable(callpara^.def), paraloc^.reference.index, paraloc^.reference.offset, paraloc^.def.alignment);
+                          res:=getregisterfordef(list, paraloc^.def);
+                          load_ref_anyreg(callpara^.def, href, res, callpara);
+                        end;
+                      callpara^.reg:=res
                     end;
-                  callpara^.reg:=res
-                end;
-              LOC_REGISTER,
-              LOC_FPUREGISTER,
-              LOC_MMREGISTER:
-                begin
-                  { undo explicit value extension }
-                  if callpara^.valueext<>lve_none then
+                  LOC_REGISTER,
+                  LOC_FPUREGISTER,
+                  LOC_MMREGISTER:
                     begin
-                      res:=getregisterfordef(list, callpara^.def);
-                      a_load_reg_reg(list, paraloc^.def, callpara^.def, paraloc^.register, res);
-                      paraloc^.register:=res;
+                      { undo explicit value extension }
+                      if callpara^.valueext<>lve_none then
+                        begin
+                          res:=getregisterfordef(list, callpara^.def);
+                          a_load_reg_reg(list, paraloc^.def, callpara^.def, paraloc^.register, res);
+                          paraloc^.register:=res;
+                        end;
+                        callpara^.reg:=paraloc^.register
                     end;
-                    callpara^.reg:=paraloc^.register
+                  else
+                    internalerror(2014010605);
                 end;
-              else
-                internalerror(2014010605);
-            end;
+              end;
             callparas.add(callpara);
             paraloc:=paraloc^.next;
           end;
@@ -431,16 +461,6 @@ implementation
     if (pd.typ=procvardef) and
        not pd.is_addressonly then
       pd:=tprocvardef(cprocvardef.getreusableprocaddr(pd));
-    { if the function returns a function pointer type or is varargs, we
-      must specify the full function signature, otherwise we can only
-      specify the return type }
-    if (po_varargs in pd.procoptions) or
-       ((pd.proccalloption in cdecl_pocalls) and
-        (pd.paras.count>0) and
-        is_array_of_const(tparavarsym(pd.paras[pd.paras.count-1]).vardef)) then
-      calldef:=get_call_pd(pd)
-    else
-      calldef:=llvmretdef;
   end;
 
 
@@ -448,12 +468,11 @@ implementation
     var
       callparas: tfplist;
       llvmretdef,
-      hlretdef,
-      calldef: tdef;
+      hlretdef: tdef;
       res: tregister;
     begin
-      a_call_common(list,pd,paras,forceresdef,res,calldef,hlretdef,llvmretdef,callparas);
-      list.concat(taillvm.call_size_name_paras(get_call_pd(pd),res,calldef,current_asmdata.RefAsmSymbol(pd.mangledname),callparas));
+      a_call_common(list,pd,paras,forceresdef,res,hlretdef,llvmretdef,callparas);
+      list.concat(taillvm.call_size_name_paras(get_call_pd(pd),res,llvmretdef,current_asmdata.RefAsmSymbol(s),callparas));
       result:=get_call_result_cgpara(pd,forceresdef);
       set_call_function_result(list,pd,llvmretdef,hlretdef,res,result);
     end;
@@ -463,12 +482,11 @@ implementation
     var
       callparas: tfplist;
       llvmretdef,
-      hlretdef,
-      calldef: tdef;
+      hlretdef: tdef;
       res: tregister;
     begin
-      a_call_common(list,pd,paras,nil,res,calldef,hlretdef,llvmretdef,callparas);
-      list.concat(taillvm.call_size_reg_paras(get_call_pd(pd),res,calldef,reg,callparas));
+      a_call_common(list,pd,paras,nil,res,hlretdef,llvmretdef,callparas);
+      list.concat(taillvm.call_size_reg_paras(get_call_pd(pd),res,llvmretdef,reg,callparas));
       result:=get_call_result_cgpara(pd,nil);
       set_call_function_result(list,pd,llvmretdef,hlretdef,res,result);
     end;
@@ -532,8 +550,12 @@ implementation
                 truncate it before storing. Unfortunately, we cannot truncate
                 records (nor bitcast them to integers), so we first have to
                 store them to memory and then bitcast the pointer to them
+
+                We can't truncate an integer to 3/5/6/7 bytes either, so also
+                pass via a temp in that case
               }
-              if fromsize.typ in [arraydef,recorddef] then
+              if (fromsize.typ in [arraydef,recorddef]) or
+                 (tosize.size in [3,5,6,7]) then
                 begin
                   { store struct/array-in-register to memory }
                   tg.gethltemp(list,fromsize,fromsize.size,tt_normal,tmpref);
@@ -713,15 +735,23 @@ implementation
     end;
 
 
-  procedure thlcgllvm.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister);
+  procedure thlcgllvm.a_loadaddr_ref_reg_intern(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister; makefromsizepointer: boolean);
     var
       sref: treference;
     begin
       { can't take the address of a 'named register' }
       if ref.refaddr=addr_full then
         internalerror(2013102306);
-      sref:=make_simple_ref(list,ref,fromsize);
-      list.concat(taillvm.op_reg_size_ref_size(la_bitcast,r,cpointerdef.getreusable(fromsize),sref,tosize));
+      if makefromsizepointer then
+        fromsize:=cpointerdef.getreusable(fromsize);
+      sref:=make_simple_ref_ptr(list,ref,fromsize);
+      list.concat(taillvm.op_reg_size_ref_size(la_bitcast,r,fromsize,sref,tosize));
+    end;
+
+
+  procedure thlcgllvm.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister);
+    begin
+      a_loadaddr_ref_reg_intern(list,fromsize,tosize,ref,r,true);
     end;
 
 
@@ -791,12 +821,14 @@ implementation
                tmpreg1:=getintregister(list,opsize);
                tmpreg2:=getintregister(list,opsize);
                tmpreg3:=getintregister(list,opsize);
-               { tmpreg1 := tcgsize2size[size] - src1 }
-               list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg1,opsize,opsize.size,src1));
-               { tmpreg2 := src2 shr tmpreg1 }
-               a_op_reg_reg_reg(list,OP_SHR,opsize,tmpreg1,src2,tmpreg2);
-               { tmpreg3 := src2 shl src1 }
-               a_op_reg_reg_reg(list,OP_SHL,opsize,src1,src2,tmpreg3);
+               { tmpreg1 := (tcgsize2size[size]*8 - (src1 and (tcgsize2size[size]*8-1) }
+               list.concat(taillvm.op_reg_size_const_reg(la_and,tmpreg1,opsize,opsize.size*8-1,src1));
+               list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg2,opsize,opsize.size*8,tmpreg1));
+               { tmpreg3 := src2 shr tmpreg2 }
+               a_op_reg_reg_reg(list,OP_SHR,opsize,tmpreg2,src2,tmpreg3);
+               { tmpreg2:= src2 shl tmpreg1 }
+               tmpreg2:=getintregister(list,opsize);
+               a_op_reg_reg_reg(list,OP_SHL,opsize,tmpreg1,src2,tmpreg2);
                { dst := tmpreg2 or tmpreg3 }
                a_op_reg_reg_reg(list,OP_OR,opsize,tmpreg2,tmpreg3,dst);
              end;
@@ -805,12 +837,14 @@ implementation
                tmpreg1:=getintregister(list,size);
                tmpreg2:=getintregister(list,size);
                tmpreg3:=getintregister(list,size);
-               { tmpreg1 := tcgsize2size[size] - src1 }
-               list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg1,opsize,opsize.size,src1));
-               { tmpreg2 := src2 shl tmpreg1 }
-               a_op_reg_reg_reg(list,OP_SHL,opsize,tmpreg1,src2,tmpreg2);
-               { tmpreg3 := src2 shr src1 }
-               a_op_reg_reg_reg(list,OP_SHR,opsize,src1,src2,tmpreg3);
+               { tmpreg1 := (tcgsize2size[size]*8 - (src1 and (tcgsize2size[size]*8-1) }
+               list.concat(taillvm.op_reg_size_const_reg(la_and,tmpreg1,opsize,opsize.size*8-1,src1));
+               list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg2,opsize,opsize.size*8,tmpreg1));
+               { tmpreg3 := src2 shl tmpreg2 }
+               a_op_reg_reg_reg(list,OP_SHL,opsize,tmpreg2,src2,tmpreg3);
+               { tmpreg2:= src2 shr tmpreg1 }
+               tmpreg2:=getintregister(list,opsize);
+               a_op_reg_reg_reg(list,OP_SHR,opsize,tmpreg1,src2,tmpreg2);
                { dst := tmpreg2 or tmpreg3 }
                a_op_reg_reg_reg(list,OP_OR,opsize,tmpreg2,tmpreg3,dst);
              end;
@@ -830,26 +864,78 @@ implementation
 
 
   procedure thlcgllvm.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation);
+    var
+      hreg: tregister;
     begin
       if not setflags then
         begin
           inherited;
           exit;
         end;
-      { use xxx.with.overflow intrinsics }
-      internalerror(2012111102);
+      hreg:=getintregister(list,size);
+      a_load_const_reg(list,size,a,hreg);
+      a_op_reg_reg_reg_checkoverflow(list,op,size,hreg,src,dst,setflags,ovloc);
     end;
 
 
   procedure thlcgllvm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
-    begin
-      if not setflags then
+    var
+      calcsize: tdef;
+      tmpsrc1,
+      tmpsrc2,
+      tmpdst: tregister;
+      signed,
+      docheck: boolean;
+    begin
+      docheck:=size.size>=ossinttype.size;
+      if not setflags or
+         not docheck then
         begin
-          inherited;
+          inherited a_op_reg_reg_reg_checkoverflow(list,op,size,src1,src2,dst,false,ovloc);
           exit;
         end;
-      { use xxx.with.overflow intrinsics }
-      internalerror(2012111103);
+      { extend values to twice their original width (one bit extra is enough,
+        but adding support for 9/17/33/65 bit types just for this is overkill) }
+      signed:=is_signed(size);
+      case size.size of
+        1:
+          if signed then
+            calcsize:=s16inttype
+          else
+            calcsize:=u16inttype;
+        2:
+          if signed then
+            calcsize:=s32inttype
+          else
+            calcsize:=u32inttype;
+        4:
+          if signed then
+            calcsize:=s64inttype
+          else
+            calcsize:=u64inttype;
+        8:
+          if signed then
+            calcsize:=s128inttype
+          else
+            calcsize:=u128inttype;
+        else
+          internalerror(2015122503);
+      end;
+      tmpsrc1:=getintregister(list,calcsize);
+      a_load_reg_reg(list,size,calcsize,src1,tmpsrc1);
+      tmpsrc2:=getintregister(list,calcsize);
+      a_load_reg_reg(list,size,calcsize,src2,tmpsrc2);
+      tmpdst:=getintregister(list,calcsize);
+      { perform the calculation with twice the width }
+      a_op_reg_reg_reg(list,op,calcsize,tmpsrc1,tmpsrc2,tmpdst);
+      { signed/unsigned overflow occurs if signed/unsigned truncation of the
+        result is different from the actual result -> extend again and compare }
+      a_load_reg_reg(list,calcsize,size,tmpdst,dst);
+      tmpsrc1:=getintregister(list,calcsize);
+      a_load_reg_reg(list,size,calcsize,dst,tmpsrc1);
+      location_reset(ovloc,LOC_REGISTER,OS_8);
+      ovloc.register:=getintregister(list,pasbool8type);
+      list.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,ovloc.register,OC_NE,calcsize,tmpsrc1,tmpdst));
     end;
 
 
@@ -939,20 +1025,20 @@ implementation
       sizepara.init;
       alignpara.init;
       volatilepara.init;
-      paramanager.getintparaloc(list,pd,1,sourcepara);
-      paramanager.getintparaloc(list,pd,2,destpara);
+      paramanager.getintparaloc(list,pd,1,destpara);
+      paramanager.getintparaloc(list,pd,2,sourcepara);
       paramanager.getintparaloc(list,pd,3,sizepara);
       paramanager.getintparaloc(list,pd,4,alignpara);
       paramanager.getintparaloc(list,pd,5,volatilepara);
-      a_loadaddr_ref_cgpara(list,size,source,sourcepara);
       a_loadaddr_ref_cgpara(list,size,dest,destpara);
+      a_loadaddr_ref_cgpara(list,size,source,sourcepara);
       a_load_const_cgpara(list,u64inttype,size.size,sizepara);
       maxalign:=newalignment(source.alignment,dest.alignment);
       a_load_const_cgpara(list,u32inttype,maxalign,alignpara);
       { we don't know anything about volatility here, should become an extra
         parameter to g_concatcopy }
       a_load_const_cgpara(list,pasbool8type,0,volatilepara);
-      g_call_system_proc(list,pd,[@sourcepara,@destpara,@sizepara,@alignpara,@volatilepara],nil).resetiftemp;
+      g_call_system_proc(list,pd,[@destpara,@sourcepara,@sizepara,@alignpara,@volatilepara],nil).resetiftemp;
       sourcepara.done;
       destpara.done;
       sizepara.done;
@@ -1178,9 +1264,11 @@ implementation
             LOC_FPUREGISTER,
             LOC_MMREGISTER:
               begin
-                resloc.check_simple_location;
-                list.concat(taillvm.op_reg_size_undef(la_bitcast,resloc.location^.register,resloc.location^.def));
+                list.concat(taillvm.op_reg_size_undef(la_bitcast,resloc.location^.register,llvmgetcgparadef(resloc,true)));
               end;
+            { for empty record returns }
+            LOC_VOID:
+              ;
             else
               internalerror(2015042301);
           end;
@@ -1196,45 +1284,103 @@ implementation
 
 
   procedure thlcgllvm.g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; var ovloc: tlocation);
+    var
+      hl: tasmlabel;
     begin
-      { todo }
-      internalerror(2012111108);
+      if not(cs_check_overflow in current_settings.localswitches) then
+        exit;
+      if ovloc.size<>OS_8 then
+        internalerror(2015122504);
+      current_asmdata.getjumplabel(hl);
+      a_cmp_const_loc_label(list,pasbool8type,OC_EQ,0,ovloc,hl);
+      g_call_system_proc(list,'fpc_overflow',[],nil);
+      a_label(list,hl);
     end;
 
 
-  procedure thlcgllvm.g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tpointerdef; reg: tregister);
+  procedure thlcgllvm.g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tdef; var reg: tregister);
+    var
+      hreg: tregister;
     begin
       { will insert a bitcast if necessary }
-      a_load_reg_reg(list,fromdef,todef,reg,reg);
+      if fromdef<>todef then
+        begin
+          hreg:=getregisterfordef(list,todef);
+          a_load_reg_reg(list,fromdef,todef,reg,hreg);
+          reg:=hreg;
+        end;
     end;
 
 
-  procedure thlcgllvm.g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tpointerdef; var ref: treference);
+  procedure thlcgllvm.g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tdef; var ref: treference);
     var
       hreg: tregister;
     begin
       hreg:=getaddressregister(list,todef);
-      a_loadaddr_ref_reg(list,fromdef.pointeddef,todef,ref,hreg);
+      a_loadaddr_ref_reg_intern(list,fromdef,todef,ref,hreg,false);
       reference_reset_base(ref,todef,hreg,0,ref.alignment);
     end;
 
 
-  procedure thlcgllvm.g_set_addr_nonbitpacked_record_field_ref(list: TAsmList; recdef: trecorddef; field: tfieldvarsym; var recref: treference);
+  procedure thlcgllvm.g_set_addr_nonbitpacked_field_ref(list: TAsmList; recdef: tabstractrecorddef; field: tfieldvarsym; var recref: treference);
     var
-      llvmfielddef,
-      llvmfieldptrdef,
-      subscriptdef: tdef;
+      parentdef,
+      subscriptdef,
+      currentstructdef,
+      llvmfielddef: tdef;
       newbase: tregister;
-    begin
+      implicitpointer: boolean;
+    begin
+      implicitpointer:=is_implicit_pointer_object_type(recdef);
+      currentstructdef:=recdef;
+      { in case the field is part of a parent of the current object,
+        index into the parents until we're at the parent containing the
+        field; if it's an implicit pointer type, these embedded parents
+        will be of the structure type of the class rather than of the
+        class time itself -> one indirection fewer }
+      while field.owner<>tabstractrecorddef(currentstructdef).symtable do
+        begin
+          { only objectdefs have parents and hence the owner of the
+            fieldvarsym can be different from the current def's owner }
+          parentdef:=tobjectdef(currentstructdef).childof;
+          if implicitpointer then
+            newbase:=getaddressregister(list,parentdef)
+          else
+            newbase:=getaddressregister(list,cpointerdef.getreusable(parentdef));
+          recref:=make_simple_ref(list,recref,recdef);
+          if implicitpointer then
+            subscriptdef:=currentstructdef
+          else
+            subscriptdef:=cpointerdef.getreusable(currentstructdef);
+          { recurse into the first field }
+          list.concat(taillvm.getelementptr_reg_size_ref_size_const(newbase,subscriptdef,recref,s32inttype,0,true));
+          reference_reset_base(recref,subscriptdef,newbase,field.offsetfromllvmfield,newalignment(recref.alignment,field.fieldoffset));
+          { go to the parent }
+          currentstructdef:=parentdef;
+        end;
       { get the type of the corresponding field in the llvm shadow
         definition }
-      llvmfielddef:=tabstractrecordsymtable(recdef.symtable).llvmst[field].def;
-      subscriptdef:=cpointerdef.getreusable(recdef);
+      llvmfielddef:=tabstractrecordsymtable(tabstractrecorddef(currentstructdef).symtable).llvmst[field].def;
+      if implicitpointer then
+        subscriptdef:=currentstructdef
+      else
+        subscriptdef:=cpointerdef.getreusable(currentstructdef);
       { load the address of that shadow field }
-      newbase:=hlcg.getaddressregister(list,cpointerdef.getreusable(llvmfielddef));
-      recref:=thlcgllvm(hlcg).make_simple_ref(list,recref,recdef);
+      newbase:=getaddressregister(list,cpointerdef.getreusable(llvmfielddef));
+      recref:=make_simple_ref(list,recref,recdef);
       list.concat(taillvm.getelementptr_reg_size_ref_size_const(newbase,subscriptdef,recref,s32inttype,field.llvmfieldnr,true));
-      reference_reset_base(recref,cpointerdef.getreusable(field.vardef),newbase,field.offsetfromllvmfield,newalignment(recref.alignment,field.fieldoffset+field.offsetfromllvmfield));
+      reference_reset_base(recref,subscriptdef,newbase,field.offsetfromllvmfield,newalignment(recref.alignment,field.fieldoffset+field.offsetfromllvmfield));
+      { in case of an 80 bits extended type, typecast from an array of 10
+        bytes (used because otherwise llvm will allocate the ABI-defined
+        size for extended, which is usually larger) into an extended }
+      if (llvmfielddef.typ=floatdef) and
+         (tfloatdef(llvmfielddef).floattype=s80real) then
+        g_ptrtypecast_ref(list,cpointerdef.getreusable(carraydef.getreusable(u8inttype,10)),cpointerdef.getreusable(s80floattype),recref);
+      { if it doesn't match the requested field exactly (variant record),
+        adjust the type of the pointer }
+      if (field.offsetfromllvmfield<>0) or
+         (llvmfielddef<>field.vardef) then
+        g_ptrtypecast_ref(list,cpointerdef.getreusable(llvmfielddef),cpointerdef.getreusable(field.vardef),recref);
     end;
 
 
@@ -1249,12 +1395,11 @@ implementation
         a_loadfpu_ref_reg(list,fromsize,tosize,ref,reg)
       else
         begin
-          { todo }
-          if fromsize<>tosize then
-            internalerror(2013060220);
           href:=make_simple_ref(list,ref,fromsize);
+          if fromsize<>tosize then
+            g_ptrtypecast_ref(list,cpointerdef.create(fromsize),cpointerdef.create(tosize),href);
           { %reg = load size* %ref }
-          list.concat(taillvm.op_reg_size_ref(la_load,reg,cpointerdef.getreusable(fromsize),href));
+          list.concat(taillvm.op_reg_size_ref(la_load,reg,cpointerdef.getreusable(tosize),href));
         end;
     end;
 
@@ -1390,6 +1535,7 @@ implementation
       hloc        : tlocation;
       href, href2 : treference;
       hreg        : tregister;
+      fielddef,
       llvmparadef : tdef;
       index       : longint;
       offset      : pint;
@@ -1423,15 +1569,11 @@ implementation
               reference_reset_base(href,cpointerdef.getreusable(llvmparadef),hreg,0,destloc.reference.alignment);
             end;
           index:=0;
-          offset:=0;
           ploc:=para.location;
           repeat
             paraloctoloc(ploc,hloc);
-            hreg:=getaddressregister(list,cpointerdef.getreusable(ploc^.def));
-            list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg,cpointerdef.getreusable(llvmparadef),href,s32inttype,index,true));
-            reference_reset_base(href2,cpointerdef.getreusable(ploc^.def),hreg,0,newalignment(href.alignment,offset));
-            a_load_loc_ref(list,ploc^.def,ploc^.def,hloc,href2);
-            inc(offset,ploc^.def.size);
+            g_setup_load_field_by_name(list,trecorddef(llvmparadef),'F'+tostr(index),href,href2,fielddef);
+            a_load_loc_ref(list,ploc^.def,fielddef,hloc,href2);
             inc(index);
             ploc:=ploc^.next;
           until not assigned(ploc);
@@ -1526,12 +1668,18 @@ implementation
 
 
   function thlcgllvm.make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference;
+    begin
+      result:=make_simple_ref_ptr(list,ref,cpointerdef.create(def));
+    end;
+
+
+  function thlcgllvm.make_simple_ref_ptr(list: TAsmList; const ref: treference; ptrdef: tdef): treference;
     var
       ptrindex: tcgint;
       hreg1,
       hreg2: tregister;
       tmpref: treference;
-      defsize: asizeint;
+      pointedsize: asizeint;
     begin
       { already simple? }
       if (not assigned(ref.symbol) or
@@ -1542,24 +1690,36 @@ implementation
           result:=ref;
           exit;
         end;
-
-      hreg2:=getaddressregister(list,cpointerdef.getreusable(def));
-      defsize:=def.size;
-      { for voiddef/formaldef }
-      if defsize=0 then
-        defsize:=1;
+      case ptrdef.typ of
+        pointerdef:
+          begin
+            pointedsize:=tpointerdef(ptrdef).pointeddef.size;
+            { void, formaldef }
+            if pointedsize=0 then
+              pointedsize:=1;
+          end;
+        else
+          begin
+            { pointedsize is only used if the offset <> 0, to see whether we
+              can use getelementptr if it's an exact multiple -> set pointedsize
+              to a value that will never be a multiple as we can't "index" other
+              types }
+            pointedsize:=ref.offset+1;
+          end;
+      end;
+      hreg2:=getaddressregister(list,ptrdef);
       { symbol+offset or base+offset with offset a multiple of the size ->
         use getelementptr }
       if (ref.index=NR_NO) and
-         (ref.offset mod defsize=0) then
+         (ref.offset mod pointedsize=0) then
         begin
-          ptrindex:=ref.offset div defsize;
+          ptrindex:=ref.offset div pointedsize;
           if assigned(ref.symbol) then
             reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment)
           else
-            reference_reset_base(tmpref,cpointerdef.getreusable(def),ref.base,0,ref.alignment);
-          list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg2,cpointerdef.getreusable(def),tmpref,ptruinttype,ptrindex,assigned(ref.symbol)));
-          reference_reset_base(result,cpointerdef.getreusable(def),hreg2,0,ref.alignment);
+            reference_reset_base(tmpref,ptrdef,ref.base,0,ref.alignment);
+          list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg2,ptrdef,tmpref,ptruinttype,ptrindex,assigned(ref.symbol)));
+          reference_reset_base(result,ptrdef,hreg2,0,ref.alignment);
           exit;
         end;
       { for now, perform all calculations using plain pointer arithmetic. Later
@@ -1567,7 +1727,7 @@ implementation
         accesses (if only to prevent running out of virtual registers).
 
         Assumptions:
-          * symbol/base register: always type "def*"
+          * symbol/base register: always type "ptrdef"
           * index/offset: always type "ptruinttype" (llvm bitcode has no sign information, so sign doesn't matter) }
       hreg1:=getintregister(list,ptruinttype);
       if assigned(ref.symbol) then
@@ -1575,11 +1735,11 @@ implementation
           if ref.base<>NR_NO then
             internalerror(2012111301);
           reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment);
-          list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg1,cpointerdef.getreusable(def),tmpref,ptruinttype,0,true));
+          list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg1,ptrdef,tmpref,ptruinttype,0,true));
         end
       else if ref.base<>NR_NO then
         begin
-          a_load_reg_reg(list,cpointerdef.getreusable(def),ptruinttype,ref.base,hreg1);
+          a_load_reg_reg(list,ptrdef,ptruinttype,ref.base,hreg1);
         end
       else
         { todo: support for absolute addresses on embedded platforms }
@@ -1597,14 +1757,15 @@ implementation
           a_op_const_reg_reg(list,OP_ADD,ptruinttype,ref.offset,hreg1,hreg2);
           hreg1:=hreg2;
         end;
-      hreg2:=getaddressregister(list,cpointerdef.getreusable(def));
-      a_load_reg_reg(list,ptruinttype,cpointerdef.getreusable(def),hreg1,hreg2);
-      reference_reset_base(result,cpointerdef.getreusable(def),hreg2,0,ref.alignment);
+      hreg2:=getaddressregister(list,ptrdef);
+      a_load_reg_reg(list,ptruinttype,ptrdef,hreg1,hreg2);
+      reference_reset_base(result,ptrdef,hreg2,0,ref.alignment);
     end;
 
 
   procedure thlcgllvm.set_call_function_result(const list: TAsmList; const pd: tabstractprocdef; const llvmretdef, hlretdef: tdef; const resval: tregister; var retpara: tcgpara);
     var
+      hreg: tregister;
       rettemp: treference;
     begin
       if not is_void(hlretdef) and
@@ -1619,13 +1780,21 @@ implementation
               { to ease the handling of aggregate types here, we just store
                 everything to memory rather than potentially dealing with aggregates
                 in "registers" }
-              tg.gethltemp(list, hlretdef, hlretdef.size, tt_normal, rettemp);
-              a_load_reg_ref(list, llvmretdef, hlretdef, resval, rettemp);
+              tg.gethltemp(list, llvmretdef, llvmretdef.size, tt_normal, rettemp);
+              case def2regtyp(llvmretdef) of
+                R_INTREGISTER,
+                R_ADDRESSREGISTER:
+                  a_load_reg_ref(list,llvmretdef,llvmretdef,resval,rettemp);
+                R_FPUREGISTER:
+                  a_loadfpu_reg_ref(list,llvmretdef,llvmretdef,resval,rettemp);
+                R_MMREGISTER:
+                  a_loadmm_reg_ref(list,llvmretdef,llvmretdef,resval,rettemp,mms_movescalar);
+              end;
               { the return parameter now contains a value whose type matches the one
                 that the high level code generator expects instead of the llvm shim
               }
-              retpara.def:=hlretdef;
-              retpara.location^.def:=hlretdef;
+              retpara.def:=llvmretdef;
+              retpara.location^.def:=llvmretdef;
               { for llvm-specific code:  }
               retpara.location^.llvmvalueloc:=false;
               retpara.location^.llvmloc.loc:=LOC_REGISTER;
@@ -1637,8 +1806,10 @@ implementation
             end
           else
             begin
-              retpara.Location^.llvmloc.loc:=retpara.location^.loc;
+              retpara.def:=llvmretdef;
+              retpara.Location^.def:=llvmretdef;
               retpara.location^.llvmloc.reg:=resval;
+              retpara.Location^.llvmloc.loc:=retpara.location^.loc;
               retpara.Location^.llvmvalueloc:=true;
             end;
         end

compiler/llvm/itllvm.pas

@@ -57,6 +57,7 @@ interface
         'icmp', 'fcmp',
         'phi', 'select', 'call',
         'va_arg', 'landingpad',
+        'blockaddress',
         { fpc pseudo opcodes }
         'type', { type definition }
         'invalid1', { la_x_to_inttoptr }

compiler/llvm/llvmbase.pas

@@ -65,6 +65,7 @@ interface
       la_icmp, la_fcmp,
       la_phi, la_select, la_call,
       la_va_arg, la_landingpad,
+      la_blockaddress,
       { fpc pseudo opcodes }
       la_type, { type definition }
       la_x_to_inttoptr, { have to convert something first to int before it can be converted to a pointer }

compiler/llvm/llvmdef.pas

@@ -35,16 +35,17 @@ interface
 
    type
      { there are three different circumstances in which procdefs are used:
-        a) definition of a procdef that's implemented in the current module or
-           declaration of an external routine that's called in the current one
-        b) alias declaration of a procdef implemented in the current module
-        c) defining a procvar type
+        a) definition of a procdef that's implemented in the current module
+        b) declaration of an external routine that's called in the current one
+        c) alias declaration of a procdef implemented in the current module
+        d) defining a procvar type
        The main differences between the contexts are:
         a) information about sign extension of result type, proc name, parameter names & sign-extension info & types
-        b) no information about sign extension of result type, proc name, no parameter names, no information about sign extension of parameters, parameter types
-        c) no information about sign extension of result type, no proc name, no parameter names, no information about sign extension of parameters, parameter types
+        b) information about sign extension of result type, proc name, no parameter names, with parameter sign-extension info & types
+        c) no information about sign extension of result type, proc name, no parameter names, no information about sign extension of parameters, parameter types
+        d) no information about sign extension of result type, no proc name, no parameter names, no information about sign extension of parameters, parameter types
       }
-     tllvmprocdefdecltype = (lpd_decl,lpd_alias,lpd_procvar);
+     tllvmprocdefdecltype = (lpd_def,lpd_decl,lpd_alias,lpd_procvar);
 
     { returns the identifier to use as typename for a def in llvm (llvm only
       allows naming struct types) -- only supported for defs with a typesym, and
@@ -128,7 +129,7 @@ implementation
     begin
       if not assigned(def.typesym) then
         internalerror(2015041901);
-      result:='%"typ.'+def.fullownerhierarchyname+'.'+def.typesym.realname+'"'
+      result:='%"typ.'+def.fullownerhierarchyname+def.typesym.realname+'"'
     end;
 
 
@@ -262,7 +263,8 @@ implementation
       result:=
         ((paraloc^.loc=LOC_REFERENCE) and
          llvmaggregatetype(paraloc^.def)) or
-        (paraloc^.shiftval<>0)
+        ((paraloc^.loc in [LOC_REGISTER,LOC_CREGISTER]) and
+         (paraloc^.shiftval<>0))
     end;
 
 
@@ -273,6 +275,8 @@ implementation
     tllvmencodeflags = set of tllvmencodeflag;
 
     procedure llvmaddencodedtype_intern(def: tdef; const flags: tllvmencodeflags; var encodedstr: TSymStr);
+      var
+        elesize: asizeint;
       begin
         case def.typ of
           stringdef :
@@ -380,8 +384,15 @@ implementation
             end;
           classrefdef :
             begin
-              llvmaddencodedtype_intern(tobjectdef(tclassrefdef(def).pointeddef).vmt_def,flags,encodedstr);
-              encodedstr:=encodedstr+'*';
+              if is_class(tclassrefdef(def).pointeddef) then
+                begin
+                  llvmaddencodedtype_intern(tobjectdef(tclassrefdef(def).pointeddef).vmt_def,flags,encodedstr);
+                  encodedstr:=encodedstr+'*';
+                end
+              else if is_objcclass(tclassrefdef(def).pointeddef) then
+                llvmaddencodedtype_intern(objc_idtype,flags,encodedstr)
+              else
+                encodedstr:=encodedstr+'i8*'
             end;
           setdef :
             begin
@@ -418,12 +429,14 @@ implementation
                   llvmaddencodedtype_intern(tarraydef(def).elementdef,[],encodedstr);
                   encodedstr:=encodedstr+'*';
                 end
-              else if is_packed_array(def) then
+              else if is_packed_array(def) and
+                      (tarraydef(def).elementdef.typ in [enumdef,orddef]) then
                 begin
-                  encodedstr:=encodedstr+'['+tostr(tarraydef(def).size div tarraydef(def).elementdef.packedbitsize)+' x ';
+                  elesize:=packedbitsloadsize(tarraydef(def).elementdef.packedbitsize);
+                  encodedstr:=encodedstr+'['+tostr(tarraydef(def).size div elesize)+' x ';
                   { encode as an array of integers with the size on which we
                     perform the packedbits operations }
-                  llvmaddencodedtype_intern(cgsize_orddef(int_cgsize(packedbitsloadsize(tarraydef(def).elementdef.packedbitsize))),[lef_inaggregate],encodedstr);
+                  llvmaddencodedtype_intern(cgsize_orddef(int_cgsize(elesize)),[lef_inaggregate],encodedstr);
                   encodedstr:=encodedstr+']';
                 end
               else
@@ -453,12 +466,12 @@ implementation
                 end
               else
                 begin
-                  encodedstr:=encodedstr+'{';
+                  encodedstr:=encodedstr+'<{';
                   { code pointer }
                   llvmaddencodedproctype(tabstractprocdef(def),'',lpd_procvar,encodedstr);
                   { data pointer (maybe todo: generate actual layout if
                     available) }
-                  encodedstr:=encodedstr+'*, i8*}';
+                  encodedstr:=encodedstr+'*, i8*}>';
                 end;
             end;
           objectdef :
@@ -478,10 +491,16 @@ implementation
                     encodedstr:=encodedstr+'*'
                 end;
               odt_interfacecom,
+              odt_interfacecorba,
+              odt_dispinterface:
+                begin
+                  { type is a pointer to a pointer to the vmt }
+                  llvmaddencodedtype_intern(tobjectdef(def).vmt_def,flags,encodedstr);
+                  if ([lef_typedecl,lef_noimplicitderef]*flags=[]) then
+                    encodedstr:=encodedstr+'**';
+                end;
               odt_interfacecom_function,
               odt_interfacecom_property,
-              odt_interfacecorba,
-              odt_dispinterface,
               odt_objcprotocol:
                 begin
                   { opaque for now }
@@ -523,13 +542,16 @@ implementation
         st: tllvmshadowsymtable;
         symdeflist: tfpobjectlist;
         i: longint;
+        nopacked: boolean;
       begin
         st:=tabstractrecordsymtable(def.symtable).llvmst;
         symdeflist:=st.symdeflist;
 
-        if tabstractrecordsymtable(def.symtable).usefieldalignment<>C_alignment then
-          encodedstr:=encodedstr+'<';
-        encodedstr:=encodedstr+'{ ';
+        nopacked:=df_llvm_no_struct_packing in def.defoptions;
+        if nopacked then
+          encodedstr:=encodedstr+'{ '
+        else
+          encodedstr:=encodedstr+'<{ ';
         if symdeflist.count>0 then
           begin
             i:=0;
@@ -551,9 +573,10 @@ implementation
                 inc(i);
               end;
           end;
-        encodedstr:=encodedstr+' }';
-        if tabstractrecordsymtable(def.symtable).usefieldalignment<>C_alignment then
-          encodedstr:=encodedstr+'>';
+        if nopacked then
+          encodedstr:=encodedstr+' }'
+        else
+          encodedstr:=encodedstr+' }>';
       end;
 
 
@@ -592,7 +615,10 @@ implementation
             encodedstr:=encodedstr+'...';
             exit
           end;
-        paraloc:=hp.paraloc[calleeside].location;
+        if withparaname then
+          paraloc:=hp.paraloc[calleeside].location
+        else
+          paraloc:=hp.paraloc[callerside].location;
         repeat
           usedef:=paraloc^.def;
           llvmextractvalueextinfo(hp.vardef,usedef,signext);
@@ -659,18 +685,26 @@ implementation
         paranr: longint;
         hp: tparavarsym;
         signext: tllvmvalueextension;
+        useside: tcallercallee;
         first: boolean;
       begin
-        def.init_paraloc_info(calleeside);
+        { when writing a definition, we have to write the parameter names, and
+          those are only available on the callee side. In all other cases,
+          we are at the callerside }
+        if pddecltype=lpd_def then
+          useside:=calleeside
+        else
+          useside:=callerside;
+        def.init_paraloc_info(useside);
         first:=true;
         { function result (return-by-ref is handled explicitly) }
         if not paramanager.ret_in_param(def.returndef,def) then
           begin
-            usedef:=llvmgetcgparadef(def.funcretloc[calleeside],false);
+            usedef:=llvmgetcgparadef(def.funcretloc[useside],false);
             llvmextractvalueextinfo(def.returndef,usedef,signext);
             { specifying result sign extention information for an alias causes
               an error for some reason }
-            if pddecltype in [lpd_decl] then
+            if pddecltype in [lpd_decl,lpd_def] then
               encodedstr:=encodedstr+llvmvalueextension2str[signext];
             encodedstr:=encodedstr+' ';
             llvmaddencodedtype_intern(usedef,[],encodedstr);
@@ -682,7 +716,7 @@ implementation
           end;
         encodedstr:=encodedstr+' ';
         { add procname? }
-        if (pddecltype in [lpd_decl]) and
+        if (pddecltype in [lpd_decl,lpd_def]) and
            (def.typ=procdef) then
           if customname='' then
             encodedstr:=encodedstr+llvmmangledname(tprocdef(def).mangledname)
@@ -694,7 +728,7 @@ implementation
         for paranr:=0 to def.paras.count-1 do
           begin
             hp:=tparavarsym(def.paras[paranr]);
-            llvmaddencodedparaloctype(hp,def.proccalloption,pddecltype in [lpd_decl],not(pddecltype in [lpd_procvar,lpd_alias]),first,encodedstr);
+            llvmaddencodedparaloctype(hp,def.proccalloption,pddecltype in [lpd_def],not(pddecltype in [lpd_procvar,lpd_alias]),first,encodedstr);
           end;
         if po_varargs in def.procoptions then
           begin
@@ -750,6 +784,8 @@ implementation
                     { other types should not appear currently, add as needed }
                     internalerror(2014012008);
                   end;
+              pointerdef:
+                typename:='p'+tostr(hdef.deflist_index);
               else
                 { other types should not appear currently, add as needed }
                 internalerror(2014012009);
@@ -762,7 +798,8 @@ implementation
           begin
             res^.Data:=crecorddef.create_global_internal(typename,packrecords,
               recordalignmin,maxcrecordalign);
-            trecorddef(res^.Data).add_fields_from_deflist(fieldtypes);
+            for i:=0 to fieldtypes.count-1 do
+              trecorddef(res^.Data).add_field_by_def('F'+tostr(i),tdef(fieldtypes[i]));
           end;
         trecordsymtable(trecorddef(res^.Data).symtable).addalignmentpadding;
         result:=trecorddef(res^.Data);
@@ -804,6 +841,7 @@ implementation
         result:=llvmgettemprecorddef(retdeflist,C_alignment,
           targetinfos[target_info.system]^.alignment.recordalignmin,
           targetinfos[target_info.system]^.alignment.maxCrecordalign);
+        include(result.defoptions,df_llvm_no_struct_packing);
       end;
 
 

compiler/llvm/llvminfo.pas

@@ -1,5 +1,5 @@
 {
-    Copyright (c) 2010, 2013 by Jonas Maebe
+    Copyright (c) 2010, 2013, 2015 by Jonas Maebe
 
     Basic Processor information for LLVM
 
@@ -16,24 +16,67 @@ Unit llvminfo;
 
 Interface
 
-  uses
-    globtype, cpubase;
+uses
+  globtype;
 
 Type
    { possible supported processors for this target }
-   tllvmcputype =
-      (llvmcpu_none,
-       { may add older/newer versions if required/appropriate }
-       llvmcpu_33
+   tllvmversion =
+      ({ may add older/newer versions if required/appropriate }
+       llvmver_3_3,
+       llvmver_3_4_0,
+       llvmver_3_4_1,
+       llvmver_3_4_2,
+       llvmver_3_5_0,
+       llvmver_3_5_1,
+       llvmver_3_5_2,
+       llvmver_3_6_0,
+       llvmver_3_6_1,
+       llvmver_3_6_2,
+       { Xcode versions use snapshots of LLVM and don't correspond to released
+         versions of llvm (they don't ship with the llvm utilities either, but
+         they do come with Clang, which can also be used to some extent instead
+         of opt/llc) }
+       llvmver_xc_6_4
       );
 
+type
+   tllvmversionflag = (
+     llvmflag_metadata_keyword,    { use "metadata" keyword (others leave it away, except when metadata is an argument to call instructions) }
+     llvmflag_linker_private       { have linker_private linkage type (later versions use global in combination with hidden visibility) }
+   );
+   tllvmversionflags = set of tllvmversionflag;
 
 Const
-
-   llvmcputypestr : array[tllvmcputype] of string[9] = ('',
-     'LLVM-3.3'
+   llvmversionstr : array[tllvmversion] of string[14] = (
+     'LLVM-3.3',
+     'LLVM-3.4.0',
+     'LLVM-3.4.1',
+     'LLVM-3.4.2',
+     'LLVM-3.5.0',
+     'LLVM-3.5.1',
+     'LLVM-3.5.2',
+     'LLVM-3.6.0',
+     'LLVM-3.6.1',
+     'LLVM-3.6.2',
+     'LLVM-Xcode-6.4'
    );
 
+   llvmversion_properties: array[tllvmversion] of tllvmversionflags =
+     (
+       { llvmver_3_3    } [llvmflag_metadata_keyword,llvmflag_linker_private],
+       { llvmver_3_4_0  } [llvmflag_metadata_keyword,llvmflag_linker_private],
+       { llvmver_3_4_1  } [llvmflag_metadata_keyword,llvmflag_linker_private],
+       { llvmver_3_4_2  } [llvmflag_metadata_keyword,llvmflag_linker_private],
+       { llvmver_3_5_0  } [llvmflag_metadata_keyword],
+       { llvmver_3_5_1  } [llvmflag_metadata_keyword],
+       { llvmver_3_5_2  } [llvmflag_metadata_keyword],
+       { llvmver_3_6_0  } [],
+       { llvmver_3_6_1  } [],
+       { llvmver_3_6_2  } [],
+       { llvmver_xc_6_4 } [llvmflag_metadata_keyword]
+     );
+
    { Supported optimizations, only used for information }
    supported_optimizerswitches = genericlevel1optimizerswitches+
                                  genericlevel2optimizerswitches+

compiler/llvm/llvmnode.pas

@@ -37,8 +37,8 @@ implementation
     ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,ncgset,
     ncgadd,ncgcal,ncgmat,ncginl,
     tgllvm,hlcgllvm,
-    nllvmadd,nllvmcal,nllvmcnv,nllvmcon,nllvminl,nllvmld,nllvmmat,nllvmmem,
-    nllvmtcon,nllvmutil,
+    nllvmadd,nllvmbas,nllvmcal,nllvmcnv,nllvmcon,nllvminl,nllvmld,nllvmmat,
+    nllvmmem,nllvmtcon,nllvmutil,nllvmvmt,
     llvmpara,
     symllvm;