Rebase to trunk revision

git-svn-id: branches/laksen/armiw@29708 -

.gitattributes

@@ -138,6 +138,7 @@ compiler/avr/ravrstd.inc svneol=native#text/plain
 compiler/avr/ravrsup.inc svneol=native#text/plain
 compiler/avr/rgcpu.pas svneol=native#text/plain
 compiler/avr/symcpu.pas svneol=native#text/plain
+compiler/blockutl.pas svneol=native#text/plain
 compiler/browcol.pas svneol=native#text/plain
 compiler/bsdcompile -text
 compiler/catch.pas svneol=native#text/plain
@@ -970,6 +971,12 @@ packages/a52/Makefile.fpc svneol=native#text/plain
 packages/a52/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/a52/fpmake.pp svneol=native#text/plain
 packages/a52/src/a52.pas svneol=native#text/plain
+packages/ami-extra/Makefile svneol=native#text/plain
+packages/ami-extra/Makefile.fpc svneol=native#text/plain
+packages/ami-extra/Makefile.fpc.fpcmake svneol=native#text/plain
+packages/ami-extra/README.txt svneol=native#text/plain
+packages/ami-extra/fpmake.pp svneol=native#text/plain
+packages/ami-extra/src/cliputils.pas svneol=native#text/plain
 packages/amunits/Makefile svneol=native#text/plain
 packages/amunits/Makefile.fpc svneol=native#text/plain
 packages/amunits/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -4753,7 +4760,7 @@ packages/libgbafpc/examples/template/Makefile.fpc svneol=native#text/plain
 packages/libgbafpc/examples/template/template.pp svneol=native#text/plain
 packages/libgbafpc/fpmake.pp svneol=native#text/plain
 packages/libgbafpc/src/gba.pp svneol=native#text/plain
-packages/libgbafpc/src/gba/BoyScout.inc svneol=native#text/plain
+packages/libgbafpc/src/gba/boyscout.inc svneol=native#text/plain
 packages/libgbafpc/src/gba/core_asm.as svneol=native#text/plain
 packages/libgbafpc/src/gba/disc.inc svneol=native#text/plain
 packages/libgbafpc/src/gba/disc_io.inc svneol=native#text/plain
@@ -5612,6 +5619,7 @@ packages/morphunits/src/datatypes.pas svneol=native#text/plain
 packages/morphunits/src/exec.pas svneol=native#text/plain
 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/inputevent.pas svneol=native#text/plain
 packages/morphunits/src/intuition.pas svneol=native#text/plain
 packages/morphunits/src/keymap.pas svneol=native#text/plain
@@ -6780,6 +6788,7 @@ packages/rtl-unicode/src/collations/collation_sv_le.inc svneol=native#text/pasca
 packages/rtl-unicode/src/collations/collation_zh.pas svneol=native#text/pascal
 packages/rtl-unicode/src/collations/collation_zh_be.inc svneol=native#text/pascal
 packages/rtl-unicode/src/collations/collation_zh_le.inc svneol=native#text/pascal
+packages/rtl-unicode/src/inc/cp895.pas svneol=native#text/plain
 packages/rtl-unicode/src/inc/cp932.pas svneol=native#text/pascal
 packages/rtl-unicode/src/inc/cp936.pas svneol=native#text/pascal
 packages/rtl-unicode/src/inc/cp949.pas svneol=native#text/pascal
@@ -7906,6 +7915,7 @@ rtl/android/Makefile.fpc svneol=native#text/plain
 rtl/android/arm/dllprt0.as svneol=native#text/plain
 rtl/android/arm/prt0.as svneol=native#text/plain
 rtl/android/cwstring.pp svneol=native#text/plain
+rtl/android/dlandroid.inc svneol=native#text/plain
 rtl/android/i386/dllprt0.as svneol=native#text/plain
 rtl/android/i386/prt0.as svneol=native#text/plain
 rtl/android/jvm/Makefile svneol=native#text/plain
@@ -8136,6 +8146,7 @@ rtl/embedded/check.inc svneol=native#text/plain
 rtl/embedded/consoleio.pp svneol=native#text/pascal
 rtl/embedded/empty.cfg svneol=native#text/plain
 rtl/embedded/heapmgr.pp svneol=native#text/pascal
+rtl/embedded/i386/multiboot.pp svneol=native#text/plain
 rtl/embedded/rtl.cfg svneol=native#text/plain
 rtl/embedded/rtldefs.inc svneol=native#text/plain
 rtl/embedded/sysdir.inc svneol=native#text/plain
@@ -8322,6 +8333,7 @@ rtl/i8086/strings.inc svneol=native#text/plain
 rtl/i8086/stringss.inc svneol=native#text/plain
 rtl/inc/aliases.inc svneol=native#text/plain
 rtl/inc/astrings.inc svneol=native#text/plain
+rtl/inc/blockrtl.pp svneol=native#text/plain
 rtl/inc/cgeneric.inc svneol=native#text/plain
 rtl/inc/cgenmath.inc svneol=native#text/plain
 rtl/inc/cgenstr.inc svneol=native#text/plain
@@ -8334,6 +8346,8 @@ rtl/inc/dos.inc svneol=native#text/plain
 rtl/inc/dosh.inc svneol=native#text/plain
 rtl/inc/dynarr.inc svneol=native#text/plain
 rtl/inc/dynarrh.inc svneol=native#text/plain
+rtl/inc/dynlib.inc svneol=native#text/plain
+rtl/inc/dynlibh.inc svneol=native#text/plain
 rtl/inc/dynlibs.pas svneol=native#text/plain
 rtl/inc/except.inc svneol=native#text/plain
 rtl/inc/exeinfo.pp svneol=native#text/plain
@@ -8592,6 +8606,7 @@ rtl/linux/unxconst.inc svneol=native#text/plain
 rtl/linux/unxfunc.inc svneol=native#text/plain
 rtl/linux/unxsysc.inc svneol=native#text/plain
 rtl/linux/unxsysch.inc svneol=native#text/plain
+rtl/linux/x86_64/abitag.as svneol=native#text/plain
 rtl/linux/x86_64/bsyscall.inc svneol=native#text/plain
 rtl/linux/x86_64/cprt0.as svneol=native#text/plain
 rtl/linux/x86_64/dllprt0.as svneol=native#text/plain
@@ -8842,6 +8857,7 @@ rtl/netware/rtldefs.inc svneol=native#text/plain
 rtl/netware/socklib.imp -text
 rtl/netware/streams.imp -text
 rtl/netware/sysdir.inc svneol=native#text/plain
+rtl/netware/sysdlh.inc svneol=native#text/plain
 rtl/netware/sysfile.inc svneol=native#text/plain
 rtl/netware/sysheap.inc svneol=native#text/plain
 rtl/netware/sysos.inc svneol=native#text/plain
@@ -8875,6 +8891,7 @@ rtl/netwlibc/nwsnut.imp -text
 rtl/netwlibc/nwsnut.pp svneol=native#text/plain
 rtl/netwlibc/rtldefs.inc svneol=native#text/plain
 rtl/netwlibc/sysdir.inc svneol=native#text/plain
+rtl/netwlibc/sysdlh.inc svneol=native#text/plain
 rtl/netwlibc/sysfile.inc svneol=native#text/plain
 rtl/netwlibc/sysheap.inc svneol=native#text/plain
 rtl/netwlibc/sysos.inc svneol=native#text/plain
@@ -9026,6 +9043,8 @@ rtl/os2/prt0.as svneol=native#text/plain
 rtl/os2/rtldefs.inc svneol=native#text/plain
 rtl/os2/so32dll.pas svneol=native#text/plain
 rtl/os2/sysdir.inc svneol=native#text/plain
+rtl/os2/sysdl.inc svneol=native#text/plain
+rtl/os2/sysdlh.inc svneol=native#text/plain
 rtl/os2/sysfile.inc svneol=native#text/plain
 rtl/os2/sysheap.inc svneol=native#text/plain
 rtl/os2/sysos.inc svneol=native#text/plain
@@ -9199,6 +9218,7 @@ rtl/ucmaps/cp1258.txt svneol=native#text/plain
 rtl/ucmaps/cp852.txt svneol=native#text/plain
 rtl/ucmaps/cp856.txt svneol=native#text/plain
 rtl/ucmaps/cp874.txt svneol=native#text/plain
+rtl/ucmaps/cp895.txt svneol=native#text/plain
 rtl/ucmaps/cp932.txt svneol=native#text/plain
 rtl/ucmaps/cp936.txt svneol=native#text/plain
 rtl/ucmaps/cp949.txt svneol=native#text/plain
@@ -9237,6 +9257,7 @@ rtl/unix/settimeo.inc svneol=native#text/plain
 rtl/unix/syscall.pp svneol=native#text/plain
 rtl/unix/syscgen.inc svneol=native#text/plain
 rtl/unix/sysdir.inc svneol=native#text/plain
+rtl/unix/sysdlh.inc svneol=native#text/plain
 rtl/unix/sysfile.inc svneol=native#text/plain
 rtl/unix/sysheap.inc svneol=native#text/plain
 rtl/unix/sysunixh.inc svneol=native#text/plain
@@ -9291,6 +9312,8 @@ rtl/win/fpcmemdll.pp svneol=native#text/plain
 rtl/win/messages.pp svneol=native#text/plain
 rtl/win/sharemem.pp svneol=native#text/plain
 rtl/win/sysdir.inc svneol=native#text/plain
+rtl/win/sysdl.inc svneol=native#text/plain
+rtl/win/sysdlh.inc svneol=native#text/plain
 rtl/win/sysfile.inc svneol=native#text/plain
 rtl/win/sysheap.inc svneol=native#text/plain
 rtl/win/sysos.inc svneol=native#text/plain
@@ -9340,6 +9363,7 @@ 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
 rtl/win64/buildrtl.pp svneol=native#text/plain
 rtl/win64/classes.pp svneol=native#text/plain
 rtl/win64/rtldefs.inc svneol=native#text/plain
@@ -9355,6 +9379,8 @@ rtl/wince/dynlibs.inc svneol=native#text/plain
 rtl/wince/messages.pp svneol=native#text/plain
 rtl/wince/readme.txt svneol=native#text/plain
 rtl/wince/rtldefs.inc svneol=native#text/plain
+rtl/wince/sysdl.inc svneol=native#text/plain
+rtl/wince/sysdlh.inc svneol=native#text/plain
 rtl/wince/system.pp svneol=native#text/plain
 rtl/wince/sysutils.pp svneol=native#text/plain
 rtl/wince/windows.pp svneol=native#text/plain
@@ -9728,6 +9754,7 @@ tests/tbf/tb0246.pp svneol=native#text/pascal
 tests/tbf/tb0247.pp svneol=native#text/pascal
 tests/tbf/tb0248.pp svneol=native#text/pascal
 tests/tbf/tb0249.pp svneol=native#text/pascal
+tests/tbf/tb0250.pp svneol=native#text/pascal
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain
@@ -10338,6 +10365,7 @@ tests/tbs/tb0605.pp svneol=native#text/pascal
 tests/tbs/tb0606.pp svneol=native#text/pascal
 tests/tbs/tb0607.pp svneol=native#text/plain
 tests/tbs/tb0608.pp svneol=native#text/pascal
+tests/tbs/tb0609.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tbs0594.pp svneol=native#text/pascal
 tests/tbs/ub0060.pp svneol=native#text/plain
@@ -10607,13 +10635,21 @@ tests/test/cg/obj/openbsd/x86_64/tcext3.o -text
 tests/test/cg/obj/openbsd/x86_64/tcext4.o -text
 tests/test/cg/obj/openbsd/x86_64/tcext5.o -text
 tests/test/cg/obj/openbsd/x86_64/tcext6.o -text
+tests/test/cg/obj/os2/i386/cpptcl1.o -text
+tests/test/cg/obj/os2/i386/cpptcl2.o -text
 tests/test/cg/obj/os2/i386/ctest.o -text
+tests/test/cg/obj/os2/i386/tcext3.o -text
+tests/test/cg/obj/os2/i386/tcext4.o -text
+tests/test/cg/obj/os2/i386/tcext5.o -text
+tests/test/cg/obj/os2/i386/tcext6.o -text
 tests/test/cg/obj/readme.txt svneol=native#text/plain
 tests/test/cg/obj/solaris/i386/cpptcl1.o -text
+tests/test/cg/obj/solaris/i386/cpptcl2.o -text
 tests/test/cg/obj/solaris/i386/ctest.o -text
 tests/test/cg/obj/solaris/i386/tcext3.o -text
 tests/test/cg/obj/solaris/i386/tcext4.o -text
 tests/test/cg/obj/solaris/i386/tcext5.o -text
+tests/test/cg/obj/solaris/i386/tcext6.o -text
 tests/test/cg/obj/solaris/sparc/cpptcl1.o -text
 tests/test/cg/obj/solaris/sparc/cpptcl2.o -text
 tests/test/cg/obj/solaris/sparc/ctest.o -text
@@ -10622,10 +10658,12 @@ tests/test/cg/obj/solaris/sparc/tcext4.o -text svneol=unset#unset
 tests/test/cg/obj/solaris/sparc/tcext5.o -text
 tests/test/cg/obj/solaris/sparc/tcext6.o -text
 tests/test/cg/obj/solaris/x86_64/cpptcl1.o -text
+tests/test/cg/obj/solaris/x86_64/cpptcl2.o -text
 tests/test/cg/obj/solaris/x86_64/ctest.o -text
 tests/test/cg/obj/solaris/x86_64/tcext3.o -text
 tests/test/cg/obj/solaris/x86_64/tcext4.o -text
 tests/test/cg/obj/solaris/x86_64/tcext5.o -text
+tests/test/cg/obj/solaris/x86_64/tcext6.o -text
 tests/test/cg/obj/stdint.h svneol=native#text/plain
 tests/test/cg/obj/tcext3.c -text
 tests/test/cg/obj/tcext4.c -text
@@ -11226,6 +11264,11 @@ tests/test/tasm8.pp svneol=native#text/plain
 tests/test/tasmread.pp svneol=native#text/plain
 tests/test/tasout.pp svneol=native#text/plain
 tests/test/tassignmentoperator1.pp svneol=native#text/pascal
+tests/test/tblock1.pp svneol=native#text/plain
+tests/test/tblock1a.pp svneol=native#text/plain
+tests/test/tblock1c.pp svneol=native#text/plain
+tests/test/tblock2.pp svneol=native#text/plain
+tests/test/tblock2a.pp svneol=native#text/plain
 tests/test/tbopr.pp svneol=native#text/plain
 tests/test/tbrtlevt.pp svneol=native#text/plain
 tests/test/tbsx1.pp svneol=native#text/plain
@@ -11700,6 +11743,7 @@ tests/test/tgeneric94.pp svneol=native#text/pascal
 tests/test/tgeneric95.pp svneol=native#text/pascal
 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/tgoto.pp svneol=native#text/plain
 tests/test/theap.pp svneol=native#text/plain
 tests/test/theapthread.pp svneol=native#text/plain
@@ -11749,6 +11793,7 @@ tests/test/thlp44.pp svneol=native#text/pascal
 tests/test/thlp45.pp svneol=native#text/pascal
 tests/test/thlp46.pp svneol=native#text/pascal
 tests/test/thlp47.pp svneol=native#text/pascal
+tests/test/thlp48.pp svneol=native#text/plain
 tests/test/thlp5.pp svneol=native#text/pascal
 tests/test/thlp6.pp svneol=native#text/pascal
 tests/test/thlp7.pp svneol=native#text/pascal
@@ -11926,6 +11971,8 @@ tests/test/tobjc38.pp svneol=native#text/plain
 tests/test/tobjc39.pp svneol=native#text/plain
 tests/test/tobjc4.pp svneol=native#text/plain
 tests/test/tobjc40.pp svneol=native#text/plain
+tests/test/tobjc41.pp svneol=native#text/plain
+tests/test/tobjc42.pp svneol=native#text/plain
 tests/test/tobjc4a.pp svneol=native#text/plain
 tests/test/tobjc5.pp svneol=native#text/plain
 tests/test/tobjc5a.pp svneol=native#text/plain
@@ -12608,6 +12655,8 @@ tests/test/uobjc35e.pp svneol=native#text/plain
 tests/test/uobjc35f.pp svneol=native#text/plain
 tests/test/uobjc35g.pp svneol=native#text/plain
 tests/test/uobjc39.pp svneol=native#text/plain
+tests/test/uobjc41.pp svneol=native#text/plain
+tests/test/uobjc42.pp svneol=native#text/plain
 tests/test/uobjc7.pp svneol=native#text/plain
 tests/test/uobjcl1.pp svneol=native#text/plain
 tests/test/uprec6.pp svneol=native#text/plain
@@ -13751,6 +13800,7 @@ tests/webtbs/tw1938.pp svneol=native#text/plain
 tests/webtbs/tw19434a.pp svneol=native#text/plain
 tests/webtbs/tw19434b.pp svneol=native#text/plain
 tests/webtbs/tw19452.pp svneol=native#text/plain
+tests/webtbs/tw19452a.pp svneol=native#text/plain
 tests/webtbs/tw1948.pp svneol=native#text/plain
 tests/webtbs/tw19498.pp svneol=native#text/pascal
 tests/webtbs/tw19499.pp svneol=native#text/pascal
@@ -13866,7 +13916,7 @@ tests/webtbs/tw21350a.pp svneol=native#text/pascal
 tests/webtbs/tw21350b.pp svneol=native#text/pascal
 tests/webtbs/tw21443.pp svneol=native#text/plain
 tests/webtbs/tw21443a.pp svneol=native#text/plain
-tests/webtbs/tw21449.pp -text svneol=native#text/plain
+tests/webtbs/tw21449.pp svneol=native#text/plain
 tests/webtbs/tw2145.pp svneol=native#text/plain
 tests/webtbs/tw21457.pp svneol=native#text/pascal
 tests/webtbs/tw21472.pp svneol=native#text/pascal
@@ -14038,6 +14088,7 @@ tests/webtbs/tw24651.pp svneol=native#text/pascal
 tests/webtbs/tw24690.pp svneol=native#text/pascal
 tests/webtbs/tw24705.pp svneol=native#text/pascal
 tests/webtbs/tw2473.pp svneol=native#text/plain
+tests/webtbs/tw24796.pp svneol=native#text/pascal
 tests/webtbs/tw2480.pp svneol=native#text/plain
 tests/webtbs/tw2481.pp svneol=native#text/plain
 tests/webtbs/tw2483.pp svneol=native#text/plain
@@ -14050,6 +14101,7 @@ tests/webtbs/tw24863.pp svneol=native#text/plain
 tests/webtbs/tw24865.pp svneol=native#text/pascal
 tests/webtbs/tw24867.pp svneol=native#text/pascal
 tests/webtbs/tw24871.pp svneol=native#text/pascal
+tests/webtbs/tw24872.pp svneol=native#text/pascal
 tests/webtbs/tw24915.pp svneol=native#text/pascal
 tests/webtbs/tw2492.pp svneol=native#text/plain
 tests/webtbs/tw2494.pp svneol=native#text/plain
@@ -14059,6 +14111,7 @@ tests/webtbs/tw2503.pp svneol=native#text/plain
 tests/webtbs/tw25030.pp svneol=native#text/pascal
 tests/webtbs/tw2504.pp svneol=native#text/plain
 tests/webtbs/tw25043.pp svneol=native#text/pascal
+tests/webtbs/tw25044.pp svneol=native#text/pascal
 tests/webtbs/tw25054a.pp svneol=native#text/pascal
 tests/webtbs/tw25054b.pp svneol=native#text/pascal
 tests/webtbs/tw25059.pp svneol=native#text/pascal
@@ -14090,6 +14143,7 @@ tests/webtbs/tw2540.pp svneol=native#text/plain
 tests/webtbs/tw25551.pp svneol=native#text/plain
 tests/webtbs/tw25598.pp svneol=native#text/plain
 tests/webtbs/tw25600.pp svneol=native#text/pascal
+tests/webtbs/tw25602.pp svneol=native#text/pascal
 tests/webtbs/tw25603.pp svneol=native#text/pascal
 tests/webtbs/tw25604.pp svneol=native#text/pascal
 tests/webtbs/tw25605.pp svneol=native#text/pascal
@@ -14104,8 +14158,10 @@ tests/webtbs/tw25869.pp svneol=native#text/plain
 tests/webtbs/tw2588.pp svneol=native#text/plain
 tests/webtbs/tw2589.pp svneol=native#text/plain
 tests/webtbs/tw25895.pp svneol=native#text/pascal
+tests/webtbs/tw25914.pp svneol=native#text/pascal
 tests/webtbs/tw25916a.pp svneol=native#text/pascal
 tests/webtbs/tw25916b.pp svneol=native#text/pascal
+tests/webtbs/tw25917.pp svneol=native#text/pascal
 tests/webtbs/tw25929.pp svneol=native#text/pascal
 tests/webtbs/tw25930.pp svneol=native#text/plain
 tests/webtbs/tw25931.pp -text svneol=native#text/plain
@@ -14137,9 +14193,13 @@ tests/webtbs/tw2643.pp svneol=native#text/plain
 tests/webtbs/tw2645.pp svneol=native#text/plain
 tests/webtbs/tw26467.pp svneol=native#text/pascal
 tests/webtbs/tw2647.pp svneol=native#text/plain
+tests/webtbs/tw26481.pp svneol=native#text/pascal
 tests/webtbs/tw26482.pp svneol=native#text/pascal
+tests/webtbs/tw26483.pp svneol=native#text/pascal
 tests/webtbs/tw2649.pp svneol=native#text/plain
 tests/webtbs/tw2651.pp svneol=native#text/plain
+tests/webtbs/tw26534a.pp svneol=native#text/pascal
+tests/webtbs/tw26534b.pp svneol=native#text/pascal
 tests/webtbs/tw26536.pp svneol=native#text/plain
 tests/webtbs/tw2656.pp svneol=native#text/plain
 tests/webtbs/tw2659.pp svneol=native#text/plain
@@ -14173,19 +14233,26 @@ 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/tw27153.pp svneol=native#text/pascal
+tests/webtbs/tw27173.pp svneol=native#text/pascal
 tests/webtbs/tw27185.pp svneol=native#text/pascal
 tests/webtbs/tw2721.pp svneol=native#text/plain
 tests/webtbs/tw2723.pp svneol=native#text/plain
 tests/webtbs/tw2725.pp svneol=native#text/plain
+tests/webtbs/tw27256.pp svneol=native#text/pascal
 tests/webtbs/tw2727.pp svneol=native#text/plain
 tests/webtbs/tw2728.pp svneol=native#text/plain
 tests/webtbs/tw2729.pp svneol=native#text/plain
+tests/webtbs/tw27294.pp svneol=native#text/plain
 tests/webtbs/tw2730.pp svneol=native#text/plain
+tests/webtbs/tw27300a.pp svneol=native#text/pascal
 tests/webtbs/tw2731.pp svneol=native#text/plain
+tests/webtbs/tw27320.pp svneol=native#text/pascal
+tests/webtbs/tw27348.pp svneol=native#text/pascal
 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/tw27424.pp svneol=native#text/pascal
 tests/webtbs/tw2758.pp svneol=native#text/plain
 tests/webtbs/tw2763.pp svneol=native#text/plain
 tests/webtbs/tw2765.pp svneol=native#text/plain
@@ -14923,7 +14990,9 @@ tests/webtbs/uw26922a.pp svneol=native#text/pascal
 tests/webtbs/uw26922b.pp svneol=native#text/pascal
 tests/webtbs/uw2706a.pp svneol=native#text/plain
 tests/webtbs/uw2706b.pp svneol=native#text/plain
+tests/webtbs/uw27294.pp svneol=native#text/plain
 tests/webtbs/uw2731.pp svneol=native#text/plain
+tests/webtbs/uw27320.defaults.pp svneol=native#text/pascal
 tests/webtbs/uw2738.pp svneol=native#text/plain
 tests/webtbs/uw2834.pp svneol=native#text/plain
 tests/webtbs/uw2920.pp svneol=native#text/plain
@@ -15294,6 +15363,7 @@ utils/javapp/src/fpc/tools/javapp/StackMapTableData.java svneol=native#text/plai
 utils/javapp/src/fpc/tools/javapp/Tables.java svneol=native#text/plain
 utils/javapp/src/fpc/tools/javapp/TrapData.java svneol=native#text/plain
 utils/javapp/src/fpc/tools/javapp/TypeSignature.java svneol=native#text/plain
+utils/mkinsadd.pp svneol=native#text/plain
 utils/mksymbian/Makefile svneol=native#text/plain
 utils/mksymbian/Makefile.fpc svneol=native#text/plain
 utils/mksymbian/Makefile.fpc.fpcmake svneol=native#text/plain

Makefile

@@ -1,9 +1,9 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2014-08-17 rev 28432]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-01-04 rev 29399]
 #
 default: help
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded 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
-BSDs = freebsd netbsd openbsd darwin
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-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
+BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom msdos
 OSNeedsComspecToRunBatch = go32v2 watcom
@@ -326,7 +326,7 @@ FPCFPMAKE=$(FPC)
 endif
 endif
 override PACKAGE_NAME=fpc
-override PACKAGE_VERSION=2.7.1
+override PACKAGE_VERSION=3.1.1
 REQUIREDVERSION=2.6.4
 REQUIREDVERSION2=2.6.2
 ifndef inOS2
@@ -467,7 +467,7 @@ endif
 endif
 BuildOnlyBaseCPUs=jvm
 ifneq ($(wildcard utils),)
-NOUTILSTARGETS=embedded gba $(BuildOnlyBaseCPUs)
+NOUTILSTARGETS=embedded gba msdos $(BuildOnlyBaseCPUs)
 ifeq ($(findstring $(OS_TARGET),$(NOUTILSTARGETS)),)
 ifdef BUILDFULLNATIVE
 UTILS=1
@@ -633,6 +633,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+override TARGET_DIRS+=compiler rtl utils packages ide installer
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
@@ -945,6 +948,12 @@ EXEEXT=
 HASSHAREDLIB=1
 SHORTSUFFIX=lnx
 endif
+ifeq ($(OS_TARGET),dragonfly)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=df
+endif
 ifeq ($(OS_TARGET),freebsd)
 BATCHEXT=.sh
 EXEEXT=
@@ -1459,8 +1468,8 @@ endif
 ifdef CREATESHARED
 override FPCOPT+=-Cg
 endif
-ifneq ($(findstring $(OS_TARGET),freebsd openbsd netbsd linux solaris),)
-ifeq ($(CPU_TARGET),x86_64)
+ifneq ($(findstring $(OS_TARGET),dragonfly freebsd openbsd netbsd linux solaris),)
+ifneq ($(findstring $(CPU_TARGET),x86_64 mips mipsel),)
 override FPCOPT+=-Cg
 endif
 endif
@@ -2271,6 +2280,14 @@ TARGET_DIRS_PACKAGES=1
 TARGET_DIRS_IDE=1
 TARGET_DIRS_INSTALLER=1
 endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+TARGET_DIRS_COMPILER=1
+TARGET_DIRS_RTL=1
+TARGET_DIRS_UTILS=1
+TARGET_DIRS_PACKAGES=1
+TARGET_DIRS_IDE=1
+TARGET_DIRS_INSTALLER=1
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 TARGET_DIRS_COMPILER=1
 TARGET_DIRS_RTL=1

Makefile.fpc

@@ -4,7 +4,7 @@
 
 [package]
 name=fpc
-version=2.7.1
+version=3.1.1
 
 [target]
 dirs=compiler rtl utils packages ide installer
@@ -204,7 +204,7 @@ endif
 BuildOnlyBaseCPUs=jvm
 
 ifneq ($(wildcard utils),)
-NOUTILSTARGETS=embedded gba $(BuildOnlyBaseCPUs)
+NOUTILSTARGETS=embedded gba msdos $(BuildOnlyBaseCPUs)
 ifeq ($(findstring $(OS_TARGET),$(NOUTILSTARGETS)),)
 ifdef BUILDFULLNATIVE
 UTILS=1

compiler/Makefile

@@ -1,9 +1,9 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2014-08-17 rev 28432]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2014-12-07 rev 29213]
 #
 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 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
-BSDs = freebsd netbsd openbsd darwin
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-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
+BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom msdos
 OSNeedsComspecToRunBatch = go32v2 watcom
@@ -326,7 +326,7 @@ FPCFPMAKE=$(FPC)
 endif
 endif
 override PACKAGE_NAME=compiler
-override PACKAGE_VERSION=2.7.1
+override PACKAGE_VERSION=3.1.1
 unexport FPC_VERSION FPC_COMPILERINFO
 CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64 m68k armeb mipsel mips avr jvm i8086
 ALLTARGETS=$(CYCLETARGETS)
@@ -477,7 +477,7 @@ ifneq ($(REVINC),)
 override LOCALOPT+=-dREVINC
 ifeq ($(REVSTR),)
 ifneq ($(SVNVERSION),)
-REVSTR:=$(shell $(SVNVERSION) -c .)
+REVSTR:=$(subst r,,$(subst r1:,,r$(shell $(SVNVERSION) -c .)))
 export REVSTR
 else
 ifeq ($(REVINC),force)
@@ -525,7 +525,7 @@ override LOCALOPT+=-Fux86
 endif
 OPTWPOCOLLECT=-OWdevirtcalls,optvmts -FW$(BASEDIR)/pp1.wpo
 OPTWPOPERFORM=-Owdevirtcalls,optvmts -Fw$(BASEDIR)/pp1.wpo
-ifneq ($(findstring $(OS_TARGET),darwin linux freebsd solaris),)
+ifneq ($(findstring $(OS_TARGET),darwin linux dragonfly freebsd solaris),)
 ifdef LINKSMART
 ifdef CREATESMART
 OPTWPOCOLLECT+=-OWsymbolliveness -Xs-
@@ -704,6 +704,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override TARGET_DIRS+=utils
 endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+override TARGET_DIRS+=utils
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 override TARGET_DIRS+=utils
 endif
@@ -932,6 +935,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override TARGET_PROGRAMS+=pp
 endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+override TARGET_PROGRAMS+=pp
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 override TARGET_PROGRAMS+=pp
 endif
@@ -1161,6 +1167,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
@@ -1389,6 +1398,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -1617,6 +1629,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override COMPILER_TARGETDIR+=.
 endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+override COMPILER_TARGETDIR+=.
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 override COMPILER_TARGETDIR+=.
 endif
@@ -1845,6 +1860,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -2156,6 +2174,12 @@ EXEEXT=
 HASSHAREDLIB=1
 SHORTSUFFIX=lnx
 endif
+ifeq ($(OS_TARGET),dragonfly)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=df
+endif
 ifeq ($(OS_TARGET),freebsd)
 BATCHEXT=.sh
 EXEEXT=
@@ -2717,6 +2741,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -2937,7 +2964,7 @@ endif
 ifdef CREATESHARED
 override FPCOPT+=-Cg
 endif
-ifneq ($(findstring $(OS_TARGET),freebsd openbsd netbsd linux solaris),)
+ifneq ($(findstring $(OS_TARGET),dragonfly freebsd openbsd netbsd linux solaris),)
 ifeq ($(CPU_TARGET),x86_64)
 override FPCOPT+=-Cg
 endif
@@ -3577,6 +3604,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 TARGET_DIRS_UTILS=1
 endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+TARGET_DIRS_UTILS=1
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 TARGET_DIRS_UTILS=1
 endif

compiler/Makefile.fpc

@@ -4,7 +4,7 @@
 
 [package]
 name=compiler
-version=2.7.1
+version=3.1.1
 
 [target]
 programs=pp
@@ -225,7 +225,7 @@ override LOCALOPT+=-dREVINC
 # svnversion executable is available
 ifeq ($(REVSTR),)
 ifneq ($(SVNVERSION),)
-REVSTR:=$(shell $(SVNVERSION) -c .)
+REVSTR:=$(subst r,,$(subst r1:,,r$(shell $(SVNVERSION) -c .)))
 export REVSTR
 else
 ifeq ($(REVINC),force)

compiler/aasmbase.pas

@@ -62,6 +62,8 @@ interface
 
     const
        asmlabeltypeprefix : array[TAsmLabeltype] of char = ('j','a','d','l','f','t','c');
