Merge with trunk r22040. Regenerated makefiles.

git-svn-id: branches/targetandroid@22046 -

.gitattributes

@@ -2328,7 +2328,13 @@ packages/fcl-passrc/src/paswrite.pp svneol=native#text/plain
 packages/fcl-passrc/src/pparser.pp svneol=native#text/plain
 packages/fcl-passrc/src/pscanner.pp svneol=native#text/plain
 packages/fcl-passrc/src/readme.txt svneol=native#text/plain
+packages/fcl-passrc/tests/tcbaseparser.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tcmoduleparser.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tconstparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcscanner.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tcstatements.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tctypeparser.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tcvarparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/testpassrc.lpi svneol=native#text/plain
 packages/fcl-passrc/tests/testpassrc.lpr svneol=native#text/plain
 packages/fcl-process/Makefile svneol=native#text/plain
@@ -7698,6 +7704,7 @@ rtl/linux/arm/ucprt0.as svneol=native#text/plain
 rtl/linux/buildrtl.lpi svneol=native#text/plain
 rtl/linux/buildrtl.pp svneol=native#text/plain
 rtl/linux/bunxsysc.inc svneol=native#text/plain
+rtl/linux/errno-mips.inc svneol=native#text/plain
 rtl/linux/errno-sparc.inc svneol=native#text/plain
 rtl/linux/errno.inc svneol=native#text/plain
 rtl/linux/errnostr.inc svneol=native#text/plain
@@ -9589,6 +9596,7 @@ tests/tbs/tb0578.pp svneol=native#text/pascal
 tests/tbs/tb0579.pp svneol=native#text/pascal
 tests/tbs/tb0580.pp svneol=native#text/pascal
 tests/tbs/tb0581.pp svneol=native#text/plain
+tests/tbs/tb0582.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
@@ -9735,6 +9743,13 @@ tests/test/cg/obj/linux/arm-eabi/tcext3.o -text
 tests/test/cg/obj/linux/arm-eabi/tcext4.o -text
 tests/test/cg/obj/linux/arm-eabi/tcext5.o -text
 tests/test/cg/obj/linux/arm-eabi/tcext6.o -text
+tests/test/cg/obj/linux/arm-gnueabihf/cpptcl1.o -text
+tests/test/cg/obj/linux/arm-gnueabihf/cpptcl2.o -text
+tests/test/cg/obj/linux/arm-gnueabihf/ctest.o -text
+tests/test/cg/obj/linux/arm-gnueabihf/tcext3.o -text
+tests/test/cg/obj/linux/arm-gnueabihf/tcext4.o -text
+tests/test/cg/obj/linux/arm-gnueabihf/tcext5.o -text
+tests/test/cg/obj/linux/arm-gnueabihf/tcext6.o -text
 tests/test/cg/obj/linux/arm/ctest.o -text
 tests/test/cg/obj/linux/arm/tcext3.o -text
 tests/test/cg/obj/linux/arm/tcext4.o -text
@@ -10290,6 +10305,8 @@ tests/test/packages/fcl-db/tdb6.pp svneol=native#text/plain
 tests/test/packages/fcl-db/toolsunit.pas svneol=native#text/plain
 tests/test/packages/fcl-registry/tregistry1.pp svneol=native#text/plain
 tests/test/packages/fcl-xml/thtmlwriter.pp svneol=native#text/plain
+tests/test/packages/fcl-xml/tw22495.pp svneol=native#text/plain
+tests/test/packages/fcl-xml/uw22495.pp svneol=native#text/plain
 tests/test/packages/hash/sha1test.pp svneol=native#text/plain
 tests/test/packages/hash/tmdtest.pp svneol=native#text/plain
 tests/test/packages/webtbs/tw10045.pp svneol=native#text/plain
@@ -10337,6 +10354,7 @@ tests/test/tasm3.pp svneol=native#text/plain
 tests/test/tasm4.pp svneol=native#text/plain
 tests/test/tasm5.pp svneol=native#text/plain
 tests/test/tasm6.pp svneol=native#text/plain
+tests/test/tasm7.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
@@ -10976,13 +10994,89 @@ tests/test/toperator1.pp svneol=native#text/plain
 tests/test/toperator10.pp svneol=native#text/pascal
 tests/test/toperator11.pp svneol=native#text/pascal
 tests/test/toperator12.pp svneol=native#text/pascal
+tests/test/toperator13.pp svneol=native#text/pascal
+tests/test/toperator14.pp svneol=native#text/pascal
+tests/test/toperator15.pp svneol=native#text/pascal
+tests/test/toperator16.pp svneol=native#text/pascal
+tests/test/toperator17.pp svneol=native#text/pascal
+tests/test/toperator18.pp svneol=native#text/pascal
+tests/test/toperator19.pp svneol=native#text/pascal
 tests/test/toperator2.pp svneol=native#text/plain
+tests/test/toperator20.pp svneol=native#text/pascal
+tests/test/toperator21.pp svneol=native#text/pascal
+tests/test/toperator22.pp svneol=native#text/pascal
+tests/test/toperator23.pp svneol=native#text/pascal
+tests/test/toperator24.pp svneol=native#text/pascal
+tests/test/toperator25.pp svneol=native#text/pascal
+tests/test/toperator26.pp svneol=native#text/pascal
+tests/test/toperator27.pp svneol=native#text/pascal
+tests/test/toperator28.pp svneol=native#text/pascal
+tests/test/toperator29.pp svneol=native#text/pascal
 tests/test/toperator3.pp svneol=native#text/plain
+tests/test/toperator30.pp svneol=native#text/pascal
+tests/test/toperator31.pp svneol=native#text/pascal
+tests/test/toperator32.pp svneol=native#text/pascal
+tests/test/toperator33.pp svneol=native#text/pascal
+tests/test/toperator34.pp svneol=native#text/pascal
+tests/test/toperator35.pp svneol=native#text/pascal
+tests/test/toperator36.pp svneol=native#text/pascal
+tests/test/toperator37.pp svneol=native#text/pascal
+tests/test/toperator38.pp svneol=native#text/pascal
+tests/test/toperator39.pp svneol=native#text/pascal
 tests/test/toperator4.pp svneol=native#text/plain
+tests/test/toperator40.pp svneol=native#text/pascal
+tests/test/toperator41.pp svneol=native#text/pascal
+tests/test/toperator42.pp svneol=native#text/pascal
+tests/test/toperator43.pp svneol=native#text/pascal
+tests/test/toperator44.pp svneol=native#text/pascal
+tests/test/toperator45.pp svneol=native#text/pascal
+tests/test/toperator46.pp svneol=native#text/pascal
+tests/test/toperator47.pp svneol=native#text/pascal
+tests/test/toperator48.pp svneol=native#text/pascal
+tests/test/toperator49.pp svneol=native#text/pascal
 tests/test/toperator5.pp svneol=native#text/plain
+tests/test/toperator50.pp svneol=native#text/pascal
+tests/test/toperator51.pp svneol=native#text/pascal
+tests/test/toperator52.pp svneol=native#text/pascal
+tests/test/toperator53.pp svneol=native#text/pascal
+tests/test/toperator54.pp svneol=native#text/pascal
+tests/test/toperator55.pp svneol=native#text/pascal
+tests/test/toperator56.pp svneol=native#text/pascal
+tests/test/toperator57.pp svneol=native#text/pascal
+tests/test/toperator58.pp svneol=native#text/pascal
+tests/test/toperator59.pp svneol=native#text/pascal
 tests/test/toperator6.pp svneol=native#text/plain
+tests/test/toperator60.pp svneol=native#text/pascal
+tests/test/toperator61.pp svneol=native#text/pascal
+tests/test/toperator62.pp svneol=native#text/pascal
+tests/test/toperator63.pp svneol=native#text/pascal
+tests/test/toperator64.pp svneol=native#text/pascal
+tests/test/toperator65.pp svneol=native#text/pascal
+tests/test/toperator66.pp svneol=native#text/pascal
+tests/test/toperator67.pp svneol=native#text/pascal
+tests/test/toperator68.pp svneol=native#text/pascal
+tests/test/toperator69.pp svneol=native#text/pascal
 tests/test/toperator7.pp svneol=native#text/plain
+tests/test/toperator70.pp svneol=native#text/pascal
+tests/test/toperator71.pp svneol=native#text/pascal
+tests/test/toperator72.pp svneol=native#text/pascal
+tests/test/toperator73.pp svneol=native#text/pascal
+tests/test/toperator74.pp svneol=native#text/pascal
+tests/test/toperator75.pp svneol=native#text/pascal
+tests/test/toperator76.pp svneol=native#text/pascal
+tests/test/toperator77.pp svneol=native#text/pascal
+tests/test/toperator78.pp svneol=native#text/pascal
+tests/test/toperator79.pp svneol=native#text/pascal
 tests/test/toperator8.pp svneol=native#text/pascal
+tests/test/toperator80.pp svneol=native#text/pascal
+tests/test/toperator81.pp svneol=native#text/pascal
+tests/test/toperator82.pp svneol=native#text/pascal
+tests/test/toperator83.pp svneol=native#text/pascal
+tests/test/toperator84.pp svneol=native#text/pascal
+tests/test/toperator85.pp svneol=native#text/pascal
+tests/test/toperator86.pp svneol=native#text/pascal
+tests/test/toperator87.pp svneol=native#text/pascal
+tests/test/toperator88.pp svneol=native#text/pascal
 tests/test/toperator9.pp svneol=native#text/pascal
 tests/test/tover1.pp svneol=native#text/plain
 tests/test/tover2.pp svneol=native#text/plain
@@ -11677,6 +11771,10 @@ tests/webtbf/tw2174.pp svneol=native#text/plain
 tests/webtbf/tw21873.pp svneol=native#text/plain
 tests/webtbf/tw2209.pp svneol=native#text/plain
 tests/webtbf/tw22219.pp svneol=native#text/pascal
+tests/webtbf/tw22343a.pp svneol=native#text/plain
+tests/webtbf/tw22343b.pp svneol=native#text/plain
+tests/webtbf/tw22343c.pp svneol=native#text/plain
+tests/webtbf/tw22395.pp svneol=native#text/plain
 tests/webtbf/tw2242.pp svneol=native#text/plain
 tests/webtbf/tw2273.pp svneol=native#text/plain
 tests/webtbf/tw2281.pp svneol=native#text/plain
@@ -12604,6 +12702,7 @@ tests/webtbs/tw20872c.pp svneol=native#text/pascal
 tests/webtbs/tw20873.pp svneol=native#text/plain
 tests/webtbs/tw20874a.pp svneol=native#text/pascal
 tests/webtbs/tw20874b.pp svneol=native#text/pascal
+tests/webtbs/tw20880.pp -text svneol=native#text/plain
 tests/webtbs/tw20889.pp svneol=native#text/pascal
 tests/webtbs/tw20909.pp svneol=native#text/pascal
 tests/webtbs/tw20940.pp svneol=native#text/pascal
@@ -12677,9 +12776,13 @@ tests/webtbs/tw22326.pp svneol=native#text/plain
 tests/webtbs/tw22329.pp svneol=native#text/pascal
 tests/webtbs/tw2233.pp svneol=native#text/plain
 tests/webtbs/tw22331.pp svneol=native#text/plain
+tests/webtbs/tw22344.pp svneol=native#text/plain
 tests/webtbs/tw2242.pp svneol=native#text/plain
 tests/webtbs/tw2250.pp svneol=native#text/plain
+tests/webtbs/tw22502.pp svneol=native#text/plain
+tests/webtbs/tw22561.pp svneol=native#text/plain
 tests/webtbs/tw2259.pp svneol=native#text/plain
+tests/webtbs/tw22593.pp svneol=native#text/plain
 tests/webtbs/tw2260.pp svneol=native#text/plain
 tests/webtbs/tw2266.pp svneol=native#text/plain
 tests/webtbs/tw2267.pp svneol=native#text/plain

Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2012/07/07]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2012/07/08]
 #
 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 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 jvm-java jvm-android

compiler/Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2012/05/07]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2012/07/08]
 #
 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 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 powerpc-android 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 armel-android mips-linux mipsel-linux
+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 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 jvm-java jvm-android
 BSDs = freebsd netbsd openbsd darwin
 UNIXs = linux $(BSDs) solaris qnx haiku aix android
 LIMIT83fs = go32v2 os2 emx watcom
@@ -296,7 +296,7 @@ override PACKAGE_NAME=compiler
 override PACKAGE_VERSION=2.7.1
 unexport FPC_VERSION FPC_COMPILERINFO
 CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64 m68k armeb mipsel mips avr
-ALLTARGETS=$(CYCLETARGETS)
+ALLTARGETS=$(CYCLETARGETS) jvm
 ifdef ALPHA
 PPC_TARGET=alpha
 endif
@@ -333,6 +333,9 @@ endif
 ifdef AVR
 PPC_TARGET=avr
 endif
+ifdef JVM
+PPC_TARGET=jvm
+endif
 ifndef PPC_TARGET
 PPC_TARGET=$(CPU_TARGET)
 endif
@@ -357,6 +360,32 @@ endif
 ifndef RTLOPT
 RTLOPT:=$(OPT)
 endif
+ifdef CYCLELEVEL
+ifeq ($(CYCLELEVEL),1)
+LOCALOOPT+=$(OPTLEVEL1)
+RTLOPT+=$(OPTLEVEL1)
+LOCALOPT+=$(LOCALOPTLEVEL1)
+RTLOPT+=$(RTLOPTLEVEL1)
+endif
+ifeq ($(CYCLELEVEL),2)
+LOCALOOPT+=$(OPTLEVEL2)
+RTLOPT+=$(OPTLEVEL2)
+LOCALOPT+=$(LOCALOPTLEVEL2)
+RTLOPT+=$(RTLOPTLEVEL2)
+endif
+ifeq ($(CYCLELEVEL),3)
+LOCALOOPT+=$(OPTLEVEL3)
+RTLOPT+=$(OPTLEVEL3)
+LOCALOPT+=$(LOCALOPTLEVEL3)
+RTLOPT+=$(RTLOPTLEVEL3)
+endif
+ifeq ($(CYCLELEVEL),4)
+LOCALOOPT+=$(OPTLEVEL4)
+RTLOPT+=$(OPTLEVEL4)
+LOCALOPT+=$(LOCALOPTLEVEL4)
+RTLOPT+=$(RTLOPTLEVEL4)
+endif
+endif
 override OPT=
 MSGFILES=$(wildcard msg/error*.msg)
 ifeq ($(CPC_TARGET),i386)
@@ -392,6 +421,9 @@ endif
 ifeq ($(CPC_TARGET),avr)
 CPUSUF=avr
 endif
+ifeq ($(CPC_TARGET),jvm)
+CPUSUF=jvm
+endif
 NOCPUDEF=1
 MSGFILE=msg/error$(FPCLANG).msg
 SVNVERSION:=$(wildcard $(addsuffix /svnversion$(SRCEXEEXT),$(SEARCHPATH)))
@@ -440,6 +472,9 @@ endif
 ifeq ($(PPC_TARGET),mipsel)
 override LOCALOPT+=-Fumips
 endif
+ifeq ($(PPC_TARGET),jvm)
+override LOCALOPT+=-Fujvm -dNOOPT
+endif
 OPTWPOCOLLECT=-OWdevirtcalls,optvmts -FW$(BASEDIR)/pp1.wpo
 OPTWPOPERFORM=-Owdevirtcalls,optvmts -Fw$(BASEDIR)/pp1.wpo
 ifneq ($(findstring $(OS_TARGET),darwin linux freebsd solaris),)
@@ -450,6 +485,15 @@ OPTWPOPERFORM+=-Owsymbolliveness
 endif
 endif
 endif
+ifeq ($(CPU_TARGET),jvm)
+NoNativeBinaries=1
+endif
+ifeq ($(OS_TARGET),embedded)
+NoNativeBinaries=1
+endif
+ifeq ($(OS_TARGET),gba)
+NoNativeBinaries=1
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_DIRS+=utils
 endif
@@ -570,9 +614,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-aix)
 override TARGET_DIRS+=utils
 endif
-ifeq ($(FULL_TARGET),powerpc-android)
-override TARGET_DIRS+=utils
-endif
 ifeq ($(FULL_TARGET),sparc-linux)
 override TARGET_DIRS+=utils
 endif
@@ -657,15 +698,18 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override TARGET_DIRS+=utils
 endif
-ifeq ($(FULL_TARGET),armel-android)
-override TARGET_DIRS+=utils
-endif
 ifeq ($(FULL_TARGET),mips-linux)
 override TARGET_DIRS+=utils
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 override TARGET_DIRS+=utils
 endif
+ifeq ($(FULL_TARGET),jvm-java)
+override TARGET_DIRS+=utils
+endif
+ifeq ($(FULL_TARGET),jvm-android)
+override TARGET_DIRS+=utils
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_PROGRAMS+=pp
 endif
@@ -786,9 +830,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-aix)
 override TARGET_PROGRAMS+=pp
 endif
-ifeq ($(FULL_TARGET),powerpc-android)
-override TARGET_PROGRAMS+=pp
-endif
 ifeq ($(FULL_TARGET),sparc-linux)
 override TARGET_PROGRAMS+=pp
 endif
@@ -873,15 +914,18 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override TARGET_PROGRAMS+=pp
 endif
-ifeq ($(FULL_TARGET),armel-android)
-override TARGET_PROGRAMS+=pp
-endif
 ifeq ($(FULL_TARGET),mips-linux)
 override TARGET_PROGRAMS+=pp
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 override TARGET_PROGRAMS+=pp
 endif
+ifeq ($(FULL_TARGET),jvm-java)
+override TARGET_PROGRAMS+=pp
+endif
+ifeq ($(FULL_TARGET),jvm-android)
+override TARGET_PROGRAMS+=pp
+endif
 override INSTALL_FPCPACKAGE=y
 ifeq ($(FULL_TARGET),i386-linux)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
@@ -1003,9 +1047,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-aix)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
-ifeq ($(FULL_TARGET),powerpc-android)
-override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
-endif
 ifeq ($(FULL_TARGET),sparc-linux)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
@@ -1090,15 +1131,18 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
-ifeq ($(FULL_TARGET),armel-android)
-override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
-endif
 ifeq ($(FULL_TARGET),mips-linux)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
+ifeq ($(FULL_TARGET),jvm-java)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
+ifeq ($(FULL_TARGET),jvm-android)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -1219,9 +1263,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-aix)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
-ifeq ($(FULL_TARGET),powerpc-android)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
 ifeq ($(FULL_TARGET),sparc-linux)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -1306,15 +1347,18 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
-ifeq ($(FULL_TARGET),armel-android)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
 ifeq ($(FULL_TARGET),mips-linux)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
+ifeq ($(FULL_TARGET),jvm-java)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
+ifeq ($(FULL_TARGET),jvm-android)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override COMPILER_TARGETDIR+=.
 endif
@@ -1435,9 +1479,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-aix)
 override COMPILER_TARGETDIR+=.
 endif
-ifeq ($(FULL_TARGET),powerpc-android)
-override COMPILER_TARGETDIR+=.
-endif
 ifeq ($(FULL_TARGET),sparc-linux)
 override COMPILER_TARGETDIR+=.
 endif
@@ -1522,15 +1563,18 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_TARGETDIR+=.
 endif
-ifeq ($(FULL_TARGET),armel-android)
-override COMPILER_TARGETDIR+=.
-endif
 ifeq ($(FULL_TARGET),mips-linux)
 override COMPILER_TARGETDIR+=.
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 override COMPILER_TARGETDIR+=.
 endif
+ifeq ($(FULL_TARGET),jvm-java)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),jvm-android)
+override COMPILER_TARGETDIR+=.
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -1651,9 +1695,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-aix)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
-ifeq ($(FULL_TARGET),powerpc-android)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
 ifeq ($(FULL_TARGET),sparc-linux)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -1738,15 +1779,18 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
-ifeq ($(FULL_TARGET),armel-android)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
 ifeq ($(FULL_TARGET),mips-linux)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),jvm-java)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
+ifeq ($(FULL_TARGET),jvm-android)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
 ifdef REQUIRE_UNITSDIR
 override UNITSDIR+=$(REQUIRE_UNITSDIR)
 endif
@@ -2472,9 +2516,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-aix)
 REQUIRE_PACKAGES_RTL=1
 endif
-ifeq ($(FULL_TARGET),powerpc-android)
-REQUIRE_PACKAGES_RTL=1
-endif
 ifeq ($(FULL_TARGET),sparc-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -2559,15 +2600,18 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 REQUIRE_PACKAGES_RTL=1
 endif
-ifeq ($(FULL_TARGET),armel-android)
-REQUIRE_PACKAGES_RTL=1
-endif
 ifeq ($(FULL_TARGET),mips-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),jvm-java)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),jvm-android)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifdef REQUIRE_PACKAGES_RTL
 PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
 ifneq ($(PACKAGEDIR_RTL),)
@@ -3319,9 +3363,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-aix)
 TARGET_DIRS_UTILS=1
 endif
-ifeq ($(FULL_TARGET),powerpc-android)
-TARGET_DIRS_UTILS=1
-endif
 ifeq ($(FULL_TARGET),sparc-linux)
 TARGET_DIRS_UTILS=1
 endif
@@ -3406,15 +3447,18 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 TARGET_DIRS_UTILS=1
 endif
-ifeq ($(FULL_TARGET),armel-android)
-TARGET_DIRS_UTILS=1
-endif
 ifeq ($(FULL_TARGET),mips-linux)
 TARGET_DIRS_UTILS=1
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 TARGET_DIRS_UTILS=1
 endif
+ifeq ($(FULL_TARGET),jvm-java)
+TARGET_DIRS_UTILS=1
+endif
+ifeq ($(FULL_TARGET),jvm-android)
+TARGET_DIRS_UTILS=1
+endif
 ifdef TARGET_DIRS_UTILS
 utils_all:
 	$(MAKE) -C utils all
@@ -3526,7 +3570,11 @@ EXENAME=ppc$(CPUSUF)$(EXEEXT)
 endif
 PPEXENAME=pp$(EXEEXT)
 TEMPNAME=ppc$(SRCEXEEXT)
+ifneq ($(CPUSUF),jvm)
 PPCROSSNAME=ppcross$(CPUSUF)$(SRCEXEEXT)
+else
+PPCROSSNAME=ppc$(CPUSUF)$(SRCEXEEXT)
+endif
 TEMPNAME1=ppc1$(EXEEXT)
 TEMPNAME2=ppc2$(EXEEXT)
 TEMPNAME3=ppc3$(EXEEXT)
@@ -3539,7 +3587,7 @@ INSTALLEXEFILE=$(PPCROSSNAME)
 else
 INSTALLEXEFILE=$(EXENAME)
 endif
-PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64 mips mipsel avr
+PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64 mips mipsel avr jvm
 INSTALL_TARGETS=$(addsuffix _exe_install,$(sort $(CYCLETARGETS) $(PPC_TARGETS)))
 .PHONY: $(PPC_TARGETS) $(INSTALL_TARGETS)
 $(PPC_TARGETS):
@@ -3574,11 +3622,11 @@ ppuclean:
 tempclean:
 	-$(DEL) $(PPCROSSNAME) $(TEMPNAME) $(TEMPNAME1) $(TEMPNAME2) $(TEMPNAME3) $(MSG2INC) pp1.wpo pp2.wpo
 execlean :
-	-$(DEL) ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2)
+	-$(DEL) ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) ppcjvm$(EXEEXT) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2)
 $(addsuffix _clean,$(ALLTARGETS)):
 	-$(DELTREE) $(addprefix $(subst _clean,,$@),/units)
 	-$(DEL) $(addprefix $(subst _clean,,$@)/,*$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT))
-	-$(DEL) $(addprefix $(subst _clean,,$@)/,ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) $(EXENAME))
+	-$(DEL) $(addprefix $(subst _clean,,$@)/,ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) ppcjvm$(EXEEXT)  $(EXENAME))
 cycleclean: cleanall $(addsuffix _clean,$(CPC_TARGET))
 	-$(DEL) $(EXENAME)
 clean: tempclean execlean cleanall $(addsuffix _clean,$(CPC_TARGET)) $(addsuffix _clean,$(TARGET_DIRS))
@@ -3692,20 +3740,20 @@ next :
 	$(MAKE) echotime
 endif
 $(TEMPNAME1) :
-	$(MAKE) 'OLDFPC=' next
+	$(MAKE) 'OLDFPC=' next CYCLELEVEL=1
 	-$(DEL) $(TEMPNAME1)
 	$(MOVE) $(EXENAME) $(TEMPNAME1)
 $(TEMPNAME2) : $(TEMPNAME1)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME1)' 'OLDFPC=' next
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME1)' 'OLDFPC=' next CYCLELEVEL=2
 	-$(DEL) $(TEMPNAME2)
 	$(MOVE) $(EXENAME) $(TEMPNAME2)
 $(TEMPNAME3) : $(TEMPNAME2)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME2)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME1)' next
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME2)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME1)' next CYCLELEVEL=3
 	-$(DEL) $(TEMPNAME3)
 	$(MOVE) $(EXENAME) $(TEMPNAME3)
 cycle:
 	$(MAKE) tempclean $(TEMPNAME3)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME2)' next
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME2)' next CYCLELEVEL=4
 	$(DIFF) $(TEMPNAME3) $(EXENAME)
 	$(MAKE) $(addsuffix _all,$(TARGET_DIRS)) 'FPC=$(BASEDIR)/$(EXENAME)'
 	$(MAKE) wpocycle
@@ -3713,14 +3761,14 @@ cycle:
 else
 cycle:
 	$(MAKE) OS_TARGET=$(OS_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 rtlclean rtl
-	$(MAKE) OS_TARGET=$(OS_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
+	$(MAKE) OS_TARGET=$(OS_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 cycleclean compiler CYCLELEVEL=1
 	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 rtlclean rtl
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 cycleclean compiler CYCLELEVEL=2
 ifndef CROSSINSTALL
 	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' rtlclean rtl
 ifneq ($(OS_TARGET),embedded)
 ifneq ($(OS_TARGET),gba)
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' cycleclean compiler
+	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' cycleclean compiler CYCLELEVEL=3
 endif
 endif
 endif
@@ -3729,29 +3777,31 @@ else
 cycle: override FPC=
 cycle:
 	$(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 rtlclean rtl
-	$(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
+	$(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 cycleclean compiler CYCLELEVEL=1
 	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 rtlclean rtl
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) PPC_TARGET=$(CPU_TARGET) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) PPC_TARGET=$(CPU_TARGET) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 cycleclean compiler CYCLELEVEL=2
 ifndef CROSSINSTALL
 	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(RTLOPT) $(CROSSOPT)' rtlclean rtl
-ifneq ($(OS_TARGET),embedded)
-ifneq ($(OS_TARGET),gba)
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(LOCALOPT) $(CROSSOPT)' cycleclean compiler
-endif
+ifndef NoNativeBinaries
+	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(LOCALOPT) $(CROSSOPT)' cycleclean compiler CYCLELEVEL=3
 endif
 endif
 endif
 cycledep:
 	$(MAKE) cycle USEDEPEND=1
 extcycle:
-	$(MAKE) cycle OPT='-n -OG2p3 -glttt -CRriot -dEXTDEBUG'
+	$(MAKE) cycle OPT="$(OPT) -n -OG2p3 -glttt -CRriot -dEXTDEBUG"
 cvstest:
 	$(MAKE) cycle 'LOCALOPT=-n -Se' 'RTLOPT=-n -Se'
 full: fullcycle
 fullcycle:
 	$(MAKE) cycle
 	$(MAKE) ppuclean
+ifneq ($(CPU_SOURCE),x86_64)
 	$(MAKE) $(filter-out $(PPC_TARGET),$(CYCLETARGETS)) 'FPC=$(BASEDIR)/$(EXENAME)'
+else
+	$(MAKE) $(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS))) 'FPC=$(BASEDIR)/$(EXENAME)'
+endif
 htmldocs:
 	$(PASDOC) -p -h -o html$(PATHSEP)$(PPC_TARGET) -d fpc -d gdb -d $(PPC_TARGET) -u $(PPC_TARGET) $(PPC_TARGET)$(PATHSEP)*.pas systems$(PATHSEP)*.pas *.pas
 .PHONY: quickinstall exeinstall install installsym
@@ -3762,8 +3812,12 @@ PPCCPULOCATION=$(INSTALL_BASEDIR)
 else
 PPCCPULOCATION=$(INSTALL_BINDIR)
 endif
-quickinstall: $(addsuffix _install,$(TARGET_DIRS))
-	$(MAKE) exeinstall
+ifndef NoNativeBinaries
+quickinstall: quickinstall_withutils
+else
+quickinstall: exeinstall
+endif
+quickinstall_withutils: $(addsuffix _install,$(TARGET_DIRS)) exeinstall
 exeinstall:
 ifneq ($(INSTALLEXEFILE),)
 ifdef UPXPROG

compiler/arm/aasmcpu.pas

@@ -668,7 +668,9 @@ implementation
           A_FMDHR,A_FMRDH,A_FMDLR,A_FMRDL,
           A_FNEGS,A_FNEGD,
           A_FSITOS,A_FSITOD,A_FTOSIS,A_FTOSID,
-          A_FTOUIS,A_FTOUID,A_FUITOS,A_FUITOD:
+          A_FTOUIS,A_FTOUID,A_FUITOS,A_FUITOD,
+          A_SXTB16,A_UXTB16,
+          A_UXTB,A_UXTH,A_SXTB,A_SXTH:
             if opnr=0 then
               result:=operand_write
             else

compiler/arm/agarmgas.pas

@@ -86,8 +86,14 @@ unit agarmgas;
           result:='-mfpu=vfpv3 '+result;
         if (current_settings.fputype = fpu_vfpv3_d16) then
           result:='-mfpu=vfpv3-d16 '+result;
-        if current_settings.cputype = cpu_armv7m then
-          result:='-march=armv7m -mthumb -mthumb-interwork '+result;
+
+        if current_settings.cputype=cpu_armv7m then
+          result:='-march=armv7m -mthumb -mthumb-interwork '+result
+        else if current_settings.cputype=cpu_armv6 then
+          result:='-march=armv6 '+result
+        else if current_settings.cputype=cpu_armv7 then
+          result:='-march=armv7-a '+result;
+
         if target_info.abi = abi_eabihf then
           { options based on what gcc uses on debian armhf }
           result:='-mfloat-abi=hard -meabi=5 '+result;

compiler/arm/aoptcpu.pas

@@ -261,7 +261,7 @@ Implementation
   function TCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean;
     var
       hp1,hp2: tai;
-      i: longint;
+      i, i2: longint;
       TmpUsedRegs: TAllUsedRegs;
       tempop: tasmop;
 
@@ -392,8 +392,6 @@ Implementation
                     { fold
                       mov reg1,reg0, shift imm1
                       mov reg1,reg1, shift imm2
-                      to
-                      mov reg1,reg0, shift imm1+imm2
                     }
                     if (taicpu(p).ops=3) and
                        (taicpu(p).oper[2]^.typ = top_shifterop) and
@@ -444,7 +442,9 @@ Implementation
                           to
                           mov reg1,reg0, shift imm1+imm2
                         }
-                        else if (taicpu(p).oper[2]^.shifterop^.shiftmode=taicpu(hp1).oper[2]^.shifterop^.shiftmode) then
+                        else if (taicpu(p).oper[2]^.shifterop^.shiftmode=taicpu(hp1).oper[2]^.shifterop^.shiftmode) or
+                          { asr makes no use after a lsr, the asr can be foled into the lsr }
+                           ((taicpu(p).oper[2]^.shifterop^.shiftmode=SM_LSR) and (taicpu(hp1).oper[2]^.shifterop^.shiftmode=SM_ASR) ) then
                           begin
                             inc(taicpu(p).oper[2]^.shifterop^.shiftimm,taicpu(hp1).oper[2]^.shifterop^.shiftimm);
                             { avoid overflows }
@@ -465,10 +465,78 @@ Implementation
                                 else
                                   internalerror(2008072803);
                               end;
-                            asml.insertbefore(tai_comment.Create(strpnew('Peephole ShiftShift2Shift done')), p);
+                            asml.insertbefore(tai_comment.Create(strpnew('Peephole ShiftShift2Shift 1 done')), p);
                             asml.remove(hp1);
                             hp1.free;
                             result := true;
+                          end
+                        { fold
+                          mov reg1,reg0, shift imm1
+                          mov reg1,reg1, shift imm2
+                          mov reg1,reg1, shift imm3 ...
+                        }
+                        else if getnextinstruction(hp1,hp2) and
+                          MatchInstruction(hp2, A_MOV, [taicpu(p).condition], [PF_None]) and
+                          (taicpu(hp2).ops=3) and
+                          MatchOperand(taicpu(hp2).oper[0]^, taicpu(hp1).oper[0]^.reg) and
+                          MatchOperand(taicpu(hp2).oper[1]^, taicpu(hp1).oper[0]^.reg) and
+                          (taicpu(hp2).oper[2]^.typ = top_shifterop) and
+                          (taicpu(hp2).oper[2]^.shifterop^.rs = NR_NO) then
+                          begin
+                            { mov reg1,reg0, lsl imm1
+                              mov reg1,reg1, lsr/asr imm2
+                              mov reg1,reg1, lsl imm3 ...
+
+                              if imm3<=imm1 and imm2>=imm3
+                              to
+                              mov reg1,reg0, lsl imm1
+                              mov reg1,reg1, lsr/asr imm2-imm3
+                            }
+                            if (taicpu(p).oper[2]^.shifterop^.shiftmode=SM_LSL) and (taicpu(hp2).oper[2]^.shifterop^.shiftmode=SM_LSL) and
+                              (taicpu(hp1).oper[2]^.shifterop^.shiftmode in [SM_ASR,SM_LSR]) and
+                              (taicpu(hp2).oper[2]^.shifterop^.shiftimm<=taicpu(p).oper[2]^.shifterop^.shiftimm) and
+                              (taicpu(hp1).oper[2]^.shifterop^.shiftimm>=taicpu(hp2).oper[2]^.shifterop^.shiftimm) then
+                              begin
+                                dec(taicpu(hp1).oper[2]^.shifterop^.shiftimm,taicpu(hp2).oper[2]^.shifterop^.shiftimm);
+                                asml.insertbefore(tai_comment.Create(strpnew('Peephole ShiftShiftShift2ShiftShift 1 done')), p);
+                                asml.remove(hp2);
+                                hp2.free;
+                                result := true;
+                                if taicpu(hp1).oper[2]^.shifterop^.shiftimm=0 then
+                                  begin
+                                    asml.remove(hp1);
+                                    hp1.free;
+                                  end;
+                              end
+                            { mov reg1,reg0, lsr/asr imm1
+                              mov reg1,reg1, lsl imm2
+                              mov reg1,reg1, lsr/asr imm3 ...
+
+                              if imm3>=imm1 and imm2>=imm1
+                              to
+                              mov reg1,reg0, lsl imm2-imm1
+                              mov reg1,reg1, lsr/asr imm3 ...
+                            }
+                            else if (taicpu(p).oper[2]^.shifterop^.shiftmode in [SM_ASR,SM_LSR]) and (taicpu(hp2).oper[2]^.shifterop^.shiftmode in [SM_ASR,SM_LSR]) and
+                              (taicpu(hp1).oper[2]^.shifterop^.shiftmode=SM_LSL) and
+                              (taicpu(hp2).oper[2]^.shifterop^.shiftimm>=taicpu(p).oper[2]^.shifterop^.shiftimm) and
+                              (taicpu(hp1).oper[2]^.shifterop^.shiftimm>=taicpu(p).oper[2]^.shifterop^.shiftimm) then
+                              begin
+                                dec(taicpu(hp1).oper[2]^.shifterop^.shiftimm,taicpu(p).oper[2]^.shifterop^.shiftimm);
+                                taicpu(hp1).oper[1]^.reg:=taicpu(p).oper[1]^.reg;
+                                asml.insertbefore(tai_comment.Create(strpnew('Peephole ShiftShiftShift2ShiftShift 2 done')), p);
+                                asml.remove(p);
+                                p.free;
+                                p:=hp2;
+                                if taicpu(hp1).oper[2]^.shifterop^.shiftimm=0 then
+                                  begin
+                                    taicpu(hp2).oper[1]^.reg:=taicpu(hp1).oper[1]^.reg;
+                                    asml.remove(hp1);
+                                    hp1.free;
+                                    p:=hp2;
+                                  end;
+                                result := true;
+                              end;
                           end;
                       end;
                     { Change the common
@@ -505,33 +573,58 @@ Implementation
                         hp1.free;
                       end;
 
-                    { 
-                      This changes the very common 
-                      mov r0, #0
-                      str r0, [...]
-                      mov r0, #0
-                      str r0, [...]
-
-                      and removes all superfluous mov instructions
+                    {
+                      optimize
+                      mov rX, yyyy
+                      ....
                     }
                     if (taicpu(p).ops = 2) and
-                       (taicpu(p).oper[1]^.typ = top_const) and
-                       GetNextInstruction(p,hp1) then
+                       GetNextInstruction(p,hp1) and
+                       (tai(hp1).typ = ait_instruction) then
                       begin
-                        while MatchInstruction(hp1, A_STR, [taicpu(p).condition], []) and
-                              MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[0]^) and
-                              GetNextInstruction(hp1, hp2) and
-                              MatchInstruction(hp2, A_MOV, [taicpu(p).condition], [PF_None]) and
-                              (taicpu(hp2).ops = 2) and
-                              MatchOperand(taicpu(hp2).oper[0]^, taicpu(p).oper[0]^) and
-                              MatchOperand(taicpu(hp2).oper[1]^, taicpu(p).oper[1]^) do
-                          begin
-                            asml.insertbefore(tai_comment.Create(strpnew('Peephole MovStrMov done')), hp2);
-                            GetNextInstruction(hp2,hp1);
-                            asml.remove(hp2);
-                            hp2.free;
-                            if not assigned(hp1) then break;
-                          end;
+                        {
+                          This changes the very common
+                          mov r0, #0
+                          str r0, [...]
+                          mov r0, #0
+                          str r0, [...]
+
+                          and removes all superfluous mov instructions
+                        }
+                        if (taicpu(p).oper[1]^.typ = top_const) and
+                           (taicpu(hp1).opcode=A_STR) then
+                          while MatchInstruction(hp1, A_STR, [taicpu(p).condition], []) and
+                                MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[0]^) and
+                                GetNextInstruction(hp1, hp2) and
+                                MatchInstruction(hp2, A_MOV, [taicpu(p).condition], [PF_None]) and
+                                (taicpu(hp2).ops = 2) and
+                                MatchOperand(taicpu(hp2).oper[0]^, taicpu(p).oper[0]^) and
+                                MatchOperand(taicpu(hp2).oper[1]^, taicpu(p).oper[1]^) do
+                            begin
+                              asml.insertbefore(tai_comment.Create(strpnew('Peephole MovStrMov done')), hp2);
+                              GetNextInstruction(hp2,hp1);
+                              asml.remove(hp2);
+                              hp2.free;
+                              if not assigned(hp1) then break;
+                            end
+                        {
+                          This removes the first mov from
+                          mov rX,...
+                          mov rX,...
+                        }
+                        else if taicpu(hp1).opcode=A_MOV then
+                          while MatchInstruction(hp1, A_MOV, [taicpu(p).condition], [taicpu(p).oppostfix]) and
+                                (taicpu(hp1).ops = 2) and
+                                MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[0]^) do
+                            begin
+                              asml.insertbefore(tai_comment.Create(strpnew('Peephole MovMov done')), p);
+                              asml.remove(p);
+                              p.free;
+                              p:=hp1;
+                              GetNextInstruction(hp1,hp1);
+                              if not assigned(hp1) then
+                                break;
+                            end;
                       end;
                     {
                       change
@@ -593,25 +686,34 @@ Implementation
                        (taicpu(p).oppostfix = PF_NONE) and
                        GetNextInstruction(p, hp1) and
                        (tai(hp1).typ = ait_instruction) and
-                       (taicpu(hp1).ops = 3) and {Currently we can't fold into another shifterop}
-                       (taicpu(hp1).oper[2]^.typ = top_reg) and
+                       (taicpu(hp1).ops >= 2) and {Currently we can't fold into another shifterop}
+                       (taicpu(hp1).oper[taicpu(hp1).ops-1]^.typ = top_reg) and
                        (taicpu(hp1).oppostfix = PF_NONE) and
                        (taicpu(hp1).condition = taicpu(p).condition) and
                        (taicpu(hp1).opcode in [A_ADD, A_ADC, A_RSB, A_RSC, A_SUB, A_SBC,
-                                               A_AND, A_BIC, A_EOR, A_ORR, A_TEQ, A_TST]) and
+                                               A_AND, A_BIC, A_EOR, A_ORR, A_TEQ, A_TST,
+                                               A_CMP, A_CMN]) and
                        (
                          {Only ONE of the two src operands is allowed to match}
-                         MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[1]^) xor
-                         MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[2]^)
+                         MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[taicpu(hp1).ops-2]^) xor
+                         MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[taicpu(hp1).ops-1]^)
                        ) then
                       begin
                         CopyUsedRegs(TmpUsedRegs);
                         UpdateUsedRegs(TmpUsedRegs, tai(p.next));