+       asmsymbindname : array[TAsmsymbind] of string = ('none', 'external','common',
+       'local','global','weak external','private external','lazy','import');
 
     type
        TAsmSectiontype=(sec_none,
@@ -197,7 +199,7 @@ interface
     function EncodeUleb128(a: qword;out buf) : byte;
     function EncodeSleb128(a: int64;out buf) : byte;
 
-    function ReplaceForbiddenAsmSymbolChars(const s: string): string;
+    function ReplaceForbiddenAsmSymbolChars(const s: ansistring): ansistring;
 
     { dummy default noop callback }
     procedure default_global_used;
@@ -348,7 +350,7 @@ implementation
       end;
 
 
-    function ReplaceForbiddenAsmSymbolChars(const s: string): string;
+    function ReplaceForbiddenAsmSymbolChars(const s: ansistring): ansistring;
       var
         i : longint;
         rchar: char;

compiler/aasmdata.pas

@@ -406,6 +406,21 @@ implementation
                  internalerror(200603261);
              end;
            hp.typ:=_typ;
+           { Changing bind from AB_GLOBAL to AB_LOCAL is wrong
+             if bind is already AB_GLOBAL or AB_EXTERNAL,
+             GOT might have been used, so change might be harmful. }
+           if (_bind<>hp.bind) and (hp.getrefs>0) then
+             begin
+{$ifdef extdebug}
+               { the changes that matter must become internalerrors, the rest
+                 should be ignored; a used cannot change anything about this,
+                 so printing a warning/hint is not useful }
+               if (_bind=AB_LOCAL) then
+                 Message3(asmw_w_changing_bind_type,s,asmsymbindname[hp.bind],asmsymbindname[_bind])
+               else
+                 Message3(asmw_h_changing_bind_type,s,asmsymbindname[hp.bind],asmsymbindname[_bind]);
+{$endif extdebug}
+             end;
            hp.bind:=_bind;
          end
         else

compiler/aasmtai.pas

@@ -274,7 +274,7 @@ interface
           top_shifterop : (shifterop : pshifterop);
       {$endif defined(arm) or defined(aarch64)}
       {$ifdef m68k}
-          top_regset : (dataregset,addrregset:^tcpuregisterset);
+          top_regset : (dataregset,addrregset,fpuregset:^tcpuregisterset);
       {$endif m68k}
       {$ifdef jvm}
           top_single : (sval:single);
@@ -2654,6 +2654,7 @@ implementation
                 begin
                   dispose(dataregset);
                   dispose(addrregset);
+                  dispose(fpuregset);
                 end;
 {$endif m68k}
 {$ifdef jvm}

compiler/arm/armins.dat

@@ -299,6 +299,7 @@ reg32,reg32         \321\300\1\x11\101            ARM32,ARMv4
 [LDMcc]
 memam4,reglist              \x69\xC8            THUMB,ARMv4T
 reglo,reglist               \x69\xC8            THUMB,ARMv4T
+reg32,reglist		   \x26\x81			ARM7
 
 memam4,reglist              \x8C\xE8\x10\x0\x0  THUMB32,WIDE,ARMv6T2
 reg32,reglist               \x8C\xE8\x10\x0\x0  THUMB32,WIDE,ARMv6T2

compiler/arm/cgcpu.pas

@@ -3226,7 +3226,10 @@ unit cgcpu;
               reference_reset_base(href,NR_R12,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
               cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
             end;
-          list.concat(taicpu.op_reg(A_BX,NR_R12));
+          if not(CPUARM_HAS_BX in cpu_capabilities[current_settings.cputype]) then
+            list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12))
+          else
+            list.concat(taicpu.op_reg(A_BX,NR_R12));
         end;
 
       var

compiler/blockutl.pas