+                        if taicpu(hp1).opcode in [A_TST, A_TEQ, A_CMN] then
+                          I2:=0
+                        else
+                          I2:=1;
                         if not(RegUsedAfterInstruction(taicpu(p).oper[0]^.reg,hp1,TmpUsedRegs)) then
-                          for I:=1 to 2 do
+                          for I:=I2 to taicpu(hp1).ops-1 do
                             if MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[I]^.reg) then
                               begin
-                                if I = 1 then
+                                { If the parameter matched on the second op from the RIGHT
+                                  we have to switch the parameters, this will not happen for CMP
+                                  were we're only evaluating the most right parameter
+                                }
+                                if I <> taicpu(hp1).ops-1 then
                                   begin
                                     {The SUB operators need to be changed when we swap parameters}
                                     case taicpu(hp1).opcode of
@@ -621,14 +723,24 @@ Implementation
                                       A_RSC: tempop:=A_SBC;
                                       else tempop:=taicpu(hp1).opcode;
                                     end;
-                                    hp2:=taicpu.op_reg_reg_reg_shifterop(tempop,
-                                         taicpu(hp1).oper[0]^.reg, taicpu(hp1).oper[2]^.reg,
-                                         taicpu(p).oper[1]^.reg, taicpu(p).oper[2]^.shifterop^);
+                                    if taicpu(hp1).ops = 3 then
+                                      hp2:=taicpu.op_reg_reg_reg_shifterop(tempop,
+                                           taicpu(hp1).oper[0]^.reg, taicpu(hp1).oper[2]^.reg,
+                                           taicpu(p).oper[1]^.reg, taicpu(p).oper[2]^.shifterop^)
+                                    else
+                                      hp2:=taicpu.op_reg_reg_shifterop(tempop,
+                                           taicpu(hp1).oper[0]^.reg, taicpu(p).oper[1]^.reg,
+                                           taicpu(p).oper[2]^.shifterop^);
                                   end
                                 else
-                                  hp2:=taicpu.op_reg_reg_reg_shifterop(taicpu(hp1).opcode,
-                                       taicpu(hp1).oper[0]^.reg, taicpu(hp1).oper[1]^.reg,
-                                       taicpu(p).oper[1]^.reg, taicpu(p).oper[2]^.shifterop^);
+                                  if taicpu(hp1).ops = 3 then
+                                    hp2:=taicpu.op_reg_reg_reg_shifterop(taicpu(hp1).opcode,
+                                         taicpu(hp1).oper[0]^.reg, taicpu(hp1).oper[1]^.reg,
+                                         taicpu(p).oper[1]^.reg, taicpu(p).oper[2]^.shifterop^)
+                                  else
+                                    hp2:=taicpu.op_reg_reg_shifterop(taicpu(hp1).opcode,
+                                         taicpu(hp1).oper[0]^.reg, taicpu(p).oper[1]^.reg,
+                                         taicpu(p).oper[2]^.shifterop^);
                                 asml.insertbefore(hp2, p);
                                 asml.remove(p);
                                 asml.remove(hp1);

compiler/arm/cgcpu.pas

@@ -211,9 +211,16 @@ unit cgcpu;
         inherited init_register_allocators;
         { currently, we always save R14, so we can use it }
         if (target_info.system<>system_arm_darwin) then
-          rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE,
-              [RS_R0,RS_R1,RS_R2,RS_R3,RS_R12,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,
-               RS_R9,RS_R10,RS_R14],first_int_imreg,[])
+            begin
+              if assigned(current_procinfo) and (current_procinfo.framepointer<>NR_R11) then
+                rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE,
+                    [RS_R0,RS_R1,RS_R2,RS_R3,RS_R12,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,
+                     RS_R9,RS_R10,RS_R11,RS_R14],first_int_imreg,[])
+              else
+                rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE,
+                    [RS_R0,RS_R1,RS_R2,RS_R3,RS_R12,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,
+                     RS_R9,RS_R10,RS_R14],first_int_imreg,[])
+            end
         else
           { r7 is not available on Darwin, it's used as frame pointer (always,
             for backtrace support -- also in gcc/clang -> R11 can be used).
@@ -756,6 +763,13 @@ unit cgcpu;
                 so.shiftimm:=l1;
                 list.concat(taicpu.op_reg_reg_reg_shifterop(A_RSB,dst,src,src,so));
               end
+            { x := y and 0; just clears a register, this sometimes gets generated on 64bit ops.
+              Just using mov x, #0 might allow some easier optimizations down the line. }
+            else if (op = OP_AND) and (dword(a)=0) then
+              list.concat(taicpu.op_reg_const(A_MOV,dst,0))
+            { x := y AND $FFFFFFFF just copies the register, so use mov for better optimizations }
+            else if (op = OP_AND) and (not(dword(a))=0) then
+              list.concat(taicpu.op_reg_reg(A_MOV,dst,src))
             { BIC clears the specified bits, while AND keeps them, using BIC allows to use a
               broader range of shifterconstants.}
             else if (op = OP_AND) and is_shifter_const(not(dword(a)),shift) then
@@ -926,9 +940,7 @@ unit cgcpu;
            ((op in [A_LDF,A_STF,A_FLDS,A_FLDD,A_FSTS,A_FSTD]) and
             ((ref.offset<-1020) or
              (ref.offset>1020) or
-             ((abs(ref.offset) mod 4)<>0) or
-             { the usual pc relative symbol handling assumes possible offsets of +/- 4095 }
-             assigned(ref.symbol)
+             ((abs(ref.offset) mod 4)<>0)
             )
            ) then
           begin
@@ -979,7 +991,10 @@ unit cgcpu;
             ref.symbol:=nil;
           end;
 
-        if (ref.base<>NR_NO) and (ref.index<>NR_NO) and (ref.offset<>0) then
+        { fold if there is base, index and offset, however, don't fold
+          for vfp memory instructions because we later fold the index }
+        if not(op in [A_FLDS,A_FLDD,A_FSTS,A_FSTD]) and
+           (ref.base<>NR_NO) and (ref.index<>NR_NO) and (ref.offset<>0) then
           begin
             if tmpreg<>NR_NO then
               a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref.offset,tmpreg,tmpreg)
@@ -1189,33 +1204,58 @@ unit cgcpu;
              conv_done:=true;
              if tcgsize2size[tosize]<=tcgsize2size[fromsize] then
                fromsize:=tosize;
-             case fromsize of
-               OS_8:
-                 list.concat(taicpu.op_reg_reg_const(A_AND,reg2,reg1,$ff));
-               OS_S8:
-                 begin
-                   do_shift(SM_LSL,24,reg1);
-                   if tosize=OS_16 then
-                     begin
-                       do_shift(SM_ASR,8,reg2);
-                       do_shift(SM_LSR,16,reg2);
-                     end
-                   else
-                     do_shift(SM_ASR,24,reg2);
-                 end;
-               OS_16:
-                 begin
-                   do_shift(SM_LSL,16,reg1);
-                   do_shift(SM_LSR,16,reg2);
-                 end;
-               OS_S16:
-                 begin
-                   do_shift(SM_LSL,16,reg1);
-                   do_shift(SM_ASR,16,reg2)
-                 end;
-               else
-                 conv_done:=false;
-             end;
+             if current_settings.cputype<cpu_armv6 then
+               case fromsize of
+                 OS_8:
+                   list.concat(taicpu.op_reg_reg_const(A_AND,reg2,reg1,$ff));
+                 OS_S8:
+                   begin
+                     do_shift(SM_LSL,24,reg1);
+                     if tosize=OS_16 then
+                       begin
+                         do_shift(SM_ASR,8,reg2);
+                         do_shift(SM_LSR,16,reg2);
+                       end
+                     else
+                       do_shift(SM_ASR,24,reg2);
+                   end;
+                 OS_16:
+                   begin
+                     do_shift(SM_LSL,16,reg1);
+                     do_shift(SM_LSR,16,reg2);
+                   end;
+                 OS_S16:
+                   begin
+                     do_shift(SM_LSL,16,reg1);
+                     do_shift(SM_ASR,16,reg2)
+                   end;
+                 else
+                   conv_done:=false;
+               end
+             else
+               case fromsize of
+                 OS_8:
+                   list.concat(taicpu.op_reg_reg_const(A_AND,reg2,reg1,$ff));
+                 OS_S8:
+                   begin
+                     if tosize=OS_16 then
+                       begin
+                         so.shiftmode:=SM_ROR;
+                         so.shiftimm:=16;
+                         list.concat(taicpu.op_reg_reg_shifterop(A_SXTB16,reg2,reg1,so));
+                         do_shift(SM_LSR,16,reg2);
+                       end
+                     else
+                       list.concat(taicpu.op_reg_reg(A_SXTB,reg2,reg1));
+                   end;
+                 OS_16:
+                   list.concat(taicpu.op_reg_reg(A_UXTH,reg2,reg1));
+                 OS_S16:
+                   list.concat(taicpu.op_reg_reg(A_SXTH,reg2,reg1));
+                 else
+                   conv_done:=false;
+               end
+
            end;
          if not conv_done and (reg1<>reg2) then
            begin
@@ -1402,6 +1442,7 @@ unit cgcpu;
          r7offset,
          stackmisalignment : pint;
          postfix: toppostfix;
+         imm1, imm2: DWord;
       begin
         LocalSize:=align(LocalSize,4);
         { call instruction does not put anything on the stack }
@@ -1529,18 +1570,24 @@ unit cgcpu;
                  (po_assembler in current_procinfo.procdef.procoptions))) then
               begin
                 localsize:=align(localsize+stackmisalignment,current_settings.alignment.localalignmax)-stackmisalignment;
-                if not(is_shifter_const(localsize,shift)) then
+                if is_shifter_const(localsize,shift) then
                   begin
-                    if current_procinfo.framepointer=NR_STACK_POINTER_REG then
-                      a_reg_alloc(list,NR_R12);
-                    a_load_const_reg(list,OS_ADDR,LocalSize,NR_R12);
-                    list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12));
                     a_reg_dealloc(list,NR_R12);
+                    list.concat(taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,LocalSize));
+                  end
+                else if split_into_shifter_const(localsize, imm1, imm2) then
+                  begin
+                    a_reg_dealloc(list,NR_R12);
+                    list.concat(taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,imm1));
+                    list.concat(taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,imm2));
                   end
                 else
                   begin
+                    if current_procinfo.framepointer=NR_STACK_POINTER_REG then
+                      a_reg_alloc(list,NR_R12);
+                    a_load_const_reg(list,OS_ADDR,LocalSize,NR_R12);
+                    list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12));
                     a_reg_dealloc(list,NR_R12);
-                    list.concat(taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,LocalSize));
                   end;
               end;
 
@@ -1607,6 +1654,7 @@ unit cgcpu;
          regs : tcpuregisterset;
          stackmisalignment: pint;
          mmpostfix: toppostfix;
+         imm1, imm2: DWord;
       begin
         if not(nostackframe) then
           begin
@@ -1738,16 +1786,19 @@ unit cgcpu;
                      (po_assembler in current_procinfo.procdef.procoptions))) then
                   begin
                     localsize:=align(localsize+stackmisalignment,current_settings.alignment.localalignmax)-stackmisalignment;
-                    if not(is_shifter_const(LocalSize,shift)) then
+                    if is_shifter_const(LocalSize,shift) then
+                      list.concat(taicpu.op_reg_reg_const(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,LocalSize))
+                    else if split_into_shifter_const(localsize, imm1, imm2) then
+                      begin
+                        list.concat(taicpu.op_reg_reg_const(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,imm1));
+                        list.concat(taicpu.op_reg_reg_const(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,imm2));
+                      end
+                    else
                       begin
                         a_reg_alloc(list,NR_R12);
                         a_load_const_reg(list,OS_ADDR,LocalSize,NR_R12);
                         list.concat(taicpu.op_reg_reg_reg(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12));
                         a_reg_dealloc(list,NR_R12);
-                      end
-                    else
-                      begin
-                        list.concat(taicpu.op_reg_reg_const(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,LocalSize));
                       end;
                   end;
 
@@ -3366,13 +3417,9 @@ unit cgcpu;
     procedure Tthumb2cgarm.g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister);
       var item: taicpu;
       begin
-        item := setcondition(taicpu.op_reg_const(A_MOV,reg,1),flags_to_cond(f));
-        list.concat(item);
-        list.insertbefore(taicpu.op_cond(A_IT, flags_to_cond(f)), item);
-
-        item := setcondition(taicpu.op_reg_const(A_MOV,reg,0),inverse_cond(flags_to_cond(f)));
-        list.concat(item);
-        list.insertbefore(taicpu.op_cond(A_IT, inverse_cond(flags_to_cond(f))), item);
+        list.concat(taicpu.op_cond(A_ITE, flags_to_cond(f)));
+        list.concat(setcondition(taicpu.op_reg_const(A_MOV,reg,1),flags_to_cond(f)));
+        list.concat(setcondition(taicpu.op_reg_const(A_MOV,reg,0),inverse_cond(flags_to_cond(f))));
       end;
 
 

compiler/arm/cpuinfo.pas

@@ -67,6 +67,11 @@ Type
       ct_lpc2114,
       ct_lpc2124,
       ct_lpc2194,
+      ct_lpc1754,
+      ct_lpc1756,
+      ct_lpc1758,
+      ct_lpc1764,
+      ct_lpc1766,
       ct_lpc1768,
 
       { ATMEL }
@@ -255,12 +260,62 @@ Const
         sramsize:$00004000
     	),
 
+        (
+    	controllertypestr:'LPC1754';
+        controllerunitstr:'LPC1754';
+        interruptvectors:12;
+    	flashbase:$00000000;
+        flashsize:$00020000;
+        srambase:$10000000;
+        sramsize:$00004000
+    	),
+
+        (
+    	controllertypestr:'LPC1756';
+        controllerunitstr:'LPC1756';
+        interruptvectors:12;
+    	flashbase:$00000000;
+        flashsize:$00040000;
+        srambase:$10000000;
+        sramsize:$00004000
+    	),
+
+        (
+    	controllertypestr:'LPC1758';
+        controllerunitstr:'LPC1758';
+        interruptvectors:12;
+    	flashbase:$00000000;
+        flashsize:$00080000;
+        srambase:$10000000;
+        sramsize:$00008000
+    	),
+
+        (
+    	controllertypestr:'LPC1764';
+        controllerunitstr:'LPC1764';
+        interruptvectors:12;
+    	flashbase:$00000000;
+        flashsize:$00020000;
+        srambase:$10000000;
+        sramsize:$00004000
+    	),
+
+        (
+    	controllertypestr:'LPC1766';
+        controllerunitstr:'LPC1766';
+        interruptvectors:12;
+    	flashbase:$00000000;
+        flashsize:$00040000;
+        srambase:$10000000;
+        sramsize:$00008000
+    	),
+
         (
     	controllertypestr:'LPC1768';
         controllerunitstr:'LPC1768';
         interruptvectors:12;
     	flashbase:$00000000;
-        flashsize:$00040000;
+        flashsize:$00080000;
         srambase:$10000000;
         sramsize:$00008000
     	),
@@ -1026,7 +1081,7 @@ Const
                                  { no need to write info about those }
                                  [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
                                  [cs_opt_regvar,cs_opt_loopunroll,cs_opt_tailrecursion,
-								  cs_opt_stackframe,cs_opt_nodecse];
+				  cs_opt_stackframe,cs_opt_nodecse,cs_opt_reorder_fields,cs_opt_fastmath];
 
    level1optimizerswitches = genericlevel1optimizerswitches;
    level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches +

compiler/arm/cpupara.pas

@@ -42,12 +42,11 @@ unit cpupara;
           procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
-          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
+          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
          private
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword; var sparesinglereg: tregister);
           function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
             var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword; var sparesinglereg: tregister; isvariadic: boolean):longint;
-          procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
        end;
 
   implementation
@@ -346,7 +345,7 @@ unit cpupara;
 
             { currently only support C-style array of const,
               there should be no location assigned to the vararg array itself }
-            if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
+            if (p.proccalloption in cstylearrayofconst) and
                is_array_of_const(paradef) then
               begin
                 paraloc:=hp.paraloc[side].add_location;
@@ -576,23 +575,17 @@ unit cpupara;
       end;
 
 
-    procedure tarmparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
-      begin
-        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
-      end;
-
-
-    function  tarmparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;
+    function  tarmparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       var
         paraloc : pcgparalocation;
         retcgsize  : tcgsize;
       begin
-         if set_common_funcretloc_info(p,def,retcgsize,result) then
+         if set_common_funcretloc_info(p,forcetempdef,retcgsize,result) then
            exit;
 
         paraloc:=result.add_location;
         { Return in FPU register? }
-        if def.typ=floatdef then
+        if result.def.typ=floatdef then
           begin
             if target_info.abi = abi_eabihf then 
               begin
@@ -708,7 +701,7 @@ unit cpupara;
         init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg);
 
         result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,true);
-        if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+        if (p.proccalloption in cstylearrayofconst) then
           { just continue loading the parameters in the registers }
           result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,true)
         else

compiler/arm/narmadd.pas

@@ -47,13 +47,16 @@ interface
     uses
       globtype,systems,
       cutils,verbose,globals,
+      constexp,
       symconst,symdef,paramgr,
       aasmbase,aasmtai,aasmdata,aasmcpu,defutil,htypechk,
       cgbase,cgutils,cgcpu,
       cpuinfo,pass_1,pass_2,regvars,procinfo,
       cpupara,
       ncon,nset,nadd,
-      ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32;
+      ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32,
+      hlcgobj
+      ;
 
 {*****************************************************************************
                                TSparcAddNode
@@ -286,7 +289,8 @@ interface
 
         location_reset(location,LOC_FLAGS,OS_NO);
 
-        force_reg_left_right(false,false);
+        hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+        hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true);
 
         case nodetype of
           equaln:
@@ -322,60 +326,93 @@ interface
       var
         unsigned : boolean;
         oldnodetype : tnodetype;
+        dummyreg : tregister;
+        l: tasmlabel;
       begin
-        pass_left_right;
-        force_reg_left_right(false,false);
-
         unsigned:=not(is_signed(left.resultdef)) or
                   not(is_signed(right.resultdef));
 
-        { operation requiring proper N, Z and C flags ? }
-        if unsigned or (nodetype in [equaln,unequaln]) then
+        pass_left_right;
+
+        if (nodetype in [equaln,unequaln]) and
+          (left.nodetype=ordconstn) and (tordconstnode(left).value=0) then
           begin
             location_reset(location,LOC_FLAGS,OS_NO);
             location.resflags:=getresflags(unsigned);
-            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi));
-            if current_settings.cputype in cpu_thumb2 then
-              current_asmdata.CurrAsmList.concat(taicpu.op_cond(A_IT, C_EQ));
-            current_asmdata.CurrAsmList.concat(setcondition(taicpu.op_reg_reg(A_CMP,left.location.register64.reglo,right.location.register64.reglo),C_EQ));
+            if not(right.location.loc in [LOC_CREGISTER,LOC_REGISTER]) then
+              hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true);
+            dummyreg:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
+            current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ORR,dummyreg,right.location.register64.reglo,right.location.register64.reghi),PF_S));
+          end
+        else if (nodetype in [equaln,unequaln]) and
+          (right.nodetype=ordconstn) and (tordconstnode(right).value=0) then
+          begin
+            location_reset(location,LOC_FLAGS,OS_NO);
+            location.resflags:=getresflags(unsigned);
+            if not(left.location.loc in [LOC_CREGISTER,LOC_REGISTER]) then
+              hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+            dummyreg:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
+            current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ORR,dummyreg,left.location.register64.reglo,left.location.register64.reghi),PF_S));
           end
         else
-        { operation requiring proper N, Z and V flags ? }
           begin
-            location_reset(location,LOC_JUMP,OS_NO);
-            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi));
-            { the jump the sequence is a little bit hairy }
-            case nodetype of
-               ltn,gtn:
-                 begin
-                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(false),current_procinfo.CurrTrueLabel);
-                    { cheat a little bit for the negative test }
-                    toggleflag(nf_swapped);
-                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(false),current_procinfo.CurrFalseLabel);
-                    toggleflag(nf_swapped);
-                 end;
-               lten,gten:
-                 begin
-                    oldnodetype:=nodetype;
-                    if nodetype=lten then
-                      nodetype:=ltn
-                    else
-                      nodetype:=gtn;
-                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel);
-                    { cheat for the negative test }
-                    if nodetype=ltn then
-                      nodetype:=gtn
-                    else
-                      nodetype:=ltn;
-                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel);
-                    nodetype:=oldnodetype;
-                 end;
-            end;
-            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reglo,right.location.register64.reglo));
-            { the comparisaion of the low dword have to be
-               always unsigned!                            }
-            cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(true),current_procinfo.CurrTrueLabel);
-            cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
+            hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+            hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true);
+
+            { operation requiring proper N, Z and C flags ? }
+            if unsigned or (nodetype in [equaln,unequaln]) then
+              begin
+                location_reset(location,LOC_FLAGS,OS_NO);
+                location.resflags:=getresflags(unsigned);
+                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi));
+                if current_settings.cputype in cpu_thumb2 then
+                  begin
+                    current_asmdata.getjumplabel(l);
+                    cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,l);
+                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reglo,right.location.register64.reglo));
+                    cg.a_label(current_asmdata.CurrAsmList,l);
+                  end
+                else
+                  current_asmdata.CurrAsmList.concat(setcondition(taicpu.op_reg_reg(A_CMP,left.location.register64.reglo,right.location.register64.reglo),C_EQ));
+              end
+            else
+            { operation requiring proper N, Z and V flags ? }
+              begin
+                location_reset(location,LOC_JUMP,OS_NO);
+                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi));
+                { the jump the sequence is a little bit hairy }
+                case nodetype of
+                   ltn,gtn:
+                     begin
+                        cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(false),current_procinfo.CurrTrueLabel);
+                        { cheat a little bit for the negative test }
+                        toggleflag(nf_swapped);
+                        cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(false),current_procinfo.CurrFalseLabel);
+                        toggleflag(nf_swapped);
+                     end;
+                   lten,gten:
+                     begin
+                        oldnodetype:=nodetype;
+                        if nodetype=lten then
+                          nodetype:=ltn
+                        else
+                          nodetype:=gtn;
+                        cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel);
+                        { cheat for the negative test }
+                        if nodetype=ltn then
+                          nodetype:=gtn
+                        else
+                          nodetype:=ltn;
+                        cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel);
+                        nodetype:=oldnodetype;
+                     end;
+                end;
+                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reglo,right.location.register64.reglo));
+                { the comparisaion of the low dword have to be
+                   always unsigned!                            }
+                cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(true),current_procinfo.CurrTrueLabel);
+                cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
+              end;
           end;
       end;
 

compiler/arm/narmmat.pas

@@ -356,7 +356,10 @@ implementation
 
     function tarmshlshrnode.first_shlshr64bitint: tnode;
       begin
-        result := nil;
+        if (current_settings.cputype in cpu_thumb2) then
+          result:=inherited
+        else
+          result := nil;
       end;
 
     procedure tarmshlshrnode.second_64bit;
@@ -423,6 +426,12 @@ implementation
         end;
 
       begin
+        if (current_settings.cputype in cpu_thumb2) then
+        begin
+          inherited;
+          exit;
+        end;
+
         location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
 
         { load left operator in a register }

compiler/arm/narmset.pas

@@ -180,7 +180,9 @@ implementation
                   else
                     begin
                       tcgarm(cg).cgsetflags:=true;
-                      cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opcgsize, aint(int64(t^._low-last)), hregister);
+                      { use OS_32 here to avoid uncessary sign extensions, at this place hregister will never be negative, because
+                        then genlinearlist wouldn't be used }
+                      cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, OS_32, aint(int64(t^._low-last)), hregister);
                       tcgarm(cg).cgsetflags:=false;
                       cg.a_jmp_flags(current_asmdata.CurrAsmList,F_EQ,blocklabel(t^.blockid));
                     end;
@@ -198,7 +200,9 @@ implementation
                        if (t^._low>get_min_value(left.resultdef)) or (get_min_value(left.resultdef)<>0) then
                          begin
                            tcgarm(cg).cgsetflags:=true;
-                           cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opcgsize, aint(int64(t^._low)), hregister);
+                           { use OS_32 here to avoid uncessary sign extensions, at this place hregister will never be negative, because
+                             then genlinearlist wouldn't be use }
+                           cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, OS_32, aint(int64(t^._low)), hregister);
                            tcgarm(cg).cgsetflags:=false;
                          end;
                     end
@@ -209,7 +213,9 @@ implementation
                       { immediately. else check the range in between:       }
 
                       tcgarm(cg).cgsetflags:=true;
-                      cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opcgsize, aint(int64(t^._low-last)), hregister);
+                      { use OS_32 here to avoid uncessary sign extensions, at this place hregister will never be negative, because
+                        then genlinearlist wouldn't be use }
+                      cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, OS_32, aint(int64(t^._low-last)), hregister);
                       tcgarm(cg).cgsetflags:=false;
                       { no jump necessary here if the new range starts at }
                       { at the value following the previous one           }
@@ -218,7 +224,9 @@ implementation
                         cg.a_jmp_flags(current_asmdata.CurrAsmList,cond_lt,elselabel);
                     end;
                   tcgarm(cg).cgsetflags:=true;
-                  cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,opcgsize,aint(int64(t^._high-t^._low)),hregister);
+                  { use OS_32 here to avoid uncessary sign extensions, at this place hregister will never be negative, because
+                    then genlinearlist wouldn't be use }
+                  cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_32,aint(int64(t^._high-t^._low)),hregister);
                   tcgarm(cg).cgsetflags:=false;
                   cg.a_jmp_flags(current_asmdata.CurrAsmList,cond_le,blocklabel(t^.blockid));
 

compiler/arm/raarmgas.pas

@@ -978,7 +978,7 @@ Unit raarmgas;
           case actasmtoken of
             AS_COMMA: { Operand delimiter }
               Begin
-                if ((instr.opcode=A_MOV) and (operandnum=2)) or
+                if ((instr.opcode in [A_MOV, A_MVN, A_CMP, A_CMN, A_TST, A_TEQ]) and (operandnum=2)) or
                   ((operandnum=3) and not(instr.opcode in [A_UMLAL,A_UMULL,A_SMLAL,A_SMULL,A_MLA])) then
                   begin
                     Consume(AS_COMMA);

compiler/arm/rgcpu.pas

@@ -35,6 +35,9 @@ unit rgcpu;
 
      type
        trgcpu = class(trgobj)
+       private
+         procedure spilling_create_load_store(list: TAsmList; pos: tai; const spilltemp:treference;tempreg:tregister; is_store: boolean);
+       public
          procedure do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
          procedure do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
          procedure add_constraints(reg:tregister);override;
@@ -122,13 +125,70 @@ unit rgcpu;
           end;
       end;
 
-
-    procedure trgcpu.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
+    procedure trgcpu.spilling_create_load_store(list: TAsmList; pos: tai; const spilltemp:treference;tempreg:tregister; is_store: boolean);
       var
         tmpref : treference;
         helplist : TAsmList;
         l : tasmlabel;
         hreg : tregister;
+        immshift: byte;
+        a: aint;
+    begin
+      helplist:=TAsmList.create;
+
+      { load consts entry }
+      if getregtype(tempreg)=R_INTREGISTER then
+        hreg:=getregisterinline(helplist,[R_SUBWHOLE])
+      else
+        hreg:=cg.getintregister(helplist,OS_ADDR);
+
+      { Lets remove the bits we can fold in later and check if the result can be easily with an add or sub }
+      a:=abs(spilltemp.offset);
+      if is_shifter_const(a and not($FFF), immshift) then
+        if spilltemp.offset > 0 then
+          begin
+            {$ifdef DEBUG_SPILLING}
+            helplist.concat(tai_comment.create(strpnew('Spilling: Use ADD to fix spill offset')));
+            {$endif}
+            helplist.concat(taicpu.op_reg_reg_const(A_ADD, hreg, current_procinfo.framepointer,
+                                                      a and not($FFF)));
+            reference_reset_base(tmpref, hreg, a and $FFF, sizeof(aint));
+          end
+        else
+          begin
+            {$ifdef DEBUG_SPILLING}
+            helplist.concat(tai_comment.create(strpnew('Spilling: Use SUB to fix spill offset')));
+            {$endif}
+            helplist.concat(taicpu.op_reg_reg_const(A_SUB, hreg, current_procinfo.framepointer,
+                                                      a and not($FFF)));
+            reference_reset_base(tmpref, hreg, -(a and $FFF), sizeof(aint));
+          end
+      else
+        begin
+          {$ifdef DEBUG_SPILLING}
+          helplist.concat(tai_comment.create(strpnew('Spilling: Use a_load_const_reg to fix spill offset')));
+          {$endif}
+          cg.a_load_const_reg(helplist,OS_ADDR,spilltemp.offset,hreg);
+          reference_reset_base(tmpref,current_procinfo.framepointer,0,sizeof(aint));
+          tmpref.index:=hreg;
+        end;
+
+      if spilltemp.index<>NR_NO then
+        internalerror(200401263);
+
+      if is_store then
+        helplist.concat(spilling_create_store(tempreg,tmpref))
+      else
+        helplist.concat(spilling_create_load(tmpref,tempreg));
+
+      if getregtype(tempreg)=R_INTREGISTER then
+        ungetregisterinline(helplist,hreg);
+
+      list.insertlistafter(pos,helplist);
+      helplist.free;
+    end;
+
+    procedure trgcpu.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
       begin
         { don't load spilled register between
           mov lr,pc
@@ -145,85 +205,16 @@ unit rgcpu;
           pos:=tai(pos.previous);
 
         if abs(spilltemp.offset)>4095 then
-          begin
-            helplist:=TAsmList.create;
-            reference_reset(tmpref,sizeof(aint));
-            { create consts entry }
-            current_asmdata.getjumplabel(l);
-            cg.a_label(current_procinfo.aktlocaldata,l);
-            tmpref.symboldata:=current_procinfo.aktlocaldata.last;
-
-            current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(spilltemp.offset));
-
-            { load consts entry }
-            if getregtype(tempreg)=R_INTREGISTER then
-              hreg:=getregisterinline(helplist,[R_SUBWHOLE])
-            else
-              hreg:=cg.getintregister(helplist,OS_ADDR);
-
-            tmpref.symbol:=l;
-            tmpref.base:=NR_R15;
-            helplist.concat(taicpu.op_reg_ref(A_LDR,hreg,tmpref));
-
-            reference_reset_base(tmpref,current_procinfo.framepointer,0,sizeof(aint));
-            tmpref.index:=hreg;
-
-            if spilltemp.index<>NR_NO then
-              internalerror(200401263);
-
-            helplist.concat(spilling_create_load(tmpref,tempreg));
-            if getregtype(tempreg)=R_INTREGISTER then
-              ungetregisterinline(helplist,hreg);
-
-            list.insertlistafter(pos,helplist);
-            helplist.free;
-          end
+          spilling_create_load_store(list, pos, spilltemp, tempreg, false)
         else
           inherited do_spill_read(list,pos,spilltemp,tempreg);
       end;
 
 
     procedure trgcpu.do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
-      var
-        tmpref : treference;
-        helplist : TAsmList;
-        l : tasmlabel;
-        hreg : tregister;
       begin
         if abs(spilltemp.offset)>4095 then
-          begin
-            helplist:=TAsmList.create;
-            reference_reset(tmpref,sizeof(aint));
-            { create consts entry }
-            current_asmdata.getjumplabel(l);
-            cg.a_label(current_procinfo.aktlocaldata,l);
-            tmpref.symboldata:=current_procinfo.aktlocaldata.last;
-
-            current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(spilltemp.offset));
-
-            { load consts entry }
-            if getregtype(tempreg)=R_INTREGISTER then
-              hreg:=getregisterinline(helplist,[R_SUBWHOLE])
-            else
-              hreg:=cg.getintregister(helplist,OS_ADDR);
-            tmpref.symbol:=l;
-            tmpref.base:=NR_R15;
-            helplist.concat(taicpu.op_reg_ref(A_LDR,hreg,tmpref));
-
-            if spilltemp.index<>NR_NO then
-              internalerror(200401263);
-
-            reference_reset_base(tmpref,current_procinfo.framepointer,0,sizeof(pint));
-            tmpref.index:=hreg;
-
-            helplist.concat(spilling_create_store(tempreg,tmpref));
-
-            if getregtype(tempreg)=R_INTREGISTER then
-              ungetregisterinline(helplist,hreg);
-
-            list.insertlistafter(pos,helplist);
-            helplist.free;
-          end
+          spilling_create_load_store(list, pos, spilltemp, tempreg, true)
         else
           inherited do_spill_written(list,pos,spilltemp,tempreg);
       end;

compiler/assemble.pas

@@ -1107,6 +1107,9 @@ Implementation
                        short jumps to become out of range }
                      Tai_align_abstract(hp).fillsize:=Tai_align_abstract(hp).aligntype;
                      ObjData.alloc(Tai_align_abstract(hp).fillsize);
+                     { may need to increase alignment of section }
+                     if tai_align_abstract(hp).aligntype>ObjData.CurrObjSec.secalign then
+                       ObjData.CurrObjSec.secalign:=tai_align_abstract(hp).aligntype;
                    end
                  else
                    Tai_align_abstract(hp).fillsize:=0;
@@ -1353,6 +1356,8 @@ Implementation
            case hp.typ of
              ait_align :
                begin
+                 if tai_align_abstract(hp).aligntype>ObjData.CurrObjSec.secalign then
+                   InternalError(2012072301);
                  if oso_data in ObjData.CurrObjSec.secoptions then
                    ObjData.writebytes(Tai_align_abstract(hp).calculatefillbuf(fillbuffer,oso_executable in ObjData.CurrObjSec.secoptions)^,
                      Tai_align_abstract(hp).fillsize)

compiler/avr/cpuinfo.pas

@@ -188,7 +188,7 @@ Const
                                  { no need to write info about those }
                                  [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
                                  [cs_opt_regvar,cs_opt_loopunroll,cs_opt_tailrecursion,
-								  cs_opt_stackframe,cs_opt_nodecse];
+				  cs_opt_stackframe,cs_opt_nodecse,cs_opt_reorder_fields,cs_opt_fastmath];
    cpuflagsstr : array[tcpuflags] of string[20] =
       ('AVR_HAS_JMP_CALL',
        'AVR_HAS_MOVW',

compiler/avr/cpupara.pas

@@ -41,12 +41,11 @@ unit cpupara;
           procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
-          function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
+          function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
          private
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
           function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
             var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
-          procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
        end;
 
   implementation
@@ -261,7 +260,7 @@ unit cpupara;
 
             { currently only support C-style array of const,
               there should be no location assigned to the vararg array itself }
-            if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
+            if (p.proccalloption in cstylearrayofconst) and
                is_array_of_const(paradef) then
               begin
                 paraloc:=hp.paraloc[side].add_location;
@@ -403,24 +402,18 @@ unit cpupara;
      end;
 
 
-    procedure tavrparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
-      begin
-        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
-      end;
-
-
     { TODO : fix tavrparamanager.get_funcretloc }
-    function  tavrparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;
+    function  tavrparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       var
         retcgsize : tcgsize;
         paraloc : pcgparalocation;
       begin
-         if set_common_funcretloc_info(p,def,retcgsize,result) then
+         if set_common_funcretloc_info(p,forcetempdef,retcgsize,result) then
            exit;
 
         paraloc:=result.add_location;
         { Return in FPU register? }
-        if def.typ=floatdef then
+        if result.def.typ=floatdef then
           begin
             if (p.proccalloption in [pocall_softfloat]) or (cs_fp_emulation in current_settings.moduleswitches) then
               begin
@@ -485,7 +478,7 @@ unit cpupara;
         init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
 
         result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
-        if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+        if (p.proccalloption in cstylearrayofconst) then
           { just continue loading the parameters in the registers }
           result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset)
         else

compiler/cclasses.pas

@@ -151,6 +151,7 @@ type
     function Last: TObject; {$ifdef CCLASSESINLINE}inline;{$endif}
     procedure Move(CurIndex, NewIndex: Integer); {$ifdef CCLASSESINLINE}inline;{$endif}
     procedure Assign(Obj:TFPObjectList);
+    procedure ConcatListCopy(Obj:TFPObjectList);
     procedure Pack; {$ifdef CCLASSESINLINE}inline;{$endif}
     procedure Sort(Compare: TListSortCompare); {$ifdef CCLASSESINLINE}inline;{$endif}
     procedure ForEachCall(proc2call:TObjectListCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif}
@@ -1088,10 +1089,15 @@ begin
 end;
 
 procedure TFPObjectList.Assign(Obj: TFPObjectList);
+begin
+  Clear;
+  ConcatListCopy(Obj);
+end;
+
+procedure TFPObjectList.ConcatListCopy(Obj: TFPObjectList);
 var
   i: Integer;
 begin
-  Clear;
   for I := 0 to Obj.Count - 1 do
     Add(Obj[i]);
 end;

compiler/cgobj.pas

@@ -368,7 +368,6 @@ unit cgobj;
           }
          procedure g_exception_reason_load(list : TAsmList; const href : treference);virtual;
 
-          procedure g_maybe_testself(list : TAsmList;reg:tregister);
           procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
           {# This should emit the opcode to copy len bytes from the source
              to destination.
@@ -395,9 +394,6 @@ unit cgobj;
           procedure g_overflowcheck(list: TAsmList; const Loc:tlocation; def:tdef); virtual;abstract;
           procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);virtual;
 
-          procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);virtual;
-          procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);virtual;
-
           {# Emits instructions when compilation is done in profile
              mode (this is set as a command line option). The default
              behavior does nothing, should be overridden as required.
@@ -2070,27 +2066,6 @@ implementation
 {$endif cpuflags}
 
 
-    procedure tcg.g_maybe_testself(list : TAsmList;reg:tregister);
-      var
-        OKLabel : tasmlabel;
-        cgpara1 : TCGPara;
-      begin
-        if (cs_check_object in current_settings.localswitches) or
-           (cs_check_range in current_settings.localswitches) then
-         begin
-           current_asmdata.getjumplabel(oklabel);
-           a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,reg,oklabel);
-           cgpara1.init;
-           paramanager.getintparaloc(pocall_default,1,s32inttype,cgpara1);
-           a_load_const_cgpara(list,OS_S32,tcgint(210),cgpara1);
-           paramanager.freecgpara(list,cgpara1);
-           a_call_name(list,'FPC_HANDLEERROR',false);
-           a_label(list,oklabel);
-           cgpara1.done;
-         end;
-      end;
-
-
     procedure tcg.g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
       var
         hrefvmt : treference;
@@ -2129,86 +2104,6 @@ implementation
                             Entry/Exit Code Functions
 *****************************************************************************}
 
-    procedure tcg.g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);
-      var
-        sizereg,sourcereg,lenreg : tregister;
-        cgpara1,cgpara2,cgpara3 : TCGPara;
-      begin
-        { because some abis don't support dynamic stack allocation properly
-          open array value parameters are copied onto the heap
-        }
-
-        { calculate necessary memory }
-
-        { read/write operations on one register make the life of the register allocator hard }
-        if not(lenloc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
-          begin
-            lenreg:=getintregister(list,OS_INT);
-            a_load_loc_reg(list,OS_INT,lenloc,lenreg);
-          end
-        else
-          lenreg:=lenloc.register;
-
-        sizereg:=getintregister(list,OS_INT);
-        a_op_const_reg_reg(list,OP_ADD,OS_INT,1,lenreg,sizereg);
-        a_op_const_reg(list,OP_IMUL,OS_INT,elesize,sizereg);
-        { load source }
-        sourcereg:=getaddressregister(list);
-        a_loadaddr_ref_reg(list,ref,sourcereg);
-
-        { do getmem call }
-        cgpara1.init;
-        paramanager.getintparaloc(pocall_default,1,ptruinttype,cgpara1);
-        a_load_reg_cgpara(list,OS_INT,sizereg,cgpara1);
-        paramanager.freecgpara(list,cgpara1);
-        allocallcpuregisters(list);
-        a_call_name(list,'FPC_GETMEM',false);
-        deallocallcpuregisters(list);
-        cgpara1.done;
-        { return the new address }
-        a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,destreg);
-
-        { do move call }
-        cgpara1.init;
-        cgpara2.init;
-        cgpara3.init;
-        paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
-        paramanager.getintparaloc(pocall_default,2,voidpointertype,cgpara2);
-        paramanager.getintparaloc(pocall_default,3,ptrsinttype,cgpara3);
-        { load size }
-        a_load_reg_cgpara(list,OS_SINT,sizereg,cgpara3);
-        { load destination }
-        a_load_reg_cgpara(list,OS_ADDR,destreg,cgpara2);
-        { load source }
-        a_load_reg_cgpara(list,OS_ADDR,sourcereg,cgpara1);
-        paramanager.freecgpara(list,cgpara3);
-        paramanager.freecgpara(list,cgpara2);
-        paramanager.freecgpara(list,cgpara1);
-        allocallcpuregisters(list);
-        a_call_name(list,'FPC_MOVE',false);
-        deallocallcpuregisters(list);
-        cgpara3.done;
-        cgpara2.done;
-        cgpara1.done;
-      end;
-
-
-    procedure tcg.g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
-      var
-        cgpara1 : TCGPara;
-      begin
-        { do move call }
-        cgpara1.init;
-        paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
-        { load source }
-        a_load_loc_cgpara(list,l,cgpara1);
-        paramanager.freecgpara(list,cgpara1);
-        allocallcpuregisters(list);
-        a_call_name(list,'FPC_FREEMEM',false);
-        deallocallcpuregisters(list);
-        cgpara1.done;
-      end;
-
 
     procedure tcg.g_save_registers(list:TAsmList);
       var

compiler/dbgbase.pas

@@ -311,8 +311,32 @@ implementation
                     internalerror(200610053);
                   dbg_state_used:
                     appenddef(list,def);
-                else
-                  internalerror(200610054);
+                  dbg_state_queued:
+                    begin
+                      { can happen in case an objectdef was used from another
+                        unit that was compiled without debug info, and we are
+                        using Stabs (which means that parent types have to be
+                        written before child types). In this case, the child
+                        objectdef will be queued and never written, because its
+                        definition is not inside the current unit and hence will
+                        not be encountered }
+                      if def.typ<>objectdef then
+                        internalerror(2012072401);
+                      if not assigned(tobjectdef(def).childof) or
+                         (tobjectdef(def).childof.dbg_state=dbg_state_written) then
+                        appenddef(list,def)
+                      else if tobjectdef(def).childof.dbg_state=dbg_state_queued then
+                        deftowritelist.add(def)
+                      else if tobjectdef(def).childof.dbg_state=dbg_state_used then
+                        { comes somewhere after the current def in the looplist
+                          and will be written at that point, so we will have to
+                          wait until the next iteration }
+                        deftowritelist.add(def)
+                      else
+                        internalerror(2012072402);
+                    end;
+                  else
+                    internalerror(200610054);
                 end;
               end;
             looplist.clear;

compiler/dbgstabs.pas

@@ -1038,22 +1038,23 @@ implementation
               while assigned(anc.childof) do
                 begin
                   anc:=anc.childof;
-                  if (anc.dbg_state=dbg_state_writing) then
-                    { happens in case a field of a parent is of the (forward }
-                    { defined) child type                                    }
-                    begin
-                      { We don't explicitly requeue it, but the fact that  }
-                      { a child type was used in a parent before the child }
-                      { type was fully defined means that it was forward   }
-                      { declared, and will still be encountered later (it  }
-                      { cannot have been declared in another unit, because }
-                      { then this and that other unit would depend on      }
-                      { eachother's interface)                             }
-                      { Setting the state to queued however allows us to   }
-                      { get the def number already without an IE           }
-                      def.dbg_state:=dbg_state_queued;
-                      exit;
-                    end;
+                  case anc.dbg_state of
+                    dbg_state_writing:
+                      { happens in case a field of a parent is of the (forward
+                        defined) child type
+                      }
+                      begin
+                        { We don't explicitly requeue it, but the fact that
+                          a child type was used in a parent before the child
+                          type was fully defined means that it was forward
+                          declared, and will still be encountered later.
+                          Setting the state to queued however allows us to
+                          get the def number already without an IE
+                        }
+                        def.dbg_state:=dbg_state_queued;
+                        break;
+                      end;
+                  end;
                 end;
               appenddef(list,vmtarraytype);
               if assigned(tobjectdef(def).ImplementedInterfaces) then
@@ -1064,6 +1065,16 @@ implementation
               while assigned(anc.childof) do
                 begin
                   anc:=anc.childof;
+                  { in case this is an object family declared in another unit
+                    that was compiled without debug info, this ancestor may not
+                    yet have a stabs number and not yet be added to defstowrite
+                    -> take care of that now, while its dbg_state is still
+                    dbg_state_unused in case the aforementioned things haven't
+                    happened yet (afterwards it will become dbg_state_writing,
+                    and then def_stab_number() won't do anything anymore because
+                    it assumes it's already happened
+                  }
+                  def_stab_number(anc);
                   appenddef(list,anc);
                   if assigned(anc.ImplementedInterfaces) then
                     for i:=0 to anc.ImplementedInterfaces.Count-1 do

compiler/defcmp.pas

@@ -1222,7 +1222,8 @@ implementation
                       if assigned(def_to.typesym) and
                          (tpointerdef(def_to).pointeddef.typ=forwarddef) then
                        begin
-                         if (def_from.typesym=def_to.typesym) then
+                         if (def_from.typesym=def_to.typesym) or
+                            (fromtreetype=niln) then
                           eq:=te_equal
                        end
                      else
@@ -1533,13 +1534,18 @@ implementation
                        doconv:=tc_variant_2_interface;
                        eq:=te_convert_l2;
                      end
-                   { ugly, but delphi allows it }
+                   { ugly, but delphi allows it (enables typecasting ordinals/
+                     enums of any size to pointer-based object defs) }
                    { in Java enums /are/ class instances, and hence such
-                     typecasts must not be treated as integer-like conversions
+                     typecasts must not be treated as integer-like conversions;
+                     arbitrary constants cannot be converted into classes/
+                     pointer-based values either on the JVM -> always return
+                     false and let it be handled by the regular explicit type
+                     casting code
                    }
-                   else if ((not(target_info.system in systems_jvm) and
-                        (def_from.typ=enumdef)) or
-                       (def_from.typ=orddef)) and
+                   else if (not(target_info.system in systems_jvm) and
+                       ((def_from.typ=enumdef) or
+                        (def_from.typ=orddef))) and
                       (m_delphi in current_settings.modeswitches) and
                       (cdo_explicit in cdoptions) then
                      begin
@@ -1555,7 +1561,8 @@ implementation
                if assigned(def_to.typesym) and
                   (tclassrefdef(def_to).pointeddef.typ=forwarddef) then
                  begin
-                   if (def_from.typesym=def_to.typesym) then
+                   if (def_from.typesym=def_to.typesym) or
+                      (fromtreetype=niln) then
                     eq:=te_equal;
                  end
                else

compiler/defutil.pas

@@ -46,6 +46,16 @@ interface
     {# Returns true, if definition defines a string type }
     function is_string(def : tdef): boolean;
 
+    {# Returns True, if definition defines a type that behaves like a string,
+       namely that can be joined and compared with another string-like type }
+    function is_stringlike(def : tdef) : boolean;
+
+    {# Returns True, if definition defines an enumeration type }
+    function is_enum(def : tdef) : boolean;
+
+    {# Returns True, if definition defines a set type }
+    function is_set(def : tdef) : boolean;
+
     {# Returns the minimal integer value of the type }
     function get_min_value(def : tdef) : TConstExprInt;
 
@@ -405,6 +415,27 @@ implementation
         is_string := (assigned(def) and (def.typ = stringdef));
       end;
 
+    function is_stringlike(def : tdef) : boolean;
+      begin
+        result := is_string(def) or
+                  is_anychar(def) or
+                  is_pchar(def) or
+                  is_pwidechar(def) or
+                  is_chararray(def) or
+                  is_widechararray(def) or
+                  is_open_chararray(def) or
+                  is_open_widechararray(def);
+      end;
+
+    function is_enum(def : tdef) : boolean;
+      begin
+        result:=def.typ=enumdef;
+      end;
+
+    function is_set(def : tdef) : boolean;
+      begin
+        result:=def.typ=setdef;
+      end;
 
     { returns the min. value of the type }
     function get_min_value(def : tdef) : TConstExprInt;

compiler/fmodule.pas

@@ -965,6 +965,8 @@ implementation
 
     procedure tmodule.setmodulename(const s:string);
       begin
+        stringdispose(modulename);
+        stringdispose(realmodulename);
         modulename:=stringdup(upper(s));
         realmodulename:=stringdup(s);
         { also update asmlibrary names }

compiler/fpcdefs.inc

@@ -107,6 +107,7 @@
   {$define cpumm}
   {$define cpurox}
   {$define cpurefshaveindexreg}
+  {$define fpc_compiler_has_fixup_jmps}
 {$endif powerpc}
 
 {$ifdef powerpc64}
@@ -117,6 +118,7 @@
   {$define cpumm}
   {$define cpurox}
   {$define cpurefshaveindexreg}
+  {$define fpc_compiler_has_fixup_jmps}
 {$endif powerpc64}
 
 {$ifdef arm}
@@ -195,6 +197,7 @@
   {$define cpurequiresproperalignment}
   { define cpumm}
   {$define cpurefshaveindexreg}
+  {$define fpc_compiler_has_fixup_jmps}
 {$endif mips}
 
 {$ifdef jvm}

compiler/globtype.pas

@@ -243,7 +243,8 @@ interface
          cs_opt_level1,cs_opt_level2,cs_opt_level3,
          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_opt_nodedfa,cs_opt_loopstrength,cs_opt_scheduler,cs_opt_autoinline,cs_useebp,
+         cs_opt_reorder_fields,cs_opt_fastmath
        );
        toptimizerswitches = set of toptimizerswitch;
 
@@ -263,11 +264,12 @@ interface
        end;
 
     const
-       OptimizerSwitchStr : array[toptimizerswitch] of string[10] = ('',
+       OptimizerSwitchStr : array[toptimizerswitch] of string[11] = ('',
          'LEVEL1','LEVEL2','LEVEL3',
          'REGVAR','UNCERTAIN','SIZE','STACKFRAME',
          'PEEPHOLE','ASMCSE','LOOPUNROLL','TAILREC','CSE',
-         'DFA','STRENGTH','SCHEDULE','AUTOINLINE'
+         'DFA','STRENGTH','SCHEDULE','AUTOINLINE','USEEBP',
+         'ORDERFIELDS','FASTMATH'
        );
        WPOptimizerSwitchStr : array [twpoptimizerswitch] of string[14] = (
          'DEVIRTCALLS','OPTVMTS','SYMBOLLIVENESS'
@@ -460,6 +462,8 @@ interface
        pocall_default = pocall_stdcall;
 {$endif}
 
+       cstylearrayofconst = [pocall_cdecl,pocall_cppdecl,pocall_mwpascal];
+
        modeswitchstr : array[tmodeswitch] of string[18] = ('','',
          '','','','','','',
          {$ifdef fpc_mode}'',{$endif}

compiler/hlcg2ll.pas

@@ -152,12 +152,12 @@ unit hlcg2ll;
           }
           procedure a_loadaddr_ref_cgpara(list : TAsmList;fromsize : tdef;const r : treference;const cgpara : TCGPara);override;
 
-          procedure a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; weak: boolean);override;
+          function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;override;
           procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);override;
           procedure a_call_ref(list : TAsmList;pd : tabstractprocdef;const ref : treference);override;
           { same as a_call_name, might be overridden on certain architectures to emit
             static calls without usage of a got trampoline }
-          procedure a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr);override;
+          function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef): tcgpara;override;
 
           { move instructions }
           procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : aint;register : tregister);override;
@@ -256,7 +256,6 @@ unit hlcg2ll;
           procedure g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref:TReference); override;
 {$endif cpuflags}
 
-//          procedure g_maybe_testself(list : TAsmList;reg:tregister);
 //          procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
           {# This should emit the opcode to copy len bytes from the source
              to destination.
@@ -283,9 +282,6 @@ unit hlcg2ll;
           procedure g_overflowcheck(list: TAsmList; const Loc:tlocation; def:tdef); override;
           procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation);override;
 
-          procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;arrdef: tarraydef;destreg:tregister);override;
-          procedure g_releasevaluepara_openarray(list : TAsmList;arrdef: tarraydef;const l:tlocation);override;
-
           {# Emits instructions when compilation is done in profile
              mode (this is set as a command line option). The default
              behavior does nothing, should be overridden as required.
@@ -460,9 +456,10 @@ implementation
       cg.a_loadaddr_ref_cgpara(list,r,cgpara);
     end;
 
-  procedure thlcg2ll.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; weak: boolean);
+  function thlcg2ll.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara;
     begin
       cg.a_call_name(list,s,weak);
+      result:=get_call_result_cgpara(pd,forceresdef);
     end;
 
   procedure thlcg2ll.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister);
@@ -475,9 +472,10 @@ implementation
       cg.a_call_ref(list,ref);
     end;
 
-  procedure thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr);
+  function thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara;
     begin
       cg.a_call_name_static(list,s);
+      result:=get_call_result_cgpara(pd,forceresdef);
     end;
 
   procedure thlcg2ll.a_load_const_reg(list: TAsmList; tosize: tdef; a: aint; register: tregister);
@@ -938,16 +936,6 @@ implementation
       cg.g_overflowCheck_loc(list,loc,def,ovloc);
     end;
 
-  procedure thlcg2ll.g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister);
-    begin
-      cg.g_copyvaluepara_openarray(list,ref,lenloc,arrdef.elesize,destreg);
-    end;
-
-  procedure thlcg2ll.g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation);
-    begin
-      cg.g_releasevaluepara_openarray(list,l);
-    end;
-
   procedure thlcg2ll.g_profilecode(list: TAsmList);
     begin
       cg.g_profilecode(list);

compiler/hlcgobj.pas

@@ -191,14 +191,15 @@ unit hlcgobj;
           }
 
           {# Emits instruction to call the method specified by symbol name.
+             Returns the function result location.
              This routine must be overridden for each new target cpu.
           }
-          procedure a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; weak: boolean);virtual;abstract;
+          function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;virtual;abstract;
           procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);virtual;abstract;
           procedure a_call_ref(list : TAsmList;pd : tabstractprocdef;const ref : treference);virtual;
           { same as a_call_name, might be overridden on certain architectures to emit
             static calls without usage of a got trampoline }
-          procedure a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr);virtual;
+          function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef): tcgpara;virtual;
           { same as a_call_name, might be overridden on certain architectures to emit
             special static calls for inherited methods }
           procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr);virtual;
@@ -260,6 +261,7 @@ unit hlcgobj;
           procedure a_bit_set_const_loc(list: TAsmList; doset: boolean; tosize: tdef; bitnumber: aint; const loc: tlocation);virtual;
 
          protected
+           function  get_call_result_cgpara(pd: tprocdef; forceresdef: tdef): tcgpara;
            procedure get_subsetref_load_info(const sref: tsubsetreference; out loadsize: torddef; out extra_load: boolean);
            procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); virtual;
            procedure a_load_subsetref_regs_index(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg: tregister); virtual;
@@ -366,7 +368,7 @@ unit hlcgobj;
           procedure g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref:TReference); virtual; abstract;
 {$endif cpuflags}
 
-//          procedure g_maybe_testself(list : TAsmList;reg:tregister);
+          procedure g_maybe_testself(list : TAsmList; selftype: tdef; reg:tregister);
 //          procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
           {# This should emit the opcode to copy len bytes from the source
              to destination.
@@ -417,8 +419,8 @@ unit hlcgobj;
           procedure g_overflowcheck(list: TAsmList; const Loc:tlocation; def:tdef); virtual; abstract;
           procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation);virtual; abstract;
 
-          procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;arrdef: tarraydef;destreg:tregister);virtual;abstract;
-          procedure g_releasevaluepara_openarray(list : TAsmList;arrdef: tarraydef;const l:tlocation);virtual;abstract;
+          procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;arrdef: tarraydef;destreg:tregister);virtual;
+          procedure g_releasevaluepara_openarray(list : TAsmList;arrdef: tarraydef;const l:tlocation);virtual;
 
           {# Emits instructions when compilation is done in profile
              mode (this is set as a command line option). The default
@@ -533,7 +535,11 @@ unit hlcgobj;
           procedure record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList); virtual;
 
           { generate a call to a routine in the system unit }
-          procedure g_call_system_proc(list: TAsmList; const procname: string);
+          function g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara;
+         protected
+          function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; virtual;
+         public
+
 
           { Generate code to exit an unwind-protected region. The default implementation
             produces a simple jump to destination label. }
@@ -884,14 +890,14 @@ implementation
       a_call_reg(list,pd,reg);
     end;
 
-  procedure thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr);
+  function thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara;
     begin
-      a_call_name(list,pd,s,false);
+      result:=a_call_name(list,pd,s,forceresdef,false);
     end;
 
     procedure thlcgobj.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr);
       begin
-        a_call_name(list,pd,s,false);
+        a_call_name(list,pd,s,nil,false);
       end;
 
   procedure thlcgobj.a_load_const_ref(list: TAsmList; tosize: tdef; a: aint; const ref: treference);
@@ -1568,6 +1574,18 @@ implementation
     end;
 
 
+  function thlcgobj.get_call_result_cgpara(pd: tprocdef; forceresdef: tdef): tcgpara;
+    begin
+      if not assigned(forceresdef) then
+        begin
+          pd.init_paraloc_info(callerside);
+          result:=pd.funcretloc[callerside];
+        end
+      else
+        result:=paramanager.get_funcretloc(pd,callerside,forceresdef);
+    end;
+
+
   (*
     Subsetrefs are used for (bit)packed arrays and (bit)packed records stored
     in memory. They are like a regular reference, but contain an extra bit
@@ -2756,6 +2774,26 @@ implementation
       end;
     end;
 
+  procedure thlcgobj.g_maybe_testself(list: TAsmList; selftype: tdef; reg: tregister);
+    var
+      OKLabel : tasmlabel;
+      cgpara1 : TCGPara;
+    begin
+      if (cs_check_object in current_settings.localswitches) or
+         (cs_check_range in current_settings.localswitches) then
+       begin
+         current_asmdata.getjumplabel(oklabel);
+         a_cmp_const_reg_label(list,selftype,OC_NE,0,reg,oklabel);
+         cgpara1.init;
+         paramanager.getintparaloc(pocall_default,1,s32inttype,cgpara1);
+         a_load_const_cgpara(list,s32inttype,aint(210),cgpara1);
+         paramanager.freecgpara(list,cgpara1);
+         g_call_system_proc(list,'fpc_handleerror',nil);
+         cgpara1.done;
+         a_label(list,oklabel);
+       end;
+    end;
+
   procedure thlcgobj.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
     begin
 {
@@ -2790,7 +2828,7 @@ implementation
       paramanager.freecgpara(list,cgpara3);
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,'fpc_shortstr_assign');
+      g_call_system_proc(list,'fpc_shortstr_assign',nil);
       cgpara3.done;
       cgpara2.done;
       cgpara1.done;
@@ -2810,7 +2848,7 @@ implementation
       a_loadaddr_ref_cgpara(list,vardef,source,cgpara1);
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,'fpc_variant_copy_overwrite');
+      g_call_system_proc(list,'fpc_variant_copy_overwrite',nil);
       cgpara2.done;
       cgpara1.done;
     end;
@@ -2848,7 +2886,7 @@ implementation
             { these functions get the pointer by value }
             a_load_ref_cgpara(list,t,ref,cgpara1);
           paramanager.freecgpara(list,cgpara1);
-          g_call_system_proc(list,incrfunc);
+          g_call_system_proc(list,incrfunc,nil);
         end
        else
         begin
@@ -2859,7 +2897,7 @@ implementation
           a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
           paramanager.freecgpara(list,cgpara1);
           paramanager.freecgpara(list,cgpara2);
-          g_call_system_proc(list,'fpc_addref');
+          g_call_system_proc(list,'fpc_addref',nil);
         end;
        cgpara2.done;
        cgpara1.done;
@@ -2885,7 +2923,7 @@ implementation
            paramanager.getintparaloc(pocall_default,1,pvardata,cgpara1);
            a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
            paramanager.freecgpara(list,cgpara1);
-           g_call_system_proc(list,'fpc_variant_init');
+           g_call_system_proc(list,'fpc_variant_init',nil);
          end
        else
          begin
@@ -2898,7 +2936,7 @@ implementation
             a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
             paramanager.freecgpara(list,cgpara1);
             paramanager.freecgpara(list,cgpara2);
-            g_call_system_proc(list,'fpc_initialize');
+            g_call_system_proc(list,'fpc_initialize',nil);
          end;
       cgpara1.done;
       cgpara2.done;
@@ -2945,9 +2983,9 @@ implementation
           paramanager.freecgpara(list,cgpara1);
           paramanager.freecgpara(list,cgpara2);
           if dynarr then
-            g_call_system_proc(list,'fpc_dynarray_clear')
+            g_call_system_proc(list,'fpc_dynarray_clear',nil)
           else
-            g_call_system_proc(list,'fpc_finalize');
+            g_call_system_proc(list,'fpc_finalize',nil);
           cgpara1.done;
           cgpara2.done;
           exit;
@@ -2956,7 +2994,7 @@ implementation
       paramanager.getintparaloc(pocall_default,1,paratype,cgpara1);
       a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,decrfunc);
+      g_call_system_proc(list,decrfunc,nil);
       cgpara1.done;
     end;
 
@@ -2996,7 +3034,7 @@ implementation
       paramanager.freecgpara(list,cgpara1);
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara3);
-      g_call_system_proc(list,name);
+      g_call_system_proc(list,name,nil);
 
       cgpara3.done;
       cgpara2.done;
@@ -3167,7 +3205,7 @@ implementation
                   { if low(to) > maxlongint also range error }
                   (lto > aintmax) then
                  begin
-                   g_call_system_proc(list,'fpc_rangeerror');
+                   g_call_system_proc(list,'fpc_rangeerror',nil);
                    exit
                  end;
                { from is signed and to is unsigned -> when looking at to }
@@ -3182,7 +3220,7 @@ implementation
                if (lfrom > aintmax) or
                   (hto < 0) then
                  begin
-                   g_call_system_proc(list,'fpc_rangeerror');
+                   g_call_system_proc(list,'fpc_rangeerror',nil);
                    exit
                  end;
                { from is unsigned and to is signed -> when looking at to }
@@ -3205,10 +3243,90 @@ implementation
         a_cmp_const_reg_label(list,maxdef,OC_BE,aintmax,hreg,neglabel)
       else
         a_cmp_const_reg_label(list,maxdef,OC_BE,tcgint(int64(hto-lto)),hreg,neglabel);
-      g_call_system_proc(list,'fpc_rangeerror');
+      g_call_system_proc(list,'fpc_rangeerror',nil);
       a_label(list,neglabel);
     end;
 
+  procedure thlcgobj.g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister);
+    var
+      sizereg,sourcereg,lenreg : tregister;
+      cgpara1,cgpara2,cgpara3 : TCGPara;
+      ptrarrdef : tdef;
+      getmemres : tcgpara;
+      destloc : tlocation;
+    begin
+      { because some abis don't support dynamic stack allocation properly
+        open array value parameters are copied onto the heap
+      }
+
+      { calculate necessary memory }
+
+      { read/write operations on one register make the life of the register allocator hard }
+      if not(lenloc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+        begin
+          lenreg:=getintregister(list,sinttype);
+          a_load_loc_reg(list,sinttype,sinttype,lenloc,lenreg);
+        end
+      else
+        lenreg:=lenloc.register;
+
+      sizereg:=getintregister(list,sinttype);
+      a_op_const_reg_reg(list,OP_ADD,sinttype,1,lenreg,sizereg);
+      a_op_const_reg(list,OP_IMUL,sinttype,arrdef.elesize,sizereg);
+      { load source }
+      ptrarrdef:=getpointerdef(arrdef);
+      sourcereg:=getaddressregister(list,ptrarrdef);
+      a_loadaddr_ref_reg(list,arrdef,ptrarrdef,ref,sourcereg);
+
+      { do getmem call }
+      cgpara1.init;
+      paramanager.getintparaloc(pocall_default,1,ptruinttype,cgpara1);
+      a_load_reg_cgpara(list,sinttype,sizereg,cgpara1);
+      paramanager.freecgpara(list,cgpara1);
+      getmemres:=g_call_system_proc(list,'fpc_getmem',ptrarrdef);
+      cgpara1.done;
+      { return the new address }
+      location_reset(destloc,LOC_REGISTER,OS_ADDR);
+      destloc.register:=destreg;
+      gen_load_cgpara_loc(list,ptrarrdef,getmemres,destloc,false);
+
+      { do move call }
+      cgpara1.init;
+      cgpara2.init;
+      cgpara3.init;
+      paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
+      paramanager.getintparaloc(pocall_default,2,voidpointertype,cgpara2);
+      paramanager.getintparaloc(pocall_default,3,ptrsinttype,cgpara3);
+      { load size }
+      a_load_reg_cgpara(list,ptrsinttype,sizereg,cgpara3);
+      { load destination }
+      a_load_reg_cgpara(list,ptrarrdef,destreg,cgpara2);
+      { load source }
+      a_load_reg_cgpara(list,ptrarrdef,sourcereg,cgpara1);
+      paramanager.freecgpara(list,cgpara3);
+      paramanager.freecgpara(list,cgpara2);
+      paramanager.freecgpara(list,cgpara1);
+      g_call_system_proc(list,'MOVE',nil);
+      cgpara3.done;
+      cgpara2.done;
+      cgpara1.done;
+      getmemres.resetiftemp;
+    end;
+
+  procedure thlcgobj.g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation);
+    var
+      cgpara1 : TCGPara;
+    begin
+      { do freemem call }
+      cgpara1.init;
+      paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
+      { load source }
+      a_load_loc_cgpara(list,getpointerdef(arrdef),l,cgpara1);
+      paramanager.freecgpara(list,cgpara1);
+      g_call_system_proc(list,'fpc_freemem',nil);
+      cgpara1.done;
+    end;
+
   procedure thlcgobj.g_profilecode(list: TAsmList);
     begin
     end;
@@ -4299,7 +4417,7 @@ implementation
         current_asmdata.asmlists[al_procedures].concatlist(data);
     end;
 
-  procedure thlcgobj.g_call_system_proc(list: TAsmList; const procname: string);
+  function thlcgobj.g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara;
     var
       srsym: tsym;
       pd: tprocdef;
@@ -4312,8 +4430,13 @@ implementation
          (srsym.typ<>procsym) then
         Message1(cg_f_unknown_compilerproc,procname);
       pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
+      result:=g_call_system_proc_intern(list,pd,forceresdef);
+    end;
+
+  function thlcgobj.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
+    begin
       allocallcpuregisters(list);