@@ -0,0 +1,385 @@
+{
+    Copyright (c) 2014 by Jonas Maebe, Member of the Free Pascal
+    development team.
+
+    This unit implements helper routines for "blocks" support
+    (http://en.wikipedia.org/wiki/Blocks_(C_language_extension) )
+
+    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 blockutl;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    node,nld,ncnv,
+    symtype,symdef;
+
+  { accepts a loadnode for a procdef
+
+    returns a node representing the converted code to implement this
+    conversion (this node is valid both for typed constant declarations and
+    in function bodies). The node is not reused }
+  function generate_block_for_procaddr(procloadnode: tloadnode): tnode;
+
+  { for a procdef, return a recorddef representing a block literal for this
+    procdef
+
+    for a procvardef, return a basic recorddef representing a block literal
+    with enough info to call this procvardef }
+  function get_block_literal_type_for_proc(pd: tabstractprocdef): trecorddef;
+
+implementation
+
+  uses
+    verbose,globtype,globals,cutils,constexp,
+    pass_1,pparautl,fmodule,
+    aasmdata,
+    nbas,ncon,nmem,nutils,
+    symbase,symconst,symtable,symsym,symcreat,objcutil,objcdef,defutil,
+    paramgr;
+
+
+  function get_block_literal_type_for_proc(pd: tabstractprocdef): trecorddef;
+    begin
+      if pd.typ=procvardef then
+        result:=trecorddef(search_named_unit_globaltype('BLOCKRTL','FPC_BLOCK_LITERAL_BASE',true).typedef)
+      else if pd.is_addressonly then
+        result:=trecorddef(search_named_unit_globaltype('BLOCKRTL','FPC_BLOCK_LITERAL_STATIC',true).typedef)
+      { todo: nested functions and Objective-C methods }
+      else if not is_nested_pd(pd) and
+              not is_objcclass(tdef(pd.owner.defowner)) then
+        result:=trecorddef(search_named_unit_globaltype('BLOCKRTL','FPC_BLOCK_LITERAL_COMPLEX_PROCVAR',true).typedef)
+      else
+        internalerror(2014071304);
+    end;
+
+
+  function get_block_literal_isa(orgpd: tprocdef): tstaticvarsym;
+    var
+      srsym: tsym;
+      srsymtable: tsymtable;
+      name: tidstring;
+    begin
+      if orgpd.is_addressonly then
+        name:='_NSCONCRETEGLOBALBLOCK'
+      else
+        name:='_NSCONCRETESTACKBLOCK';
+      if not searchsym_in_named_module('BLOCKRTL',name,srsym,srsymtable) or
+         (srsym.typ<>staticvarsym) then
+        internalerror(2014071501);
+      result:=tstaticvarsym(srsym);
+    end;
+
+
+  function get_block_literal_flags(orgpd, invokepd: tprocdef): longint;
+    { BlockLiteralFlags }
+    const
+      BLOCK_HAS_COPY_DISPOSE    = 1 shl 25;
+      BLOCK_HAS_CXX_OBJ         = 1 shl 26;
+      BLOCK_IS_GLOBAL           = 1 shl 28;
+      BLOCK_USE_STRET           = 1 shl 29;
+      BLOCK_HAS_SIGNATURE       = 1 shl 30;
+      BLOCK_HAS_EXTENDED_LAYOUT = 1 shl 31;
+    begin
+      result:=0;
+      { BLOCK_HAS_COPY_DISPOSE :
+          copy/dispose will be necessary once we support nested procedures, in
+          case they capture reference counted types, Objective-C class instances
+          or block-type variables
+      }
+
+      { BLOCK_HAS_CXX_OBJ:
+          we don't support C++ (stack-based) class instances yet
+      }
+
+      { BLOCK_IS_GLOBAL:
+          set in case the block does not capture any local state; used for
+          global functions and in theory also possible for nested functions that
+          do not access any variables from their parentfp context
+      }
+      if orgpd.is_addressonly then
+        result:=result or BLOCK_IS_GLOBAL;
+
+      { BLOCK_USE_STRET:
+          set in case the invoke function returns its result via a hidden
+          parameter
+      }
+      if paramanager.ret_in_param(invokepd.returndef,orgpd) then
+        result:=result or BLOCK_USE_STRET;
+      { BLOCK_HAS_SIGNATURE:
+          only if this bit is set, the above bit will actually be taken into
+          account (for backward compatibility). We need it so that our invoke
+          function isn't called as a variadic function, but on the downside this
+          requires Mac OS X 10.7 or later
+      }
+      result:=result or BLOCK_HAS_SIGNATURE;
+      { BLOCK_HAS_EXTENDED_LAYOUT:
+          no documentation about what this means or what it's good for (clang
+          adds it for Objective-C 1 platforms in case garbage collection is
+          switched off, but then you also have to actually generate this layout)
+      }
+    end;
+
+
+  function get_block_literal_descriptor(invokepd: tprocdef; block_literal_size: tcgint): tstaticvarsym;
+    var
+      descriptordef: tdef;
+      descriptor: tstaticvarsym;
+      name: tsymstr;
+      srsym: tsym;
+      srsymtable: tsymtable;
+    begin
+      (*
+        FPC_Block_descriptor_simple = record
+          reserved: culong;
+          Block_size: culong;
+          { signatures are only for the "ABI.2010.3.16" version, but that's all
+            we support because otherwise the callback has to be a C-style
+            variadic function, which we cannot (yet?) generate }
+          signature: pchar;
+        end;
+      *)
+
+      { 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);
+      { already exists -> return }
+      if searchsym(name,srsym,srsymtable) then
+        begin
+          if srsym.typ<>staticvarsym then
+            internalerror(2014071402);
+          result:=tstaticvarsym(srsym);
+          exit;
+        end;
+      { 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,[]);
+      symtablestack.top.insert(descriptor);
+      include(descriptor.symoptions,sp_internal);
+      { create typed constant for the descriptor }
+      str_parse_typedconst(current_asmdata.AsmLists[al_const],
+        '(reserved: 0; Block_size: '+tostr(block_literal_size)+
+        '; signature: '''+objcencodemethod(invokepd)+''');',descriptor);
+      result:=descriptor;
+    end;
+
+
+  { creates a wrapper function for pd with the C calling convention and an
+    extra first parameter pointing to the block "self" pointer. This wrapper is
+    what will be assigned to the "invoke" field of the block }
+  function get_invoke_wrapper(orgpd: tprocdef; orgpv: tprocvardef): tprocdef;
+    var
+      wrappername: TIDString;
+      srsym: tsym;
+      srsymtable: tsymtable;
+    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);
+      { already an invoke wrapper for this procsym -> reuse }
+      if searchsym(wrappername,srsym,srsymtable) then
+        begin
+          if (srsym.typ<>procsym) or
+             (tprocsym(srsym).procdeflist.count<>1) then
+            internalerror(2014071503);
+          result:=tprocdef(tprocsym(srsym).procdeflist[0]);
+          exit;
+        end;
+      { bare copy, so that self etc are not inserted }
+      result:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc));
+      { will be called accoding to the ABI conventions }
+      result.proccalloption:=pocall_cdecl;
+      { add po_is_block so that a block "self" pointer gets added (of the type
+        returned by get_block_literal_type_for_proc()) }
+      include(result.procoptions,po_is_block);
+      { now insert self/vmt/funcret according to the newly set calling
+        convention }
+      insert_self_and_vmt_para(result);
+      insert_funcret_para(result);
+      finish_copied_procdef(result,wrappername,current_module.localsymtable,nil);
+      if orgpd.is_addressonly then
+        begin
+          result.synthetickind:=tsk_callthrough;
+          result.skpara:=orgpd;
+        end
+      else
+        begin
+          { alias for the type to invoke the procvar, used in the symcreat
+            handling of tsk_block_invoke_procvar }
+          result.localst.insert(ctypesym.create('__FPC_BLOCK_INVOKE_PV_TYPE',orgpv));
+          result.synthetickind:=tsk_block_invoke_procvar;
+        end;
+    end;
+
+
+  { compose a block literal for a static block (one without context) }
+  function get_global_proc_literal_sym(blockliteraldef: tdef; blockisasym: tstaticvarsym; blockflags: longint; invokepd: tprocdef; descriptor: tstaticvarsym): tstaticvarsym;
+    var
+      literalname: TIDString;
+      srsym: tsym;
+      srsymtable: tsymtable;
+    begin
+      literalname:='block_literal_for_'+invokepd.procsym.realname;
+      { already exists -> return }
+      if searchsym(literalname,srsym,srsymtable) then
+        begin
+          if srsym.typ<>staticvarsym then
+            internalerror(2014071506);
+          result:=tstaticvarsym(srsym);
+          exit;
+        end;
+      { create new block literal symbol }
+      result:=cstaticvarsym.create(
+        '$'+literalname,
+        vs_value,
+        blockliteraldef,[]);
+      include(result.symoptions,sp_internal);
+      symtablestack.top.insert(result);
+      { initialise it }
+      str_parse_typedconst(current_asmdata.AsmLists[al_const],
+        '(base: (isa        : @'+blockisasym.realname+
+              '; flags     : '+tostr(blockflags)+
+              '; reserved  : 0'+
+              '; invoke    : @'+invokepd.procsym.realname+
+              '; descriptor: @'+descriptor.realname+
+              '));',
+        result);
+    end;
+
+
+  { compose an on-stack block literal for a "procedure of object" }
+  function get_pascal_method_literal(blockliteraldef: tdef; blockisasym: tstaticvarsym; blockflags: longint; procvarnode: tnode; invokepd: tprocdef; orgpv: tprocvardef; descriptor: tstaticvarsym): tnode;
+    var
+      statement: tstatementnode;
+      literaltemp: ttempcreatenode;
+    begin
+      result:=internalstatements(statement);
+      { create new block literal structure }
+      literaltemp:=ctempcreatenode.create(blockliteraldef,blockliteraldef.size,tt_persistent,false);
+      addstatement(statement,literaltemp);
+      { temp.base.isa:=@blockisasym }
+      addstatement(statement,cassignmentnode.create(
+        genloadfield(genloadfield(ctemprefnode.create(literaltemp),'BASE'),'ISA'),
+        caddrnode.create(cloadnode.create(blockisasym,blockisasym.owner))));
+      { temp.base.flags:=blockflags }
+      addstatement(statement,cassignmentnode.create(
+        genloadfield(genloadfield(ctemprefnode.create(literaltemp),'BASE'),'FLAGS'),
+        genintconstnode(blockflags)));
+      { temp.base.reserved:=0 }
+      addstatement(statement,cassignmentnode.create(
+        genloadfield(genloadfield(ctemprefnode.create(literaltemp),'BASE'),'RESERVED'),
+        genintconstnode(0)));
+      { temp.base.invoke:=tmethod(@invokepd) }
+      addstatement(statement,cassignmentnode.create(
+        genloadfield(genloadfield(ctemprefnode.create(literaltemp),'BASE'),'INVOKE'),
+        ctypeconvnode.create_proc_to_procvar(
+          cloadnode.create_procvar(invokepd.procsym,invokepd,invokepd.owner))));
+      { temp.base.descriptor:=@descriptor }
+      addstatement(statement,cassignmentnode.create(
+        genloadfield(genloadfield(ctemprefnode.create(literaltemp),'BASE'),'DESCRIPTOR'),
+        caddrnode.create(cloadnode.create(descriptor,descriptor.owner))));
+      { temp.pv:=tmethod(@orgpd) }
+      addstatement(statement,cassignmentnode.create(
+        ctypeconvnode.create_explicit(genloadfield(ctemprefnode.create(literaltemp),'PV'),orgpv),
+          procvarnode.getcopy));
+      { and return the address of the temp }
+      addstatement(statement,caddrnode.create(ctemprefnode.create(literaltemp)));
+      { typecheck this now, because the current source may be written in TP/
+        Delphi/MacPas mode and the above node tree has been constructed for
+        ObjFPC mode, which has been set by replace_scanner (in Delphi, the
+        assignment to invoke would be without the proc_to_procvar conversion) }
+      typecheckpass(result);
+    end;
+
+
+  function generate_block_for_procaddr(procloadnode: tloadnode): tnode;
+    var
+      procvarnode: tnode;
+      { procvardef representing the original function we want to invoke }
+      orgpv: tprocvardef;
+      { procdef of the original function we want to invoke }
+      orgpd,
+      { procdef for the invoke-wrapper that we generated to call the original
+        function via a procvar }
+      invokepd: tprocdef;
+      blockliteraldef: tdef;
+      descriptor,
+      blockisasym,
+      blockliteralsym: tstaticvarsym;
+      blockflags: longint;
+      old_symtablestack: tsymtablestack;
+      sstate: tscannerstate;
+    begin
+      result:=nil;
+      { supported? (should be caught earlier) }
+      if (procloadnode.resultdef.typ<>procdef) or
+         is_nested_pd(tprocdef(procloadnode.resultdef)) or
+         is_objcclass(tdef(procloadnode.resultdef.owner.defowner)) then
+        internalerror(2014071401);
+
+      { add every symbol that we create here to the unit-level symbol table }
+      old_symtablestack:=symtablestack;
+      symtablestack:=old_symtablestack.getcopyuntil(current_module.localsymtable);
+      { save scanner state }
+      replace_scanner('block literal creation',sstate);
+
+      { def representing the original function }
+      orgpd:=tprocdef(procloadnode.resultdef);
+      { def representing the corresponding procvar type }
+      procvarnode:=ctypeconvnode.create_proc_to_procvar(procloadnode.getcopy);
+      typecheckpass(procvarnode);
+      orgpv:=tprocvardef(procvarnode.resultdef);
+      { get blockdef for this kind of procdef }
+      blockliteraldef:=get_block_literal_type_for_proc(orgpd);
+      { get the invoke wrapper }
+      invokepd:=get_invoke_wrapper(orgpd,orgpv);
+      { get the descriptor }
+      descriptor:=get_block_literal_descriptor(invokepd,blockliteraldef.size);
+      { get the ISA pointer for the literal }
+      blockisasym:=get_block_literal_isa(orgpd);
+      { get the flags for the block }
+      blockflags:=get_block_literal_flags(orgpd,invokepd);
+      { global/simple procedure -> block literal is a typed constant }
+      if orgpd.is_addressonly then
+        begin
+          blockliteralsym:=get_global_proc_literal_sym(blockliteraldef,blockisasym,blockflags,invokepd,descriptor);
+          { result: address of the block literal }
+          result:=caddrnode.create(cloadnode.create(blockliteralsym,blockliteralsym.owner));
+        end
+      else
+        begin
+          result:=get_pascal_method_literal(blockliteraldef,blockisasym,blockflags,procvarnode,invokepd,orgpv,descriptor)
+        end;
+
+      procvarnode.free;
+
+      { restore scanner }
+      restore_scanner(sstate);
+      { restore symtable stack }
+      symtablestack.free;
+      symtablestack:=old_symtablestack;
+    end;
+
+end.
+

compiler/defcmp.pas

@@ -1533,6 +1533,10 @@ implementation
                    begin
                      { procvar -> procvar }
                      eq:=proc_to_procvar_equal(tprocvardef(def_from),tprocvardef(def_to),cdo_warn_incompatible_univ in cdoptions);
+                     if eq<te_equal then
+                       doconv:=tc_proc_2_procvar
+                     else
+                       doconv:=tc_equal;
                    end;
                  pointerdef :
                    begin
@@ -2176,30 +2180,38 @@ implementation
          if not(assigned(def1)) or not(assigned(def2)) then
            exit;
          { check for method pointer and local procedure pointer:
-             a) if one is a procedure of object, the other also has to be one
-             b) if one is a pure address, the other also has to be one
+             a) anything but procvars can be assigned to blocks
+             b) if one is a procedure of object, the other also has to be one
+                (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
                 (global procedures can be converted into nested procvars)
-             c) if def1 is a nested procedure, then def2 has to be a nested
+             d) if def1 is a nested procedure, then def2 has to be a nested
                 procvar and def1 has to have the po_delphi_nested_cc option
-             d) if def1 is a procvar, def1 and def2 both have to be nested or
+             e) if def1 is a procvar, def1 and def2 both have to be nested or
                 non-nested (we don't allow assignments from non-nested to
                 nested procvars to make sure that we can still implement
                 nested procvars using trampolines -- e.g., this would be
                 necessary for LLVM or CIL as long as they do not have support
                 for Delphi-style frame pointer parameter passing) }
-         if (def1.is_methodpointer<>def2.is_methodpointer) or  { a) }
-            ((def1.is_addressonly<>def2.is_addressonly) and    { b) }
+         if is_block(def2) then                                     { a) }
+           { 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) }
+            ((def1.is_addressonly<>def2.is_addressonly) and         { c) }
              (is_nested_pd(def1) or
               not is_nested_pd(def2))) or
-            ((def1.typ=procdef) and                            { c) }
+            ((def1.typ=procdef) and                                 { d) }
              is_nested_pd(def1) and
              (not(po_delphi_nested_cc in def1.procoptions) or
               not is_nested_pd(def2))) or
-            ((def1.typ=procvardef) and                         { d) }
+            ((def1.typ=procvardef) and                              { e) }
              (is_nested_pd(def1)<>is_nested_pd(def2))) then
            exit;
          pa_comp:=[cpo_ignoreframepointer];
+         if is_block(def2) then
+           include(pa_comp,cpo_ignorehidden);
          if checkincompatibleuniv then
            include(pa_comp,cpo_warn_incompatible_univ);
          { check return value and options, methodpointer is already checked }
@@ -2209,7 +2221,10 @@ implementation
            include(po_comp,po_staticmethod);
          if (m_delphi in current_settings.modeswitches) then
            exclude(po_comp,po_varargs);
-         if (def1.proccalloption=def2.proccalloption) and
+         { for blocks, the calling convention doesn't matter because we have to
+           generate a wrapper anyway }
+         if ((po_is_block in def2.procoptions) or
+             (def1.proccalloption=def2.proccalloption)) and
             ((po_comp * def1.procoptions)= (po_comp * def2.procoptions)) and
             equal_defs(def1.returndef,def2.returndef) then
           begin
@@ -2224,6 +2239,9 @@ implementation
                 { prefer non-nested to non-nested over non-nested to nested }
                 if (is_nested_pd(def1)<>is_nested_pd(def2)) then
                   eq:=te_convert_l1;
+                { in case of non-block to block, we need a type conversion }
+                if (po_is_block in def1.procoptions) <> (po_is_block in def2.procoptions) then
+                  eq:=te_convert_l1;
               end;
             proc_to_procvar_equal:=eq;
           end;

compiler/defutil.pas

@@ -331,6 +331,9 @@ interface
     { returns true of def is a methodpointer }
     function is_methodpointer(def : tdef) : boolean;
 
+    { returns true if def is a C "block" }
+    function is_block(def: tdef): boolean;
+
 implementation
 
     uses
@@ -1425,4 +1428,10 @@ implementation
         result:=(def.typ=procvardef) and (po_methodpointer in tprocvardef(def).procoptions);
       end;
 
+
+    function is_block(def: tdef): boolean;
+      begin
+        result:=(def.typ=procvardef) and (po_is_block in tprocvardef(def).procoptions)
+      end;
+
 end.

compiler/fppu.pas

@@ -836,7 +836,13 @@ var
                 end;
              end
            else
-             temp:=' not available';
+             begin
+               { still register the source module for proper error messages
+                 since source_avail for the module is still false, this should not hurt }
+               sourcefiles.register_file(tdosinputfile.create(hs));
+
+               temp:=' not available';
+             end;
            if is_main then
              begin
                mainsource:=hs;

compiler/globtype.pas

@@ -267,7 +267,7 @@ interface
      type
        { optimizer }
        toptimizerswitch = (cs_opt_none,
-         cs_opt_level1,cs_opt_level2,cs_opt_level3,
+         cs_opt_level1,cs_opt_level2,cs_opt_level3,cs_opt_level4,
          cs_opt_regvar,cs_opt_uncertain,cs_opt_size,cs_opt_stackframe,
          cs_opt_peephole,cs_opt_asmcse,cs_opt_loopunroll,cs_opt_tailrecursion,cs_opt_nodecse,
          cs_opt_nodedfa,cs_opt_loopstrength,cs_opt_scheduler,cs_opt_autoinline,cs_useebp,cs_userbp,
@@ -313,7 +313,7 @@ interface
 
     const
        OptimizerSwitchStr : array[toptimizerswitch] of string[17] = ('',
-         'LEVEL1','LEVEL2','LEVEL3',
+         'LEVEL1','LEVEL2','LEVEL3','LEVEL4',
          'REGVAR','UNCERTAIN','SIZE','STACKFRAME',
          'PEEPHOLE','ASMCSE','LOOPUNROLL','TAILREC','CSE',
          'DFA','STRENGTH','SCHEDULE','AUTOINLINE','USEEBP','USERBP',
@@ -345,7 +345,7 @@ interface
        genericlevel1optimizerswitches = [cs_opt_level1,cs_opt_peephole];
        genericlevel2optimizerswitches = [cs_opt_level2,cs_opt_remove_emtpy_proc];
        genericlevel3optimizerswitches = [cs_opt_level3,cs_opt_constant_propagate,cs_opt_nodedfa];
-       genericlevel4optimizerswitches = [cs_opt_reorder_fields,cs_opt_dead_values,cs_opt_fastmath];
+       genericlevel4optimizerswitches = [cs_opt_level4,cs_opt_reorder_fields,cs_opt_dead_values,cs_opt_fastmath];
 
        { whole program optimizations whose information generation requires
          information from all loaded units
@@ -400,8 +400,9 @@ interface
                                   fields in Java) }
          m_default_unicodestring, { makes the default string type in $h+ mode unicodestring rather than
                                     ansistring; similarly, char becomes unicodechar rather than ansichar }
-         m_type_helpers         { allows the declaration of "type helper" (non-Delphi) or "record helper"
+         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) }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -566,7 +567,8 @@ interface
          'SYSTEMCODEPAGE',
          'FINALFIELDS',
          'UNICODESTRINGS',
-         'TYPEHELPERS');
+         'TYPEHELPERS',
+         'CBLOCKS');
 
 
      type
@@ -615,7 +617,9 @@ interface
          { allocates memory on stack, so stack is unbalanced on exit }
          pi_has_stack_allocs,
          { set if the stack frame of the procedure is estimated }
-         pi_estimatestacksize
+         pi_estimatestacksize,
+         { the routine calls a C-style varargs function }
+         pi_calls_c_varargs
        );
        tprocinfoflags=set of tprocinfoflag;
 

compiler/hlcgobj.pas

@@ -2311,7 +2311,9 @@ implementation
 
   function thlcgobj.get_bit_reg_ref_sref(list: TAsmList; bitnumbersize, refsize: tdef; bitnumber: tregister; const ref: treference): tsubsetreference;
     var
-      tmpreg: tregister;
+      refptrdef: tdef;
+      tmpreg,
+      newbase: tregister;
     begin
       result.ref:=ref;
       result.startbit:=0;
@@ -2323,13 +2325,15 @@ implementation
 
       { don't assign to ref.base, that one is for pointers and this is an index
         (important for platforms like LLVM) }
-      if (result.ref.index=NR_NO) then
-        result.ref.index:=tmpreg
-      else
+      if result.ref.index<>NR_NO then
         begin
-          a_op_reg_reg(list,OP_ADD,ptruinttype,result.ref.index,tmpreg);
-          result.ref.index:=tmpreg;
+          { don't just add to ref.index, as it may be scaled }
+          refptrdef:=getpointerdef(refsize);
+          newbase:=getaddressregister(list,refptrdef);
+          a_loadaddr_ref_reg(list,refsize,refptrdef,ref,newbase);
+          reference_reset_base(result.ref,refptrdef,newbase,0,result.ref.alignment);
         end;
+      result.ref.index:=tmpreg;
       tmpreg:=getintregister(list,ptruinttype);
       a_load_reg_reg(list,bitnumbersize,ptruinttype,bitnumber,tmpreg);
       a_op_const_reg(list,OP_AND,ptruinttype,7,tmpreg);
@@ -4387,7 +4391,7 @@ implementation
     var
       href : treference;
     begin
-      if (tsym(p).typ=staticvarsym) then
+      if (tsym(p).typ=staticvarsym) and not(tstaticvarsym(p).noregvarinitneeded) then
        begin
          { Static variables can have the initialloc only set to LOC_CxREGISTER
            or LOC_INVALID, for explaination see gen_alloc_symtable (PFV) }

compiler/htypechk.pas

@@ -2780,7 +2780,7 @@ implementation
                    eq:=compare_defs_ext(n.resultdef,def_to,n.nodetype,convtype,pdoper,cdoptions);
                    n.free;
                  end
-              else if (def_to.typ=arraydef) and
+              else if is_open_array(def_to) and
                       is_class_or_interface_or_dispinterface_or_objc_or_java(tarraydef(def_to).elementdef) and
                       is_array_constructor(currpt.left.resultdef) and
                       assigned(tarrayconstructornode(currpt.left).left) then

compiler/i386/cgcpu.pas

@@ -343,7 +343,7 @@ unit cgcpu;
               begin
                 if (not paramanager.use_fixed_stack) then
                   internal_restore_regs(list,not (pi_has_stack_allocs in current_procinfo.flags));
-                list.concat(Taicpu.op_none(A_LEAVE,S_NO));
+                generate_leave(list);
               end;
             list.concat(tai_regalloc.dealloc(current_procinfo.framepointer,nil));
           end;

compiler/i386/cpupara.pas

@@ -302,7 +302,9 @@ unit cpupara;
           usedef:=forcetempdef;
         { on darwin/i386, if a record has only one field and that field is a
           single or double, it has to be returned like a single/double }
-        if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and
+        if (target_info.system in [system_i386_darwin,system_i386_iphonesim,
+                                   system_i386_freebsd,system_i386_openbsd,
+                                   system_i386_os2,system_i386_emx]) and
            ((usedef.typ=recorddef) or
             is_object(usedef)) and
            tabstractrecordsymtable(tabstractrecorddef(usedef).symtable).has_single_field(sym) and

compiler/i386/n386flw.pas

@@ -535,7 +535,7 @@ procedure ti386tryexceptnode.pass_generate_code;
     { start of scope }
     if assigned(right) then
       begin
-        current_asmdata.getdatalabel(filterlabel);
+        current_asmdata.getaddrlabel(filterlabel);
         emit_scope_start(
           current_asmdata.RefAsmSymbol('__FPC_on_handler'),
           filterlabel);
@@ -609,8 +609,7 @@ procedure ti386tryexceptnode.pass_generate_code;
           begin
             if hnode.nodetype<>onn then
               InternalError(2011103101);
-            { TODO: make it done without using global label }
-            current_asmdata.getglobaljumplabel(onlabel);
+            current_asmdata.getjumplabel(onlabel);
             hlist.concat(tai_const.create_sym(current_asmdata.RefAsmSymbol(tonnode(hnode).excepttype.vmt_mangledname,AT_DATA)));
             hlist.concat(tai_const.create_sym(onlabel));
             cg.a_label(current_asmdata.CurrAsmList,onlabel);
@@ -626,8 +625,7 @@ procedure ti386tryexceptnode.pass_generate_code;
             inc(onnodecount.value);
           end;
         { now move filter table to permanent list all at once }
-        maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
-        current_asmdata.asmlists[al_typedconsts].concatlist(hlist);
+        current_procinfo.aktlocaldata.concatlist(hlist);
         hlist.free;
       end;
 

compiler/i386/popt386.pas

@@ -79,6 +79,35 @@ begin
 end;
 
 
+function IsExitCode(p : tai) : boolean;
+  var
+    hp2,hp3 : tai;
+  begin
+    result:=(p.typ=ait_instruction) and
+    ((taicpu(p).opcode = A_RET) or
+     ((taicpu(p).opcode=A_LEAVE) and
+      GetNextInstruction(p,hp2) and
+      (hp2.typ=ait_instruction) and
+      (taicpu(hp2).opcode=A_RET)
+     ) or
+     ((taicpu(p).opcode=A_MOV) and
+      (taicpu(p).oper[0]^.typ=top_reg) and
+      (taicpu(p).oper[0]^.reg=NR_EBP) and
+      (taicpu(p).oper[1]^.typ=top_reg) and
+      (taicpu(p).oper[1]^.reg=NR_ESP) and
+      GetNextInstruction(p,hp2) and
+      (hp2.typ=ait_instruction) and
+      (taicpu(hp2).opcode=A_POP) and
+      (taicpu(hp2).oper[0]^.typ=top_reg) and
+      (taicpu(hp2).oper[0]^.reg=NR_EBP) and
+      GetNextInstruction(hp2,hp3) and
+      (hp3.typ=ait_instruction) and
+      (taicpu(hp3).opcode=A_RET)
+     )
+    );
+  end;
+
+
 function doFpuLoadStoreOpt(asmL: TAsmList; var p: tai): boolean;
 { returns true if a "continue" should be done after this optimization }
 var hp1, hp2: tai;
@@ -99,8 +128,7 @@ begin
       if (taicpu(p).opsize=S_FX) and
          getNextInstruction(hp1, hp2) and
          (hp2.typ = ait_instruction) and
-         ((taicpu(hp2).opcode = A_LEAVE) or
-          (taicpu(hp2).opcode = A_RET)) and
+         IsExitCode(hp2) and
          (taicpu(p).oper[0]^.ref^.base = current_procinfo.FramePointer) and
          not(assigned(current_procinfo.procdef.funcretsym) and
              (taicpu(p).oper[0]^.ref^.offset < tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)) and
@@ -517,7 +545,6 @@ function MatchReference(const ref : treference;base,index : TRegister) : Boolean
       (ref.index=index));
   end;
 
-
 { First pass of peephole optimizations }
 procedure PeepHoleOptPass1(Asml: TAsmList; BlockStart, BlockEnd: tai);
 
@@ -1214,8 +1241,7 @@ begin
                     result)}
                           if GetNextInstruction(p, hp1) and
                              (tai(hp1).typ = ait_instruction) then
-                            if ((taicpu(hp1).opcode = A_LEAVE) or
-                                (taicpu(hp1).opcode = A_RET)) and
+                            if IsExitCode(hp1) and
                                (taicpu(p).oper[1]^.typ = top_ref) and
                                (taicpu(p).oper[1]^.ref^.base = current_procinfo.FramePointer) and
                                not(assigned(current_procinfo.procdef.funcretsym) and
@@ -1873,9 +1899,7 @@ begin
                       if (taicpu(p).oper[0]^.typ = top_ref) and
                          GetNextInstruction(p, hp1) and
                          GetNextInstruction(hp1, hp2) and
-                         (hp2.typ = ait_instruction) and
-                         ((taicpu(hp2).opcode = A_LEAVE) or
-                          (taicpu(hp2).opcode = A_RET)) and
+                         IsExitCode(hp2) and
                          (taicpu(p).oper[0]^.ref^.base = current_procinfo.FramePointer) and
                          (taicpu(p).oper[0]^.ref^.index = NR_NO) and
                          not(assigned(current_procinfo.procdef.funcretsym) and
@@ -2307,22 +2331,47 @@ begin
               end;
             case taicpu(p).opcode Of
               A_CALL:
-                { don't do this on modern CPUs, this really hurts them due to
-                  broken call/ret pairing }
-                if (current_settings.optimizecputype < cpu_Pentium2) and
-                   not(cs_create_pic in current_settings.moduleswitches) and
-                   GetNextInstruction(p, hp1) and
-                   (hp1.typ = ait_instruction) and
-                   (taicpu(hp1).opcode = A_JMP) and
-                   ((taicpu(hp1).oper[0]^.typ=top_ref) and (taicpu(hp1).oper[0]^.ref^.refaddr=addr_full)) then
-                  begin
-                    hp2 := taicpu.Op_sym(A_PUSH,S_L,taicpu(hp1).oper[0]^.ref^.symbol);
-                    InsertLLItem(asml, p.previous, p, hp2);
-                    taicpu(p).opcode := A_JMP;
-                    taicpu(p).is_jmp := true;
-                    asml.remove(hp1);
-                    hp1.free;
-                  end;
+                begin
+                  { don't do this on modern CPUs, this really hurts them due to
+                    broken call/ret pairing }
+                  if (current_settings.optimizecputype < cpu_Pentium2) and
+                     not(cs_create_pic in current_settings.moduleswitches) and
+                     GetNextInstruction(p, hp1) and
+                     (hp1.typ = ait_instruction) and
+                     (taicpu(hp1).opcode = A_JMP) and
+                     ((taicpu(hp1).oper[0]^.typ=top_ref) and (taicpu(hp1).oper[0]^.ref^.refaddr=addr_full)) then
+                    begin
+                      hp2 := taicpu.Op_sym(A_PUSH,S_L,taicpu(hp1).oper[0]^.ref^.symbol);
+                      InsertLLItem(asml, p.previous, p, hp2);
+                      taicpu(p).opcode := A_JMP;
+                      taicpu(p).is_jmp := true;
+                      asml.remove(hp1);
+                      hp1.free;
+                    end
+                  { replace
+                      call   procname
+                      ret
+                    by
+                      jmp    procname
+
+                    this should never hurt except when pic is used, not sure
+                    how to handle it then
+
+                    but do it only on level 4 because it destroys stack back traces
+                  }  
+                  else if (cs_opt_level4 in current_settings.optimizerswitches) and
+                     not(cs_create_pic in current_settings.moduleswitches) and
+                     GetNextInstruction(p, hp1) and
+                     (hp1.typ = ait_instruction) and
+                     (taicpu(hp1).opcode = A_RET) and
+                     (taicpu(hp1).ops=0) then
+                    begin
+                      taicpu(p).opcode := A_JMP;
+                      taicpu(p).is_jmp := true;
+                      asml.remove(hp1);
+                      hp1.free;
+                    end;
+                end;
               A_CMP:
                 begin
                   if (taicpu(p).oper[0]^.typ = top_const) and

compiler/i8086/cgcpu.pas

@@ -1781,15 +1781,7 @@ unit cgcpu;
                   cg.a_op_const_reg(list,OP_ADD,OS_ADDR,stacksize,current_procinfo.framepointer);
               end
             else
-              begin
-                if current_settings.cputype < cpu_186 then
-                  begin
-                    list.concat(Taicpu.op_reg_reg(A_MOV, S_W, NR_BP, NR_SP));
-                    list.concat(Taicpu.op_reg(A_POP, S_W, NR_BP));
-                  end
-                else
-                  list.concat(Taicpu.op_none(A_LEAVE,S_NO));
-              end;
+              generate_leave(list);
             list.concat(tai_regalloc.dealloc(current_procinfo.framepointer,nil));
           end;
 

compiler/m68k/aasmcpu.pas

@@ -41,7 +41,7 @@ type
   taicpu = class(tai_cpu_abstract_sym)
      opsize : topsize;
 
-     procedure loadregset(opidx:longint; const dataregs,addrregs:tcpuregisterset);
+     procedure loadregset(opidx:longint; const dataregs,addrregs,fpuregs:tcpuregisterset);
 
      constructor op_none(op : tasmop);
      constructor op_none(op : tasmop;_size : topsize);
@@ -68,11 +68,11 @@ type
      constructor op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister; _op3 : treference);
      constructor op_const_reg_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : treference);
 
-     constructor op_reg_regset(op: tasmop; _size : topsize; _op1: tregister;const _op2data,_op2addr: tcpuregisterset);
-     constructor op_regset_reg(op: tasmop; _size : topsize;const _op1data,_op1addr: tcpuregisterset; _op2: tregister);
+     constructor op_reg_regset(op: tasmop; _size : topsize; _op1: tregister;const _op2data,_op2addr,_op2fpu: tcpuregisterset);
+     constructor op_regset_reg(op: tasmop; _size : topsize;const _op1data,_op1addr,_op1fpu: tcpuregisterset; _op2: tregister);
 
-     constructor op_ref_regset(op: tasmop; _size : topsize; _op1: treference;const _op2data,_op2addr: tcpuregisterset);
-     constructor op_regset_ref(op: tasmop; _size : topsize;const _op1data,_op1addr: tcpuregisterset; _op2: treference);
+     constructor op_ref_regset(op: tasmop; _size : topsize; _op1: treference;const _op2data,_op2addr,_op2fpu: tcpuregisterset);
+     constructor op_regset_ref(op: tasmop; _size : topsize;const _op1data,_op1addr,_op1fpu: tcpuregisterset; _op2: treference);
 
      { this is for Jmp instructions }
      constructor op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol);
@@ -87,6 +87,7 @@ type
 
      function is_same_reg_move(regtype: Tregistertype):boolean;override;
      function spilling_get_operation_type(opnr: longint): topertype;override;
+     function spilling_get_operation_type_ref(opnr: longint; reg: tregister): topertype;override;
 
   private
      procedure init(_size : topsize); { this need to be called by all constructor }
@@ -115,7 +116,7 @@ type
 
 
 
-    procedure taicpu.loadregset(opidx:longint; const dataregs,addrregs:tcpuregisterset);
+    procedure taicpu.loadregset(opidx:longint; const dataregs,addrregs,fpuregs:tcpuregisterset);
       var
         i : byte;
       begin
@@ -126,8 +127,10 @@ type
              clearop(opidx);
            new(dataregset);
            new(addrregset);
+           new(fpuregset);
            dataregset^:=dataregs;
            addrregset^:=addrregs;
+           fpuregset^:=fpuregs;
            typ:=top_regset;
            for i:=RS_D0 to RS_D7 do
              begin
@@ -139,6 +142,11 @@ type
                if assigned(add_reg_instruction_hook) and (i in addrregset^) then
                  add_reg_instruction_hook(self,newreg(R_ADDRESSREGISTER,i,R_SUBWHOLE));
              end;
+           for i:=RS_FP0 to RS_FP7 do
+             begin
+               if assigned(add_reg_instruction_hook) and (i in fpuregset^) then
+                 add_reg_instruction_hook(self,newreg(R_FPUREGISTER,i,R_SUBWHOLE));
+             end;
          end;
       end;
 
@@ -326,43 +334,43 @@ type
       end;
 
 
-   constructor taicpu.op_ref_regset(op: tasmop; _size : topsize; _op1: treference;const _op2data,_op2addr: tcpuregisterset);
+   constructor taicpu.op_ref_regset(op: tasmop; _size : topsize; _op1: treference;const _op2data,_op2addr,_op2fpu: tcpuregisterset);
      Begin
         inherited create(op);
         init(_size);
         ops:=2;
         loadref(0,_op1);
-        loadregset(1,_op2data,_op2addr);
+        loadregset(1,_op2data,_op2addr,_op2fpu);
      end;
 
 
-   constructor taicpu.op_regset_ref(op: tasmop; _size : topsize;const _op1data,_op1addr: tcpuregisterset; _op2: treference);
+   constructor taicpu.op_regset_ref(op: tasmop; _size : topsize;const _op1data,_op1addr,_op1fpu: tcpuregisterset; _op2: treference);
      Begin
         inherited create(op);
         init(_size);
         ops:=2;
-        loadregset(0,_op1data,_op1addr);
+        loadregset(0,_op1data,_op1addr,_op1fpu);
         loadref(1,_op2);
      End;
 
 
 
-   constructor taicpu.op_reg_regset(op: tasmop; _size : topsize; _op1: tregister;const _op2data,_op2addr: tcpuregisterset);
+   constructor taicpu.op_reg_regset(op: tasmop; _size : topsize; _op1: tregister;const _op2data,_op2addr,_op2fpu: tcpuregisterset);
      Begin
         inherited create(op);
         init(_size);
         ops:=2;
         loadreg(0,_op1);
-        loadregset(1,_op2data,_op2addr);
+        loadregset(1,_op2data,_op2addr,_op2fpu);
      end;
 
 
-   constructor taicpu.op_regset_reg(op: tasmop; _size : topsize;const _op1data,_op1addr: tcpuregisterset; _op2: tregister);
+   constructor taicpu.op_regset_reg(op: tasmop; _size : topsize;const _op1data,_op1addr,_op1fpu: tcpuregisterset; _op2: tregister);
      Begin
         inherited create(op);
         init(_size);
         ops:=2;
-        loadregset(0,_op1data,_op1addr);
+        loadregset(0,_op1data,_op1addr,_op1fpu);
         loadreg(1,_op2);
      End;
 
@@ -464,6 +472,7 @@ type
         result:=operand_read;
 
         case opcode of
+          // CPU opcodes
           A_MOVE, A_MOVEQ, A_MOVEA, A_MVZ, A_MVS, A_MOV3Q, A_LEA:
             if opnr=1 then
               result:=operand_write;
@@ -483,12 +492,32 @@ type
             result:=operand_readwrite;
           A_TST,A_CMP,A_CMPI:
             begin end; { Do nothing, default operand_read is fine here. }
+
+          // FPU opcodes
+          A_FSXX, A_FSEQ, A_FSNE, A_FSLT, A_FSLE, A_FSGT, A_FSGE:
+             result:=operand_write;
+          A_FMOVE:
+             if opnr=1 then
+               result:=operand_write;
+          A_FADD, A_FSUB, A_FMUL, A_FDIV:
+             if opnr=1 then
+               result:=operand_readwrite;
+          A_FCMP:
+             begin end; { operand_read }
+
           else begin
             internalerror(2004040903);
           end;
         end;
       end;
 
+    function taicpu.spilling_get_operation_type_ref(opnr: longint; reg: tregister): topertype;
+      begin
+        result := operand_read;
+        if (oper[opnr]^.ref^.base = reg) and
+          (oper[opnr]^.ref^.direction <> dir_none) then
+           result := operand_readwrite;
+      end;
 
     function spilling_create_load(const ref:treference;r:tregister):Taicpu;
       begin
@@ -508,17 +537,17 @@ type
 
     function spilling_create_store(r:tregister; const ref:treference):Taicpu;
       begin
-	case getregtype(r) of
-	  R_INTREGISTER :
-	    result:=taicpu.op_reg_ref(A_MOVE,S_L,r,ref);
-	  R_ADDRESSREGISTER :
-	    result:=taicpu.op_reg_ref(A_MOVE,S_L,r,ref);
-	  R_FPUREGISTER :
+        case getregtype(r) of
+          R_INTREGISTER :
+            result:=taicpu.op_reg_ref(A_MOVE,S_L,r,ref);
+          R_ADDRESSREGISTER :
+            result:=taicpu.op_reg_ref(A_MOVE,S_L,r,ref);
+          R_FPUREGISTER :
             // no need to handle sizes here
             result:=taicpu.op_reg_ref(A_FMOVE,S_FS,r,ref);
           else
             internalerror(200602012);
-	end;
+        end;
       end;
 
 

compiler/m68k/ag68kgas.pas

@@ -173,6 +173,11 @@ interface
                   if i in o.addrregset^ then
                    hs:=hs+gas_regname(newreg(R_ADDRESSREGISTER,i,R_SUBWHOLE))+'/';
                 end;
+              for i:=RS_FP0 to RS_FP7 do
+                begin
+                  if i in o.fpuregset^ then
+                   hs:=hs+gas_regname(newreg(R_FPUREGISTER,i,R_SUBWHOLE))+'/';
+                end;
               delete(hs,length(hs),1);
               getopstr := hs;
             end;
@@ -234,7 +239,7 @@ interface
          A_SNE,A_SPL,A_ST,A_SVC,A_SVS,A_SF]) then
          s:=gas_op2str[op]
         else
-        if op = A_SXX then
+        if op in [A_SXX, A_FSXX] then
          s:=gas_op2str[op]+cond2str[taicpu(hp).condition]
         else
         { size of DBRA is always WORD, doesn't need opsize (KB) }

compiler/m68k/aoptcpu.pas

@@ -25,6 +25,8 @@ unit aoptcpu;
 
 {$i fpcdefs.inc}
 
+{$define DEBUG_AOPTCPU}
+
   Interface
 
     uses
@@ -33,16 +35,31 @@ unit aoptcpu;
     Type
       TCpuAsmOptimizer = class(TAsmOptimizer)
         function PeepHoleOptPass1Cpu(var p: tai): boolean; override;
+
+        { outputs a debug message into the assembler file }
+        procedure DebugMsg(const s: string; p: tai);
       End;
 
   Implementation
 
     uses
-      cutils, aasmcpu;
+      cutils, aasmcpu, cgutils;
+
+{$ifdef DEBUG_AOPTCPU}
+  procedure TCpuAsmOptimizer.DebugMsg(const s: string; p : tai);
+    begin
+      asml.insertbefore(tai_comment.Create(strpnew(s)), p);
+    end;
+{$else DEBUG_AOPTCPU}
+  procedure TCpuAsmOptimizer.DebugMsg(const s: string; p : tai);inline;
+    begin
+    end;
+{$endif DEBUG_AOPTCPU}
 
   function TCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean;
     var
       next: tai;
+      tmpref: treference;
     begin
       result:=false;
       case p.typ of
@@ -50,21 +67,64 @@ unit aoptcpu;
           begin
             //asml.insertbefore(tai_comment.Create(strpnew('pass1 called for instr')), p);
 
-            { LEA (Ax),Ax is a NOP if src and dest reg is equal, so remove it. }
-            if getnextinstruction(p,next) and (taicpu(p).opcode = A_LEA) and
-               (not assigned(taicpu(p).oper[0]^.ref^.symbol)) and
-               (((taicpu(p).oper[0]^.ref^.base = taicpu(p).oper[1]^.reg) and
-               (taicpu(p).oper[0]^.ref^.index = NR_NO)) or
-               ((taicpu(p).oper[0]^.ref^.index = taicpu(p).oper[1]^.reg) and
-               (taicpu(p).oper[0]^.ref^.base = NR_NO))) and
-               (taicpu(p).oper[0]^.ref^.offset = 0) then
-              begin
-                //asml.insertbefore(tai_comment.Create(strpnew('LEA (Ax),Ax removed')), p);
-                asml.remove(p);
-                p.free;
-                p:=next;
-                result:=true;
-              end;
+            case taicpu(p).opcode of
+              { LEA (Ax),Ax is a NOP if src and dest reg is equal, so remove it. }
+              A_LEA:
+                if GetNextInstruction(p,next) and not assigned(taicpu(p).oper[0]^.ref^.symbol) and
+                   (((taicpu(p).oper[0]^.ref^.base = taicpu(p).oper[1]^.reg) and
+                   (taicpu(p).oper[0]^.ref^.index = NR_NO)) or
+                   ((taicpu(p).oper[0]^.ref^.index = taicpu(p).oper[1]^.reg) and
+                   (taicpu(p).oper[0]^.ref^.base = NR_NO))) and
+                   (taicpu(p).oper[0]^.ref^.offset = 0) then
+                  begin
+                    DebugMsg('Optimizer: LEA 0(Ax),Ax removed',p);
+                    asml.remove(p);
+                    p.free;
+                    p:=next;
+                    result:=true;
+                  end;
+              { Address register sub/add can be replaced with ADDQ/SUBQ or LEA if the value is in the
+                SmallInt range, which is shorter to encode and faster to execute on most 68k }
+              A_SUB,A_SUBA,A_ADD,A_ADDA:
+                if (taicpu(p).oper[1]^.typ = top_reg) and isaddressregister(taicpu(p).oper[1]^.reg) and
+                   (taicpu(p).oper[0]^.typ = top_const) then
+                  begin
+                    if isvalueforaddqsubq(taicpu(p).oper[0]^.val) then
+                      begin
+                        DebugMsg('Optimizer: SUB/ADD #val,Ax to SUBQ/ADDQ',p);
+                        taicpu(p).opsize:=S_L; // this is safe, because we're targetting an address reg
+                        if taicpu(p).opcode in [A_ADD,A_ADDA] then
+                          taicpu(p).opcode:=A_ADDQ
+                        else
+                          taicpu(p).opcode:=A_SUBQ;
+                        result:=true;
+                      end
+                    else
+                      if isvalue16bit(abs(taicpu(p).oper[0]^.val)) then
+                        begin
+                          DebugMsg('Optimizer: SUB/ADD #val,Ax to LEA val(Ax),Ax',p);
+                          if taicpu(p).opcode in [A_SUB,A_SUBA] then
+                            reference_reset_base(tmpref,taicpu(p).oper[1]^.reg,-taicpu(p).oper[0]^.val,0)
+                          else
+                            reference_reset_base(tmpref,taicpu(p).oper[1]^.reg,taicpu(p).oper[0]^.val,0);
+                          taicpu(p).opcode:=A_LEA;
+                          taicpu(p).loadref(0,tmpref);
+                          result:=true;
+                        end;
+                  end;
+              { CMP #0,<ea> equals to TST <ea>, just shorter and TST is more flexible anyway }
+              A_CMP:
+                if (taicpu(p).oper[0]^.typ = top_const) and
+                   (taicpu(p).oper[0]^.val = 0) then
+                  begin
+                    DebugMsg('Optimizer: CMP #0 to TST',p);
+                    taicpu(p).opcode:=A_TST;
+                    taicpu(p).loadoper(0,taicpu(p).oper[1]^);
+                    taicpu(p).clearop(1);
+                    taicpu(p).ops:=1;
+                    result:=true;
+                  end;
+            end;
           end;
       end;
     end;

compiler/m68k/aoptcpub.pas

@@ -27,7 +27,7 @@ Unit aoptcpub; { Assembler OPTimizer CPU specific Base }
 
 { enable the following define if memory references can have a scaled index }
 
-{ define RefsHaveScale}
+{$define RefsHaveScale}
 
 { enable the following define if memory references can have a segment }
 { override                                                            }
@@ -37,6 +37,7 @@ Unit aoptcpub; { Assembler OPTimizer CPU specific Base }
 Interface
 
 Uses
+  aasmtai,cgbase,
   cpubase,aasmcpu,AOptBase;
 
 Type
@@ -59,6 +60,7 @@ Type
 { ************************************************************************* }
 
   TAoptBaseCpu = class(TAoptBase)
+    function RegModifiedByInstruction(Reg: TRegister; p1: tai): boolean; override;
   End;
 
 
@@ -112,4 +114,20 @@ Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl}
 Begin
 End;
 
+  function TAoptBaseCpu.RegModifiedByInstruction(Reg: TRegister; p1: tai): boolean;
+    var
+      i : Longint;
+    begin
+      result:=false;
+      for i:=0 to taicpu(p1).ops-1 do
+        case taicpu(p1).oper[i]^.typ of
+          top_reg:
+            if (taicpu(p1).oper[i]^.reg=Reg) and (taicpu(p1).spilling_get_operation_type(i) in [operand_write,operand_readwrite]) then
+              exit(true);
+          top_ref:
+            if (taicpu(p1).spilling_get_operation_type_ref(i,Reg)<>operand_read) then
+              exit(true);
+        end;
+    end;
+
 End.

compiler/m68k/cgcpu.pas

@@ -58,6 +58,7 @@ unit cgcpu;
         procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override;
         procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override;
         procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override;
+        procedure a_loadfpu_reg_cgpara(list : TAsmList; size : tcgsize;const reg : tregister;const cgpara : TCGPara); override;
         procedure a_loadfpu_ref_cgpara(list : TAsmList; size : tcgsize;const ref : treference;const cgpara : TCGPara);override;
 
         procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister); override;
@@ -378,8 +379,9 @@ unit cgcpu;
         if use_push(cgpara) then
           begin
             { Record copy? }
-            if (cgpara.size in [OS_NO,OS_F64]) or (size=OS_NO) then
+            if (cgpara.size in [OS_NO,OS_F64]) or (size in [OS_NO,OS_F64]) then
               begin
+                //list.concat(tai_comment.create(strpnew('a_load_ref_cgpara: g_concatcopy')));
                 cgpara.check_simple_location;
                 len:=align(cgpara.intsize,cgpara.alignment);
                 g_stackpointer_alloc(list,len);
@@ -644,11 +646,15 @@ unit cgcpu;
         paramanager.freecgpara(list,paraloc3);
         paramanager.freecgpara(list,paraloc2);
         paramanager.freecgpara(list,paraloc1);
+        if current_settings.fputype in [fpu_68881] then
+          alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         alloccpuregisters(list,R_ADDRESSREGISTER,paramanager.get_volatile_registers_address(pocall_default));
         alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
         a_call_name(list,name,false);
         dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
         dealloccpuregisters(list,R_ADDRESSREGISTER,paramanager.get_volatile_registers_address(pocall_default));
+        if current_settings.fputype in [fpu_68881] then
+          dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
         cg.a_load_reg_reg(list,OS_32,OS_32,NR_FUNCTION_RESULT_REG,reg);
         paraloc3.done;
@@ -675,11 +681,15 @@ unit cgcpu;
         paramanager.freecgpara(list,paraloc3);
         paramanager.freecgpara(list,paraloc2);
         paramanager.freecgpara(list,paraloc1);
+        if current_settings.fputype in [fpu_68881] then
+          alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
         alloccpuregisters(list,R_ADDRESSREGISTER,paramanager.get_volatile_registers_address(pocall_default));
         a_call_name(list,name,false);
         dealloccpuregisters(list,R_ADDRESSREGISTER,paramanager.get_volatile_registers_address(pocall_default));
         dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        if current_settings.fputype in [fpu_68881] then
+          dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
         cg.a_load_reg_reg(list,OS_32,OS_32,NR_FUNCTION_RESULT_REG,reg2);
         paraloc3.done;
@@ -964,20 +974,16 @@ unit cgcpu;
       var
         instr : taicpu;
       begin
-        { in emulation mode, only 32-bit single is supported }
-        if (cs_fp_emulation in current_settings.moduleswitches) or (current_settings.fputype=fpu_soft) then
-          instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2)
-        else
-          instr:=taicpu.op_reg_reg(A_FMOVE,tcgsize2opsize[tosize],reg1,reg2);
-         add_move_instruction(instr);
-         list.concat(instr);
+        instr:=taicpu.op_reg_reg(A_FMOVE,S_FX,reg1,reg2);
+        add_move_instruction(instr);
+        list.concat(instr);
       end;
 
 
     procedure tcg68k.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister);
-     var
-      opsize : topsize;
-      href : treference;
+      var
+        opsize : topsize;
+        href : treference;
       begin
         opsize := tcgsize2opsize[fromsize];
         { extended is not supported, since it is not available on Coldfire }
@@ -985,50 +991,79 @@ unit cgcpu;
           internalerror(20020729);
         href := ref;
         fixref(list,href);
-        { in emulation mode, only 32-bit single is supported }
-        if (cs_fp_emulation in current_settings.moduleswitches) or (current_settings.fputype=fpu_soft) then
-           list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,reg))
-        else
-           begin
-             list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
-             if (tosize < fromsize) then
-               a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg);
-           end;
+        list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
       end;
 
     procedure tcg68k.a_loadfpu_reg_ref(list: TAsmList; fromsize,tosize: tcgsize; reg: tregister; const ref: treference);
       var
-       opsize : topsize;
+        opsize : topsize;
+        href : treference;
       begin
         opsize := tcgsize2opsize[tosize];
         { extended is not supported, since it is not available on Coldfire }
         if opsize = S_FX then
           internalerror(20020729);
-        { in emulation mode, only 32-bit single is supported }
-        if (cs_fp_emulation in current_settings.moduleswitches) or (current_settings.fputype=fpu_soft) then
-          list.concat(taicpu.op_reg_ref(A_MOVE,S_L,reg, ref))
-        else
-          list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg, ref));
+        href := ref;
+        fixref(list,href);
+        list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg,href));
       end;
 
+    procedure tcg68k.a_loadfpu_reg_cgpara(list : TAsmList;size : tcgsize;const reg : tregister;const cgpara : tcgpara);
+      var
+        ref : treference;
+      begin
+        if use_push(cgpara) and (current_settings.fputype in [fpu_68881]) then
+          begin
+            cgpara.check_simple_location;
+            { FIXME: 68k cg really needs to support 2 byte stack alignment, otherwise the "Extended"
+              floating point type cannot work (KB) }
+            reference_reset_base(ref, NR_STACK_POINTER_REG, 0, cgpara.alignment);
+            ref.direction := dir_dec;
+            list.concat(taicpu.op_reg_ref(A_FMOVE,tcgsize2opsize[cgpara.location^.size],reg,ref));
+          end
+        else
+          inherited a_loadfpu_reg_cgpara(list,size,reg,cgpara);
+      end;
 
     procedure tcg68k.a_loadfpu_ref_cgpara(list : TAsmList; size : tcgsize;const ref : treference;const cgpara : TCGPara);
+      var
+        href : treference;
+        fref : treference;
+        freg : tregister;
       begin
-        case cgpara.location^.loc of
-          LOC_REFERENCE,LOC_CREFERENCE:
-            begin
-              case size of
-                OS_F64:
-                  cg64.a_load64_ref_cgpara(list,ref,cgpara);
-                OS_F32:
-                  a_load_ref_cgpara(list,size,ref,cgpara);
-                else
-                  internalerror(2013021201);
+        if current_settings.fputype = fpu_soft then
+          case cgpara.location^.loc of
+            LOC_REFERENCE,LOC_CREFERENCE:
+              begin
+                case size of
+                  OS_F64:
+                    cg64.a_load64_ref_cgpara(list,ref,cgpara);
+                  OS_F32:
+                    a_load_ref_cgpara(list,size,ref,cgpara);
+                  else
+                    internalerror(2013021201);
+                end;
               end;
-            end;
+            else
+              inherited a_loadfpu_ref_cgpara(list,size,ref,cgpara);
+          end
+        else
+          if use_push(cgpara) and (current_settings.fputype in [fpu_68881]) then
+            begin
+              fref:=ref;
+              fixref(list,fref);
+              { fmove can't do <ea> -> <ea>, so move it to an fpreg first }
+              freg:=getfpuregister(list,size);
+              a_loadfpu_ref_reg(list,size,size,fref,freg);
+              reference_reset_base(href, NR_STACK_POINTER_REG, 0, cgpara.alignment);
+              href.direction := dir_dec;
+              list.concat(taicpu.op_reg_ref(A_FMOVE,tcgsize2opsize[cgpara.location^.size],freg,href));
+            end
           else
-            inherited a_loadfpu_ref_cgpara(list,size,ref,cgpara);
-        end;
+            begin
+              //list.concat(tai_comment.create(strpnew('a_loadfpu_ref_cgpara inherited')));
+              inherited a_loadfpu_ref_cgpara(list,size,ref,cgpara);
+            end;
       end;
 
 
@@ -1762,9 +1797,12 @@ unit cgcpu;
       var
         dataregs: tcpuregisterset;
         addrregs: tcpuregisterset;
+        fpuregs: tcpuregisterset;
         href : treference;
         hreg : tregister;
+        hfreg : tregister;
         size : longint;
+        fsize : longint;
         r : integer;
       begin
         { The code generated by the section below, particularly the movem.l
@@ -1775,10 +1813,13 @@ unit cgcpu;
           AS version instead. (KB) }
         dataregs:=[];
         addrregs:=[];
+        fpuregs:=[];
 
         { calculate temp. size }
         size:=0;
+        fsize:=0;
         hreg:=NR_NO;
+        hfreg:=NR_NO;
         for r:=low(saved_standard_registers) to high(saved_standard_registers) do
           if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
             begin
@@ -1794,14 +1835,22 @@ unit cgcpu;
                 inc(size,sizeof(aint));
                 addrregs:=addrregs + [saved_address_registers[r]];
               end;
+        if uses_registers(R_FPUREGISTER) then
+          for r:=low(saved_fpu_registers) to high(saved_fpu_registers) do
+            if saved_fpu_registers[r] in rg[R_FPUREGISTER].used_in_proc then
+              begin
+                hfreg:=newreg(R_FPUREGISTER,saved_fpu_registers[r],R_SUBWHOLE);
+                inc(fsize,10{sizeof(extended)});
+                fpuregs:=fpuregs + [saved_fpu_registers[r]];
+              end;
 
         { 68k has no MM registers }
         if uses_registers(R_MMREGISTER) then
           internalerror(2014030201);
 
-        if size>0 then
+        if (size+fsize) > 0 then
           begin
-            tg.GetTemp(list,size,sizeof(aint),tt_noreuse,current_procinfo.save_regs_ref);
+            tg.GetTemp(list,size+fsize,sizeof(aint),tt_noreuse,current_procinfo.save_regs_ref);
             include(current_procinfo.flags,pi_has_saved_regs);
 
             { Copy registers to temp }
@@ -1813,10 +1862,22 @@ unit cgcpu;
                 list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0));
                 reference_reset_base(href,NR_A0,0,sizeof(pint));
               end;
-            if size = sizeof(aint) then
-              list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hreg,href))
-            else
-              list.concat(taicpu.op_regset_ref(A_MOVEM,S_L,dataregs,addrregs,href));
+
+            if size > 0 then
+              if size = sizeof(aint) then
+                list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hreg,href))
+              else
+                list.concat(taicpu.op_regset_ref(A_MOVEM,S_L,dataregs,addrregs,[],href));
+
+            if fsize > 0 then
+              begin
+                { size is always longword aligned, while fsize is not }
+                inc(href.offset,size);
+                if fsize = 10{sizeof(extended)} then
+                  list.concat(taicpu.op_reg_ref(A_FMOVE,S_FX,hfreg,href))
+                else
+                  list.concat(taicpu.op_regset_ref(A_FMOVEM,S_FX,[],[],fpuregs,href));
+              end;
           end;
       end;
 
@@ -1825,20 +1886,26 @@ unit cgcpu;
       var
         dataregs: tcpuregisterset;
         addrregs: tcpuregisterset;
+        fpuregs : tcpuregisterset;
         href    : treference;
         r       : integer;
         hreg    : tregister;
+        hfreg   : tregister;
         size    : longint;
+        fsize   : longint;
       begin
         { see the remark about buggy GNU AS versions in g_save_registers() (KB) }
         dataregs:=[];
         addrregs:=[];
+        fpuregs:=[];
 
         if not(pi_has_saved_regs in current_procinfo.flags) then
           exit;
         { Copy registers from temp }
         size:=0;
+        fsize:=0;
         hreg:=NR_NO;
+        hfreg:=NR_NO;
         for r:=low(saved_standard_registers) to high(saved_standard_registers) do
           if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
             begin
@@ -1860,6 +1927,17 @@ unit cgcpu;
                 addrregs:=addrregs + [saved_address_registers[r]];
               end;
 
+        if uses_registers(R_FPUREGISTER) then
+          for r:=low(saved_address_registers) to high(saved_address_registers) do
+            if saved_fpu_registers[r] in rg[R_FPUREGISTER].used_in_proc then
+              begin
+                inc(fsize,10{sizeof(extended)});
+                hfreg:=newreg(R_FPUREGISTER,saved_address_registers[r],R_SUBWHOLE);
+                { Allocate register so the optimizer does not remove the load }
+                a_reg_alloc(list,hfreg);
+                fpuregs:=fpuregs + [saved_fpu_registers[r]];
+              end;
+
         { 68k has no MM registers }
         if uses_registers(R_MMREGISTER) then
           internalerror(2014030202);
@@ -1872,10 +1950,22 @@ unit cgcpu;
             list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0));
             reference_reset_base(href,NR_A0,0,sizeof(pint));
           end;
-        if size = sizeof(aint) then
-          list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,hreg))
-        else
-          list.concat(taicpu.op_ref_regset(A_MOVEM,S_L,href,dataregs,addrregs));
+
+        if size > 0 then
+          if size = sizeof(aint) then
+            list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,hreg))
+          else
+            list.concat(taicpu.op_ref_regset(A_MOVEM,S_L,href,dataregs,addrregs,[]));
+
+        if fsize > 0 then
+          begin
+            { size is always longword aligned, while fsize is not }
+            inc(href.offset,size);
+            if fsize = 10{sizeof(extended)} then
+              list.concat(taicpu.op_ref_reg(A_FMOVE,S_FX,href,hfreg))
+            else
+              list.concat(taicpu.op_ref_regset(A_FMOVEM,S_FX,href,[],[],fpuregs));
+          end;
 
         tg.UnGetTemp(list,current_procinfo.save_regs_ref);
       end;

compiler/m68k/cpubase.pas

@@ -89,7 +89,7 @@ unit cpubase;
          { (this may include 68040 mmu instructions)          }
          a_frestore,a_fsave,a_pflush,a_pflusha,a_pload,a_pmove,a_ptest,
          { useful for assembly language output }
-         a_label,a_dbxx,a_sxx,a_bxx,a_fbxx);
+         a_label,a_dbxx,a_sxx,a_bxx,a_fsxx,a_fbxx);
 
       {# This should define the array of instructions as string }
       op2strtable=array[tasmop] of string[11];
@@ -153,7 +153,7 @@ unit cpubase;
 
       { registers which may be destroyed by calls }
       VOLATILE_INTREGISTERS = [RS_D0,RS_D1];
-      VOLATILE_FPUREGISTERS = [];
+      VOLATILE_FPUREGISTERS = [RS_FP0,RS_FP1];
       VOLATILE_ADDRESSREGISTERS = [RS_A0,RS_A1];
 
     type
@@ -311,6 +311,7 @@ unit cpubase;
       }
       saved_standard_registers : array[0..5] of tsuperregister = (RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7);
       saved_address_registers : array[0..4] of tsuperregister = (RS_A2,RS_A3,RS_A4,RS_A5,RS_A6);
+      saved_fpu_registers : array[0..5] of tsuperregister = (RS_FP2,RS_FP3,RS_FP4,RS_FP5,RS_FP6,RS_FP7);
 
       { this is only for the generic code which is not used for this architecture }
       saved_mm_registers : array[0..0] of tsuperregister = (RS_INVALID);
@@ -359,6 +360,10 @@ unit cpubase;
     function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
     function dwarf_reg(r:tregister):shortint;
 
+    function isvalue8bit(val: tcgint): boolean;
+    function isvalue16bit(val: tcgint): boolean;
+    function isvalueforaddqsubq(val: tcgint): boolean;
+
 implementation
 
     uses
@@ -471,7 +476,9 @@ implementation
           R_INTREGISTER :
             result:=OS_32;
           R_FPUREGISTER :
-            result:=OS_F64;
+            { 68881 & compatibles -> 80 bit }
+            { CF FPU -> 64 bit, but that's unsupported for now }
+            result:=OS_F80;
           else
             internalerror(200303181);
         end;
@@ -539,4 +546,23 @@ implementation
           internalerror(200603251);
       end;
 
+
+    { returns true if given value fits to an 8bit signed integer }
+    function isvalue8bit(val: tcgint): boolean;
+      begin
+        isvalue8bit := (val >= low(shortint)) and (val <= high(shortint));
+      end;
+
+    { returns true if given value fits to a 16bit signed integer }
+    function isvalue16bit(val: tcgint): boolean;
+      begin
+        isvalue16bit := (val >= low(smallint)) and (val <= high(smallint));
+      end;
+
+    { returns true if given value fits addq/subq argument, so in 1 - 8 range }
+    function isvalueforaddqsubq(val: tcgint): boolean;
+      begin
+        isvalueforaddqsubq := (val >= 1) and (val <= 8);
+      end;
+
 end.

compiler/m68k/cpupara.pas

@@ -50,6 +50,7 @@ unit cpupara;
           function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;override;
           function get_volatile_registers_int(calloption:tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_address(calloption:tproccalloption):tcpuregisterset;override;
+          function get_volatile_registers_fpu(calloption:tproccalloption):tcpuregisterset;override;
          private
           function parse_loc_string_to_register(var locreg: tregister; const s : string): boolean;
           function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
@@ -79,6 +80,11 @@ unit cpupara;
         Result:=VOLATILE_ADDRESSREGISTERS;
       end;
 
+    function tm68kparamanager.get_volatile_registers_fpu(calloption:tproccalloption):tcpuregisterset;
+      begin
+        { fp0 and fp1 are considered volatile }
+        Result:=VOLATILE_FPUREGISTERS;
+      end;
 
     function tm68kparamanager.param_use_paraloc(const cgpara:tcgpara):boolean;
       var

compiler/m68k/itcpugas.pas

@@ -83,7 +83,7 @@ interface
          { (this may include 68040 mmu instructions)          }
          'frestore','fsave','pflush','pflusha','pload','pmove','ptest',
          { useful for assembly language output }
-         'label','db','s','b','fb');
+         'label','db','s','b','fs','fb');
 
     function gas_regnum_search(const s:string):Tregister;
     function gas_regname(r:Tregister):string;

compiler/m68k/n68kadd.pas

@@ -138,56 +138,67 @@ implementation
         if nf_swapped in flags then
           swapleftright;
 
-        // put both operands in a register
-        hlcg.location_force_fpureg(current_asmdata.CurrAsmList,right.location,right.resultdef,true);
-        hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
-
-        // initialize de result
-        location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
-        if left.location.loc = LOC_FPUREGISTER then
-          location.register := left.location.register
-        else if right.location.loc = LOC_FPUREGISTER then
-          location.register := right.location.register
-        else
-          location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
-
-        // emit the actual operation
-        {
-          current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,
-            location.register,left.location.register,
-            right.location.register))
-        }
+        case current_settings.fputype of
+          fpu_68881:
+            begin
+              // put both operands in a register
+              hlcg.location_force_fpureg(current_asmdata.CurrAsmList,right.location,right.resultdef,true);
+              hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
+
+              // initialize the result
+              location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
+              location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
+
+              // emit the actual operation
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FMOVE,S_FX,left.location.register,location.register));
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,S_FX,right.location.register,location.register));
+            end;
+          else
+            // softfpu should be handled in pass1, others are not yet supported...
+            internalerror(2015010201);
+        end;
       end;
 
 
     procedure t68kaddnode.second_cmpfloat;
+      var
+        tmpreg : tregister;
+        ai: taicpu;
       begin
         pass_left_right;
-
-{
         if (nf_swapped in flags) then
           swapleftright;
-}
-        { force fpureg as location, left right doesn't matter
-          as both will be in a fpureg }
-        hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
-        hlcg.location_force_fpureg(current_asmdata.CurrAsmList,right.location,right.resultdef,true);
 
-        location_reset(location,LOC_FLAGS,OS_NO);
-        location.resflags:=getresflags(true);
-{
-        if nodetype in [equaln,unequaln] then
-          current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMF,
-             left.location.register,right.location.register),
-             cgsize2fpuoppostfix[def_cgsize(resultdef)]))
-        else
-          current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMFE,
-             left.location.register,right.location.register),
-             cgsize2fpuoppostfix[def_cgsize(resultdef)]));
+        case current_settings.fputype of
+          fpu_68881:
+            begin
+              location_reset(location,LOC_FLAGS,OS_NO);
 
-        location_reset(location,LOC_FLAGS,OS_NO);
-        location.resflags:=getresflags(false);
-}
+              { force fpureg as location, left right doesn't matter
+                as both will be in a fpureg }
+              hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
+              hlcg.location_force_fpureg(current_asmdata.CurrAsmList,right.location,right.resultdef,true);
+
+              // emit compare
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FCMP,S_FX,right.location.register,left.location.register));
+
+              location.resflags:=getresflags(false);
+
+              // temporary(?) hack, move condition result back to the CPU from the FPU.
+              // 6888x has its own FBcc branch instructions and FScc flags->reg instruction,
+              // which we don't support yet in the rest of the cg. (KB)
+              tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_8);
+              ai:=taicpu.op_reg(A_FSxx,S_B,tmpreg);
+              ai.SetCondition(flags_to_cond(location.resflags));
+              current_asmdata.CurrAsmList.concat(ai);
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_B,tmpreg));
+              location.resflags:=F_E;
+
+            end;
+          else
+            // softfpu should be handled in pass1, others are not yet supported...
+            internalerror(2015010201);
+        end;
       end;
 
 

compiler/m68k/n68kcnv.pas

@@ -68,8 +68,14 @@ implementation
           end
         else
         { converting a 64bit integer to a float requires a helper }
-        if is_64bitint(left.resultdef) then
+        if is_64bitint(left.resultdef) or
+            is_currency(left.resultdef) then
           begin
+            { hack to avoid double division by 10000, as it's
+              already done by typecheckpass.resultdef_int_to_real }
+            if is_currency(left.resultdef) then
+              left.resultdef := s64inttype;
+
             if is_signed(left.resultdef) then
               fname := 'fpc_int64_to_double'
             else

compiler/mips/aoptcpu.pas

@@ -47,7 +47,7 @@ unit aoptcpu;
   Implementation
 
      uses
-       cutils,globals,aasmbase,cpuinfo,verbose;
+       cutils,globtype,globals,aasmbase,cpuinfo,verbose;
 
 
   function MatchInstruction(const instr: tai; const op: TAsmOp): boolean;
@@ -271,8 +271,11 @@ unit aoptcpu;
                 lw  $reg, (whatever)
                 <alloc volatile registers>
                 move $t9,$reg
-                jalr $t9      }
+                jalr $t9
+                Do not do so if the used register might contain a 
+                register variable.      }
               if (opcode=A_MOVE) and
+                 not(cs_opt_regvar in current_settings.optimizerswitches) and
                  (taicpu(next).oper[0]^.reg=NR_R25) and
                  GetNextInstruction(next,hp1) and
                  MatchInstruction(hp1,A_JALR) and
@@ -492,7 +495,8 @@ unit aoptcpu;
                       else if (taicpu(next).opcode in [A_ADD,A_ADDU,A_ADDI,A_ADDIU,A_SUB,A_SUBU]) and
                          MatchOperand(taicpu(next).oper[0]^,taicpu(p).oper[0]^.reg) then
                         begin
-                          if MatchOperand(taicpu(next).oper[1]^,taicpu(p).oper[0]^.reg) then
+                          if MatchOperand(taicpu(next).oper[1]^,taicpu(p).oper[0]^.reg) and
+                             Assigned(FindRegDealloc(taicpu(p).oper[0]^.reg,tai(next.next))) then
                             begin
                               taicpu(next).loadreg(1,taicpu(p).oper[1]^.reg);
                               asml.remove(p);
@@ -501,7 +505,8 @@ unit aoptcpu;
                             end
                           { TODO: if Ry=NR_R0, this effectively changes instruction into MOVE,
                             providing further optimization possibilities }
-                          else if MatchOperand(taicpu(next).oper[2]^,taicpu(p).oper[0]^.reg) then
+                          else if MatchOperand(taicpu(next).oper[2]^,taicpu(p).oper[0]^.reg) and
+                                  Assigned(FindRegDealloc(taicpu(p).oper[0]^.reg,tai(next.next))) then
                             begin
                               taicpu(next).loadreg(2,taicpu(p).oper[1]^.reg);
                               asml.remove(p);

compiler/msg/errorct.msg

@@ -264,7 +264,7 @@ scan_e_unsupported_asmmode_specifier=02050_E_L'estil d'assemblador especificat "
 % the compiler didn't recognize the mode you specified.
 scan_w_no_asm_reader_switch_inside_asm=02051_W_No es permet el commutador de lector d'ASM dins d'una declaració ASM, "$1" serà efectiu a continuació
 % It is not possible to switch from one assembler reader to another
-% inside an assmebler block. The new reader will be used for next
+% inside an assembler block. The new reader will be used for next
 % assembler statements only.
 scan_e_wrong_switch_toggle=02052_E_El modificador del commutador és erroni, utilitzeu ON/OFF o +/-
 % You need to use ON or OFF or a + or - to toggle the switch
@@ -2100,7 +2100,7 @@ option_code_page_not_available=11039_E_La p
 #
 option_logo=11023_[
 Free Pascal Compiler versió $FPCFULLVERSION [$FPCDATE] per $FPCCPU
-Copyright (c) 1993-2014 per Florian Klaempfl
+Copyright (c) 1993-2015 per Florian Klaempfl and others
 ]
 
 #

compiler/msg/errord.msg

@@ -3,10 +3,10 @@
 #   Latest updates contributed by Karl-Michael Schindler aka mischi
 #   <karl-michael.schindler at web.de>
 #
-#   Based on errore.msg of SVN revision 29129
+#   Based on errore.msg of SVN revision 29517
 #
 #   This file is part of the Free Pascal Compiler
-#   Copyright (c) 1998-2014 by the Free Pascal Development team
+#   Copyright (c) 1998-2015 by the Free Pascal Development team
 #
 #   See the file COPYING.v2, included in this distribution,
 #   for details about the copyright.
@@ -421,7 +421,7 @@ scan_e_illegal_hugepointernormalization=02098_E_Illegales Argument f
 #
 # Parser
 #
-# 03338 is the last used one
+# 03339 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -714,7 +714,7 @@ parser_e_comparative_operator_return_boolean=03090_E_Vergleichsoperator muss ein
 parser_e_only_virtual_methods_abstract=03091_E_Nur virtuelle Methoden k”nnen abstrakt sein
 % You are declaring a method as abstract, when it isn't declared to be
 % virtual.
-parser_f_unsupported_feature=03092_F_Benutzung einer nicht unterst�tzten Erweiterung!
+parser_f_unsupported_feature=03092_F_Benutzung der nicht unterst�tzten Erweiterung: "$1"
 % You're trying to force the compiler into doing something it cannot do yet.
 parser_e_mix_of_classes_and_objects=03093_E_Das Mischen von Klassen und Objekten ist unzul„ssig
 % You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} intertwined. E.g.
@@ -988,10 +988,10 @@ parser_w_skipped_fields_after=03177_W_Einige Felder nach dem Feld "$1" sind nich
 % You can leave some fields at the end of a type constant record uninitialized
 % (The compiler will initialize them to zero automatically). This may be the cause
 % of subtle problems.
-parser_e_varargs_need_cdecl_and_external=03178_E_Verwendung von VarArgs (oder '...' in MacPas) ohne CDecl/CPPDecl/MWPascal oder External nicht m”glich
+parser_e_varargs_need_cdecl_and_external=03178_E_Verwendung von VarArgs (oder '...' in MacPas) ohne CDecl/CPPDecl/MWPascal/StdCall oder External nicht m”glich
 % The varargs directive (or the ``...'' varargs parameter in MacPas mode) can only be
 % used with procedures or functions that are declared with \var{external} and one of
-% \var{cdecl}, \var{cppdecl} and \var{mwpascal}. This functionality
+% \var{cdecl}, \var{cppdecl}, \var{stdcall} and \var{mwpascal}. This functionality
 % is only supported to provide a compatible interface to C functions like printf.
 parser_e_self_call_by_value=03179_E_Self muss ein Call-By-Value-Parameter sein
 % You cannot declare \var{Self} as a const or var parameter, it must always be
@@ -1539,6 +1539,9 @@ parser_w_ptr_type_ignored=03338_W_Zeigertyp "$1" ignoriert
 % The specified pointer type modifier is ignored, because it is not supported on
 % the current platform. This happens, for example, when a far pointer is
 % declared on a non-x86 platform.
+parser_e_global_generic_references_static=03339_E_Ein globales, generisches Templat referenziert eine statische Symboltabelle
+% A generic declared in the interface section of a unit must not reference symbols that belong
+% solely to the implementation section of that unit.
 %
 % \end{description}
 # EndOfTeX
@@ -1546,7 +1549,7 @@ parser_w_ptr_type_ignored=03338_W_Zeigertyp "$1" ignoriert
 #
 # Type Checking
 #
-# 04122 is the last used one
+# 04123 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -1854,13 +1857,13 @@ type_w_zero_to_nil=04090_W_Konvertiere 0 zu NIL
 % Use NIL rather than 0 when initialising a pointer. 
 type_e_protocol_type_expected=04091_E_Objective-C Protokolltyp erwartet, erhielt aber "$1"
 % The compiler expected a protocol type name, but found something else.
-type_e_objc_type_unsupported=04092_E_Der Typ "$1" wird nicht f�r die Verwendung mit der Objective-C Laufzeitumgebung unterst�tzt.
-% Objective-C makes extensive use of run time type information (RTTI). This format
+type_e_objc_type_unsupported=04092_E_Der Typ "$1" wird f�r die Verwendung mit den Laufzeitumgebungen Objective-C- oder Blocks nicht unterst�tzt.
+% Objective-C and Blocks makes extensive use of run time type information (RTTI). This format
 % is defined by the maintainers of the run time and can therefore not be adapted
 % to all possible Object Pascal types. In particular, types that depend on
 % reference counting by the compiler (such as ansistrings and certain kinds of
 % interfaces) cannot be used as fields of Objective-C classes, cannot be
-% directly passed to Objective-C methods, and cannot be encoded using \var{objc\_encode}.
+% directly passed to Objective-C methods or Blocks, and cannot be encoded using \var{objc\_encode}.
 type_e_class_or_objcclass_type_expected=04093_E_Klasse oder Objective-C Klasse als Typ erwartet, erhielt aber "$1"
 % It is only possible to create class reference types of \var{class} and \var{objcclass}
 type_e_objcclass_type_expected=04094_E_Objective-C Klasse als Typ erwartet
@@ -1976,6 +1979,13 @@ type_e_procedure_must_be_far=04121_E_Prozedur oder Funktion muss weit ("far") se
 type_w_instance_abstract_class=04122_W_Erzeugung einer Instanz der abstrakten Klasse "$1"
 % The specified class is declared as \var{abstract} and thus no instance of this class
 % should be created. This is merely a warning for Delphi compatibility.
+type_e_function_reference_kind=04123_E_Unterprogrammreferenzen k”nnen nicht als "of object" oder "is nested" deklariert werden; sie k”nnen sich immer auf alle m”gliche Arten von Unterprogrammen beziehen
+% Subroutine references can refer to any kind of subroutine and hence do not
+% require specialisation for methods or nested subroutines.
+type_e_anonymous_function_unsupported=04999_E_Referenzen auf Funktionen werden noch nicht unterst�tzt, lediglich blocks (f�ge "cdecl;" am Ende hinzu.)
+% Remove this error message once Delphi-style anonymous are implemented. It has
+% number 4999 so as not to result in a gap in the error message numbering once
+% it's removed.
 %
 % \end{description}
 # EndOfTeX
@@ -1983,7 +1993,7 @@ type_w_instance_abstract_class=04122_W_Erzeugung einer Instanz der abstrakten Kl
 #
 # Symtable
 #
-# 05088 is the last used one
+# 05095 is the last used one
 #
 % \section{Symbol handling}
 % This section lists all the messages that concern the handling of symbols.
@@ -2251,6 +2261,47 @@ sym_d_adding_helper_for=05087_D_Helfer f
 % A helper for the mentioned type is added to the current scope
 sym_e_param_list=05088_E_Deklaration gefunden: $1
 % This message shows all overloaded declarations in case of an error.
+sym_w_uninitialized_managed_local_variable=05089_W_Die lokale Variable "$1" eines managed Typs ist anscheinend nicht initialisiert
+% This message is displayed if the compiler thinks that a variable will
+% be used (i.e. it appears in the right-hand side of an expression) when it
+% was not initialized first (i.e. appeared in the left-hand side of an
+% assignment). Since the variable is managed, i. e. implicitly initialized by the compiler, this might be intended behaviour and
+% does not necessarily mean that the code is wrong.
+sym_w_uninitialized_managed_variable=05090_W_Die Variable "$1" eines managed Typs ist anscheinend nicht initialisiert
+% This message is displayed if the compiler thinks that a variable will
+% be used (i.e. it appears in the right-hand side of an expression) when it
+% was not initialized first (i.e. appeared in the left-hand side of an
+% assignment). Since the variable is managed, i. e. implicitly initialized by the compiler, this might be intended behaviour and
+% does not necessarily mean that the code is wrong.
+sym_h_uninitialized_managed_local_variable=05091_H_Die lokale Variable "$1" eines managed Typs ist anscheinend nicht initialisiert
+% This message is displayed if the compiler thinks that a variable will
+% be used (i.e. it appears in the right-hand side of an expression) when it
+% was not initialized first (i.e. it did not appear in the left-hand side of an
+% assignment). Since the variable is managed, i. e. implicitly initialized by the compiler, this might be intended behaviour and
+% does not necessarily mean that the code is wrong.
+sym_h_uninitialized_managed_variable=05092_H_Die Variable "$1" eines managed Typs ist anscheinend nicht initialisiert
+% This message is displayed if the compiler thinks that a variable will
+% be used (i.e. it appears in the right-hand side of an expression) when it
+% was not initialized first (i.e. t did not appear in the left-hand side of an
+% assignment). Since the variable is managed, i. e. implicitly initialized by the compiler, this might be intended behaviour and
+% does not necessarily mean that the code is wrong.
+sym_w_managed_function_result_uninitialized=05093_W_Die Ergebnisvariable einer Funktion eines managed Typs ist anscheinend nicht initialisiert
+% This message is displayed if the compiler thinks that the function result
+% variable will be used (i.e. it appears in the right-hand side of an expression)
+% before it is initialized (i.e. before it appeared in the left-hand side of an
+% assignment). Since the variable is managed, i. e. implicitly initialized by the compiler, this might be intended behaviour and
+% does not necessarily mean that the code is wrong.
+sym_h_managed_function_result_uninitialized=05094_H_Die Ergebnisvariable einer Funktion eines managed Typs ist anscheinend nicht initialisiert
+% This message is displayed if the compiler thinks that the function result
+% variable will be used (i.e. it appears in the right-hand side of an expression)
+% before it is initialized (i.e. it appears in the left-hand side of an
+% assignment). Since the variable is managed, i. e. implicitly initialized by the compiler, this might be intended behaviour and
+% does not necessarily mean that the code is wrong.
+sym_w_duplicate_id=05095_W_Duplikat des Bezeichners "$1"
+% The identifier was already declared in an Objective-C category that's in the
+% same scope as the current identifier. This is a warning instead of an error,
+% because while this hides the identifier from the category, there are often
+% many unused categories in scope.
 %
 % \end{description}
 # EndOfTeX
@@ -2721,7 +2772,7 @@ asmr_e_invalid_ref_register=07125_E_Ung
 #
 # Assembler/binary writers
 #
-# 08026 is the last used one
+# 08028 is the last used one
 #
 asmw_f_too_many_asm_files=08000_F_Zu viele Assembler-Dateien
 % With smartlinking enabled, there are too many assembler
@@ -2765,6 +2816,12 @@ asmw_e_handlerdata_no_handler=08025_E_".seh_handlerdata"-Direktive ohne vorangeh
 asmw_f_too_many_relocations=08026_F_Relocationz„hler f�r Sektion $1 �bersteigt 65535
 % Legacy COFF targets limit number of relocations per section to 65535 because they use a 2-byte field
 % to store the relocation count. Targets using newer PECOFF format do not have this limitation.
+asmw_w_changing_bind_type=08027_N_Žnderung des Bind-Typs des Symbols $1 von $2 nach $3 nach seiner Verwendung
+asmw_h_changing_bind_type=08028_H_Žnderung des Bind-Typs des Symbols $1 von $2 nach $3 nach seiner Verwendung
+% An assembler symbol bind type has been altered after use, which can lead to wrong code.
+% First version is reserved for changig to local label, which is the most probable cause
+% of wrong code generation, but currently set to Note level as it appears inside
+% the compiler compilation.
 %
 % \end{description}
 # EndOfTeX
@@ -3173,10 +3230,10 @@ option_target_is_already_set=11011_W_Zielsystem ist bereits gesetzt: $1
 option_no_shared_lib_under_dos=11012_W_Gemeinsame Bibliotheken sind auf der DOS Platform nicht verf�gbar, verwende stattdessen statische Bibliotheken
 % If you specify \var{-CD} for the \dos platform, this message is displayed.
 % The compiler supports only static libraries under \dos.
-option_too_many_ifdef=11013_F_Zu viele \var{\#IF(N)DEFs} in Zeile $2 der Optionen-Datei $1
+option_too_many_ifdef=11013_F_Zu viele \#IF(N)DEFs in Zeile $2 der Optionen-Datei $1
 % The \var{\#IF(N)DEF} statements in the options file are not balanced with
 % the \var{\#ENDIF} statements.
-option_too_many_endif=11014_F_Unerwartetes \var{\#ENDIFs} in Zeile $2 der Optionen-Datei $1
+option_too_many_endif=11014_F_Unerwartete \#ENDIFs in Zeile $2 der Optionen-Datei $1
 % The \var{\#IF(N)DEF} statements in the options file are not balanced with
 % the \var{\#ENDIF} statements.
 option_too_less_endif=11015_F_Offene Bedingung am Ende der Optionen-Datei
@@ -3245,7 +3302,7 @@ option_confict_asm_debug=11041_W_Die gew
 option_ppc386_deprecated=11042_W_Die Verwendung von ppc386.cfg wird beendet. Bitte statt dessen fpc.cfg benutzen
 % Using ppc386.cfg is still supported for historical reasons, however, for a multiplatform
 % system the naming makes no sense anymore. Please continue to use fpc.cfg instead.
-option_else_without_if=11043_F_Zur \var{\#ELSE} Direktive in Zeile $2 der Optionen-Datei $1 gibt es kein entsprechendes \var{\#IF(N)DEF}
+option_else_without_if=11043_F_Zur \#ELSE Direktive in Zeile $2 der Optionen-Datei $1 gibt es kein entsprechendes \#IF(N)DEF
 % An \var{\#ELSE} statement was found in the options file without a matching \var{\#IF(N)DEF} statement.
 option_unsupported_target=11044_F_Die Option "$1" wird auf der Zielplattform nicht oder noch nicht unterst�tzt
 % Not all options are supported or implemented for all target platforms. This message informs you that a chosen
@@ -3368,7 +3425,7 @@ wpo_cant_create_feedback_file=12019_E_Die angegebene Feedback-Eingabe-Datei "$1"
 #
 option_logo=11023_[
 Free Pascal Compiler Version $FPCFULLVERSION [$FPCDATE] f�r $FPCTARGET
-Copyright (c) 1993-2014 Florian Kl„mpfl und andere
+Copyright (c) 1993-2015 Florian Kl„mpfl und andere
 ]
 
 #
@@ -3521,6 +3578,8 @@ P*2CN_Erzeuge
 **2Cp<x>_W„hle Instruction-Set aus; fpc -i oder fpc -ic geben die m”glichen Werte aus
 **2CP<x>=<y>_ Einstellungen f�r packing
 **3CPPACKSET=<y>_ <y> Belegung von Sets: 0, 1 oder DEFAULT oder NORMAL, 2, 4 und 8
+**3CPPACKENUM=<y>_ <y> Packen von Aufz„hlungen: 0, 1, 2 und 4 oder DEFAULT oder NORMAL
+**3CPPACKRECORD=<y>_ <y> Packen von Records: 0 oder DEFAULT oder NORMAL, 1, 2, 4, 8, 16 und 32
 **2Cr_F�hre Bereichspr�fung durch
 **2CR_Verifiziere die G�ltigkiet des Aufrufs der Objektmethoden
 **2Cs<n>_Setze die Pr�fgr”sse des Stacks auf <n>
@@ -3750,6 +3809,7 @@ V*2Tembedded_Embedded
 **2*_b : Schreibe bei Meldungen mit    p : Schreibe tree.log mit Analysenbaum (parse tree)
 **2*_    Dateinamen den vollst„ndigen  v : Schreibe fpcdebug.txt mit 
 **2*_    Pfad                              ganz viel Information
+**2*_z : Schreibe output nach stderr
 **2*_m<x>,<y> : Zeige die Meldungen mit den Nummern <x> und <y> nicht
 F*1V<x>_H„nge '-<x>' an den Namen der Compilerbinary an (z.B. f�r die Version)
 **1W<x>_Spezifiziere ein natives Programm (Windows)

compiler/msg/errorda.msg

@@ -271,7 +271,7 @@ scan_e_illegal_asmmode_specifier=02050_E_Ugyldig assemblerstil angivet "$1"
 % the compiler didn't recognize the mode you specified.
 scan_w_no_asm_reader_switch_inside_asm=02051_W_Kan ikke skifte assemblerlæser midt i en assemblerblok. Skifter til "$1" i næste blok
 % It is not possible to switch from one assembler reader to another
-% inside an assmebler block. The new reader will be used for next
+% inside an assembler block. The new reader will be used for next
 % assembler statements only.
 scan_e_wrong_switch_toggle=02052_E_Forkert indstillingsparameter. Brug ON/OFF eller +/-
 % You need to use ON or OFF or a + or - to toggle the switch
@@ -2207,7 +2207,7 @@ option_config_is_dir=11040_F_Konfigurationsfilen $1 er et directory
 #
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] til $FPCTARGET
-Copyright (c) 1993-2014 Florian Klaempfl
+Copyright (c) 1993-2015 Florian Klaempfl and others
 ]
 
 #

compiler/msg/errordu.msg

@@ -3,10 +3,10 @@
 #   Latest updates contributed by Karl-Michael Schindler aka mischi
 #   <karl-michael.schindler at web.de>
 #
-#   Based on errore.msg of SVN revision 29129
+#   Based on errore.msg of SVN revision 29517
 #
 #   This file is part of the Free Pascal Compiler
-#   Copyright (c) 1998-2014 by the Free Pascal Development team
+#   Copyright (c) 1998-2015 by the Free Pascal Development team
 #
 #   See the file COPYING.v2, included in this distribution,
 #   for details about the copyright.
@@ -421,7 +421,7 @@ scan_e_illegal_hugepointernormalization=02098_E_Illegales Argument für HUGEPOIN
 #
 # Parser
 #
-# 03338 is the last used one
+# 03339 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -714,7 +714,7 @@ parser_e_comparative_operator_return_boolean=03090_E_Vergleichsoperator muss ein
 parser_e_only_virtual_methods_abstract=03091_E_Nur virtuelle Methoden können abstrakt sein
 % You are declaring a method as abstract, when it isn't declared to be
 % virtual.
-parser_f_unsupported_feature=03092_F_Benutzung einer nicht unterstützten Erweiterung!
+parser_f_unsupported_feature=03092_F_Benutzung der nicht unterstützten Erweiterung: "$1"
 % You're trying to force the compiler into doing something it cannot do yet.
 parser_e_mix_of_classes_and_objects=03093_E_Das Mischen von Klassen und Objekten ist unzulässig
 % You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} intertwined. E.g.
@@ -988,10 +988,10 @@ parser_w_skipped_fields_after=03177_W_Einige Felder nach dem Feld "$1" sind nich
 % You can leave some fields at the end of a type constant record uninitialized
 % (The compiler will initialize them to zero automatically). This may be the cause
 % of subtle problems.
-parser_e_varargs_need_cdecl_and_external=03178_E_Verwendung von VarArgs (oder '...' in MacPas) ohne CDecl/CPPDecl/MWPascal oder External nicht möglich
+parser_e_varargs_need_cdecl_and_external=03178_E_Verwendung von VarArgs (oder '...' in MacPas) ohne CDecl/CPPDecl/MWPascal/StdCall oder External nicht möglich
 % The varargs directive (or the ``...'' varargs parameter in MacPas mode) can only be
 % used with procedures or functions that are declared with \var{external} and one of
-% \var{cdecl}, \var{cppdecl} and \var{mwpascal}. This functionality
+% \var{cdecl}, \var{cppdecl}, \var{stdcall} and \var{mwpascal}. This functionality
 % is only supported to provide a compatible interface to C functions like printf.
 parser_e_self_call_by_value=03179_E_Self muss ein Call-By-Value-Parameter sein
 % You cannot declare \var{Self} as a const or var parameter, it must always be
@@ -1539,6 +1539,9 @@ parser_w_ptr_type_ignored=03338_W_Zeigertyp "$1" ignoriert
 % The specified pointer type modifier is ignored, because it is not supported on
 % the current platform. This happens, for example, when a far pointer is
 % declared on a non-x86 platform.
+parser_e_global_generic_references_static=03339_E_Ein globales, generisches Templat referenziert eine statische Symboltabelle
+% A generic declared in the interface section of a unit must not reference symbols that belong
+% solely to the implementation section of that unit.
 %
 % \end{description}
 # EndOfTeX
@@ -1546,7 +1549,7 @@ parser_w_ptr_type_ignored=03338_W_Zeigertyp "$1" ignoriert
 #
 # Type Checking
 #
-# 04122 is the last used one
+# 04123 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -1854,13 +1857,13 @@ type_w_zero_to_nil=04090_W_Konvertiere 0 zu NIL
 % Use NIL rather than 0 when initialising a pointer. 
 type_e_protocol_type_expected=04091_E_Objective-C Protokolltyp erwartet, erhielt aber "$1"
 % The compiler expected a protocol type name, but found something else.
-type_e_objc_type_unsupported=04092_E_Der Typ "$1" wird nicht für die Verwendung mit der Objective-C Laufzeitumgebung unterstützt.
+type_e_objc_type_unsupported=04092_E_Der Typ "$1" wird für die Verwendung mit den Laufzeitumgebungen Objective-C- oder Blocks nicht unterstützt.
 % Objective-C makes extensive use of run time type information (RTTI). This format
 % is defined by the maintainers of the run time and can therefore not be adapted
 % to all possible Object Pascal types. In particular, types that depend on
 % reference counting by the compiler (such as ansistrings and certain kinds of
 % interfaces) cannot be used as fields of Objective-C classes, cannot be
-% directly passed to Objective-C methods, and cannot be encoded using \var{objc\_encode}.
+% directly passed to Objective-C methods or Blocks, and cannot be encoded using \var{objc\_encode}.
 type_e_class_or_objcclass_type_expected=04093_E_Klasse oder Objective-C Klasse als Typ erwartet, erhielt aber "$1"
 % It is only possible to create class reference types of \var{class} and \var{objcclass}
 type_e_objcclass_type_expected=04094_E_Objective-C Klasse als Typ erwartet
@@ -1976,6 +1979,13 @@ type_e_procedure_must_be_far=04121_E_Prozedur oder Funktion muss weit ("far") se
 type_w_instance_abstract_class=04122_W_Erzeugung einer Instanz der abstrakten Klasse "$1"
 % The specified class is declared as \var{abstract} and thus no instance of this class
 % should be created. This is merely a warning for Delphi compatibility.
+type_e_function_reference_kind=04123_E_Unterprogrammreferenzen können nicht als "of object" oder "is nested" deklariert werden; sie können sich immer auf alle mögliche Arten von Unterprogrammen beziehen
+% Subroutine references can refer to any kind of subroutine and hence do not
+% require specialisation for methods or nested subroutines.
+type_e_anonymous_function_unsupported=04999_E_Referenzen auf Funktionen werden noch nicht unterstützt, lediglich blocks (füge "cdecl;" am Ende hinzu.)
+% Remove this error message once Delphi-style anonymous are implemented. It has
+% number 4999 so as not to result in a gap in the error message numbering once
+% it's removed.
 %
 % \end{description}
 # EndOfTeX
@@ -1983,7 +1993,7 @@ type_w_instance_abstract_class=04122_W_Erzeugung einer Instanz der abstrakten Kl
 #
 # Symtable
 #
-# 05088 is the last used one
+# 05095 is the last used one
 #
 % \section{Symbol handling}
 % This section lists all the messages that concern the handling of symbols.
@@ -2251,6 +2261,47 @@ sym_d_adding_helper_for=05087_D_Helfer für $1 hinzugefügt
 % A helper for the mentioned type is added to the current scope
 sym_e_param_list=05088_E_Deklaration gefunden: $1
 % This message shows all overloaded declarations in case of an error.
+sym_w_uninitialized_managed_local_variable=05089_W_Die lokale Variable "$1" eines managed Typs ist anscheinend nicht initialisiert
+% This message is displayed if the compiler thinks that a variable will
+% be used (i.e. it appears in the right-hand side of an expression) when it
+% was not initialized first (i.e. appeared in the left-hand side of an
+% assignment). Since the variable is managed, i. e. implicitly initialized by the compiler, this might be intended behaviour and
+% does not necessarily mean that the code is wrong.
+sym_w_uninitialized_managed_variable=05090_W_Die Variable "$1" eines managed Typs ist anscheinend nicht initialisiert
+% This message is displayed if the compiler thinks that a variable will
+% be used (i.e. it appears in the right-hand side of an expression) when it
+% was not initialized first (i.e. appeared in the left-hand side of an
+% assignment). Since the variable is managed, i. e. implicitly initialized by the compiler, this might be intended behaviour and
+% does not necessarily mean that the code is wrong.
+sym_h_uninitialized_managed_local_variable=05091_H_Die lokale Variable "$1" eines managed Typs ist anscheinend nicht initialisiert
+% This message is displayed if the compiler thinks that a variable will
+% be used (i.e. it appears in the right-hand side of an expression) when it
+% was not initialized first (i.e. it did not appear in the left-hand side of an
+% assignment). Since the variable is managed, i. e. implicitly initialized by the compiler, this might be intended behaviour and
+% does not necessarily mean that the code is wrong.
+sym_h_uninitialized_managed_variable=05092_H_Die Variable "$1" eines managed Typs ist anscheinend nicht initialisiert
+% This message is displayed if the compiler thinks that a variable will
+% be used (i.e. it appears in the right-hand side of an expression) when it
+% was not initialized first (i.e. t did not appear in the left-hand side of an
+% assignment). Since the variable is managed, i. e. implicitly initialized by the compiler, this might be intended behaviour and
+% does not necessarily mean that the code is wrong.
+sym_w_managed_function_result_uninitialized=05093_W_Die Ergebnisvariable einer Funktion eines managed Typs ist anscheinend nicht initialisiert
+% This message is displayed if the compiler thinks that the function result
+% variable will be used (i.e. it appears in the right-hand side of an expression)
+% before it is initialized (i.e. before it appeared in the left-hand side of an
+% assignment). Since the variable is managed, i. e. implicitly initialized by the compiler, this might be intended behaviour and
+% does not necessarily mean that the code is wrong.
+sym_h_managed_function_result_uninitialized=05094_H_Die Ergebnisvariable einer Funktion eines managed Typs ist anscheinend nicht initialisiert
+% This message is displayed if the compiler thinks that the function result
+% variable will be used (i.e. it appears in the right-hand side of an expression)
+% before it is initialized (i.e. it appears in the left-hand side of an
+% assignment). Since the variable is managed, i. e. implicitly initialized by the compiler, this might be intended behaviour and
+% does not necessarily mean that the code is wrong.
+sym_w_duplicate_id=05095_W_Duplikat des Bezeichners "$1"
+% The identifier was already declared in an Objective-C category that's in the
+% same scope as the current identifier. This is a warning instead of an error,
+% because while this hides the identifier from the category, there are often
+% many unused categories in scope.
 %
 % \end{description}
 # EndOfTeX
@@ -2721,7 +2772,7 @@ asmr_e_invalid_ref_register=07125_E_Ungültiges Register in Speicherreferenzausd
 #
 # Assembler/binary writers
 #
-# 08026 is the last used one
+# 08028 is the last used one
 #
 asmw_f_too_many_asm_files=08000_F_Zu viele Assembler-Dateien
 % With smartlinking enabled, there are too many assembler
@@ -2765,6 +2816,12 @@ asmw_e_handlerdata_no_handler=08025_E_".seh_handlerdata"-Direktive ohne vorangeh
 asmw_f_too_many_relocations=08026_F_Relocationzähler für Sektion $1 übersteigt 65535
 % Legacy COFF targets limit number of relocations per section to 65535 because they use a 2-byte field
 % to store the relocation count. Targets using newer PECOFF format do not have this limitation.
+asmw_w_changing_bind_type=08027_N_Änderung des Bind-Typs des Symbols $1 von $2 nach $3 nach seiner Verwendung
+asmw_h_changing_bind_type=08028_H_Änderung des Bind-Typs des Symbols $1 von $2 nach $3 nach seiner Verwendung
+% An assembler symbol bind type has been altered after use, which can lead to wrong code.
+% First version is reserved for changig to local label, which is the most probable cause
+% of wrong code generation, but currently set to Note level as it appears inside
+% the compiler compilation.
 %
 % \end{description}
 # EndOfTeX
@@ -3173,10 +3230,10 @@ option_target_is_already_set=11011_W_Zielsystem ist bereits gesetzt: $1
 option_no_shared_lib_under_dos=11012_W_Gemeinsame Bibliotheken sind auf der DOS Platform nicht verfügbar, verwende stattdessen statische Bibliotheken
 % If you specify \var{-CD} for the \dos platform, this message is displayed.
 % The compiler supports only static libraries under \dos.
-option_too_many_ifdef=11013_F_Zu viele \var{\#IF(N)DEFs} in Zeile $2 der Optionen-Datei $1
+option_too_many_ifdef=11013_F_Zu viele \#IF(N)DEFs in Zeile $2 der Optionen-Datei $1
 % The \var{\#IF(N)DEF} statements in the options file are not balanced with
 % the \var{\#ENDIF} statements.
-option_too_many_endif=11014_F_Unerwartetes \var{\#ENDIFs} in Zeile $2 der Optionen-Datei $1
+option_too_many_endif=11014_F_Unerwartete \#ENDIFs in Zeile $2 der Optionen-Datei $1
 % The \var{\#IF(N)DEF} statements in the options file are not balanced with
 % the \var{\#ENDIF} statements.
 option_too_less_endif=11015_F_Offene Bedingung am Ende der Optionen-Datei
@@ -3245,7 +3302,7 @@ option_confict_asm_debug=11041_W_Die gewählte Assembler-Ausgabe "$1" kann kein
 option_ppc386_deprecated=11042_W_Die Verwendung von ppc386.cfg wird beendet. Bitte statt dessen fpc.cfg benutzen
 % Using ppc386.cfg is still supported for historical reasons, however, for a multiplatform
 % system the naming makes no sense anymore. Please continue to use fpc.cfg instead.
-option_else_without_if=11043_F_Zur \var{\#ELSE} Direktive in Zeile $2 der Optionen-Datei $1 gibt es kein entsprechendes \var{\#IF(N)DEF}
+option_else_without_if=11043_F_Zur \#ELSE Direktive in Zeile $2 der Optionen-Datei $1 gibt es kein entsprechendes \#IF(N)DEF
 % An \var{\#ELSE} statement was found in the options file without a matching \var{\#IF(N)DEF} statement.
 option_unsupported_target=11044_F_Die Option "$1" wird auf der Zielplattform nicht oder noch nicht unterstützt
 % Not all options are supported or implemented for all target platforms. This message informs you that a chosen
@@ -3368,7 +3425,7 @@ wpo_cant_create_feedback_file=12019_E_Die angegebene Feedback-Eingabe-Datei "$1"
 #
 option_logo=11023_[
 Free Pascal Compiler Version $FPCFULLVERSION [$FPCDATE] für $FPCTARGET
-Copyright (c) 1993-2014 Florian Klämpfl und andere
+Copyright (c) 1993-2015 Florian Klämpfl und andere
 ]
 
 #
@@ -3521,6 +3578,8 @@ P*2CN_Erzeuge Überprüfungen auf Nil-Zeiger (nur AIX)
 **2Cp<x>_Wähle Instruction-Set aus; fpc -i oder fpc -ic geben die möglichen Werte aus
 **2CP<x>=<y>_ Einstellungen für packing
 **3CPPACKSET=<y>_ <y> Belegung von Sets: 0, 1 oder DEFAULT oder NORMAL, 2, 4 und 8
+**3CPPACKENUM=<y>_ <y> Packen von Aufzählungen: 0, 1, 2 und 4 oder DEFAULT oder NORMAL
+**3CPPACKRECORD=<y>_ <y> Packen von Records: 0 oder DEFAULT oder NORMAL, 1, 2, 4, 8, 16 und 32
 **2Cr_Führe Bereichsprüfung durch
 **2CR_Verifiziere die Gültigkiet des Aufrufs der Objektmethoden
 **2Cs<n>_Setze die Prüfgrösse des Stacks auf <n>
@@ -3750,6 +3809,7 @@ V*2Tembedded_Embedded
 **2*_b : Schreibe bei Meldungen mit    p : Schreibe tree.log mit Analysenbaum (parse tree)
 **2*_    Dateinamen den vollständigen  v : Schreibe fpcdebug.txt mit 
 **2*_    Pfad                              ganz viel Information
+**2*_z : Schreibe output nach stderr
 **2*_m<x>,<y> : Zeige die Meldungen mit den Nummern <x> und <y> nicht
 F*1V<x>_Hänge '-<x>' an den Namen der Compilerbinary an (z.B. für die Version)
 **1W<x>_Spezifiziere ein natives Programm (Windows)

compiler/msg/errore.msg

@@ -411,7 +411,7 @@ scan_e_illegal_hugepointernormalization=02098_E_Illegal argument for HUGEPOINTER
 #
 # Parser
 #
-# 03338 is the last used one
+# 03339 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -977,10 +977,10 @@ parser_w_skipped_fields_after=03177_W_Some fields coming after "$1" were not ini
 % You can leave some fields at the end of a type constant record uninitialized
 % (The compiler will initialize them to zero automatically). This may be the cause
 % of subtle problems.
-parser_e_varargs_need_cdecl_and_external=03178_E_VarArgs directive (or '...' in MacPas) without CDecl/CPPDecl/MWPascal and External
+parser_e_varargs_need_cdecl_and_external=03178_E_VarArgs directive (or '...' in MacPas) without CDecl/CPPDecl/MWPascal/StdCall and External
 % The varargs directive (or the ``...'' varargs parameter in MacPas mode) can only be
 % used with procedures or functions that are declared with \var{external} and one of
-% \var{cdecl}, \var{cppdecl} and \var{mwpascal}. This functionality
+% \var{cdecl}, \var{cppdecl}, \var{stdcall}  and \var{mwpascal}. This functionality
 % is only supported to provide a compatible interface to C functions like printf.
 parser_e_self_call_by_value=03179_E_Self must be a normal (call-by-value) parameter
 % You cannot declare \var{Self} as a const or var parameter, it must always be
@@ -1528,6 +1528,9 @@ parser_w_ptr_type_ignored=03338_W_Pointer type "$1" ignored
 % The specified pointer type modifier is ignored, because it is not supported on
 % the current platform. This happens, for example, when a far pointer is
 % declared on a non-x86 platform.
+parser_e_global_generic_references_static=03339_E_Global Generic template references static symtable
+% A generic declared in the interface section of a unit must not reference symbols that belong
+% solely to the implementation section of that unit.
 %
 %
 %
@@ -1535,7 +1538,7 @@ parser_w_ptr_type_ignored=03338_W_Pointer type "$1" ignored
 %
 # Type Checking
 #
-# 04122 is the last used one
+# 04123 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -1843,13 +1846,13 @@ type_w_zero_to_nil=04090_W_Converting 0 to NIL
 % Use NIL rather than 0 when initialising a pointer.
 type_e_protocol_type_expected=04091_E_Objective-C protocol type expected, but got "$1"
 % The compiler expected a protocol type name, but found something else.
-type_e_objc_type_unsupported=04092_E_The type "$1" is not supported for interaction with the Objective-C runtime.
-% Objective-C makes extensive use of run time type information (RTTI). This format
+type_e_objc_type_unsupported=04092_E_The type "$1" is not supported for interaction with the Objective-C and the blocks runtime.
+% Objective-C and Blocks make extensive use of run time type information (RTTI). This format
 % is defined by the maintainers of the run time and can therefore not be adapted
 % to all possible Object Pascal types. In particular, types that depend on
 % reference counting by the compiler (such as ansistrings and certain kinds of
 % interfaces) cannot be used as fields of Objective-C classes, cannot be
-% directly passed to Objective-C methods, and cannot be encoded using \var{objc\_encode}.
+% directly passed to Objective-C methods or Blocks, and cannot be encoded using \var{objc\_encode}.
 type_e_class_or_objcclass_type_expected=04093_E_Class or objcclass type expected, but got "$1"
 % It is only possible to create class reference types of \var{class} and \var{objcclass}
 type_e_objcclass_type_expected=04094_E_Objcclass type expected
@@ -1965,11 +1968,18 @@ type_e_procedure_must_be_far=04121_E_Procedure or function must be far in order
 type_w_instance_abstract_class=04122_W_Creating an instance of abstract class "$1"
 % The specified class is declared as \var{abstract} and thus no instance of this class
 % should be created. This is merely a warning for Delphi compatibility.
+type_e_function_reference_kind=04123_E_Subroutine references cannot be declared as "of object" or "is nested", they can always refer to any kind of subroutine
+% Subroutine references can refer to any kind of subroutine and hence do not
+% require specialisation for methods or nested subroutines.
+type_e_anonymous_function_unsupported=04999_E_Function references are not yet supported, only blocks (add "cdecl;" at the end)
+% Remove this error message once Delphi-style anonymous are implemented. It has
+% number 4999 so as not to result in a gap in the error message numbering once
+% it's removed.
 % \end{description}
 #
 # Symtable
 #
-# 05087 is the last used one
+# 05095 is the last used one
 #
 % \section{Symbol handling}
 % This section lists all the messages that concern the handling of symbols.
@@ -2273,6 +2283,11 @@ sym_h_managed_function_result_uninitialized=05094_H_Function result variable of
 % before it is initialized (i.e. it appears in the left-hand side of an
 % assignment). Since the variable is managed, i. e. implicitly initialized by the compiler, this might be intended behaviour and
 % does not necessarily mean that the code is wrong.
+sym_w_duplicate_id=05095_W_Duplicate identifier "$1"
+% The identifier was already declared in an Objective-C category that's in the
+% same scope as the current identifier. This is a warning instead of an error,
+% because while this hides the identifier from the category, there are often
+% many unused categories in scope.
 % \end{description}
 #
 # Codegenerator
@@ -2736,7 +2751,7 @@ asmr_e_invalid_ref_register=07125_E_Invalid register used in memory reference ex
 #
 # Assembler/binary writers
 #
-# 08026 is the last used one
+# 08028 is the last used one
 #
 asmw_f_too_many_asm_files=08000_F_Too many assembler files
 % With smartlinking enabled, there are too many assembler
@@ -2780,7 +2795,12 @@ asmw_e_handlerdata_no_handler=08025_E_.seh_handlerdata directive without precedi
 asmw_f_too_many_relocations=08026_F_Relocation count for section $1 exceeds 65535
 % Legacy COFF targets limit number of relocations per section to 65535 because they use a 2-byte field
 % to store the relocation count. Targets using newer PECOFF format do not have this limitation.
-
+asmw_w_changing_bind_type=08027_N_Change of bind type of symbol $1 from $2 to $3 after use
+asmw_h_changing_bind_type=08028_H_Change of bind type of symbol $1 from $2 to $3 after use
+% An assembler symbol bind type has been altered after use, which can lead to wrong code.
+% First version is reserved for changig to local label, which is the most probable cause
+% of wrong code generation, but currently set to Note level as it appears inside
+% the compiler compilation.
 #
 # Executing linker/assembler
 #
@@ -3378,7 +3398,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 #
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2014 by Florian Klaempfl and others
+Copyright (c) 1993-2015 by Florian Klaempfl and others
 ]
 
 #
@@ -3487,7 +3507,7 @@ F*0*_Only options valid for the default or selected platform are listed.
 3*2Aelf_ELF (Linux) using internal writer
 3*2Acoff_COFF (Go32v2) using internal writer
 3*2Apecoff_PE-COFF (Win32) using internal writer
-3*2Ayasm_Assmeble using Yasm (experimental)
+3*2Ayasm_Assemble using Yasm (experimental)
 4*2Aas_Assemble using GNU AS
 4*2Agas_Assemble using GNU GAS
 4*2Agas-darwin_Assemble darwin Mach-O64 using GNU GAS
@@ -3760,7 +3780,7 @@ V*2Tembedded_Embedded
 **2*_a : Show everything             x : Show info about invoked tools
 **2*_b : Write file names messages   p : Write tree.log with parse tree
 **2*_    with full path              v : Write fpcdebug.txt with
-**2*_                                    lots of debugging info
+**2*_z : Write output to stderr          lots of debugging info
 **2*_m<x>,<y> : Do not show messages numbered <x> and <y>
 F*1V<x>_Append '-<x>' to the used compiler binary name (e.g. for version)
 **1W<x>_Target-specific options (targets)

compiler/msg/errores.msg

@@ -270,7 +270,7 @@ scan_e_illegal_asmmode_specifier=02050_E_Estilo de ensamblador inv
 % the compiler didn't recognize the mode you specified.
 scan_w_no_asm_reader_switch_inside_asm=02051_W_No es posible cambiar el lector dentro de una sentencia asm. "$1" solo sera efectivo en los siguientes
 % It is not possible to switch from one assembler reader to another
-% inside an assmebler block. The new reader will be used for next
+% inside an assembler block. The new reader will be used for next
 % assembler statements only.
 scan_e_wrong_switch_toggle=02052_E_Modificador de conmutador erróneo, use ON/OFF o +/-
 % You need to use ON or OFF or a + or - to toggle the switch
@@ -2111,7 +2111,7 @@ option_code_page_not_available=11039_E_C
 #
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2014 by Florian Klaempfl
+Copyright (c) 1993-2015 by Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorf.msg

@@ -269,7 +269,7 @@ scan_w_unsupported_asmmode_specifier=02050_W_Style assembleur non support
 % the compiler didn't recognize the mode you specified.
 scan_w_no_asm_reader_switch_inside_asm=02051_W_Changement de type d'interpr‚teur ASM … l'int‚rieur de code assembleur, $1 sera effectif seulement pour le prochain
 % It is not possible to switch from one assembler reader to another
-% inside an assmebler block. The new reader will be used for next
+% inside an assembler block. The new reader will be used for next
 % assembler statement only.
 scan_e_wrong_switch_toggle=02052_E_Mauvais argument de switch, utilisez ON/OFF ou +/-
 % You need to use ON or OFF or a + or - to toggle the switch
@@ -1712,7 +1712,7 @@ option_asm_forced=11022_W_"$1" assembler use forced
 #
 option_logo=11023_[
 Compilateur Free Pascal version $FPCFULLVERSION [$FPCDATE] pour $FPCTARGET
-Copyright (c) 1993-2014 by Florian Klaempfl
+Copyright (c) 1993-2015 by Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorfi.msg

@@ -2258,7 +2258,7 @@ option_config_is_dir=11040_F_Le fichier de configuration $1 est un r
 # Logo (option -l)
 #
 option_logo=11023_[ Compilateur Free Pascal version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2014, Florian Klaempfl ]
+Copyright (c) 1993-2015, Florian Klaempfl and others]
 #
 # Info (option -i)
 #

compiler/msg/errorhe.msg

@@ -2404,7 +2404,7 @@ option_confict_asm_debug=11041_W_
 #
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2014 by Florian Klaempfl
+Copyright (c) 1993-2015 by Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorheu.msg

@@ -2404,7 +2404,7 @@ option_confict_asm_debug=11041_W_סוג הפלט של המאסף שנבחר "$1"
 #
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2014 by Florian Klaempfl
+Copyright (c) 1993-2015 by Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorid.msg

@@ -2421,7 +2421,7 @@ option_confict_asm_debug=11041_W_Output assembler yang dipilih "$1" tidak bisa m
 #
 option_logo=11023_[
 Free Pascal Compiler versi $FPCFULLVERSION [$FPCDATE] untuk $FPCCPU
-Hak Cipta (c) 1993-2014 oleh Florian Klaempfl
+Hak Cipta (c) 1993-2015 oleh Florian Klaempfl and others
 ]
 
 #

compiler/msg/erroriu.msg

@@ -2690,7 +2690,7 @@ wpo_cant_create_feedback_file=12019_E_Impossibile creare il file di feedback "$1
 #
 option_logo=11023_[
 Compilatore Free Pascal, versione $FPCFULLVERSION [$FPCDATE] per $FPCCPU
-Copyright (c) 1993-2014 di Florian Klaempfl
+Copyright (c) 1993-2015 di Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorn.msg

@@ -2183,7 +2183,7 @@ option_config_is_dir=11040_F_Config bestand $1 is een directorie
 %\end{description}
 option_logo=11023_[
 Free Pascal Compiler versie $FPCFULLVERSION [$FPCDATE] voor $FPCTARGET
-Copyright (c) 1993-2014 door Florian Klaempfl en anderen
+Copyright (c) 1993-2015 door Florian Klaempfl en anderen
 ]
 #
 # Info (option -i)

compiler/msg/errorpl.msg

@@ -266,7 +266,7 @@ scan_w_unsupported_asmmode_specifier=02050_W_Nieprawid
 % the compiler didn't recognize the mode you specified.
 scan_w_no_asm_reader_switch_inside_asm=02051_W_Przeˆ¥cznik stylu asemblera niedozwolony w bloku asemblera, $1 b©dzie dziaˆa† dopiero w nast©pnym bloku
 % It is not possible to switch from one assembler reader to another
-% inside an assmebler block. The new reader will be used for next
+% inside an assembler block. The new reader will be used for next
 % assembler statement only.
 scan_e_wrong_switch_toggle=02052_E_Zˆa warto˜† przeˆ¥cznika, u¾yj ON/OFF lub +/-
 % You need to use ON or OFF or a + or - to toggle the switch
@@ -2116,7 +2116,7 @@ option_code_page_not_available=11039_E_Nieznana strona kodowa
 #
 option_logo=11023_[
 Free Pascal Compiler wersja $FPCFULLVERSION [$FPCDATE] dla $FPCCPU
-Copyright (c) 1993-2014 by Florian Klaempfl
+Copyright (c) 1993-2015 by Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorpli.msg

@@ -266,7 +266,7 @@ scan_w_unsupported_asmmode_specifier=02050_W_Nieprawid
 % the compiler didn't recognize the mode you specified.
 scan_w_no_asm_reader_switch_inside_asm=02051_W_Prze³±cznik stylu asemblera niedozwolony w bloku asemblera, $1 bêdzie dzia³aæ dopiero w nastêpnym bloku
 % It is not possible to switch from one assembler reader to another
-% inside an assmebler block. The new reader will be used for next
+% inside an assembler block. The new reader will be used for next
 % assembler statement only.
 scan_e_wrong_switch_toggle=02052_E_Z³a warto¶æ prze³±cznika, u¿yj ON/OFF lub +/-
 % You need to use ON or OFF or a + or - to toggle the switch
@@ -2116,7 +2116,7 @@ option_code_page_not_available=11039_E_Nieznana strona kodowa
 #
 option_logo=11023_[
 Free Pascal Compiler wersja $FPCFULLVERSION [$FPCDATE] dla $FPCCPU
-Copyright (c) 1993-2014 by Florian Klaempfl
+Copyright (c) 1993-2015 by Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorpt.msg

@@ -3083,7 +3083,7 @@ wpo_cant_create_feedback_file=12019_E_Imposs
 #
 option_logo=11023_[
 Compilador Free Pascal versÆo $FPCFULLVERSION [$FPCDATE] para $FPCCPU
-Copyright (c) 1993-2014 by Florian Klaempfl
+Copyright (c) 1993-2015 by Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorptu.msg

@@ -3083,7 +3083,7 @@ wpo_cant_create_feedback_file=12019_E_Impossível criar arquivo retorno otimiza
 #
 option_logo=11023_[
 Compilador Free Pascal versão $FPCFULLVERSION [$FPCDATE] para $FPCCPU
-Copyright (c) 1993-2014 by Florian Klaempfl
+Copyright (c) 1993-2015 by Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorr.msg

@@ -2503,7 +2503,7 @@ wpo_cant_create_feedback_file=12019_E_
 #
 option_logo=11023_[
 Š®¬¯¨«ïâ®à Free Pascal ¢¥àᨨ $FPCFULLVERSION [$FPCDATE] ¤«ï $FPCCPU
-Copyright (c) 1993-2014 by Florian Klaempfl
+Copyright (c) 1993-2015 by Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorru.msg

@@ -2503,7 +2503,7 @@ wpo_cant_create_feedback_file=12019_E_Невозможно создать фай
 #
 option_logo=11023_[
 Компилятор Free Pascal версии $FPCFULLVERSION [$FPCDATE] для $FPCCPU
-Copyright (c) 1993-2014 by Florian Klaempfl
+Copyright (c) 1993-2015 by Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorues.msg

@@ -264,7 +264,7 @@ scan_e_illegal_asmmode_specifier=02050_E_Estilo de ensamblador inváalido especi
 % the compiler didn't recognize the mode you specified.
 scan_w_no_asm_reader_switch_inside_asm=02051_W_No es posible cambiar el lector dentro de una sentencia asm. "$1" solo sera efectivo en los siguientes
 % It is not possible to switch from one assembler reader to another
-% inside an assmebler block. The new reader will be used for next
+% inside an assembler block. The new reader will be used for next
 % assembler statements only.
 scan_e_wrong_switch_toggle=02052_E_Modificador de conmutador erróneo, use ON/OFF o +/-
 % You need to use ON or OFF or a + or - to toggle the switch
@@ -2105,7 +2105,7 @@ option_code_page_not_available=11039_E_Código de página desconocido
 #
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2014 by Florian Klaempfl
+Copyright (c) 1993-2015 by Florian Klaempfl and others
 ]
 
 #

compiler/msgidx.inc

@@ -440,6 +440,7 @@ const
   parser_e_overloaded_have_same_mangled_name=03336;
   parser_e_default_value_val_const=03337;
   parser_w_ptr_type_ignored=03338;
+  parser_e_global_generic_references_static=03339;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -553,6 +554,8 @@ const
   type_e_type_not_allowed_for_type_helper=04120;
   type_e_procedure_must_be_far=04121;
   type_w_instance_abstract_class=04122;
+  type_e_function_reference_kind=04123;
+  type_e_anonymous_function_unsupported=04999;
   sym_e_id_not_found=05000;
   sym_f_internal_error_in_symtablestack=05001;
   sym_e_duplicate_id=05002;
@@ -634,6 +637,7 @@ const
   sym_h_uninitialized_managed_variable=05092;
   sym_w_managed_function_result_uninitialized=05093;
   sym_h_managed_function_result_uninitialized=05094;
+  sym_w_duplicate_id=05095;
   cg_e_parasize_too_big=06009;
   cg_e_file_must_call_by_reference=06012;
   cg_e_cant_use_far_pointer_there=06013;
@@ -816,6 +820,8 @@ const
   asmw_e_prologue_too_large=08024;
   asmw_e_handlerdata_no_handler=08025;
   asmw_f_too_many_relocations=08026;
+  asmw_w_changing_bind_type=08027;
+  asmw_h_changing_bind_type=08028;
   exec_w_source_os_redefined=09000;
   exec_i_assembling_pipe=09001;
   exec_d_cant_create_asmfile=09002;
@@ -1000,9 +1006,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 74490;
+  MsgTxtSize = 74953;
 
   MsgIdxMax : array[1..20] of longint=(
-    26,99,339,123,95,57,126,27,202,64,
+    26,99,340,1000,96,57,126,29,202,64,
     58,20,1,1,1,1,1,1,1,1
   );

compiler/nadd.pas

@@ -409,8 +409,7 @@ implementation
           end;
 
         { both are int constants }
-        if (
-            (
+        if  (
              is_constintnode(left) and
              is_constintnode(right)
             ) or
@@ -422,7 +421,7 @@ implementation
             (
              is_constenumnode(left) and
              is_constenumnode(right) and
-             allowenumop(nodetype))
+             (allowenumop(nodetype) or (nf_internal in flags))
             ) or
             (
              (lt = pointerconstn) and
@@ -2140,7 +2139,7 @@ implementation
          { enums }
          else if (ld.typ=enumdef) and (rd.typ=enumdef) then
           begin
-            if allowenumop(nodetype) then
+            if allowenumop(nodetype) or (nf_internal in flags) then
               inserttypeconv(right,left.resultdef)
             else
               CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);

compiler/nbas.pas

@@ -540,18 +540,30 @@ implementation
         {  main program body, and those nodes should always be blocknodes }
         {  since that's what the compiler expects elsewhere.              }
 
-        { if the current block contains only one statement, and   }
-        { this one statement only contains another block, replace }
-        { this block with that other block.                       }
         if assigned(left) and
-           not assigned(tstatementnode(left).right) and
-           (tstatementnode(left).left.nodetype = blockn) then
+           not assigned(tstatementnode(left).right) then
           begin
-            result:=tstatementnode(left).left;
-            tstatementnode(left).left:=nil;
-            { make sure the nf_block_with_exit flag is safeguarded }
-            result.flags:=result.flags+(flags*[nf_block_with_exit,nf_usercode_entry]);
-            exit;
+            case tstatementnode(left).left.nodetype of
+              blockn:
+                begin
+                  { if the current block contains only one statement, and
+                    this one statement only contains another block, replace
+                    this block with that other block.                       }
+                  result:=tstatementnode(left).left;
+                  tstatementnode(left).left:=nil;
+                  { make sure the nf_block_with_exit flag is safeguarded }
+                  result.flags:=result.flags+(flags*[nf_block_with_exit,nf_usercode_entry]);
+                  exit;
+                end;
+              nothingn:
+                begin
+                  { if the block contains only a statement with a nothing node,
+                    get rid of the statement }
+                  left.Free;
+                  left:=nil;
+                  exit;
+                end;
+            end;
           end;
       end;
 

compiler/ncal.pas

@@ -69,6 +69,7 @@ interface
           function  gen_procvar_context_tree_parentfp:tnode;
           function  gen_self_tree:tnode;
           function  gen_vmt_tree:tnode;
+          function gen_block_context:tnode;
           procedure gen_hidden_parameters;
           function  funcret_can_be_reused:boolean;
           procedure maybe_create_funcret_node;
@@ -268,6 +269,9 @@ interface
        between the callparanodes and the callnode they belong to }
       aktcallnode : tcallnode;
 
+    const
+      { track current inlining depth }
+      inlinelevel : longint = 0;
 
 implementation
 
@@ -1004,10 +1008,17 @@ implementation
                         { uninitialized warnings (tbs/tb0542)         }
                         set_varstate(left,vs_written,[]);
                         set_varstate(left,vs_readwritten,[]);
+                        make_not_regable(left,[ra_addr_regable,ra_addr_taken]);
                       end;
                     vs_var,
                     vs_constref:
-                      set_varstate(left,vs_readwritten,[vsf_must_be_valid,vsf_use_hints]);
+                      begin
+                        set_varstate(left,vs_readwritten,[vsf_must_be_valid,vsf_use_hints]);
+                        { constref takes also the address, but storing it is actually the compiler
+                          is not supposed to expect }
+                        if parasym.varspez=vs_var then
+                          make_not_regable(left,[ra_addr_regable,ra_addr_taken]);
+                      end;
                     else
                       set_varstate(left,vs_read,[vsf_must_be_valid]);
                   end;
@@ -1702,7 +1713,10 @@ implementation
                       typecheckpass(temp);
                       if (temp.nodetype <> ordconstn) or
                          (tordconstnode(temp).value <> 0) then
-                        hightree := caddnode.create(subn,hightree,temp)
+                        begin
+                          hightree:=caddnode.create(subn,hightree,temp);
+                          include(hightree.flags,nf_internal);
+                        end
                       else
                         temp.free;
                     end;
@@ -2337,6 +2351,13 @@ implementation
       end;
 
 
+    function tcallnode.gen_block_context: tnode;
+      begin
+        { the self parameter of a block invocation is that address of the
+          block literal (which is what right contains) }
+        result:=right.getcopy;
+      end;
+
 
     function check_funcret_used_as_para(var n: tnode; arg: pointer): foreachnoderesult;
       var
@@ -2567,8 +2588,10 @@ implementation
                          else
                            internalerror(200309287);
                        end
+                     else if not(po_is_block in procdefinition.procoptions) then
+                       para.left:=gen_procvar_context_tree_parentfp
                      else
-                       para.left:=gen_procvar_context_tree_parentfp;
+                       para.left:=gen_block_context
                    end
                 else
                  if vo_is_range_check in para.parasym.varoptions then
@@ -2821,6 +2844,7 @@ implementation
           end;
         if (i>0) then
           begin
+            include(current_procinfo.flags,pi_calls_c_varargs);
             varargsparas:=tvarargsparalist.create;
             pt:=tcallparanode(left);
             while assigned(pt) do
@@ -3489,9 +3513,25 @@ implementation
         { Can we inline the procedure? }
         if (po_inline in procdefinition.procoptions) and
            (procdefinition.typ=procdef) and
-           tprocdef(procdefinition).has_inlininginfo then
+           tprocdef(procdefinition).has_inlininginfo and
+           {  Prevent too deep inlining recursion and code bloat by inlining
+
+              The actual formuala is
+                                inlinelevel+1  /-------
+                  node count <  -------------\/  10000
+
+              This allows exponential grow of the code only to a certain limit.
+
+              Remarks
+               - The current approach calculates the inlining level top down, so outer call nodes (nodes closer to the leaf) might not be inlined
+                 if the max. complexity is reached. This is done because it makes the implementation easier and because
+                 there might be situations were it is more beneficial to inline inner nodes and do the calls to the outer nodes
+                 if the outer nodes are in a seldomly used code path
+               - The code avoids to use functions from the math unit
+           }
+           (node_count(tprocdef(procdefinition).inlininginfo^.code)<round(exp((1.0/(inlinelevel+1))*ln(10000)))) then
           begin
-             include(callnodeflags,cnf_do_inline);
+            include(callnodeflags,cnf_do_inline);
             { Check if we can inline the procedure when it references proc/var that
               are not in the globally available }
             st:=procdefinition.owner;
@@ -3883,7 +3923,10 @@ implementation
             ((tloadnode(n).symtable.symtabletype in [globalsymtable,ObjectSymtable]) or
             { statics can only be modified by functions in the same unit }
              ((tloadnode(n).symtable.symtabletype = staticsymtable) and
-              (tloadnode(n).symtable = TSymtable(arg))))) or
+              (tloadnode(n).symtable = TSymtable(arg))) or
+              { if the addr of the symbol is taken somewhere, it can be also non-local }
+              (tabstractvarsym(tloadnode(n).symtableentry).addr_taken)
+           )) or
            ((n.nodetype = subscriptn) and
             (tsubscriptnode(n).vs.owner.symtabletype = ObjectSymtable)) then
           result := fen_norecurse_true;
@@ -4151,6 +4194,18 @@ implementation
       end;
 
 
+    { this procedure removes the user code flag because it prevents optimizations }
+    function removeusercodeflag(var n : tnode; arg : pointer) : foreachnoderesult;
+      begin
+        result:=fen_false;
+        if nf_usercode_entry in n.flags then
+          begin
+            exclude(n.flags,nf_usercode_entry);
+            result:=fen_norecurse_true;
+          end;
+      end;
+
+
     function tcallnode.pass1_inline:tnode;
       var
         n,
@@ -4159,6 +4214,7 @@ implementation
         inlineblock,
         inlinecleanupblock : tblocknode;
       begin
+        inc(inlinelevel);
         result:=nil;
         if not(assigned(tprocdef(procdefinition).inlininginfo) and
                assigned(tprocdef(procdefinition).inlininginfo^.code)) then
@@ -4186,6 +4242,7 @@ implementation
 
         { create a copy of the body and replace parameter loads with the parameter values }
         body:=tprocdef(procdefinition).inlininginfo^.code.getcopy;
+        foreachnodestatic(pm_postprocess,body,@removeusercodeflag,nil);
         foreachnode(pm_preprocess,body,@replaceparaload,@fileinfo);
 
         { Concat the body and finalization parts }
@@ -4256,6 +4313,7 @@ implementation
         writeln('**************************',tprocdef(procdefinition).mangledname);
         printnode(output,result);
 {$endif DEBUGINLINE}
+        dec(inlinelevel);
       end;
 
 end.

compiler/ncgcal.pas

@@ -28,7 +28,7 @@ interface
     uses
       cpubase,
       globtype,
-      parabase,cgutils,
+      parabase,cgbase,cgutils,
       symdef,node,ncal;
 
     type
@@ -95,6 +95,8 @@ interface
           function can_call_ref(var ref: treference):boolean;virtual;
           procedure extra_call_ref_code(var ref: treference);virtual;
           procedure do_call_ref(ref: treference);virtual;
+
+          procedure load_block_invoke(toreg: tregister);virtual;
        public
           procedure pass_generate_code;override;
           destructor destroy;override;
@@ -107,11 +109,11 @@ implementation
       systems,
       cutils,verbose,globals,
       cpuinfo,
-      symconst,symtable,symtype,defutil,paramgr,
-      cgbase,pass_2,
+      symconst,symbase,symtable,symtype,symsym,defutil,paramgr,
+      pass_2,
       aasmbase,aasmtai,aasmdata,
       nbas,nmem,nld,ncnv,nutils,
-      ncgutil,
+      ncgutil,blockutl,
       cgobj,tgobj,hlcgobj,
       procinfo,
       wpobase;
@@ -449,6 +451,26 @@ implementation
       end;
 
 
+    procedure tcgcallnode.load_block_invoke(toreg: tregister);
+      var
+        href: treference;
+        srsym: tsym;
+        srsymtable: tsymtable;
+        literaldef: trecorddef;
+      begin
+        literaldef:=get_block_literal_type_for_proc(tabstractprocdef(right.resultdef));
+        hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,getpointerdef(literaldef),true);
+        { load the invoke pointer }
+        hlcg.reference_reset_base(href,right.resultdef,right.location.register,0,right.resultdef.alignment);
+        if not searchsym_in_record(literaldef,'INVOKE',srsym,srsymtable) or
+           (srsym.typ<>fieldvarsym) or
+           (tfieldvarsym(srsym).vardef<>voidpointertype) then
+          internalerror(2014071506);
+        href.offset:=tfieldvarsym(srsym).fieldoffset;
+        hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,tfieldvarsym(srsym).vardef,procdefinition,href,toreg);
+      end;
+
+
     procedure tcgcallnode.set_result_location(realresdef: tstoreddef);
       begin
         if realresdef.is_intregable or
@@ -1007,7 +1029,9 @@ implementation
               pvreg:=cg.getintregister(current_asmdata.CurrAsmList,proc_addr_size);
               { Only load OS_ADDR from the reference (when converting to hlcg:
                 watch out with procedure of object) }
-              if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
+              if po_is_block in procdefinition.procoptions then
+                load_block_invoke(pvreg)
+              else if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
                 begin
                   href:=right.location.reference;
                   callref:=can_call_ref(href);

compiler/ncgcnv.pas

@@ -176,6 +176,11 @@ interface
         if (nf_explicit in flags) and
            not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
           begin
+             { overriding methods must be able to know in advance whether this
+               code path will be taken by checking expectloc, so they can call
+               the inherited method in that case }
+             if left.expectloc in [LOC_FLAGS,LOC_JUMP] then
+               internalerror(2014122901);
              location_copy(location,left.location);
              newsize:=def_cgsize(resultdef);
              { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }

compiler/ncgmat.pas

@@ -457,9 +457,9 @@ implementation
     procedure tcgshlshrnode.second_integer;
       var
          op : topcg;
-         opdef,right_opdef : tdef;
+         opdef: tdef;
          hcountreg : tregister;
-         opsize,right_opsize : tcgsize;
+         opsize : tcgsize;
          shiftval : longint;
       begin
          { determine operator }
@@ -472,44 +472,51 @@ implementation
 {$ifdef cpunodefaultint}
         opsize:=left.location.size;
         opdef:=left.resultdef;
-        right_opsize:=opsize;
-        right_opdef:=opdef;
 {$else cpunodefaultint}
-         { load left operators in a register }
-         if is_signed(left.resultdef) then
-           begin
-             right_opsize:=OS_SINT;
-             right_opdef:=ossinttype;
-             {$ifdef cpu16bitalu}
-               if left.resultdef.size > 2 then
-                 begin
-                   opsize:=OS_S32;
-                   opdef:=s32inttype;
-                 end
-               else
-             {$endif cpu16bitalu}
-                 begin
-                   opsize:=OS_SINT;
-                   opdef:=ossinttype
-                 end;
-           end
-         else
-           begin
-             right_opsize:=OS_INT;
-             right_opdef:=osuinttype;
-             {$ifdef cpu16bitalu}
-               if left.resultdef.size > 2 then
-                 begin
-                   opsize:=OS_32;
-                   opdef:=u32inttype;
-                 end
-               else
-             {$endif cpu16bitalu}
-                 begin
-                   opsize:=OS_INT;
-                   opdef:=osuinttype;
-                 end;
-             end;
+        if left.resultdef.size<=4 then
+          begin
+            if is_signed(left.resultdef) then
+              begin
+                if (sizeof(aint)<4) and
+                   (left.resultdef.size<=sizeof(aint)) then
+                  begin
+                    opsize:=OS_SINT;
+                    opdef:=sinttype;
+                  end
+                else
+                  begin
+                    opdef:=s32inttype;
+                    opsize:=OS_S32
+                  end
+              end
+            else
+              begin
+                if (sizeof(aint)<4) and
+                   (left.resultdef.size<=sizeof(aint)) then
+                  begin
+                    opsize:=OS_INT;
+                    opdef:=uinttype;
+                  end
+                else
+                  begin
+                    opdef:=u32inttype;
+                    opsize:=OS_32;
+                  end
+              end
+          end
+        else
+          begin
+            if is_signed(left.resultdef) then
+              begin
+                opdef:=s64inttype;
+                opsize:=OS_S64;
+              end
+            else
+              begin
+                opdef:=u64inttype;
+                opsize:=OS_64;
+              end;
+          end;
 {$endif cpunodefaultint}
 
          if not(left.location.loc in [LOC_CREGISTER,LOC_REGISTER]) or
@@ -538,14 +545,8 @@ implementation
                 is done since most target cpu which will use this
                 node do not support a shift count in a mem. location (cec)
               }
-              if not(right.location.loc in [LOC_CREGISTER,LOC_REGISTER]) then
-                begin
-                  hcountreg:=hlcg.getintregister(current_asmdata.CurrAsmList,right_opdef);
-                  hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,right.resultdef,right_opdef,right.location,hcountreg);
-                end
-              else
-                hcountreg:=right.location.register;
-              hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,op,opdef,hcountreg,left.location.register,location.register);
+              hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,opdef,true);
+              hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,op,opdef,right.location.register,left.location.register,location.register);
            end;
          { shl/shr nodes return the same type as left, which can be different
            from opdef }

compiler/ncgmem.pas

@@ -446,14 +446,14 @@ implementation
                        offsetcorrection:=0;
                        if (left.location.size in [OS_PAIR,OS_SPAIR]) then
                          begin
-                           if (vs.fieldoffset>=sizeof(aword)) then
-                             begin
-                               location.sreg.subsetreg := left.location.registerhi;
-                               offsetcorrection:=sizeof(aword)*8;
-                             end
+                           if (vs.fieldoffset>=sizeof(aword)) xor (target_info.endian=endian_big) then
+                             location.sreg.subsetreg := left.location.registerhi
                            else
                              location.sreg.subsetreg := left.location.register;
 
+                           if (vs.fieldoffset>=sizeof(aword)) then
+                             offsetcorrection:=sizeof(aword)*8;
+
                            location.sreg.subsetregsize := OS_INT;
                          end
                        else

compiler/ncgutil.pas

@@ -1348,10 +1348,18 @@ implementation
         item := TCmdStrListItem(pd.aliasnames.first);
         while assigned(item) do
           begin
-            current_asmdata.DefineAsmSymbol(item.str,AB_GLOBAL,AT_FUNCTION);
-            item := TCmdStrListItem(item.next);
-          end;
-       end;
+            { The condition to use global or local symbol must match
+              the code written in hlcg.gen_proc_symbol to 
+              avoid change from AB_LOCAL to AB_GLOBAL, which generates
+              erroneous code (at least for targets using GOT) } 
+            if (cs_profile in current_settings.moduleswitches) or
+               (po_global in current_procinfo.procdef.procoptions) then
+              current_asmdata.DefineAsmSymbol(item.str,AB_GLOBAL,AT_FUNCTION)
+            else
+              current_asmdata.DefineAsmSymbol(item.str,AB_LOCAL,AT_FUNCTION);
+           item := TCmdStrListItem(item.next);
+         end;
+      end;
 
 
     procedure gen_proc_entry_code(list:TAsmList);

compiler/ncnv.pas

@@ -296,7 +296,7 @@ implementation
       symconst,symdef,symsym,symcpu,symtable,
       ncon,ncal,nset,nadd,nmem,nmat,nbas,nutils,ninl,
       cgbase,procinfo,
-      htypechk,pass_1,cpuinfo;
+      htypechk,blockutl,pass_1,cpuinfo;
 
 
 {*****************************************************************************
@@ -1992,6 +1992,7 @@ implementation
     function ttypeconvnode.typecheck_proc_to_procvar : tnode;
       var
         pd : tabstractprocdef;
+        source: pnode;
       begin
         result:=nil;
         pd:=tabstractprocdef(left.resultdef);
@@ -2002,7 +2003,36 @@ implementation
           real procvartype that we are converting to) }
         if assigned(totypedef) and
            (totypedef.typ=procvardef) then
-          resultdef:=totypedef
+          begin
+            { have to do this in typecheckpass so that it's triggered for
+              typed constant declarations }
+            if po_is_block in tprocvardef(totypedef).procoptions then
+              begin
+                { can only convert from procdef to procvardef, but in the mean
+                  time other type conversions may have been inserted (pointers,
+                  proc2procvar, ...) }
+                source:=actualtargetnode(@left);
+                while (source^.nodetype=typeconvn) and
+                      (ttypeconvnode(source^).convtype=tc_proc_2_procvar) and
+                      (is_void(source^.resultdef) or
+                       (source^.resultdef.typ=procvardef)) do
+                  begin
+                    { won't skip proc2procvar }
+                    source:=actualtargetnode(@ttypeconvnode(source^).left);
+                  end;
+                if (source^.nodetype=loadn) and
+                   (source^.resultdef.typ=procdef) and
+                   not is_nested_pd(tprocdef(source^.resultdef)) and
+                   not is_objcclass(tdef(source^.resultdef.owner.defowner)) then
+                  begin
+                    result:=generate_block_for_procaddr(tloadnode(source^));
+                    exit;
+                  end
+                else
+                  CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
+              end;
+            resultdef:=totypedef;
+          end
         else
          begin
            resultdef:=pd.getcopyas(procvardef,pc_normal);
@@ -2241,7 +2271,9 @@ implementation
                        the procvar, is compatible with the procvar's type }
                      if not(nf_explicit in flags) and
                         (proc_to_procvar_equal(currprocdef,tprocvardef(resultdef),false)=te_incompatible) then
-                       IncompatibleTypes(left.resultdef,resultdef);
+                       IncompatibleTypes(left.resultdef,resultdef)
+                     else
+                       result:=typecheck_call_helper(convtype);
                      exit;
                    end
                   else if maybe_global_proc_to_nested(left,resultdef) then

compiler/ngenutil.pas

@@ -695,7 +695,7 @@ implementation
       unitinits.insert(Tai_const.Create_pint(count));
       { Add to data segment }
       maybe_new_object_file(current_asmdata.asmlists[al_globals]);
-      new_section(current_asmdata.asmlists[al_globals],sec_data,'INITFINAL',sizeof(pint));
+      new_section(current_asmdata.asmlists[al_globals],sec_data,'INITFINAL',const_align(sizeof(pint)));
       current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('INITFINAL',AT_DATA,0));
       current_asmdata.asmlists[al_globals].concatlist(unitinits);
       current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('INITFINAL'));
@@ -733,7 +733,7 @@ implementation
       ltvTables.insert(Tai_const.Create_32bit(count));
       { insert in data segment }
       maybe_new_object_file(current_asmdata.asmlists[al_globals]);
-      new_section(current_asmdata.asmlists[al_globals],sec_data,'FPC_THREADVARTABLES',sizeof(pint));
+      new_section(current_asmdata.asmlists[al_globals],sec_data,'FPC_THREADVARTABLES',const_align(sizeof(pint)));
       current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('FPC_THREADVARTABLES',AT_DATA,0));
       current_asmdata.asmlists[al_globals].concatlist(ltvTables);
       current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('FPC_THREADVARTABLES'));
@@ -814,7 +814,7 @@ implementation
       hlist.insert(Tai_const.Create_pint(count));
       { insert in data segment }
       maybe_new_object_file(current_asmdata.asmlists[al_globals]);
-      new_section(current_asmdata.asmlists[al_globals],sec_data,tablename,sizeof(pint));
+      new_section(current_asmdata.asmlists[al_globals],sec_data,tablename,const_align(sizeof(pint)));
       current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(tablename,AT_DATA,0));
       current_asmdata.asmlists[al_globals].concatlist(hlist);
       current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(tablename));
@@ -899,7 +899,7 @@ implementation
       ResourceStringTables.insert(Tai_const.Create_pint(count));
       { Add to data segment }
       maybe_new_object_file(current_asmdata.AsmLists[al_globals]);
-      new_section(current_asmdata.AsmLists[al_globals],sec_data,'FPC_RESOURCESTRINGTABLES',sizeof(pint));
+      new_section(current_asmdata.AsmLists[al_globals],sec_data,'FPC_RESOURCESTRINGTABLES',const_align(sizeof(pint)));
       current_asmdata.AsmLists[al_globals].concat(Tai_symbol.Createname_global('FPC_RESOURCESTRINGTABLES',AT_DATA,0));
       current_asmdata.AsmLists[al_globals].concatlist(ResourceStringTables);
       current_asmdata.AsmLists[al_globals].concat(Tai_symbol_end.Createname('FPC_RESOURCESTRINGTABLES'));
@@ -913,7 +913,7 @@ implementation
     begin
       if (target_res.id in [res_elf,res_macho,res_xcoff]) then
         begin
-        ResourceInfo:=TAsmList.Create;
+        ResourceInfo:=current_asmdata.asmlists[al_globals];
 
         maybe_new_object_file(ResourceInfo);
         new_section(ResourceInfo,sec_data,'FPC_RESLOCATION',sizeof(aint));
@@ -928,9 +928,6 @@ implementation
           {$ELSE}
           ResourceInfo.Concat(Tai_const.Create_64bit(0));
           {$ENDIF}
-        maybe_new_object_file(current_asmdata.asmlists[al_globals]);
-        current_asmdata.asmlists[al_globals].concatlist(ResourceInfo);
-        ResourceInfo.free;
         end;
     end;
 
@@ -970,7 +967,7 @@ implementation
 {$ENDIF POWERPC}
       { Initial heapsize }
       maybe_new_object_file(current_asmdata.asmlists[al_globals]);
-      new_section(current_asmdata.asmlists[al_globals],sec_data,'__heapsize',sizeof(pint));
+      new_section(current_asmdata.asmlists[al_globals],sec_data,'__heapsize',const_align(sizeof(pint)));
       current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__heapsize',AT_DATA,sizeof(pint)));
       current_asmdata.asmlists[al_globals].concat(Tai_const.Create_pint(heapsize));
 
@@ -984,7 +981,7 @@ implementation
 
       { Valgrind usage }
       maybe_new_object_file(current_asmdata.asmlists[al_globals]);
-      new_section(current_asmdata.asmlists[al_globals],sec_data,'__fpc_valgrind',sizeof(boolean));
+      new_section(current_asmdata.asmlists[al_globals],sec_data,'__fpc_valgrind',const_align(sizeof(pint)));
       current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__fpc_valgrind',AT_DATA,sizeof(boolean)));
       current_asmdata.asmlists[al_globals].concat(Tai_const.create_8bit(byte(cs_gdb_valgrind in current_settings.globalswitches)));
     end;

compiler/ngtcon.pas

@@ -81,6 +81,7 @@ interface
         function parse_single_packed_const(def: tdef; var bp: tbitpackedval): boolean;
        protected
         list: tasmlist;
+        datalist: tasmlist;
 
         procedure parse_packed_array_def(def: tarraydef);
         procedure parse_arraydef(def:tarraydef);override;
@@ -97,7 +98,7 @@ interface
         procedure tc_emit_stringdef(def: tstringdef; var node: tnode);override;
        public
         constructor create(sym: tstaticvarsym);virtual;
-        function parse_into_asmlist: tasmlist;
+        procedure parse_into_asmlist(out res, data: tasmlist);
       end;
       tasmlisttypedconstbuilderclass = class of tasmlisttypedconstbuilder;
 
@@ -428,6 +429,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
       begin
         inherited;
         list:=tasmlist.create;
+        datalist:=tasmlist.create;
         curoffset:=0;
       end;
 
@@ -545,7 +547,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                        ll.ofs:=0;
                      end
                    else
-                     ll:=emit_ansistring_const(current_asmdata.asmlists[al_const],strval,strlength,def.encoding);
+                     ll:=emit_ansistring_const(datalist,strval,strlength,def.encoding);
                    list.concat(Tai_const.Create_sym_offset(ll.lab,ll.ofs));
                 end;
               st_unicodestring,
@@ -560,7 +562,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                    else
                      begin
                        winlike:=(def.stringtype=st_widestring) and (tf_winlikewidestring in target_info.flags);
-                       ll:=emit_unicodestring_const(current_asmdata.asmlists[al_const],
+                       ll:=emit_unicodestring_const(datalist,
                               strval,
                               def.encoding,
                               winlike);
@@ -833,8 +835,8 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
               else
                varalign:=0;
               varalign:=const_align(varalign);
-              new_section(current_asmdata.asmlists[al_const], sec_rodata, ll.name, varalign);
-              current_asmdata.asmlists[al_const].concat(Tai_label.Create(ll));
+              new_section(datalist, sec_rodata, ll.name, varalign);
+              datalist.concat(Tai_label.Create(ll));
               if node.nodetype=stringconstn then
                 begin
                   len:=tstringconstnode(node).len;
@@ -844,11 +846,11 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                    len:=255;
                   getmem(ca,len+2);
                   move(tstringconstnode(node).value_str^,ca^,len+1);
-                  current_asmdata.asmlists[al_const].concat(Tai_string.Create_pchar(ca,len+1));
+                  datalist.concat(Tai_string.Create_pchar(ca,len+1));
                 end
               else
                 if is_constcharnode(node) then
-                  current_asmdata.asmlists[al_const].concat(Tai_string.Create(char(byte(tordconstnode(node).value.svalue))+#0))
+                  datalist.concat(Tai_string.Create(char(byte(tordconstnode(node).value.svalue))+#0))
               else
                 IncompatibleTypes(node.resultdef, def);
           end
@@ -859,8 +861,8 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
             begin
               current_asmdata.getdatalabel(ll);
               list.concat(Tai_const.Create_sym(ll));
-              new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,ll.name,const_align(sizeof(pint)));
-              current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(ll));
+              new_section(datalist,sec_rodata_norel,ll.name,const_align(sizeof(pint)));
+              datalist.concat(Tai_label.Create(ll));
               if (node.nodetype in [stringconstn,ordconstn]) then
                 begin
                   { convert to unicodestring stringconstn }
@@ -870,9 +872,9 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                    begin
                      pw:=pcompilerwidestring(tstringconstnode(node).value_str);
                      for i:=0 to tstringconstnode(node).len-1 do
-                       current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_16bit(pw^.data[i]));
+                       datalist.concat(Tai_const.Create_16bit(pw^.data[i]));
                      { ending #0 }
-                     current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_16bit(0))
+                     datalist.concat(Tai_const.Create_16bit(0))
                    end;
                 end
               else
@@ -1107,21 +1109,40 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
           begin
             oldoffset:=curoffset;
             curoffset:=0;
-            for i:=def.lowrange to def.highrange-1 do
+            { in case of a generic subroutine, it might be we cannot
+              determine the size yet }
+            if assigned(current_procinfo) and (df_generic in current_procinfo.procdef.defoptions) then
               begin
-                read_typed_const_data(def.elementdef);
-                Inc(curoffset,def.elementdef.size);
-                if token=_RKLAMMER then
+                while true do
                   begin
-                    Message1(parser_e_more_array_elements_expected,tostr(def.highrange-i));
-                    consume(_RKLAMMER);
-                    exit;
-                  end
-                else
-                  consume(_COMMA);
+                    read_typed_const_data(def.elementdef);
+                    if token=_RKLAMMER then
+                      begin
+                        consume(_RKLAMMER);
+                        break;
+                      end
+                    else
+                      consume(_COMMA);
+                  end;
+              end
+            else
+              begin
+                for i:=def.lowrange to def.highrange-1 do
+                  begin
+                    read_typed_const_data(def.elementdef);
+                    Inc(curoffset,def.elementdef.size);
+                    if token=_RKLAMMER then
+                      begin
+                        Message1(parser_e_more_array_elements_expected,tostr(def.highrange-i));
+                        consume(_RKLAMMER);
+                        exit;
+                      end
+                    else
+                      consume(_COMMA);
+                  end;
+                read_typed_const_data(def.elementdef);
+                consume(_RKLAMMER);
               end;
-            read_typed_const_data(def.elementdef);
-            consume(_RKLAMMER);
             curoffset:=oldoffset;
           end
         { if array of char then we allow also a string }
@@ -1235,6 +1256,8 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
       var
         tmpn,n : tnode;
         pd   : tprocdef;
+        havepd,
+        haveblock: boolean;
       begin
         { Procvars and pointers are no longer compatible.  }
         { under tp:  =nil or =var under fpc: =nil or =@var }
@@ -1284,18 +1307,35 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
             n.free;
             n:=tmpn;
           end;
+        pd:=nil;
         { we now need to have a loadn with a procsym }
-        if (n.nodetype=loadn) and
-           (tloadnode(n).symtableentry.typ=procsym) then
+        havepd:=
+          (n.nodetype=loadn) and
+          (tloadnode(n).symtableentry.typ=procsym);
+        { or a staticvarsym representing a block }
+        haveblock:=
+          (n.nodetype=loadn) and
+          (tloadnode(n).symtableentry.typ=staticvarsym) and
+          (sp_internal in tloadnode(n).symtableentry.symoptions);
+        if havepd or
+           haveblock then
           begin
-            pd:=tloadnode(n).procdef;
-            list.concat(Tai_const.createname(pd.mangledname,0));
+            if havepd then
+              begin
+                pd:=tloadnode(n).procdef;
+                list.concat(Tai_const.createname(pd.mangledname,0));
+              end
+            else
+              begin
+                list.concat(Tai_const.Createname(tstaticvarsym(tloadnode(n).symtableentry).mangledname,0));
+              end;
             { nested procvar typed consts can only be initialised with nil
               (checked above) or with a global procedure (checked here),
               because in other cases we need a valid frame pointer }
             if is_nested_pd(def) then
               begin
-                if is_nested_pd(pd) then
+                if haveblock or
+                   is_nested_pd(pd) then
                   Message(parser_e_no_procvarnested_const);
                 list.concat(Tai_const.Create_sym(nil));
               end
@@ -1671,10 +1711,11 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
       end;
 
 
-    function tasmlisttypedconstbuilder.parse_into_asmlist: tasmlist;
+    procedure tasmlisttypedconstbuilder.parse_into_asmlist(out res,data: tasmlist);
       begin
         read_typed_const_data(tcsym.vardef);
-        result:=list;
+        res:=list;
+        data:=datalist;
       end;
 
 

compiler/nutils.pas

@@ -1043,6 +1043,41 @@ implementation
 
 
     function handle_staticfield_access(sym: tsym; nested: boolean; var p1: tnode): boolean;
+
+      function handle_generic_staticfield_access:boolean;
+        var
+          tmp : tstoreddef;
+          pd : tprocdef;
+        begin
+          { in case we have a specialization inside a generic (thus the static var sym does not
+            exist) we simply simulate a non static access to avoid unnecessary errors }
+          if assigned(sym.owner.defowner) and (df_specialization in tstoreddef(sym.owner.defowner).defoptions) then
+            begin
+              tmp:=tstoreddef(sym.owner.defowner);
+              while assigned(tmp) do
+                begin
+                  if df_generic in tmp.defoptions then
+                    begin
+                      p1.free;
+                      if assigned(current_procinfo) then
+                        begin
+                          pd:=current_procinfo.get_normal_proc.procdef;
+                          if assigned(pd) and pd.no_self_node then
+                            p1:=cloadvmtaddrnode.create(ctypenode.create(pd.struct))
+                          else
+                            p1:=load_self_node;
+                        end
+                      else
+                        p1:=load_self_node;
+                      p1:=csubscriptnode.create(sym,p1);
+                      exit(true);
+                    end;
+                  tmp:=tstoreddef(tmp.owner.defowner);
+                end;
+            end;
+          result:=false;
+        end;
+
       var
         static_name: shortstring;
         srsymtable: tsymtable;
@@ -1052,6 +1087,8 @@ implementation
         if (sp_static in sym.symoptions) then
           begin
             result:=true;
+            if handle_generic_staticfield_access then
+              exit;
             if not nested then
               static_name:=lower(sym.owner.name^)+'_'+sym.name
             else

compiler/objcdef.pas

@@ -371,7 +371,10 @@ implementation
                 end;
             end;
           procvardef :
-            encodedstr:=encodedstr+'^?';
+            if not(po_is_block in tprocvardef(def).procoptions) then
+              encodedstr:=encodedstr+'^?'
+            else
+              encodedstr:=encodedstr+'@?';
           objectdef :
             case tobjectdef(def).objecttype of
               odt_helper,

compiler/objcutil.pas

@@ -40,7 +40,7 @@ interface
 
     { Encode a method's parameters and result type into the format used by the
       run time (for generating protocol and class rtti).  }
-    function objcencodemethod(pd: tprocdef): ansistring;
+    function objcencodemethod(pd: tabstractprocdef): ansistring;
 
     { Exports all assembler symbols related to the obj-c class }
     procedure exportobjcclass(def: tobjectdef);
@@ -196,7 +196,7 @@ end;
       end;
 
 
-    function objcencodemethod(pd: tprocdef): ansistring;
+    function objcencodemethod(pd: tabstractprocdef): ansistring;
       var
         parasize,
         totalsize: aint;
@@ -230,7 +230,11 @@ end;
                (vs.varspez in [vs_var,vs_out,vs_constref]) then
               result:=result+'^';
             { Add the parameter type.  }
-            if not objcaddencodedtype(vs.vardef,ris_initial,false,result,founderror) then
+            if (vo_is_parentfp in vs.varoptions) and
+               (po_is_block in pd.procoptions) then
+              { special case: self parameter of block procvars has to be @? }
+              result:=result+'@?'
+            else if not objcaddencodedtype(vs.vardef,ris_initial,false,result,founderror) then
               { should be checked earlier on }
               internalerror(2009081701);
             { And the total size of the parameters coming before this one

compiler/ogelf.pas

@@ -256,7 +256,9 @@ interface
          hashobjsec: TElfObjSection;
          neededlist: TFPHashList;
          dyncopysyms: TFPObjectList;
-
+         preinitarraysec,
+         initarraysec,
+         finiarraysec: TObjSection;
          function AttachSection(objsec:TObjSection):TElfExeSection;
          function CreateSegment(atype,aflags,aalign:longword):TElfSegment;
          procedure WriteHeader;
@@ -2359,12 +2361,15 @@ implementation
 
     procedure TElfExeOutput.Order_end;
 
-      procedure set_oso_keep(const s:string);
+      procedure set_oso_keep(const s:string;out firstsec:TObjSection);
         var
           exesec:TExeSection;
           objsec:TObjSection;
           i:longint;
+          sz: aword;
         begin
+          firstsec:=nil;
+          sz:=0;
           exesec:=TExeSection(ExeSectionList.Find(s));
           if assigned(exesec) then
             begin
@@ -2373,23 +2378,33 @@ implementation
                   objsec:=TObjSection(exesec.ObjSectionList[i]);
                   { ignore sections used for symbol definition }
                   if oso_data in objsec.SecOptions then
-                    objsec.SecOptions:=[oso_keep];
+                    begin
+                      if firstsec=nil then
+                        firstsec:=objsec;
+                      objsec.SecOptions:=[oso_keep];
+                      inc(sz,objsec.size);
+                    end;
                 end;
+              exesec.size:=sz;
             end;
         end;
 
+      var
+        dummy: TObjSection;
       begin
         OrderOrphanSections;
         inherited Order_end;
-        set_oso_keep('.init');
-        set_oso_keep('.fini');
-        set_oso_keep('.jcr');
-        set_oso_keep('.ctors');
-        set_oso_keep('.dtors');
-        set_oso_keep('.preinit_array');
-        set_oso_keep('.init_array');
-        set_oso_keep('.fini_array');
-        set_oso_keep('.eh_frame');
+        set_oso_keep('.init',dummy);
+        set_oso_keep('.fini',dummy);
+        set_oso_keep('.jcr',dummy);
+        set_oso_keep('.ctors',dummy);
+        set_oso_keep('.dtors',dummy);
+        set_oso_keep('.preinit_array',preinitarraysec);
+        if assigned(preinitarraysec) and IsSharedLibrary then
+          Comment(v_error,'.preinit_array section is not allowed in shared libraries');
+        set_oso_keep('.init_array',initarraysec);
+        set_oso_keep('.fini_array',finiarraysec);
+        set_oso_keep('.eh_frame',dummy);
 
         { let .dynamic reference other dynamic sections so they aren't marked
           for removal as unused }
@@ -2406,7 +2421,7 @@ implementation
         exesec:TExeSection;
         opts:TObjSectionOptions;
         s:string;
-        newsections,tmp:TFPHashObjectList;
+        newsections:TFPHashObjectList;
         allsections:TFPList;
         inserts:array[0..6] of TExeSection;
         idx,inspos:longint;
@@ -3226,6 +3241,24 @@ implementation
               end;
           end;
 
+        if assigned(preinitarraysec) then
+          begin
+            WriteDynTag(DT_PREINIT_ARRAY,preinitarraysec,0);
+            WriteDynTag(DT_PREINIT_ARRAYSZ,preinitarraysec.exesection.size);
+          end;
+
+        if assigned(initarraysec) then
+          begin
+            WriteDynTag(DT_INIT_ARRAY,initarraysec,0);
+            WriteDynTag(DT_INIT_ARRAYSZ,initarraysec.exesection.size);
+          end;
+
+        if assigned(finiarraysec) then
+          begin
+            WriteDynTag(DT_FINI_ARRAY,finiarraysec,0);
+            WriteDynTag(DT_FINI_ARRAYSZ,finiarraysec.exesection.size);
+          end;
+
         writeDynTag(DT_HASH,hashobjsec);
         writeDynTag(DT_STRTAB,dynsymtable.fstrsec);
         writeDynTag(DT_SYMTAB,dynsymtable);

compiler/optdfa.pas

@@ -517,6 +517,10 @@ unit optdfa;
                   end;
               end;
 
+{$ifdef JVM}
+            { all other platforms except jvm translate raise nodes into call nodes during pass_1 }
+            raisen,
+{$endif JVM}
             asn,
             inlinen,
             calln:
@@ -918,6 +922,10 @@ unit optdfa;
                   end
               end;
             { could be the implicitly generated load node for the result }
+{$ifdef JVM}
+            { all other platforms except jvm translate raise nodes into call nodes during pass_1 }
+            raisen,
+{$endif JVM}
             loadn,
             assignn,
             calln,

compiler/options.pas

@@ -3863,11 +3863,16 @@ if (target_info.abi = abi_eabihf) then
     2. override with generic optimizer setting (little size)
     3. override with the user specified -Oa }
   UpdateAlignment(init_settings.alignment,target_info.alignment);
-  if (cs_opt_size in current_settings.optimizerswitches) then
+  if (cs_opt_size in init_settings.optimizerswitches) then
    begin
      init_settings.alignment.procalign:=1;
      init_settings.alignment.jumpalign:=1;
      init_settings.alignment.loopalign:=1;
+{$ifdef x86}
+     { constalignmax=1 keeps the executable and thus the memory foot print small but
+       all processors except x86 are really hurt by this or might even crash }
+     init_settings.alignment.constalignmax:=1;
+{$endif x86}
    end;
 
   UpdateAlignment(init_settings.alignment,option.paraalignment);

compiler/pdecl.pas

@@ -787,6 +787,28 @@ implementation
                            consume(_SEMICOLON);
                          end;
                        parse_var_proc_directives(tsym(newtype));
+                       if po_is_function_ref in tprocvardef(hdef).procoptions then
+                         begin
+                           { these always support everything, no "of object" or
+                             "is_nested" is allowed }
+                           if is_nested_pd(tprocvardef(hdef)) or
+                              is_methodpointer(hdef) then
+                             cgmessage(type_e_function_reference_kind)
+                           else
+                             begin
+                               if (po_hascallingconvention in tprocvardef(hdef).procoptions) and
+                                  (tprocvardef(hdef).proccalloption=pocall_cdecl) then
+                                 begin
+                                   include(tprocvardef(hdef).procoptions,po_is_block);
+                                   { can't check yet whether the parameter types
+                                     are valid for a block, since some of them
+                                     may still be forwarddefs }
+                                 end
+                               else
+                                 { a regular anonymous function type: not yet supported }
+                                 cgmessage(type_e_anonymous_function_unsupported);
+                             end
+                         end;
                        handle_calling_convention(tprocvardef(hdef));
                        if try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg) then
                          consume(_SEMICOLON);

compiler/pdecsub.pas

@@ -1134,7 +1134,7 @@ implementation
               end;
             single_type(pd.returndef,[stoAllowSpecialization]);
 
-// Issue #24863, commented out for now because it breaks building of RTL and needs extensive
+            // Issue #24863, enabled only for the main progra commented out for now because it breaks building of RTL and needs extensive
 // testing and/or RTL patching.
 {
             if ((pd.returndef=cvarianttype) or (pd.returndef=colevarianttype)) and
@@ -1358,7 +1358,7 @@ implementation
         { support procedure proc stdcall export; }
         if not(check_proc_directive(false)) then
           begin
-            if (token=_COLON) then
+            if (token=_COLON) and not(Assigned(pd) and is_void(pd.returndef)) then
               begin
                 message(parser_e_field_not_allowed_here);
                 consume_all_until(_SEMICOLON);
@@ -2105,6 +2105,13 @@ begin
     pd_external(pd);
 end;
 
+procedure pd_winapi(pd:tabstractprocdef);
+begin
+  if not(target_info.system in systems_wince) then
+    pd.proccalloption:=pocall_cdecl
+  else
+    pd.proccalloption:=pocall_stdcall;
+end;
 
 type
    pd_handler=procedure(pd:tabstractprocdef);
@@ -2120,7 +2127,7 @@ type
    end;
 const
   {Should contain the number of procedure directives we support.}
-  num_proc_directives=44;
+  num_proc_directives=45;
   proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
    (
     (
@@ -2487,7 +2494,7 @@ const
       handler  : nil;
       pocall   : pocall_none;
       pooption : [po_varargs];
-      mutexclpocall : [pocall_internproc,pocall_stdcall,pocall_register,
+      mutexclpocall : [pocall_internproc,pocall_register,
                        pocall_far16,pocall_oldfpccall,pocall_mwpascal];
       mutexclpotype : [];
       mutexclpo     : [po_assembler,po_interrupt,po_inline]
@@ -2513,6 +2520,15 @@ const
       { allowed for external cpp classes }
       mutexclpotype : [{potype_constructor,potype_destructor}potype_class_constructor,potype_class_destructor];
       mutexclpo     : [po_public,po_exports,po_interrupt,po_assembler,po_inline]
+    ),(
+      idtok:_WINAPI;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
+      handler  : @pd_winapi;
+      pocall   : pocall_none;
+      pooption : [];
+      mutexclpocall : [pocall_stdcall,pocall_cdecl];
+      mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
+      mutexclpo     : [po_external]
     ),(
       idtok:_ENUMERATOR;
       pd_flags : [pd_interface,pd_object,pd_record];
@@ -2609,7 +2625,7 @@ const
               next variable !! }
             if ((pdflags * [pd_procvar,pd_object,pd_record,pd_objcclass,pd_objcprot])=[]) and
                not(idtoken=_PROPERTY) then
-              Message1(parser_w_unknown_proc_directive_ignored,name);
+              Message1(parser_w_unknown_proc_directive_ignored,pattern);
             exit;
          end;
 
@@ -2920,7 +2936,7 @@ const
                          { for objcclasses this is checked later, because the entire
                            class may be external.  }
                          is_objc_class_or_protocol(tprocdef(pd).struct)) and
-                     not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then
+                     not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal,pocall_stdcall])) then
                     Message(parser_e_varargs_need_cdecl_and_external);
                 end
                else
@@ -2928,7 +2944,7 @@ const
                   { both must be defined now }
                   if not((po_external in pd.procoptions) or
                          (pd.typ=procvardef)) or
-                     not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then
+                     not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal,pocall_stdcall])) then
                     Message(parser_e_varargs_need_cdecl_and_external);
                 end;
              end;

compiler/pgenutil.pas

@@ -991,6 +991,8 @@ uses
           if token=_ID then
             begin
               generictype:=ctypesym.create(orgpattern,cundefinedtype);
+              { type parameters need to be added as strict private }
+              generictype.visibility:=vis_strictprivate;
               include(generictype.symoptions,sp_generic_para);
               result.add(orgpattern,generictype);
             end;
@@ -1128,7 +1130,11 @@ uses
               firstidx:=result.count;
 
               constraintdata.free;
-            end;
+            end
+          else
+            if token=_SEMICOLON then
+              { a semicolon terminates a type parameter group }
+              firstidx:=result.count;
         until not (try_to_consume(_COMMA) or try_to_consume(_SEMICOLON));
         block_type:=old_block_type;
       end;
@@ -1166,6 +1172,8 @@ uses
             if assigned(generictype.owner) then
               begin
                 sym:=ctypesym.create(genericlist.nameofindex(i),generictype.typedef);
+                { type parameters need to be added as strict private }
+                sym.visibility:=vis_strictprivate;
                 st.insert(sym);
                 include(sym.symoptions,sp_generic_para);
               end

compiler/pmodules.pas

@@ -348,6 +348,10 @@ implementation
         if m_iso in current_settings.modeswitches then
           AddUnit('iso7185');
 
+        { blocks support? }
+        if m_blocks in current_settings.modeswitches then
+          AddUnit('blockrtl');
+
         { default char=widechar? }
         if m_default_unicodestring in current_settings.modeswitches then
           AddUnit('uuchar');

compiler/pparautl.pas

@@ -39,7 +39,7 @@ implementation
 
     uses
       globals,globtype,verbose,systems,
-      symconst,symtype,symbase,symsym,symtable,symcreat,defutil,
+      symconst,symtype,symbase,symsym,symtable,symcreat,defutil,blockutl,
       paramgr;
 
 
@@ -176,6 +176,31 @@ implementation
             vs:=cparavarsym.create('$self',paranr_self,vs_value,voidpointertype,[vo_is_self,vo_is_hidden_para]);
             pd.parast.insert(vs);
           end
+        { while only procvardefs of this type can be declared in Pascal code,
+          internally we also generate procdefs of this type when creating
+          block wrappers }
+        else if (po_is_block in pd.procoptions) then
+          begin
+            { generate the first hidden parameter, which is a so-called "block
+              literal" describing the block and containing its invocation
+              procedure  }
+            hdef:=getpointerdef(get_block_literal_type_for_proc(pd));
+            { mark as vo_is_parentfp so that proc2procvar comparisons will
+              succeed when assigning arbitrary routines to the block }
+            vs:=cparavarsym.create('$_block_literal',paranr_blockselfpara,vs_value,
+              hdef,[vo_is_hidden_para,vo_is_parentfp]
+            );
+            pd.parast.insert(vs);
+            if pd.typ=procdef then
+              begin
+                { make accessible to code }
+                sl:=tpropaccesslist.create;
+                sl.addsym(sl_load,vs);
+                aliasvs:=cabsolutevarsym.create_ref('FPC_BLOCK_SELF',hdef,sl);
+                include(aliasvs.varoptions,vo_is_parentfp);
+                tlocalsymtable(tprocdef(pd).localst).insert(aliasvs);
+              end;
+          end
         else
           begin
              if (pd.typ=procdef) and

compiler/ppcarm.lpi

@@ -1,4 +1,4 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
     <Version Value="9"/>
@@ -25,29 +25,27 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
+        <CommandLineParams Value="system -Tlinux -O4 -Sg -Cparmv7A -Cfvfpv3 -CIthumb -XParm-embedded-"/>
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <WorkingDirectory Value="C:\Users\jepjoh2\Desktop\abcd\t4"/>
       </local>
     </RunParams>
     <Units Count="4">
       <Unit0>
         <Filename Value="pp.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="pp"/>
       </Unit0>
       <Unit1>
         <Filename Value="arm\aasmcpu.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="aasmcpu"/>
       </Unit1>
       <Unit2>
         <Filename Value="arm\aoptcpu.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="aoptcpu"/>
       </Unit2>
       <Unit3>
         <Filename Value="aopt.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="aopt"/>
       </Unit3>
     </Units>
   </ProjectOptions>
@@ -79,11 +77,7 @@
       <ConfigFile>
         <StopAfterErrCount Value="50"/>
       </ConfigFile>
-      <CompilerMessages>
-        <UseMsgFile Value="True"/>
-      </CompilerMessages>
       <CustomOptions Value="-darm"/>
-      <CompilerPath Value="$(CompPath)"/>
     </Other>
   </CompilerOptions>
 </CONFIG>

compiler/psub.pas

@@ -155,6 +155,12 @@ implementation
             Message(parser_h_inlining_disabled);
             exit;
           end;
+        if pi_calls_c_varargs in current_procinfo.flags then
+          begin
+            Message1(parser_h_not_supported_for_inline,'called C-style varargs functions');
+            Message(parser_h_inlining_disabled);
+            exit;
+          end;
         { the compiler cannot handle inherited in inlined subroutines because
           it tries to search for self in the symtable, however, the symtable
           is not available }
@@ -262,7 +268,10 @@ implementation
         if (tsym(p).typ=paravarsym) then
           begin
             if tparavarsym(p).needs_finalization then
-              include(current_procinfo.flags,pi_needs_implicit_finally);
+              begin
+                include(current_procinfo.flags,pi_needs_implicit_finally);
+                include(current_procinfo.flags,pi_do_call);
+              end;
             if (tparavarsym(p).varspez in [vs_value,vs_out]) and
                (cs_create_pic in current_settings.moduleswitches) and
                (tf_pic_uses_got in target_info.flags) and
@@ -281,6 +290,7 @@ implementation
            is_managed_type(tlocalvarsym(p).vardef) then
           begin
             include(current_procinfo.flags,pi_needs_implicit_finally);
+            include(current_procinfo.flags,pi_do_call);
             if is_rtti_managed_type(tlocalvarsym(p).vardef) and
               (cs_create_pic in current_settings.moduleswitches) and
               (tf_pic_uses_got in target_info.flags) then
@@ -1334,13 +1344,24 @@ implementation
               { iterate through life info of the first node }
               for i:=0 to dfabuilder.nodemap.count-1 do
                 begin
-                  if DFASetIn(GetUserCode.optinfo^.life,i) and
-                    { do not warn about parameters passed by var }
-                    not((tnode(dfabuilder.nodemap[i]).nodetype=loadn) and (tloadnode(dfabuilder.nodemap[i]).symtableentry.typ=paravarsym) and
-                        (tparavarsym(tloadnode(dfabuilder.nodemap[i]).symtableentry).varspez=vs_var) and
+                  if DFASetIn(GetUserCode.optinfo^.life,i) then
+                    begin
+                      { do not warn for certain parameters: }
+                      if not((tnode(dfabuilder.nodemap[i]).nodetype=loadn) and (tloadnode(dfabuilder.nodemap[i]).symtableentry.typ=paravarsym) and
+                        { do not warn about parameters passed by var }
+                        (((tparavarsym(tloadnode(dfabuilder.nodemap[i]).symtableentry).varspez=vs_var) and
                         { function result is passed by var but it must be initialized }
-                        not(vo_is_funcret in tparavarsym(tloadnode(dfabuilder.nodemap[i]).symtableentry).varoptions)) then
-                    CheckAndWarn(GetUserCode,tnode(dfabuilder.nodemap[i]));
+                        not(vo_is_funcret in tparavarsym(tloadnode(dfabuilder.nodemap[i]).symtableentry).varoptions)) or
+                        { do not warn about initialized hidden parameters }
+                        ((tparavarsym(tloadnode(dfabuilder.nodemap[i]).symtableentry).varoptions*[vo_is_high_para,vo_is_parentfp,vo_is_result,vo_is_self])<>[]))) then
+                        CheckAndWarn(GetUserCode,tnode(dfabuilder.nodemap[i]));
+                    end
+                  else
+                    begin
+                      if (tnode(dfabuilder.nodemap[i]).nodetype=loadn) and
+                        (tloadnode(dfabuilder.nodemap[i]).symtableentry.typ in [staticvarsym,localvarsym]) then
+                        tabstractnormalvarsym(tloadnode(dfabuilder.nodemap[i]).symtableentry).noregvarinitneeded:=true
+                    end;
                 end;
           end;
 
@@ -1795,11 +1816,11 @@ implementation
              { Give an error for accesses in the static symtable that aren't visible
                outside the current unit }
              st:=procdef.owner;
-             while (st.symtabletype=ObjectSymtable) do
+             while (st.symtabletype in [ObjectSymtable,recordsymtable]) do
                st:=st.defowner.owner;
              if (pi_uses_static_symtable in flags) and
                 (st.symtabletype<>staticsymtable) then
-               Comment(V_Error,'Global Generic template references static symtable');
+               Message(parser_e_global_generic_references_static);
            end;
 
          { save exit info }

compiler/ptconst.pas

@@ -47,6 +47,7 @@ implementation
         cursectype   : TAsmSectionType;
         section      : ansistring;
         tcbuilder    : ttypedconstbuilder;
+        datalist,
         reslist      : tasmlist;
         restree,
         previnit     : tnode;
@@ -66,7 +67,7 @@ implementation
           begin
             maybe_new_object_file(list);
             tcbuilder:=tasmlisttypedconstbuilderclass(ctypedconstbuilder).create(sym);
-            reslist:=tasmlisttypedconstbuilder(tcbuilder).parse_into_asmlist;
+            tasmlisttypedconstbuilder(tcbuilder).parse_into_asmlist(reslist,datalist);
             { Certain types like windows WideString are initialized at runtime and cannot
               be placed into readonly memory }
             if (sym.varspez=vs_const) and not (vo_force_finalize in sym.varoptions) then
@@ -89,6 +90,7 @@ implementation
               current_module.tcinitcode:=restree;
             tcbuilder.free;
             reslist:=nil;
+            datalist:=nil;
             cursectype:=sec_none;
           end;
 
@@ -160,6 +162,9 @@ implementation
             list.concatlist(reslist);
             reslist.free;
             list.concat(tai_symbol_end.Createname(sym.mangledname));
+            { and pointed data, if any }
+            current_asmdata.asmlists[al_const].concatlist(datalist);
+            datalist.free;
           end
         else
           begin

compiler/ptype.pas

@@ -73,7 +73,7 @@ implementation
        paramgr,procinfo,
        { symtable }
        symconst,symsym,symtable,symcreat,
-       defutil,defcmp,
+       defutil,defcmp,objcdef,
 {$ifdef jvm}
        jvmdef,
 {$endif}
@@ -340,7 +340,11 @@ implementation
             ((ttypesym(srsym).typedef.typ=errordef) or
             (not allowgenericsyms and
             (ttypesym(srsym).typedef.typ=undefineddef) and
-            not (sp_generic_para in srsym.symoptions))) then
+            not (sp_generic_para in srsym.symoptions) and
+            not (sp_explicitrename in srsym.symoptions) and
+            not assigned(srsym.owner.defowner) and
+            { use df_generic instead of is_generic to allow aliases in nested types as well }
+            not (df_generic in tstoreddef(srsym.owner.defowner).defoptions))) then
           begin
             Message1(type_e_type_is_not_completly_defined,ttypesym(srsym).realname);
             def:=generrordef;
@@ -1791,6 +1795,43 @@ implementation
                 jvm_create_procvar_class(name,def);
 {$endif}
               end;
+            _ID:
+              begin
+                case idtoken of
+                  _HELPER:
+                    begin
+                      if hadtypetoken and
+                         { don't allow "type helper" in mode delphi and require modeswitch typehelpers }
+                         ([m_delphi,m_type_helpers]*current_settings.modeswitches=[m_type_helpers]) then
+                        begin
+                          { reset hadtypetoken, so that calling code knows that it should not be handled
+                            as a "unique" type }
+                          hadtypetoken:=false;
+                          consume(_HELPER);
+                          def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_type);
+                        end
+                      else
+                        expr_type
+                    end;
+                  _REFERENCE:
+                    begin
+                      if m_blocks in current_settings.modeswitches then
+                        begin
+                          consume(_REFERENCE);
+                          consume(_TO);
+                          def:=procvar_dec(genericdef,genericlist);
+                          { could be errordef in case of a syntax error }
+                          if assigned(def) and
+                             (def.typ=procvardef) then
+                            include(tprocvardef(def).procoptions,po_is_function_ref);
+                        end
+                      else
+                        expr_type;
+                    end;
+                  else
+                    expr_type;
+                end;
+              end
             else
               if (token=_KLAMMERAFFE) and (m_iso in current_settings.modeswitches) then
                 begin
@@ -1801,19 +1842,7 @@ implementation
                     current_module.checkforwarddefs.add(def);
                 end
               else
-                if hadtypetoken and
-                    { don't allow "type helper" in mode delphi and require modeswitch typehelpers }
-                    ([m_delphi,m_type_helpers]*current_settings.modeswitches=[m_type_helpers]) and
-                    (token=_ID) and (idtoken=_HELPER) then
-                  begin
-                    { reset hadtypetoken, so that calling code knows that it should not be handled
-                      as a "unique" type }
-                    hadtypetoken:=false;
-                    consume(_HELPER);
-                    def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_type);
-                  end
-                else
-                  expr_type;
+                expr_type;
          end;
 
          if def=nil then

compiler/rautils.pas

@@ -54,7 +54,7 @@ type
       OPR_LOCAL     : (localvarsize, localconstoffset: asizeint;localsym:tabstractnormalvarsym;localsymofs:aint;localindexreg:tregister;localscale:byte;localgetoffset,localforceref:boolean);
       OPR_REGISTER  : (reg:tregister);
 {$ifdef m68k}
-      OPR_REGSET   : (regsetdata,regsetaddr : tcpuregisterset);
+      OPR_REGSET   : (regsetdata,regsetaddr,regsetfpu : tcpuregisterset);
 {$endif m68k}
 {$ifdef powerpc}
       OPR_COND      : (cond : tasmcond);
@@ -1057,7 +1057,7 @@ end;
                 ai.loadref(i-1,ref);
 {$ifdef m68k}
               OPR_REGSET:
-                ai.loadregset(i-1,regsetdata,regsetaddr);
+                ai.loadregset(i-1,regsetdata,regsetaddr,regsetfpu);
 {$endif}
 {$ifdef ARM}
               OPR_REGSET:

compiler/scanner.pas

@@ -602,6 +602,15 @@ implementation
                   break;
                 end;
 
+              { Blocks supported? }
+              if doinclude and
+                 (i = m_blocks) and
+                 not(target_info.system in systems_blocks_supported) then
+                begin
+                  Message1(option_unsupported_target_for_feature,'Blocks');
+                  break;
+                end;
+
               if changeInit then
                 current_settings.modeswitches:=init_settings.modeswitches;
               Result:=true;
@@ -3316,8 +3325,6 @@ type
                       begin
                         current_settings.pmessage:=nil;
                         mesgnb:=tokenreadsizeint;
-                        if mesgnb>0 then
-                          Comment(V_Error,'Message recordind not yet supported');
                         prevmsg:=nil;
                         for i:=1 to mesgnb do
                           begin

compiler/symconst.pas

@@ -113,16 +113,17 @@ const
   { implicit parameter positions, normal parameters start at 10
     and will increase with 10 for each parameter. The high parameters
     will be inserted with n+1 }
-  paranr_parentfp = 1;
-  paranr_parentfp_delphi_cc_leftright = 1;
-  paranr_self = 2;
-  paranr_result = 3;
-  paranr_vmt = 4;
+  paranr_blockselfpara = 1;
+  paranr_parentfp = 2;
+  paranr_parentfp_delphi_cc_leftright = 2;
+  paranr_self = 3;
+  paranr_result = 4;
+  paranr_vmt = 5;
 
   { the implicit parameters for Objective-C methods need to come
     after the hidden result parameter }
-  paranr_objc_self = 4;
-  paranr_objc_cmd = 5;
+  paranr_objc_self = 5;
+  paranr_objc_cmd = 6;
   { Required to support variations of syscalls on MorphOS }
   paranr_syscall_basesysv    = 9;
   paranr_syscall_sysvbase    = high(word)-5;
@@ -355,7 +356,11 @@ type
     { procedure is far (x86 only) }
     po_far,
     { the procedure never returns, this information is usefull for dfa }
-    po_noreturn
+    po_noreturn,
+    { procvar is a function reference }
+    po_is_function_ref,
+    { procvar is a block (http://en.wikipedia.org/wiki/Blocks_(C_language_extension) ) }
+    po_is_block
   );
   tprocoptions=set of tprocoption;
 
@@ -393,7 +398,8 @@ type
     tsk_jvm_procvar_intconstr, // Java procvar class constructor that accepts an interface instance for easy Java interoperation
     tsk_jvm_virtual_clmethod,  // Java wrapper for virtual class method
     tsk_field_getter,          // getter for a field (callthrough property is passed in skpara)
-    tsk_field_setter           // Setter for a field (callthrough property is passed in skpara)
+    tsk_field_setter,          // Setter for a field (callthrough property is passed in skpara)
+    tsk_block_invoke_procvar   // Call a procvar to invoke inside a block
   );
 
   { options for objects and classes }
@@ -762,6 +768,9 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
       vararray = $2000;
       varbyref = $4000;
 
+      { blocks-related constants }
+      blocks_procvar_invoke_type_name = '__FPC_invoke_pvtype';
+
 implementation
 
 end.

compiler/symcreat.pas

@@ -916,6 +916,20 @@ implementation
     end;
 
 
+  procedure implement_block_invoke_procvar(pd: tprocdef);
+    var
+      str: ansistring;
+    begin
+      str:='';
+      str:='begin ';
+      if pd.returndef<>voidtype then
+        str:=str+'result:=';
+      str:=str+'__FPC_BLOCK_INVOKE_PV_TYPE(PFPC_Block_literal_complex_procvar(FPC_Block_Self)^.pv)(';
+      addvisibibleparameters(str,pd);
+      str:=str+') end;';
+      str_parse_method_impl(str,pd,false);
+    end;
+
   procedure add_synthetic_method_implementations_for_st(st: tsymtable);
     var
       i   : longint;
@@ -986,6 +1000,8 @@ implementation
               implement_field_getter(pd);
             tsk_field_setter:
               implement_field_setter(pd);
+            tsk_block_invoke_procvar:
+              implement_block_invoke_procvar(pd);
             else
               internalerror(2011032801);
           end;
@@ -999,9 +1015,6 @@ implementation
       def: tdef;
       sstate: tscannerstate;
     begin
-      { only necessary for the JVM target currently }
-      if not (target_info.system in systems_jvm) then
-        exit;
       { skip if any errors have occurred, since then this can only cause more
         errors }
       if ErrorCount<>0 then

compiler/symdef.pas

@@ -1244,8 +1244,12 @@ implementation
                        crc:=UpdateCrc32(crc,hs[1],length(hs));
                      end;
                  end;
-               hs:=hp.vardef.mangledparaname;
-               crc:=UpdateCrc32(crc,hs[1],length(hs));
+               if not is_void(tprocdef(st.defowner).returndef) then
+                 begin
+                   { add a little prefix so that x(integer; integer) is different from x(integer):integer }
+                   hs:='$$'+tprocdef(st.defowner).returndef.mangledparaname;
+                   crc:=UpdateCrc32(crc,hs[1],length(hs));
+                 end;
                s:=Copy(s,1,oldlen)+'$crc'+hexstr(crc,8);
              end;
            if prefix<>'' then
@@ -2032,8 +2036,7 @@ implementation
               recsize:=size;
               is_intregable:=
                 ispowerof2(recsize,temp) and
-                { sizeof(asizeint)*2 records in int registers is currently broken for endian_big targets }
-                (((recsize <= sizeof(asizeint)*2) and (target_info.endian=endian_little)
+                (((recsize <= sizeof(asizeint)*2)
                  { records cannot go into registers on 16 bit targets for now }
                   and (sizeof(asizeint)>2)
                   and not trecorddef(self).contains_float_field) or
@@ -5244,7 +5247,9 @@ implementation
            not(is_void(returndef)) then
           s:=s+':'+returndef.GetTypeName;
         if owner.symtabletype=localsymtable then
-          s:=s+' is nested';
+          s:=s+' is nested'
+        else if po_is_block in procoptions then
+          s:=s+' is block';
         s:=s+';';
         { forced calling convention? }
         if (po_hascallingconvention in procoptions) then
@@ -5507,8 +5512,12 @@ implementation
                     crc:=UpdateCrc32(crc,hs[1],length(hs));
                   end;
               end;
-            hs:=hp.vardef.mangledparaname;
-            crc:=UpdateCrc32(crc,hs[1],length(hs));
+            if not is_void(returndef) then
+              begin
+                { add a little prefix so that x(integer; integer) is different from x(integer):integer }
+                hs:='$$'+returndef.mangledparaname;
+                crc:=UpdateCrc32(crc,hs[1],length(hs));
+              end;
             defaultmangledname:=Copy(defaultmangledname,1,oldlen)+'$crc'+hexstr(crc,8);
           end;
       end;
@@ -5886,7 +5895,11 @@ implementation
            s := s+' of object';
          if is_nested_pd(self) then
            s := s+' is nested';
-         GetTypeName := s+';'+ProcCallOptionStr[proccalloption]+'>';
+         { calling convention doesn't matter for blocks }
+         if po_is_block in procoptions then
+           GetTypeName := s+' is block;'
+         else
+           GetTypeName := s+';'+ProcCallOptionStr[proccalloption]+'>';
       end;
 
 
@@ -6300,7 +6313,7 @@ implementation
          inherited derefimpl;
          { the procdefs are not owned by the class helper procsyms, so they
            are not stored/restored either -> re-add them here }
-         if (objecttype=odt_objcclass) or
+         if (objecttype in [odt_objcclass,odt_objcprotocol]) or
             (oo_is_classhelper in objectoptions) then
            symtable.DefList.ForEachCall(@create_class_helper_for_procdef,nil);
       end;

compiler/symsym.pas

@@ -220,6 +220,9 @@ interface
           currentregloc  : TLocation;
           { migrated to a parentfpstruct because of nested access (not written to ppu, because not important and would change interface crc) }
           inparentfpstruct : boolean;
+          { the variable is not living at entry of the scope, so it does not need to be initialized if it is a reg. var
+            (not written to ppu, because not important and would change interface crc) }
+          noregvarinitneeded : boolean;
           constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
           constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
           function globalasmsym: boolean;

compiler/symtable.pas

@@ -43,6 +43,7 @@ interface
           init_final_check_done : boolean;
           procedure _needs_init_final(sym:TObject;arg:pointer);
           procedure check_forward(sym:TObject;arg:pointer);
+          procedure check_block_valid(def: TObject;arg:pointer);
           procedure labeldefined(sym:TObject;arg:pointer);
           procedure varsymbolused(sym:TObject;arg:pointer);
           procedure TestPrivate(sym:TObject;arg:pointer);
@@ -229,7 +230,7 @@ interface
     function generate_objectpascal_helper_key(def:tdef):string;
     procedure incompatibletypes(def1,def2:tdef);
     procedure hidesym(sym:TSymEntry);
-    procedure duplicatesym(var hashedid:THashedIDString;dupsym,origsym:TSymEntry);
+    procedure duplicatesym(var hashedid: THashedIDString; dupsym, origsym:TSymEntry; warn: boolean);
     function handle_generic_dummysym(sym:TSymEntry;var symoptions:tsymoptions):boolean;
     function get_jumpbuf_size : longint;
 
@@ -360,7 +361,7 @@ implementation
       { global }
       verbose,globals,
       { symtable }
-      symutil,defutil,defcmp,
+      symutil,defutil,defcmp,objcdef,
       { module }
       fmodule,
       { codegen }
@@ -630,7 +631,7 @@ implementation
       begin
         hsym:=tsym(FindWithHash(hashedid));
         if assigned(hsym) then
-          DuplicateSym(hashedid,sym,hsym);
+          DuplicateSym(hashedid,sym,hsym,false);
         result:=assigned(hsym);
       end;
 
@@ -656,6 +657,21 @@ implementation
       end;
 
 
+    procedure tstoredsymtable.check_block_valid(def: TObject; arg: pointer);
+      var
+        founderrordef: tdef;
+      begin
+        { all parameters passed to a block must be handled by the Objective-C
+          runtime }
+        if is_block(tdef(def)) and
+           not objcchecktype(tdef(def),founderrordef) then
+          if assigned(tdef(def).typesym) then
+            MessagePos1(tdef(def).typesym.fileinfo,type_e_objc_type_unsupported,founderrordef.typename)
+          else
+            Message1(type_e_objc_type_unsupported,tprocvardef(def).typename)
+      end;
+
+
     procedure TStoredSymtable.labeldefined(sym:TObject;arg:pointer);
       begin
         if (tsym(sym).typ=labelsym) and
@@ -800,6 +816,9 @@ implementation
     procedure tstoredsymtable.check_forwards;
       begin
          SymList.ForEachCall(@check_forward,nil);
+         { check whether all block definitions contain valid Objective-C types
+           (now that all forward definitions have been resolved) }
+         DefList.ForEachCall(@check_block_valid,nil);
       end;
 
 
@@ -1461,7 +1480,8 @@ implementation
 
     function tObjectSymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
       var
-         hsym : tsym;
+         hsym: tsym;
+         warn: boolean;
       begin
          result:=false;
          if not assigned(defowner) then
@@ -1492,7 +1512,15 @@ implementation
                   )
                  ) then
                 begin
-                  DuplicateSym(hashedid,sym,hsym);
+                  { only watn when a parameter/local variable in a method
+                    conflicts with a category method, because this can easily
+                    happen due to all possible categories being imported via
+                    CocoaAll }
+                  warn:=
+                    (is_objccategory(tdef(hsym.owner.defowner)) or
+                     is_classhelper(tdef(hsym.owner.defowner))) and
+                    (sym.typ in [paravarsym,localvarsym,fieldvarsym]);
+                  DuplicateSym(hashedid,sym,hsym,warn);
                   result:=true;
                 end;
            end
@@ -1571,7 +1599,7 @@ implementation
                    (vo_is_result in tabstractvarsym(hsym).varoptions)) then
               HideSym(hsym)
             else
-              DuplicateSym(hashedid,sym,hsym);
+              DuplicateSym(hashedid,sym,hsym,false);
             result:=true;
             exit;
           end;
@@ -1591,7 +1619,7 @@ implementation
                    (vo_is_result in tabstractvarsym(sym).varoptions)) then
               Hidesym(sym)
             else
-              DuplicateSym(hashedid,sym,hsym);
+              DuplicateSym(hashedid,sym,hsym,false);
             result:=true;
             exit;
           end;
@@ -1697,7 +1725,7 @@ implementation
                   tnamespacesym(sym).unitsym:=tsym(hsym);
               end
             else
-              DuplicateSym(hashedid,sym,hsym);
+              DuplicateSym(hashedid,sym,hsym,false);
             result:=true;
             exit;
           end;
@@ -2040,11 +2068,15 @@ implementation
       end;
 
 
-    procedure duplicatesym(var hashedid:THashedIDString;dupsym,origsym:TSymEntry);
+    procedure duplicatesym(var hashedid: THashedIDString; dupsym, origsym: TSymEntry; warn: boolean);
       var
         st : TSymtable;
+        filename : TIDString;
       begin
-        Message1(sym_e_duplicate_id,tsym(origsym).realname);
+        if not warn then
+          Message1(sym_e_duplicate_id,tsym(origsym).realname)
+        else
+         Message1(sym_w_duplicate_id,tsym(origsym).realname);
         { Write hint where the original symbol was found }
         st:=finduniTSymtable(origsym.owner);
         with tsym(origsym).fileinfo do
@@ -2054,7 +2086,13 @@ implementation
                st.iscurrentunit then
               Message2(sym_h_duplicate_id_where,current_module.sourcefiles.get_file_name(fileindex),tostr(line))
             else if assigned(st.name) then
-              Message2(sym_h_duplicate_id_where,'unit '+st.name^,tostr(line));
+              begin
+                filename:=find_module_from_symtable(st).sourcefiles.get_file_name(fileindex);
+                if filename<>'' then
+                  Message2(sym_h_duplicate_id_where,'unit '+st.name^+': '+filename,tostr(line))
+                else
+                  Message2(sym_h_duplicate_id_where,'unit '+st.name^,tostr(line))
+              end;
           end;
         { Rename duplicate sym to an unreachable name, but it can be
           inserted in the symtable without errors }
@@ -2204,6 +2242,7 @@ implementation
     function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean;
       var
         symownerdef : tabstractrecorddef;
+        nonlocalst : tsymtable;
       begin
         result:=false;
 
@@ -2212,17 +2251,22 @@ implementation
            not (symst.symtabletype in [objectsymtable,recordsymtable]) then
           internalerror(200810285);
         symownerdef:=tabstractrecorddef(symst.defowner);
+        { specializations might belong to a localsymtable or parasymtable }
+        nonlocalst:=symownerdef.owner;
+        if tstoreddef(symst.defowner).is_specialization then
+          while nonlocalst.symtabletype in [localsymtable,parasymtable] do
+            nonlocalst:=nonlocalst.defowner.owner;
         case symvisibility of
           vis_private :
             begin
               { private symbols are allowed when we are in the same
                 module as they are defined }
               result:=(
-                       (symownerdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
-                       (symownerdef.owner.iscurrentunit)
+                       (nonlocalst.symtabletype in [globalsymtable,staticsymtable]) and
+                       (nonlocalst.iscurrentunit)
                       ) or
                       ( // the case of specialize inside the generic declaration and nested types
-                       (symownerdef.owner.symtabletype in [objectsymtable,recordsymtable]) and
+                       (nonlocalst.symtabletype in [objectsymtable,recordsymtable]) and
                        (
                          assigned(current_structdef) and
                          (
@@ -2274,8 +2318,8 @@ implementation
                 in the current module }
               result:=(
                        (
-                        (symownerdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
-                        (symownerdef.owner.iscurrentunit)
+                        (nonlocalst.symtabletype in [globalsymtable,staticsymtable]) and
+                        (nonlocalst.iscurrentunit)
                        ) or
                        (
                         assigned(contextobjdef) and
@@ -2284,7 +2328,7 @@ implementation
                         def_is_related(contextobjdef,symownerdef)
                        ) or
                        ( // the case of specialize inside the generic declaration and nested types
-                        (symownerdef.owner.symtabletype in [objectsymtable,recordsymtable]) and
+                        (nonlocalst.symtabletype in [objectsymtable,recordsymtable]) and
                         (
                           assigned(current_structdef) and
                           (

compiler/systems.pas

@@ -287,6 +287,9 @@ interface
        { systems using the non-fragile Objective-C ABI }
        systems_objc_nfabi = [system_powerpc64_darwin,system_x86_64_darwin,system_arm_darwin,system_i386_iphonesim];
 
+       { systems supporting "blocks" }
+       systems_blocks_supported = systems_darwin;
+
        { all systems supporting exports from programs or units }
        systems_unit_program_exports = [system_i386_win32,
                                          system_i386_wdosx,

compiler/systems/i_sunos.pas

@@ -36,6 +36,7 @@ unit i_sunos;
             shortname    : 'solaris';
             flags        : [tf_under_development,tf_needs_symbol_size,
                             tf_files_case_sensitive,tf_requires_proper_alignment,
+                            tf_pic_uses_got,tf_library_needs_pic,
                             tf_smartlink_library,tf_has_winlike_resources];
             cpu          : cpu_i386;
             unit_env     : 'SOLARISUNITS';
@@ -130,7 +131,7 @@ unit i_sunos;
             Cprefix      : '';
             newline      : #10;
             dirsep       : '/';
-            assem        : as_ggas{as_x86_64_elf64};
+            assem        : as_x86_64_elf64;
             assemextern  : as_ggas;
             link         : ld_none;
             linkextern   : ld_solaris;

compiler/systems/t_embed.pas

@@ -581,6 +581,7 @@ begin
       Add('     . = 0x100000;');
       Add('     .text ALIGN (0x1000) :');
       Add('    {');
+      Add('    _text = .;');
       Add('    KEEP(*(.init, .init.*))');
       Add('    *(.text, .text.*)');
       Add('    *(.strings)');

compiler/systems/t_linux.pas

@@ -146,6 +146,7 @@ begin
 {$endif}
 {$endif arm}
 {$ifdef x86_64}
+  if not Dontlinkstdlibpath Then
     LibrarySearchPath.AddPath(sysrootpath,'/usr/lib/x86_64-linux-gnu',true);
 {$endif x86_64}
 end;

compiler/systems/t_os2.pas

@@ -330,17 +330,13 @@ begin
     if index<>0 then
         begin
             str(index,tmp3);
-(*
-            tmp3:=func+'='+module+'.'+tmp3;
-*)
             tmp3:=Name+'='+module+'.'+tmp3;
         end
     else
-        tmp3:=Name+'='+module+'.'+name;
-(*
-        tmp3:=func+'='+module+'.'+name;
-    aout_sym(tmp2,n_imp1+n_ext,0,0,0);
+(*        tmp3:=Name+'='+module+'.'+name;
 *)
+        tmp3 := MangledName + '=' + module + '.' + target_info.Cprefix + name;
+
     aout_sym(tmp2,n_imp1+n_ext,0,0,0);
     aout_sym(tmp3,n_imp2+n_ext,0,0,0);
     aout_finish;
@@ -477,6 +473,7 @@ var
   BaseFilename: TPathStr;
   RsrcStr : string;
   OutName: TPathStr;
+  StackSizeKB: cardinal;
 begin
   if not(cs_link_nolink in current_settings.globalswitches) then
    Message1(exec_i_linking,current_module.exefilename);
@@ -517,10 +514,16 @@ begin
         { Is this really required? Not anymore according to my EMX docs }
         Replace(cmdstr,'$HEAPMB',tostr((1048575) shr 20));
         {Size of the stack when an EMX program runs in OS/2.}
-        Replace(cmdstr,'$STACKKB',tostr((stacksize+1023) shr 10));
+        StackSizeKB := (StackSize + 1023) shr 10;
+        (* Ensure a value which might work and is accepted by EMXBIND *)
+        if StackSizeKB < 64 then
+         StackSizeKB := 64
+        else if StackSizeKB > (512 shl 10) then
+         StackSizeKB := 512 shl 10;
+        Replace(cmdstr,'$STACKKB',tostr(StackSizeKB));
         {When an EMX program runs in DOS, the heap and stack share the
          same memory pool. The heap grows upwards, the stack grows downwards.}
-        Replace(cmdstr,'$DOSHEAPKB',tostr((stacksize+1023) shr 10));
+        Replace(cmdstr,'$DOSHEAPKB',tostr(StackSizeKB));
         Replace(cmdstr,'$STRIP ', StripStr);
         Replace(cmdstr,'$MAP ', MapStr);
         Replace(cmdstr,'$APPTYPE',AppTypeStr);

compiler/systems/t_sunos.pas

@@ -115,10 +115,23 @@ implementation
                                   TLINKERsolaris
 *****************************************************************************}
 
+{$ifdef x86_64}
+const
+  gnu_emul = '-m elf_x86_64_sol2';
+{$endif}
+{$ifdef i386}
+const
+  gnu_emul = '-m elf_i386_sol2';
+{$endif }
+{$ifdef sparc}
+const
+  { no emulation specification needed, as long as only 32-bit is supported }
+  gnu_emul = '';
+{$endif}
+
 Constructor TLinkersolaris.Create;
 begin
   Inherited Create;
-
   if cs_link_native in init_settings.globalswitches then
     use_gnu_ld:=false
   else
@@ -143,12 +156,12 @@ procedure TLinkersolaris.SetDefaultInfo;
 }
 {$ifdef x86_64}
 const
-  gld = 'gld -m elf_x86_64_sol2 ';
+  gld = 'gld $EMUL ';
   solaris_ld = '/usr/bin/ld -64 ';
 {$endif}
 {$ifdef i386}
 const
-  gld = 'gld ';
+  gld = 'gld $EMUL';
   solaris_ld = '/usr/bin/ld ';
 {$endif }
 {$ifdef sparc}
@@ -163,10 +176,10 @@ begin
    begin
 {$IFDEF GnuLd}
      ExeCmd[1]:=gld + '$OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $RES';
-     ExeCmd[2]:=solaris_ld + '$OPT $DYNLINK $STATIC $STRIP -L . -o $EXE $RESDATA';
-     DllCmd[1]:=gld + '$OPT $INITFINI -shared -L. -o $EXE $RES';
+     ExeCmd[2]:=solaris_ld + '$OPT $DYNLINK $STATIC $STRIP -L . -o $EXE $RESDATA $REDIRECT';
+     DllCmd[1]:=gld + '$OPT $INITFINI -shared -L. $MAP -o $EXE $RES';
      DllCmd[2]:='gstrip --strip-unneeded $EXE';
-     DllCmd[3]:=solaris_ld + '$OPT $INITFINI -M $VERSIONFILE -G -Bdynamic -L. -o $EXE $RESDATA';
+     DllCmd[3]:=solaris_ld + '$OPT $INITFINI -M $VERSIONFILE $MAP -G -Bdynamic -L. -o $EXE $RESDATA $REDIRECT';
      DynamicLinker:=''; { Gnu uses the default }
      Glibc21:=false;
 {$ELSE}
@@ -242,7 +255,7 @@ begin
   if (isdll) then
     begin
       LinkRes.add('VERSION');
-      LinkRes.add('{');
+      LinkRes.add('{ DEFAULT'); { gld 2.25 does not support anonymous version }
       LinkRes.add('  {');
       if not texportlibunix(exportlib).exportedsymnames.empty then
         begin
@@ -310,6 +323,7 @@ begin
          end
         else
          begin
+           LinkRes.Add('-lc');
            linklibc:=true;
            linkdynamic:=false; { libc will include the ld-solaris (war ld-linux) for us }
          end;
@@ -409,13 +423,13 @@ begin
   { Write staticlibraries }
   if not StaticLibFiles.Empty then
    begin
-     linkres.add('-('); 
+     linkres.add('-(');
      While not StaticLibFiles.Empty do
       begin
         S:=StaticLibFiles.GetFirst;
         LinkRes.AddFileName(maybequoted(s))
       end;
-     linkres.add('-)'); 
+     linkres.add('-)');
    end;
 
   { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
@@ -474,20 +488,32 @@ var
   cmdstr  : TCmdStr;
   success : boolean;
   DynLinkStr : string[60];
-  StaticStr,
+  StaticStr, RedirectStr,
   StripStr   : string[40];
 begin
+  success:=false;
   if not(cs_link_nolink in current_settings.globalswitches) then
    Message1(exec_i_linking,current_module.exefilename);
 
 { Create some replacements }
   StaticStr:='';
   StripStr:='';
+  RedirectStr:='';
   DynLinkStr:='';
   if (cs_link_staticflag in current_settings.globalswitches) then
     StaticStr:='-Bstatic';
   if (cs_link_strip in current_settings.globalswitches) then
    StripStr:='-s';
+  if (cs_link_map in current_settings.globalswitches) then
+   begin
+     if use_gnu_ld then
+       StripStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename,'.map'))
+     else
+       begin
+         StripStr:='-m';
+         RedirectStr:=' > '+maybequoted(ChangeFileExt(current_module.exefilename,'.map'));
+       end;
+   end;
   If (cs_profile in current_settings.moduleswitches) or
      ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then
    DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
@@ -509,7 +535,10 @@ begin
   Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename));
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
   if use_gnu_ld then
-    Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName))
+    begin
+      Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
+      Replace(cmdstr,'$EMUL',gnu_emul);
+    end
   else
     begin
       linkstr:='';
@@ -524,12 +553,13 @@ begin
     end;
   Replace(cmdstr,'$STATIC',StaticStr);
   Replace(cmdstr,'$STRIP',StripStr);
+  Replace(cmdstr,'$REDIRECT',RedirectStr);
   Replace(cmdstr,'$DYNLINK',DynLinkStr);
   if BinStr[1]<>'/' then
-    success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,false)
-  else { Using utilsprefix has no sense on /usr/bin/ld }
-    success:=DoExec(BinStr,Trim(CmdStr),true,false);
+    BinStr:=FindUtil(utilsprefix+BinStr);
 
+  { We need shell if output is redirected }
+  success:=DoExec(BinStr,Trim(CmdStr),true,RedirectStr<>'');
 { Remove ReponseFile }
 {$IFNDEF LinkTest}
   if (success) and use_gnu_ld and
@@ -543,11 +573,12 @@ end;
 Function TLinkersolaris.MakeSharedLibrary:boolean;
 var
   InitFiniStr : string;
-  binstr,
-  s, linkstr,
+  binstr, RedirectStr,
+  s, linkstr, MapStr,
   cmdstr  : TCmdStr;
-  success : boolean;
+  need_quotes, success : boolean;
 begin
+  success:=false;
   MakeSharedLibrary:=false;
   if not(cs_link_nolink in current_settings.globalswitches) then
    Message1(exec_i_linking,current_module.sharedlibfilename);
@@ -555,20 +586,34 @@ begin
 { Write used files and libraries }
   WriteResponseFile(true);
 
+  RedirectStr:='';
+  MapStr:='';
 { Create some replacements }
+  if (cs_link_map in current_settings.globalswitches) then
+   begin
+     if use_gnu_ld then
+       MapStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename,'.map'))
+     else
+       begin
+         MapStr:='-m';
+         RedirectStr:=' > '+maybequoted(ChangeFileExt(current_module.exefilename,'.map'));
+       end;
+   end;
+  need_quotes:= (cs_link_nolink in current_settings.globalswitches) or
+                (RedirectStr<>'');
 { initname and fininame may contain $, which can be wrongly interpreted
-  in a link script, thus we surround them with single quotes 
+  in a link script, thus we surround them with single quotes
   in cs_link_nolink is in globalswitches }
   if use_gnu_ld then
     begin
       InitFiniStr:='-init ';
-      if cs_link_nolink in current_settings.globalswitches then
+      if need_quotes then
         InitFiniStr:=InitFiniStr+''''+exportlib.initname+''''
       else
         InitFiniStr:=InitFiniStr+exportlib.initname;
       if (exportlib.fininame<>'') then
         begin
-          if cs_link_nolink in current_settings.globalswitches then
+          if need_quotes then
             InitFiniStr:=InitFiniStr+' -fini '''+exportlib.initname+''''
           else
             InitFiniStr:=InitFiniStr+' -fini '+exportlib.fininame;
@@ -577,13 +622,13 @@ begin
   else
     begin
       InitFiniStr:='-z initarray=';
-      if cs_link_nolink in current_settings.globalswitches then
+      if need_quotes then
         InitFiniStr:=InitFiniStr+''''+exportlib.initname+''''
       else
         InitFiniStr:=InitFiniStr+exportlib.initname;
       if (exportlib.fininame<>'') then
         begin
-          if cs_link_nolink in current_settings.globalswitches then
+          if need_quotes then
             InitFiniStr:=InitFiniStr+' -z finiarray='''+exportlib.initname+''''
           else
             InitFiniStr:=InitFiniStr+' -z finiarray='+exportlib.fininame;
@@ -599,7 +644,10 @@ begin
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
   Replace(cmdstr,'$INITFINI',InitFiniStr);
   if use_gnu_ld then
-    Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName))
+    begin
+      Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
+      Replace(cmdstr,'$EMUL',gnu_emul);
+    end
   else
     begin
       Replace(cmdstr,'$VERSIONFILE',maybequoted(outputexedir+Info.ResName));
@@ -613,12 +661,12 @@ begin
       linkres.free;
       Replace(cmdstr,'$RESDATA',linkstr);
     end;
+  Replace(cmdstr,'$REDIRECT',RedirectStr);
+  Replace(cmdstr,'$MAP',MapStr);
   if BinStr[1]<>'/' then
-    success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,false)
-  else { Using utilsprefix has no sense on /usr/bin/ld }
-    success:=DoExec(BinStr,Trim(CmdStr),true,false);
-
-
+    BinStr:=FindUtil(utilsprefix+BinStr);
+  { We need shell if output is redirected }
+  success:=DoExec(BinStr,Trim(CmdStr),true,RedirectStr<>'');
 { Strip the library ? }
   if success and (cs_link_strip in current_settings.globalswitches) then
    begin

compiler/tokens.pas

@@ -187,6 +187,7 @@ type
     _STRICT,
     _STRING,
     _SYSTEM,
+    _WINAPI,
     _ASMNAME,
     _CPPDECL,
     _DEFAULT,
@@ -257,6 +258,7 @@ type
     _PROCEDURE,
     _PROTECTED,
     _PUBLISHED,
+    _REFERENCE,
     _SOFTFLOAT,
     _THREADVAR,
     _WRITEONLY,
@@ -505,6 +507,7 @@ const
       (str:'STRICT'        ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'STRING'        ;special:false;keyword:alllanguagemodes-[m_iso];op:NOTOKEN),
       (str:'SYSTEM'        ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'WINAPI'        ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'ASMNAME'       ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'CPPDECL'       ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'DEFAULT'       ;special:false;keyword:[m_none];op:NOTOKEN),
@@ -575,6 +578,7 @@ const
       (str:'PROCEDURE'     ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'PROTECTED'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'PUBLISHED'     ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'REFERENCE'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'SOFTFLOAT'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'THREADVAR'     ;special:false;keyword:alllanguagemodes-[m_iso];op:NOTOKEN),
       (str:'WRITEONLY'     ;special:false;keyword:[m_none];op:NOTOKEN),

compiler/utils/Makefile

@@ -1,9 +1,9 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2014-08-17 rev 28432]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2014-12-07 rev 29213]
 #
 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 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
-BSDs = freebsd netbsd openbsd darwin
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-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
+BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom msdos
 OSNeedsComspecToRunBatch = go32v2 watcom
@@ -484,6 +484,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove mkarmins mkx86ins
 endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove mkarmins mkx86ins
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove mkarmins mkx86ins
 endif
@@ -712,6 +715,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override CLEAN_UNITS+=ppu crc
 endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+override CLEAN_UNITS+=ppu crc
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 override CLEAN_UNITS+=ppu crc
 endif
@@ -941,6 +947,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override COMPILER_UNITDIR+=..
 endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+override COMPILER_UNITDIR+=..
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 override COMPILER_UNITDIR+=..
 endif
@@ -1169,6 +1178,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override COMPILER_SOURCEDIR+=..
 endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+override COMPILER_SOURCEDIR+=..
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 override COMPILER_SOURCEDIR+=..
 endif
@@ -1482,6 +1494,12 @@ EXEEXT=
 HASSHAREDLIB=1
 SHORTSUFFIX=lnx
 endif
+ifeq ($(OS_TARGET),dragonfly)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=df
+endif
 ifeq ($(OS_TARGET),freebsd)
 BATCHEXT=.sh
 EXEEXT=
@@ -2043,6 +2061,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -2263,7 +2284,7 @@ endif
 ifdef CREATESHARED
 override FPCOPT+=-Cg
 endif
-ifneq ($(findstring $(OS_TARGET),freebsd openbsd netbsd linux solaris),)
+ifneq ($(findstring $(OS_TARGET),dragonfly freebsd openbsd netbsd linux solaris),)
 ifeq ($(CPU_TARGET),x86_64)
 override FPCOPT+=-Cg
 endif

compiler/utils/ppuutils/ppudump.pp

@@ -289,8 +289,32 @@ const
   end;
 
 const has_errors : boolean = false;
+      has_warnings : boolean = false;
       has_more_infos : boolean = false;
 
+procedure SetHasErrors;
+begin
+  has_errors:=true;
+end;
+
+Procedure WriteError(const S : string);
+Begin
+  system.Writeln(StdErr, S);
+  SetHasErrors;
+End;
+
+Procedure WriteWarning(const S : string);
+var
+  ss: string;
+Begin
+  ss:='!! Warning: ' + S;
+  if nostdout then
+    system.Writeln(StdErr, ss)
+  else
+    system.Writeln(ss);
+  has_warnings:=true;
+End;
+
 procedure Write(const s: string);
 begin
   if nostdout then exit;
@@ -300,20 +324,84 @@ end;
 procedure Write(const params: array of const);
 var
   i: integer;
+  { Last vtType define in rtl/inc/objpash.inc }
+const
+  max_vttype = vtUnicodeString;
 begin
   if nostdout then exit;
   for i:=Low(params) to High(params) do
+  { All vtType in
+        vtInteger       = 0;
+        vtBoolean       = 1;
+        vtChar          = 2;
+        vtExtended      = 3;
+        vtString        = 4;
+        vtPointer       = 5;
+        vtPChar         = 6;
+        vtObject        = 7;
+        vtClass         = 8;
+        vtWideChar      = 9;
+        vtPWideChar     = 10;
+        vtAnsiString32  = 11; called vtAnsiString in objpas unit
+        vtCurrency      = 12;
+        vtVariant       = 13;
+        vtInterface     = 14;
+        vtWideString    = 15;
+        vtInt64         = 16;
+        vtQWord         = 17;
+        vtUnicodeString = 18;
+        // vtAnsiString16  = 19; not yet used
+        // vtAnsiString64  = 20; not yet used
+    }
     with TVarRec(params[i]) do
       case VType of
         vtInteger: system.write(VInteger);
-        vtInt64: system.write(VInt64^);
-        vtQWord: system.write(VQWord^);
-        vtString: system.write(VString^);
-        vtAnsiString: system.write(ansistring(VAnsiString));
-        vtPChar: system.write(VPChar);
-        vtChar: system.write(VChar);
         vtBoolean: system.write(VBoolean);
+        vtChar: system.write(VChar);
         vtExtended: system.write(VExtended^);
+        vtString: system.write(VString^);
+        vtPointer:
+          begin
+            { Not sure the display will be correct
+              if sizeof pointer is not native }
+            WriteWarning('Pointer constant');
+          end;
+        vtPChar: system.write(VPChar);
+        vtObject:
+          begin
+            { Not sure the display will be correct
+              if sizeof pointer is not native }
+            WriteWarning('Object constant');
+          end;
+        vtClass:
+          begin
+            { Not sure the display will be correct
+              if sizeof pointer is not native }
+            WriteWarning('Class constant');
+          end;
+        vtWideChar: system.write(VWideChar);
+        vtPWideChar:
+          begin
+            WriteWarning('PWideChar constant');
+          end;
+        vtAnsiString: system.write(ansistring(VAnsiString));
+        vtCurrency : system.write(VCurrency^);
+        vtVariant :
+          begin
+            { Not sure the display will be correct
+              if sizeof pointer is not native }
+            WriteWarning('Variant constant');
+          end;
+        vtInterface :
+          begin
+            { Not sure the display will be correct
+              if sizeof pointer is not native }
+            WriteWarning('Interface constant');
+          end;
+        vtWideString : system.write(widestring(VWideString));
+        vtInt64: system.write(VInt64^);
+        vtQWord: system.write(VQWord^);
+        vtUnicodeString : system.write(unicodestring(VUnicodeString));
         else
           begin
             system.writeln;
@@ -342,28 +430,6 @@ begin
   has_more_infos:=true;
 end;
 
-procedure SetHasErrors;
-begin
-  has_errors:=true;
-end;
-
-Procedure WriteError(const S : string);
-Begin
-  system.Writeln(StdErr, S);
-  SetHasErrors;
-End;
-
-Procedure WriteWarning(const S : string);
-var
-  ss: string;
-Begin
-  ss:='!! Warning: ' + S;
-  if nostdout then
-    system.Writeln(StdErr, ss)
-  else
-    system.Writeln(ss);
-End;
-
 function Unknown(const st : string; val :longint) : string;
 Begin
   Unknown:='<!! Unknown'+st+' value '+tostr(val)+'>';
@@ -463,7 +529,7 @@ const
       'jvm enum fpcvalueof', 'jvm enum long2set',
       'jvm enum bitset2set', 'jvm enum set2set',
       'jvm procvar invoke', 'jvm procvar intf constructor',
-      'jvm virtual class method', 'jvm field getter', 'jvm field setter');
+      'jvm virtual class method', 'jvm field getter', 'jvm field setter', 'block invoke');
 begin
   if w<=ord(high(syntheticName)) then
     result:=syntheticName[tsynthetickind(w)]
@@ -1200,7 +1266,9 @@ const
          (mask:pi_has_stack_allocs;
          str:' allocates memory on stack, so stack may be unbalanced on exit '),
          (mask:pi_estimatestacksize;
-         str:' stack size is estimated before subroutine is compiled ')
+         str:' stack size is estimated before subroutine is compiled '),
+         (mask:pi_calls_c_varargs;
+         str:' calls function with C-style varargs ')
   );
 var
   procinfooptions : tprocinfoflags;
@@ -1755,7 +1823,9 @@ const
      (mask:po_rtlproc;         str: 'RTL procedure'),
      (mask:po_auto_raised_visibility; str: 'Visibility raised by compiler'),
      (mask:po_far;             str: 'Far'),
-     (mask:po_noreturn;             str: 'No return')
+     (mask:po_noreturn;        str: 'No return'),
+     (mask:po_is_function_ref; str: 'Function reference'),
+     (mask:po_is_block;        str: 'C "Block"')
   );
 var
   proctypeoption  : tproctypeoption;
@@ -2546,9 +2616,8 @@ begin
          ibmacrosym :
            begin
              readcommonsym('Macro symbol ');
-             writeln([space,'          Name: ',getstring]);
-             writeln([space,'       Defined: ',getbyte]);
-             writeln([space,'  Compiler var: ',getbyte]);
+             writeln([space,'       Defined: ',boolean(getbyte)]);
+             writeln([space,'  Compiler var: ',boolean(getbyte)]);
              len:=getlongint;
              writeln([space,'  Value length: ',len]);
              if len > 0 then
@@ -3791,7 +3860,8 @@ begin
   end;
   if has_errors then
     Halt(1);
-  if error_on_more and has_more_infos then
+  if error_on_more and
+    (has_more_infos or has_warnings) then
     Halt(2);
 end.
 

compiler/version.pas

@@ -27,8 +27,8 @@ interface
 
     const
        { version string }
-       version_nr = '2';
-       release_nr = '7';
+       version_nr = '3';
+       release_nr = '1';
        patch_nr   = '1';
        minorpatch = '';
 

compiler/x86/agx86att.pas

@@ -163,18 +163,19 @@ interface
            if assigned(relsymbol) then
              owner.AsmWrite('-'+relsymbol.name);
            if ref.refaddr=addr_pic then
-{$ifdef x86_64}
              begin
-               { local symbols don't have to (and in case of Mac OS X: cannot)
-                 be accessed via the GOT
-               }
-               if not assigned(ref.symbol) or
-                  (ref.symbol.bind<>AB_LOCAL) then
-                 owner.AsmWrite('@GOTPCREL');
-             end;
+               { @GOT and @GOTPCREL references are only allowed for symbol alone,
+                 indexing, relsymbol or offset cannot be present. }
+               if assigned(relsymbol) or (offset<>0) or (index<>NR_NO) then
+                 InternalError(2015011801);
+{$ifdef x86_64}
+               if (base<>NR_RIP) then
+                 InternalError(2015011802);
+               owner.AsmWrite('@GOTPCREL');
 {$else x86_64}
-             owner.AsmWrite('@GOT');
+               owner.AsmWrite('@GOT');
 {$endif x86_64}
+             end;
            if offset<0 then
              owner.AsmWrite(tostr(offset))
            else

compiler/x86/agx86int.pas

@@ -231,6 +231,7 @@ implementation
           1: result:='BYTE';
           2: result:='WORD';
           4: result:='DWORD';
+          0,
           16: result:='PARA';
           256: result:='PAGE';
         else
@@ -821,8 +822,10 @@ implementation
                     hp:=tai(hp.next);
                   end;
                  AsmWriteLn(#9'.386p');
+{$ifdef i8086}
                  AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
                  AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
+{$endif i8086}
                  { I was told that this isn't necesarry because }
                  { the labels generated by FPC are unique (FK)  }
                  { AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); }
@@ -925,8 +928,10 @@ implementation
             begin
               AsmWriteLn(#9'LOCALS '+target_asm.labelprefix);
             end;
+{$ifdef i8086}
           AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
           AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
+{$endif i8086}
           AsmLn;
         end;