-      a_call_name(list,pd,pd.mangledname,false);
+      result:=a_call_name(list,pd,pd.mangledname,forceresdef,false);
       deallocallcpuregisters(list);
     end;
 

compiler/htypechk.pas

@@ -195,6 +195,12 @@ implementation
       TValidAssigns=set of TValidAssign;
 
 
+    { keep these two in sync! }
+    const
+      non_commutative_op_tokens=[_OP_SHL,_OP_SHR,_OP_DIV,_OP_MOD,_STARSTAR,_SLASH,_MINUS];
+      non_commutative_op_nodes=[shln,shrn,divn,modn,starstarn,slashn,subn];
+
+
     function node2opstr(nt:tnodetype):string;
       var
         i : integer;
@@ -212,8 +218,26 @@ implementation
     function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
 
         function internal_check(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype;var allowed:boolean):boolean;
+        const
+          identity_operators=[equaln,unequaln];
+          order_theoretic_operators=identity_operators+[ltn,lten,gtn,gten];
+          arithmetic_operators=[addn,subn,muln,divn,modn];
+          rational_operators=[addn,subn,muln,slashn];
+          numerical_operators=arithmetic_operators+[slashn];
+          pointer_arithmetic_operators=[addn,subn];
+          logical_operators=[andn,orn,xorn];
+          bit_manipulation_operators=logical_operators+[shln,shrn];
+          set_set_operators=identity_operators+[addn,subn,muln,symdifn]+
+            order_theoretic_operators;
+          element_set_operators=[inn];
+          string_comparison_operators=order_theoretic_operators;
+          string_manipulation_operators=[addn];
+          string_operators =
+            string_comparison_operators+string_manipulation_operators;
         begin
           internal_check:=true;
+
+          { Reject the cases permitted by the default interpretation (DI). }
           case ld.typ of
             formaldef,
             recorddef,
@@ -221,6 +245,117 @@ implementation
               begin
                 allowed:=true;
               end;
+            enumdef:
+              begin
+                allowed:=not (
+                           (
+                             is_set(rd) and
+                             (treetyp in element_set_operators)
+                           ) or
+                           (
+                             is_enum(rd) and
+                             (treetyp in (order_theoretic_operators+[addn, subn]))
+                           )
+                         );
+              end;
+            setdef:
+              begin
+                allowed:=not (
+                           (
+                             is_set(rd) and
+                             (treetyp in (set_set_operators+identity_operators))
+                           ) or
+                           (
+                             { This clause is a hack but it’s due to a hack somewhere
+                               else---while set + element is not permitted by DI, it
+                               seems to be used when a set is constructed inline }
+                             (rd.typ in [enumdef,orddef]) and
+                             (treetyp=addn)
+                           )
+                         );
+              end;
+            orddef, floatdef:
+              begin
+                allowed:=not (
+                           (
+                             (rd.typ in [orddef,floatdef]) and
+                             (treetyp in order_theoretic_operators)
+                           ) or
+                           (
+                             is_stringlike(rd) and
+                             (ld.typ=orddef) and
+                             (treetyp in string_comparison_operators)) or
+                             { c.f. $(source)\tests\tmacpas5.pp }
+                             (
+                               (rd.typ=setdef) and
+                               (ld.typ=orddef) and
+                               (treetyp in element_set_operators)
+                             )
+                            { This clause may be too restrictive---not all types under
+                              orddef have a corresponding set type; despite this the
+                              restriction should be very unlikely to become
+                              a practical obstacle, and can be relaxed by simply
+                              adding an extra check on TOrdDef(rd).ordtype }
+                           );
+
+                { Note that Currency can be under either orddef or floatdef;
+                  when it’s under floatdef, is_currency() implies is_float();
+                  when it’s under orddef, is_currency() does NOT imply
+                  is_integer(). }
+                if allowed then
+                  begin
+                    if is_anychar(ld) then
+                      allowed:=not (
+                                 is_stringlike(rd) and
+                                 (treetyp in string_operators)
+                               )
+                    else if is_boolean(ld) then
+                      allowed:=not (
+                                 is_boolean(rd) and
+                                 (treetyp in logical_operators)
+                               )
+                    else if is_integer(ld) or
+                        (
+                          (ld.typ=orddef) and
+                          is_currency(ld)
+                        { Here ld is Currency but behaves like an integer }
+                        ) then
+                      allowed:=not (
+                                 (
+                                   (
+                                     is_integer(rd) or
+                                     (
+                                       (rd.typ=orddef) and
+                                       is_currency(rd)
+                                     )
+                                   ) and
+                                   (treetyp in (bit_manipulation_operators+numerical_operators))
+                                 ) or
+                                 (
+                                   is_fpu(rd) and
+                                   (treetyp in rational_operators)
+                                 ) or
+                                 (
+                                   { When an integer type is used as the first operand in
+                                     pointer arithmetic, DI doesn’t accept minus as the
+                                     operator (Currency can’t be used in pointer
+                                     arithmetic even if it’s under orddef)  }
+                                   is_integer(ld) and
+                                   (rd.typ=pointerdef) and
+                                   (treetyp in pointer_arithmetic_operators-[subn])
+                                 )
+                               )
+                    else  { is_fpu(ld) = True }
+                      allowed:=not (
+                                 (
+                                   is_fpu(rd) or
+                                   is_integer(rd) or
+                                   is_currency(rd)
+                                 ) and
+                                 (treetyp in rational_operators)
+                               );
+                  end;
+              end;
             procvardef :
               begin
                 if (rd.typ in [pointerdef,procdef,procvardef]) then
@@ -232,25 +367,55 @@ implementation
               end;
             pointerdef :
               begin
-                if ((rd.typ in [orddef,enumdef,pointerdef,classrefdef,procvardef]) or
-                    is_implicit_pointer_object_type(rd)) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
-
-                { don't allow pchar+string }
-                if (is_pchar(ld) or is_pwidechar(ld)) and
-                   ((rd.typ=stringdef) or
-                    is_pchar(rd) or
-                    is_pwidechar(rd) or
-                    is_chararray(rd) or
-                    is_widechararray(rd)) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
-                allowed:=true;
+                { DI permits pointer arithmetic for pointer + pointer, pointer -
+                  integer, pointer - pointer, but not for pointer + pointer.
+                  The last case is only valid in DI when both sides are
+                  stringlike. }
+
+                if is_stringlike(ld) then
+                  if is_stringlike(rd) then
+                    { DI in this case permits string operations and pointer
+                      arithmetic. }
+                    allowed:=not (treetyp in (string_operators+pointer_arithmetic_operators))
+                  else if rd.typ = pointerdef then
+                    { DI in this case permits minus for pointer arithmetic and
+                      order-theoretic operators for pointer comparison. }
+                    allowed:=not (
+                               treetyp in (
+                                 pointer_arithmetic_operators-[addn]+
+                                 order_theoretic_operators
+                               )
+                             )
+                  else if is_integer(rd) then
+                    { DI in this case permits pointer arithmetic. }
+                    allowed:=not (treetyp in pointer_arithmetic_operators)
+                  else
+                    allowed:=true
+                else
+                  allowed:=not (
+                             (
+                               is_integer(rd) and
+                               (treetyp in pointer_arithmetic_operators)
+                             ) or
+                             (
+                               (rd.typ=pointerdef) and
+                               (
+                                 treetyp in (
+                                   pointer_arithmetic_operators-[addn]+
+                                   order_theoretic_operators
+                                 )
+                               )
+                             ) or
+                             (
+                               (lt=niln) and
+                               (rd.typ in [procvardef,procdef,classrefdef]) and
+                               (treetyp in identity_operators)
+                             ) or
+                             (
+                               is_implicit_pointer_object_type(rd) and
+                               (treetyp in identity_operators)
+                             )
+                           );
               end;
             arraydef :
               begin
@@ -263,80 +428,82 @@ implementation
                    allowed:=false;
                    exit;
                  end;
-                { not chararray+[(wide)char,(wide)string,(wide)chararray] }
-                if (is_chararray(ld) or is_widechararray(ld) or
-                    is_open_chararray(ld) or is_open_widechararray(ld))
-                   and
-                   ((rd.typ in [stringdef,orddef,enumdef]) or
-                    is_pchar(rd) or
-                    is_pwidechar(rd) or
-                    is_chararray(rd) or
-                    is_widechararray(rd) or
-                    is_open_chararray(rd) or
-                    is_open_widechararray(rd) or
-                    (rt=niln)) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
+
+                if is_stringlike(ld) and
+                    (
+                      (
+                        (
+                          is_stringlike(rd) or
+                          (rt = niln)
+                        ) and
+                        (treetyp in string_operators)
+                      ) or
+                      (
+                        is_integer(rd) and
+                        (treetyp in pointer_arithmetic_operators)
+                      ) or
+                      (
+                        (
+                          is_pchar(rd) or
+                          is_pwidechar(rd)) and
+                          (treetyp in pointer_arithmetic_operators) and
+                          (tpointerdef(rd).pointeddef=tarraydef(ld).elementdef
+                        )
+                      )
+                    ) then
+                  begin
+                    allowed:=false;
+                    exit;
+                  end;
+
                 { dynamic array compare with niln }
-                if ((is_dynamic_array(ld) and
-                   (rt=niln)) or
-                   (is_dynamic_array(ld) and is_dynamic_array(rd)))
-                   and
-                   (treetyp in [equaln,unequaln]) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
+                if is_dynamic_array(ld) and
+                    (treetyp in identity_operators) then
+                  if is_dynamic_array(rd) or
+                      (rt=niln) then
+                    begin
+                      allowed:=false;
+                      exit;
+                    end;
+
                 allowed:=true;
               end;
             objectdef :
               begin
                 { <> and = are defined for implicit pointer object types }
-                if (treetyp in [equaln,unequaln]) and
-                   is_implicit_pointer_object_type(ld) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
-                allowed:=true;
+                allowed:=not (
+                           is_implicit_pointer_object_type(ld) and
+                           (
+                             (
+                               is_implicit_pointer_object_type(rd) or
+                               (rd.typ=pointerdef) or
+                               (rt=niln)
+                             )
+                           ) and
+                           (treetyp in identity_operators)
+                         );
               end;
             stringdef :
               begin
-                if (rd.typ in [orddef,enumdef,stringdef]) or
-                   is_pchar(rd) or
-                   is_pwidechar(rd) or
-                   is_chararray(rd) or
-                   is_widechararray(rd) or
-                   is_open_chararray(rd) or
-                   is_open_widechararray(rd) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
-                allowed:=true;
+                allowed:=not (
+                           is_stringlike(rd) and
+                           (treetyp in string_operators)
+                         );
               end;
             else
               internal_check:=false;
           end;
         end;
 
-      var
-        allowed : boolean;
       begin
         { power ** is always possible }
-        if (treetyp=starstarn) then
-         begin
-           isbinaryoperatoroverloadable:=true;
-           exit;
-         end;
-        { order of arguments does not matter so we have to check also
-          the reversed order }
-        allowed:=false;
-        if not internal_check(treetyp,ld,lt,rd,rt,allowed) then
-          internal_check(treetyp,rd,rt,ld,lt,allowed);
-        isbinaryoperatoroverloadable:=allowed;
+        result:=treetyp=starstarn;
+        if not result then
+          begin
+            if not internal_check(treetyp,ld,lt,rd,rt,result) and
+                not (treetyp in non_commutative_op_nodes) then
+              internal_check(treetyp,rd,rt,ld,lt,result)
+          end;
       end;
 
 
@@ -366,8 +533,7 @@ implementation
 
           notn :
             begin
-              if (ld.typ in [orddef,enumdef,floatdef]) then
-                exit;
+              if ld.typ = orddef then exit;
 
 {$ifdef SUPPORT_MMX}
               if (cs_mmx in current_settings.localswitches) and
@@ -631,7 +797,7 @@ implementation
 
             { for commutative operators we can swap arguments and try again }
             if (candidates.count=0) and
-               not(optoken in [_OP_SHL,_OP_SHR,_OP_DIV,_OP_MOD,_STARSTAR,_SLASH,_MINUS]) then
+               not(optoken in non_commutative_op_tokens) then
               begin
                 candidates.free;
                 reverseparameters(ppn);

compiler/i386/cgcpu.pas

@@ -45,8 +45,8 @@ unit cgcpu;
         procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);override;
 
         procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override;
-        procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);override;
-        procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);override;
+        procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);
+        procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
 
         procedure g_exception_reason_save(list : TAsmList; const href : treference);override;
         procedure g_exception_reason_save_const(list : TAsmList; const href : treference; a: tcgint);override;
@@ -89,7 +89,10 @@ unit cgcpu;
            (cs_create_pic in current_settings.moduleswitches) then
           rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP])
         else
-          rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_EBX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP]);
+          if (cs_useebp in current_settings.optimizerswitches) and assigned(current_procinfo) and (current_procinfo.framepointer<>NR_EBP) then
+            rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_EBX,RS_ESI,RS_EDI,RS_EBP],first_int_imreg,[])
+          else
+            rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_EBX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP]);
         rg[R_MMXREGISTER]:=trgcpu.create(R_MMXREGISTER,R_SUBNONE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7],first_mm_imreg,[]);
         rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBWHOLE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7],first_mm_imreg,[]);
         rgfpu:=Trgx86fpu.create;
@@ -394,12 +397,6 @@ unit cgcpu;
         again,ok : tasmlabel;
 {$endif}
       begin
-        if paramanager.use_fixed_stack then
-          begin
-            inherited g_copyvaluepara_openarray(list,ref,lenloc,elesize,destreg);
-            exit;
-          end;
-
         { get stack space }
         getcpuregister(list,NR_EDI);
         a_load_loc_reg(list,OS_INT,lenloc,NR_EDI);
@@ -486,11 +483,6 @@ unit cgcpu;
 
     procedure tcg386.g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
       begin
-        if paramanager.use_fixed_stack then
-          begin
-            inherited g_releasevaluepara_openarray(list,l);
-            exit;
-          end;
         { Nothing to release }
       end;
 

compiler/i386/cpubase.inc

@@ -135,7 +135,7 @@
          This value can be deduced from the CALLED_USED_REGISTERS array in the
          GCC source.
       }
-      saved_standard_registers : array[0..2] of tsuperregister = (RS_EBX,RS_ESI,RS_EDI);
+      saved_standard_registers : array[0..3] of tsuperregister = (RS_EBX,RS_ESI,RS_EDI,RS_EBP);
 
       saved_mm_registers : array[0..0] of tsuperregister = (RS_INVALID);
       {# Required parameter alignment when calling a routine declared as

compiler/i386/cpuinfo.pas

@@ -102,7 +102,8 @@ Const
                                  [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
                                  [cs_opt_peephole,cs_opt_regvar,cs_opt_stackframe,
                                   cs_opt_asmcse,cs_opt_loopunroll,cs_opt_uncertain,
-								  cs_opt_tailrecursion,cs_opt_nodecse];
+                                  cs_opt_tailrecursion,cs_opt_nodecse,cs_useebp,
+				  cs_opt_reorder_fields,cs_opt_fastmath];
 
    level1optimizerswitches = genericlevel1optimizerswitches + [cs_opt_peephole];
    level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches +

compiler/i386/cpupara.pas

@@ -49,9 +49,8 @@ unit cpupara;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override;
-          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): TCGPara;override;
+          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;override;
        private
-          procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
           procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint);
           procedure create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parareg,parasize:longint);
        end;
@@ -310,29 +309,35 @@ unit cpupara;
       end;
 
 
-    procedure ti386paramanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
-      begin
-        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
-      end;
-
-
-    function  ti386paramanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): TCGPara;
+    function  ti386paramanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;
       var
         retcgsize  : tcgsize;
         paraloc : pcgparalocation;
         sym: tfieldvarsym;
+        usedef: tdef;
+        handled: boolean;
       begin
+        if not assigned(forcetempdef) then
+          usedef:=p.returndef
+        else
+          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
-           ((def.typ=recorddef) or
-            is_object(def)) and
-           tabstractrecordsymtable(tabstractrecorddef(def).symtable).has_single_field(sym) and
+           ((usedef.typ=recorddef) or
+            is_object(usedef)) and
+           tabstractrecordsymtable(tabstractrecorddef(usedef).symtable).has_single_field(sym) and
            (sym.vardef.typ=floatdef) and
            (tfloatdef(sym.vardef).floattype in [s32real,s64real]) then
-          def:=sym.vardef;
-
-        if set_common_funcretloc_info(p,def,retcgsize,result) then
+          usedef:=sym.vardef;
+
+        handled:=set_common_funcretloc_info(p,usedef,retcgsize,result);
+        { normally forcetempdef is passed straight through to
+          set_common_funcretloc_info and that one will correctly determine whether
+          the location is a temporary one, but that doesn't work here because we
+          sometimes have to change the type }
+        result.temporary:=assigned(forcetempdef);
+        if handled then
           exit;
 
         { darwin/x86 requires that results < sizeof(aint) are sign/zero
@@ -349,7 +354,7 @@ unit cpupara;
           end;
 
         { Return in FPU register? }
-        if def.typ=floatdef then
+        if result.def.typ=floatdef then
           begin
             paraloc:=result.add_location;
             paraloc^.loc:=LOC_FPUREGISTER;

compiler/i386/hlcgcpu.pas

@@ -30,8 +30,8 @@ interface
 
   uses
     aasmdata,
-    symtype,parabase,
-    cgutils,
+    symtype,symdef,parabase,
+    cgbase,cgutils,
     hlcgobj, hlcgx86;
 
 
@@ -39,6 +39,9 @@ interface
     thlcgcpu = class(thlcgx86)
      protected
       procedure gen_loadfpu_loc_cgpara(list: TAsmList; size: tdef; const l: tlocation; const cgpara: tcgpara; locintsize: longint); override;
+     public
+      procedure g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister); override;
+      procedure g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation); override;
     end;
 
   procedure create_hlcodegen;
@@ -48,7 +51,6 @@ implementation
   uses
     globtype,verbose,
     paramgr,
-    cgbase,
     cpubase,tgobj,cgobj,cgcpu;
 
   { thlcgcpu }
@@ -169,6 +171,28 @@ implementation
     end;
 
 
+  procedure thlcgcpu.g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister);
+    begin
+      if paramanager.use_fixed_stack then
+        begin
+          inherited;
+          exit;
+        end;
+      tcg386(cg).g_copyvaluepara_openarray(list,ref,lenloc,arrdef.elesize,destreg);
+    end;
+
+
+  procedure thlcgcpu.g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation);
+    begin
+      if paramanager.use_fixed_stack then
+        begin
+          inherited;
+          exit;
+        end;
+      tcg386(cg).g_releasevaluepara_openarray(list,l);
+    end;
+
+
   procedure create_hlcodegen;
     begin
       hlcg:=thlcgcpu.create;

compiler/i386/n386add.pas

@@ -88,7 +88,6 @@ interface
         unsigned:boolean;
         r:Tregister;
       begin
-        firstcomplex(self);
         pass_left_right;
 
         op1:=A_NONE;
@@ -283,8 +282,6 @@ interface
         end;
 
       begin
-        firstcomplex(self);
-
         pass_left_right;
 
         unsigned:=((left.resultdef.typ=orddef) and

compiler/i386/popt386.pas

@@ -991,7 +991,8 @@ begin
                          (taicpu(hp1).oper[0]^.reg = taicpu(p).oper[1]^.reg) then
                         begin
                           {we have "mov x, %treg; mov %treg, y}
-                          if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, hp1, TmpUsedRegs)) then
+                          if not(RegInOp(getsupreg(taicpu(p).oper[1]^.reg),taicpu(hp1).oper[1]^)) and
+                             not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, hp1, TmpUsedRegs)) then
                             {we've got "mov x, %treg; mov %treg, y; with %treg is not used after }
                             case taicpu(p).oper[0]^.typ Of
                               top_reg:

compiler/jvm/cpupara.pas

@@ -45,12 +45,11 @@ interface
         procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
         function  create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
         function  create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
-        function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
+        function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
         function param_use_paraloc(const cgpara: tcgpara): boolean; override;
         function ret_in_param(def: tdef; calloption: tproccalloption): boolean; override;
         function is_stack_paraloc(paraloc: pcgparalocation): boolean;override;
       private
-        procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
         procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
                                              var parasize:longint);
       end;
@@ -111,23 +110,23 @@ implementation
       end;
 
 
-    procedure TJVMParaManager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
-      begin
-        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
-      end;
-
-
-    function TJVMParaManager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;
+    function TJVMParaManager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       var
         paraloc : pcgparalocation;
         retcgsize  : tcgsize;
       begin
-        def:=get_para_push_size(def);
         result.init;
         result.alignment:=get_para_align(p.proccalloption);
-        result.def:=def;
+        if not assigned(forcetempdef) then
+          result.def:=p.returndef
+        else
+          begin
+            result.def:=forcetempdef;
+            result.temporary:=true;
+          end;
+        result.def:=get_para_push_size(result.def);
         { void has no location }
-        if is_void(def) then
+        if is_void(result.def) then
           begin
             paraloc:=result.add_location;
             result.size:=OS_NO;
@@ -144,8 +143,8 @@ implementation
           end
         else
           begin
-            retcgsize:=def_cgsize(def);
-            result.intsize:=def.size;
+            retcgsize:=def_cgsize(result.def);
+            result.intsize:=result.def.size;
           end;
         result.size:=retcgsize;
 

compiler/jvm/hlcgcpu.pas

@@ -50,7 +50,7 @@ uses
 
       procedure a_load_const_cgpara(list : TAsmList;tosize : tdef;a : aint;const cgpara : TCGPara);override;
 
-      procedure a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; weak: boolean);override;
+      function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;override;
       procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr);override;
       procedure a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister); override;
 
@@ -158,6 +158,10 @@ uses
         then they have to be zero-extended again on the consumer side }
       procedure maybe_resize_stack_para_val(list: TAsmList; retdef: tdef; callside: boolean);
 
+      { adjust the stack height after a call based on the specified number of
+        slots used for parameters and the provided resultdef }
+      procedure g_adjust_stack_after_call(list: TAsmList; pd: tabstractprocdef; paraheight: longint; forceresdef: tdef);
+
 
       property maxevalstackheight: longint read fmaxevalstackheight;
 
@@ -178,6 +182,7 @@ uses
 
       procedure inittempvariables(list:TAsmList);override;
 
+      function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; override;
 
       { in case of an array, the array base address and index have to be
         put on the evaluation stack before the stored value; similarly, for
@@ -199,7 +204,7 @@ uses
         JVM does not support unsigned divisions }
       procedure maybepreparedivu32(list: TAsmList; var op: topcg; size: tdef; out isdivu32: boolean);
       { common implementation of a_call_* }
-      procedure a_call_name_intern(list : TAsmList;pd : tprocdef;const s : TSymStr; inheritedcall: boolean);
+      function a_call_name_intern(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; inheritedcall: boolean): tcgpara;
 
       { concatcopy helpers }
       procedure concatcopy_normal_array(list: TAsmList; size: tdef; const source, dest: treference);
@@ -291,14 +296,14 @@ implementation
       inherited a_load_const_cgpara(list, tosize, a, cgpara);
     end;
 
-  procedure thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; weak: boolean);
+  function thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara;
     begin
-      a_call_name_intern(list,pd,s,false);
+      result:=a_call_name_intern(list,pd,s,forceresdef,false);
     end;
 
   procedure thlcgjvm.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr);
     begin
-      a_call_name_intern(list,pd,s,true);
+      a_call_name_intern(list,pd,s,nil,true);
     end;
 
 
@@ -632,7 +637,6 @@ implementation
       i: longint;
       mangledname: string;
       opc: tasmop;
-      parasize: longint;
       primitivetype: boolean;
     begin
       elemdef:=arrdef;
@@ -682,50 +686,46 @@ implementation
           list.concat(taicpu.op_none(a_dup));
           incstack(list,1);
           a_load_const_stack(list,s32inttype,initdim-1,R_INTREGISTER);
-          parasize:=2;
           case elemdef.typ of
             arraydef:
-              g_call_system_proc(list,'fpc_initialize_array_dynarr');
+              g_call_system_proc(list,'fpc_initialize_array_dynarr',nil);
             recorddef,setdef,procvardef:
               begin
                 tg.gethltemp(list,elemdef,elemdef.size,tt_persistent,recref);
                 a_load_ref_stack(list,elemdef,recref,prepare_stack_for_ref(list,recref,false));
-                inc(parasize);
                 case elemdef.typ of
                   recorddef:
-                    g_call_system_proc(list,'fpc_initialize_array_record');
+                    g_call_system_proc(list,'fpc_initialize_array_record',nil);
                   setdef:
                     begin
                       if tsetdef(elemdef).elementdef.typ=enumdef then
-                        g_call_system_proc(list,'fpc_initialize_array_enumset')
+                        g_call_system_proc(list,'fpc_initialize_array_enumset',nil)
                       else
-                        g_call_system_proc(list,'fpc_initialize_array_bitset')
+                        g_call_system_proc(list,'fpc_initialize_array_bitset',nil)
                     end;
                   procvardef:
-                    g_call_system_proc(list,'fpc_initialize_array_procvar');
+                    g_call_system_proc(list,'fpc_initialize_array_procvar',nil);
                 end;
                 tg.ungettemp(list,recref);
               end;
             enumdef:
               begin
-                inc(parasize);
                 a_load_ref_stack(list,java_jlobject,enuminitref,prepare_stack_for_ref(list,enuminitref,false));
-                g_call_system_proc(list,'fpc_initialize_array_object');
+                g_call_system_proc(list,'fpc_initialize_array_object',nil);
               end;
             stringdef:
               begin
                 case tstringdef(elemdef).stringtype of
                   st_shortstring:
                     begin
-                      inc(parasize);
                       a_load_const_stack_intern(list,u8inttype,tstringdef(elemdef).len,R_INTREGISTER,true);
-                      g_call_system_proc(list,'fpc_initialize_array_shortstring');
+                      g_call_system_proc(list,'fpc_initialize_array_shortstring',nil);
                     end;
                   st_ansistring:
-                    g_call_system_proc(list,'fpc_initialize_array_ansistring');
+                    g_call_system_proc(list,'fpc_initialize_array_ansistring',nil);
                   st_unicodestring,
                   st_widestring:
-                    g_call_system_proc(list,'fpc_initialize_array_unicodestring');
+                    g_call_system_proc(list,'fpc_initialize_array_unicodestring',nil);
                   else
                     internalerror(2011081801);
                 end;
@@ -733,7 +733,6 @@ implementation
             else
               internalerror(2011081801);
           end;
-          decstack(list,parasize);
         end;
     end;
 
@@ -933,6 +932,15 @@ implementation
       { these are automatically initialised when allocated if necessary }
     end;
 
+
+  function thlcgjvm.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
+    begin
+      result:=inherited;
+      pd.init_paraloc_info(callerside);
+      g_adjust_stack_after_call(list,pd,pd.callerargareasize,forceresdef);
+    end;
+
+
   function thlcgjvm.prepare_stack_for_ref(list: TAsmList; const ref: treference; dup: boolean): longint;
     var
       href: treference;
@@ -1287,16 +1295,9 @@ implementation
          a_load_const_stack(list,s32inttype,-1,R_INTREGISTER);
          a_load_const_stack(list,s32inttype,-1,R_INTREGISTER);
        end;
-     g_call_system_proc(list,procname);
-     if ndim=1 then
-       begin
-         decstack(list,2);
-         if adddefaultlenparas then
-           decstack(list,2);
-       end
-     else
+     g_call_system_proc(list,procname,nil);
+     if ndim<>1 then
        begin
-         decstack(list,4);
          { pop return value, must be the same as dest }
          list.concat(taicpu.op_none(a_pop));
          decstack(list,1);
@@ -1318,7 +1319,7 @@ implementation
            (srsym.typ<>procsym) then
           Message1(cg_f_unknown_compilerproc,size.typename+'.fpcDeepCopy');
         pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
-        a_call_name(list,pd,pd.mangledname,false);
+        a_call_name(list,pd,pd.mangledname,nil,false);
         { both parameters are removed, no function result }
         decstack(list,2);
       end;
@@ -1330,11 +1331,9 @@ implementation
         a_load_ref_stack(list,size,dest,prepare_stack_for_ref(list,dest,false));
         { call set copy helper }
         if tsetdef(size).elementdef.typ=enumdef then
-          g_call_system_proc(list,'fpc_enumset_copy')
+          g_call_system_proc(list,'fpc_enumset_copy',nil)
         else
-          g_call_system_proc(list,'fpc_bitset_copy');
-        { both parameters are removed, no function result }
-        decstack(list,2);
+          g_call_system_proc(list,'fpc_bitset_copy',nil);
       end;
 
 
@@ -1353,7 +1352,7 @@ implementation
            (srsym.typ<>procsym) then
           Message1(cg_f_unknown_compilerproc,'ShortstringClass.FpcDeepCopy');
         pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
-        a_call_name(list,pd,pd.mangledname,false);
+        a_call_name(list,pd,pd.mangledname,nil,false);
         { both parameters are removed, no function result }
         decstack(list,2);
       end;
@@ -1543,22 +1542,22 @@ implementation
       a_load_const_stack(list,s32inttype,normaldim,R_INTREGISTER);
       { highloc is invalid, the length is part of the array in Java }
       if is_wide_or_unicode_string(t) then
-        g_call_system_proc(list,'fpc_initialize_array_unicodestring')
+        g_call_system_proc(list,'fpc_initialize_array_unicodestring',nil)
       else if is_ansistring(t) then
-        g_call_system_proc(list,'fpc_initialize_array_ansistring')
+        g_call_system_proc(list,'fpc_initialize_array_ansistring',nil)
       else if is_dynamic_array(t) then
-        g_call_system_proc(list,'fpc_initialize_array_dynarr')
+        g_call_system_proc(list,'fpc_initialize_array_dynarr',nil)
       else if is_record(t) or
               (t.typ=setdef) then
         begin
           tg.gethltemp(list,t,t.size,tt_persistent,eleref);
           a_load_ref_stack(list,t,eleref,prepare_stack_for_ref(list,eleref,false));
           if is_record(t) then
-            g_call_system_proc(list,'fpc_initialize_array_record')
+            g_call_system_proc(list,'fpc_initialize_array_record',nil)
           else if tsetdef(t).elementdef.typ=enumdef then
-            g_call_system_proc(list,'fpc_initialize_array_enumset')
+            g_call_system_proc(list,'fpc_initialize_array_enumset',nil)
           else
-            g_call_system_proc(list,'fpc_initialize_array_bitset');
+            g_call_system_proc(list,'fpc_initialize_array_bitset',nil);
           tg.ungettemp(list,eleref);
         end
       else if (t.typ=enumdef) then
@@ -1566,7 +1565,7 @@ implementation
           if get_enum_init_val_ref(t,eleref) then
             begin
               a_load_ref_stack(list,java_jlobject,eleref,prepare_stack_for_ref(list,eleref,false));
-              g_call_system_proc(list,'fpc_initialize_array_object');
+              g_call_system_proc(list,'fpc_initialize_array_object',nil);
             end;
         end
       else
@@ -1597,7 +1596,7 @@ implementation
               pd:=tprocdef(tprocsym(sym).procdeflist[0]);
             end;
           a_load_ref_stack(list,java_jlobject,ref,prepare_stack_for_ref(list,ref,false));
-          a_call_name(list,pd,pd.mangledname,false);
+          a_call_name(list,pd,pd.mangledname,nil,false);
           { parameter removed, no result }
           decstack(list,1);
         end
@@ -2060,6 +2059,31 @@ implementation
           end;
       end;
 
+
+  procedure thlcgjvm.g_adjust_stack_after_call(list: TAsmList; pd: tabstractprocdef; paraheight: longint; forceresdef: tdef);
+    var
+      totalremovesize: longint;
+      realresdef: tdef;
+    begin
+      if not assigned(forceresdef) then
+        realresdef:=pd.returndef
+      else
+        realresdef:=forceresdef;
+      { a constructor doesn't actually return a value in the jvm }
+      if (tabstractprocdef(pd).proctypeoption=potype_constructor) then
+        totalremovesize:=paraheight
+      else
+        { even a byte takes up a full stackslot -> align size to multiple of 4 }
+        totalremovesize:=paraheight-(align(realresdef.size,4) shr 2);
+      { remove parameters from internal evaluation stack counter (in case of
+        e.g. no parameters and a result, it can also increase) }
+      if totalremovesize>0 then
+        decstack(list,totalremovesize)
+      else if totalremovesize<0 then
+        incstack(list,-totalremovesize);
+    end;
+
+
   procedure thlcgjvm.allocate_implicit_struct_with_base_ref(list: TAsmList; vs: tabstractvarsym; ref: treference);
     var
       tmpref: treference;
@@ -2256,7 +2280,7 @@ implementation
         isdivu32:=false;
     end;
 
-  procedure thlcgjvm.a_call_name_intern(list: TAsmList; pd: tprocdef; const s: TSymStr; inheritedcall: boolean);
+  function thlcgjvm.a_call_name_intern(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; inheritedcall: boolean): tcgpara;
     var
       opc: tasmop;
     begin
@@ -2319,6 +2343,7 @@ implementation
           pd.init_paraloc_info(calleeside);
           list.concat(taicpu.op_sym_const(opc,current_asmdata.RefAsmSymbol(s),pd.calleeargareasize));
         end;
+      result:=get_call_result_cgpara(pd,forceresdef);
     end;
 
   procedure create_hlcodegen;

compiler/jvm/njvmcal.pas

@@ -439,33 +439,21 @@ implementation
 
     procedure tjvmcallnode.extra_post_call_code;
       var
-        totalremovesize: longint;
         realresdef: tdef;
       begin
-        if not assigned(typedef) then
-          realresdef:=tstoreddef(resultdef)
-        else
-          realresdef:=tstoreddef(typedef);
+        thlcgjvm(hlcg).g_adjust_stack_after_call(current_asmdata.CurrAsmList,procdefinition,pushedparasize,typedef);
         { a constructor doesn't actually return a value in the jvm }
-        if (tabstractprocdef(procdefinition).proctypeoption=potype_constructor) then
-          totalremovesize:=pushedparasize
-        else
+        if (tabstractprocdef(procdefinition).proctypeoption<>potype_constructor) then
           begin
-            { zero-extend unsigned 8/16 bit returns (we have to return them
-              sign-extended to keep the Android verifier happy, and even if that
-              one did not exist a plain Java routine could return a
-              sign-extended value) }
             if cnf_return_value_used in callnodeflags then
-              thlcgjvm(hlcg).maybe_resize_stack_para_val(current_asmdata.CurrAsmList,realresdef,false);
-            { even a byte takes up a full stackslot -> align size to multiple of 4 }
-            totalremovesize:=pushedparasize-(align(realresdef.size,4) shr 2);
+              begin
+                if not assigned(typedef) then
+                  realresdef:=tstoreddef(resultdef)
+                else
+                  realresdef:=tstoreddef(typedef);
+                thlcgjvm(hlcg).maybe_resize_stack_para_val(current_asmdata.CurrAsmList,realresdef,false);
+              end;
           end;
-        { remove parameters from internal evaluation stack counter (in case of
-          e.g. no parameters and a result, it can also increase) }
-        if totalremovesize>0 then
-          thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,totalremovesize)
-        else if totalremovesize<0 then
-          thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,-totalremovesize);
 
         { if this was an inherited constructor call, initialise all fields that
           are wrapped types following it }

compiler/jvm/njvminl.pas

@@ -38,8 +38,7 @@ interface
 
           function first_copy: tnode; override;
           function first_assigned: tnode; override;
-
-          function first_assert: tnode; override;
+          function first_get_frame: tnode; override;
 
           function first_box: tnode; override;
           function first_unbox: tnode; override;
@@ -242,17 +241,10 @@ implementation
       end;
 
 
-    function tjvminlinenode.first_assert: tnode;
-      var
-        paras: tcallparanode;
+    function tjvminlinenode.first_get_frame: tnode;
       begin
-        paras:=tcallparanode(tcallparanode(left).right);
-        paras:=ccallparanode.create(cstringconstnode.createstr(current_module.sourcefiles.get_file_name(current_filepos.fileindex)),paras);
-        paras:=ccallparanode.create(genintconstnode(fileinfo.line),paras);
-        result:=cifnode.create(cnotnode.create(tcallparanode(left).left),
-           ccallnode.createintern('fpc_assert',paras),nil);
-        tcallparanode(left).left:=nil;
-        tcallparanode(left).right:=nil;
+        { no frame pointer on the JVM target }
+        result:=cnilnode.create;
       end;
 
 

compiler/jvm/njvmmem.pas

@@ -415,7 +415,7 @@ implementation
                   (tprocsym(psym).ProcdefList.count<>1) then
                  internalerror(2011062607);
                thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,right.resultdef,right.location);
-               hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(tprocsym(psym).procdeflist[0]),tprocdef(tprocsym(psym).procdeflist[0]).mangledname,false);
+               hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(tprocsym(psym).procdeflist[0]),tprocdef(tprocsym(psym).procdeflist[0]).mangledname,nil,false);
                { call replaces self parameter with longint result -> no stack
                  height change }
                location_reset(right.location,LOC_REGISTER,OS_S32);

compiler/jvm/tgcpu.pas

@@ -85,7 +85,7 @@ unit tgcpu;
           end
         else
           internalerror(2011060301);
-        hlcg.a_call_name(list,pd,pd.mangledname,false);
+        hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
         thlcgjvm(hlcg).decstack(list,1);
         { store reference to instance }
         thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0);
@@ -146,7 +146,7 @@ unit tgcpu;
                         internalerror(2011062801);
                       pd:=tprocdef(tprocsym(sym).procdeflist[0]);
                     end;
-                  hlcg.a_call_name(list,pd,pd.mangledname,false);
+                  hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
                   { static calls method replaces parameter with set instance
                     -> no change in stack height }
                 end
@@ -169,7 +169,7 @@ unit tgcpu;
                     end
                   else
                     internalerror(2011062803);
-                  hlcg.a_call_name(list,pd,pd.mangledname,false);
+                  hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
                   { duplicate self pointer is removed }
                   thlcgjvm(hlcg).decstack(list,1);
                 end;
@@ -203,7 +203,7 @@ unit tgcpu;
                         internalerror(2011052404);
                       pd:=tprocdef(tprocsym(sym).procdeflist[0]);
                     end;
-                  hlcg.a_call_name(list,pd,pd.mangledname,false);
+                  hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
                   { static calls method replaces parameter with string instance
                     -> no change in stack height }
                   { store reference to instance }

compiler/link.pas

@@ -93,7 +93,7 @@ interface
          FCExeOutput : TExeOutputClass;
          FCObjInput  : TObjInputClass;
          { Libraries }
-         FStaticLibraryList : TFPHashObjectList;
+         FStaticLibraryList : TFPObjectList;
          FImportLibraryList : TFPHashObjectList;
          procedure Load_ReadObject(const para:TCmdStr);
          procedure Load_ReadStaticLibrary(const para:TCmdStr);
@@ -112,10 +112,10 @@ interface
          IsHandled : PBooleanArray;
          property CObjInput:TObjInputClass read FCObjInput write FCObjInput;
          property CExeOutput:TExeOutputClass read FCExeOutput write FCExeOutput;
-         property StaticLibraryList:TFPHashObjectList read FStaticLibraryList;
+         property StaticLibraryList:TFPObjectList read FStaticLibraryList;
          property ImportLibraryList:TFPHashObjectList read FImportLibraryList;
          procedure DefaultLinkScript;virtual;abstract;
-         procedure ConcatGenericSections(secnames:string);
+         procedure ScriptAddGenericSections(secnames:string);
          procedure ScriptAddSourceStatements(AddSharedAsStatic:boolean);virtual;
       public
          IsSharedLibrary : boolean;
@@ -848,7 +848,7 @@ Implementation
       begin
         inherited Create;
         linkscript:=TCmdStrList.Create;
-        FStaticLibraryList:=TFPHashObjectList.Create(true);
+        FStaticLibraryList:=TFPObjectList.Create(true);
         FImportLibraryList:=TFPHashObjectList.Create(true);
         exemap:=nil;
         exeoutput:=nil;
@@ -960,7 +960,7 @@ Implementation
           exit;
         Comment(V_Tried,'Opening library '+para);
         objreader:=TArObjectreader.create(para);
-        TStaticLibrary.Create(StaticLibraryList,para,objreader,CObjInput);
+        StaticLibraryList.Add(TStaticLibrary.Create(para,objreader,CObjInput));
       end;
 
 
@@ -1276,6 +1276,8 @@ Implementation
         ParseScript_Handle;
         { Load .o files and resolve symbols }
         ParseScript_Load;
+        if ErrorCount>0 then
+          goto myexit;
         exeoutput.ResolveSymbols(StaticLibraryList);
         { Generate symbols and code to do the importing }
         exeoutput.GenerateLibraryImports(ImportLibraryList);
@@ -1293,7 +1295,7 @@ Implementation
         { if UseStabs then, this would remove
           STABS for empty linker scripts }
           exeoutput.MergeStabs;
-        exeoutput.RemoveEmptySections;
+        exeoutput.MarkEmptySections;
         if ErrorCount>0 then
           goto myexit;
 
@@ -1375,7 +1377,7 @@ Implementation
       end;
 
 
-    procedure TInternalLinker.ConcatGenericSections(secnames:string);
+    procedure TInternalLinker.ScriptAddGenericSections(secnames:string);
       var
         secname:string;
       begin

compiler/m68k/cgcpu.pas

@@ -83,7 +83,6 @@ unit cgcpu;
         procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override;
         { generates overflow checking code for a node }
         procedure g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef); override;
-        procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);override;
 
         procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override;
         procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override;
@@ -1294,11 +1293,6 @@ unit cgcpu;
       begin
       end;
 
-    procedure tcg68k.g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);
-      begin
-      end;
-
-
     procedure tcg68k.g_proc_entry(list: TAsmList; localsize: longint; nostackframe:boolean);
       var
         r,rsp: TRegister;

compiler/m68k/cpuinfo.pas

@@ -75,7 +75,8 @@ Const
                                  genericlevel3optimizerswitches-
                                  { no need to write info about those }
                                  [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
-                                 [cs_opt_regvar,cs_opt_loopunroll,cs_opt_nodecse];
+                                 [cs_opt_regvar,cs_opt_loopunroll,cs_opt_nodecse,
+                                  cs_opt_reorder_fields,cs_opt_fastmath];
 
    level1optimizerswitches = genericlevel1optimizerswitches;
    level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + 

compiler/m68k/cpupara.pas

@@ -44,9 +44,8 @@ unit cpupara;
           procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
-          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
+          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override;
-          procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
           function parseparaloc(p : tparavarsym;const s : string) : boolean;override;
           function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;override;
@@ -187,23 +186,17 @@ unit cpupara;
         curfloatreg:=RS_FP0;
       end;
 
-    procedure tm68kparamanager.create_funcretloc_info(p: tabstractprocdef; side: tcallercallee);
-      begin
-        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
-      end;
-
-
-    function tm68kparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;
+    function tm68kparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       var
         paraloc : pcgparalocation;
         retcgsize  : tcgsize;
       begin
-        if set_common_funcretloc_info(p,def,retcgsize,result) then
+        if set_common_funcretloc_info(p,forcetempdef,retcgsize,result) then
           exit;
 
         paraloc:=result.add_location;
         { Return in FPU register? }
-        if not(cs_fp_emulation in current_settings.moduleswitches) and (p.returndef.typ=floatdef) then
+        if not(cs_fp_emulation in current_settings.moduleswitches) and (result.def.typ=floatdef) then
           begin
             paraloc^.loc:=LOC_FPUREGISTER;
             paraloc^.register:=NR_FPU_RESULT_REG;
@@ -292,7 +285,7 @@ unit cpupara;
             hp.paraloc[side].reset;
 
             { currently only support C-style array of const }
-            if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
+            if (p.proccalloption in cstylearrayofconst) and
                is_array_of_const(paradef) then
               begin
 {$ifdef DEBUG_CHARLIE}
@@ -556,7 +549,7 @@ unit cpupara;
         init_values(curintreg,curfloatreg,cur_stack_offset);
 
         result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,cur_stack_offset);
-        if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+        if (p.proccalloption in cstylearrayofconst) then
           { just continue loading the parameters in the registers }
           result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,cur_stack_offset)
         else

compiler/mips/aasmcpu.pas

@@ -28,7 +28,7 @@ interface
 uses
   cclasses,
   globtype, globals, verbose,
-  aasmbase, aasmsym, aasmtai,
+  aasmbase, aasmdata, aasmsym, aasmtai,
   cgbase, cgutils, cpubase, cpuinfo;
 
 const
@@ -78,11 +78,16 @@ type
   procedure InitAsm;
   procedure DoneAsm;
 
+  procedure fixup_jmps(list: TAsmList);
+
   function spilling_create_load(const ref: treference; r: tregister): taicpu;
   function spilling_create_store(r: tregister; const ref: treference): taicpu;
 
 implementation
 
+  uses
+    cutils;
+
 {*****************************************************************************
                                  taicpu Constructors
 *****************************************************************************}
@@ -452,6 +457,146 @@ procedure DoneAsm;
   end;
 
 
+procedure fixup_jmps(list: TAsmList);
+  var
+    p,pdelayslot: tai;
+    newcomment: tai_comment;
+    newjmp,newnoop: taicpu;
+    labelpositions: TFPList;
+    instrpos: ptrint;
+    l: tasmlabel;
+    inserted_something: boolean;
+  begin
+    // if certainly not enough instructions to cause an overflow, dont bother
+    if (list.count <= (high(smallint) div 4)) then
+      exit;
+    labelpositions := TFPList.create;
+    p := tai(list.first);
+    instrpos := 1;
+    // record label positions
+    while assigned(p) do
+      begin
+        if p.typ = ait_label then
+          begin
+            if (tai_label(p).labsym.labelnr >= labelpositions.count) then
+              labelpositions.count := tai_label(p).labsym.labelnr * 2;
+            labelpositions[tai_label(p).labsym.labelnr] := pointer(instrpos);
+          end;
+        { ait_const is for jump tables }
+        case p.typ of
+          ait_instruction:
+            { probleim here: pseudo-instructions can translate into
+              several CPU instructions, possibly depending on assembler options,
+              to obe on safe side, let's assume a mean of two. } 
+            inc(instrpos,2);
+          ait_const:
+            begin
+              if (tai_const(p).consttype<>aitconst_32bit) then
+                internalerror(2008052101);
+              inc(instrpos);
+            end;
+        end;
+        p := tai(p.next);
+      end;
+
+    { If the number of instructions is below limit, we can't overflow either }
+    if (instrpos <= (high(smallint) div 4)) then
+      exit;
+    // check and fix distances
+    repeat
+      inserted_something := false;
+      p := tai(list.first);
+      instrpos := 1;
+      while assigned(p) do
+        begin
+          case p.typ of
+            ait_label:
+              // update labelposition in case it changed due to insertion
+              // of jumps
+              begin
+                // can happen because of newly inserted labels
+                if (tai_label(p).labsym.labelnr > labelpositions.count) then
+                  labelpositions.count := tai_label(p).labsym.labelnr * 2;
+                labelpositions[tai_label(p).labsym.labelnr] := pointer(instrpos);
+              end;
+            ait_instruction:
+              begin
+                inc(instrpos,2);
+                case taicpu(p).opcode of
+                  A_BA:
+                    if (taicpu(p).oper[0]^.typ = top_ref) and
+                       assigned(taicpu(p).oper[0]^.ref^.symbol) and
+                       (taicpu(p).oper[0]^.ref^.symbol is tasmlabel) and
+                       (labelpositions[tasmlabel(taicpu(p).oper[0]^.ref^.symbol).labelnr] <> NIL) and
+{$push}
+{$q-}
+                       (ptruint(abs(ptrint(labelpositions[tasmlabel(taicpu(p).oper[0]^.ref^.symbol).labelnr]-instrpos)) - (low(smallint) div 4)) > ptruint((high(smallint) - low(smallint)) div 4)) then
+{$pop}
+                      begin
+                        { This is not PIC safe }
+                        taicpu(p).opcode:=A_J;
+                        newcomment:=tai_comment.create(strpnew('fixup_jmps, A_BA changed into A_J'));
+                        list.insertbefore(newcomment,p);
+                      end;
+                  A_BC:
+                    if (taicpu(p).ops=3) and (taicpu(p).oper[2]^.typ = top_ref) and
+                       assigned(taicpu(p).oper[2]^.ref^.symbol) and
+                       (taicpu(p).oper[2]^.ref^.symbol is tasmlabel) and
+                       (labelpositions[tasmlabel(taicpu(p).oper[2]^.ref^.symbol).labelnr] <> NIL) and
+{$push}
+{$q-}
+                       (ptruint(abs(ptrint(labelpositions[tasmlabel(taicpu(p).oper[2]^.ref^.symbol).labelnr]-instrpos)) - (low(smallint) div 4)) > ptruint((high(smallint) - low(smallint)) div 4)) then
+{$pop}
+                      begin
+                        // add a new label after this jump
+                        current_asmdata.getjumplabel(l);
+                        { new label -> may have to increase array size }
+                        if (l.labelnr >= labelpositions.count) then
+                          labelpositions.count := l.labelnr + 10;
+                        { newjmp will be inserted before the label, and it's inserted after }
+                        { plus delay slot                                                   } 
+                        { the current jump -> instrpos+3                                    }
+                        labelpositions[l.labelnr] := pointer(instrpos+2*3);
+                        pdelayslot:=tai(p.next);
+                        { We need to insert the new instruction after the delay slot instruction ! }
+                        while assigned(pdelayslot) and (pdelayslot.typ<>ait_instruction) do
+                          pdelayslot:=tai(pdelayslot.next);
+
+                        list.insertafter(tai_label.create(l),pdelayslot);
+                        // add a new unconditional jump between this jump and the label
+                        newcomment:=tai_comment.create(strpnew('fixup_jmps, A_BXX changed into A_BNOTXX label;A_J;label:'));
+                        list.insertbefore(newcomment,p);
+                        newjmp := taicpu.op_sym(A_J,taicpu(p).oper[2]^.ref^.symbol);
+                        newjmp.is_jmp := true;
+                        newjmp.fileinfo := taicpu(p).fileinfo;
+                        list.insertafter(newjmp,pdelayslot);
+                        inc(instrpos,2);
+                        { Add a delay slot for new A_J instruction }
+                        newnoop:=taicpu.op_none(A_NOP);
+                        newnoop.fileinfo := taicpu(p).fileinfo;
+                        list.insertafter(newnoop,newjmp);
+                        inc(instrpos,2);
+                        // change the conditional jump to point to the newly inserted label
+                        tasmlabel(taicpu(p).oper[2]^.ref^.symbol).decrefs;
+                        taicpu(p).oper[2]^.ref^.symbol := l;
+                        l.increfs;
+                        // and invert its condition code
+                        taicpu(p).condition := inverse_cond(taicpu(p).condition);
+                        // we inserted an instruction, so will have to check everything again
+                        inserted_something := true;
+                      end;
+                end;
+              end;
+            ait_const:
+              inc(instrpos);
+          end;
+          p := tai(p.next);
+        end;
+     until not inserted_something;
+    labelpositions.free;
+  end;
+
+
 begin
   cai_cpu   := taicpu;
   cai_align := tai_align;

compiler/mips/cgcpu.pas

@@ -508,6 +508,7 @@ procedure TCGMIPS.init_register_allocators;
 begin
   inherited init_register_allocators;
 
+  { Keep RS_R25, i.e. $t9 for PIC call }
   if (cs_create_pic in current_settings.moduleswitches) and assigned(current_procinfo) and
     (pi_needs_got in current_procinfo.flags) then
     begin
@@ -515,14 +516,14 @@ begin
       rg[R_INTREGISTER]    := Trgcpu.Create(R_INTREGISTER, R_SUBD,
         [RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,RS_R9,
        RS_R10,RS_R11,RS_R12,RS_R13,RS_R14,RS_R15,RS_R16,RS_R17,RS_R18,RS_R19,
-       RS_R20,RS_R21,RS_R22,RS_R23,RS_R24,RS_R25],
+       RS_R20,RS_R21,RS_R22,RS_R23,RS_R24{,RS_R25}],
         first_int_imreg, []);
     end
   else
     rg[R_INTREGISTER] := trgcpu.Create(R_INTREGISTER, R_SUBD,
       [RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,RS_R9,
        RS_R10,RS_R11,RS_R12,RS_R13,RS_R14,RS_R15,RS_R16,RS_R17,RS_R18,RS_R19,
-       RS_R20,RS_R21,RS_R22,RS_R23,RS_R24,RS_R25],
+       RS_R20,RS_R21,RS_R22,RS_R23,RS_R24{,RS_R25}],
       first_int_imreg, []);
 
 {
@@ -1323,12 +1324,7 @@ procedure TCGMIPS.a_jmp_always(List: tasmlist; l: TAsmLabel);
 var
   ai : Taicpu;
 begin
-  { Always use A_J instead of A_BA to avoid 
-    out of range error, but not for PIC code }
-  if (cs_create_pic in current_settings.moduleswitches) then
-    ai := taicpu.op_sym(A_BA, l)
-  else
-    ai := taicpu.op_sym(A_J, l);
+  ai := taicpu.op_sym(A_BA, l);
   list.concat(ai);
   { Delay slot }
   list.Concat(TAiCpu.Op_none(A_NOP));
@@ -1337,12 +1333,7 @@ end;
 
 procedure TCGMIPS.a_jmp_name(list: tasmlist; const s: string);
 begin
-  { Always use A_J instead of A_BA to avoid 
-    out of range error, but not for PIC code }
-  if (cs_create_pic in current_settings.moduleswitches) then
-    List.Concat(TAiCpu.op_sym(A_BA, current_asmdata.RefAsmSymbol(s)))
-  else
-    List.Concat(TAiCpu.op_sym(A_J, current_asmdata.RefAsmSymbol(s)));
+  List.Concat(TAiCpu.op_sym(A_BA, current_asmdata.RefAsmSymbol(s)));
   { Delay slot }
   list.Concat(TAiCpu.Op_none(A_NOP));
 end;

compiler/mips/cpuinfo.pas

@@ -68,7 +68,8 @@ Const
    );
 
    { Supported optimizations, only used for information }
-   supported_optimizerswitches = [cs_opt_regvar,cs_opt_loopunroll,cs_opt_nodecse];
+   supported_optimizerswitches = [cs_opt_regvar,cs_opt_loopunroll,cs_opt_nodecse,
+                                  cs_opt_reorder_fields,cs_opt_fastmath];
 
    level1optimizerswitches = [];
    level2optimizerswitches = level1optimizerswitches + [cs_opt_regvar,cs_opt_stackframe,cs_opt_nodecse];

compiler/mips/cpupara.pas

@@ -79,11 +79,10 @@ interface
         procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
         function  create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
         function  create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargsparalist):longint;override;
-        function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
+        function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
       private
         intparareg,
         intparasize : longint;
-        procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
         procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist);
       end;
 
@@ -181,22 +180,16 @@ implementation
       end;
 
 
-    procedure TMIPSParaManager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
-      begin
-        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
-      end;
-
-
-    function TMIPSParaManager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;
+    function TMIPSParaManager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       var
         paraloc : pcgparalocation;
         retcgsize  : tcgsize;
       begin
-        if set_common_funcretloc_info(p,def,retcgsize,result) then
+        if set_common_funcretloc_info(p,forcetempdef,retcgsize,result) then
           begin
             { Return is passed as var parameter,
               in this case we use the first register R4 for it }
-            if ret_in_param(def,p.proccalloption) then
+            if ret_in_param(result.def,p.proccalloption) then
               begin
                 if intparareg=0 then
                   inc(intparareg);
@@ -222,14 +215,14 @@ implementation
                   begin
                     getIntParaLoc(p.proccalloption,1,result.def,result);
                   end;
-                result.def:=getpointerdef(def);
+                result.def:=getpointerdef(result.def);
               end;
             exit;
           end;
 
         paraloc:=result.add_location;
         { Return in FPU register? }
-        if p.returndef.typ=floatdef then
+        if result.def.typ=floatdef then
           begin
             paraloc^.loc:=LOC_FPUREGISTER;
             paraloc^.register:=NR_FPU_RESULT_REG;
@@ -295,7 +288,7 @@ implementation
             paradef := hp.vardef;
 
             { currently only support C-style array of const }
-             if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
+             if (p.proccalloption in cstylearrayofconst) and
                is_array_of_const(paradef) then
               begin
                 paraloc:=hp.paraloc[side].add_location;

compiler/mips/hlcgcpu.pas

@@ -31,49 +31,81 @@ interface
 uses
   globtype,
   aasmbase, aasmdata,
-  symdef,
-  hlcgobj, hlcg2ll;
-  
+  cgbase, cgutils,
+  symtype,symdef,
+  parabase, hlcgobj, hlcg2ll;
+
   type
-    thlcg2mips = class(thlcg2ll)
-      procedure a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; weak: boolean);override;
-	end;
+    thlcgmips = class(thlcg2ll)
+      function a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara; override;
+      procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);override;
+      procedure a_call_ref(list : TAsmList;pd : tabstractprocdef;const ref : treference);override;
+  end;
 
   procedure create_hlcodegen;
 
 implementation
 
   uses
-	cgbase,
-	cgutils,
-	cgobj,
-	cpubase,
-	cgcpu;
+    aasmtai,
+    cutils,
+    cgobj,
+    cpubase,
+    cgcpu;
 
-  procedure thlcg2mips.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; weak: boolean);
+  function thlcgmips.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara;
     var
       ref : treference;
     begin
-      if pd.proccalloption =pocall_cdecl then
+      if pd.proccalloption=pocall_cdecl then
         begin
           { Use $gp/$t9 registers as the code might be in a shared library }
-		  reference_reset(ref,sizeof(aint));
-		  ref.symbol:=current_asmdata.RefAsmSymbol('_gp');
-		  cg.a_loadaddr_ref_reg(list,ref,NR_GP);
-		  reference_reset(ref,sizeof(aint));
-		  ref.symbol:=current_asmdata.RefAsmSymbol(s);
-		  ref.base:=NR_GP;
-		  ref.refaddr:=addr_pic;
-		  cg.a_loadaddr_ref_reg(list,ref,NR_PIC_FUNC);
-		  cg.a_call_reg(list,NR_PIC_FUNC);
+          reference_reset(ref,sizeof(aint));
+          ref.symbol:=current_asmdata.RefAsmSymbol('_gp');
+          list.concat(tai_comment.create(strpnew('Using PIC code for a_call_name')));
+          cg.a_loadaddr_ref_reg(list,ref,NR_GP);
+          reference_reset(ref,sizeof(aint));
+          ref.symbol:=current_asmdata.RefAsmSymbol(s);
+          ref.base:=NR_GP;
+      	  ref.refaddr:=addr_pic;
+          cg.a_loadaddr_ref_reg(list,ref,NR_PIC_FUNC);
+          cg.a_call_reg(list,NR_PIC_FUNC);
         end
       else
         cg.a_call_name(list,s,weak);
+      { set the result location }
+      result:=get_call_result_cgpara(pd,forceresdef);
+    end;
+
+  procedure thlcgmips.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister);
+    begin
+      if (pd.proccalloption=pocall_cdecl) and (reg<>NR_PIC_FUNC) then
+        begin
+          list.concat(tai_comment.create(strpnew('Using PIC code for a_call_reg')));
+          { Use $t9 register as the code might be in a shared library }
+          cg.a_load_reg_reg(list,OS_32,OS_32,reg,NR_PIC_FUNC);
+          cg.a_call_reg(list,NR_PIC_FUNC);
+        end
+      else
+        cg.a_call_reg(list,reg);
+    end;
+
+  procedure thlcgmips.a_call_ref(list: TAsmList; pd: tabstractprocdef; const ref: treference);
+    begin
+      if pd.proccalloption =pocall_cdecl then
+        begin
+          { Use $t9 register as the code might be in a shared library }
+          list.concat(tai_comment.create(strpnew('Using PIC code for a_call_ref')));
+          cg.a_loadaddr_ref_reg(list,ref,NR_PIC_FUNC);
+          cg.a_call_reg(list,NR_PIC_FUNC);
+        end
+      else
+        cg.a_call_ref(list,ref);
     end;
 
   procedure create_hlcodegen;
     begin
-      hlcg:=thlcg2mips.create;
+      hlcg:=thlcgmips.create;
       create_codegen;
     end;
 

compiler/msg/errord.msg

@@ -3240,8 +3240,6 @@ S*2Aas_Assembliere mit Hilfe von GNU AS
 **2Mtp_Versuche zu TP/BP 7.0 kompatibel zu sein
 **2Mmacpas_Versuche zu den MacIntosh Pascal-Dialekten kompatibel zu sein
 **1n_Standard-Konfigurationsdatei ignorieren
-**1N<x>_Node tree Optimierung
-**2Nu_Unroll loops
 **1o<x>_Die erzeugte, ausfhrbare Datei bekommt den Namen <x>
 **1O<x>_Optimierungen:
 **2O-_Optimierungen ausschalten

compiler/msg/errordu.msg

@@ -3241,8 +3241,6 @@ S*2Aas_Assembliere mit Hilfe von GNU AS
 **2Mtp_Versuche zu TP/BP 7.0 kompatibel zu sein
 **2Mmacpas_Versuche zu den MacIntosh Pascal-Dialekten kompatibel zu sein
 **1n_Standard-Konfigurationsdatei ignorieren
-**1N<x>_Node tree Optimierung
-**2Nu_Unroll loops
 **1o<x>_Die erzeugte, ausführbare Datei bekommt den Namen <x>
 **1O<x>_Optimierungen:
 **2O-_Optimierungen ausschalten

compiler/msg/errore.msg

@@ -390,7 +390,7 @@ scan_w_unavailable_system_codepage=02091_W_Current system codepage "$1" is not a
 #
 # Parser
 #
-# 03321 is the last used one
+# 03322 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1199,8 +1199,8 @@ parser_e_forward_mismatch=03249_E_Forward type definition does not match
 % when being implemented. A forward interface cannot be changed into a class.
 parser_n_ignore_lower_visibility=03250_N_Virtual method "$1" has a lower visibility ($2) than parent class $3 ($4)
 % The virtual method overrides an method that is declared with a higher visibility. This might give
-% unexpected results. In case the new visibility is private than it might be that a call to inherited in a
-% new child class will call the higher visible method in a parent class and ignores the private method.
+% unexpected results. E.g., in case the new visibility is private then a call to ``inherited'' in a
+% new child class will call the higher-visible method in a parent class and ignores the private method.
 parser_e_field_not_allowed_here=03251_E_Fields cannot appear after a method or property definition, start a new visibility section first
 % Once a method or property has been defined in a class or object, you cannot define any fields afterwards
 % without starting a new visibility section (such as \var{public}, \var{private}, etc.). The reason is
@@ -1444,10 +1444,12 @@ parser_e_jvm_invalid_virtual_constructor_call=03321_E_Calling a virtual construc
 % The JVM does not natively support virtual constructor. Unforunately, we are not aware of a way to
 % emulate them in a way that makes it possible to support calling virtual constructors
 % for the current instance inside another constructor.
+parser_e_method_lower_visibility=03322_E_Overring method "$1" cannot have a lower visibility ($2) than in parent class $3 ($4)
+% The JVM does not allow lowering the visibility of an overriding method.
 % \end{description}
 # Type Checking
 #
-# 04117 is the last used one
+# 04119 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -1864,6 +1866,11 @@ type_e_interface_lower_visibility=04117_E_The interface method "$1" has a higher
 % warning that is disabled by default because such situations are common
 % practice, but it can be enabled in case you are concerned with keeping your
 % code compilable for the JVM target.
+type_e_typeof_requires_vmt=04118_E_TYPEOF can only be used on object types with VMT
+% Typeof() intrinsic returns pointer to VMT of its argument. It cannot be used on object types that do not have VMT.
+type_e_invalid_default_value=04119_E_It is not possible to define a default value for a parameter of type "$1"
+% Parameters declared as structured types, such as files, variants, non-dynamic
+% arrays and TP-style objects, cannot have a default value.
 % \end{description}
 #
 # Symtable
@@ -3382,8 +3389,6 @@ J*2Cv_Var/out parameter copy-out checking
 **2Mtp_TP/BP 7.0 compatibility mode
 **2Mmacpas_Macintosh Pascal dialects compatibility mode
 **1n_Do not read the default config files
-**1N<x>_Node tree optimizations
-**2Nu_Unroll loops
 **1o<x>_Change the name of the executable produced to <x>
 **1O<x>_Optimizations:
 **2O-_Disable optimizations

compiler/msg/errorhe.msg

@@ -2564,8 +2564,6 @@ S*2Aas_
 **2Mtp_מנסה להיות תואם ל TP/BP 7.0
 **2Mmacpas_מנסה להיות תואם ללהג של Macintosh Pascal
 **1n_אל תקרא את קובץ הגדרות ברירת המחדל
-**1N<x>_מיטוב צמתי עץ
-**2Nu_לגולל לולאות
 **1o<x>_שנה את שם קובץ הריצה שהתקבל ל <x>
 **1O<x>_מיטובים:
 **2O-_בטל מיטוב

compiler/msg/errorheu.msg

@@ -2564,8 +2564,6 @@ S*2Aas_אסוף עם GNU AS
 **2Mtp_מנסה להיות תואם ל TP/BP 7.0
 **2Mmacpas_מנסה להיות תואם ללהג של Macintosh Pascal
 **1n_אל תקרא את קובץ הגדרות ברירת המחדל
-**1N<x>_מיטוב צמתי עץ
-**2Nu_לגולל לולאות
 **1o<x>_שנה את שם קובץ הריצה שהתקבל ל <x>
 **1O<x>_מיטובים:
 **2O-_בטל מיטוב

compiler/msg/errorid.msg

@@ -2580,8 +2580,6 @@ S*2Aas_Rangkai menggunakan GNU AS
 **2Mtp_Mode kompatibilitas TP/BP 7.0
 **2Mmacpas_Mode kompatibilitas dialek Macintosh Pascal
 **1n_Jangan baca file konfigurasi standar
-**1N<x>_Optimasi susunan node
-**2Nu_Jangan gulung pengulangan
 **1o<x>_Ubah nama executable yang dihasilkan ke <x>
 **1O<x>_Optimasi:
 **2O-_Matikan optimasi

compiler/msg/erroriu.msg

@@ -2876,8 +2876,6 @@ S*2Aas_Assembla con GNU AS
 **2Mtp_Modo compatibilità TP/BP 7.0 
 **2Mmacpas_Modo compatibilità Macintosh Pascal e dialetti
 **1n_Non leggere i file configurazione di default
-**1N<x>_Ottimizzazioni dell'albero dei nodi
-**2Nu_Srotola i loop
 **1o<x>_Rinomina l'eseguibile prodotto in <x>
 **1O<x>_Ottimizzazioni:
 **2O-_Disabilita le ottimizzazioni

compiler/msg/errorpl.msg

@@ -2259,8 +2259,6 @@ S*2Aas_asemblacja przy u
 **2Mgpc_kompatybilno�† z gpc
 **2Mmac_kompatybilno�† z dialektami pascala na Macintosha
 **1n_zignorowanie standardowego pliku konfiguracyjnego
-**1N<x>optymalizacje w©z�˘w drzewa
-**2Nu_rozwijanie p©tli
 **1o<x>_zmiana nazwy skompilowanego programu na <x>
 3*1O<x>_optymalizacje:
 3*2Og_generacja mniejszego kodu

compiler/msg/errorpli.msg

@@ -2259,8 +2259,6 @@ S*2Aas_asemblacja przy u
 **2Mgpc_kompatybilność z gpc
 **2Mmac_kompatybilność z dialektami pascala na Macintosha
 **1n_zignorowanie standardowego pliku konfiguracyjnego
-**1N<x>optymalizacje węzłów drzewa
-**2Nu_rozwijanie pętli
 **1o<x>_zmiana nazwy skompilowanego programu na <x>
 3*1O<x>_optymalizacje:
 3*2Og_generacja mniejszego kodu

compiler/msg/errorpt.msg

@@ -3270,8 +3270,6 @@ S*2Aas_Monta usando o GNU AS
 **2Mtp_Modo compatibilidade TP/BP 7.0
 **2Mmacpas_Modo compatibilidade dialetos Macintosh Pascal
 **1n_NÆo ler os arquivos de configura‡äes padrÆo
-**1N<x>_Otimiza‡äes n¢s  rvore
-**2Nu_Desdobra la‡os
 **1o<x>_Altera o nome do execut vel produzido para <x>
 **1O<x>_Otimiza‡äes:
 **2O-_Disabilita otimiza‡äes

compiler/msg/errorptu.msg

@@ -3270,8 +3270,6 @@ S*2Aas_Monta usando o GNU AS
 **2Mtp_Modo compatibilidade TP/BP 7.0
 **2Mmacpas_Modo compatibilidade dialetos Macintosh Pascal
 **1n_Não ler os arquivos de configurações padrão
-**1N<x>_Otimizações nós árvore
-**2Nu_Desdobra laços
 **1o<x>_Altera o nome do executável produzido para <x>
 **1O<x>_Otimizações:
 **2O-_Disabilita otimizações

compiler/msg/errorr.msg

@@ -2679,8 +2679,6 @@ S*2Aas_
 **2Mtp_¥¦¨¬ ᮢ¬¥á⨬®á⨠á TP/BP 7.0
 **2Mmacpas_¥¦¨¬ ᮢ¬¥á⨬®áâ¨ á ¤¨ «¥ªâ ¬¨ Macintosh Pascal
 **1n_¥ ç¨â âì áâ ­¤ pâ­ë¥ ä ©«ë ª®­ä¨£ãà æ¨¨
-**1N<x>_Ž¯â¨¬¨§ æ¨ï £à ä 
-**2Nu_ §¢®à ç¨¢ âì 横«ë
 **1o<x>_ˆ§¬¥­¨âì ¨¬ï ¯®«ãç ¥¬®£® ¨á¯®«­ï¥¬®£® ä ©«  ­  <x>
 **1O<x>_Ž¯â¨¬¨§ æ¨¨:
 **2O-_Žâª«îç¨âì ®¯â¨¬¨§ æ¨¨

compiler/msg/errorru.msg

@@ -2679,8 +2679,6 @@ S*2Aas_Ассемблер GNU AS
 **2Mtp_Режим совместимости с TP/BP 7.0
 **2Mmacpas_Режим совместимости с диалектами Macintosh Pascal
 **1n_Не читать стандаpтные файлы конфигурации
-**1N<x>_Оптимизация графа
-**2Nu_Разворачивать циклы
 **1o<x>_Изменить имя получаемого исполняемого файла на <x>
 **1O<x>_Оптимизации:
 **2O-_Отключить оптимизации

compiler/msgidx.inc

@@ -416,6 +416,7 @@ const
   parser_d_internal_parser_string=03319;
   parser_e_feature_unsupported_for_vm=03320;
   parser_e_jvm_invalid_virtual_constructor_call=03321;
+  parser_e_method_lower_visibility=03322;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -524,6 +525,8 @@ const
   type_e_no_managed_assign_generic_typecast=04115;
   type_w_interface_lower_visibility=04116;
   type_e_interface_lower_visibility=04117;
+  type_e_typeof_requires_vmt=04118;
+  type_e_invalid_default_value=04119;
   sym_e_id_not_found=05000;
   sym_f_internal_error_in_symtablestack=05001;
   sym_e_duplicate_id=05002;
@@ -943,9 +946,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 65908;
+  MsgTxtSize = 66090;
 
   MsgIdxMax : array[1..20] of longint=(
-    26,92,322,118,87,56,116,26,202,63,
+    26,92,323,120,87,56,116,26,202,63,
     53,20,1,1,1,1,1,1,1,1
   );

compiler/nbas.pas

@@ -140,7 +140,11 @@ interface
          { this temp only allows reading (makes it possible to safely use as
            reference under more circumstances)
          }
-         ti_readonly);
+         ti_readonly,
+         { if this is a managed temp, it doesn't have to be finalised before use
+         }
+         ti_nofini
+         );
        ttempinfoflags = set of ttempinfoflag;
 
      const

compiler/ncal.pas

@@ -2392,6 +2392,11 @@ implementation
                   (cnf_do_inline in callnodeflags) and
                   not(tabstractvarsym(tprocdef(procdefinition).funcretsym).varregable in [vr_none,vr_addr]));
                 include(temp.flags,nf_is_funcret);
+                { if a managed type is returned by reference, assigning something
+                  to the result on the caller side will take care of decreasing
+                  the reference count }
+                if paramanager.ret_in_param(resultdef,procdefinition.proccalloption) then
+                  include(ttempcreatenode(temp).tempinfo^.flags,ti_nofini);
                 add_init_statement(temp);
                 { When the function result is not used in an inlined function
                   we need to delete the temp. This can currently only be done by

compiler/ncgbas.pas

@@ -405,8 +405,10 @@ interface
                 location_reset_ref(tempinfo^.location,LOC_REFERENCE,def_cgsize(tempinfo^.typedef),0);
                 tg.gethltemptyped(current_asmdata.CurrAsmList,tempinfo^.typedef,tempinfo^.temptype,tempinfo^.location.reference);
                 { the temp could have been used previously either because the memory location was reused or
-                  because we're in a loop }
-                hlcg.g_finalize(current_asmdata.CurrAsmList,tempinfo^.typedef,tempinfo^.location.reference);
+                  because we're in a loop. In case it's used as a function result, that doesn't matter
+                  because it will be finalized when assigned to. }
+                if not(ti_nofini in tempinfo^.flags) then
+                  hlcg.g_finalize(current_asmdata.CurrAsmList,tempinfo^.typedef,tempinfo^.location.reference);
               end
             else if (ti_may_be_in_reg in tempinfo^.flags) then
               begin

compiler/ncgcal.pas

@@ -530,7 +530,7 @@ implementation
                          if (hp2.nodetype=typeconvn) and
                             (tunarynode(hp2).left.nodetype=addrn) then
                            hp2:=tunarynode(tunarynode(hp2).left).left
-                         else if tunarynode(hp2).nodetype=addrn then
+                         else if hp2.nodetype=addrn then
                            hp2:=tunarynode(hp2).left;
                          location_freetemp(current_asmdata.CurrAsmList,hp2.location);
                          hp:=tarrayconstructornode(hp).right;
@@ -835,9 +835,9 @@ implementation
                  { call method }
                  extra_call_code;
 {$ifdef x86}
-                 cg.a_call_ref(current_asmdata.CurrAsmList,href);
+                 hlcg.a_call_ref(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),href);
 {$else x86}
-                 cg.a_call_reg(current_asmdata.CurrAsmList,pvreg);
+                 hlcg.a_call_reg(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),pvreg);
 {$endif x86}
                  extra_post_call_code;
                end
@@ -872,9 +872,9 @@ implementation
                         if cnf_inherited in callnodeflags then
                           hlcg.a_call_name_inherited(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname)
                         else
-                          hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname,po_weakexternal in procdefinition.procoptions)
+                          hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname,typedef,po_weakexternal in procdefinition.procoptions).resetiftemp
                       else
-                        hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,po_weakexternal in procdefinition.procoptions);
+                        hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,typedef,po_weakexternal in procdefinition.procoptions).resetiftemp;
                       extra_post_call_code;
                     end;
                end;
@@ -913,7 +913,7 @@ implementation
               if (po_interrupt in procdefinition.procoptions) then
                 extra_interrupt_code;
               extra_call_code;
-              cg.a_call_reg(current_asmdata.CurrAsmList,pvreg);
+              hlcg.a_call_reg(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),pvreg);
               extra_post_call_code;
            end;
 
@@ -1019,8 +1019,7 @@ implementation
 
     destructor tcgcallnode.destroy;
       begin
-        if assigned(typedef) then
-          retloc.done;
+        retloc.resetiftemp;
         inherited destroy;
       end;
 

compiler/ncgcon.pas

@@ -32,12 +32,10 @@ interface
 
     type
        tcgdataconstnode = class(tdataconstnode)
-          function pass_1 : tnode;override;
           procedure pass_generate_code;override;
        end;
 
        tcgrealconstnode = class(trealconstnode)
-          function pass_1 : tnode;override;
           procedure pass_generate_code;override;
        end;
 
@@ -50,12 +48,10 @@ interface
        end;
 
        tcgstringconstnode = class(tstringconstnode)
-          function pass_1 : tnode;override;
           procedure pass_generate_code;override;
        end;
 
        tcgsetconstnode = class(tsetconstnode)
-          function pass_1 : tnode;override;
          protected
           function emitvarsetconst: tasmsymbol; virtual;
           procedure handlevarsetconst;
@@ -68,7 +64,6 @@ interface
        end;
 
        tcgguidconstnode = class(tguidconstnode)
-          function pass_1 : tnode;override;
           procedure pass_generate_code;override;
        end;
 
@@ -79,7 +74,7 @@ implementation
       globtype,widestr,systems,
       verbose,globals,cutils,
       symconst,symdef,aasmtai,aasmdata,aasmcpu,defutil,
-      procinfo,cpuinfo,cpubase,
+      cpuinfo,cpubase,
       cgbase,cgobj,cgutils,
       ncgutil, cclasses,asmutils,tgobj
       ;
@@ -89,20 +84,6 @@ implementation
                            TCGREALCONSTNODE
 *****************************************************************************}
 
-
-    procedure needs_got_for_pic;
-	  begin
-        if (cs_create_pic in current_settings.moduleswitches) and
-		   assigned(current_procinfo) then
-          include(current_procinfo.flags,pi_needs_got);
-      end;
-
-    function tcgdataconstnode.pass_1 : tnode;
-	  begin
-        pass_1:=inherited pass_1;
-		needs_got_for_pic;
-	  end;
-
     procedure tcgdataconstnode.pass_generate_code;
       var
         l : tasmlabel;
@@ -127,12 +108,6 @@ implementation
                            TCGREALCONSTNODE
 *****************************************************************************}
 
-    function tcgrealconstnode.pass_1 : tnode;
-	  begin
-        pass_1:=inherited pass_1;
-		needs_got_for_pic;
-	  end;
-
     procedure tcgrealconstnode.pass_generate_code;
       { I suppose the parser/pass_1 must make sure the generated real  }
       { constants are actually supported by the target processor? (JM) }
@@ -280,12 +255,6 @@ implementation
                           TCGSTRINGCONSTNODE
 *****************************************************************************}
 
-    function tcgstringconstnode.pass_1 : tnode;
-	  begin
-        pass_1:=inherited pass_1;
-		needs_got_for_pic;
-	  end;
-
     procedure tcgstringconstnode.pass_generate_code;
       var
          lastlabel: tasmlabofs;
@@ -420,12 +389,6 @@ implementation
 {*****************************************************************************
                            TCGSETCONSTNODE
 *****************************************************************************}
-    function tcgsetconstnode.pass_1 : tnode;
-	  begin
-        pass_1:=inherited pass_1;
-		needs_got_for_pic;
-	  end;
-
 
     function tcgsetconstnode.emitvarsetconst: tasmsymbol;
       type
@@ -560,12 +523,6 @@ implementation
                           TCGGUIDCONSTNODE
 *****************************************************************************}
 
-    function tcgguidconstnode.pass_1 : tnode;
-	  begin
-        pass_1:=inherited pass_1;
-		needs_got_for_pic;
-	  end;
-
     procedure tcgguidconstnode.pass_generate_code;
       var
         tmplabel : TAsmLabel;
@@ -595,5 +552,4 @@ begin
    csetconstnode:=tcgsetconstnode;
    cnilnode:=tcgnilnode;
    cguidconstnode:=tcgguidconstnode;
-   global_used:=@needs_got_for_pic;
 end.

compiler/ncginl.pas

@@ -31,7 +31,6 @@ interface
     type
        tcginlinenode = class(tinlinenode)
           procedure pass_generate_code;override;
-          procedure second_assert;virtual;
           procedure second_sizeoftypeof;virtual;
           procedure second_length;virtual;
           procedure second_predsucc;virtual;
@@ -65,7 +64,7 @@ implementation
 
     uses
       globtype,systems,constexp,
-      cutils,verbose,globals,fmodule,
+      cutils,verbose,globals,
       symconst,symdef,defutil,symsym,
       aasmbase,aasmtai,aasmdata,aasmcpu,parabase,
       cgbase,pass_1,pass_2,
@@ -89,8 +88,6 @@ implementation
          location_reset(location,LOC_VOID,OS_NO);
 
          case inlinenumber of
-            in_assert_x_y:
-              second_Assert;
             in_sizeof_x,
             in_typeof_x :
               second_SizeofTypeOf;
@@ -185,75 +182,6 @@ implementation
       end;
 
 
-{*****************************************************************************
-                          ASSERT GENERIC HANDLING
-*****************************************************************************}
-    procedure tcginlinenode.second_Assert;
-     var
-       hp2,hp3 : tnode;
-       otlabel,oflabel : tasmlabel;
-       paraloc1,paraloc2,
-       paraloc3,paraloc4 : tcgpara;
-     begin
-       { the node should be removed in the firstpass }
-       if not (cs_do_assertion in current_settings.localswitches) then
-          internalerror(7123458);
-       paraloc1.init;
-       paraloc2.init;
-       paraloc3.init;
-       paraloc4.init;
-       paramanager.getintparaloc(pocall_default,1,getpointerdef(cshortstringtype),paraloc1);
-       paramanager.getintparaloc(pocall_default,2,getpointerdef(cshortstringtype),paraloc2);
-       paramanager.getintparaloc(pocall_default,3,s32inttype,paraloc3);
-       paramanager.getintparaloc(pocall_default,4,voidpointertype,paraloc4);
-       otlabel:=current_procinfo.CurrTrueLabel;
-       oflabel:=current_procinfo.CurrFalseLabel;
-       current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
-       current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
-       secondpass(tcallparanode(left).left);
-       maketojumpbool(current_asmdata.CurrAsmList,tcallparanode(left).left,lr_load_regvars);
-       cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
-       { First call secondpass() before we can push the parameters, otherwise
-         parameters allocated in the registers can be destroyed }
-       { generate filename string parameter }
-       hp2:=ctypeconvnode.create(cstringconstnode.createstr(current_module.sourcefiles.get_file_name(current_filepos.fileindex)),cshortstringtype);
-       firstpass(hp2);
-       secondpass(hp2);
-       if codegenerror then
-          exit;
-       { message parameter }
-       hp3:=tcallparanode(tcallparanode(left).right).left;
-       secondpass(hp3);
-       if codegenerror then
-          exit;
-       { push erroraddr }
-       cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_ADDR,NR_FRAME_POINTER_REG,paraloc4);
-       { push lineno }
-       cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_S32,current_filepos.line,paraloc3);
-       { push filename }
-       cg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,hp2.location.reference,paraloc2);
-       { push msg }
-       cg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,hp3.location.reference,paraloc1);
-       { call }
-       paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
-       paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc2);
-       paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc3);
-       paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc4);
-       cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-       cg.a_call_name(current_asmdata.CurrAsmList,'FPC_ASSERT',false);
-       cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
-       location_freetemp(current_asmdata.CurrAsmList,hp3.location);
-       location_freetemp(current_asmdata.CurrAsmList,hp2.location);
-       cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
-       current_procinfo.CurrTrueLabel:=otlabel;
-       current_procinfo.CurrFalseLabel:=oflabel;
-       paraloc1.done;
-       paraloc2.done;
-       paraloc3.done;
-       paraloc4.done;
-       hp2.free;
-     end;
-
 
 {*****************************************************************************
                           SIZEOF / TYPEOF GENERIC HANDLING
@@ -304,7 +232,7 @@ implementation
                    begin
                      { deref class }
                      cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.reference,hregister);
-                     cg.g_maybe_testself(current_asmdata.CurrAsmList,hregister);
+                     hlcg.g_maybe_testself(current_asmdata.CurrAsmList,left.resultdef,hregister);
                      { load VMT pointer }
                      reference_reset_base(hrefvmt,hregister,tobjectdef(left.resultdef).vmt_offset,sizeof(pint));
                      cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,hrefvmt,hregister);

compiler/ncgutil.pas

@@ -413,9 +413,6 @@ implementation
     procedure new_exception(list:TAsmList;const t:texceptiontemps;exceptlabel:tasmlabel);
       var
         paraloc1,paraloc2,paraloc3 : tcgpara;
-{$ifdef MIPS}
-		sbl : tasmlabel;
-{$endif MIPS}
       begin
         paraloc1.init;
         paraloc2.init;
@@ -443,14 +440,7 @@ implementation
         cg.alloccpuregisters(list,R_INTREGISTER,[RS_FUNCTION_RESULT_REG]);
 
         cg.g_exception_reason_save(list, t.reasonbuf);
-{$ifdef MIPS}
-        current_asmdata.getjumplabel(sbl);
-		cg.a_cmp_const_reg_label(list,OS_S32,OC_EQ,0,cg.makeregsize(list,NR_FUNCTION_RESULT_REG,OS_S32),sbl);
-        cg.a_jmp_always(list,exceptlabel);
-        cg.a_label(list,sbl);
-{$else not MIPS}
-          cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,cg.makeregsize(list,NR_FUNCTION_RESULT_REG,OS_S32),exceptlabel);
-{$endif not MIPS}
+        cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,cg.makeregsize(list,NR_FUNCTION_RESULT_REG,OS_S32),exceptlabel);
         cg.dealloccpuregisters(list,R_INTREGISTER,[RS_FUNCTION_RESULT_REG]);
         paraloc1.done;
         paraloc2.done;
@@ -669,7 +659,7 @@ implementation
                       internalerror(200306061);
                     hreg:=cg.getaddressregister(list);
                     if not is_packed_array(tparavarsym(p).vardef) then
-                      cg.g_copyvaluepara_openarray(list,href,hsym.initialloc,tarraydef(tparavarsym(p).vardef).elesize,hreg)
+                      hlcg.g_copyvaluepara_openarray(list,href,hsym.initialloc,tarraydef(tparavarsym(p).vardef),hreg)
                     else
                       internalerror(2006080401);
 //                      cg.g_copyvaluepara_packedopenarray(list,href,hsym.intialloc,tarraydef(tparavarsym(p).vardef).elepackedbitsize,hreg);
@@ -1905,6 +1895,7 @@ implementation
     procedure gen_load_vmt_register(list:TAsmList;objdef:tobjectdef;selfloc:tlocation;var vmtreg:tregister);
       var
         href : treference;
+        selfdef: tdef;
       begin
         if is_object(objdef) then
           begin
@@ -1914,6 +1905,7 @@ implementation
                 begin
                   reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset,sizeof(pint));
                   cg.a_loadaddr_ref_reg(list,selfloc.reference,href.base);
+                  selfdef:=getpointerdef(objdef);
                 end;
               else
                 internalerror(200305056);
@@ -1924,6 +1916,7 @@ implementation
             and the first "field" of an Objective-C class instance is a pointer
             to its "meta-class".  }
           begin
+            selfdef:=objdef;
             case selfloc.loc of
               LOC_REGISTER:
                 begin
@@ -1951,7 +1944,7 @@ implementation
             end;
           end;
         vmtreg:=cg.getaddressregister(list);
-        cg.g_maybe_testself(list,href.base);
+        hlcg.g_maybe_testself(list,selfdef,href.base);
         cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,vmtreg);
 
         { test validity of VMT }

compiler/ncnv.pas

@@ -134,6 +134,7 @@ interface
           function first_cstring_to_int : tnode;virtual;
           function first_string_to_chararray : tnode;virtual;
           function first_char_to_string : tnode;virtual;
+          function first_char_to_chararray : tnode; virtual;
           function first_nothing : tnode;virtual;
           function first_array_to_pointer : tnode;virtual;
           function first_int_to_real : tnode;virtual;
@@ -163,6 +164,7 @@ interface
           function _first_cstring_to_int : tnode;
           function _first_string_to_chararray : tnode;
           function _first_char_to_string : tnode;
+          function _first_char_to_chararray : tnode;
           function _first_nothing : tnode;
           function _first_array_to_pointer : tnode;
           function _first_int_to_real : tnode;
@@ -1277,16 +1279,7 @@ implementation
 
     function ttypeconvnode.typecheck_char_to_chararray : tnode;
       begin
-        if resultdef.size <> 1 then
-          begin
-            { convert first to string, then to chararray }
-            inserttypeconv(left,cshortstringtype);
-            inserttypeconv(left,resultdef);
-            result:=left;
-            left := nil;
-            exit;
-          end;
-        result := nil;
+        result:=nil;
       end;
 
 
@@ -1335,13 +1328,15 @@ implementation
         if left.nodetype=ordconstn then
          begin
            v:=tordconstnode(left).value;
-           if is_currency(resultdef) then
+           if is_currency(resultdef) and
+              not(nf_internal in flags) then
              v:=v*10000;
            if (resultdef.typ=pointerdef) then
              result:=cpointerconstnode.create(TConstPtrUInt(v.uvalue),resultdef)
            else
              begin
-               if is_currency(left.resultdef) then
+               if is_currency(left.resultdef) and
+                  not(nf_internal in flags) then
                  v:=v div 10000;
                result:=cordconstnode.create(v,resultdef,false);
              end;
@@ -1353,18 +1348,25 @@ implementation
              result:=cpointerconstnode.create(v.uvalue,resultdef)
            else
              begin
-               if is_currency(resultdef) then
+               if is_currency(resultdef) and
+                  not(nf_internal in flags) then
                  v:=v*10000;
                result:=cordconstnode.create(v,resultdef,false);
              end;
          end
         else
          begin
+           if (is_currency(resultdef) or
+               is_currency(left.resultdef)) and
+              (nf_internal in flags) then
+             begin
+               include(flags,nf_is_currency)
+             end
            { multiply by 10000 for currency. We need to use getcopy to pass
              the argument because the current node is always disposed. Only
              inserting the multiply in the left node is not possible because
              it'll get in an infinite loop to convert int->currency }
-           if is_currency(resultdef) then
+           else if is_currency(resultdef) then
             begin
               result:=caddnode.create(muln,getcopy,cordconstnode.create(10000,resultdef,false));
               include(result.flags,nf_is_currency);
@@ -1386,19 +1388,27 @@ implementation
         if left.nodetype=ordconstn then
          begin
            rv:=tordconstnode(left).value;
-           if is_currency(resultdef) then
+           if is_currency(resultdef) and
+              not(nf_internal in flags) then
              rv:=rv*10000.0
-           else if is_currency(left.resultdef) then
+           else if is_currency(left.resultdef) and
+              not(nf_internal in flags) then
              rv:=rv/10000.0;
            result:=crealconstnode.create(rv,resultdef);
          end
         else
          begin
+           if (is_currency(resultdef) or
+               is_currency(left.resultdef)) and
+              (nf_internal in flags) then
+             begin
+               include(flags,nf_is_currency)
+             end
            { multiply by 10000 for currency. We need to use getcopy to pass
              the argument because the current node is always disposed. Only
              inserting the multiply in the left node is not possible because
              it'll get in an infinite loop to convert int->currency }
-           if is_currency(resultdef) then
+           else if is_currency(resultdef) then
             begin
               result:=caddnode.create(muln,getcopy,crealconstnode.create(10000.0,resultdef));
               include(result.flags,nf_is_currency);
@@ -2138,7 +2148,11 @@ implementation
 
         if convtype=tc_none then
           begin
-            cdoptions:=[cdo_check_operator,cdo_allow_variant,cdo_warn_incompatible_univ];
+            cdoptions:=[cdo_allow_variant,cdo_warn_incompatible_univ];
+            { overloaded operators require calls, which is not possible inside
+              a constant declaration }
+            if block_type<>bt_const then
+              include(cdoptions,cdo_check_operator);
             if nf_explicit in flags then
               include(cdoptions,cdo_explicit);
             if nf_internal in flags then
@@ -2825,6 +2839,22 @@ implementation
       end;
 
 
+    function ttypeconvnode.first_char_to_chararray : tnode;
+
+      begin
+        if resultdef.size <> 1 then
+          begin
+            { convert first to string, then to chararray }
+            inserttypeconv(left,cshortstringtype);
+            inserttypeconv(left,resultdef);
+            result:=left;
+            left := nil;
+            exit;
+          end;
+        result := nil;
+      end;
+
+
     function ttypeconvnode.first_nothing : tnode;
       begin
          first_nothing:=nil;
@@ -3069,7 +3099,8 @@ implementation
     function ttypeconvnode.first_bool_to_bool : tnode;
       begin
          first_bool_to_bool:=nil;
-         if (left.expectloc in [LOC_FLAGS,LOC_JUMP]) then
+         if (left.expectloc in [LOC_FLAGS,LOC_JUMP]) and
+            not is_cbool(resultdef) then
            expectloc := left.expectloc
          else
            expectloc:=LOC_REGISTER;
@@ -3334,6 +3365,11 @@ implementation
          result:=first_char_to_string;
       end;
 
+    function ttypeconvnode._first_char_to_chararray: tnode;
+      begin
+        result:=first_char_to_chararray;
+      end;
+
     function ttypeconvnode._first_nothing : tnode;
       begin
          result:=first_nothing;
@@ -3433,7 +3469,7 @@ implementation
            @ttypeconvnode._first_nothing, {not_possible}
            @ttypeconvnode._first_string_to_string,
            @ttypeconvnode._first_char_to_string,
-           @ttypeconvnode._first_nothing, { char_2_chararray, needs nothing extra }
+           @ttypeconvnode._first_char_to_chararray,
            nil, { removed in typecheck_chararray_to_string }
            @ttypeconvnode._first_cchar_to_pchar,
            @ttypeconvnode._first_cstring_to_pchar,

compiler/ninl.pas

@@ -66,6 +66,7 @@ interface
           function first_int_real: tnode; virtual;
           function first_abs_long: tnode; virtual;
           function first_IncludeExclude: tnode; virtual;
+          function first_get_frame: tnode; virtual;
           function first_setlength: tnode; virtual;
           function first_copy: tnode; virtual;
           { This one by default generates an internal error, because such
@@ -102,7 +103,7 @@ implementation
 
     uses
       verbose,globals,systems,constexp,
-      globtype, cutils,
+      globtype,cutils,fmodule,
       symconst,symdef,symsym,symtable,paramgr,defutil,symbase,
       pass_1,
       ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,nutils,
@@ -2519,7 +2520,11 @@ implementation
                 begin
                   if target_info.system in systems_managed_vm then
                     message(parser_e_feature_unsupported_for_vm);
+                  typecheckpass(left);
                   set_varstate(left,vs_read,[]);
+                  if (left.resultdef.typ=objectdef) and
+                    not(oo_has_vmt in tobjectdef(left.resultdef).objectoptions) then
+                      message(type_e_typeof_requires_vmt);
                   resultdef:=voidpointertype;
                 end;
 
@@ -3436,8 +3441,7 @@ implementation
             end;
          in_get_frame:
             begin
-              include(current_procinfo.flags,pi_needs_stackframe);
-              expectloc:=LOC_CREGISTER;
+              result:=first_get_frame;
             end;
          in_get_caller_frame:
             begin
@@ -3613,6 +3617,14 @@ implementation
        end;
 
 
+     function tinlinenode.first_get_frame: tnode;
+       begin
+         include(current_procinfo.flags,pi_needs_stackframe);
+         expectloc:=LOC_CREGISTER;
+         result:=nil;
+       end;
+
+
      function tinlinenode.first_setlength: tnode;
       var
         paras   : tnode;
@@ -3788,15 +3800,21 @@ implementation
 
 
      function tinlinenode.first_assert: tnode;
+       var
+         paras: tcallparanode;
        begin
-         result:=nil;
-         expectloc:=LOC_VOID;
-{$ifdef i386}
-         { hack: on i386, the fourth parameter is passed via memory ->
-           we have to allocate enough stack space for it on targets that
-           use a fixed stack }
-         current_procinfo.allocate_push_parasize(4);
+         paras:=tcallparanode(tcallparanode(left).right);
+         paras:=ccallparanode.create(cstringconstnode.createstr(current_module.sourcefiles.get_file_name(current_filepos.fileindex)),paras);
+         paras:=ccallparanode.create(genintconstnode(fileinfo.line),paras);
+{$if defined(x86) or defined(arm) or defined(jvm)}
+         paras:=ccallparanode.create(geninlinenode(in_get_frame,false,nil),paras);
+{$else}
+         paras:=ccallparanode.create(ccallnode.createinternfromunit('SYSTEM','GET_FRAME',nil),paras);
 {$endif}
+         result:=cifnode.create(cnotnode.create(tcallparanode(left).left),
+            ccallnode.createintern('fpc_assert',paras),nil);
+         tcallparanode(left).left:=nil;
+         tcallparanode(left).right:=nil;
        end;
 
 

compiler/nld.pas

@@ -1229,9 +1229,9 @@ implementation
            Only when the allowed flag is set we don't generate
            an error }
          if not allowed then
-          Message(parser_e_no_type_not_allowed_here);
+           CGMessage(parser_e_no_type_not_allowed_here);
          if not helperallowed and is_objectpascal_helper(typedef) then
-           Message(parser_e_no_category_as_types);
+           CGMessage(parser_e_no_category_as_types);
       end;
 
 

compiler/nobj.pas

@@ -416,7 +416,12 @@ implementation
                   { Give a note if the new visibility is lower. For a higher
                     visibility update the vmt info }
                   if vmtentryvis>pd.visibility then
-                    MessagePos4(pd.fileinfo,parser_n_ignore_lower_visibility,pd.fullprocname(false),
+{$ifdef jvm}
+                    MessagePos4(pd.fileinfo,parser_e_method_lower_visibility,
+{$else jvm}
+                    MessagePos4(pd.fileinfo,parser_n_ignore_lower_visibility,
+{$endif jvm}
+                         pd.fullprocname(false),
                          visibilityname[pd.visibility],tobjectdef(vmtpd.owner.defowner).objrealname^,visibilityname[vmtentryvis])
                   else if pd.visibility>vmtentryvis then
                     begin

compiler/nutils.pas

@@ -570,8 +570,11 @@ implementation
                 end;
               subscriptn:
                 begin
-                  if is_implicit_pointer_object_type(tunarynode(p).left.resultdef) then
-                    inc(result,2);
+                  if is_implicit_pointer_object_type(tunarynode(p).left.resultdef) or
+                    is_bitpacked_access(p) then
+                    inc(result,2)
+                  else if tstoreddef(p.resultdef).is_intregable then
+                    inc(result,1);
                   if (result = NODE_COMPLEXITY_INF) then
                     exit;
                   p := tunarynode(p).left;

compiler/ogbase.pas

@@ -120,11 +120,7 @@ interface
        oso_Data,
        { Is loaded into memory }
        oso_load,
-       { Not loaded into memory }
-       oso_noload,
-       { Read only }
-       oso_readonly,
-       { Read/Write }
+       { Writable }
        oso_write,
        { Contains executable instructions }
        oso_executable,
@@ -135,7 +131,9 @@ interface
        { Contains debug info and can be stripped }
        oso_debug,
        { Contains only strings }
-       oso_strings
+       oso_strings,
+       { Ignore this section }
+       oso_disabled
      );
 
      TObjSectionOptions = set of TObjSectionOption;
@@ -192,6 +190,7 @@ interface
        procedure SetSecOptions(Aoptions:TObjSectionOptions);
      public
        ObjData    : TObjData;
+       index      : longword;  { index of section in section headers }
        SecSymIdx  : longint;   { index for the section in symtab }
        SecAlign   : shortint;   { alignment of the section }
        { section Data }
@@ -215,7 +214,6 @@ interface
        procedure alloc(l:aword);
        procedure addsymReloc(ofs:aword;p:TObjSymbol;Reloctype:TObjRelocationType);
        procedure addsectionReloc(ofs:aword;aobjsec:TObjSection;Reloctype:TObjRelocationType);
-       procedure FixupRelocs(Exe: TExeOutput);virtual;
        procedure ReleaseData;
        function  FullName:string;
        property  Data:TDynamicArray read FData;
@@ -227,7 +225,6 @@ interface
 
      TObjData = class(TLinkedListItem)
      private
-       FName       : TString80;
        FCurrObjSec : TObjSection;
        FObjSectionList  : TFPHashObjectList;
        FCObjSection     : TObjSectionClass;
@@ -241,9 +238,11 @@ interface
        procedure section_afteralloc(p:TObject;arg:pointer);
        procedure section_afterwrite(p:TObject;arg:pointer);
      protected
+       FName       : TString80;
        property CObjSection:TObjSectionClass read FCObjSection write FCObjSection;
      public
        CurrPass  : byte;
+       ExecStack : boolean;
        constructor create(const n:string);virtual;
        destructor  destroy;override;
        { Sections }
@@ -316,6 +315,7 @@ interface
         destructor  destroy;override;
         function  newObjData(const n:string):TObjData;
         function  ReadObjData(AReader:TObjectreader;Data:TObjData):boolean;virtual;abstract;
+        class function CanReadObjData(AReader:TObjectreader):boolean;virtual;
         procedure inputerror(const s : string);
       end;
       TObjInputClass=class of TObjInput;
@@ -372,12 +372,13 @@ interface
       end;
       TExeSectionClass=class of TExeSection;
 
-      TStaticLibrary = class(TFPHashObject)
+      TStaticLibrary = class(TObject)
       private
+        FName : TCmdStr;
         FArReader : TObjectReader;
         FObjInputClass : TObjInputClass;
       public
-        constructor create(AList:TFPHashObjectList;const AName:string;AReader:TObjectReader;AObjInputClass:TObjInputClass);
+        constructor create(const AName:TCmdStr;AReader:TObjectReader;AObjInputClass:TObjInputClass);
         destructor  destroy;override;
         property ArReader:TObjectReader read FArReader;
         property ObjInputClass:TObjInputClass read FObjInputClass;
@@ -443,10 +444,12 @@ interface
         property CObjData:TObjDataClass read FCObjData write FCObjData;
         procedure Order_ObjSectionList(ObjSectionList : TFPObjectList; const aPattern:string);virtual;
         procedure WriteExeSectionContent;
+        procedure DoRelocationFixup(objsec:TObjSection);virtual;abstract;
       public
         CurrDataPos  : aword;
         MaxMemPos    : qword;
         IsSharedLibrary : boolean;
+        ExecStack    : boolean;
         constructor create;virtual;
         destructor  destroy;override;
         function  FindExeSection(const aname:string):TExeSection;
@@ -457,6 +460,7 @@ interface
         procedure Load_ProvideSymbol(const aname:string);virtual;
         procedure Load_IsSharedLibrary;
         procedure Load_ImageBase(const avalue:string);
+        procedure Load_DynamicObject(ObjData:TObjData);virtual;
         procedure Order_Start;virtual;
         procedure Order_End;virtual;
         procedure Order_ExeSection(const aname:string);virtual;
@@ -480,14 +484,15 @@ interface
         procedure DataPos_Symbols;virtual;
         procedure BuildVTableTree(VTInheritList,VTEntryList:TFPObjectList);
         procedure PackUnresolvedExeSymbols(const s:string);
-        procedure ResolveSymbols(StaticLibraryList:TFPHashObjectList);
+        procedure ResolveSymbols(StaticLibraryList:TFPObjectList);
         procedure PrintMemoryMap;
         procedure FixupSymbols;
         procedure FixupRelocations;
         procedure RemoveUnusedExeSymbols;
         procedure MergeStabs;
+        procedure MarkEmptySections;
         procedure RemoveUnreferencedSections;
-        procedure RemoveEmptySections;
+        procedure RemoveDisabledSections;
         procedure RemoveDebugInfo;
         procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);virtual;
         procedure GenerateDebugLink(const dbgname:string;dbgcrc:cardinal);
@@ -748,11 +753,6 @@ implementation
       end;
 
 
-    procedure TObjSection.FixupRelocs(Exe:TExeOutput);
-      begin
-      end;
-
-
     procedure TObjSection.ReleaseData;
       begin
         if assigned(FData) then
@@ -908,7 +908,7 @@ implementation
       const
         secoptions : array[TAsmSectiontype] of TObjSectionOptions = ([],
           {user} [oso_Data,oso_load,oso_write,oso_keep],
-          {code} [oso_Data,oso_load,oso_readonly,oso_executable,oso_keep],
+          {code} [oso_Data,oso_load,oso_executable,oso_keep],
           {Data} [oso_Data,oso_load,oso_write,oso_keep],
 { TODO: Fix sec_rodata be read-only-with-relocs}
           {roData} [oso_Data,oso_load,oso_write,oso_keep],
@@ -920,29 +920,29 @@ implementation
                        ,oso_keep
 {$endif FPC_USE_TLS_DIRECTORY}
           ],
-          {pdata} [oso_data,oso_load,oso_readonly {$ifndef x86_64},oso_keep{$endif}],
-          {stub} [oso_Data,oso_load,oso_readonly,oso_executable],
+          {pdata} [oso_data,oso_load {$ifndef x86_64},oso_keep{$endif}],
+          {stub} [oso_Data,oso_load,oso_executable],
           {data_nonlazy}  [oso_Data,oso_load,oso_write],
           {data_lazy} [oso_Data,oso_load,oso_write],
           {init_func} [oso_Data,oso_load],
           {term_func} [oso_Data,oso_load],
-          {stab} [oso_Data,oso_noload,oso_debug],
-          {stabstr} [oso_Data,oso_noload,oso_strings,oso_debug],
+          {stab} [oso_Data,oso_debug],
+          {stabstr} [oso_Data,oso_strings,oso_debug],
           {iData2} [oso_Data,oso_load,oso_write],
           {iData4} [oso_Data,oso_load,oso_write],
           {iData5} [oso_Data,oso_load,oso_write],
           {iData6} [oso_Data,oso_load,oso_write],
           {iData7} [oso_Data,oso_load,oso_write],
-          {eData} [oso_Data,oso_load,oso_readonly],
-          {eh_frame} [oso_Data,oso_load,oso_readonly],
-          {debug_frame} [oso_Data,oso_noload,oso_debug],
-          {debug_info} [oso_Data,oso_noload,oso_debug],
-          {debug_line} [oso_Data,oso_noload,oso_debug],
-          {debug_abbrev} [oso_Data,oso_noload,oso_debug],
+          {eData} [oso_Data,oso_load],
+          {eh_frame} [oso_Data,oso_load],
+          {debug_frame} [oso_Data,oso_debug],
+          {debug_info} [oso_Data,oso_debug],
+          {debug_line} [oso_Data,oso_debug],
+          {debug_abbrev} [oso_Data,oso_debug],
           {fpc} [oso_Data,oso_load,oso_write,oso_keep],
-          {toc} [oso_Data,oso_load,oso_readonly],
-          {init} [oso_Data,oso_load,oso_readonly,oso_executable,oso_keep],
-          {fini} [oso_Data,oso_load,oso_readonly,oso_executable,oso_keep],
+          {toc} [oso_Data,oso_load],
+          {init} [oso_Data,oso_load,oso_executable,oso_keep],
+          {fini} [oso_Data,oso_load,oso_executable,oso_keep],
           {objc_class} [oso_data,oso_load],
           {objc_meta_class} [oso_data,oso_load],
           {objc_cat_cls_meth} [oso_data,oso_load],
@@ -1085,17 +1085,29 @@ implementation
 
 
     function TObjData.symbolref(asmsym:TAsmSymbol):TObjSymbol;
+      var
+        s:string;
       begin
         if assigned(asmsym) then
           begin
             if not assigned(asmsym.cachedObjSymbol) then
               begin
-                result:=symbolref(asmsym.name);
+                s:=asmsym.name;
+                result:=TObjSymbol(FObjSymbolList.Find(s));
+                if result=nil then
+                  begin
+                    result:=TObjSymbol.Create(FObjSymbolList,s);
+                    if asmsym.bind=AB_WEAK_EXTERNAL then
+                      result.bind:=AB_WEAK_EXTERNAL;
+                  end;
                 asmsym.cachedObjSymbol:=result;
                 FCachedAsmSymbolList.add(asmsym);
               end
             else
               result:=TObjSymbol(asmsym.cachedObjSymbol);
+            { The weak bit could have been removed from asmsym. }
+            if (asmsym.bind=AB_EXTERNAL) and (result.bind=AB_WEAK_EXTERNAL) then
+              result.bind:=AB_EXTERNAL;
           end
         else
           result:=nil;
@@ -1451,10 +1463,10 @@ implementation
         else
           begin
             { inherit section options }
-            SecAlign:=objsec.SecAlign;
             SecOptions:=SecOptions+objsec.SecOptions;
           end;
         { relate ObjSection to ExeSection, and mark it Used by default }
+        SecAlign:=max(objsec.SecAlign,SecAlign);
         objsec.ExeSection:=self;
         objsec.Used:=true;
       end;
@@ -1464,9 +1476,9 @@ implementation
                                 TStaticLibrary
 ****************************************************************************}
 
-    constructor TStaticLibrary.create(AList:TFPHashObjectList;const AName:string;AReader:TObjectReader;AObjInputClass:TObjInputClass);
+    constructor TStaticLibrary.create(const AName:TCmdStr;AReader:TObjectReader;AObjInputClass:TObjInputClass);
       begin
-        inherited create(AList,AName);
+        FName:=AName;
         FArReader:=AReader;
         FObjInputClass:=AObjInputClass;
       end;
@@ -1539,7 +1551,6 @@ implementation
         FCommonObjSymbols:=TFPObjectList.Create(false);
         FProvidedObjSymbols:=TFPObjectList.Create(false);
         FExeVTableList:=TFPObjectList.Create(false);
-        FEntryName:='start';
         { sections }
         FExeSectionList:=TFPHashObjectList.Create(true);
         FImageBase:=0;
@@ -1604,6 +1615,7 @@ implementation
         if ObjData.classtype<>FCObjData then
           Comment(V_Error,'Invalid input object format for '+ObjData.name+' got '+ObjData.classname+' expected '+FCObjData.classname);
         ObjDataList.Add(ObjData);
+        ExecStack:=ExecStack or ObjData.ExecStack;
       end;
 
 
@@ -1669,6 +1681,11 @@ implementation
       end;
 
 
+    procedure TExeOutput.Load_DynamicObject(ObjData:TObjData);
+      begin
+      end;
+
+
     procedure TExeOutput.Order_Start;
       begin
       end;
@@ -1896,6 +1913,7 @@ implementation
     procedure TExeOutput.MemPos_Start;
       begin
         CurrMemPos:=0;
+        RemoveDisabledSections;
       end;
 
 
@@ -2088,7 +2106,7 @@ implementation
       end;
 
 
-    procedure TExeOutput.ResolveSymbols(StaticLibraryList:TFPHashObjectList);
+    procedure TExeOutput.ResolveSymbols(StaticLibraryList:TFPObjectList);
       var
         ObjData   : TObjData;
         exesym    : TExeSymbol;
@@ -2290,18 +2308,21 @@ implementation
         PackUnresolvedExeSymbols('after defining COMMON symbols');
 
         { Find entry symbol and print in map }
-        exesym:=texesymbol(ExeSymbolList.Find(EntryName));
-        if assigned(exesym) then
+        if (EntryName<>'') then
           begin
-            EntrySym:=exesym.ObjSymbol;
-            if assigned(exemap) then
+            exesym:=texesymbol(ExeSymbolList.Find(EntryName));
+            if assigned(exesym) then
               begin
-                exemap.Add('');
-                exemap.Add('Entry symbol '+EntryName);
-              end;
-          end
-        else
-          Comment(V_Error,'Entrypoint '+EntryName+' not defined');
+                EntrySym:=exesym.ObjSymbol;
+                if assigned(exemap) then
+                  begin
+                    exemap.Add('');
+                    exemap.Add('Entry symbol '+EntryName);
+                  end;
+              end
+            else
+              Comment(V_Error,'Entrypoint '+EntryName+' not defined');
+          end;
 
         { Generate VTable tree }
         if cs_link_opt_vtable in current_settings.globalswitches then
@@ -2652,7 +2673,7 @@ implementation
       end;
 
 
-    procedure TExeOutput.RemoveEmptySections;
+    procedure TExeOutput.MarkEmptySections;
       var
         i, j   : longint;
         exesec : TExeSection;
@@ -2682,12 +2703,26 @@ implementation
                       break;
                     end;
               end;
-            if doremove and not (RelocSection and (exesec.Name='.reloc')) then
+            if doremove then
               begin
-                Comment(V_Debug,'Deleting empty section '+exesec.name);
-                ExeSectionList[i]:=nil;
+                Comment(V_Debug,'Disabling empty section '+exesec.name);
+                exesec.SecOptions:=exesec.SecOptions+[oso_disabled];
               end;
           end;
+      end;
+
+
+    procedure TExeOutput.RemoveDisabledSections;
+      var
+        i: longint;
+        exesec: TExeSection;
+      begin
+        for i:=0 to ExeSectionList.Count-1 do
+          begin
+            exesec:=TExeSection(ExeSectionList[i]);
+            if (oso_disabled in exesec.SecOptions) then
+              ExeSectionList[i]:=nil;
+          end;
         ExeSectionList.Pack;
       end;
 
@@ -2817,7 +2852,8 @@ implementation
                   end;
               end;
           end;
-        AddToObjSectionWorkList(entrysym.exesymbol.objsymbol.objsection);
+        if assigned(entrysym) then
+          AddToObjSectionWorkList(entrysym.exesymbol.objsymbol.objsection);
 
         { Process all sections, add new sections to process based
           on the symbol references  }
@@ -2894,7 +2930,13 @@ implementation
                 objsec:=TObjSection(exesec.ObjSectionlist[j]);
                 if not objsec.Used then
                   internalerror(200603301);
-                objsec.FixupRelocs(Self);
+                if (objsec.ObjRelocations.Count>0) and
+                   not assigned(objsec.data) then
+                  internalerror(200205183);
+                DoRelocationFixup(objsec);
+                {for size = 0 data is not valid PM }
+                if assigned(objsec.data) and (objsec.data.size<>objsec.size) then
+                  internalerror(2010092801);
               end;
           end;
       end;
@@ -2986,6 +3028,12 @@ implementation
       end;
 
 
+    class function TObjInput.CanReadObjData(AReader:TObjectReader):boolean;
+      begin
+        result:=false;
+      end;
+
+
     procedure TObjInput.ReadSectionContent(Data:TObjData);
       var
         i: longint;

compiler/ogcoff.pas

@@ -107,10 +107,8 @@ interface
          coffrelocs,
          coffrelocpos : aword;
        public
-         secidx   : longword;
          constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);override;
          procedure addsymsizereloc(ofs:aword;p:TObjSymbol;symsize:aword;reloctype:TObjRelocationType);
-         procedure fixuprelocs(Exe:TExeOutput);override;
        end;
 
        TCoffObjData = class(TObjData)
@@ -207,6 +205,7 @@ interface
        protected
          function writedata:boolean;override;
          procedure Order_ObjSectionList(ObjSectionList : TFPObjectList;const aPattern:string);override;
+         procedure DoRelocationFixup(objsec:TObjSection);override;
        public
          constructor createcoff(awin32:boolean);
          procedure MemPos_Header;override;
@@ -227,7 +226,7 @@ interface
        public
          constructor create;override;
          procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);override;
-         procedure Order_End;override;
+         procedure MemPos_Start;override;
          procedure MemPos_ExeSection(const aname:string);override;
        end;
 
@@ -769,16 +768,11 @@ const pemagic : array[0..3] of byte = (
           include(aoptions,oso_debug);
         if flags and PE_SCN_CNT_UNINITIALIZED_DATA=0 then
           include(aoptions,oso_data);
-        if (flags and PE_SCN_LNK_REMOVE<>0) or
-           (flags and PE_SCN_MEM_DISCARDABLE<>0) then
-          include(aoptions,oso_noload)
-        else
+        if (flags and (PE_SCN_LNK_REMOVE or PE_SCN_MEM_DISCARDABLE)=0) then
           include(aoptions,oso_load);
         { read/write }
         if flags and PE_SCN_MEM_WRITE<>0 then
-          include(aoptions,oso_write)
-        else
-          include(aoptions,oso_readonly);
+          include(aoptions,oso_write);
         { alignment }
         alignflag:=flags and PE_SCN_ALIGN_MASK;
         if alignflag=PE_SCN_ALIGN_64BYTES then
@@ -818,7 +812,7 @@ const pemagic : array[0..3] of byte = (
       end;
 
 
-    procedure TCoffObjSection.fixuprelocs(Exe:TExeOutput);
+    procedure TCoffExeOutput.DoRelocationFixup(objsec:TObjSection);
       var
         i,zero,address_size : longint;
         objreloc : TObjRelocation;
@@ -828,13 +822,12 @@ const pemagic : array[0..3] of byte = (
 {$ifdef cpu64bitaddr}
         s        : string;
 {$endif cpu64bitaddr}
+        data     : TDynamicArray;
       begin
-        if (ObjRelocations.Count>0) and
-           not assigned(data) then
-          internalerror(200205183);
-        for i:=0 to ObjRelocations.Count-1 do
+        data:=objsec.data;
+        for i:=0 to objsec.ObjRelocations.Count-1 do
           begin
-            objreloc:=TObjRelocation(ObjRelocations[i]);
+            objreloc:=TObjRelocation(objsec.ObjRelocations[i]);
             address_size:=4;
             case objreloc.typ of
               RELOC_NONE:
@@ -869,24 +862,24 @@ const pemagic : array[0..3] of byte = (
             else
               internalerror(200205183);
             { Only debug sections are allowed to have relocs pointing to unused sections }
-            if not relocsec.used and not (oso_debug in secoptions) then
+            if not relocsec.used and not (oso_debug in objsec.secoptions) then
               internalerror(200603061);
 
             if relocsec.used then
               case objreloc.typ of
                 RELOC_RELATIVE  :
                   begin
-                    address:=address-mempos+relocval;
-                    if TCoffObjData(objdata).win32 then
+                    address:=address-objsec.mempos+relocval;
+                    if TCoffObjData(objsec.objdata).win32 then
                       dec(address,objreloc.dataoffset+4);
                   end;
                 RELOC_RVA:
                   begin
                     { fixup address when the symbol was known in defined object }
-                    if (relocsec.objdata=objdata) then
+                    if (relocsec.objdata=objsec.objdata) then
                       dec(address,TCoffObjSection(relocsec).orgmempos);
 {$ifdef arm}
-                    if (relocsec.objdata=objdata) and not TCoffObjData(objdata).eVCobj then
+                    if (relocsec.objdata=objsec.objdata) and not TCoffObjData(objsec.objdata).eVCobj then
                       inc(address, relocsec.MemPos)
                     else
 {$endif arm}
@@ -895,14 +888,14 @@ const pemagic : array[0..3] of byte = (
                 RELOC_SECREL32 :
                   begin
                     { fixup address when the symbol was known in defined object }
-                    if (relocsec.objdata=objdata) then
+                    if (relocsec.objdata=objsec.objdata) then
                       dec(address,relocsec.ExeSection.MemPos);
                     inc(address,relocval);
                   end;
 {$ifdef arm}
                 RELOC_RELATIVE_24:
                   begin
-                    relocval:=longint(relocval - mempos - objreloc.dataoffset) shr 2 - 2;
+                    relocval:=longint(relocval - objsec.mempos - objreloc.dataoffset) shr 2 - 2;
                     address:=address or (relocval and $ffffff);
                     relocval:=relocval shr 24;
                     if (relocval<>$3f) and (relocval<>0) then
@@ -913,27 +906,27 @@ const pemagic : array[0..3] of byte = (
                 { 64 bit coff only }
                 RELOC_RELATIVE_1:
                   begin
-                    address:=address-mempos+relocval;
+                    address:=address-objsec.mempos+relocval;
                     dec(address,objreloc.dataoffset+1);
                   end;
                 RELOC_RELATIVE_2:
                   begin
-                    address:=address-mempos+relocval;
+                    address:=address-objsec.mempos+relocval;
                     dec(address,objreloc.dataoffset+2);
                   end;
                 RELOC_RELATIVE_3:
                   begin
-                    address:=address-mempos+relocval;
+                    address:=address-objsec.mempos+relocval;
                     dec(address,objreloc.dataoffset+3);
                   end;
                 RELOC_RELATIVE_4:
                   begin
-                    address:=address-mempos+relocval;
+                    address:=address-objsec.mempos+relocval;
                     dec(address,objreloc.dataoffset+4);
                   end;
                 RELOC_RELATIVE_5:
                   begin
-                    address:=address-mempos+relocval;
+                    address:=address-objsec.mempos+relocval;
                     dec(address,objreloc.dataoffset+5);
                   end;
                 RELOC_ABSOLUTE32,
@@ -945,16 +938,16 @@ const pemagic : array[0..3] of byte = (
                     else
                       begin
                         { fixup address when the symbol was known in defined object }
-                        if (relocsec.objdata=objdata) then
+                        if (relocsec.objdata=objsec.objdata) then
                           dec(address,TCoffObjSection(relocsec).orgmempos);
                       end;
 {$ifdef arm}
-                    if (relocsec.objdata=objdata) and not TCoffObjData(objdata).eVCobj then
+                    if (relocsec.objdata=objsec.objdata) and not TCoffObjData(objsec.objdata).eVCobj then
                       inc(address, relocsec.MemPos)
                     else
 {$endif arm}
                       inc(address,relocval);
-                    inc(address,exe.imagebase);
+                    inc(address,imagebase);
                   end;
                 else
                   internalerror(200604014);
@@ -965,19 +958,16 @@ const pemagic : array[0..3] of byte = (
             data.Seek(objreloc.dataoffset);
             data.Write(address,address_size);
 {$ifdef cpu64bitaddr}
-            if (objreloc.typ = RELOC_ABSOLUTE32) and (name <> '.stab') then
+            if (objreloc.typ = RELOC_ABSOLUTE32) and (objsec.name <> '.stab') then
               begin
                 if assigned(objreloc.symbol) then
                   s:=objreloc.symbol.Name
                 else
                   s:=objreloc.objsection.Name;
-                Message2(link_w_32bit_absolute_reloc, ObjData.Name, s);
+                Message2(link_w_32bit_absolute_reloc, objsec.ObjData.Name, s);
               end;
 {$endif cpu64bitaddr}
           end;
-        {for size = 0 data is not valid PM }
-        if assigned(data) and (data.size <> size) then
-          internalerror(2010092801);
       end;
 
 
@@ -1191,14 +1181,14 @@ const pemagic : array[0..3] of byte = (
         with TCoffObjSection(p) do
           begin
             Inc(plongword(arg)^);
-            secidx:=plongword(arg)^;
+            index:=plongword(arg)^;
 
             secsymidx:=symidx;
             { Both GNU and Microsoft toolchains write section symbols using
               storage class 3 (STATIC).
               No reason to use COFF_SYM_SECTION, it is silently converted to 3 by
               PE binutils and causes warnings with DJGPP binutils. }
-            write_symbol(name,mempos,secidx,COFF_SYM_LOCAL,1);
+            write_symbol(name,mempos,index,COFF_SYM_LOCAL,1);
             { AUX }
             fillchar(secrec,sizeof(secrec),0);
             secrec.len:=Size;
@@ -1326,13 +1316,13 @@ const pemagic : array[0..3] of byte = (
                  AB_GLOBAL :
                    begin
                      globalval:=COFF_SYM_GLOBAL;
-                     sectionval:=TCoffObjSection(objsym.objsection).secidx;
+                     sectionval:=objsym.objsection.index;
                      value:=objsym.address;
                    end;
                  AB_LOCAL :
                    begin
                      globalval:=COFF_SYM_LOCAL;
-                     sectionval:=TCoffObjSection(objsym.objsection).secidx;
+                     sectionval:=objsym.objsection.index;
                      value:=objsym.address;
                    end;
                  else
@@ -1954,9 +1944,9 @@ const pemagic : array[0..3] of byte = (
                 value:=address;
               end;
             if bind=AB_LOCAL then
-              globalval:=3
+              globalval:=COFF_SYM_LOCAL
             else
-              globalval:=2;
+              globalval:=COFF_SYM_GLOBAL;
             { reloctype address to the section in the executable }
             write_symbol(name,value,secval,globalval,0);
           end;
@@ -2336,7 +2326,7 @@ const pemagic : array[0..3] of byte = (
           begin
             idataExeSec:=FindExeSection('.idata');
             if idataExeSec<>nil then
-              idataExeSec.SecOptions:=idataExeSec.SecOptions - [oso_write] + [oso_readonly];
+              idataExeSec.SecOptions:=idataExeSec.SecOptions - [oso_write];
           end;
 
         { Section headers }
@@ -2666,7 +2656,7 @@ const pemagic : array[0..3] of byte = (
         exesec:=FindExeSection('.reloc');
         if exesec=nil then
           exit;
-        objsec:=internalObjData.createsection('.reloc',0,exesec.SecOptions+[oso_data]);
+        objsec:=internalObjData.createsection('.reloc',0,[oso_data,oso_load,oso_keep]);
         exesec.AddObjSection(objsec);
         pgaddr:=longword(-1);
         hdrpos:=longword(-1);
@@ -2712,17 +2702,18 @@ const pemagic : array[0..3] of byte = (
       end;
 
 
-    procedure TPECoffexeoutput.Order_End;
+    procedure TPECoffexeoutput.MemPos_Start;
       var
         exesec : TExeSection;
       begin
+        if RelocSection then
+          begin
+            exesec:=FindExeSection('.reloc');
+            if exesec=nil then
+              InternalError(2012072401);
+            exesec.SecOptions:=exesec.SecOptions-[oso_disabled];
+          end;
         inherited;
-        if not IsSharedLibrary then
-          exit;
-        exesec:=FindExeSection('.reloc');
-        if exesec=nil then
-          exit;
-        exesec.SecOptions:=exesec.SecOptions + [oso_Data,oso_keep,oso_load];
       end;
 
 

compiler/ogelf.pas

@@ -39,7 +39,6 @@ interface
     type
        TElfObjSection = class(TObjSection)
        public
-          secshidx  : longint; { index for the section in symtab }
           shstridx,
           shtype,
           shflags,
@@ -47,7 +46,8 @@ interface
           shinfo,
           shentsize : longint;
           constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);override;
-          constructor create_ext(aobjdata:TObjData;const Aname:string;Ashtype,Ashflags,Ashlink,Ashinfo:longint;Aalign:shortint;Aentsize:longint);
+          constructor create_ext(aobjdata:TObjData;const Aname:string;Ashtype,Ashflags:longint;Aalign:shortint;Aentsize:longint);
+          constructor create_reloc(aobjdata:TObjData;const Aname:string;allocflag:boolean);
        end;
 
        TElfSymtabKind = (esk_obj,esk_exe,esk_dyn);
@@ -58,7 +58,7 @@ interface
          fstrsec: TObjSection;
          symidx: longint;
          constructor create(aObjData:TObjData;aKind:TElfSymtabKind);reintroduce;
-         procedure writeSymbol(objsym:TObjSymbol);
+         procedure writeSymbol(objsym:TObjSymbol;nameidx:longword=0);
          procedure writeInternalSymbol(astridx:longint;ainfo:byte;ashndx:word);
        end;
 
@@ -111,6 +111,10 @@ implementation
       R_386_PC32 = 2;                  { PC-relative relocation }
       R_386_GOT32 = 3;                 { an offset into GOT }
       R_386_PLT32 = 4;                 { a PC-relative offset into PLT }
+      R_386_COPY = 5;
+      R_386_GLOB_DAT = 6;
+      R_386_JUMP_SLOT = 7;
+      R_386_RELATIVE = 8;
       R_386_GOTOFF = 9;                { an offset from GOT base }
       R_386_GOTPC = 10;                { a PC-relative offset _to_ GOT }
       R_386_GNU_VTINHERIT = 250;
@@ -239,6 +243,9 @@ implementation
       STT_FUNC    = 2;
       STT_SECTION = 3;
       STT_FILE    = 4;
+      STT_COMMON  = 5;
+      STT_TLS     = 6;
+      STT_GNU_IFUNC = 10;
 
       { program header types }
       PT_NULL     = 0;
@@ -248,14 +255,20 @@ implementation
       PT_NOTE     = 4;
       PT_SHLIB    = 5;
       PT_PHDR     = 6;
+      PT_LOOS     = $60000000;
+      PT_HIOS     = $6FFFFFFF;
       PT_LOPROC   = $70000000;
       PT_HIPROC   = $7FFFFFFF;
+      PT_GNU_EH_FRAME = PT_LOOS + $474e550;   { Frame unwind information }
+      PT_GNU_STACK = PT_LOOS + $474e551;      { Stack flags }
+      PT_GNU_RELRO = PT_LOOS + $474e552;      { Read-only after relocation }
 
       { program header flags }
       PF_X = 1;
       PF_W = 2;
       PF_R = 4;
-      PF_MASKPROC = $F0000000;
+      PF_MASKOS   = $0FF00000;   { OS-specific reserved bits }
+      PF_MASKPROC = $F0000000;   { Processor-specific reserved bits }
 
       { .dynamic tags  }
       DT_NULL     = 0;
@@ -298,6 +311,14 @@ implementation
       DT_LOPROC   = $70000000;
       DT_HIPROC   = $7fffffff;
 
+      DT_RELACOUNT = $6ffffff9;
+      DT_RELCOUNT  = $6ffffffa;
+      DT_FLAGS_1   = $6ffffffb;
+      DT_VERDEF    = $6ffffffc;
+      DT_VERDEFNUM = $6ffffffd;
+      DT_VERNEED   = $6ffffffe;
+      DT_VERNEEDNUM = $6fffffff;
+
       type
       { Structures which are written directly to the output file }
         TElf32header=packed record
@@ -308,11 +329,11 @@ implementation
           padding           : array[$07..$0f] of byte;
           e_type            : word;
           e_machine         : word;
-          e_version         : longint;
-          e_entry           : longint;          { entrypoint }
-          e_phoff           : longint;          { program header offset }
-          e_shoff           : longint;          { sections header offset }
-          e_flags           : longint;
+          e_version         : longword;
+          e_entry           : longword;         { entrypoint }
+          e_phoff           : longword;         { program header offset }
+          e_shoff           : longword;         { sections header offset }
+          e_flags           : longword;
           e_ehsize          : word;             { elf header size in bytes }
           e_phentsize       : word;             { size of an entry in the program header array }
           e_phnum           : word;             { 0..e_phnum-1 of entrys }
@@ -321,16 +342,16 @@ implementation
           e_shstrndx        : word;             { index of string section header }
         end;
         TElf32sechdr=packed record
-          sh_name           : longint;
-          sh_type           : longint;
-          sh_flags          : longint;
-          sh_addr           : longint;
-          sh_offset         : longint;
-          sh_size           : longint;
-          sh_link           : longint;
-          sh_info           : longint;
-          sh_addralign      : longint;
-          sh_entsize        : longint;
+          sh_name           : longword;
+          sh_type           : longword;
+          sh_flags          : longword;
+          sh_addr           : longword;
+          sh_offset         : longword;
+          sh_size           : longword;
+          sh_link           : longword;
+          sh_info           : longword;
+          sh_addralign      : longword;
+          sh_entsize        : longword;
         end;
         TElf32proghdr=packed record
           p_type            : longword;
@@ -343,14 +364,14 @@ implementation
           p_align           : longword;
         end;
         TElf32reloc=packed record
-          address : longint;
-          info    : longint; { bit 0-7: type, 8-31: symbol }
+          address : longword;
+          info    : longword; { bit 0-7: type, 8-31: symbol }
           addend  : longint;
         end;
         TElf32symbol=packed record
-          st_name  : longint;
-          st_value : longint;
-          st_size  : longint;
+          st_name  : longword;
+          st_value : longword;
+          st_size  : longword;
           st_info  : byte; { bit 0-3: type, 4-7: bind }
           st_other : byte;
           st_shndx : word;
@@ -371,11 +392,11 @@ implementation
           padding           : array[$07..$0f] of byte;
           e_type            : word;
           e_machine         : word;
-          e_version         : longint;
+          e_version         : longword;
           e_entry           : qword;            { entrypoint }
           e_phoff           : qword;            { program header offset }
           e_shoff           : qword;            { sections header offset }
-          e_flags           : longint;
+          e_flags           : longword;
           e_ehsize          : word;             { elf header size in bytes }
           e_phentsize       : word;             { size of an entry in the program header array }
           e_phnum           : word;             { 0..e_phnum-1 of entrys }
@@ -384,14 +405,14 @@ implementation
           e_shstrndx        : word;             { index of string section header }
         end;
         telf64sechdr=packed record
-          sh_name           : longint;
-          sh_type           : longint;
+          sh_name           : longword;
+          sh_type           : longword;
           sh_flags          : qword;
           sh_addr           : qword;
           sh_offset         : qword;
           sh_size           : qword;
-          sh_link           : longint;
-          sh_info           : longint;
+          sh_link           : longword;
+          sh_info           : longword;
           sh_addralign      : qword;
           sh_entsize        : qword;
         end;
@@ -411,7 +432,7 @@ implementation
           addend  : int64; { signed! }
         end;
         telf64symbol=packed record
-          st_name  : longint;
+          st_name  : longword;
           st_info  : byte; { bit 0-3: type, 4-7: bind }
           st_other : byte;
           st_shndx : word;
@@ -425,6 +446,36 @@ implementation
             1: (d_ptr: qword);
         end;
 
+        TElfVerdef=record        { same for 32 and 64 bits }
+          vd_version: word;      { =1 }
+          vd_flags:   word;
+          vd_ndx:     word;
+          vd_cnt:     word;      { number of verdaux records }
+          vd_hash:    longword;  { ELF hash of version name }
+          vd_aux:     longword;  { offset to verdaux records }
+          vd_next:    longword;  { offset to next verdef record }
+        end;
+
+        TElfVerdaux=record
+          vda_name: longword;
+          vda_next: longword;
+        end;
+
+        TElfVerneed=record
+          vn_version: word;      { =VER_NEED_CURRENT }
+          vn_cnt:     word;
+          vn_file:    longword;
+          vn_aux:     longword;
+          vn_next:    longword;
+        end;
+
+        TElfVernaux=record
+          vna_hash:  longword;
+          vna_flags: word;
+          vna_other: word;
+          vna_name:  longword;
+          vna_next:  longword;
+        end;
 
 {$ifdef cpu64bitaddr}
       const
@@ -436,6 +487,12 @@ implementation
         telfsechdr = telf64sechdr;
         telfproghdr = telf64proghdr;
         telfdyn = telf64dyn;
+
+      function ELF_R_INFO(sym:longword;typ:byte):qword;inline;
+        begin
+          result:=(qword(sym) shl 32) or typ;
+        end;
+
 {$else cpu64bitaddr}
       const
         ELFCLASS = ELFCLASS32;
@@ -446,6 +503,11 @@ implementation
         telfsechdr = telf32sechdr;
         telfproghdr = telf32proghdr;
         telfdyn = telf32dyn;
+
+      function ELF_R_INFO(sym:longword;typ:byte):longword;inline;
+        begin
+          result:=(sym shl 8) or typ;
+        end;
 {$endif cpu64bitaddr}
 
 {$ifdef x86_64}
@@ -677,13 +739,9 @@ implementation
           include(aoptions,oso_strings);
         { Section Flags }
         if Ashflags and SHF_ALLOC<>0 then
-          include(aoptions,oso_load)
-        else
-          include(aoptions,oso_noload);
+          include(aoptions,oso_load);
         if Ashflags and SHF_WRITE<>0 then
-          include(aoptions,oso_write)
-        else
-          include(aoptions,oso_readonly);
+          include(aoptions,oso_write);
         if Ashflags and SHF_EXECINSTR<>0 then
           include(aoptions,oso_executable);
       end;
@@ -696,7 +754,7 @@ implementation
     constructor TElfObjSection.create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);
       begin
         inherited create(AList,Aname,Aalign,aoptions);
-        secshidx:=0;
+        index:=0;
         shstridx:=0;
         encodesechdrflags(aoptions,shtype,shflags);
         shlink:=0;
@@ -706,23 +764,35 @@ implementation
       end;
 
 
-    constructor TElfObjSection.create_ext(aobjdata:TObjData;const Aname:string;Ashtype,Ashflags,Ashlink,Ashinfo:longint;Aalign:shortint;Aentsize:longint);
+    constructor TElfObjSection.create_ext(aobjdata:TObjData;const Aname:string;Ashtype,Ashflags:longint;Aalign:shortint;Aentsize:longint);
       var
         aoptions : TObjSectionOptions;
       begin
         decodesechdrflags(Ashtype,Ashflags,aoptions);
         inherited create(aobjdata.ObjSectionList,Aname,Aalign,aoptions);
         objdata:=aobjdata;
-        secshidx:=0;
+        index:=0;
         shstridx:=0;
         shtype:=AshType;
         shflags:=AshFlags;
-        shlink:=Ashlink;
-        shinfo:=Ashinfo;
         shentsize:=Aentsize;
       end;
 
 
+    const
+      relsec_prefix:array[boolean] of string[5] = ('.rel','.rela');
+      relsec_shtype:array[boolean] of longword = (SHT_REL,SHT_RELA);
+
+    constructor TElfObjSection.create_reloc(aobjdata:TObjData;const Aname:string;allocflag:boolean);
+      begin
+        create_ext(aobjdata,
+          relsec_prefix[relocs_use_addend]+aname,
+          relsec_shtype[relocs_use_addend],
+          SHF_ALLOC*ord(allocflag),
+          sizeof(pint),
+          (2+ord(relocs_use_addend))*sizeof(pint));
+      end;
+
 {****************************************************************************
                             TElfObjData
 ****************************************************************************}
@@ -978,8 +1048,8 @@ implementation
         dyn:boolean;
       begin
         dyn:=(aKind=esk_dyn);
-        create_ext(aObjData,symsecnames[dyn],symsectypes[dyn],symsecattrs[dyn],0,0,sizeof(pint),sizeof(TElfSymbol));
-        fstrsec:=TElfObjSection.create_ext(aObjData,strsecnames[dyn],SHT_STRTAB,symsecattrs[dyn],0,0,1,0);
+        create_ext(aObjData,symsecnames[dyn],symsectypes[dyn],symsecattrs[dyn],sizeof(pint),sizeof(TElfSymbol));
+        fstrsec:=TElfObjSection.create_ext(aObjData,strsecnames[dyn],SHT_STRTAB,symsecattrs[dyn],1,0);
         fstrsec.writestr(#0);
         writezeros(sizeof(TElfSymbol));
         symidx:=1;
@@ -1001,14 +1071,19 @@ implementation
         write(elfsym,sizeof(elfsym));
       end;
 
-    procedure TElfSymtab.writeSymbol(objsym:TObjSymbol);
+    procedure TElfSymtab.writeSymbol(objsym:TObjSymbol;nameidx:longword);
       var
         elfsym:TElfSymbol;
       begin
         fillchar(elfsym,sizeof(elfsym),0);
         { symbolname, write the #0 separate to overcome 255+1 char not possible }
-        elfsym.st_name:=fstrsec.writestr(objsym.name);
-        fstrsec.writestr(#0);
+        if nameidx=0 then
+          begin
+            elfsym.st_name:=fstrsec.writestr(objsym.name);
+            fstrsec.writestr(#0);
+          end
+        else
+          elfsym.st_name:=nameidx;
         elfsym.st_size:=objsym.size;
         case objsym.bind of
           AB_LOCAL :
@@ -1053,7 +1128,7 @@ implementation
             else
               begin
                 if assigned(objsym.objsection) then
-                  elfsym.st_shndx:=TElfObjSection(objsym.objsection).secshidx
+                  elfsym.st_shndx:=objsym.objsection.index
                 else
                   elfsym.st_shndx:=SHN_UNDEF;
                 objsym.symidx:=symidx;
@@ -1087,10 +1162,9 @@ implementation
         with data do
          begin
            { create the reloc section }
-           if relocs_use_addend then
-             relocsect:=TElfObjSection.create_ext(data,'.rela'+s.name,SHT_RELA,0,symtabsect.secshidx,s.secshidx,4,3*sizeof(pint))
-           else
-             relocsect:=TElfObjSection.create_ext(data,'.rel'+s.name,SHT_REL,0,symtabsect.secshidx,s.secshidx,4,2*sizeof(pint));
+           relocsect:=TElfObjSection.create_reloc(data,s.name,false);
+           relocsect.shlink:=symtabsect.index;
+           relocsect.shinfo:=s.index;
            { add the relocations }
            for i:=0 to s.Objrelocations.count-1 do
              begin
@@ -1163,11 +1237,7 @@ implementation
                    else
                      relsym:=SHN_UNDEF;
                  end;
-{$ifdef cpu64bitaddr}
-               rel.info:=(qword(relsym) shl 32) or reltyp;
-{$else cpu64bitaddr}
-               rel.info:=(relsym shl 8) or reltyp;
-{$endif cpu64bitaddr}
+               rel.info:=ELF_R_INFO(relsym,reltyp);
                { write reloc }
                { ElfXX_Rel is essentially ElfXX_Rela without the addend field. }
                MaybeSwapElfReloc(rel);
@@ -1184,7 +1254,7 @@ implementation
         if (TElfObjSection(p).shtype in [SHT_SYMTAB,SHT_STRTAB,SHT_REL,SHT_RELA]) then
           exit;
         TObjSection(p).secsymidx:=symtabsect.symidx;
-        symtabsect.writeInternalSymbol(0,STT_SECTION,TElfObjSection(p).secshidx);
+        symtabsect.writeInternalSymbol(0,STT_SECTION,TObjSection(p).index);
       end;
 
 
@@ -1216,7 +1286,7 @@ implementation
                  symtabsect.WriteSymbol(objsym);
              end;
            { update the .symtab section header }
-           symtabsect.shlink:=TElfObjSection(symtabsect.fstrsec).secshidx;
+           symtabsect.shlink:=symtabsect.fstrsec.index;
          end;
       end;
 
@@ -1258,7 +1328,7 @@ implementation
 
     procedure TElfObjectOutput.section_count_sections(p:TObject;arg:pointer);
       begin
-        TElfObjSection(p).secshidx:=pword(arg)^;
+        TElfObjSection(p).index:=pword(arg)^;
         inc(pword(arg)^);
       end;
 
@@ -1288,11 +1358,11 @@ implementation
          begin
            { default sections }
            symtabsect:=TElfSymtab.create(data,esk_obj);
-           shstrtabsect:=TElfObjSection.create_ext(data,'.shstrtab',SHT_STRTAB,0,0,0,1,0);
+           shstrtabsect:=TElfObjSection.create_ext(data,'.shstrtab',SHT_STRTAB,0,1,0);
            { "no executable stack" marker for Linux }
            if (target_info.system in systems_linux) and
               not(cs_executable_stack in current_settings.moduleswitches) then
-             TElfObjSection.create_ext(data,'.note.GNU-stack',SHT_PROGBITS,0,0,0,1,0);
+             TElfObjSection.create_ext(data,'.note.GNU-stack',SHT_PROGBITS,0,1,0);
            { insert filename as first in strtab }
            symtabsect.fstrsec.writestr(ExtractFileName(current_module.mainsource));
            symtabsect.fstrsec.writestr(#0);
@@ -1339,7 +1409,7 @@ implementation
 {$endif arm}
            header.e_version:=1;
            header.e_shoff:=shoffset;
-           header.e_shstrndx:=shstrtabsect.secshidx;
+           header.e_shstrndx:=shstrtabsect.index;
 
            header.e_shnum:=nsections;
            header.e_ehsize:=sizeof(telfheader);

compiler/ognlm.pas

@@ -281,7 +281,7 @@ const NLM_MAX_DESCRIPTION_LENGTH = 127;
          procedure DataPos_Header;override;
          procedure fillNlmVersionHeader;
          procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);override;
-         procedure Order_End;override;
+         procedure MemPos_Start;override;
          procedure MemPos_ExeSection(const aname:string);override;
          procedure DataPos_ExeSection(const aname:string);override;
          procedure NLMwriteString (const s : string; terminateWithZero : boolean);
@@ -1172,7 +1172,7 @@ function SecOpts(SecOptions:TObjSectionOptions):string;
         exesec:=FindExeSection('.reloc');
         if exesec=nil then
           exit;
-        objsec:=internalObjData.createsection('.reloc',0,exesec.SecOptions+[oso_data]);
+        objsec:=internalObjData.createsection('.reloc',0,[oso_data,oso_load,oso_keep]);
         exesec.AddObjSection(objsec);
         for i:=0 to ExeSectionList.Count-1 do
           begin
@@ -1227,15 +1227,15 @@ function SecOpts(SecOptions:TObjSectionOptions):string;
       end;
 
 
-    procedure TNLMexeoutput.Order_End;
+    procedure TNLMexeoutput.MemPos_Start;
       var
         exesec : TExeSection;
       begin
-        inherited;
         exesec:=FindExeSection('.reloc');
         if exesec=nil then
-          exit;
-        exesec.SecOptions:=exesec.SecOptions + [oso_Data,oso_keep,oso_load];
+          InternalError(2012072602);
+        exesec.SecOptions:=exesec.SecOptions-[oso_disabled];
+        inherited;
       end;
 
 

compiler/optcse.pas

@@ -50,12 +50,12 @@ unit optcse;
   implementation
 
     uses
-      globtype,
+      globtype,globals,
       cclasses,
       verbose,
       nutils,
       procinfo,
-      nbas,nld,ninl,ncal,ncnv,nadd,
+      nbas,nld,ninl,ncal,ncnv,nadd,nmem,
       pass_1,
       symconst,symtype,symdef,symsym,
       defutil,
@@ -65,7 +65,7 @@ unit optcse;
       cseinvariant : set of tnodetype = [addn,muln,subn,divn,slashn,modn,andn,orn,xorn,notn,vecn,
         derefn,equaln,unequaln,ltn,gtn,lten,gten,typeconvn,subscriptn,
         inn,symdifn,shrn,shln,ordconstn,realconstn,unaryminusn,pointerconstn,stringconstn,setconstn,
-        isn,asn,starstarn,nothingn,temprefn,loadparentfpn {,callparan}];
+        isn,asn,starstarn,nothingn,temprefn,loadparentfpn {,callparan},assignn];
 
     function searchsubdomain(var n:tnode; arg: pointer) : foreachnoderesult;
       begin
@@ -122,41 +122,58 @@ unit optcse;
             exit;
           end;
         { so far, we can handle only nodes being read }
-        if (n.flags*[nf_write,nf_modify]=[]) and
+        if
           { node possible to add? }
           assigned(n.resultdef) and
-          (tstoreddef(n.resultdef).is_intregable or tstoreddef(n.resultdef).is_fpuregable) and
-          { is_int/fpuregable allows arrays and records to be in registers, cse cannot handle this }
-          not(n.resultdef.typ in [arraydef,recorddef]) and
-          { same for voiddef }
-          not(is_void(n.resultdef)) and
-          { adding tempref nodes is worthless but their complexity is probably <= 1 anyways }
-          not(n.nodetype in [temprefn]) and
-
-          { node worth to add?
-
-            We consider almost every node because even loading a variables from
-            a register instead of memory is more beneficial. This behaviour should
-            not increase register pressure because if a variable is already
-            in a register, the reg. allocator can merge the nodes. If a variable
-            is loaded from memory, loading this variable and spilling another register
-            should not add a speed penalty.
-          }
-          {
-            load nodes are not considered if they load para or local symbols from the
-            current stack frame, those are in registers anyways if possible
-          }
-          (not(n.nodetype=loadn) or
-           not(tloadnode(n).symtableentry.typ in [paravarsym,localvarsym]) or
-           (tloadnode(n).symtable.symtablelevel<>current_procinfo.procdef.parast.symtablelevel)
-          ) and
-
-          {
-            Const nodes however are only considered if their complexity is >1
-            This might be the case for the risc architectures if they need
-            more than one instruction to load this particular value
-          }
-          (not(is_constnode(n)) or (node_complexity(n)>1)) then
+          (
+            { regable expressions }
+            (n.actualtargetnode.flags*[nf_write,nf_modify]=[]) and
+            ((tstoreddef(n.resultdef).is_intregable or tstoreddef(n.resultdef).is_fpuregable) and
+            { is_int/fpuregable allows arrays and records to be in registers, cse cannot handle this }
+            (not(n.resultdef.typ in [arraydef,recorddef])) and
+            { same for voiddef }
+            not(is_void(n.resultdef)) and
+            { adding tempref nodes is worthless but their complexity is probably <= 1 anyways }
+            not(n.nodetype in [temprefn]) and
+
+            { node worth to add?
+
+              We consider almost every node because even loading a variables from
+              a register instead of memory is more beneficial. This behaviour should
+              not increase register pressure because if a variable is already
+              in a register, the reg. allocator can merge the nodes. If a variable
+              is loaded from memory, loading this variable and spilling another register
+              should not add a speed penalty.
+            }
+            {
+              load nodes are not considered if they load para or local symbols from the
+              current stack frame, those are in registers anyways if possible
+            }
+            (not(n.nodetype=loadn) or
+             not(tloadnode(n).symtableentry.typ in [paravarsym,localvarsym]) or
+             (tloadnode(n).symtable.symtablelevel<>current_procinfo.procdef.parast.symtablelevel)
+            ) and
+
+            {
+              Const nodes however are only considered if their complexity is >1
+              This might be the case for the risc architectures if they need
+              more than one instruction to load this particular value
+            }
+            (not(is_constnode(n)) or (node_complexity(n)>1)))
+{$ifndef x86}
+            or
+            { store reference of expression? }
+
+            { loading the address of a global symbol takes typically more than
+              one instruction on every platform except x86
+              so consider in this case loading the address of the data
+            }
+            (((n.resultdef.typ in [arraydef,recorddef]) or is_object(n.resultdef)) and
+             (n.nodetype=loadn) and
+             (tloadnode(n).symtableentry.typ=staticvarsym)
+            )
+{$endif x86}
+          ) then
           begin
             plists(arg)^.nodelist.Add(n);
             plists(arg)^.locationlist.Add(@n);
@@ -207,14 +224,75 @@ unit optcse;
         creates,
         statements : tstatementnode;
         hp : ttempcreatenode;
+        addrstored : boolean;
+        hp2 : tnode;
       begin
         result:=fen_false;
         if n.nodetype in cseinvariant then
           begin
             csedomain:=true;
             foreachnodestatic(pm_postprocess,n,@searchsubdomain,@csedomain);
-            { found a cse domain }
-            if csedomain then
+            if not(csedomain) then
+              begin
+                { try to transform the tree to get better cse domains, consider:
+                       +
+                      / \
+                     +   C
+                    / \
+                   A   B
+
+                  if A is not cse'able but B and C are, then the compiler cannot do cse so the tree is transformed into
+                       +
+                      / \
+                     A   +
+                        / \
+                       B   C
+                  Because A could be another tree of this kind, the whole process is done in a while loop
+                }
+                if (n.nodetype in [andn,orn,addn,muln]) and
+                  (n.nodetype=tbinarynode(n).left.nodetype) and
+                  { do is optimizations only for integers, reals (no currency!), vectors and sets }
+                  (is_integer(n.resultdef) or is_real(n.resultdef) or is_vector(n.resultdef) or is_set(n.resultdef)) and
+                  { either if fastmath is on }
+                  ((cs_opt_fastmath in current_settings.optimizerswitches) or
+                   { or for the logical operators, they cannot overflow }
+                   (n.nodetype in [andn,orn]) or
+                   { or for integers if range checking is off }
+                   ((is_integer(n.resultdef) and
+                    (n.localswitches*[cs_check_range,cs_check_overflow]=[]) and
+                    (tbinarynode(n).left.localswitches*[cs_check_range,cs_check_overflow]=[]))) or
+                   { for sets, we can do this always }
+                   (is_set(n.resultdef))
+                   ) then
+                  while n.nodetype=tbinarynode(n).left.nodetype do
+                    begin
+                      csedomain:=true;
+                      foreachnodestatic(pm_postprocess,tbinarynode(n).right,@searchsubdomain,@csedomain);
+                      if csedomain then
+                        begin
+                          csedomain:=true;
+                          foreachnodestatic(pm_postprocess,tbinarynode(tbinarynode(n).left).right,@searchsubdomain,@csedomain);
+                          if csedomain then
+                            begin
+                              hp2:=tbinarynode(tbinarynode(n).left).left;
+                              tbinarynode(tbinarynode(n).left).left:=tbinarynode(tbinarynode(n).left).right;
+                              tbinarynode(tbinarynode(n).left).right:=tbinarynode(n).right;
+                              tbinarynode(n).right:=tbinarynode(n).left;
+                              tbinarynode(n).left:=hp2;
+
+                              { the transformed tree could result in new possibilities to fold constants
+                                so force a firstpass on the root node }
+                              exclude(tbinarynode(n).right.flags,nf_pass1_done);
+                              do_firstpass(tbinarynode(n).right);
+                            end
+                          else
+                            break;
+                        end
+                      else
+                        break;
+                    end;
+              end
+            else
               begin
                 statements:=nil;
                 result:=fen_norecurse_true;
@@ -245,8 +323,17 @@ unit optcse;
                           end;
 
                         def:=tstoreddef(tnode(lists.nodelist[i]).resultdef);
-                        templist[i]:=ctempcreatenode.create_value(def,def.size,tt_persistent,
-                          def.is_intregable or def.is_fpuregable,tnode(lists.nodelist[i]));
+                        { we cannot handle register stored records or array in CSE yet
+                          but we can store their reference }
+                        addrstored:=(def.typ in [arraydef,recorddef]) or is_object(def);
+
+                        if addrstored then
+                          templist[i]:=ctempcreatenode.create_value(getpointerdef(def),voidpointertype.size,tt_persistent,
+                            true,caddrnode.create(tnode(lists.nodelist[i])))
+                        else
+                          templist[i]:=ctempcreatenode.create_value(def,def.size,tt_persistent,
+                            def.is_intregable or def.is_fpuregable,tnode(lists.nodelist[i]));
+
                         { make debugging easier and set temp. location to the original location }
                         tnode(templist[i]).fileinfo:=tnode(lists.nodelist[i]).fileinfo;
 
@@ -258,7 +345,10 @@ unit optcse;
                         do_firstpass(tnode(hp));
                         templist[i]:=hp;
 
-                        pnode(lists.locationlist[i])^:=ctemprefnode.create(ttempcreatenode(templist[i]));
+                        if addrstored then
+                          pnode(lists.locationlist[i])^:=cderefnode.Create(ctemprefnode.create(ttempcreatenode(templist[i])))
+                        else
+                          pnode(lists.locationlist[i])^:=ctemprefnode.create(ttempcreatenode(templist[i]));
                         { make debugging easier and set temp. location to the original location }
                         pnode(lists.locationlist[i])^.fileinfo:=tnode(lists.nodelist[i]).fileinfo;
 
@@ -270,13 +360,21 @@ unit optcse;
                     { current node reference to another node? }
                     else if lists.equalto[i]<>pointer(-1) then
                       begin
+                        def:=tstoreddef(tnode(lists.nodelist[i]).resultdef);
+                        { we cannot handle register stored records or array in CSE yet
+                          but we can store their reference }
+                        addrstored:=(def.typ in [arraydef,recorddef]) or is_object(def);
+
 {$if defined(csedebug) or defined(csestats)}
                         printnode(output,tnode(lists.nodelist[i]));
                         writeln(i,'    equals   ',ptrint(lists.equalto[i]));
                         printnode(output,tnode(lists.nodelist[ptrint(lists.equalto[i])]));
 {$endif defined(csedebug) or defined(csestats)}
                         templist[i]:=templist[ptrint(lists.equalto[i])];
-                        pnode(lists.locationlist[i])^:=ctemprefnode.create(ttempcreatenode(templist[ptrint(lists.equalto[i])]));
+                        if addrstored then
+                          pnode(lists.locationlist[i])^:=cderefnode.Create(ctemprefnode.create(ttempcreatenode(templist[ptrint(lists.equalto[i])])))
+                        else
+                          pnode(lists.locationlist[i])^:=ctemprefnode.create(ttempcreatenode(templist[ptrint(lists.equalto[i])]));
 
                         { make debugging easier and set temp. location to the original location }
                         pnode(lists.locationlist[i])^.fileinfo:=tnode(lists.nodelist[i]).fileinfo;

compiler/options.pas

@@ -2893,6 +2893,11 @@ begin
   def_system_macro('FPC_CURRENCY_IS_INT64');
   def_system_macro('FPC_COMP_IS_INT64');
   def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
+  { On most systems, locals are accessed relative to base pointer,
+    but for MIPS cpu, they are accessed relative to stack pointer.
+    This needs adaptation for so low level routines,
+    like MethodPointerLocal and related objects unit functions. }
+  def_system_macro('FPC_LOCALS_ARE_STACK_REG_RELATIVE');
 {$endif mipsel}
 
 {$ifdef mipseb}
@@ -2907,6 +2912,8 @@ begin
   def_system_macro('FPC_CURRENCY_IS_INT64');
   def_system_macro('FPC_COMP_IS_INT64');
   def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
+  { See comment above for mipsel }
+  def_system_macro('FPC_LOCALS_ARE_STACK_REG_RELATIVE');
 {$endif}
 
   { read configuration file }
@@ -3168,10 +3175,21 @@ if (target_info.system=system_arm_darwin) then
 { set default cpu type to ARMv7 for ARMHF unless specified otherwise }
 if (target_info.abi = abi_eabihf) then
   begin
+{$ifdef CPUARMV6}
+    { if the compiler is built for armv6, then
+      inherit this setting, e.g. Raspian is armhf but
+      only armv6, this makes rebuilds of the compiler
+      easier }
+    if not option.CPUSetExplicitly then
+      init_settings.cputype:=cpu_armv6;
+    if not option.OptCPUSetExplicitly then
+      init_settings.optimizecputype:=cpu_armv6;
+{$else CPUARMV6}
     if not option.CPUSetExplicitly then
       init_settings.cputype:=cpu_armv7;
     if not option.OptCPUSetExplicitly then
       init_settings.optimizecputype:=cpu_armv7;
+{$endif CPUARMV6}
   end;
 {$endif arm}
 

compiler/owar.pas

@@ -69,17 +69,19 @@ type
     CurrMemberPos,
     CurrMemberSize : longint;
     CurrMemberName : string;
+    isar: boolean;
     function  DecodeMemberName(ahdr:TArHdr):string;
     function  DecodeMemberSize(ahdr:TArHdr):longint;
     procedure ReadArchive;
   protected
     function getfilename:string;override;
   public
-    constructor create(const Aarfn:string);
+    constructor create(const Aarfn:string;allow_nonar:boolean=false);
     destructor  destroy;override;
     function  openfile(const fn:string):boolean;override;
     procedure closefile;override;
     procedure seek(len:longint);override;
+    property isarchive: boolean read isar;
   end;
 
 
@@ -315,7 +317,9 @@ implementation
 *****************************************************************************}
 
 
-    constructor tarobjectreader.create(const Aarfn:string);
+    constructor tarobjectreader.create(const Aarfn:string;allow_nonar:boolean);
+      var
+        magic:array[0..sizeof(armagic)-1] of char;
       begin
         inherited Create;
         ArSymbols:=TFPHashObjectList.Create(true);
@@ -323,7 +327,14 @@ implementation
         CurrMemberSize:=0;
         CurrMemberName:='';
         if inherited openfile(Aarfn) then
-          ReadArchive;
+          begin
+            Read(magic,sizeof(armagic));
+            isar:=(CompareByte(magic,armagic,sizeof(armagic))=0);
+            if isar then
+              ReadArchive
+            else if (not allow_nonar) then
+              Comment(V_Error,'Not a ar file, illegal magic: '+filename);
+          end;
       end;
 
 
@@ -414,7 +425,6 @@ implementation
 
     procedure tarobjectreader.ReadArchive;
       var
-        currarmagic : array[0..sizeof(armagic)-1] of char;
         currarhdr   : tarhdr;
         nrelocs,
         relocidx,
@@ -429,12 +439,6 @@ implementation
         startp      : pchar;
         relocs      : plongint;
       begin
-        Read(currarmagic,sizeof(armagic));
-        if CompareByte(currarmagic,armagic,sizeof(armagic))<>0 then
-          begin
-            Comment(V_Error,'Not a ar file, illegal magic: '+filename);
-            exit;
-          end;
         Read(currarhdr,sizeof(currarhdr));
         { Read number of relocs }
         Read(nrelocs,sizeof(nrelocs));

compiler/owbase.pas

@@ -72,6 +72,7 @@ type
     function  read(out b;len:longint):boolean;virtual;
     function  readarray(a:TDynamicArray;len:longint):boolean;
     property filename : string read getfilename;
+    property size:longint read bufmax;
   end;
 
 implementation
@@ -240,9 +241,9 @@ begin
        exit;
     end;
   ffilename:=fn;
-  getmem(buf,f.Size);
-  f.read(buf^,f.Size);
   bufmax:=f.Size;
+  getmem(buf,bufmax);
+  f.read(buf^,bufmax);
   f.free;
   bufidx:=0;
   opened:=true;

compiler/parabase.pas

@@ -73,18 +73,20 @@ unit parabase;
        end;
 
        TCGPara = object
+          Def       : tdef; { Type of the parameter }
           Location  : PCGParalocation;
           IntSize   : tcgint; { size of the total location in bytes }
+          DefDeref  : tderef;
           Alignment : ShortInt;
           Size      : TCGSize;  { Size of the parameter included in all locations }
-          Def       : tdef; { Type of the parameter }
-          DefDeref  : tderef;
+          Temporary : boolean;  { created on the fly, no permanent references exist to this somewhere that will cause it to be disposed }
 {$ifdef powerpc}
           composite: boolean; { under the AIX abi, how certain parameters are passed depends on whether they are composite or not }
 {$endif powerpc}
           constructor init;
           destructor  done;
           procedure   reset;
+          procedure   resetiftemp; { reset if Temporary }
           function    getcopy:tcgpara;
           procedure   check_simple_location;
           function    add_location:pcgparalocation;
@@ -132,6 +134,7 @@ implementation
         intsize:=0;
         location:=nil;
         def:=nil;
+        temporary:=false;
 {$ifdef powerpc}
         composite:=false;
 {$endif powerpc}
@@ -162,6 +165,12 @@ implementation
 {$endif powerpc}
       end;
 
+    procedure TCGPara.resetiftemp;
+      begin
+        if temporary then
+          reset;
+      end;
+
 
     function tcgpara.getcopy:tcgpara;
       var

compiler/paramgr.pas

@@ -114,7 +114,8 @@ unit paramgr;
             function result instead of its actual result. Used if the compiler
             forces the function result to something different than the real
             result.  }
-          function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;virtual;abstract;
+          function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;virtual;abstract;
+          procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
 
           { This is used to populate the location information on all parameters
             for the routine when it is being inlined. It returns
@@ -143,7 +144,7 @@ unit paramgr;
          strict protected
           { common part of get_funcretloc; returns true if retloc is completely
             initialized afterwards }
-          function set_common_funcretloc_info(p : tabstractprocdef; def: tdef; out retcgsize: tcgsize; out retloc: tcgpara): boolean;
+          function set_common_funcretloc_info(p : tabstractprocdef; forcetempdef: tdef; out retcgsize: tcgsize; out retloc: tcgpara): boolean;
        end;
 
 
@@ -453,6 +454,12 @@ implementation
       end;
 
 
+    procedure tparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
+      begin
+        p.funcretloc[side]:=get_funcretloc(p,side,nil);
+      end;
+
+
     function tparamanager.create_inline_paraloc_info(p : tabstractprocdef):longint;
       begin
         { We need to return the size allocated }
@@ -497,16 +504,22 @@ implementation
       end;
 
 
-    function tparamanager.set_common_funcretloc_info(p : tabstractprocdef; def: tdef; out retcgsize: tcgsize; out retloc: tcgpara): boolean;
+    function tparamanager.set_common_funcretloc_info(p : tabstractprocdef; forcetempdef: tdef; out retcgsize: tcgsize; out retloc: tcgpara): boolean;
       var
         paraloc : pcgparalocation;
       begin
         result:=true;
         retloc.init;
-        retloc.def:=def;
+        if not assigned(forcetempdef) then
+          retloc.def:=p.returndef
+        else
+          begin
+            retloc.def:=forcetempdef;
+            retloc.temporary:=true;
+          end;
         retloc.alignment:=get_para_align(p.proccalloption);
         { void has no location }
-        if is_void(def) then
+        if is_void(retloc.def) then
           begin
             paraloc:=retloc.add_location;
             retloc.size:=OS_NO;
@@ -528,14 +541,14 @@ implementation
           end
         else
           begin
-            retcgsize:=def_cgsize(def);
-            retloc.intsize:=def.size;
+            retcgsize:=def_cgsize(retloc.def);
+            retloc.intsize:=retloc.def.size;
           end;
         retloc.size:=retcgsize;
         { Return is passed as var parameter }
-        if ret_in_param(def,p.proccalloption) then
+        if ret_in_param(retloc.def,p.proccalloption) then
           begin
-            retloc.def:=getpointerdef(def);
+            retloc.def:=getpointerdef(retloc.def);
             paraloc:=retloc.add_location;
             paraloc^.loc:=LOC_REFERENCE;
             paraloc^.size:=retcgsize;

compiler/pdecobj.pas

@@ -966,6 +966,7 @@ implementation
         object_member_blocktype : tblock_type;
         fields_allowed, is_classdef, class_fields, is_final, final_fields: boolean;
         vdoptions: tvar_dec_options;
+        fieldlist: tfpobjectlist;
 
 
       procedure parse_const;
@@ -1059,6 +1060,7 @@ implementation
         is_final:=false;
         final_fields:=false;
         object_member_blocktype:=bt_general;
+        fieldlist:=tfpobjectlist.create(false);
         repeat
           case token of
             _TYPE :
@@ -1173,9 +1175,11 @@ implementation
                             vdoptions:=[vd_object];
                             if class_fields then
                               include(vdoptions,vd_class);
+                            if is_class(current_structdef) then
+                              include(vdoptions,vd_canreorder);
                             if final_fields then
                               include(vdoptions,vd_final);
-                            read_record_fields(vdoptions);
+                            read_record_fields(vdoptions,fieldlist);
                           end
                         else if object_member_blocktype=bt_type then
                           types_dec(true)
@@ -1226,6 +1230,10 @@ implementation
               consume(_ID); { Give a ident expected message, like tp7 }
           end;
         until false;
+
+        if is_class(current_structdef) then
+          tabstractrecordsymtable(current_structdef.symtable).addfieldlist(fieldlist,true);
+        fieldlist.free;
       end;
 
 

compiler/pdecsub.pas

@@ -233,6 +233,56 @@ implementation
         explicit_paraloc,
         need_array,
         is_univ: boolean;
+
+        procedure handle_default_para_value;
+          var
+            convpd : tprocdef;
+            doconv : tconverttype;
+            nodetype : tnodetype;
+            bt : tblock_type;
+          begin
+            { only allowed for types that can be represented by a
+              constant expression }
+            if try_to_consume(_EQ) then
+             begin
+               if (hdef.typ in [recorddef,variantdef,filedef,formaldef]) or
+                  is_object(hdef) or
+                  ((hdef.typ=arraydef) and
+                   not is_dynamic_array(hdef)) then
+                 Message1(type_e_invalid_default_value,FullTypeName(hdef,nil));
+               vs:=tparavarsym(sc[0]);
+               if sc.count>1 then
+                 Message(parser_e_default_value_only_one_para);
+               bt:=block_type;
+               block_type:=bt_const;
+               { prefix 'def' to the parameter name }
+               defaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo);
+               block_type:=bt;
+               if assigned(defaultvalue) then
+                 begin
+                   include(defaultvalue.symoptions,sp_internal);
+                   pd.parast.insert(defaultvalue);
+                   { check whether the default value is of the correct
+                     type }
+                   if defaultvalue.consttyp in [conststring,constwstring] then
+                     nodetype:=stringconstn
+                   else if defaultvalue.consttyp=constnil then
+                     nodetype:=niln
+                   else
+                     nodetype:=nothingn;
+                   if compare_defs_ext(defaultvalue.constdef,hdef,nodetype,doconv,convpd,[])<=te_convert_operator then
+                     MessagePos2(defaultvalue.fileinfo,type_e_incompatible_types,FullTypeName(defaultvalue.constdef,hdef),FullTypeName(hdef,defaultvalue.constdef));
+                 end;
+               defaultrequired:=true;
+             end
+            else
+             begin
+               if defaultrequired then
+                 Message1(parser_e_default_value_expected_for_para,vs.name);
+             end;
+          end;
+
+
       begin
         old_block_type:=block_type;
         explicit_paraloc:=false;
@@ -427,27 +477,7 @@ implementation
 
                 { default parameter }
                 if (m_default_para in current_settings.modeswitches) then
-                 begin
-                   if try_to_consume(_EQ) then
-                    begin
-                      vs:=tparavarsym(sc[0]);
-                      if sc.count>1 then
-                        Message(parser_e_default_value_only_one_para);
-                      { prefix 'def' to the parameter name }
-                      defaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo);
-                      if assigned(defaultvalue) then
-                        begin
-                          include(defaultvalue.symoptions,sp_internal);
-                          pd.parast.insert(defaultvalue);
-                        end;
-                      defaultrequired:=true;
-                    end
-                   else
-                    begin
-                      if defaultrequired then
-                        Message1(parser_e_default_value_expected_for_para,vs.name);
-                    end;
-                 end;
+                  handle_default_para_value;
               end;
            end
           else
@@ -2175,7 +2205,7 @@ const
       handler  : @pd_interrupt;
       pocall   : pocall_oldfpccall;
       pooption : [po_interrupt];
-      mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,pocall_stdcall,
+      mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,pocall_stdcall,pocall_mwpascal,
                        pocall_pascal,pocall_far16,pocall_oldfpccall];
       mutexclpotype : [potype_constructor,potype_destructor,potype_operator,potype_class_constructor,potype_class_destructor];
       mutexclpo     : [po_external,po_inline]

compiler/pdecvar.pas

@@ -27,17 +27,18 @@ unit pdecvar;
 interface
 
     uses
+      cclasses,
       symtable,symsym,symdef;
 
     type
-      tvar_dec_option=(vd_record,vd_object,vd_threadvar,vd_class,vd_final);
+      tvar_dec_option=(vd_record,vd_object,vd_threadvar,vd_class,vd_final,vd_canreorder);
       tvar_dec_options=set of tvar_dec_option;
 
     function  read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym;
 
     procedure read_var_decls(options:Tvar_dec_options);
 
-    procedure read_record_fields(options:Tvar_dec_options);
+    procedure read_record_fields(options:Tvar_dec_options; reorderlist: TFPObjectList);
 
     procedure read_public_and_external(vs: tabstractvarsym);
 
@@ -48,7 +49,7 @@ implementation
     uses
        SysUtils,
        { common }
-       cutils,cclasses,
+       cutils,
        { global }
        globtype,globals,tokens,verbose,constexp,
        systems,
@@ -938,8 +939,10 @@ implementation
                    fieldvarsym :
                      begin
                        ImplIntf.IType:=etFieldValue;
-                       { this must be done more sophisticated, here is also probably the wrong place }
-                       ImplIntf.IOffset:=tfieldvarsym(p.propaccesslist[palt_read].firstsym^.sym).fieldoffset;
+                       { this must be done in a more robust way. Can't read the
+                         fieldvarsym's fieldoffset yet, because it may not yet
+                         be set }
+                       ImplIntf.ImplementsField:=p.propaccesslist[palt_read].firstsym^.sym;
                      end
                    else
                      internalerror(200802161);
@@ -1577,7 +1580,7 @@ implementation
       end;
 
 
-    procedure read_record_fields(options:Tvar_dec_options);
+    procedure read_record_fields(options:Tvar_dec_options; reorderlist: TFPObjectList);
       var
          sc : TFPObjectList;
          i  : longint;
@@ -1637,6 +1640,11 @@ implementation
                if token=_ID then
                  begin
                    vs:=tfieldvarsym.create(sorg,vs_value,generrordef,[]);
+                   { normally the visibility is set via addfield, but sometimes
+                     we collect symbols so we can add them in a batch of
+                     potentially mixed visibility, and then the individual
+                     symbols need to have their visibility already set }
+                   vs.visibility:=visibility;
                    sc.add(vs);
                    recst.insert(vs);
                  end;
@@ -1796,14 +1804,13 @@ implementation
                    end;
                end;
 
-             { Generate field in the recordsymtable }
-             for i:=0 to sc.count-1 do
-               begin
-                 fieldvs:=tfieldvarsym(sc[i]);
-                 { static data fields are already inserted in the globalsymtable }
-                 if not(sp_static in fieldvs.symoptions) then
-                   recst.addfield(fieldvs,visibility);
-               end;
+             if not(vd_canreorder in options) then
+               { add field(s) to the recordsymtable }
+               recst.addfieldlist(sc,false)
+             else
+               { we may reorder the fields before adding them to the symbol
+                 table }
+               reorderlist.concatlistcopy(sc)
            end;
 
          if m_delphi in current_settings.modeswitches then
@@ -1875,7 +1882,7 @@ implementation
                 consume(_LKLAMMER);
                 inc(variantrecordlevel);
                 if token<>_RKLAMMER then
-                  read_record_fields([vd_record]);
+                  read_record_fields([vd_record],nil);
                 dec(variantrecordlevel);
                 consume(_RKLAMMER);
                 { calculates maximal variant size }

compiler/pexports.pas

@@ -163,6 +163,8 @@ implementation
                        pt:=comp_expr(true,false);
                        if pt.nodetype=stringconstn then
                          hpname:=strpas(tstringconstnode(pt).value_str)
+                       else if is_constcharnode(pt) then
+                         hpname:=chr(tordconstnode(pt).value.svalue and $ff)
                        else
                          consume(_CSTRING);
                        options:=options or eo_name;

compiler/pexpr.pas

@@ -2199,10 +2199,7 @@ implementation
               (
                (token=_LKLAMMER) or
                (
-                (
-                 (m_tp7 in current_settings.modeswitches) or
-                 (m_delphi in current_settings.modeswitches)
-                ) and
+                (([m_tp7,m_delphi,m_mac] * current_settings.modeswitches) <> []) and
                 (afterassignment or in_args)
                )
               ) then
@@ -2291,7 +2288,7 @@ implementation
                     else
                      begin
                        { We need to know if this unit uses Variants }
-                       if (hdef=cvarianttype) and
+                       if ((hdef=cvarianttype) or (hdef=colevarianttype)) and
                           not(cs_compilesystem in current_settings.moduleswitches) then
                          current_module.flags:=current_module.flags or uf_uses_variants;
                        p1:=handle_factor_typenode(hdef,getaddr,again,srsym,typeonly);

compiler/pgenutil.pas

@@ -397,8 +397,7 @@ uses
                 { use the index the module got from the current compilation process }
                 current_filepos.moduleindex:=hmodule.unit_index;
                 current_tokenpos:=current_filepos;
-                current_scanner.startreplaytokens(genericdef.generictokenbuf,
-                  genericdef.change_endian);
+                current_scanner.startreplaytokens(genericdef.generictokenbuf);
                 read_named_type(tt,srsym,genericdef,generictypelist,false);
                 current_filepos:=oldcurrent_filepos;
                 ttypesym(srsym).typedef:=tt;

compiler/powerpc/cpuinfo.pas

@@ -77,7 +77,8 @@ Const
                                  genericlevel3optimizerswitches-
                                  { no need to write info about those }
                                  [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
-                                 [cs_opt_regvar,cs_opt_loopunroll,cs_opt_nodecse,cs_opt_tailrecursion];
+                                 [cs_opt_regvar,cs_opt_loopunroll,cs_opt_nodecse,
+                                  cs_opt_tailrecursion,cs_opt_reorder_fields,cs_opt_fastmath];
 
    level1optimizerswitches = genericlevel1optimizerswitches;
    level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + [cs_opt_regvar,cs_opt_nodecse,cs_opt_tailrecursion];

compiler/powerpc/cpupara.pas

@@ -40,8 +40,7 @@ unit cpupara;
           procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
-          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
-          procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
+          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
          private
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
           function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras:tparalist;
@@ -246,23 +245,17 @@ unit cpupara;
       end;
 
 
-    procedure tppcparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
-      begin
-        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
-      end;
-
-
-    function tppcparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;
+    function tppcparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       var
         paraloc : pcgparalocation;
         retcgsize  : tcgsize;
       begin
-        if set_common_funcretloc_info(p,def,retcgsize,result) then
+        if set_common_funcretloc_info(p,forcetempdef,retcgsize,result) then
           exit;
 
         paraloc:=result.add_location;
         { Return in FPU register? }
-        if def.typ=floatdef then
+        if result.def.typ=floatdef then
           begin
             paraloc^.loc:=LOC_FPUREGISTER;
             paraloc^.register:=NR_FPU_RESULT_REG;
@@ -363,7 +356,7 @@ unit cpupara;
                 end;
               hp.paraloc[side].reset;
               { currently only support C-style array of const }
-              if (p.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_mwpascal]) and
+              if (p.proccalloption in cstylearrayofconst) and
                  is_array_of_const(paradef) then
                 begin
                   paraloc:=hp.paraloc[side].add_location;
@@ -580,7 +573,7 @@ unit cpupara;
         firstfloatreg:=curfloatreg;
 
         result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset, false);
-        if (p.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_mwpascal]) then
+        if (p.proccalloption in cstylearrayofconst) then
           { just continue loading the parameters in the registers }
           begin
             result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,true);

compiler/powerpc/nppcmat.pas

@@ -403,7 +403,13 @@ end;
                      cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reglo);
                      cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reglo);
                    end
-                 else } if shiftval > 31 then
+                 else }
+                 if shiftval = 0 then
+                   begin
+                     cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.register64.reghi,location.register64.reghi);
+                     cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.register64.reglo,location.register64.reglo);
+                   end
+                 else if shiftval > 31 then
                    begin
                      if nodetype = shln then
                        begin

compiler/powerpc64/cpuinfo.pas

@@ -69,7 +69,8 @@ const
                                  genericlevel3optimizerswitches-
                                  { no need to write info about those }
                                  [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
-                                 [cs_opt_regvar,cs_opt_loopunroll,cs_opt_nodecse,cs_opt_tailrecursion];
+                                 [cs_opt_regvar,cs_opt_loopunroll,cs_opt_nodecse,
+                                  cs_opt_tailrecursion,cs_opt_reorder_fields,cs_opt_fastmath];
 
    level1optimizerswitches = genericlevel1optimizerswitches;
    level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + 

compiler/powerpc64/cpupara.pas

@@ -44,8 +44,7 @@ type
     function create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint; override;
     function create_varargs_paraloc_info(p: tabstractprocdef; varargspara:
       tvarargsparalist): longint; override;
-    function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
-    procedure create_funcretloc_info(p: tabstractprocdef; side: tcallercallee);
+    function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
 
   private
     procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister;
@@ -202,24 +201,18 @@ begin
   curmmreg := RS_M2;
 end;
 
-procedure tppcparamanager.create_funcretloc_info(p: tabstractprocdef; side:
-  tcallercallee);
-begin
-  p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
-end;
-
 function tppcparamanager.get_funcretloc(p : tabstractprocdef; side:
-  tcallercallee; def: tdef): tcgpara;
+  tcallercallee; forcetempdef: tdef): tcgpara;
 var
   paraloc : pcgparalocation;
   retcgsize  : tcgsize;
 begin
-  if set_common_funcretloc_info(p,def,retcgsize,result) then
+  if set_common_funcretloc_info(p,forcetempdef,retcgsize,result) then
     exit;
 
   paraloc:=result.add_location;
   { Return in FPU register? }
-  if def.typ=floatdef then
+  if result.def.typ=floatdef then
     begin
       paraloc^.loc:=LOC_FPUREGISTER;
       paraloc^.register:=NR_FPU_RESULT_REG;

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 151;
+  CurrentPPUVersion = 152;
 
 { buffer sizes }
   maxentrysize = 1024;