Merged changes from trunk

git-svn-id: branches/mips_embedded@28623 -

Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2013/07/05]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2014-08-17 rev 28432]
 #
 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 mipsel-embedded jvm-java jvm-android i8086-msdos
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos
 BSDs = freebsd netbsd openbsd darwin
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom msdos
@@ -186,7 +186,7 @@ override FPCOPT+=-Cp$(SUBARCH)
 endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 ifeq ($(SUBARCH),)
-$(error When compiling for mipsel-embedded, a sub-architecture (e.g. SUBARCH=mips32 or SUBARCH=mips32v2) must be defined)
+$(error When compiling for mipsel-embedded, a sub-architecture (e.g. SUBARCH=pic32mx) must be defined)
 endif
 override FPCOPT+=-Cp$(SUBARCH)
 endif
@@ -282,7 +282,7 @@ else
 ifeq ($(CPU_TARGET),i386)
 BINUTILSPREFIX=i686-linux-android-
 else
-ifeq ($(CPU_TARGET),mips)
+ifeq ($(CPU_TARGET),mipsel)
 BINUTILSPREFIX=mipsel-linux-android-
 endif
 endif
@@ -327,8 +327,8 @@ endif
 endif
 override PACKAGE_NAME=fpc
 override PACKAGE_VERSION=2.7.1
-REQUIREDVERSION=2.6.2
-REQUIREDVERSION2=2.6.0
+REQUIREDVERSION=2.6.4
+REQUIREDVERSION2=2.6.2
 ifndef inOS2
 override FPCDIR:=$(BASEDIR)
 export FPCDIR
@@ -376,6 +376,9 @@ endif
 ifeq ($(CPU_TARGET),i8086)
 PPSUF=8086
 endif
+ifeq ($(CPU_TARGET),avr)
+PPSUF=avr
+endif
 ifdef CROSSCOMPILE
 ifneq ($(CPU_TARGET),jvm)
 PPPRE=ppcross
@@ -448,8 +451,11 @@ else
 FPCMAKENEW=$(BASEDIR)/utils/fpcm/bin/$(SOURCESUFFIX)/fpcmake$(SRCEXEEXT)
 endif
 endif
+ifneq ($(OPT),)
+OPTNEW+=$(OPT)
+endif
 CLEANOPTS=FPC=$(PPNEW)
-BUILDOPTS=FPC=$(PPNEW) FPCFPMAKE=$(FPCFPMAKENEW) RELEASE=1
+BUILDOPTS=FPC=$(PPNEW) FPCFPMAKE=$(FPCFPMAKENEW) RELEASE=1 'OPT=$(OPTNEW)'
 INSTALLOPTS=FPC=$(PPNEW) ZIPDESTDIR=$(BASEDIR) FPCMAKE=$(FPCMAKENEW)
 ifndef CROSSCOMPILE
 ifneq ($(wildcard ide),)
@@ -537,6 +543,9 @@ endif
 ifeq ($(FULL_TARGET),i386-android)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
+ifeq ($(FULL_TARGET),i386-aros)
+override TARGET_DIRS+=compiler rtl utils packages ide installer
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
@@ -681,6 +690,9 @@ endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
+ifeq ($(FULL_TARGET),mipsel-android)
+override TARGET_DIRS+=compiler rtl utils packages ide installer
+endif
 ifeq ($(FULL_TARGET),jvm-java)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
@@ -978,6 +990,11 @@ EXEEXT=
 SHAREDLIBEXT=.library
 SHORTSUFFIX=amg
 endif
+ifeq ($(OS_TARGET),aros)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=aros
+endif
 ifeq ($(OS_TARGET),morphos)
 EXEEXT=
 SHAREDLIBEXT=.library
@@ -1072,7 +1089,7 @@ endif
 endif
 ifeq ($(OS_TARGET),msdos)
 STATICLIBPREFIX=
-STATICLIBEXT=.lib
+STATICLIBEXT=.a
 SHORTSUFFIX=d16
 endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
@@ -1264,6 +1281,7 @@ ASNAME=$(BINUTILSPREFIX)as
 LDNAME=$(BINUTILSPREFIX)ld
 ARNAME=$(BINUTILSPREFIX)ar
 RCNAME=$(BINUTILSPREFIX)rc
+NASMNAME=$(BINUTILSPREFIX)nasm
 ifndef ASPROG
 ifdef CROSSBINDIR
 ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
@@ -1292,10 +1310,18 @@ else
 ARPROG=$(ARNAME)
 endif
 endif
+ifndef NASMPROG
+ifdef CROSSBINDIR
+NASMPROG=$(CROSSBINDIR)/$(NASMNAME)$(SRCEXEEXT)
+else
+NASMPROG=$(NASMNAME)
+endif
+endif
 AS=$(ASPROG)
 LD=$(LDPROG)
 RC=$(RCPROG)
 AR=$(ARPROG)
+NASM=$(NASMPROG)
 ifdef inUnix
 PPAS=./ppas$(SRCBATCHEXT)
 else
@@ -1462,18 +1488,24 @@ endif
 ifdef ACROSSCOMPILE
 override FPCOPT+=$(CROSSOPT)
 endif
-override COMPILER:=$(FPC) $(FPCOPT)
-ifeq (,$(findstring -s ,$(COMPILER)))
+override COMPILER:=$(strip $(FPC) $(FPCOPT))
+ifneq (,$(findstring -sh ,$(COMPILER)))
+UseEXECPPAS=1
+endif
+ifneq (,$(findstring -s ,$(COMPILER)))
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+UseEXECPPAS=1
+endif
+endif
+ifneq ($(UseEXECPPAS),1)
 EXECPPAS=
 else
-ifeq ($(FULL_SOURCE),$(FULL_TARGET))
 ifdef RUNBATCH
 EXECPPAS:=@$(RUNBATCH) $(PPAS)
 else
 EXECPPAS:=@$(PPAS)
 endif
 endif
-endif
 ifdef TARGET_RSTS
 override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
 override CLEANRSTFILES+=$(RSTFILES)
@@ -1999,6 +2031,14 @@ TARGET_DIRS_PACKAGES=1
 TARGET_DIRS_IDE=1
 TARGET_DIRS_INSTALLER=1
 endif
+ifeq ($(FULL_TARGET),i386-aros)
+TARGET_DIRS_COMPILER=1
+TARGET_DIRS_RTL=1
+TARGET_DIRS_UTILS=1
+TARGET_DIRS_PACKAGES=1
+TARGET_DIRS_IDE=1
+TARGET_DIRS_INSTALLER=1
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 TARGET_DIRS_COMPILER=1
 TARGET_DIRS_RTL=1
@@ -2383,6 +2423,14 @@ TARGET_DIRS_PACKAGES=1
 TARGET_DIRS_IDE=1
 TARGET_DIRS_INSTALLER=1
 endif
+ifeq ($(FULL_TARGET),mipsel-android)
+TARGET_DIRS_COMPILER=1
+TARGET_DIRS_RTL=1
+TARGET_DIRS_UTILS=1
+TARGET_DIRS_PACKAGES=1
+TARGET_DIRS_IDE=1
+TARGET_DIRS_INSTALLER=1
+endif
 ifeq ($(FULL_TARGET),jvm-java)
 TARGET_DIRS_COMPILER=1
 TARGET_DIRS_RTL=1

Makefile.fpc

@@ -20,8 +20,8 @@ fpcdir=.
 rule=help
 
 [prerules]
-REQUIREDVERSION=2.6.2
-REQUIREDVERSION2=2.6.0
+REQUIREDVERSION=2.6.4
+REQUIREDVERSION2=2.6.2
 
 
 # make versions < 3.77 (OS2 version) are buggy
@@ -76,6 +76,9 @@ endif
 ifeq ($(CPU_TARGET),i8086)
 PPSUF=8086
 endif
+ifeq ($(CPU_TARGET),avr)
+PPSUF=avr
+endif
 
 # cross compilers uses full cpu_target, not just ppc-suffix
 # (except if the target cannot run a native compiler)
@@ -179,8 +182,11 @@ endif
 endif
 
 # Build/install options
+ifneq ($(OPT),)
+OPTNEW+=$(OPT)
+endif
 CLEANOPTS=FPC=$(PPNEW)
-BUILDOPTS=FPC=$(PPNEW) FPCFPMAKE=$(FPCFPMAKENEW) RELEASE=1
+BUILDOPTS=FPC=$(PPNEW) FPCFPMAKE=$(FPCFPMAKENEW) RELEASE=1 'OPT=$(OPTNEW)'
 INSTALLOPTS=FPC=$(PPNEW) ZIPDESTDIR=$(BASEDIR) FPCMAKE=$(FPCMAKENEW)
 
 # Compile also IDE (check for ide and fv dir)

compiler/Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2013/07/05]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2014-08-17 rev 28432]
 #
 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 sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded jvm-java jvm-android i8086-msdos
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos
 BSDs = freebsd netbsd openbsd darwin
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom msdos
@@ -186,7 +186,7 @@ override FPCOPT+=-Cp$(SUBARCH)
 endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 ifeq ($(SUBARCH),)
-$(error When compiling for mipsel-embedded, a sub-architecture (e.g. SUBARCH=mips32 or SUBARCH=mips32v2) must be defined)
+$(error When compiling for mipsel-embedded, a sub-architecture (e.g. SUBARCH=pic32mx) must be defined)
 endif
 override FPCOPT+=-Cp$(SUBARCH)
 endif
@@ -282,7 +282,7 @@ else
 ifeq ($(CPU_TARGET),i386)
 BINUTILSPREFIX=i686-linux-android-
 else
-ifeq ($(CPU_TARGET),mips)
+ifeq ($(CPU_TARGET),mipsel)
 BINUTILSPREFIX=mipsel-linux-android-
 endif
 endif
@@ -408,18 +408,24 @@ override LOCALOPT+=$(OPTLEVEL2)
 override RTLOPT+=$(OPTLEVEL2)
 override LOCALOPT+=$(LOCALOPTLEVEL2)
 override RTLOPT+=$(RTLOPTLEVEL2)
+override LOCALOPT+=$(OPTNEW)
+override RTLOPT+=$(OPTNEW)
 endif
 ifeq ($(CYCLELEVEL),3)
 override LOCALOPT+=$(OPTLEVEL3)
 override RTLOPT+=$(OPTLEVEL3)
 override LOCALOPT+=$(LOCALOPTLEVEL3)
 override RTLOPT+=$(RTLOPTLEVEL3)
+override LOCALOPT+=$(OPTNEW)
+override RTLOPT+=$(OPTNEW)
 endif
 ifeq ($(CYCLELEVEL),4)
 override LOCALOPT+=$(OPTLEVEL4)
 override RTLOPT+=$(OPTLEVEL4)
 override LOCALOPT+=$(LOCALOPTLEVEL4)
 override RTLOPT+=$(RTLOPTLEVEL4)
+override LOCALOPT+=$(OPTNEW)
+override RTLOPT+=$(OPTNEW)
 endif
 endif
 override OPT=
@@ -495,7 +501,7 @@ ifeq ($(PPC_TARGET),powerpc64)
 override LOCALOPT+=-Fuppcgen
 endif
 ifeq ($(PPC_TARGET),m68k)
-override LOCALOPT+=-dNOOPT
+override LOCALOPT+=
 endif
 ifeq ($(PPC_TARGET),sparc)
 override LOCALOPT+=
@@ -608,6 +614,9 @@ endif
 ifeq ($(FULL_TARGET),i386-android)
 override TARGET_DIRS+=utils
 endif
+ifeq ($(FULL_TARGET),i386-aros)
+override TARGET_DIRS+=utils
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override TARGET_DIRS+=utils
 endif
@@ -752,6 +761,9 @@ endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 override TARGET_DIRS+=utils
 endif
+ifeq ($(FULL_TARGET),mipsel-android)
+override TARGET_DIRS+=utils
+endif
 ifeq ($(FULL_TARGET),jvm-java)
 override TARGET_DIRS+=utils
 endif
@@ -830,6 +842,9 @@ endif
 ifeq ($(FULL_TARGET),i386-android)
 override TARGET_PROGRAMS+=pp
 endif
+ifeq ($(FULL_TARGET),i386-aros)
+override TARGET_PROGRAMS+=pp
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override TARGET_PROGRAMS+=pp
 endif
@@ -974,6 +989,9 @@ endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 override TARGET_PROGRAMS+=pp
 endif
+ifeq ($(FULL_TARGET),mipsel-android)
+override TARGET_PROGRAMS+=pp
+endif
 ifeq ($(FULL_TARGET),jvm-java)
 override TARGET_PROGRAMS+=pp
 endif
@@ -1053,6 +1071,9 @@ endif
 ifeq ($(FULL_TARGET),i386-android)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
+ifeq ($(FULL_TARGET),i386-aros)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
@@ -1197,6 +1218,9 @@ endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
+ifeq ($(FULL_TARGET),mipsel-android)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
 ifeq ($(FULL_TARGET),jvm-java)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
@@ -1275,6 +1299,9 @@ endif
 ifeq ($(FULL_TARGET),i386-android)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
+ifeq ($(FULL_TARGET),i386-aros)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -1419,6 +1446,9 @@ endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
+ifeq ($(FULL_TARGET),mipsel-android)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
 ifeq ($(FULL_TARGET),jvm-java)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -1497,6 +1527,9 @@ endif
 ifeq ($(FULL_TARGET),i386-android)
 override COMPILER_TARGETDIR+=.
 endif
+ifeq ($(FULL_TARGET),i386-aros)
+override COMPILER_TARGETDIR+=.
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override COMPILER_TARGETDIR+=.
 endif
@@ -1641,6 +1674,9 @@ endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 override COMPILER_TARGETDIR+=.
 endif
+ifeq ($(FULL_TARGET),mipsel-android)
+override COMPILER_TARGETDIR+=.
+endif
 ifeq ($(FULL_TARGET),jvm-java)
 override COMPILER_TARGETDIR+=.
 endif
@@ -1719,6 +1755,9 @@ endif
 ifeq ($(FULL_TARGET),i386-android)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),i386-aros)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -1863,6 +1902,9 @@ endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),mipsel-android)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
 ifeq ($(FULL_TARGET),jvm-java)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -2159,6 +2201,11 @@ EXEEXT=
 SHAREDLIBEXT=.library
 SHORTSUFFIX=amg
 endif
+ifeq ($(OS_TARGET),aros)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=aros
+endif
 ifeq ($(OS_TARGET),morphos)
 EXEEXT=
 SHAREDLIBEXT=.library
@@ -2253,7 +2300,7 @@ endif
 endif
 ifeq ($(OS_TARGET),msdos)
 STATICLIBPREFIX=
-STATICLIBEXT=.lib
+STATICLIBEXT=.a
 SHORTSUFFIX=d16
 endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
@@ -2445,6 +2492,7 @@ ASNAME=$(BINUTILSPREFIX)as
 LDNAME=$(BINUTILSPREFIX)ld
 ARNAME=$(BINUTILSPREFIX)ar
 RCNAME=$(BINUTILSPREFIX)rc
+NASMNAME=$(BINUTILSPREFIX)nasm
 ifndef ASPROG
 ifdef CROSSBINDIR
 ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
@@ -2473,10 +2521,18 @@ else
 ARPROG=$(ARNAME)
 endif
 endif
+ifndef NASMPROG
+ifdef CROSSBINDIR
+NASMPROG=$(CROSSBINDIR)/$(NASMNAME)$(SRCEXEEXT)
+else
+NASMPROG=$(NASMNAME)
+endif
+endif
 AS=$(ASPROG)
 LD=$(LDPROG)
 RC=$(RCPROG)
 AR=$(ARPROG)
+NASM=$(NASMPROG)
 ifdef inUnix
 PPAS=./ppas$(SRCBATCHEXT)
 else
@@ -2571,6 +2627,9 @@ endif
 ifeq ($(FULL_TARGET),i386-android)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),i386-aros)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -2715,6 +2774,9 @@ endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),mipsel-android)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),jvm-java)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -2904,18 +2966,24 @@ endif
 ifdef ACROSSCOMPILE
 override FPCOPT+=$(CROSSOPT)
 endif
-override COMPILER:=$(FPC) $(FPCOPT)
-ifeq (,$(findstring -s ,$(COMPILER)))
+override COMPILER:=$(strip $(FPC) $(FPCOPT))
+ifneq (,$(findstring -sh ,$(COMPILER)))
+UseEXECPPAS=1
+endif
+ifneq (,$(findstring -s ,$(COMPILER)))
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+UseEXECPPAS=1
+endif
+endif
+ifneq ($(UseEXECPPAS),1)
 EXECPPAS=
 else
-ifeq ($(FULL_SOURCE),$(FULL_TARGET))
 ifdef RUNBATCH
 EXECPPAS:=@$(RUNBATCH) $(PPAS)
 else
 EXECPPAS:=@$(PPAS)
 endif
 endif
-endif
 .PHONY: fpc_exes
 ifndef CROSSINSTALL
 ifneq ($(TARGET_PROGRAMS),)
@@ -3419,6 +3487,9 @@ endif
 ifeq ($(FULL_TARGET),i386-android)
 TARGET_DIRS_UTILS=1
 endif
+ifeq ($(FULL_TARGET),i386-aros)
+TARGET_DIRS_UTILS=1
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 TARGET_DIRS_UTILS=1
 endif
@@ -3563,6 +3634,9 @@ endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 TARGET_DIRS_UTILS=1
 endif
+ifeq ($(FULL_TARGET),mipsel-android)
+TARGET_DIRS_UTILS=1
+endif
 ifeq ($(FULL_TARGET),jvm-java)
 TARGET_DIRS_UTILS=1
 endif
@@ -3752,9 +3826,12 @@ msgtxt.inc: $(MSGFILE)
 msg: msgtxt.inc
 insdatx86 : $(COMPILER_UNITTARGETDIR) x86/x86ins.dat
 	$(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkx86ins.pp
+	cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86ins$(SRCEXEEXT) i8086 && mv -f *.inc ../i8086
 	cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86ins$(SRCEXEEXT) && mv -f *.inc ../i386
 	cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86ins$(SRCEXEEXT) x86_64 && mv -f *.inc ../x86_64
 	$(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkx86reg.pp
+	cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86reg$(SRCEXEEXT) i8086
+	mv -f x86/r8086*.inc i8086
 	cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86reg$(SRCEXEEXT)
 	mv -f x86/r386*.inc i386
 	cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86reg$(SRCEXEEXT) x86_64
@@ -3825,13 +3902,13 @@ ifdef RELEASE
 DOWPOCYCLE=1
 wpocycle:
 	$(RM) $(EXENAME)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(LOCALOPT) $(OPTWPOCOLLECT)' compiler
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTWPOCOLLECT) $(OPTNEW))' compiler
 	$(RM) $(EXENAME)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(RTLOPT) $(OPTWPOPERFORM)' rtlclean rtl
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(LOCALOPT) $(OPTWPOPERFORM) $(subst pp1.wpo,pp2.wpo,$(OPTWPOCOLLECT))' $(addsuffix _clean,$(ALLTARGETS)) compiler
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(RTLOPT) $(OPTWPOPERFORM) $(OPTNEW))' rtlclean rtl
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(OPTWPOPERFORM) $(subst pp1.wpo,pp2.wpo,$(OPTWPOCOLLECT)))' $(addsuffix _clean,$(ALLTARGETS)) compiler
 	$(MOVE) $(EXENAME) $(TEMPWPONAME1)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(RTLOPT) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM))' rtlclean rtl
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(LOCALOPT) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM))' $(addsuffix _clean,$(ALLTARGETS)) compiler
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(strip $(RTLOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' rtlclean rtl
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' $(addsuffix _clean,$(ALLTARGETS)) compiler
 	$(COPY) $(EXENAME) $(TEMPWPONAME2)
 endif
 endif
@@ -3900,12 +3977,12 @@ cycle: override FPC=
 cycle:
 	$(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 rtlclean rtl CYCLELEVEL=1
 	$(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 CYCLELEVEL=‚
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 rtlclean rtl CYCLELEVEL=2
 	$(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 CYCLELEVEL=3
 ifndef NoNativeBinaries
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(LOCALOPT) $(CROSSOPT)' cycleclean compiler CYCLELEVEL=3
+	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(strip $(LOCALOPT) $(CROSSOPT))' cycleclean compiler CYCLELEVEL=3
 endif
 endif
 endif

compiler/Makefile.fpc

@@ -138,18 +138,24 @@ override LOCALOPT+=$(OPTLEVEL2)
 override RTLOPT+=$(OPTLEVEL2)
 override LOCALOPT+=$(LOCALOPTLEVEL2)
 override RTLOPT+=$(RTLOPTLEVEL2)
+override LOCALOPT+=$(OPTNEW)
+override RTLOPT+=$(OPTNEW)
 endif
 ifeq ($(CYCLELEVEL),3)
 override LOCALOPT+=$(OPTLEVEL3)
 override RTLOPT+=$(OPTLEVEL3)
 override LOCALOPT+=$(LOCALOPTLEVEL3)
 override RTLOPT+=$(RTLOPTLEVEL3)
+override LOCALOPT+=$(OPTNEW)
+override RTLOPT+=$(OPTNEW)
 endif
 ifeq ($(CYCLELEVEL),4)
 override LOCALOPT+=$(OPTLEVEL4)
 override RTLOPT+=$(OPTLEVEL4)
 override LOCALOPT+=$(LOCALOPTLEVEL4)
 override RTLOPT+=$(RTLOPTLEVEL4)
+override LOCALOPT+=$(OPTNEW)
+override RTLOPT+=$(OPTNEW)
 endif
 endif
 
@@ -255,7 +261,7 @@ endif
 
 # m68k specific
 ifeq ($(PPC_TARGET),m68k)
-override LOCALOPT+=-dNOOPT
+override LOCALOPT+=
 endif
 
 # Sparc specific
@@ -478,9 +484,12 @@ msg: msgtxt.inc
 
 insdatx86 : $(COMPILER_UNITTARGETDIR) x86/x86ins.dat
 	$(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkx86ins.pp
+        cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86ins$(SRCEXEEXT) i8086 && mv -f *.inc ../i8086
         cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86ins$(SRCEXEEXT) && mv -f *.inc ../i386
         cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86ins$(SRCEXEEXT) x86_64 && mv -f *.inc ../x86_64
 	$(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkx86reg.pp
+        cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86reg$(SRCEXEEXT) i8086
+        mv -f x86/r8086*.inc i8086
         cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86reg$(SRCEXEEXT)
         mv -f x86/r386*.inc i386
         cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86reg$(SRCEXEEXT) x86_64
@@ -593,13 +602,13 @@ DOWPOCYCLE=1
 wpocycle:
 # don't use cycle_clean, it will delete the compiler utilities again
         $(RM) $(EXENAME)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(LOCALOPT) $(OPTWPOCOLLECT)' compiler
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTWPOCOLLECT) $(OPTNEW))' compiler
         $(RM) $(EXENAME)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(RTLOPT) $(OPTWPOPERFORM)' rtlclean rtl
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(LOCALOPT) $(OPTWPOPERFORM) $(subst pp1.wpo,pp2.wpo,$(OPTWPOCOLLECT))' $(addsuffix _clean,$(ALLTARGETS)) compiler
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(RTLOPT) $(OPTWPOPERFORM) $(OPTNEW))' rtlclean rtl
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(OPTWPOPERFORM) $(subst pp1.wpo,pp2.wpo,$(OPTWPOCOLLECT)))' $(addsuffix _clean,$(ALLTARGETS)) compiler
         $(MOVE) $(EXENAME) $(TEMPWPONAME1)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(RTLOPT) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM))' rtlclean rtl
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(LOCALOPT) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM))' $(addsuffix _clean,$(ALLTARGETS)) compiler
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(strip $(RTLOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' rtlclean rtl
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(strip $(LOCALOPT) $(OPTNEW) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM)))' $(addsuffix _clean,$(ALLTARGETS)) compiler
         $(COPY) $(EXENAME) $(TEMPWPONAME2)
 endif
 endif
@@ -701,14 +710,14 @@ cycle:
         $(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 rtlclean rtl CYCLELEVEL=1
         $(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 cycleclean compiler CYCLELEVEL=1
 # ppcross<ARCH> (source native)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 rtlclean rtl CYCLELEVEL=‚
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 rtlclean rtl CYCLELEVEL=2
         $(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
 # ppc<ARCH> (target native)
 ifndef CROSSINSTALL
         $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(RTLOPT) $(CROSSOPT)' rtlclean rtl CYCLELEVEL=3
 # building a native compiler for JVM and embedded targets is not possible
 ifndef NoNativeBinaries
-        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(LOCALOPT) $(CROSSOPT)' cycleclean compiler CYCLELEVEL=3
+        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(strip $(LOCALOPT) $(CROSSOPT))' cycleclean compiler CYCLELEVEL=3
 endif
 endif
 

compiler/aarch64/cpubase.pas

@@ -281,9 +281,10 @@ unit cpubase;
       }
       saved_standard_registers : array[0..9] of tsuperregister =
         (RS_X19,RS_X20,RS_X21,RS_X22,RS_X23,RS_X24,RS_X25,RS_X26,RS_X27,RS_X28);
+      saved_mm_registers : array[0..7] of tsuperregister = (RS_D8,RS_D9,RS_D10,RS_D11,RS_D12,RS_D13,RS_D14,RS_D15);
 
       { this is only for the generic code which is not used for this architecture }
-      saved_mm_registers : array[0..7] of tsuperregister = (RS_D8,RS_D9,RS_D10,RS_D11,RS_D12,RS_D13,RS_D14,RS_D15);
+      saved_address_registers : array[0..0] of tsuperregister = (RS_INVALID);
 
 {*****************************************************************************
                                   Helpers

compiler/aarch64/symcpu.pas

@@ -0,0 +1,178 @@
+{
+    Copyright (c) 2014 by Florian Klaempfl
+
+    Symbol table overrides for AARCH64
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit symcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  symtype,symdef,symsym;
+
+type
+  { defs }
+  tcpufiledef = class(tfiledef)
+  end;
+
+  tcpuvariantdef = class(tvariantdef)
+  end;
+
+  tcpuformaldef = class(tformaldef)
+  end;
+
+  tcpuforwarddef = class(tforwarddef)
+  end;
+
+  tcpuundefineddef = class(tundefineddef)
+  end;
+
+  tcpuerrordef = class(terrordef)
+  end;
+
+  tcpupointerdef = class(tpointerdef)
+  end;
+
+  tcpurecorddef = class(trecorddef)
+  end;
+
+  tcpuimplementedinterface = class(timplementedinterface)
+  end;
+
+  tcpuobjectdef = class(tobjectdef)
+  end;
+
+  tcpuclassrefdef = class(tclassrefdef)
+  end;
+
+  tcpuarraydef = class(tarraydef)
+  end;
+
+  tcpuorddef = class(torddef)
+  end;
+
+  tcpufloatdef = class(tfloatdef)
+  end;
+
+  tcpuprocvardef = class(tprocvardef)
+  end;
+
+  tcpuprocdef = class(tprocdef)
+  end;
+
+  tcpustringdef = class(tstringdef)
+  end;
+
+  tcpuenumdef = class(tenumdef)
+  end;
+
+  tcpusetdef = class(tsetdef)
+  end;
+
+  { syms }
+  tcpulabelsym = class(tlabelsym)
+  end;
+
+  tcpuunitsym = class(tunitsym)
+  end;
+
+  tcpunamespacesym = class(tnamespacesym)
+  end;
+
+  tcpuprocsym = class(tprocsym)
+  end;
+
+  tcputypesym = class(ttypesym)
+  end;
+
+  tcpufieldvarsym = class(tfieldvarsym)
+  end;
+
+  tcpulocalvarsym = class(tlocalvarsym)
+  end;
+
+  tcpuparavarsym = class(tparavarsym)
+  end;
+
+  tcpustaticvarsym = class(tstaticvarsym)
+  end;
+
+  tcpuabsolutevarsym = class(tabsolutevarsym)
+  end;
+
+  tcpupropertysym = class(tpropertysym)
+  end;
+
+  tcpuconstsym = class(tconstsym)
+  end;
+
+  tcpuenumsym = class(tenumsym)
+  end;
+
+  tcpusyssym = class(tsyssym)
+  end;
+
+
+const
+  pbestrealtype : ^tdef = @s64floattype;
+
+
+implementation
+
+begin
+  { used tdef classes }
+  cfiledef:=tcpufiledef;
+  cvariantdef:=tcpuvariantdef;
+  cformaldef:=tcpuformaldef;
+  cforwarddef:=tcpuforwarddef;
+  cundefineddef:=tcpuundefineddef;
+  cerrordef:=tcpuerrordef;
+  cpointerdef:=tcpupointerdef;
+  crecorddef:=tcpurecorddef;
+  cimplementedinterface:=tcpuimplementedinterface;
+  cobjectdef:=tcpuobjectdef;
+  cclassrefdef:=tcpuclassrefdef;
+  carraydef:=tcpuarraydef;
+  corddef:=tcpuorddef;
+  cfloatdef:=tcpufloatdef;
+  cprocvardef:=tcpuprocvardef;
+  cprocdef:=tcpuprocdef;
+  cstringdef:=tcpustringdef;
+  cenumdef:=tcpuenumdef;
+  csetdef:=tcpusetdef;
+
+  { used tsym classes }
+  clabelsym:=tcpulabelsym;
+  cunitsym:=tcpuunitsym;
+  cnamespacesym:=tcpunamespacesym;
+  cprocsym:=tcpuprocsym;
+  ctypesym:=tcputypesym;
+  cfieldvarsym:=tcpufieldvarsym;
+  clocalvarsym:=tcpulocalvarsym;
+  cparavarsym:=tcpuparavarsym;
+  cstaticvarsym:=tcpustaticvarsym;
+  cabsolutevarsym:=tcpuabsolutevarsym;
+  cpropertysym:=tcpupropertysym;
+  cconstsym:=tcpuconstsym;
+  cenumsym:=tcpuenumsym;
+  csyssym:=tcpusyssym;
+end.
+

compiler/aasmbase.pas

@@ -140,7 +140,11 @@ interface
          sec_objc_nlclasslist,
          sec_objc_catlist,
          sec_objc_nlcatlist,
-         sec_objc_protolist
+         sec_objc_protolist,
+         { stack segment for 16-bit DOS }
+         sec_stack,
+         { initial heap segment for 16-bit DOS }
+         sec_heap
        );
 
        TAsmSectionOrder = (secorder_begin,secorder_default,secorder_end);

compiler/aasmdata.pas

@@ -155,21 +155,20 @@ interface
         FConstPools    : array[TConstPoolType] of THashSet;
         function GetConstPools(APoolType: TConstPoolType): THashSet;
       public
-        name,
-        realname      : string[80];
+        name          : pshortstring;       { owned by tmodule }
         NextVTEntryNr : longint;
         { Assembler lists }
         AsmLists      : array[TAsmListType] of TAsmList;
         CurrAsmList   : TAsmList;
         WideInits     : TLinkedList;
         ResStrInits   : TLinkedList;
-        constructor create(const n:string);
+        constructor create(n: pshortstring);
         destructor  destroy;override;
         { asmsymbol }
         function  DefineAsmSymbolByClass(symclass: TAsmSymbolClass; const s : TSymStr;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
         function  DefineAsmSymbol(const s : TSymStr;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
-        function  WeakRefAsmSymbol(const s : TSymStr) : TAsmSymbol;
-        function  RefAsmSymbol(const s : TSymStr) : TAsmSymbol;
+        function  WeakRefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype=AT_NONE) : TAsmSymbol;
+        function  RefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype=AT_NONE) : TAsmSymbol;
         function  GetAsmSymbol(const s : TSymStr) : TAsmSymbol;
         { create new assembler label }
         procedure getlabel(out l : TAsmLabel;alt:TAsmLabeltype);
@@ -343,14 +342,13 @@ implementation
         Result := FConstPools[APoolType];
       end;
 
-    constructor TAsmData.create(const n:string);
+    constructor TAsmData.create(n:pshortstring);
       var
         alt : TAsmLabelType;
         hal : TAsmListType;
       begin
         inherited create;
-        realname:=n;
-        name:=upper(n);
+        name:=n;
         { symbols }
         FAsmSymbolDict:=TFPHashObjectList.create(true);
         FAltSymbolList:=TFPObjectList.Create(false);
@@ -441,22 +439,22 @@ implementation
       end;
 
 
-    function TAsmData.RefAsmSymbol(const s : TSymStr) : TAsmSymbol;
+    function TAsmData.RefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype=AT_NONE) : TAsmSymbol;
       begin
         result:=TAsmSymbol(FAsmSymbolDict.Find(s));
         if not assigned(result) then
-          result:=TAsmSymbol.create(AsmSymbolDict,s,AB_EXTERNAL,AT_NONE)
+          result:=TAsmSymbol.create(AsmSymbolDict,s,AB_EXTERNAL,_typ)
         { one normal reference removes the "weak" character of a symbol }
         else if (result.bind=AB_WEAK_EXTERNAL) then
           result.bind:=AB_EXTERNAL;
       end;
 
 
-    function TAsmData.WeakRefAsmSymbol(const s : TSymStr) : TAsmSymbol;
+    function TAsmData.WeakRefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype=AT_NONE) : TAsmSymbol;
       begin
         result:=TAsmSymbol(FAsmSymbolDict.Find(s));
         if not assigned(result) then
-          result:=TAsmSymbol.create(AsmSymbolDict,s,AB_WEAK_EXTERNAL,AT_NONE);
+          result:=TAsmSymbol.create(AsmSymbolDict,s,AB_WEAK_EXTERNAL,_typ);
       end;
 
 
@@ -494,7 +492,7 @@ implementation
              but if we create_smartlink_sections, this is useless }
            (create_smartlink_library) and
            (alt = alt_dbgline) then
-          l:=TAsmLabel.createglobal(AsmSymbolDict,name,FNextLabelNr[alt],alt)
+          l:=TAsmLabel.createglobal(AsmSymbolDict,name^,FNextLabelNr[alt],alt)
         else
           l:=TAsmLabel.createlocal(AsmSymbolDict,FNextLabelNr[alt],alt);
         inc(FNextLabelNr[alt]);
@@ -509,13 +507,13 @@ implementation
 
     procedure TAsmData.getglobaljumplabel(out l : TAsmLabel);
       begin
-        l:=TAsmLabel.createglobal(AsmSymbolDict,name,FNextLabelNr[alt_jump],alt_jump);
+        l:=TAsmLabel.createglobal(AsmSymbolDict,name^,FNextLabelNr[alt_jump],alt_jump);
         inc(FNextLabelNr[alt_jump]);
       end;
 
     procedure TAsmData.getdatalabel(out l : TAsmLabel);
       begin
-        l:=TAsmLabel.createglobal(AsmSymbolDict,name,FNextLabelNr[alt_data],alt_data);
+        l:=TAsmLabel.createglobal(AsmSymbolDict,name^,FNextLabelNr[alt_data],alt_data);
         inc(FNextLabelNr[alt_data]);
       end;
 

compiler/aasmtai.pas

@@ -68,10 +68,6 @@ interface
           ait_stab,
           ait_force_line,
           ait_function_name,
-		  { Used for .ent .end pair used for .dpr section in MIPS
-		    and probably also for Alpha }
-          ait_ent,
-		  ait_ent_end,
 {$ifdef alpha}
           { the follow is for the DEC Alpha }
           ait_frame,
@@ -140,7 +136,11 @@ interface
           aitconst_32bit_unaligned,
           aitconst_64bit_unaligned,
           { i8086 far pointer; emits: 'DW symbol, SEG symbol' }
-          aitconst_farptr
+          aitconst_farptr,
+          { offset of symbol's GOT slot in GOT }
+          aitconst_got,
+          { offset of symbol itself from GOT }
+          aitconst_gotoff_symbol
         );
 
     const
@@ -186,8 +186,6 @@ interface
           'stab',
           'force_line',
           'function_name',
-          'ent',
-          'ent_end',
 {$ifdef alpha}
           { the follow is for the DEC Alpha }
           'frame',
@@ -278,7 +276,7 @@ interface
           top_shifterop : (shifterop : pshifterop);
       {$endif defined(arm) or defined(aarch64)}
       {$ifdef m68k}
-          top_regset : (regset:^tcpuregisterset);
+          top_regset : (dataregset,addrregset:^tcpuregisterset);
       {$endif m68k}
       {$ifdef jvm}
           top_single : (sval:single);
@@ -297,7 +295,7 @@ interface
       SkipInstr = [ait_comment, ait_symbol,ait_section
                    ,ait_stab, ait_function_name, ait_force_line
                    ,ait_regalloc, ait_tempalloc, ait_symbol_end
-                   ,ait_ent, ait_ent_end, ait_directive
+                   ,ait_directive
                    ,ait_varloc,
 {$ifdef JVM}
                    ait_jvar, ait_jcatch,
@@ -311,7 +309,6 @@ interface
                      ait_stab,ait_function_name,
                      ait_cutobject,ait_marker,ait_varloc,ait_align,ait_section,ait_comment,
                      ait_const,ait_directive,
-                     ait_ent, ait_ent_end,
 {$ifdef arm}
                      ait_thumb_func,
                      ait_thumb_set,
@@ -357,7 +354,9 @@ interface
         asd_reference,asd_no_dead_strip,asd_weak_reference,asd_lazy_reference,
         asd_weak_definition,
         { for Jasmin }
-        asd_jclass,asd_jinterface,asd_jsuper,asd_jfield,asd_jlimit,asd_jline
+        asd_jclass,asd_jinterface,asd_jsuper,asd_jfield,asd_jlimit,asd_jline,
+        { .ent/.end for MIPS and Alpha }
+        asd_ent,asd_ent_end
       );
 
       TAsmSehDirective=(
@@ -384,7 +383,9 @@ interface
         'extern','nasm_import', 'tc', 'reference',
         'no_dead_strip','weak_reference','lazy_reference','weak_definition',
         { for Jasmin }
-        'class','interface','super','field','limit','line'
+        'class','interface','super','field','limit','line',
+        { .ent/.end for MIPS and Alpha }
+        'ent','end'
       );
       sehdirectivestr : array[TAsmSehDirective] of string[16]=(
         '.seh_proc','.seh_endproc',
@@ -464,16 +465,6 @@ interface
           procedure derefimpl;override;
        end;
 
-       tai_ent = class(tai)
-          Name : string;
-          Constructor Create (const ProcName : String);
-       end;
-
-       tai_ent_end = class(tai)
-          Name : string;
-          Constructor Create (const ProcName : String);
-       end;
-
        tai_directive = class(tailineinfo)
           name : ansistring;
           directive : TAsmDirective;
@@ -485,7 +476,6 @@ interface
        { Generates an assembler label }
        tai_label = class(tai)
           labsym    : tasmlabel;
-          is_global : boolean;
 {$ifdef arm}
           { set to true when the label has been moved by insertpcrelativedata to the correct location
             so one label can be used multiple times }
@@ -544,6 +534,9 @@ interface
 
 
        { Generates an integer const }
+
+       { tai_const }
+
        tai_const = class(tai)
           sym,
           endsym  : tasmsymbol;
@@ -568,12 +561,22 @@ interface
           constructor Create_uleb128bit(_value : qword);
           constructor Create_aint(_value : aint);
           constructor Create_pint(_value : pint);
+          constructor Create_pint_unaligned(_value : pint);
           constructor Create_sym(_sym:tasmsymbol);
+{$ifdef i8086}
+          constructor Create_sym_near(_sym:tasmsymbol);
+          constructor Create_sym_far(_sym:tasmsymbol);
+{$endif i8086}
           constructor Create_type_sym(_typ:taiconst_type;_sym:tasmsymbol);
           constructor Create_sym_offset(_sym:tasmsymbol;ofs:aint);
+          constructor Create_type_sym_offset(_typ:taiconst_type;_sym:tasmsymbol;ofs:aint);
           constructor Create_rel_sym(_typ:taiconst_type;_sym,_endsym:tasmsymbol);
+          constructor Create_rel_sym_offset(_typ : taiconst_type; _sym,_endsym : tasmsymbol; _ofs : int64);
           constructor Create_rva_sym(_sym:tasmsymbol);
           constructor Createname(const name:string;ofs:aint);
+          constructor Createname(const name:string;_symtyp:Tasmsymtype;ofs:aint);
+          constructor Create_type_name(_typ:taiconst_type;const name:string;ofs:aint);
+          constructor Create_type_name(_typ:taiconst_type;const name:string;_symtyp:Tasmsymtype;ofs:aint);
           constructor Create_nil_codeptr;
           constructor Create_nil_dataptr;
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
@@ -1284,6 +1287,10 @@ implementation
          typ:=ait_symbol;
          sym:=_sym;
          size:=siz;
+         { don't redefine global/external symbols as local, as code to access
+           such symbols is different on some platforms }
+         if not(sym.bind in [AB_NONE,AB_LOCAL]) then
+           internalerror(2013081601);
          sym.bind:=AB_LOCAL;
          is_global:=false;
       end;
@@ -1369,7 +1376,9 @@ implementation
       begin
          inherited Create;
          typ:=ait_symbol_end;
-         sym:=current_asmdata.RefAsmSymbol(_name);
+         sym:=current_asmdata.GetAsmSymbol(_name);
+         if not assigned(sym) then
+           internalerror(2013080301);
       end;
 
 
@@ -1420,26 +1429,6 @@ implementation
         ppufile.putbyte(byte(directive));
       end;
 
-{****************************************************************************
-                               TAI_ENT / TAI_ENT_END
- ****************************************************************************}
-
-    Constructor tai_ent.Create (const ProcName : String);
-
-    begin
-      Inherited Create;
-	  Name:=ProcName;
-      typ:=ait_ent;
-    end;
-
-    Constructor tai_ent_end.Create (const ProcName : String);
-
-    begin
-      Inherited Create;
-	  Name:=ProcName;
-      typ:=ait_ent_end;
-    end;
-
 
 {****************************************************************************
                                TAI_CONST
@@ -1608,6 +1597,17 @@ implementation
       end;
 
 
+    constructor tai_const.Create_pint_unaligned(_value: pint);
+      begin
+         inherited Create;
+         typ:=ait_const;
+         consttype:=aitconst_ptr_unaligned;
+         value:=_value;
+         sym:=nil;
+         endsym:=nil;
+      end;
+
+
     constructor tai_const.Create_type_sym(_typ:taiconst_type;_sym:tasmsymbol);
       begin
          inherited Create;
@@ -1628,6 +1628,21 @@ implementation
       end;
 
 
+{$ifdef i8086}
+    constructor tai_const.Create_sym_near(_sym: tasmsymbol);
+      begin
+         self.create_sym(_sym);
+         consttype:=aitconst_ptr;
+      end;
+
+    constructor tai_const.Create_sym_far(_sym: tasmsymbol);
+      begin
+        self.create_sym(_sym);
+        consttype:=aitconst_farptr;
+      end;
+{$endif i8086}
+
+
     constructor tai_const.Create_sym_offset(_sym:tasmsymbol;ofs:aint);
       begin
          inherited Create;
@@ -1663,6 +1678,24 @@ implementation
       end;
 
 
+    constructor tai_const.Create_type_sym_offset(_typ : taiconst_type;_sym : tasmsymbol; ofs : aint);
+      begin
+         inherited Create;
+         typ:=ait_const;
+         consttype:=_typ;
+         { sym is allowed to be nil, this is used to write nil pointers }
+         sym:=_sym;
+         endsym:=nil;
+         { store the original offset in symofs so that we can recalculate the
+           value field in the assembler }
+         symofs:=ofs;
+         value:=ofs;
+         { update sym info }
+         if assigned(sym) then
+           sym.increfs;
+      end;
+
+
     constructor tai_const.Create_rel_sym(_typ:taiconst_type;_sym,_endsym:tasmsymbol);
       begin
          self.create_sym_offset(_sym,0);
@@ -1672,6 +1705,15 @@ implementation
       end;
 
 
+    constructor tai_const.Create_rel_sym_offset(_typ: taiconst_type; _sym,_endsym: tasmsymbol; _ofs: int64);
+       begin
+         self.create_sym_offset(_sym,_ofs);
+         consttype:=_typ;
+         endsym:=_endsym;
+         endsym.increfs;
+       end;
+
+
     constructor tai_const.Create_rva_sym(_sym:tasmsymbol);
       begin
          self.create_sym_offset(_sym,0);
@@ -1681,7 +1723,26 @@ implementation
 
     constructor tai_const.Createname(const name:string;ofs:aint);
       begin
-         self.create_sym_offset(current_asmdata.RefAsmSymbol(name),ofs);
+         self.Createname(name,AT_NONE,ofs);
+      end;
+
+
+    constructor tai_const.Createname(const name:string;_symtyp:Tasmsymtype;ofs:aint);
+      begin
+         self.create_sym_offset(current_asmdata.RefAsmSymbol(name,_symtyp),ofs);
+      end;
+
+
+    constructor tai_const.Create_type_name(_typ:taiconst_type;const name:string;ofs:aint);
+      begin
+         self.Create_type_name(_typ,name,AT_NONE,ofs);
+      end;
+
+
+    constructor tai_const.Create_type_name(_typ:taiconst_type;const name:string;_symtyp:Tasmsymtype;ofs:aint);
+      begin
+         self.create_sym_offset(current_asmdata.RefAsmSymbol(name,_symtyp),ofs);
+         consttype:=_typ;
       end;
 
 
@@ -1780,6 +1841,8 @@ implementation
             result:=LengthSleb128(value);
           aitconst_half16bit:
             result:=2;
+          aitconst_gotoff_symbol:
+            result:=4;
           else
             internalerror(200603253);
         end;
@@ -2004,13 +2067,12 @@ implementation
                                TAI_LABEL
  ****************************************************************************}
 
-        constructor tai_label.Create(_labsym : tasmlabel);
+    constructor tai_label.Create(_labsym : tasmlabel);
       begin
         inherited Create;
         typ:=ait_label;
         labsym:=_labsym;
         labsym.is_set:=true;
-        is_global:=(labsym.bind in [AB_GLOBAL,AB_PRIVATE_EXTERN]);
       end;
 
 
@@ -2018,7 +2080,7 @@ implementation
       begin
         inherited ppuload(t,ppufile);
         labsym:=tasmlabel(ppufile.getasmsymbol);
-        is_global:=boolean(ppufile.getbyte);
+        ppufile.getbyte; { was is_global flag, now unused }
       end;
 
 
@@ -2026,7 +2088,7 @@ implementation
       begin
         inherited ppuwrite(ppufile);
         ppufile.putasmsymbol(labsym);
-        ppufile.putbyte(byte(is_global));
+        ppufile.putbyte(0); { was is_global flag, now unused }
       end;
 
 
@@ -2569,6 +2631,13 @@ implementation
               top_regset:
                 dispose(regset);
 {$endif ARM}
+{$ifdef m68k}
+              top_regset:
+                begin
+                  dispose(dataregset);
+                  dispose(addrregset);
+                end;
+{$endif m68k}
 {$ifdef jvm}
               top_string:
                 freemem(pcval);

compiler/aggas.pas

@@ -227,7 +227,7 @@ implementation
         );
 
       { Generic unaligned pseudo-instructions, seems ELF specific }
-      use_ua_elf_systems = [system_mipsel_linux,system_mipseb_linux,system_mipsel_embedded,system_mipseb_embedded];
+      use_ua_elf_systems = [system_mipsel_linux,system_mipseb_linux,system_mipsel_android,system_mipsel_embedded,system_mipseb_embedded];
       ait_ua_elf_const2str : array[aitconst_16bit_unaligned..aitconst_64bit_unaligned]
         of string[20]=(
           #9'.2byte'#9,#9'.4byte'#9,#9'.8byte'#9
@@ -347,7 +347,9 @@ implementation
           '.objc_nlclasslist',
           '.objc_catlist',
           '.obcj_nlcatlist',
-          '.objc_protolist'
+          '.objc_protolist',
+          '.stack',
+          '.heap'
         );
         secnames_pic : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','',
           '.text',
@@ -404,7 +406,9 @@ implementation
           '.objc_nlclasslist',
           '.objc_catlist',
           '.obcj_nlcatlist',
-          '.objc_protolist'
+          '.objc_protolist',
+          '.stack',
+          '.heap'
         );
       var
         sep     : string[3];
@@ -652,28 +656,18 @@ implementation
               if not(target_info.system in (systems_darwin+systems_aix)) then
                 begin
 {$ifdef m68k}
-                  if assigned(lasthp) and
-                      (
-                        (lasthp.typ=ait_instruction) and
-                        (taicpu(lasthp).opcode<>A_JMP)
-                      ) or
-                      (
-                        (lasthp.typ=ait_label)
-                      ) then
+                  if not use_op and (lastsectype=sec_code) then
                     begin
-                      if ispowerof2(alignment,i) then
-                        begin
-                          { the Coldfire manual suggests the TBF instruction for
-                            alignments, but somehow QEMU does not interpret that
-                            correctly... }
-                          {if current_settings.cputype=cpu_coldfire then
-                            instr:='0x51fc'
-                          else}
-                            instr:='0x4e71';
-                          AsmWrite(#9'.balignw '+tostr(alignment)+','+instr);
-                        end
-                      else
-                        internalerror(2012102101);
+                      if not ispowerof2(alignment,i) then
+                        internalerror(2014022201);
+                      { the Coldfire manual suggests the TBF instruction for
+                        alignments, but somehow QEMU does not interpret that
+                        correctly... }
+                      {if current_settings.cputype in cpu_coldfire then
+                        instr:='0x51fc'
+                      else}
+                        instr:='0x4e71';
+                      AsmWrite(#9'.balignw '+tostr(alignment)+','+instr);
                     end
                   else
                     begin
@@ -849,7 +843,8 @@ implementation
                        asmwrite(ReplaceForbiddenAsmSymbolChars(tai_datablock(hp).sym.name));
                        asmwrite(',');
                        asmwrite(tostr(tai_datablock(hp).size)+',');
-                       asmwrite('_data.bss_');
+                       asmwrite('_data.bss_,');
+                       asmwriteln(tostr(last_align));
                      end;
                  end
                else
@@ -956,6 +951,37 @@ implementation
                       AsmLn;
                     end;
 {$endif cpu64bitaddr}
+                 aitconst_got:
+                   begin
+                     AsmWrite(#9'.word'#9+tai_const(hp).sym.name+'(GOT)');
+                     Asmln;
+                   end;
+
+                 aitconst_gotoff_symbol:
+                   begin
+                     if (tai_const(hp).sym=nil) then
+                       InternalError(2014022601);
+                     case target_info.cpu of
+
+                       cpu_mipseb,cpu_mipsel:
+                         begin
+                           AsmWrite(#9'.gpword'#9);
+                           AsmWrite(tai_const(hp).sym.name);
+                         end;
+
+                       cpu_i386:
+                         begin
+                           AsmWrite(ait_const2str[aitconst_32bit]);
+                           AsmWrite(tai_const(hp).sym.name);
+                         end;
+                     else
+                       InternalError(2014022602);
+                     end;
+                     if (tai_const(hp).value<>0) then
+                       AsmWrite(tostr_with_plus(tai_const(hp).value));
+                     Asmln;
+                   end;
+
                  aitconst_uleb128bit,
                  aitconst_sleb128bit,
 {$ifdef cpu64bitaddr}
@@ -1008,14 +1034,13 @@ implementation
                          else if (constdef in ait_unaligned_consts) and
                                  (target_info.system in use_ua_elf_systems) then
                            AsmWrite(ait_ua_elf_const2str[constdef])
-                          else if not(target_info.system in systems_aix) or
-                            (constdef<>aitconst_64bit) then
-                           AsmWrite(ait_const2str[constdef])
+                         { we can also have unaligned pointers in packed record
+                           constants, which don't get translated into
+                           unaligned tai -> always use vbyte }
+                         else if target_info.system in systems_aix then
+                            AsmWrite(#9'.vbyte'#9+tostr(tai_const(hp).size)+',')
                          else
-                           { can't use .llong, because that forces 8 byte
-                             alignnment and we sometimes store addresses on
-                             4-byte aligned addresses (e.g. in the RTTI) }
-                           AsmWrite('.vbyte'#9'8,');
+                           AsmWrite(ait_const2str[constdef]);
                          l:=0;
                          t := '';
                          repeat
@@ -1219,6 +1244,11 @@ implementation
                     end;
                   if tai_label(hp).labsym.bind in [AB_GLOBAL,AB_PRIVATE_EXTERN] then
                    begin
+{$ifdef arm}
+                     { do no change arm mode accidently, .globl seems to reset the mode }
+                     if GenerateThumbCode or GenerateThumb2Code then
+                       AsmWriteln(#9'.thumb_func'#9);
+{$endif arm}
                      AsmWrite('.globl'#9);
                      if replaceforbidden then
                        AsmWriteLn(ReplaceForbiddenAsmSymbolChars(tai_label(hp).labsym.name))
@@ -1331,29 +1361,19 @@ implementation
 {$endif arm}
            ait_set:
              begin
-               AsmWriteLn(#9'.set '+tai_set(hp).sym^+', '+tai_set(hp).value^);
-             end;
-           ait_weak:
-             begin
-               AsmWriteLn(#9'.weak '+tai_weak(hp).sym^);
-             end;
-           ait_ent:
-             begin
-               AsmWrite(#9'.ent'#9);
-			   if replaceforbidden then
-                 AsmWriteLn(ReplaceForbiddenAsmSymbolChars(tai_ent(hp).Name))
+               if replaceforbidden then
+                 AsmWriteLn(#9'.set '+ReplaceForbiddenAsmSymbolChars(tai_set(hp).sym^)+', '+ReplaceForbiddenAsmSymbolChars(tai_set(hp).value^))
                else
-                 AsmWriteLn(tai_ent(hp).Name);
+                 AsmWriteLn(#9'.set '+tai_set(hp).sym^+', '+tai_set(hp).value^);
              end;
-           ait_ent_end:
+           ait_weak:
              begin
-               AsmWrite(#9'.end'#9);
-			   if replaceforbidden then
-                 AsmWriteLn(ReplaceForbiddenAsmSymbolChars(tai_ent_end(hp).Name))
+               if replaceforbidden then
+                 AsmWriteLn(#9'.weak '+ReplaceForbiddenAsmSymbolChars(tai_weak(hp).sym^))
                else
-  			     AsmWriteLn(tai_ent_end(hp).Name);
+                 AsmWriteLn(#9'.weak '+tai_weak(hp).sym^);
              end;
-            ait_symbol_end :
+           ait_symbol_end :
              begin
                if tf_needs_symbol_size in target_info.flags then
                 begin
@@ -1529,6 +1549,7 @@ implementation
 
       begin
         pos:=0;
+        instring:=false;
         for i:=1 to hp.len do
           begin
             if pos=0 then
@@ -1678,9 +1699,12 @@ implementation
 
       for hal:=low(TasmlistType) to high(TasmlistType) do
         begin
-          AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
-          writetree(current_asmdata.asmlists[hal]);
-          AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
+          if not (current_asmdata.asmlists[hal].empty) then
+            begin
+              AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
+              writetree(current_asmdata.asmlists[hal]);
+              AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
+            end;
         end;
 
       { add weak symbol markers }
@@ -1692,14 +1716,16 @@ implementation
          (target_info.system in systems_darwin) then
         AsmWriteLn(#9'.subsections_via_symbols');
 
-      { "no executable stack" marker for Linux }
-      if (target_info.system in (systems_linux + systems_android)) and
+      { "no executable stack" marker }
+      { TODO: used by OpenBSD/NetBSD as well? }
+      if (target_info.system in (systems_linux + systems_android + systems_freebsd)) and
          not(cs_executable_stack in current_settings.moduleswitches) then
         begin
           AsmWriteLn('.section .note.GNU-stack,"",%progbits');
         end;
 
       AsmLn;
+      WriteExtraFooter;
 {$ifdef EXTDEBUG}
       if current_module.mainsource<>'' then
        Comment(V_Debug,'Done writing gas-styled assembler output for '+current_module.mainsource);
@@ -1802,7 +1828,10 @@ implementation
               end;
             sec_objc_image_info:
               begin
-                result:='.section __OBJC, __image_info, regular, no_dead_strip';
+                if (target_info.system in systems_objc_nfabi) then
+                  result:='.section __DATA,__objc_imageinfo,regular,no_dead_strip'
+                else
+                  result:='.section __OBJC, __image_info, regular, no_dead_strip';
                 exit;
               end;
             sec_objc_cstring_object:
@@ -1831,12 +1860,27 @@ implementation
                     exit;
                   end;
               end;
-            sec_objc_meth_var_names,
+            sec_objc_meth_var_types:
+              begin
+                if (target_info.system in systems_objc_nfabi) then
+                  begin
+                    result:='.section __TEXT,__objc_methtype,cstring_literals';
+                    exit
+                  end;
+              end;
+            sec_objc_meth_var_names:
+              begin
+                if (target_info.system in systems_objc_nfabi) then
+                  begin
+                    result:='.section __TEXT,__objc_methname,cstring_literals';
+                    exit
+                  end;
+              end;
             sec_objc_class_names:
               begin
                 if (target_info.system in systems_objc_nfabi) then
                   begin
-                    result:='.cstring';
+                    result:='.section __TEXT,__objc_classname,cstring_literals';
                     exit
                   end;
               end;
@@ -1980,7 +2024,9 @@ implementation
          sec_none (* sec_objc_nlclasslist *),
          sec_none (* sec_objc_catlist *),
          sec_none (* sec_objc_nlcatlist *),
-         sec_none (* sec_objc_protlist *)
+         sec_none (* sec_objc_protlist *),
+         sec_none (* sec_stack *),
+         sec_none (* sec_heap *)
         );
       begin
         Result := inherited SectionName (SecXTable [AType], AName, AOrder);

compiler/agjasmin.pas

@@ -100,7 +100,7 @@ implementation
       SysUtils,
       cutils,cfileutl,systems,script,
       fmodule,finput,verbose,
-      symtype,symtable,jvmdef,
+      symtype,symcpu,symtable,jvmdef,
       itcpujas,cpubase,cpuinfo,cgutils,
       widestr
       ;
@@ -526,6 +526,8 @@ implementation
         i: longint;
         toplevelowner: tsymtable;
       begin
+        superclass:=nil;
+
         { JVM 1.5+ }
         AsmWriteLn('.bytecode 49.0');
         // include files are not support by Java, and the directory of the main
@@ -687,7 +689,8 @@ implementation
        if cs_asm_extern in current_settings.globalswitches then
          Replace(result,'$JASMINJAR',maybequoted(ScriptFixFileName(jasminjar)))
        else
-         Replace(result,'$JASMINJAR',ScriptFixFileName(jasminjar))
+         Replace(result,'$JASMINJAR',ScriptFixFileName(jasminjar));
+       Replace(result,'$EXTRAOPT',asmextraopt);
      end;
 
 
@@ -747,7 +750,7 @@ implementation
             not(po_classmethod in pd.procoptions) and
             not(pd.proctypeoption in [potype_constructor,potype_class_constructor])) then
           result:=result+'final ';
-        result:=result+pd.jvmmangledbasename(false);
+        result:=result+tcpuprocdef(pd).jvmmangledbasename(false);
       end;
 
 
@@ -762,6 +765,8 @@ implementation
               2:result:=tostr(smallint(csym.value.valueord.svalue));
               4:result:=tostr(longint(csym.value.valueord.svalue));
               8:result:=tostr(csym.value.valueord.svalue);
+              else
+                internalerror(2014082050);
             end;
           conststring:
             result:=constastr(pchar(csym.value.valueptr),csym.value.len);
@@ -912,7 +917,7 @@ implementation
 
     procedure TJasminAssembler.WriteProcDef(pd: tprocdef);
       begin
-        if not assigned(pd.exprasmlist) and
+        if not assigned(tcpuprocdef(pd).exprasmlist) and
            not(po_abstractmethod in pd.procoptions) and
            (not is_javainterface(pd.struct) or
             (pd.proctypeoption in [potype_unitinit,potype_unitfinalize])) then
@@ -922,10 +927,10 @@ implementation
         if jvmtypeneedssignature(pd) then
           begin
             AsmWrite('.signature "');
-            AsmWrite(pd.jvmmangledbasename(true));
+            AsmWrite(tcpuprocdef(pd).jvmmangledbasename(true));
             AsmWriteln('"');
           end;
-        WriteTree(pd.exprasmlist);
+        WriteTree(tcpuprocdef(pd).exprasmlist);
         AsmWriteln('.end method');
         AsmLn;
       end;
@@ -1223,7 +1228,7 @@ implementation
          id     : as_jvm_jasmin;
          idtxt  : 'Jasmin';
          asmbin : 'java';
-         asmcmd : '-jar $JASMINJAR $ASM -d $OBJDIR';
+         asmcmd : '-jar $JASMINJAR $ASM $EXTRAOPT -d $OBJDIR';
          supported_targets : [system_jvm_java32,system_jvm_android32];
          flags : [];
          labelprefix : 'L';

compiler/alpha/cpunode.pas

@@ -32,7 +32,7 @@ unit cpunode;
 
     uses
        { generic nodes }
-       ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl
+       ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,
        { to be able to only parts of the generic code,
          the processor specific nodes must be included
          after the generic one (FK)
@@ -48,7 +48,9 @@ unit cpunode;
        { this not really a node }
 //       naxpobj,
 //       naxpmat,
-//       naxpcnv
+//       naxpcnv,
+         { symtable }
+         symcpu
        ;
 
 end.

compiler/alpha/symcpu.pas

@@ -0,0 +1,211 @@
+{
+    Copyright (c) 2014 by Florian Klaempfl
+
+    Symbol table overrides for Alpha
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit symcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  symtype,symdef,symsym;
+
+type
+  { defs }
+  tcpufiledef = class(tfiledef)
+  end;
+  tcpufiledefclass = class of tcpufiledef;
+
+  tcpuvariantdef = class(tvariantdef)
+  end;
+  tcpuvariantdefclass = class of tcpuvariantdef;
+
+  tcpuformaldef = class(tformaldef)
+  end;
+  tcpuformaldefclass = class of tcpuformaldef;
+
+  tcpuforwarddef = class(tforwarddef)
+  end;
+  tcpuforwarddefclass = class of tcpuforwarddef;
+
+  tcpuundefineddef = class(tundefineddef)
+  end;
+  tcpuundefineddefclass = class of tcpuundefineddef;
+
+  tcpuerrordef = class(terrordef)
+  end;
+  tcpuerrordefclass = class of tcpuerrordef;
+
+  tcpupointerdef = class(tpointerdef)
+  end;
+  tcpupointerdefclass = class of tcpupointerdef;
+
+  tcpurecorddef = class(trecorddef)
+  end;
+  tcpurecorddefclass = class of tcpurecorddef;
+
+  tcpuimplementedinterface = class(timplementedinterface)
+  end;
+  tcpuimplementedinterfaceclass = class of tcpuimplementedinterface;
+
+  tcpuobjectdef = class(tobjectdef)
+  end;
+  tcpuobjectdefclass = class of tcpuobjectdef;
+
+  tcpuclassrefdef = class(tclassrefdef)
+  end;
+  tcpuclassrefdefclass = class of tcpuclassrefdef;
+
+  tcpuarraydef = class(tarraydef)
+  end;
+  tcpuarraydefclass = class of tcpuarraydef;
+
+  tcpuorddef = class(torddef)
+  end;
+  tcpuorddefclass = class of tcpuorddef;
+
+  tcpufloatdef = class(tfloatdef)
+  end;
+  tcpufloatdefclass = class of tcpufloatdef;
+
+  tcpuprocvardef = class(tprocvardef)
+  end;
+  tcpuprocvardefclass = class of tcpuprocvardef;
+
+  tcpuprocdef = class(tprocdef)
+  end;
+  tcpuprocdefclass = class of tcpuprocdef;
+
+  tcpustringdef = class(tstringdef)
+  end;
+  tcpustringdefclass = class of tcpustringdef;
+
+  tcpuenumdef = class(tenumdef)
+  end;
+  tcpuenumdefclass = class of tcpuenumdef;
+
+  tcpusetdef = class(tsetdef)
+  end;
+  tcpusetdefclass = class of tcpusetdef;
+
+  { syms }
+  tcpulabelsym = class(tlabelsym)
+  end;
+  tcpulabelsymclass = class of tcpulabelsym;
+
+  tcpuunitsym = class(tunitsym)
+  end;
+  tcpuunitsymclass = class of tcpuunitsym;
+
+  tcpunamespacesym = class(tnamespacesym)
+  end;
+  tcpunamespacesymclass = class of tcpunamespacesym;
+
+  tcpuprocsym = class(tprocsym)
+  end;
+  tcpuprocsymclass = class of tcpuprocsym;
+
+  tcputypesym = class(ttypesym)
+  end;
+  tcpuypesymclass = class of tcputypesym;
+
+  tcpufieldvarsym = class(tfieldvarsym)
+  end;
+  tcpufieldvarsymclass = class of tcpufieldvarsym;
+
+  tcpulocalvarsym = class(tlocalvarsym)
+  end;
+  tcpulocalvarsymclass = class of tcpulocalvarsym;
+
+  tcpuparavarsym = class(tparavarsym)
+  end;
+  tcpuparavarsymclass = class of tcpuparavarsym;
+
+  tcpustaticvarsym = class(tstaticvarsym)
+  end;
+  tcpustaticvarsymclass = class of tcpustaticvarsym;
+
+  tcpuabsolutevarsym = class(tabsolutevarsym)
+  end;
+  tcpuabsolutevarsymclass = class of tcpuabsolutevarsym;
+
+  tcpupropertysym = class(tpropertysym)
+  end;
+  tcpupropertysymclass = class of tcpupropertysym;
+
+  tcpuconstsym = class(tconstsym)
+  end;
+  tcpuconstsymclass = class of tcpuconstsym;
+
+  tcpuenumsym = class(tenumsym)
+  end;
+  tcpuenumsymclass = class of tcpuenumsym;
+
+  tcpusyssym = class(tsyssym)
+  end;
+  tcpusyssymclass = class of tcpusyssym;
+
+
+const
+  pbestrealtype : ^tdef = @s64floattype;
+
+
+implementation
+
+begin
+  { used tdef classes }
+  cfiledef:=tcpufiledef;
+  cvariantdef:=tcpuvariantdef;
+  cformaldef:=tcpuformaldef;
+  cforwarddef:=tcpuforwarddef;
+  cundefineddef:=tcpuundefineddef;
+  cerrordef:=tcpuerrordef;
+  cpointerdef:=tcpupointerdef;
+  crecorddef:=tcpurecorddef;
+  cimplementedinterface:=tcpuimplementedinterface;
+  cobjectdef:=tcpuobjectdef;
+  cclassrefdef:=tcpuclassrefdef;
+  carraydef:=tcpuarraydef;
+  corddef:=tcpuorddef;
+  cfloatdef:=tcpufloatdef;
+  cprocvardef:=tcpuprocvardef;
+  cprocdef:=tcpuprocdef;
+  cstringdef:=tcpustringdef;
+  cenumdef:=tcpuenumdef;
+  csetdef:=tcpusetdef;
+
+  { used tsym classes }
+  clabelsym:=tcpulabelsym;
+  cunitsym:=tcpuunitsym;
+  cnamespacesym:=tcpunamespacesym;
+  cprocsym:=tcpuprocsym;
+  ctypesym:=tcputypesym;
+  cfieldvarsym:=tcpufieldvarsym;
+  clocalvarsym:=tcpulocalvarsym;
+  cparavarsym:=tcpuparavarsym;
+  cstaticvarsym:=tcpustaticvarsym;
+  cabsolutevarsym:=tcpuabsolutevarsym;
+  cpropertysym:=tcpupropertysym;
+  cconstsym:=tcpuconstsym;
+  cenumsym:=tcpuenumsym;
+  csyssym:=tcpusyssym;
+end.
+

compiler/aopt.pas

@@ -267,13 +267,16 @@ Unit aopt;
         pass_1;
         While Assigned(BlockStart) Do
           Begin
-             if pass = 0 then
-               PrePeepHoleOpts;
-            { Peephole optimizations }
-             PeepHoleOptPass1;
-            { Only perform them twice in the first pass }
-             if pass = 0 then
-               PeepHoleOptPass1;
+            if (cs_opt_peephole in current_settings.optimizerswitches) then
+              begin
+                if pass = 0 then
+                  PrePeepHoleOpts;
+                { Peephole optimizations }
+                PeepHoleOptPass1;
+                { Only perform them twice in the first pass }
+                if pass = 0 then
+                  PeepHoleOptPass1;
+              end;
             If (cs_opt_asmcse in current_settings.optimizerswitches) Then
               Begin
 //                DFA:=TAOptDFACpu.Create(AsmL,BlockStart,BlockEnd,LabelInfo);
@@ -283,9 +286,12 @@ Unit aopt;
       {          CSE;}
               End;
             { more peephole optimizations }
-            PeepHoleOptPass2;
-            { if pass = last_pass then }
-            PostPeepHoleOpts;
+            if (cs_opt_peephole in current_settings.optimizerswitches) then
+              begin
+                PeepHoleOptPass2;
+                { if pass = last_pass then }
+                PostPeepHoleOpts;
+              end;
             { free memory }
             clear;
             { continue where we left off, BlockEnd is either the start of an }

compiler/aoptbase.pas

@@ -67,6 +67,7 @@ unit aoptbase;
         { false and sets last to nil                                     }
         Function GetLastInstruction(Current: tai; Var Last: tai): Boolean;
 
+        function SkipEntryExitMarker(current: tai; var next: tai): boolean;
 
         { processor dependent methods }
 
@@ -116,17 +117,16 @@ unit aoptbase;
 
 
   Function TAOptBase.RegInInstruction(Reg: TRegister; p1: tai): Boolean;
-    Var Count: AWord;
-        TmpResult: Boolean;
+    Var
+      Count: longint;
     Begin
-      TmpResult := False;
-      Count := 0;
-      If (p1.typ = ait_instruction) and assigned(TInstr(p1).oper[0]) Then
-        Repeat
-          TmpResult := RegInOp(Reg, TInstr(p1).oper[Count]^);
-          Inc(Count)
-        Until (TInstr(p1).oper[Count]=nil) or (Count = MaxOps) or TmpResult;
-      RegInInstruction := TmpResult
+      result:=false;
+      if p1.typ<>ait_instruction then
+        exit;
+      for Count:=0 to TInstr(p1).ops-1 do
+        if RegInOp(Reg, TInstr(p1).oper[Count]^) then
+          exit(true);
+      result:=false;
     End;
 
 
@@ -246,6 +246,21 @@ unit aoptbase;
   End;
 
 
+  function TAOptBase.SkipEntryExitMarker(current: tai; var next: tai): boolean;
+    begin
+      result:=true;
+      if current.typ<>ait_marker then
+        exit;
+      next:=current;
+      while GetNextInstruction(next,next) do
+        begin
+          if (next.typ<>ait_marker) or not(tai_marker(next).Kind in [mark_Position,mark_BlockStart]) then
+            exit;
+        end;
+      result:=false;
+    end;
+
+
   Function TAOptBase.RegUsedBetween(reg : TRegister;p1,p2 : tai) : Boolean;
   Begin
     Result:=false;

compiler/aoptobj.pas

@@ -289,13 +289,23 @@ Unit AoptObj;
         { returns true if the operands o1 and o2 are completely equal }
         Function OpsEqual(const o1,o2:toper): Boolean;
 
-        { Returns the next ait_alloc object with ratype ra_dealloc for
+        { Returns the next ait_alloc object with ratype ra_alloc for
           Reg is found in the block
           of Tai's starting with StartPai and ending with the next "real"
           instruction. If none is found, it returns
-          nil                                                                        }
+          nil
+        }
         Function FindRegAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc;
 
+        { Returns the last ait_alloc object with ratype ra_alloc for
+          Reg is found in the block
+          of Tai's starting with StartPai and ending with the next "real"
+          instruction. If none is found, it returns
+          nil
+        }
+        Function FindRegAllocBackward(Reg : TRegister; StartPai : Tai) : tai_regalloc;
+
+
         { Returns the next ait_alloc object with ratype ra_dealloc
           for Reg which is found in the block of Tai's starting with StartPai
           and ending with the next "real" instruction. If none is found, it returns
@@ -320,6 +330,10 @@ Unit AoptObj;
 
         function getlabelwithsym(sym: tasmlabel): tai;
 
+        { Removes an instruction following hp1 (possibly with reg.deallocations in between),
+          if its opcode is A_NOP. }
+        procedure RemoveDelaySlot(hp1: tai);
+
         { peephole optimizer }
         procedure PrePeepHoleOpts;
         procedure PeepHoleOptPass1;
@@ -1048,6 +1062,33 @@ Unit AoptObj;
       End;
 
 
+      Function TAOptObj.FindRegAllocBackward(Reg: TRegister; StartPai: Tai): tai_regalloc;
+      Begin
+        Result:=nil;
+        Repeat
+          While Assigned(StartPai) And
+                ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
+                 ((StartPai.typ = ait_label) and
+                  Not(Tai_Label(StartPai).labsym.Is_Used))) Do
+            StartPai := Tai(StartPai.Previous);
+          If Assigned(StartPai) And
+             (StartPai.typ = ait_regAlloc) Then
+            Begin
+              if (tai_regalloc(StartPai).ratype=ra_alloc) and
+                (getregtype(tai_regalloc(StartPai).Reg) = getregtype(Reg)) and
+                (getsupreg(tai_regalloc(StartPai).Reg) = getsupreg(Reg)) then
+               begin
+                 Result:=tai_regalloc(StartPai);
+                 exit;
+               end;
+              StartPai := Tai(StartPai.Previous);
+            End
+          else
+            exit;
+        Until false;
+      End;
+
+
       function TAOptObj.FindRegDeAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc;
       Begin
          Result:=nil;
@@ -1078,7 +1119,7 @@ Unit AoptObj;
       function TAOptObj.RegUsedAfterInstruction(reg: Tregister; p: tai;
        var AllUsedRegs: TAllUsedRegs): Boolean;
        begin
-         AllUsedRegs[getregtype(reg)].Update(tai(p.Next));
+         AllUsedRegs[getregtype(reg)].Update(tai(p.Next),true);
          RegUsedAfterInstruction :=
            (AllUsedRegs[getregtype(reg)].IsUsed(reg)); { optimization and
               (not(getNextInstruction(p,p)) or
@@ -1143,6 +1184,24 @@ Unit AoptObj;
       end;
 
 
+    procedure TAOptObj.RemoveDelaySlot(hp1:tai);
+      var
+        hp2: tai;
+      begin
+        hp2:=tai(hp1.next);
+        while assigned(hp2) and (hp2.typ in SkipInstr) do
+          hp2:=tai(hp2.next);
+        if assigned(hp2) and (hp2.typ=ait_instruction) and
+          (taicpu(hp2).opcode=A_NOP) then
+          begin
+            asml.remove(hp2);
+            hp2.free;
+          end;
+        { Anything except A_NOP must be left in place: these instructions
+          execute before branch, so code stays correct if branch is removed. }
+      end;
+
+
     function TAOptObj.GetFinalDestination(hp: taicpu; level: longint): boolean;
       {traces sucessive jumps to their final destination and sets it, e.g.
        je l1                je l3
@@ -1247,139 +1306,138 @@ Unit AoptObj;
     procedure TAOptObj.PeepHoleOptPass1;
       var
         p,hp1,hp2 : tai;
+        stoploop:boolean;
       begin
-        p := BlockStart;
-        ClearUsedRegs;
-        while (p <> BlockEnd) Do
-          begin
-            { I'am not sure why this is done, UsedRegs should reflect the register usage before the instruction
-              If an instruction needs the information of this, it can easily create a TempUsedRegs (FK)
-            UpdateUsedRegs(tai(p.next));
-            }
-{$ifdef DEBUG_OPTALLOC}
-            if p.Typ=ait_instruction then
-              InsertLLItem(tai(p.Previous),p,tai_comment.create(strpnew(GetAllocationString(UsedRegs))));
-{$endif DEBUG_OPTALLOC}
-            if PeepHoleOptPass1Cpu(p) then
-              begin
-                UpdateUsedRegs(p);
-                continue;
-              end;
-            case p.Typ Of
-              ait_instruction:
+        repeat
+          stoploop:=true;
+          p := BlockStart;
+          ClearUsedRegs;
+          while (p <> BlockEnd) Do
+            begin
+              { I'am not sure why this is done, UsedRegs should reflect the register usage before the instruction
+                If an instruction needs the information of this, it can easily create a TempUsedRegs (FK)
+              UpdateUsedRegs(tai(p.next));
+              }
+  {$ifdef DEBUG_OPTALLOC}
+              if p.Typ=ait_instruction then
+                InsertLLItem(tai(p.Previous),p,tai_comment.create(strpnew(GetAllocationString(UsedRegs))));
+  {$endif DEBUG_OPTALLOC}
+              if PeepHoleOptPass1Cpu(p) then
                 begin
-                  { Handle Jmp Optimizations }
-                  if taicpu(p).is_jmp then
-                    begin
-                      { the following if-block removes all code between a jmp and the next label,
-                        because it can never be executed
-                      }
-                      if IsJumpToLabel(taicpu(p)) then
-                        begin
-                          hp2:=p;
-                          while GetNextInstruction(hp2, hp1) and
-                                (hp1.typ <> ait_label) do
-                            if not(hp1.typ in ([ait_label,ait_align]+skipinstr)) then
-                              begin
-                                if (hp1.typ = ait_instruction) and
-                                   taicpu(hp1).is_jmp and
-                                   (JumpTargetOp(taicpu(hp1))^.typ = top_ref) and
-                                   (JumpTargetOp(taicpu(hp1))^.ref^.symbol is TAsmLabel) then
-                                   TAsmLabel(JumpTargetOp(taicpu(hp1))^.ref^.symbol).decrefs;
-                                { don't kill start/end of assembler block,
-                                  no-line-info-start/end etc }
-                                if hp1.typ<>ait_marker then
-                                  begin
-                                    asml.remove(hp1);
-                                    hp1.free;
-                                  end
-                                else
-                                  hp2:=hp1;
-                              end
-                            else break;
-                          end;
-                      { remove jumps to a label coming right after them }
-                      if GetNextInstruction(p, hp1) then
-                        begin
-                          if FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp1) and
-        { TODO: FIXME removing the first instruction fails}
-                              (p<>blockstart) then
-                            begin
-                              tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol).decrefs;
-{$if defined(SPARC) or defined(MIPS)}
-                              hp2:=tai(p.next);
-                              asml.remove(hp2);
-                              hp2.free;
-{$endif SPARC or MIPS}
-                              hp2:=tai(hp1.next);
-                              asml.remove(p);
-                              p.free;
-                              p:=hp2;
-                              continue;
-                            end
-                          else
-                            begin
-                              if hp1.typ = ait_label then
-                                SkipLabels(hp1,hp1);
-                              if (tai(hp1).typ=ait_instruction) and
-                                  IsJumpToLabel(taicpu(hp1)) and
-                                  GetNextInstruction(hp1, hp2) and
-                                  FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp2) then
+                  stoploop:=false;
+                  UpdateUsedRegs(p);
+                  continue;
+                end;
+              case p.Typ Of
+                ait_instruction:
+                  begin
+                    { Handle Jmp Optimizations }
+                    if taicpu(p).is_jmp then
+                      begin
+                        { the following if-block removes all code between a jmp and the next label,
+                          because it can never be executed
+                        }
+                        if IsJumpToLabel(taicpu(p)) then
+                          begin
+                            hp2:=p;
+                            while GetNextInstruction(hp2, hp1) and
+                                  (hp1.typ <> ait_label) do
+                              if not(hp1.typ in ([ait_label,ait_align]+skipinstr)) then
                                 begin
-                                  if (taicpu(p).opcode=aopt_condjmp)
-{$ifdef arm}
-                                    and (taicpu(p).condition<>C_None)
-{$endif arm}
-                                  then
+                                  if (hp1.typ = ait_instruction) and
+                                     taicpu(hp1).is_jmp and
+                                     (JumpTargetOp(taicpu(hp1))^.typ = top_ref) and
+                                     (JumpTargetOp(taicpu(hp1))^.ref^.symbol is TAsmLabel) then
+                                     TAsmLabel(JumpTargetOp(taicpu(hp1))^.ref^.symbol).decrefs;
+                                  { don't kill start/end of assembler block,
+                                    no-line-info-start/end etc }
+                                  if hp1.typ<>ait_marker then
                                     begin
-                                      taicpu(p).condition:=inverse_cond(taicpu(p).condition);
-                                      tai_label(hp2).labsym.decrefs;
-                                      JumpTargetOp(taicpu(p))^.ref^.symbol:=JumpTargetOp(taicpu(hp1))^.ref^.symbol;
-                                      { when freeing hp1, the reference count
-                                        isn't decreased, so don't increase
-
-                                       taicpu(p).oper[0]^.ref^.symbol.increfs;
-                                      }
-{$if defined(SPARC) or defined(MIPS)}
-                                      { Remove delay slot. Initially is is placed immediately after
-                                        branch, but RA can insert regallocs in between. }
-                                      hp2:=tai(hp1.next);
-                                      while assigned(hp2) and (hp2.typ in SkipInstr) do
-                                        hp2:=tai(hp2.next);
-                                      if assigned(hp2) and (hp2.typ=ait_instruction) and
-                                         (taicpu(hp2).opcode=A_NOP) then
-                                        begin
-                                          asml.remove(hp2);
-                                          hp2.free;
-                                        end
-                                      else
-                                        InternalError(2013070301);
-{$endif SPARC or MIPS}
+  {$if defined(SPARC) or defined(MIPS) }
+                                      if (hp1.typ=ait_instruction) and (taicpu(hp1).is_jmp) then
+                                        RemoveDelaySlot(hp1);
+  {$endif SPARC or MIPS }
                                       asml.remove(hp1);
                                       hp1.free;
-                                      GetFinalDestination(taicpu(p),0);
+                                      stoploop:=false;
                                     end
                                   else
-                                    begin
-                                      GetFinalDestination(taicpu(p),0);
-                                      p:=tai(p.next);
-                                      continue;
-                                    end;
+                                    hp2:=hp1;
                                 end
-                              else
-                                GetFinalDestination(taicpu(p),0);
+                              else break;
                             end;
-                        end;
-                    end
-                  else
-                  { All other optimizes }
-                    begin
-                    end; { if is_jmp }
-                end;
+                        { remove jumps to a label coming right after them }
+                        if GetNextInstruction(p, hp1) then
+                          begin
+                            SkipEntryExitMarker(hp1,hp1);
+                            if FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp1) and
+          { TODO: FIXME removing the first instruction fails}
+                                (p<>blockstart) then
+                              begin
+                                tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol).decrefs;
+  {$if defined(SPARC) or defined(MIPS)}
+                                RemoveDelaySlot(p);
+  {$endif SPARC or MIPS}
+                                hp2:=tai(hp1.next);
+                                asml.remove(p);
+                                p.free;
+                                p:=hp2;
+                                stoploop:=false;
+                                continue;
+                              end
+                            else if assigned(hp1) then
+                              begin
+                                if hp1.typ = ait_label then
+                                  SkipLabels(hp1,hp1);
+                                if (tai(hp1).typ=ait_instruction) and
+                                    IsJumpToLabel(taicpu(hp1)) and
+                                    GetNextInstruction(hp1, hp2) and
+                                    FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp2) then
+                                  begin
+                                    if (taicpu(p).opcode=aopt_condjmp)
+  {$ifdef arm}
+                                      and (taicpu(p).condition<>C_None)
+  {$endif arm}
+                                    then
+                                      begin
+                                        taicpu(p).condition:=inverse_cond(taicpu(p).condition);
+                                        tai_label(hp2).labsym.decrefs;
+                                        JumpTargetOp(taicpu(p))^.ref^.symbol:=JumpTargetOp(taicpu(hp1))^.ref^.symbol;
+                                        { when freeing hp1, the reference count
+                                          isn't decreased, so don't increase
+
+                                         taicpu(p).oper[0]^.ref^.symbol.increfs;
+                                        }
+  {$if defined(SPARC) or defined(MIPS)}
+                                        RemoveDelaySlot(hp1);
+  {$endif SPARC or MIPS}
+                                        asml.remove(hp1);
+                                        hp1.free;
+                                        stoploop:=false;
+                                        GetFinalDestination(taicpu(p),0);
+                                      end
+                                    else
+                                      begin
+                                        GetFinalDestination(taicpu(p),0);
+                                        p:=tai(p.next);
+                                        continue;
+                                      end;
+                                  end
+                                else
+                                  GetFinalDestination(taicpu(p),0);
+                              end;
+                          end;
+                      end
+                    else
+                    { All other optimizes }
+                      begin
+                      end; { if is_jmp }
+                  end;
+              end;
+              UpdateUsedRegs(p);
+              p:=tai(p.next);
             end;
-            UpdateUsedRegs(p);
-            p:=tai(p.next);
-          end;
+        until stoploop or not(cs_opt_level3 in current_settings.optimizerswitches);
       end;
 
 

compiler/arm/aasmcpu.pas

@@ -644,6 +644,8 @@ implementation
                   op:=A_FLDD;
                 R_SUBFS:
                   op:=A_FLDS;
+                R_SUBNONE:
+                  op:=A_VLDR;
                 else
                   internalerror(2009112905);
               end;
@@ -674,6 +676,8 @@ implementation
                   op:=A_FSTD;
                 R_SUBFS:
                   op:=A_FSTS;
+                R_SUBNONE:
+                  op:=A_VSTR;
                 else
                   internalerror(2009112904);
               end;
@@ -715,7 +719,8 @@ implementation
           A_FTOUIS,A_FTOUID,A_FUITOS,A_FUITOD,
           A_SXTB16,A_UXTB16,
           A_UXTB,A_UXTH,A_SXTB,A_SXTH,
-          A_NEG:
+          A_NEG,
+          A_VABS,A_VADD,A_VCVT,A_VDIV,A_VLDR,A_VMOV,A_VMUL,A_VNEG,A_VSQRT,A_VSUB:
             if opnr=0 then
               result:=operand_write
             else
@@ -724,7 +729,8 @@ implementation
           A_CMN,A_CMP,A_TEQ,A_TST,
           A_CMF,A_CMFE,A_WFS,A_CNF,
           A_FCMPS,A_FCMPD,A_FCMPES,A_FCMPED,A_FCMPEZS,A_FCMPEZD,
-          A_FCMPZS,A_FCMPZD:
+          A_FCMPZS,A_FCMPZD,
+          A_VCMP,A_VCMPE:
             result:=operand_read;
           A_SMLAL,A_UMLAL:
             if opnr in [0,1] then
@@ -739,7 +745,8 @@ implementation
               result:=operand_read;
           A_STR,A_STRB,A_STRBT,
           A_STRH,A_STRT,A_STF,A_SFM,
-          A_FSTS,A_FSTD:
+          A_FSTS,A_FSTD,
+          A_VSTR:
             { important is what happens with the involved registers }
             if opnr=0 then
               result := operand_read
@@ -763,8 +770,7 @@ implementation
             else
               result:=operand_read;
           A_STREX:
-            if opnr in [0,1,2] then
-              result:=operand_write;
+            result:=operand_write;
           else
             internalerror(200403151);
         end;
@@ -863,6 +869,26 @@ implementation
 *)
 
     procedure insertpcrelativedata(list,listtoinsert : TAsmList);
+
+      var
+        limit: longint;
+
+      { FLD/FST VFP instructions have a limit of +/- 1024, not 4096, this
+        function checks the next count instructions if the limit must be
+        decreased }
+      procedure CheckLimit(hp : tai;count : integer);
+        var
+          i : Integer;
+        begin
+          for i:=1 to count do
+            if SimpleGetNextInstruction(hp,hp) and
+               (tai(hp).typ=ait_instruction) and
+               ((taicpu(hp).opcode=A_FLDS) or
+                (taicpu(hp).opcode=A_FLDD) or
+                (taicpu(hp).opcode=A_VLDR)) then
+              limit:=254;
+        end;
+
       var
         curinspos,
         penalty,
@@ -870,7 +896,6 @@ implementation
         { increased for every data element > 4 bytes inserted }
         currentsize,
         extradataoffset,
-        limit: longint;
         curop : longint;
         curtai : tai;
         ai_label : tai_label;
@@ -885,7 +910,7 @@ implementation
         lastinspos:=-1;
         curinspos:=0;
         extradataoffset:=0;
-        if current_settings.cputype in cpu_thumb then
+        if GenerateThumbCode then
           begin
             multiplier:=2;
             limit:=504;
@@ -915,7 +940,7 @@ implementation
                             begin
                               { create a new copy of a data entry on arm thumb if the entry has been inserted already
                                 before because arm thumb does not allow pc relative negative offsets }
-                              if (current_settings.cputype in cpu_thumb) and
+                              if (GenerateThumbCode) and
                                 tai_label(curdatatai).inserted then
                                 begin
                                   current_asmdata.getjumplabel(l);
@@ -1025,32 +1050,81 @@ implementation
                 end;
             end;
             { special case for case jump tables }
+            penalty:=0;
             if SimpleGetNextInstruction(curtai,hp) and
-              (tai(hp).typ=ait_instruction) and
-              (taicpu(hp).opcode=A_LDR) and
-              (taicpu(hp).oper[0]^.typ=top_reg) and
-              (taicpu(hp).oper[0]^.reg=NR_PC) then
+              (tai(hp).typ=ait_instruction) then
               begin
-                penalty:=1*multiplier;
-                hp:=tai(hp.next);
-                { skip register allocations and comments inserted by the optimizer }
-                while assigned(hp) and (hp.typ in [ait_comment,ait_regalloc]) do
-                  hp:=tai(hp.next);
-                while assigned(hp) and (hp.typ=ait_const) do
-                  begin
-                    inc(penalty,multiplier);
-                    hp:=tai(hp.next);
-                  end;
-              end
-            else
-              penalty:=0;
+                case taicpu(hp).opcode of
+                  A_BX,
+                  A_LDR,
+                  A_ADD:
+                    { approximation if we hit a case jump table }
+                    if ((taicpu(hp).opcode in [A_ADD,A_LDR]) and not(GenerateThumbCode or GenerateThumb2Code) and
+                       (taicpu(hp).oper[0]^.typ=top_reg) and
+                      (taicpu(hp).oper[0]^.reg=NR_PC)) or
+                      ((taicpu(hp).opcode=A_BX) and (GenerateThumbCode) and
+                       (taicpu(hp).oper[0]^.typ=top_reg))
+                       then
+                      begin
+                        penalty:=multiplier;
+                        hp:=tai(hp.next);
+                        { skip register allocations and comments inserted by the optimizer as well as a label
+                          as jump tables for thumb might have }
+                        while assigned(hp) and (hp.typ in [ait_comment,ait_regalloc,ait_label]) do
+                          hp:=tai(hp.next);
+                        while assigned(hp) and (hp.typ=ait_const) do
+                          begin
+                            inc(penalty,multiplier);
+                            hp:=tai(hp.next);
+                          end;
+                      end;
+                  A_IT:
+                    begin
+                      if GenerateThumb2Code then
+                        penalty:=multiplier;
+                        { check if the next instruction fits as well
+                          or if we splitted after the it so split before }
+                        CheckLimit(hp,1);
+                    end;
+                  A_ITE,
+                  A_ITT:
+                    begin
+                      if GenerateThumb2Code then
+                        penalty:=2*multiplier;
+                        { check if the next two instructions fit as well
+                          or if we splitted them so split before }
+                        CheckLimit(hp,2);
+                    end;
+                  A_ITEE,
+                  A_ITTE,
+                  A_ITET,
+                  A_ITTT:
+                    begin
+                      if GenerateThumb2Code then
+                        penalty:=3*multiplier;
+                        { check if the next three instructions fit as well
+                          or if we splitted them so split before }
+                        CheckLimit(hp,3);
+                    end;
+                  A_ITEEE,
+                  A_ITTEE,
+                  A_ITETE,
+                  A_ITTTE,
+                  A_ITEET,
+                  A_ITTET,
+                  A_ITETT,
+                  A_ITTTT:
+                    begin
+                      if GenerateThumb2Code then
+                        penalty:=4*multiplier;
+                        { check if the next three instructions fit as well
+                          or if we splitted them so split before }
+                      CheckLimit(hp,4);
+                    end;
+                end;
+              end;
 
-            { FLD/FST VFP instructions have a limit of +/- 1024, not 4096 }
-            if SimpleGetNextInstruction(curtai,hp) and
-               (tai(hp).typ=ait_instruction) and
-               ((taicpu(hp).opcode=A_FLDS) or
-                (taicpu(hp).opcode=A_FLDD)) then
-              limit:=254;
+            CheckLimit(curtai,1);
 
             { don't miss an insert }
             doinsert:=doinsert or
@@ -1071,7 +1145,7 @@ implementation
               ) and
               (
                 { do not insert data after a B instruction due to their limited range }
-                not((current_settings.cputype in cpu_thumb) and
+                not((GenerateThumbCode) and
                     (taicpu(curtai).opcode=A_B)
                    )
               ) then
@@ -1079,23 +1153,23 @@ implementation
                 lastinspos:=-1;
                 extradataoffset:=0;
 
-                if current_settings.cputype in cpu_thumb then
+                if GenerateThumbCode then
                   limit:=502
                 else
                   limit:=1016;
 
-                { on arm thumb, insert the date always after all labels etc. following an instruction so it
+                { on arm thumb, insert the data always after all labels etc. following an instruction so it
                   is prevent that a bxx yyy; bl xxx; yyyy: sequence gets separated ( we never insert on arm thumb after
                   bxx) and the distance of bxx gets too long }
-                if current_settings.cputype in cpu_thumb then
+                if GenerateThumbCode then
                   while assigned(tai(curtai.Next)) and (tai(curtai.Next).typ in SkipInstr+[ait_label]) do
                     curtai:=tai(curtai.next);
 
                 doinsert:=false;
                 current_asmdata.getjumplabel(l);
 
-                { align thumb in thumb .text section to 4 bytes }
-                if not(curdata.empty) and (current_settings.cputype in cpu_thumb) then
+                { align jump in thumb .text section to 4 bytes }
+                if not(curdata.empty) and (GenerateThumbCode) then
                   curdata.Insert(tai_align.Create(4));
                 curdata.insert(taicpu.op_sym(A_B,l));
                 curdata.concat(tai_label.create(l));
@@ -1122,8 +1196,8 @@ implementation
             else
               curtai:=tai(curtai.next);
           end;
-        { align thumb in thumb .text section to 4 bytes }
-        if not(curdata.empty) and (current_settings.cputype in cpu_thumb+cpu_thumb2) then
+        { align jump in thumb .text section to 4 bytes }
+        if not(curdata.empty) and (GenerateThumbCode or GenerateThumb2Code) then
           curdata.Insert(tai_align.Create(4));
         list.concatlist(curdata);
         curdata.free;
@@ -1285,7 +1359,7 @@ implementation
     procedure finalizearmcode(list, listtoinsert: TAsmList);
       begin
         { Do Thumb-2 16bit -> 32bit transformations }
-        if current_settings.cputype in cpu_thumb2 then
+        if GenerateThumb2Code then
           begin
             ensurethumb2encodings(list);
             foldITInstructions(list);
@@ -2058,6 +2132,7 @@ implementation
 
       begin
         bytes:=$0;
+        i_field:=0;
         { evaluate and set condition code }
 
         { condition code allowed? }

compiler/arm/agarmgas.pas

@@ -110,9 +110,9 @@ unit agarmgas;
         if (current_settings.fputype = fpu_fpv4_s16) then
           result:='-mfpu=fpv4-sp-d16 '+result;
 
-        if current_settings.cputype in cpu_thumb2 then
+        if GenerateThumb2Code then
           result:='-march='+cputype_to_gas_march[current_settings.cputype]+' -mthumb -mthumb-interwork '+result
-        else if current_settings.cputype in cpu_thumb then
+        else if GenerateThumbCode then
           result:='-march='+cputype_to_gas_march[current_settings.cputype]+' -mthumb -mthumb-interwork '+result
         // EDSP instructions in RTL require armv5te at least to not generate error
         else if current_settings.cputype >= cpu_armv5te then
@@ -126,7 +126,7 @@ unit agarmgas;
     procedure TArmGNUAssembler.WriteExtraHeader;
       begin
         inherited WriteExtraHeader;
-        if current_settings.cputype in cpu_thumb2 then
+        if GenerateThumb2Code then
           AsmWriteLn(#9'.syntax unified');
       end;
 
@@ -164,10 +164,10 @@ unit agarmgas;
                 if (base<>NR_NO) and not(is_pc(base)) then
                   internalerror(200309011);
                 s:=symbol.name;
-                if offset<0 then
-                  s:=s+tostr(offset)
-                else if offset>0 then
-                  s:=s+'+'+tostr(offset);
+                if offset<>0 then
+                  s:=s+tostr_with_plus(offset);
+                if refaddr=addr_pic then
+                  s:=s+'(PLT)';
               end
             else
               begin
@@ -289,14 +289,14 @@ unit agarmgas;
         sep: string[3];
     begin
       op:=taicpu(hp).opcode;
-      if current_settings.cputype in cpu_thumb2 then
+      if GenerateThumb2Code then
         begin
           postfix:='';
           if taicpu(hp).wideformat then
             postfix:='.w';
 
           if taicpu(hp).ops = 0 then
-            s:=#9+gas_op2str[op]+' '+cond2str[taicpu(hp).condition]+oppostfix2str[taicpu(hp).oppostfix]
+            s:=#9+gas_op2str[op]+cond2str[taicpu(hp).condition]+oppostfix2str[taicpu(hp).oppostfix]
           else if (taicpu(hp).opcode>=A_VABS) and (taicpu(hp).opcode<=A_VSUB) then
             s:=#9+gas_op2str[op]+cond2str[taicpu(hp).condition]+oppostfix2str[taicpu(hp).oppostfix]
           else
@@ -356,7 +356,7 @@ unit agarmgas;
 
             idtxt  : 'AS';
             asmbin : 'as';
-            asmcmd : '-o $OBJ $ASM';
+            asmcmd : '-o $OBJ $EXTRAOPT $ASM';
             supported_targets : [system_arm_linux,system_arm_wince,system_arm_gba,system_arm_palmos,system_arm_nds,
                                  system_arm_embedded,system_arm_symbian,system_arm_android];
             flags : [af_needar,af_smartlink_sections];
@@ -370,7 +370,7 @@ unit agarmgas;
             id     : as_darwin;
             idtxt  : 'AS-Darwin';
             asmbin : 'as';
-            asmcmd : '-o $OBJ $ASM -arch $ARCH';
+            asmcmd : '-o $OBJ $EXTRAOPT $ASM -arch $ARCH';
             supported_targets : [system_arm_darwin];
             flags : [af_needar,af_smartlink_sections,af_supports_dwarf,af_stabs_use_function_absolute_addresses];
             labelprefix : 'L';

compiler/arm/armatt.inc

@@ -8,6 +8,7 @@
 'adc',
 'add',
 'adf',
+'adr',
 'and',
 'b',
 'bic',

compiler/arm/armatts.inc

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

compiler/arm/armins.dat

@@ -107,6 +107,8 @@ reg32,reg32,imm          \7\x2\x80                     ARM7
 
 [ADFcc]
 
+[ADRcc]
+
 [ANDcc]
 reg32,reg32,reg32        \4\x0\x00                     ARM7
 reg32,reg32,reg32,reg32  \5\x0\x00                     ARM7

compiler/arm/armop.inc

@@ -8,6 +8,7 @@ A_ATN,
 A_ADC,
 A_ADD,
 A_ADF,
+A_ADR,
 A_AND,
 A_B,
 A_BIC,

compiler/arm/cpubase.pas

@@ -330,6 +330,7 @@ unit cpubase;
         (RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,RS_R9,RS_R10);
 
       { this is only for the generic code which is not used for this architecture }
+      saved_address_registers : array[0..0] of tsuperregister = (RS_INVALID);
       saved_mm_registers : array[0..0] of tsuperregister = (RS_INVALID);
 
       { Required parameter alignment when calling a routine declared as
@@ -374,6 +375,10 @@ unit cpubase;
     function IsIT(op: TAsmOp) : boolean;
     function GetITLevels(op: TAsmOp) : longint;
 
+    function GenerateARMCode : boolean;
+    function GenerateThumbCode : boolean;
+    function GenerateThumb2Code : boolean;
+
   implementation
 
     uses
@@ -526,7 +531,7 @@ unit cpubase;
       var
          i : longint;
       begin
-        if current_settings.cputype in cpu_thumb2 then
+        if GenerateThumb2Code then
           begin
             for i:=0 to 24 do
               begin
@@ -566,35 +571,23 @@ unit cpubase;
         i : longint;
         imm : byte;
       begin
-        result:=false;
+        {Loading 0-255 is simple}
         if (d and $FF) = d then
-          begin
-            result:=true;
-            exit;
-          end;
-        if ((d and $FF00FF00) = 0) and
-           ((d shr 16)=(d and $FFFF)) then
-          begin
-            result:=true;
-            exit;
-          end;
-        if ((d and $00FF00FF) = 0) and
-           ((d shr 16)=(d and $FFFF)) then
-          begin
-            result:=true;
-            exit;
-          end;
-        if ((d shr 16)=(d and $FFFF)) and
-           ((d shr 8)=(d and $FF)) then
-          begin
-            result:=true;
-            exit;
-          end;
-        if is_shifter_const(d,imm) then
-          begin
-            result:=true;
-            exit;
-          end;
+          result:=true
+        { If top and bottom are equal, check if either all 4 bytes are equal
+          or byte 0 and 2 or byte 1 and 3 are equal }
+        else if ((d shr 16)=(d and $FFFF)) and
+                (
+                  ((d and $FF00FF00) = 0) or
+                  ((d and $00FF00FF) = 0) or
+                  ((d shr 8)=(d and $FF))
+                ) then
+          result:=true
+        {Can an 8-bit value be shifted accordingly?}
+        else if is_shifter_const(d,imm) then
+          result:=true
+        else
+          result:=false;
       end;
     
     function is_continuous_mask(d : aint;var lsb, width: byte) : boolean;
@@ -616,7 +609,7 @@ unit cpubase;
       begin
         Result:=false;
         {Thumb2 is not supported (YET?)}
-        if current_settings.cputype in cpu_thumb2 then exit;
+        if GenerateThumb2Code then exit;
         d:=DWord(value);
         for i:=0 to 15 do
           begin
@@ -707,4 +700,24 @@ unit cpubase;
         end;
       end;
 
+
+    function GenerateARMCode : boolean;
+      begin
+        Result:=current_settings.instructionset=is_arm;
+      end;
+
+
+    function GenerateThumbCode : boolean;
+      begin
+        Result:=(current_settings.instructionset=is_thumb) and not(CPUARM_HAS_THUMB2 in cpu_capabilities[current_settings.cputype]);
+      end;
+
+
+    function GenerateThumb2Code : boolean;
+      begin
+        Result:=(current_settings.instructionset=is_thumb) and (CPUARM_HAS_THUMB2 in cpu_capabilities[current_settings.cputype]);
+      end;
+
+
 end.
+

compiler/arm/cpuelf.pas

@@ -168,6 +168,16 @@ implementation
 
     TCB_SIZE = 8;
 
+    { ELF header e_flags }
+    EF_ARM_BE8          = $00800000;
+    EF_ARM_EABIMASK     = $FF000000;
+    EF_ARM_EABI_UNKNOWN = $00000000;
+    EF_ARM_EABI_VER1    = $01000000;
+    EF_ARM_EABI_VER2    = $02000000;
+    EF_ARM_EABI_VER3    = $03000000;
+    EF_ARM_EABI_VER4    = $04000000;
+    EF_ARM_EABI_VER5    = $05000000;
+
   { Using short identifiers to save typing. This ARM thing has more relocations
     than it has instructions... }
   const

compiler/arm/cpuinfo.pas

@@ -51,10 +51,7 @@ Type
        cpu_armv7em
       );
 
-Const
-   cpu_arm = [cpu_none,cpu_armv3,cpu_armv4,cpu_armv4t,cpu_armv5];
-   cpu_thumb = [cpu_armv6m];
-   cpu_thumb2 = [cpu_armv7m,cpu_armv7em];
+   tinstructionset = (is_thumb,is_arm);
 
 Type
    tfputype =
@@ -185,6 +182,28 @@ Type
       ct_at91sam7xc256,
 
       { STMicroelectronics }
+      ct_stm32f030c6,
+      ct_stm32f030c8,
+      ct_stm32f030f4,
+      ct_stm32f030k6,
+      ct_stm32f030r8,
+      ct_stm32f050c4,
+      ct_stm32f050c6,
+      ct_stm32f050f4,
+      ct_stm32f050f6,
+      ct_stm32f050g4,
+      ct_stm32f050g6,
+      ct_stm32f050k4,
+      ct_stm32f050k6,
+      ct_stm32f051c4,
+      ct_stm32f051c6,
+      ct_stm32f051c8,
+      ct_stm32f051k4,
+      ct_stm32f051k6,
+      ct_stm32f051k8,
+      ct_stm32f051r4,
+      ct_stm32f051r6,
+      ct_stm32f051r8,
       ct_stm32f100x4, // LD&MD value line, 4=16,6=32,8=64,b=128
       ct_stm32f100x6,
       ct_stm32f100x8,
@@ -217,6 +236,16 @@ Type
       ct_stm32f107x8, // MD and HD connectivity line, 8=64,B=128,C=256
       ct_stm32f107xB,
       ct_stm32f107xC,
+      ct_stm32f105r8,
+      ct_stm32f105rb,
+      ct_stm32f105rc,
+      ct_stm32f105v8,
+      ct_stm32f105vb,
+      ct_stm32f105vc,
+      ct_stm32f107rb,
+      ct_stm32f107rc,
+      ct_stm32f107vb,
+      ct_stm32f107vc,
 
       { TI - Fury Class - 64 K Flash, 16 K SRAM Devices }
       ct_lm3s1110,
@@ -386,91 +415,91 @@ Const
 
       { LPC 11xx Series}
       (controllertypestr:'LPC1110FD20';		controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00001000;	srambase:$10000000;	sramsize:$00000400),
-      (controllertypestr:'LPC1111FDH20/002';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00000800),
-      (controllertypestr:'LPC1111FHN33/101';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00000800),
-      (controllertypestr:'LPC1111FHN33/102';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00000800),
-      (controllertypestr:'LPC1111FHN33/103';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00000800),
-      (controllertypestr:'LPC1111FHN33/201';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1111FHN33/202';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1111FHN33/203';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00001000),
-
-      (controllertypestr:'LPC1112FD20/102';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1112FDH20/102';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1112FDH28/102';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1112FHN33/101';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00000800),
-      (controllertypestr:'LPC1112FHN33/102';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00000800),
-      (controllertypestr:'LPC1112FHN33/103';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00000800),
-      (controllertypestr:'LPC1112FHN33/201';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1112FHN24/202';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1112FHN33/202';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1112FHN33/203';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1112FHI33/202';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1112FHI33/203';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
-
-      (controllertypestr:'LPC1113FHN33/201';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1113FHN33/202';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1113FHN33/203';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1113FHN33/301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1113FHN33/302';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1113FHN33/303';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1113FBD48/301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1113FBD48/302';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1113FBD48/303';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00002000),
-
-      (controllertypestr:'LPC1114FDH28/102';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1114FN28/102';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1114FHN33/201';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1114FHN33/202';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1114FHN33/203';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1114FHN33/301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1114FHN33/302';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1114FHN33/303';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1114FHN33/333';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$0000E000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1114FHI33/302';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1114FHI33/303';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1114FBD48/301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1114FBD48/302';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1114FBD48/303';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1114FBD48/323';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$0000C000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1114FBD48/333';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$0000E000;	srambase:$10000000;	sramsize:$00002000),
-
-      (controllertypestr:'LPC1115FBD48/303';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00010000;	srambase:$10000000;	sramsize:$00002000),
-
-      (controllertypestr:'LPC11C12FBD48/301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC11C14FBD48/301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
-
-      (controllertypestr:'LPC11C22FBD48/301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC11C24FBD48/301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
-
-      (controllertypestr:'LPC11D14FBD100/302';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1111FDH20_002';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00000800),
+      (controllertypestr:'LPC1111FHN33_101';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00000800),
+      (controllertypestr:'LPC1111FHN33_102';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00000800),
+      (controllertypestr:'LPC1111FHN33_103';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00000800),
+      (controllertypestr:'LPC1111FHN33_201';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1111FHN33_202';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1111FHN33_203';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00001000),
+
+      (controllertypestr:'LPC1112FD20_102';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1112FDH20_102';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1112FDH28_102';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1112FHN33_101';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00000800),
+      (controllertypestr:'LPC1112FHN33_102';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00000800),
+      (controllertypestr:'LPC1112FHN33_103';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00000800),
+      (controllertypestr:'LPC1112FHN33_201';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1112FHN24_202';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1112FHN33_202';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1112FHN33_203';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1112FHI33_202';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1112FHI33_203';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00001000),
+
+      (controllertypestr:'LPC1113FHN33_201';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1113FHN33_202';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1113FHN33_203';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1113FHN33_301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1113FHN33_302';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1113FHN33_303';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1113FBD48_301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1113FBD48_302';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1113FBD48_303';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00006000;	srambase:$10000000;	sramsize:$00002000),
+
+      (controllertypestr:'LPC1114FDH28_102';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1114FN28_102';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1114FHN33_201';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1114FHN33_202';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1114FHN33_203';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1114FHN33_301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1114FHN33_302';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1114FHN33_303';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1114FHN33_333';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$0000E000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1114FHI33_302';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1114FHI33_303';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1114FBD48_301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1114FBD48_302';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1114FBD48_303';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1114FBD48_323';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$0000C000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1114FBD48_333';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$0000E000;	srambase:$10000000;	sramsize:$00002000),
+
+      (controllertypestr:'LPC1115FBD48_303';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00010000;	srambase:$10000000;	sramsize:$00002000),
+
+      (controllertypestr:'LPC11C12FBD48_301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC11C14FBD48_301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
+
+      (controllertypestr:'LPC11C22FBD48_301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00004000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC11C24FBD48_301';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
+
+      (controllertypestr:'LPC11D14FBD100_302';	controllerunitstr:'LPC11XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
 
       {LPC 122x Series}
-      (controllertypestr:'LPC1224FBD48/101';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1224FBD48/121';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$0000C000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1224FBD64/101';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1224FBD64/121';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$0000C000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1224FBD48_101';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1224FBD48_121';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$0000C000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1224FBD64_101';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1224FBD64_121';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$0000C000;	srambase:$10000000;	sramsize:$00001000),
 
-      (controllertypestr:'LPC1225FBD48/301';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00010000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1225FBD48/321';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00014000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1225FBD64/301';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00010000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1225FBD64/321';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00014000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1225FBD48_301';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00010000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1225FBD48_321';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00014000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1225FBD64_301';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00010000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1225FBD64_321';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00014000;	srambase:$10000000;	sramsize:$00002000),
 
-      (controllertypestr:'LPC1226FBD48/301';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00018000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1226FBD64/301';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00018000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1226FBD48_301';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00018000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1226FBD64_301';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00018000;	srambase:$10000000;	sramsize:$00002000),
 
-      (controllertypestr:'LPC1227FBD48/301';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00020000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1227FBD64/301';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00020000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1227FBD48_301';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00020000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1227FBD64_301';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00020000;	srambase:$10000000;	sramsize:$00002000),
 
-      (controllertypestr:'LPC12D27FBD100/301';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00020000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC12D27FBD100_301';	controllerunitstr:'LPC122X';	flashbase:$00000000;	flashsize:$00020000;	srambase:$10000000;	sramsize:$00002000),
 
 
       (controllertypestr:'LPC1311FHN33';	controllerunitstr:'LPC13XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00001000),
-      (controllertypestr:'LPC1311FHN33/01';	controllerunitstr:'LPC13XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00001000),
+      (controllertypestr:'LPC1311FHN33_01';	controllerunitstr:'LPC13XX';	flashbase:$00000000;	flashsize:$00002000;	srambase:$10000000;	sramsize:$00001000),
 
       (controllertypestr:'LPC1313FHN33';	controllerunitstr:'LPC13XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1313FHN33/01';	controllerunitstr:'LPC13XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1313FHN33_01';	controllerunitstr:'LPC13XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
       (controllertypestr:'LPC1313FBD48';	controllerunitstr:'LPC13XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
-      (controllertypestr:'LPC1313FBD48/01';	controllerunitstr:'LPC13XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
+      (controllertypestr:'LPC1313FBD48_01';	controllerunitstr:'LPC13XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
 
       (controllertypestr:'LPC1315FHN33';	controllerunitstr:'LPC13XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
       (controllertypestr:'LPC1315FBD48';	controllerunitstr:'LPC13XX';	flashbase:$00000000;	flashsize:$00008000;	srambase:$10000000;	sramsize:$00002000),
@@ -514,6 +543,30 @@ Const
       (controllertypestr:'AT91SAM7X256';	controllerunitstr:'AT91SAM7x256';	flashbase:$00000000;	flashsize:$00040000;	srambase:$00200000;	sramsize:$00010000),
       (controllertypestr:'AT91SAM7XC256';	controllerunitstr:'AT91SAM7x256';	flashbase:$00000000;	flashsize:$00040000;	srambase:$00200000;	sramsize:$00010000),
 
+      { STM32F0 series }
+      (controllertypestr:'STM32F030C6';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00008000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F030C8';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00010000; srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'STM32F030F4';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00004000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F030K6';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00008000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F030R8';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00010000; srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'STM32F050C4';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00004000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F050C6';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00008000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F050F4';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00004000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F050F6';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00008000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F050G4';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00004000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F050G6';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00008000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F050K4';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00004000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F050K6';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00008000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F051C4';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00004000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F051C6';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00008000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F051C8';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00010000; srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'STM32F051K4';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00004000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F051K6';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00008000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F051K8';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00010000; srambase:$20000000; sramsize:$00002000),
+      (controllertypestr:'STM32F051R4';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00004000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F051R6';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00008000; srambase:$20000000; sramsize:$00001000),
+      (controllertypestr:'STM32F051R8';     controllerunitstr:'STM32F0XX';        flashbase:$08000000; flashsize:$00010000; srambase:$20000000; sramsize:$00002000),
+
       { STM32F1 series }
       (controllertypestr:'STM32F100X4';     controllerunitstr:'STM32F10X_LD';     flashbase:$08000000; flashsize:$00004000; srambase:$20000000; sramsize:$00001000),
       (controllertypestr:'STM32F100X6';     controllerunitstr:'STM32F10X_LD';     flashbase:$08000000; flashsize:$00008000; srambase:$20000000; sramsize:$00001000),
@@ -548,6 +601,17 @@ Const
       (controllertypestr:'STM32F107XB';     controllerunitstr:'STM32F10X_CONN';   flashbase:$08000000; flashsize:$00020000; srambase:$20000000; sramsize:$00010000),
       (controllertypestr:'STM32F107XC';     controllerunitstr:'STM32F10X_CONN';   flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
 
+      (controllertypestr:'STM32F105R8';     controllerunitstr:'STM32F10X_CL';     flashbase:$08000000; flashsize:$00010000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'STM32F105RB';     controllerunitstr:'STM32F10X_CL';     flashbase:$08000000; flashsize:$00020000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'STM32F105RC';     controllerunitstr:'STM32F10X_CL';     flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'STM32F105V8';     controllerunitstr:'STM32F10X_CL';     flashbase:$08000000; flashsize:$00010000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'STM32F105VB';     controllerunitstr:'STM32F10X_CL';     flashbase:$08000000; flashsize:$00020000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'STM32F105VC';     controllerunitstr:'STM32F10X_CL';     flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'STM32F107RB';     controllerunitstr:'STM32F10X_CL';     flashbase:$08000000; flashsize:$00020000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'STM32F107RC';     controllerunitstr:'STM32F10X_CL';     flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'STM32F107VB';     controllerunitstr:'STM32F10X_CL';     flashbase:$08000000; flashsize:$00020000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'STM32F107VC';     controllerunitstr:'STM32F10X_CL';     flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
+
       (controllertypestr:'LM3S1110';	controllerunitstr:'LM3FURY';	flashbase:$00000000;	flashsize:$00010000;	srambase:$20000000;	sramsize:$00004000),
       (controllertypestr:'LM3S1133';	controllerunitstr:'LM3FURY';	flashbase:$00000000;	flashsize:$00010000;	srambase:$20000000;	sramsize:$00004000),
       (controllertypestr:'LM3S1138';	controllerunitstr:'LM3FURY';	flashbase:$00000000;	flashsize:$00010000;	srambase:$20000000;	sramsize:$00004000),
@@ -646,7 +710,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_reorder_fields,cs_opt_fastmath];
+                                  cs_opt_stackframe,cs_opt_nodecse,cs_opt_reorder_fields,cs_opt_fastmath,cs_opt_forcenostackframe];
 
    level1optimizerswitches = genericlevel1optimizerswitches;
    level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches +
@@ -665,32 +729,38 @@ Const
        CPUARM_HAS_RBIT,       { CPU supports the RBIT instruction                         }
        CPUARM_HAS_DMB,        { CPU has memory barrier instructions (DMB, DSB, ISB)       }
        CPUARM_HAS_LDREX,
-       CPUARM_HAS_IDIV
+       CPUARM_HAS_IDIV,
+       CPUARM_HAS_THUMB_IDIV,
+       CPUARM_HAS_THUMB2,
+       CPUARM_HAS_UMULL
       );
 
  const
    cpu_capabilities : array[tcputype] of set of tcpuflags =
      ( { cpu_none     } [],
        { cpu_armv3    } [],
-       { cpu_armv4    } [],
-       { cpu_armv4t   } [CPUARM_HAS_BX],
-       { cpu_armv5    } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ],
-       { cpu_armv5t   } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ],
-       { cpu_armv5te  } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP],
-       { cpu_armv5tej } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP],
-       { cpu_armv6    } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_LDREX],
-       { cpu_armv6k   } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_LDREX],
-       { cpu_armv6t2  } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX],
-       { cpu_armv6z   } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_LDREX],
+       { cpu_armv4    } [CPUARM_HAS_UMULL],
+       { cpu_armv4t   } [CPUARM_HAS_BX,CPUARM_HAS_UMULL],
+       { cpu_armv5    } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_UMULL],
+       { cpu_armv5t   } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_UMULL],
+       { cpu_armv5te  } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_UMULL],
+       { cpu_armv5tej } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_UMULL],
+       { cpu_armv6    } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_LDREX,CPUARM_HAS_UMULL],
+       { cpu_armv6k   } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_LDREX,CPUARM_HAS_UMULL],
+       { cpu_armv6t2  } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
+       { cpu_armv6z   } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_LDREX,CPUARM_HAS_UMULL],
        { cpu_armv6m   } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_REV],
        { the identifier armv7 is should not be used, it is considered being equal to armv7a }
-       { cpu_armv7    } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_DMB],
-       { cpu_armv7a   } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_DMB],
-       { cpu_armv7r   } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_DMB],
-       { cpu_armv7m   } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_IDIV,CPUARM_HAS_DMB],
-       { cpu_armv7em  } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_IDIV,CPUARM_HAS_DMB]
+       { cpu_armv7    } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
+       { cpu_armv7a   } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
+       { cpu_armv7r   } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
+       { cpu_armv7m   } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2],
+       { cpu_armv7em  } [CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2]
      );
 
+   { contains all CPU supporting any kind of thumb instruction set }
+   cpu_has_thumb = [cpu_armv4t,cpu_armv5t,cpu_armv5te,cpu_armv5tej,cpu_armv6t2,cpu_armv6z,cpu_armv6m,cpu_armv7a,cpu_armv7r,cpu_armv7m,cpu_armv7em];
+
 Implementation
 
 end.

compiler/arm/cpunode.pas

@@ -41,7 +41,9 @@ unit cpunode;
        narmcnv,
        narmcon,
        narmset,
-       narmmem
+       narmmem,
+       { symtable }
+       symcpu
        ;
 
 

compiler/arm/cpupara.pas

@@ -44,8 +44,8 @@ unit cpupara;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
          private
           procedure init_values(p: tabstractprocdef; side: tcallercallee; var curintreg,
-           curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword;
- var sparesinglereg: tregister);
+            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;
        end;
@@ -54,7 +54,9 @@ unit cpupara;
 
     uses
        verbose,systems,cutils,
-       defutil,symsym,symtable;
+       defutil,symsym,symcpu,symtable,
+       { PowerPC uses procinfo as well in cpupara, so this should not hurt }
+       procinfo;
 
 
     function tarmparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
@@ -298,8 +300,8 @@ unit cpupara;
         curfloatreg:=RS_F0;
         curmmreg:=RS_D0;
 
-        if (current_settings.cputype in cpu_thumb) and (side=calleeside) then
-          cur_stack_offset:=(p as tprocdef).total_stackframe_size
+        if (side=calleeside) and (GenerateThumbCode or (pi_estimatestacksize in current_procinfo.flags)) then
+          cur_stack_offset:=(p as tcpuprocdef).total_stackframe_size
         else
           cur_stack_offset:=0;
         sparesinglereg := NR_NO;
@@ -581,13 +583,9 @@ unit cpupara;
                    begin
                      if paraloc^.loc=LOC_REFERENCE then
                        begin
-                         if current_settings.cputype in cpu_thumb then
+                         paraloc^.reference.index:=current_procinfo.framepointer;
+                         if current_procinfo.framepointer=NR_FRAME_POINTER_REG then
                            begin
-                             paraloc^.reference.index:=NR_STACK_POINTER_REG;
-                           end
-                         else
-                           begin
-                             paraloc^.reference.index:=NR_FRAME_POINTER_REG;
                              { on non-Darwin, the framepointer contains the value
                                of the stack pointer on entry. On Darwin, the
                                framepointer points to the previously saved
@@ -714,16 +712,25 @@ unit cpupara;
               begin
                 paraloc^.loc:=LOC_REGISTER;
                 paraloc^.register:=NR_FUNCTION_RETURN_REG;
-                if (result.intsize<>3) then
-                  begin
-                    paraloc^.size:=retcgsize;
-                    paraloc^.def:=result.def;
-                  end
-                else
-                  begin
-                    paraloc^.size:=OS_32;
-                    paraloc^.def:=u32inttype;
-                  end;
+                case result.IntSize of
+                  0:
+                    begin
+                      paraloc^.loc:=LOC_VOID;
+                      paraloc^.register:=NR_NO;
+                      paraloc^.size:=OS_NO;
+                      paraloc^.def:=voidpointertype;
+                    end;
+                  3:
+                    begin
+                      paraloc^.size:=OS_32;
+                      paraloc^.def:=u32inttype;
+                    end;
+                  else
+                    begin
+                      paraloc^.size:=retcgsize;
+                      paraloc^.def:=result.def;
+                    end;
+                end;
               end;
           end;
       end;

compiler/arm/cpupi.pas

@@ -29,7 +29,8 @@ unit cpupi;
 
     uses
        globtype,cutils,
-       procinfo,cpuinfo,psub;
+       procinfo,cpuinfo,psub,cgbase,
+       aasmdata;
 
     type
        tarmprocinfo = class(tcgprocinfo)
@@ -39,12 +40,15 @@ unit cpupi;
             if this size is too little the procedure must be compiled again with a larger value }
           stackframesize,
           floatregstart : aint;
+          stackpaddingreg: TSuperRegister;
           // procedure handle_body_start;override;
           // procedure after_pass1;override;
           procedure set_first_temp_offset;override;
           function calc_stackframe_size:longint;override;
           procedure init_framepointer; override;
           procedure generate_parameter_info;override;
+          procedure allocate_got_register(list : TAsmList);override;
+          procedure postprocess_code;override;
        end;
 
 
@@ -54,10 +58,11 @@ unit cpupi;
        globals,systems,
        cpubase,
        tgobj,
-       symconst,symtype,symsym,paramgr,
-       cgbase,cgutils,
+       symconst,symtype,symsym,symcpu,paramgr,
+       cgutils,
        cgobj,
-       defutil;
+       defutil,
+       aasmcpu;
 
     procedure tarmprocinfo.set_first_temp_offset;
       var
@@ -96,7 +101,7 @@ unit cpupi;
           tg.setfirsttemp(maxpushedparasize);
 
         { estimate stack frame size }
-        if current_settings.cputype in cpu_thumb then
+        if GenerateThumbCode or (pi_estimatestacksize in flags) then
           begin
             stackframesize:=maxpushedparasize+32;
             localsize:=0;
@@ -108,10 +113,14 @@ unit cpupi;
             localsize:=0;
             for i:=0 to procdef.parast.SymList.Count-1 do
               if tsym(procdef.parast.SymList[i]).typ=paravarsym then
-                if is_open_string(tabstractnormalvarsym(procdef.parast.SymList[i]).vardef) then
-                  inc(localsize,256)
-                else
-                  inc(localsize,tabstractnormalvarsym(procdef.parast.SymList[i]).getsize);
+                begin
+                  if tabstractnormalvarsym(procdef.parast.SymList[i]).varspez in [vs_var,vs_out,vs_constref] then
+                    inc(localsize,4)
+                  else if is_open_string(tabstractnormalvarsym(procdef.parast.SymList[i]).vardef) then
+                    inc(localsize,256)
+                  else
+                    inc(localsize,tabstractnormalvarsym(procdef.parast.SymList[i]).getsize);
+                end;
 
             inc(stackframesize,localsize);
 
@@ -138,7 +147,7 @@ unit cpupi;
          floatsavesize : aword;
          regs: tcpuregisterset;
       begin
-        if current_settings.cputype in cpu_thumb then
+        if GenerateThumbCode or (pi_estimatestacksize in flags) then
           result:=stackframesize
         else
           begin
@@ -151,6 +160,7 @@ unit cpupi;
                 begin
                   { save floating point registers? }
                   firstfloatreg:=RS_NO;
+                  lastfloatreg:=RS_NO;
                   regs:=cg.rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall);
                   for r:=RS_F0 to RS_F7 do
                     if r in regs then
@@ -183,16 +193,55 @@ unit cpupi;
             end;
             floatsavesize:=align(floatsavesize,max(current_settings.alignment.localalignmin,4));
             result:=Align(tg.direction*tg.lasttemp,max(current_settings.alignment.localalignmin,4))+maxpushedparasize+aint(floatsavesize);
-            floatregstart:=tg.direction*result+maxpushedparasize;
+            { Note: in cgcpu "-floatregstart" is subtracted -> reason based on
+                "adding floatregstart" to avoid double negation
+
+              tg.direction=1 -> no framepointer ->
+                1) save used int registers
+                2) allocate stacksize (= subtracting result, which is positive,
+                   from the stackpointer)
+                3) add floatregstart to the stackpointer to get the offset where
+                   to store the floating point registers (-> floatregstart
+                   should be positive)
+                4) store the floating point registers from this offset with IA
+                   (i.e., this offset and higher addresses -> offset should
+                    point to lower end of area)
+               -> newsp+(result) points to lower end of saved int registers area
+               -> newsp+(result-floatsavesize) points to lower end of float reg
+                  saving area
+
+              tg.direction=-1 -> with framepointer ->
+                1) save stack pointer in framepointer
+                2) save used int registers using stackpointer
+                3) allocate stacksize (= subtracting result, which is positive,
+                   from the stack pointer)
+                4) add floatregstart" to the framepointer to get the offset
+                   where to store the floating point registers (-> floatregstart
+                   should be negative)
+                5) store the floating point registers from this offset with IA
+                   (i.e., this offset and higher addresses -> offset should
+                    point to lower end of area)
+                o in this case, firsttemp starts right after the saved int
+                  registers area (or a bit further, because it's calculated for
+                  the worst-case scenario, when all non-volative integer
+                  registers have to be saved) -> we store the floating point
+                  registers between the last temp and the parameter pushing area
+               -> fp+(-result) points to the top of the stack (= end of
+                  parameter pushing area)
+               -> fp+(-result+maxpushedparasize) points to the start of the
+                  parameter pushing area = lower end of float reg saving area
+            }
             if tg.direction=1 then
-              dec(floatregstart,floatsavesize);
+              floatregstart:=result-aint(floatsavesize)
+            else
+              floatregstart:=-result+maxpushedparasize;
           end;
       end;
 
 
     procedure tarmprocinfo.init_framepointer;
       begin
-        if (target_info.system in systems_darwin) or (current_settings.cputype in cpu_thumb) then
+        if (target_info.system in systems_darwin) or GenerateThumbCode then
           begin
             RS_FRAME_POINTER_REG:=RS_R7;
             NR_FRAME_POINTER_REG:=NR_R7;
@@ -207,11 +256,25 @@ unit cpupi;
 
     procedure tarmprocinfo.generate_parameter_info;
       begin
-       procdef.total_stackframe_size:=stackframesize;
+       tcpuprocdef(procdef).total_stackframe_size:=stackframesize;
        inherited generate_parameter_info;
       end;
 
 
+    procedure tarmprocinfo.allocate_got_register(list: TAsmList);
+      begin
+        { darwin doesn't use a got }
+        if tf_pic_uses_got in target_info.flags then
+          got := cg.getaddressregister(list);
+      end;
+
+
+    procedure tarmprocinfo.postprocess_code;
+      begin
+        { because of the limited constant size of the arm, all data access is done pc relative }
+        finalizearmcode(aktproccode,aktlocaldata);
+      end;
+
 begin
    cprocinfo:=tarmprocinfo;
 end.

compiler/arm/narmadd.pas

@@ -32,27 +32,32 @@ interface
        tarmaddnode = class(tcgaddnode)
        private
           function  GetResFlags(unsigned:Boolean):TResFlags;
+          function  GetFpuResFlags:TResFlags;
        public
           function pass_1 : tnode;override;
+          function use_generic_mul32to64: boolean; override;
+          function use_generic_mul64bit: boolean; override;
        protected
           function first_addfloat: tnode; override;
+          procedure second_addordinal;override;
           procedure second_addfloat;override;
           procedure second_cmpfloat;override;
           procedure second_cmpordinal;override;
           procedure second_cmpsmallset;override;
           procedure second_cmp64bit;override;
+          procedure second_add64bit;override;
        end;
 
   implementation
 
     uses
-      globtype,verbose,globals,
-      constexp,symdef,symtable,symtype,
-      aasmbase,aasmdata,aasmcpu,defutil,htypechk,
-      cgbase,cgutils,
-      cpuinfo,pass_1,procinfo,
+      globtype,verbose,globals,systems,
+      constexp,symdef,symtable,symtype,symconst,
+      aasmbase,aasmdata,aasmcpu,
+      defutil,htypechk,cgbase,cgutils,
+      cpuinfo,pass_1,pass_2,procinfo,
       ncon,nadd,ncnv,ncal,nmat,
-      ncgutil,cgobj,
+      ncgutil,cgobj,cgcpu,
       hlcgobj
       ;
 
@@ -80,6 +85,8 @@ interface
                       GetResFlags:=F_LT;
                     gten:
                       GetResFlags:=F_LE;
+                    else
+                      internalerror(201408203);
                   end
                 else
                   case NodeType of
@@ -91,6 +98,8 @@ interface
                       GetResFlags:=F_GT;
                     gten:
                       GetResFlags:=F_GE;
+                    else
+                      internalerror(201408204);
                   end;
               end
             else
@@ -105,6 +114,8 @@ interface
                       GetResFlags:=F_CC;
                     gten:
                       GetResFlags:=F_LS;
+                    else
+                      internalerror(201408205);
                   end
                 else
                   case NodeType of
@@ -116,12 +127,37 @@ interface
                       GetResFlags:=F_HI;
                     gten:
                       GetResFlags:=F_CS;
+                    else
+                      internalerror(201408206);
                   end;
               end;
         end;
       end;
 
 
+    function tarmaddnode.GetFpuResFlags:TResFlags;
+      begin
+        if nf_swapped in Flags then
+          internalerror(2014042001);
+        case NodeType of
+          equaln:
+            result:=F_EQ;
+          unequaln:
+            result:=F_NE;
+          ltn:
+            result:=F_MI;
+          lten:
+            result:=F_LS;
+          gtn:
+            result:=F_GT;
+          gten:
+            result:=F_GE;
+          else
+            internalerror(201408207);
+        end;
+      end;
+
+
     procedure tarmaddnode.second_addfloat;
       var
         op : TAsmOp;
@@ -138,8 +174,8 @@ interface
             begin
               { force fpureg as location, left right doesn't matter
                 as both will be in a fpureg }
-              location_force_fpureg(current_asmdata.CurrAsmList,left.location,true);
-              location_force_fpureg(current_asmdata.CurrAsmList,right.location,true);
+              hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
+              hlcg.location_force_fpureg(current_asmdata.CurrAsmList,right.location,right.resultdef,true);
 
               location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
               location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
@@ -245,7 +281,7 @@ interface
           swapleftright;
 
         location_reset(location,LOC_FLAGS,OS_NO);
-        location.resflags:=getresflags(true);
+        location.resflags:=getresflags(false);
 
         case current_settings.fputype of
           fpu_fpa,
@@ -254,8 +290,8 @@ interface
             begin
               { force fpureg as location, left right doesn't matter
                 as both will be in a fpureg }
-              location_force_fpureg(current_asmdata.CurrAsmList,left.location,true);
-              location_force_fpureg(current_asmdata.CurrAsmList,right.location,true);
+              hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
+              hlcg.location_force_fpureg(current_asmdata.CurrAsmList,right.location,right.resultdef,true);
 
               cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
               if nodetype in [equaln,unequaln] then
@@ -287,6 +323,7 @@ interface
                 left.location.register,right.location.register));
               cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
               current_asmdata.CurrAsmList.concat(taicpu.op_none(A_FMSTAT));
+              location.resflags:=GetFpuResFlags;
             end;
           fpu_fpv4_s16:
             begin
@@ -307,9 +344,6 @@ interface
             { this case should be handled already by pass1 }
             internalerror(2009112404);
         end;
-
-        location_reset(location,LOC_FLAGS,OS_NO);
-        location.resflags:=getresflags(false);
       end;
 
 
@@ -331,7 +365,7 @@ interface
         (* Try to keep right as a constant *)
         if (right.location.loc <> LOC_CONSTANT) or
           not(is_shifter_const(right.location.value, b)) or
-          ((current_settings.cputype in cpu_thumb) and not(is_thumb_imm(right.location.value))) then
+          ((GenerateThumbCode) and not(is_thumb_imm(right.location.value))) then
           hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true);
         hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
 
@@ -355,13 +389,13 @@ interface
               tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
               if right.location.loc = LOC_CONSTANT then
                 begin
-                  current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_AND,tmpreg,left.location.register,right.location.value));
+                  cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_AND,OS_32,right.location.value,left.location.register,tmpreg);
                   cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMP,tmpreg,right.location.value));
                 end
               else
                 begin
-                  current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_AND,tmpreg,left.location.register,right.location.register));
+                  cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_AND,OS_32,left.location.register,right.location.register,tmpreg);
                   cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,tmpreg,right.location.register));
                 end;
@@ -379,41 +413,44 @@ interface
         oldnodetype : tnodetype;
         dummyreg : tregister;
         l: tasmlabel;
+      const
+        lt_zero_swapped: array[boolean] of tnodetype = (ltn, gtn);
       begin
         unsigned:=not(is_signed(left.resultdef)) or
                   not(is_signed(right.resultdef));
 
         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);
-            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);
-            cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
-
-            if current_settings.cputype in cpu_thumb then
-              cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,right.location.register64.reglo,right.location.register64.reghi,dummyreg)
-            else
-              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
+        { pass_left_right moves possible consts to the right, the only
+          remaining case with left consts (currency) can take this path too (KB) }
+        if (right.nodetype=ordconstn) and
+           (tordconstnode(right).value=0) and
+           ((nodetype in [equaln,unequaln]) or
+            (not(GenerateThumbCode) and is_signed(left.resultdef) and (nodetype = lt_zero_swapped[nf_swapped in Flags]))
+           ) 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);
-            cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
 
-            if current_settings.cputype in cpu_thumb then
-              cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reglo,left.location.register64.reghi,dummyreg)
+            cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
+            { Optimize for the common case of int64 < 0 }
+            if nodetype in [ltn, gtn] then
+              begin
+                {Just check for the MSB in reghi to be set or not, this is independed from nf_swapped}
+                location.resflags:=F_NE;
+                current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_TST,left.location.register64.reghi, aint($80000000)));
+              end
             else
-              current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ORR,dummyreg,left.location.register64.reglo,left.location.register64.reghi),PF_S));
+              begin
+                location.resflags:=getresflags(unsigned);
+                dummyreg:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
+
+                if GenerateThumbCode then
+                  cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reglo,left.location.register64.reghi,dummyreg)
+                else
+                  current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ORR,dummyreg,left.location.register64.reglo,left.location.register64.reghi),PF_S));
+              end;
           end
         else
           begin
@@ -427,7 +464,7 @@ interface
                 location.resflags:=getresflags(unsigned);
                 cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
                 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi));
-                if current_settings.cputype in (cpu_thumb+cpu_thumb2) then
+                if GenerateThumbCode or GenerateThumb2Code then
                   begin
                     current_asmdata.getjumplabel(l);
                     cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,l);
@@ -483,6 +520,33 @@ interface
           end;
       end;
 
+    procedure tarmaddnode.second_add64bit;
+      var
+        asmList : TAsmList;
+        ll,rl,res : TRegister64;
+        tmpreg: TRegister;
+      begin
+        if (nodetype in [muln]) then
+          begin
+            asmList := current_asmdata.CurrAsmList;
+            pass_left_right;
+            force_reg_left_right(true, (left.location.loc<>LOC_CONSTANT) and (right.location.loc<>LOC_CONSTANT));
+            set_result_location_reg;
+
+            { shortcuts to register64s }
+            ll:=left.location.register64;
+            rl:=right.location.register64;
+            res:=location.register64;
+
+            tmpreg := cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+            asmList.concat(taicpu.op_reg_reg_reg(A_MUL,tmpreg,ll.reglo,rl.reghi));
+            asmList.concat(taicpu.op_reg_reg_reg_reg(A_UMULL,res.reglo,res.reghi,rl.reglo,ll.reglo));
+            tbasecgarm(cg).safe_mla(asmList,tmpreg,rl.reglo,ll.reghi,tmpreg);
+            asmList.concat(taicpu.op_reg_reg_reg(A_ADD,res.reghi,tmpreg,res.reghi));
+          end
+        else
+          inherited second_add64bit;
+      end;
 
     function tarmaddnode.pass_1 : tnode;
       var
@@ -541,13 +605,13 @@ interface
                       procname:=procname+'_le';
                     gtn:
                       begin
-                        procname:=procname+'_le';
-                        notnode:=true;
+                        procname:=procname+'_lt';
+                        swapleftright;
                       end;
                     gten:
                       begin
-                        procname:=procname+'_lt';
-                        notnode:=true;
+                        procname:=procname+'_le';
+                        swapleftright;
                       end;
                     equaln:
                       procname:=procname+'_eq';
@@ -595,8 +659,8 @@ interface
         cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
         if right.location.loc = LOC_CONSTANT then
           begin
-             if (not(current_settings.cputype in cpu_thumb) and is_shifter_const(right.location.value,b)) or
-                ((current_settings.cputype in cpu_thumb) and is_thumb_imm(right.location.value)) then
+             if (not(GenerateThumbCode) and is_shifter_const(right.location.value,b)) or
+                ((GenerateThumbCode) and is_thumb_imm(right.location.value)) then
                current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMP,left.location.register,right.location.value))
              else
                begin
@@ -613,6 +677,43 @@ interface
         location.resflags:=getresflags(unsigned);
       end;
 
+    const
+      multops: array[boolean] of TAsmOp = (A_SMULL, A_UMULL);
+
+    procedure tarmaddnode.second_addordinal;
+      var
+        unsigned: boolean;
+      begin
+        if (nodetype=muln) and
+           is_64bit(resultdef) and
+           not(GenerateThumbCode) and
+           (CPUARM_HAS_UMULL in cpu_capabilities[current_settings.cputype]) then
+          begin
+            pass_left_right;
+            force_reg_left_right(true, false);
+            set_result_location_reg;
+            unsigned:=not(is_signed(left.resultdef)) or
+                      not(is_signed(right.resultdef));
+            current_asmdata.CurrAsmList.Concat(
+              taicpu.op_reg_reg_reg_reg(multops[unsigned], location.register64.reglo, location.register64.reghi,
+                                        left.location.register,right.location.register));
+          end
+        else
+          inherited second_addordinal;
+      end;
+
+    function tarmaddnode.use_generic_mul32to64: boolean;
+      begin
+        result:=GenerateThumbCode or not(CPUARM_HAS_UMULL in cpu_capabilities[current_settings.cputype]);
+      end;
+
+    function tarmaddnode.use_generic_mul64bit: boolean;
+      begin
+        result:=GenerateThumbCode or
+          not(CPUARM_HAS_UMULL in cpu_capabilities[current_settings.cputype]) or
+          (cs_check_overflow in current_settings.localswitches);
+      end;
+
 begin
   caddnode:=tarmaddnode;
 end.

compiler/arm/narmcon.pas

@@ -77,8 +77,7 @@ interface
                 begin
                   current_procinfo.aktlocaldata.concat(Tai_real_32bit.Create(ts32real(value_real)));
                   { range checking? }
-                  if ((cs_check_range in current_settings.localswitches) or
-                    (cs_check_overflow in current_settings.localswitches)) and
+                  if floating_point_range_check_error and
                     (tai_real_32bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) then
                     Message(parser_e_range_check_error);
                 end;
@@ -91,8 +90,7 @@ interface
                     current_procinfo.aktlocaldata.concat(Tai_real_64bit.Create(ts64real(value_real)));
 
                   { range checking? }
-                  if ((cs_check_range in current_settings.localswitches) or
-                    (cs_check_overflow in current_settings.localswitches)) and
+                  if floating_point_range_check_error and
                     (tai_real_64bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) then
                     Message(parser_e_range_check_error);
                end;
@@ -102,8 +100,7 @@ interface
                   current_procinfo.aktlocaldata.concat(Tai_real_80bit.Create(value_real,tfloatdef(resultdef).size));
 
                   { range checking? }
-                  if ((cs_check_range in current_settings.localswitches) or
-                    (cs_check_overflow in current_settings.localswitches)) and
+                  if floating_point_range_check_error and
                     (tai_real_80bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) then
                     Message(parser_e_range_check_error);
                 end;
@@ -113,8 +110,7 @@ interface
                   current_procinfo.aktlocaldata.concat(Tai_real_128bit.Create(value_real));
 
                   { range checking? }
-                  if ((cs_check_range in current_settings.localswitches) or
-                    (cs_check_overflow in current_settings.localswitches)) and
+                  if floating_point_range_check_error and
                     (tai_real_128bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) then
                     Message(parser_e_range_check_error);
                 end;

compiler/arm/narminl.pas

@@ -60,7 +60,7 @@ implementation
     uses
       globtype,verbose,globals,
       cpuinfo, defutil,symdef,aasmdata,aasmcpu,
-      cgbase,cgutils,pass_2,
+      cgbase,cgutils,pass_1,pass_2,
       cpubase,ncgutil,cgobj,cgcpu, hlcgobj;
 
 {*****************************************************************************
@@ -75,7 +75,7 @@ implementation
           fpu_fpa10,
           fpu_fpa11:
             begin
-              location_force_fpureg(current_asmdata.CurrAsmList,left.location,true);
+              hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
               location_copy(location,left.location);
               if left.location.loc=LOC_CFPUREGISTER then
                 begin
@@ -96,6 +96,11 @@ implementation
                  location.loc := LOC_MMREGISTER;
                end;
             end;
+          fpu_soft:
+            begin
+              hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
+              location_copy(location,left.location);
+            end
           else
             internalerror(2009111801);
         end;
@@ -106,7 +111,11 @@ implementation
     function tarminlinenode.first_abs_real : tnode;
       begin
         if (cs_fp_emulation in current_settings.moduleswitches) then
-          result:=inherited first_abs_real
+          begin
+            firstpass(left);
+            expectloc:=LOC_REGISTER;
+            first_abs_real:=nil;
+          end
         else
           begin
             case current_settings.fputype of
@@ -245,6 +254,13 @@ implementation
             end;
           fpu_fpv4_s16:
             current_asmdata.CurrAsmList.Concat(setoppostfix(taicpu.op_reg_reg(A_VABS,location.register,left.location.register), PF_F32));
+          fpu_soft:
+            begin
+              if singleprec then
+                cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_AND,OS_32,tcgint($7fffffff),location.register)
+              else
+                cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_AND,OS_32,tcgint($7fffffff),location.registerhi);
+            end
         else
           internalerror(2009111402);
         end;
@@ -342,7 +358,7 @@ implementation
         ref : treference;
         r : tregister;
       begin
-        if CPUARM_HAS_EDSP in cpu_capabilities[current_settings.cputype] then
+        if not(GenerateThumbCode) and (CPUARM_HAS_EDSP in cpu_capabilities[current_settings.cputype]) then
           begin
             secondpass(left);
             case left.location.loc of
@@ -366,14 +382,26 @@ implementation
         opsize : tcgsize;
         hp : taicpu;
       begin
+        if GenerateThumbCode then
+          begin
+            inherited second_abs_long;
+            exit;
+          end;
+
         secondpass(left);
         opsize:=def_cgsize(left.resultdef);
         hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
         location:=left.location;
         location.register:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
+
         cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
         current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_MOV,location.register,left.location.register), PF_S));
+
+        if GenerateThumb2Code then
+          current_asmdata.CurrAsmList.concat(taicpu.op_cond(A_IT,C_MI));
+
         current_asmdata.CurrAsmList.concat(setcondition(taicpu.op_reg_reg_const(A_RSB,location.register,location.register, 0), C_MI));
+
         cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
       end;
 

compiler/arm/narmmat.pas

@@ -71,19 +71,25 @@ implementation
       var
         power  : longint;
       begin
-        if (right.nodetype=ordconstn) and
-          (nodetype=divn) and
-          (ispowerof2(tordconstnode(right).value,power) or
-           (tordconstnode(right).value=1) or
-           (tordconstnode(right).value=int64(-1))
-          ) and
-          not(is_64bitint(resultdef)) then
+        {We can handle all cases of constant division}
+        if not(cs_check_overflow in current_settings.localswitches) and
+           (right.nodetype=ordconstn) and
+           (nodetype=divn) and
+           not(is_64bitint(resultdef)) and
+           {Only the ARM and thumb2-isa support umull and smull, which are required for arbitary division by const optimization}
+           (GenerateArmCode or
+            GenerateThumb2Code or
+            (ispowerof2(tordconstnode(right).value,power) or
+            (tordconstnode(right).value=1) or
+            (tordconstnode(right).value=int64(-1))
+            )
+           ) then
           result:=nil
-        else if (current_settings.cputype in [cpu_armv7m,cpu_armv7em]) and
+        else if ((GenerateThumbCode or GenerateThumb2Code) and (CPUARM_HAS_THUMB_IDIV in cpu_capabilities[current_settings.cputype])) and
           (nodetype=divn) and
           not(is_64bitint(resultdef)) then
           result:=nil
-        else if (current_settings.cputype in [cpu_armv7m,cpu_armv7em]) and
+        else if ((GenerateThumbCode or GenerateThumb2Code) and (CPUARM_HAS_THUMB_IDIV in cpu_capabilities[current_settings.cputype])) and
           (nodetype=modn) and
           not(is_64bitint(resultdef)) then
           begin
@@ -91,13 +97,14 @@ implementation
               ispowerof2(tordconstnode(right).value,power) and
               (tordconstnode(right).value<=256) and
               (tordconstnode(right).value>0) then
-              result:=caddnode.create(andn,left,cordconstnode.create(tordconstnode(right).value-1,sinttype,false))
+              result:=caddnode.create_internal(andn,left,cordconstnode.create(tordconstnode(right).value-1,sinttype,false))
             else
               begin
-                result:=caddnode.create(subn,left,caddnode.create(muln,right.getcopy, cmoddivnode.Create(divn,left.getcopy,right.getcopy)));
+                result:=caddnode.create_internal(subn,left,caddnode.create_internal(muln,right,cmoddivnode.Create(divn,left.getcopy,right.getcopy)));
                 right:=nil;
               end;
             left:=nil;
+            firstpass(result);
           end
         else if (nodetype=modn) and
           (is_signed(left.resultdef)) and
@@ -105,13 +112,18 @@ implementation
           (tordconstnode(right).value=2) then
           begin
             // result:=(0-(left and 1)) and (1+(sarlongint(left,31) shl 1))
-            result:=caddnode.create(andn,caddnode.create(subn,cordconstnode.create(0,sinttype,false),caddnode.create(andn,left,cordconstnode.create(1,sinttype,false))),
-                                         caddnode.create(addn,cordconstnode.create(1,sinttype,false),
+            result:=caddnode.create_internal(andn,caddnode.create_internal(subn,cordconstnode.create(0,sinttype,false),caddnode.create_internal(andn,left,cordconstnode.create(1,sinttype,false))),
+                                         caddnode.create_internal(addn,cordconstnode.create(1,sinttype,false),
                                                               cshlshrnode.create(shln,cinlinenode.create(in_sar_x_y,false,ccallparanode.create(cordconstnode.create(31,sinttype,false),ccallparanode.Create(left.getcopy,nil))),cordconstnode.create(1,sinttype,false))));
             left:=nil;
+            firstpass(result);
           end
         else
           result:=inherited first_moddivint;
+
+        { we may not change the result type here }
+        if assigned(result) and (torddef(result.resultdef).ordtype<>torddef(resultdef).ordtype) then
+          inserttypeconv(result,resultdef);
       end;
 
 
@@ -150,7 +162,7 @@ implementation
                       cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,numerator,helper1)
                     else
                       cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SAR,OS_INT,31,numerator,helper1);
-                    if current_settings.cputype in cpu_thumb then
+                    if GenerateThumbCode then
                       begin
                         cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SAR,OS_INT,32-power,helper1);
                         current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ADD,helper2,numerator,helper1));
@@ -166,7 +178,10 @@ implementation
                   end
                else
                  cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,power,numerator,resultreg)
-             end;
+             end
+           else {Everything else is handled the generic code}
+             cg.g_div_const_reg_reg(current_asmdata.CurrAsmList,def_cgsize(resultdef),
+               tordconstnode(right).value.svalue,numerator,resultreg);
          end;
 
 {
@@ -214,7 +229,7 @@ implementation
         secondpass(left);
         secondpass(right);
 
-        if (current_settings.cputype in [cpu_armv7m,cpu_armv7em]) and
+        if ((GenerateThumbCode or GenerateThumb2Code) and (CPUARM_HAS_THUMB_IDIV in cpu_capabilities[current_settings.cputype])) and
            (nodetype=divn) and
            not(is_64bitint(resultdef)) then
           begin
@@ -349,6 +364,15 @@ implementation
         procname: string[31];
         fdef : tdef;
       begin
+        if (current_settings.fputype=fpu_soft) and
+           (left.resultdef.typ=floatdef) then
+          begin
+            result:=nil;
+            firstpass(left);
+            expectloc:=LOC_REGISTER;
+            exit;
+          end;
+
         if (current_settings.fputype<>fpu_fpv4_s16) or
           (tfloatdef(resultdef).floattype=s32real) then
           exit(inherited pass_1);
@@ -394,7 +418,7 @@ implementation
           fpu_fpa10,
           fpu_fpa11:
             begin
-              location_force_fpureg(current_asmdata.CurrAsmList,left.location,false);
+              hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
               location:=left.location;
               current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_const(A_RSF,
                 location.register,left.location.register,0),
@@ -423,6 +447,19 @@ implementation
                 location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
               current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_VNEG,
                 location.register,left.location.register), PF_F32));
+            end;
+          fpu_soft:
+            begin
+              hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
+              location:=left.location;
+              case location.size of
+                OS_32:
+                  cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_XOR,OS_32,tcgint($80000000),location.register);
+                OS_64:
+                  cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_XOR,OS_32,tcgint($80000000),location.registerhi);
+              else
+                internalerror(2014033101);
+              end;
             end
           else
             internalerror(2009112602);
@@ -431,7 +468,7 @@ implementation
 
     function tarmshlshrnode.first_shlshr64bitint: tnode;
       begin
-        if (current_settings.cputype in cpu_thumb+cpu_thumb2) then
+        if GenerateThumbCode or GenerateThumb2Code then
           result:=inherited
         else
           result := nil;
@@ -439,87 +476,101 @@ implementation
 
     procedure tarmshlshrnode.second_64bit;
       var
-        hreg64hi,hreg64lo,shiftreg:Tregister;
         v : TConstExprInt;
-        l1,l2,l3:Tasmlabel;
         so: tshifterop;
+        lreg, resreg: TRegister64;
 
       procedure emit_instr(p: tai);
         begin
           current_asmdata.CurrAsmList.concat(p);
         end;
 
-      {Reg1 gets shifted and moved into reg2, and is set to zero afterwards}
-      procedure shift_more_than_32(reg1, reg2: TRegister; shiftval: Byte ; sm: TShiftMode);
+      {This code is build like it gets called with sm=SM_LSR all the time, for SM_LSL dst* and src* have to be reversed}
+      procedure shift_less_than_32(srchi, srclo, dsthi, dstlo: TRegister; shiftval: Byte; sm: TShiftMode);
         begin
-          shifterop_reset(so); so.shiftimm:=shiftval - 32; so.shiftmode:=sm;
-          emit_instr(taicpu.op_reg_reg_shifterop(A_MOV, reg2, reg1, so));
-          emit_instr(taicpu.op_reg_const(A_MOV, reg1, 0));
-        end;
+          shifterop_reset(so);
 
-      procedure shift_less_than_32(reg1, reg2: TRegister; shiftval: Byte; shiftright: boolean);
-        begin
-          shifterop_reset(so); so.shiftimm:=shiftval;
-          if shiftright then so.shiftmode:=SM_LSR else so.shiftmode:=SM_LSL;
-          emit_instr(taicpu.op_reg_reg_shifterop(A_MOV, reg1, reg1, so));
+          so.shiftimm:=shiftval;
+          so.shiftmode:=sm;
+          emit_instr(taicpu.op_reg_reg_shifterop(A_MOV, dstlo, srclo, so));
+          emit_instr(taicpu.op_reg_reg_shifterop(A_MOV, dsthi, srchi, so));
 
-          if shiftright then so.shiftmode:=SM_LSL else so.shiftmode:=SM_LSR;
+          if sm = SM_LSR then so.shiftmode:=SM_LSL else so.shiftmode:=SM_LSR;
           so.shiftimm:=32-shiftval;
-          emit_instr(taicpu.op_reg_reg_reg_shifterop(A_ORR, reg1, reg1, reg2, so));
+          emit_instr(taicpu.op_reg_reg_reg_shifterop(A_ORR, dstlo, dstlo, srchi, so));
 
-          if shiftright then so.shiftmode:=SM_LSR else so.shiftmode:=SM_LSL;
-          so.shiftimm:=shiftval;
-          emit_instr(taicpu.op_reg_reg_shifterop(A_MOV, reg2, reg2, so));
         end;
 
-      procedure shift_by_variable(reg1, reg2, shiftval: TRegister; shiftright: boolean);
+      {This code is build like it gets called with sm=SM_LSR all the time, for SM_LSL dst* and src* have to be reversed
+       This will generate
+         mov   shiftval1, shiftval
+         cmp   shiftval1, #64
+         movcs shiftval1, #64
+         rsb   shiftval2, shiftval1, #32
+         mov   dstlo, srclo, lsr shiftval1
+         mov   dsthi, srchi, lsr shiftval1
+         orr   dstlo, srchi, lsl shiftval2
+         subs  shiftval2, shiftval1, #32
+         movpl dstlo, srchi, lsr shiftval2
+      }
+      procedure shift_by_variable(srchi, srclo, dsthi, dstlo, shiftval: TRegister; sm: TShiftMode);
         var
-          shiftval2:TRegister;
+          shiftval1,shiftval2:TRegister;
         begin
           shifterop_reset(so);
+          shiftval1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
           shiftval2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
 
+          cg.a_load_reg_reg(current_asmdata.CurrAsmList, OS_INT, OS_INT, shiftval, shiftval1);
+
+          {The ARM barrel shifter only considers the lower 8 bits of a register for the shift}
           cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
+          emit_instr(taicpu.op_reg_const(A_CMP, shiftval1, 64));
+          emit_instr(setcondition(taicpu.op_reg_const(A_MOV, shiftval1, 64), C_CS));
+          cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
 
-          {Do we shift more than 32 bits?}
-          emit_instr(setoppostfix(taicpu.op_reg_reg_const(A_RSB, shiftval2, shiftval, 32), PF_S));
+          {Calculate how much the upper register needs to be shifted left}
+          emit_instr(taicpu.op_reg_reg_const(A_RSB, shiftval2, shiftval1, 32));
 
-          {This part cares for 32 bits and more}
-          emit_instr(setcondition(taicpu.op_reg_reg_const(A_SUB, shiftval2, shiftval, 32), C_MI));
-          if shiftright then so.shiftmode:=SM_LSR else so.shiftmode:=SM_LSL;
-          so.rs:=shiftval2;
-          emit_instr(setcondition(taicpu.op_reg_reg_shifterop(A_MOV, reg2, reg1, so), C_MI));
+          so.shiftmode:=sm;
+          so.rs:=shiftval1;
+
+          {Shift and zerofill the hi+lo register}
+          emit_instr(taicpu.op_reg_reg_shifterop(A_MOV, dstlo, srclo, so));
+          emit_instr(taicpu.op_reg_reg_shifterop(A_MOV, dsthi, srchi, so));
 
-          {Less than 32 bits}
-          so.rs:=shiftval;
-          emit_instr(setcondition(taicpu.op_reg_reg_shifterop(A_MOV, reg2, reg2, so), C_PL));
-          if shiftright then so.shiftmode:=SM_LSL else so.shiftmode:=SM_LSR;
+          {Fold in the lower 32-shiftval bits}
+          if sm = SM_LSR then so.shiftmode:=SM_LSL else so.shiftmode:=SM_LSR;
           so.rs:=shiftval2;
-          emit_instr(setcondition(taicpu.op_reg_reg_reg_shifterop(A_ORR, reg2, reg2, reg1, so), C_PL));
+          emit_instr(taicpu.op_reg_reg_reg_shifterop(A_ORR, dstlo, dstlo, srchi, so));
 
-          cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
+          cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
+          emit_instr(setoppostfix(taicpu.op_reg_reg_const(A_SUB, shiftval2, shiftval1, 32), PF_S));
 
-          {Final adjustments}
-          if shiftright then so.shiftmode:=SM_LSR else so.shiftmode:=SM_LSL;
-          so.rs:=shiftval;
-          emit_instr(taicpu.op_reg_reg_shifterop(A_MOV, reg1, reg1, so));
+          so.shiftmode:=sm;
+          emit_instr(setcondition(taicpu.op_reg_reg_shifterop(A_MOV, dstlo, srchi, so), C_PL));
+          cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
         end;
 
       begin
-        if (current_settings.cputype in cpu_thumb+cpu_thumb2) then
+        if GenerateThumbCode or GenerateThumb2Code then
         begin
           inherited;
           exit;
         end;
 
         location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
+        location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+        location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
 
         { load left operator in a register }
-        hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef,false);
-        hreg64hi:=left.location.register64.reghi;
-        hreg64lo:=left.location.register64.reglo;
-        location.register64.reghi:=hreg64hi;
-        location.register64.reglo:=hreg64lo;
+        if not(left.location.loc in [LOC_CREGISTER,LOC_REGISTER]) or
+           (left.location.size<>OS_64) then
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef,true);
+
+        lreg := left.location.register64;
+        resreg := location.register64;
+        shifterop_reset(so);
 
         { shifting by a constant directly coded: }
         if (right.nodetype=ordconstn) then
@@ -531,8 +582,8 @@ implementation
                 begin
                   {Shift left by one by 2 simple 32bit additions}
                   cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
-                  emit_instr(setoppostfix(taicpu.op_reg_reg_reg(A_ADD, hreg64lo, hreg64lo, hreg64lo), PF_S));
-                  emit_instr(taicpu.op_reg_reg_reg(A_ADC, hreg64hi, hreg64hi, hreg64hi));
+                  emit_instr(setoppostfix(taicpu.op_reg_reg_reg(A_ADD, resreg.reglo, lreg.reglo, lreg.reglo), PF_S));
+                  emit_instr(taicpu.op_reg_reg_reg(A_ADC, resreg.reghi, lreg.reghi, lreg.reghi));
                   cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
                 end
               else
@@ -540,42 +591,41 @@ implementation
                   {Shift right by first shifting hi by one and then using RRX (rotate right extended), which rotates through the carry}
                   shifterop_reset(so); so.shiftmode:=SM_LSR; so.shiftimm:=1;
                   cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
-                  emit_instr(setoppostfix(taicpu.op_reg_reg_shifterop(A_MOV, hreg64hi, hreg64hi, so), PF_S));
+                  emit_instr(setoppostfix(taicpu.op_reg_reg_shifterop(A_MOV, resreg.reghi, lreg.reghi, so), PF_S));
                   so.shiftmode:=SM_RRX; so.shiftimm:=0; {RRX does NOT have a shift amount}
-                  emit_instr(taicpu.op_reg_reg_shifterop(A_MOV, hreg64lo, hreg64lo, so));
+                  emit_instr(taicpu.op_reg_reg_shifterop(A_MOV, resreg.reglo, lreg.reglo, so));
                   cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
                 end
-            {A 32bit shift just replaces a register and clears the other}
-            else if v = 32 then
+            {Clear one register and use the cg to generate a normal 32-bit shift}
+            else if v >= 32 then
+              if nodetype=shln then
               begin
-                if nodetype=shln then
-                  emit_instr(taicpu.op_reg_const(A_MOV, hreg64hi, 0))
-                else
-                  emit_instr(taicpu.op_reg_const(A_MOV, hreg64lo, 0));
-                location.register64.reghi:=hreg64lo;
-                location.register64.reglo:=hreg64hi;
+                emit_instr(taicpu.op_reg_const(A_MOV, resreg.reglo, 0));
+                cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_32,v.uvalue-32,lreg.reglo,resreg.reghi);
               end
-            {Shift LESS than 32}
-            else if (v < 32) and (v > 1) then
-              if nodetype=shln then
-                shift_less_than_32(hreg64hi, hreg64lo, v.uvalue, false)
               else
-                shift_less_than_32(hreg64lo, hreg64hi, v.uvalue, true)
-            {More than 32}
-            else if v > 32 then
+              begin
+                emit_instr(taicpu.op_reg_const(A_MOV, resreg.reghi, 0));
+                cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_32,v.uvalue-32,lreg.reghi,resreg.reglo);
+              end
+            {Shift LESS than 32, thats the tricky one}
+            else if (v < 32) and (v > 1) then
               if nodetype=shln then
-                shift_more_than_32(hreg64lo, hreg64hi, v.uvalue, SM_LSL)
+                shift_less_than_32(lreg.reglo, lreg.reghi, resreg.reglo, resreg.reghi, v.uvalue, SM_LSL)
               else
-                shift_more_than_32(hreg64hi, hreg64lo, v.uvalue, SM_LSR);
+                shift_less_than_32(lreg.reghi, lreg.reglo, resreg.reghi, resreg.reglo, v.uvalue, SM_LSR);
           end
         else
           begin
-            { force right operators in a register }
-            hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,resultdef,false);
+            { force right operator into a register }
+            if not(right.location.loc in [LOC_CREGISTER,LOC_REGISTER]) or
+               (right.location.size<>OS_32) then
+              hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,u32inttype,true);
+
             if nodetype = shln then
-              shift_by_variable(hreg64lo,hreg64hi,right.location.register, false)
+              shift_by_variable(lreg.reglo, lreg.reghi, resreg.reglo, resreg.reghi, right.location.register, SM_LSL)
             else
-              shift_by_variable(hreg64hi,hreg64lo,right.location.register, true);
+              shift_by_variable(lreg.reghi, lreg.reglo, resreg.reghi, resreg.reglo, right.location.register, SM_LSR);
           end;
       end;
 

compiler/arm/narmmem.pas

@@ -42,7 +42,7 @@ interface
 implementation
 
     uses
-      cutils,verbose,globals,aasmdata,aasmcpu,cgobj,
+      cutils,verbose,globals,aasmdata,aasmcpu,cgobj,cgcpu,
       cpuinfo,
       cgutils,
       procinfo;
@@ -54,7 +54,7 @@ implementation
     procedure tarmloadparentfpnode.pass_generate_code;
       begin
         { normally, we cannot use the stack pointer as normal register on arm thumb }
-        if (current_settings.cputype in cpu_thumb) and
+        if (GenerateThumbCode) and
           (getsupreg(current_procinfo.framepointer) in [RS_R8..RS_R15]) and
           (current_procinfo.procdef.parast.symtablelevel=parentpd.parast.symtablelevel) then
           begin
@@ -76,7 +76,7 @@ implementation
          hl : longint;
        begin
          if ((location.reference.base=NR_NO) and (location.reference.index=NR_NO)) or
-            (current_settings.cputype in cpu_thumb) or
+            (GenerateThumbCode) or
             { simple constant? }
             (l=1) or ispowerof2(l,hl) or ispowerof2(l+1,hl) or ispowerof2(l-1,hl) then
            inherited update_reference_reg_mul(maybe_const_reg,l)
@@ -84,7 +84,7 @@ implementation
            begin
              hreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
              cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_ADDR,l,hreg);
-             current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_reg(A_MLA,hreg,maybe_const_reg,hreg,location.reference.base));
+             tbasecgarm(cg).safe_mla(current_asmdata.CurrAsmList,hreg,maybe_const_reg,hreg,location.reference.base);
              location.reference.base:=hreg;
              { update alignment }
              if (location.reference.alignment=0) then
@@ -95,7 +95,7 @@ implementation
            begin
              hreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
              cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_ADDR,l,hreg);
-             current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_reg(A_MLA,hreg,maybe_const_reg,hreg,location.reference.index));
+             tbasecgarm(cg).safe_mla(current_asmdata.CurrAsmList,hreg,maybe_const_reg,hreg,location.reference.index);
              location.reference.base:=hreg;
              location.reference.index:=NR_NO;
              { update alignment }

compiler/arm/narmset.pas

@@ -51,7 +51,7 @@ interface
 implementation
 
     uses
-      globals,constexp,defutil,
+      verbose,globals,constexp,defutil,
       aasmbase,aasmtai,aasmdata,aasmcpu,
       cpubase,cpuinfo,
       cgutils,cgobj,ncgutil,
@@ -84,7 +84,7 @@ implementation
       begin
         location_reset(location,LOC_FLAGS,OS_NO);
         location.resflags:=F_NE;
-        if (left.location.loc=LOC_CONSTANT) and not(current_settings.cputype in cpu_thumb) then
+        if (left.location.loc=LOC_CONSTANT) and not(GenerateThumbCode) then
           begin
             hlcg.location_force_reg(current_asmdata.CurrAsmList, right.location,
               right.resultdef, right.resultdef, true);
@@ -104,7 +104,7 @@ implementation
             hregister:=cg.getintregister(current_asmdata.CurrAsmList, uopsize);
             current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_MOV,hregister,1));
 
-            if current_settings.cputype in cpu_thumb then
+            if GenerateThumbCode or GenerateThumb2Code then
               begin
                 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_LSL,hregister,left.location.register));
                 cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
@@ -141,11 +141,13 @@ implementation
     procedure tarmcasenode.genjumptable(hp : pcaselabel;min_,max_ : aint);
       var
         last : TConstExprInt;
+        tmpreg,
         basereg,
         indexreg : tregister;
         href : treference;
-        tablelabel: TAsmLabel;
+        tablelabel, piclabel : TAsmLabel;
         opcgsize : tcgsize;
+        picoffset : int64;
 
         procedure genitem(list:TAsmList;t : pcaselabel);
           var
@@ -155,9 +157,15 @@ implementation
               genitem(list,t^.less);
             { fill possible hole }
             for i:=last.svalue+1 to t^._low.svalue-1 do
-              list.concat(Tai_const.Create_sym(elselabel));
+              if cs_create_pic in current_settings.moduleswitches then
+                list.concat(Tai_const.Create_rel_sym_offset(aitconst_ptr,piclabel,elselabel,picoffset))
+              else
+                list.concat(Tai_const.Create_sym(elselabel));
             for i:=t^._low.svalue to t^._high.svalue do
-              list.concat(Tai_const.Create_sym(blocklabel(t^.blockid)));
+              if cs_create_pic in current_settings.moduleswitches then
+                list.concat(Tai_const.Create_rel_sym_offset(aitconst_ptr,piclabel,blocklabel(t^.blockid),picoffset))
+              else
+                list.concat(Tai_const.Create_sym(blocklabel(t^.blockid)));
             last:=t^._high.svalue;
             if assigned(t^.greater) then
               genitem(list,t^.greater);
@@ -192,8 +200,10 @@ implementation
         indexreg:=cg.makeregsize(current_asmdata.CurrAsmList,hregister,OS_INT);
         cg.a_load_reg_reg(current_asmdata.CurrAsmList,opcgsize,OS_INT,hregister,indexreg);
 
-        if current_settings.cputype in cpu_thumb2 then
+        if GenerateThumb2Code then
           begin
+            if cs_create_pic in current_settings.moduleswitches then
+              internalerror(2013082101);
             { adjust index }
             cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_ADDR,min_,indexreg,indexreg);
             { create reference and generate jump table }
@@ -209,9 +219,11 @@ implementation
             last:=min_;
             genitem_thumb2(current_asmdata.CurrAsmList,hp);
           end
-        else if current_settings.cputype in cpu_thumb then
+        else if GenerateThumbCode then
           begin
-            cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_ADDR,min_+1,indexreg,indexreg);
+            if cs_create_pic in current_settings.moduleswitches then
+              internalerror(2013082102);
+            cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_ADDR,min_,indexreg,indexreg);
             current_asmdata.getaddrlabel(tablelabel);
 
             cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHL,OS_ADDR,2,indexreg);
@@ -220,9 +232,15 @@ implementation
             reference_reset_symbol(href,tablelabel,0,4);
             cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList, href, basereg);
 
-            cg.a_op_reg_reg(current_asmdata.CurrAsmList, OP_ADD, OS_ADDr, indexreg, basereg);
-
-            current_asmdata.CurrAsmList.Concat(taicpu.op_reg(A_BX, basereg));
+            reference_reset(href,0);
+            href.base:=basereg;
+            href.index:=indexreg;
+            
+            tmpreg:=cg.getintregister(current_asmdata.CurrAsmList, OS_ADDR);
+            cg.a_load_ref_reg(current_asmdata.CurrAsmList, OS_ADDR, OS_ADDR, href, tmpreg);
+            
+            { do not use BX here to avoid switching into arm mode }
+            current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg(A_MOV, NR_PC, tmpreg));
 
             cg.a_label(current_asmdata.CurrAsmList,tablelabel);
             { generate jump table }
@@ -232,14 +250,26 @@ implementation
         else
           begin
             { adjust index }
-            cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_ADDR,min_+1,indexreg,indexreg);
+            cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_ADDR,
+              min_+ord(not(cs_create_pic in current_settings.moduleswitches)),
+              indexreg,indexreg);
             { create reference and generate jump table }
             reference_reset(href,4);
             href.base:=NR_PC;
             href.index:=indexreg;
             href.shiftmode:=SM_LSL;
             href.shiftimm:=2;
-            cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,NR_PC);
+            if cs_create_pic in current_settings.moduleswitches then
+              begin
+                picoffset:=-8;
+                current_asmdata.getaddrlabel(piclabel);
+                indexreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
+                cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,indexreg);
+                cg.a_label(current_asmdata.CurrAsmList,piclabel);
+                cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_ADD,OS_ADDR,indexreg,NR_PC);
+              end
+            else
+              cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,NR_PC);
             { generate jump table }
             last:=min_;
             genitem(current_asmdata.CurrAsmList,hp);

compiler/arm/raarmgas.pas

@@ -556,6 +556,11 @@ Unit raarmgas;
                oper.InitRef;
                oper.opr.ref.symbol:=hl;
                oper.opr.ref.base:=NR_PC;
+               if (actasmtoken in [AS_PLUS, AS_MINUS]) then
+                 begin
+                   l:=BuildConstExpression(true,false);
+                   oper.opr.ref.offset:=l;
+                 end;
              end;
           end;
 
@@ -718,6 +723,68 @@ Unit raarmgas;
               end;
           end;
 
+
+        procedure BuildDirectRef;
+
+          function GetConstLabel(const symname: string; ofs: aint): TAsmLabel;
+            var
+              hp: tai;
+              newconst: tai_const;
+              lab: TAsmLabel;
+            begin
+              if symname<>'' then
+                newconst:=tai_const.Createname(symname,ofs)
+              else
+                newconst:=tai_const.Create_32bit(ofs);
+
+              hp:=tai(current_procinfo.aktlocaldata.First);
+              while assigned(hp) do
+                begin
+                  if hp.typ=ait_const then
+                    begin
+                      if (tai_const(hp).sym=newconst.sym) and
+                         (tai_const(hp).value=newconst.value) and
+                         assigned(hp.Previous) and
+                         (tai(hp.previous).typ=ait_label) then
+                        begin
+                          newconst.Free;
+                          result:=tai_label(hp.Previous).labsym;
+                          exit;
+                        end;
+                    end;
+
+                  hp:=tai(hp.Next);
+                end;
+
+              current_asmdata.getjumplabel(lab);
+              current_procinfo.aktlocaldata.concat(tai_align.create(4));
+              current_procinfo.aktlocaldata.concat(tai_label.create(lab));
+              current_procinfo.aktlocaldata.concat(newconst);
+              result:=lab;
+            end;
+
+          var
+            symtype: TAsmsymtype;
+            sym: string;
+            val: aint;
+          begin
+            case actasmtoken of
+              AS_INTNUM,
+              AS_ID:
+                begin
+                  BuildConstSymbolExpression(true,false,false,val,sym,symtype);
+
+                  if symtype=AT_NONE then
+                    sym:='';
+
+                  reference_reset(oper.opr.ref,4);
+                  oper.opr.ref.base:=NR_PC;
+                  oper.opr.ref.symbol:=GetConstLabel(sym,val);
+                end;
+            end;
+          end;
+
+
       var
         tempreg : tregister;
         ireg : tsuperregister;
@@ -741,6 +808,21 @@ Unit raarmgas;
               BuildConstantOperand(oper);
             end;
 
+          AS_EQUAL:
+            begin
+              case actopcode of
+                A_LDRBT,A_LDRB,A_LDR,A_LDRH,A_LDRSB,A_LDRSH,A_LDRT,
+                A_LDREX,A_LDREXB,A_LDREXD,A_LDREXH:
+                  begin
+                    consume(AS_EQUAL);
+                    oper.InitRef;
+                    BuildDirectRef;
+                  end;
+              else
+                Message(asmr_e_invalid_opcode_and_operand);
+              end;
+            end;
+
           (*
           AS_INTNUM,
           AS_MINUS,
@@ -961,6 +1043,7 @@ Unit raarmgas;
         hreg : tregister;
         flags : tspecialregflags;
       begin
+        hreg:=NR_NO;
         case actasmtoken of
           AS_REGISTER:
             begin

compiler/arm/rgcpu.pas

@@ -43,6 +43,8 @@ unit rgcpu;
        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;
+         function do_spill_replace(list : TAsmList;instr : taicpu;
+           orgreg : tsuperregister;const spilltemp : treference) : boolean;override;
          procedure add_constraints(reg:tregister);override;
          function  get_spill_subreg(r:tregister) : tsubregister;override;
        end;
@@ -92,7 +94,11 @@ unit rgcpu;
                   for hr := RS_R8 to RS_R15 do
                     add_edge(getsupreg(taicpu(p).oper[0]^.reg), hr);
                 end;
-              A_ADD:
+              A_ADD,
+              A_SUB,
+              A_AND,
+              A_BIC,
+              A_EOR:
                 begin
                   if taicpu(p).ops = 3 then
                     begin
@@ -121,6 +127,24 @@ unit rgcpu;
                         end;
                     end;
                 end;
+              A_MLA,
+              A_MLS,
+              A_MUL:
+                begin
+                  if (current_settings.cputype<cpu_armv6) and (taicpu(p).opcode<>A_MLS) then
+                    add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[1]^.reg));
+                   add_edge(getsupreg(taicpu(p).oper[0]^.reg),RS_R13);
+                   add_edge(getsupreg(taicpu(p).oper[0]^.reg),RS_R15);
+                   add_edge(getsupreg(taicpu(p).oper[1]^.reg),RS_R13);
+                   add_edge(getsupreg(taicpu(p).oper[1]^.reg),RS_R15);
+                   add_edge(getsupreg(taicpu(p).oper[2]^.reg),RS_R13);
+                   add_edge(getsupreg(taicpu(p).oper[2]^.reg),RS_R15);
+                   if taicpu(p).opcode<>A_MUL then
+                     begin
+                       add_edge(getsupreg(taicpu(p).oper[3]^.reg),RS_R13);
+                       add_edge(getsupreg(taicpu(p).oper[3]^.reg),RS_R15);
+                     end;
+                end;
               A_LDRB,
               A_STRB,
               A_STR,
@@ -165,7 +189,7 @@ unit rgcpu;
 
       { 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 current_settings.cputype in cpu_thumb then
+      if GenerateThumbCode then
         begin
           {$ifdef DEBUG_SPILLING}
           helplist.concat(tai_comment.create(strpnew('Spilling: Use a_load_const_reg to fix spill offset')));
@@ -222,7 +246,7 @@ unit rgcpu;
    function fix_spilling_offset(offset : ASizeInt) : boolean;
      begin
        result:=(abs(offset)>4095) or
-          ((current_settings.cputype in cpu_thumb) and ((offset<0) or (offset>1020)));
+          ((GenerateThumbCode) and ((offset<0) or (offset>1020)));
      end;
 
 
@@ -258,6 +282,61 @@ unit rgcpu;
       end;
 
 
+    function trgcpu.do_spill_replace(list:TAsmList;instr:taicpu;orgreg:tsuperregister;const spilltemp:treference):boolean;
+      var
+        b : byte;
+      begin
+        result:=false;
+        if abs(spilltemp.offset)>4095 then
+          exit;
+
+        { ldr can't set the flags }
+        if instr.oppostfix=PF_S then
+          exit;
+
+        if GenerateThumbCode and
+          (abs(spilltemp.offset)>1020) then
+          exit;
+
+        { Replace 'mov  dst,orgreg' with 'ldr  dst,spilltemp'
+          and     'mov  orgreg,src' with 'str  dst,spilltemp' }
+        with instr do
+          begin
+            if (opcode=A_MOV) and (ops=2) and (oper[1]^.typ=top_reg) and (oper[0]^.typ=top_reg) then
+              begin
+                if (getregtype(oper[0]^.reg)=regtype) and
+                   (get_alias(getsupreg(oper[0]^.reg))=orgreg) and
+                   (get_alias(getsupreg(oper[1]^.reg))<>orgreg) then
+                  begin
+                    { do not replace if we're on Thumb, ldr/str cannot be used with rX>r7 }
+                    if GenerateThumbCode and
+                       (getsupreg(oper[1]^.reg)>RS_R7) then
+                       exit;
+
+                    { str expects the register in oper[0] }
+                    instr.loadreg(0,oper[1]^.reg);
+                    instr.loadref(1,spilltemp);
+                    opcode:=A_STR;
+                    result:=true;
+                  end
+                else if (getregtype(oper[1]^.reg)=regtype) and
+                   (get_alias(getsupreg(oper[1]^.reg))=orgreg) and
+                   (get_alias(getsupreg(oper[0]^.reg))<>orgreg) then
+                  begin
+                    { do not replace if we're on Thumb, ldr/str cannot be used with rX>r7 }
+                    if GenerateThumbCode and
+                       (getsupreg(oper[0]^.reg)>RS_R7) then
+                       exit;
+
+                    instr.loadref(1,spilltemp);
+                    opcode:=A_LDR;
+                    result:=true;
+                  end;
+              end;
+          end;
+      end;
+
+
     procedure trgcpu.add_constraints(reg:tregister);
       var
         supreg,i : Tsuperregister;
@@ -486,16 +565,26 @@ unit rgcpu;
             case taicpu(p).opcode of
               A_MLA,
               A_MUL:
-                if current_settings.cputype<cpu_armv6 then
-                  add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[1]^.reg));
+                begin
+                  if current_settings.cputype<cpu_armv6 then
+                    add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[1]^.reg));
+                  add_edge(getsupreg(taicpu(p).oper[0]^.reg),RS_R15);
+                  add_edge(getsupreg(taicpu(p).oper[1]^.reg),RS_R15);
+                  add_edge(getsupreg(taicpu(p).oper[2]^.reg),RS_R15);
+                  if taicpu(p).opcode=A_MLA then
+                    add_edge(getsupreg(taicpu(p).oper[3]^.reg),RS_R15);
+                end;
               A_UMULL,
               A_UMLAL,
               A_SMULL,
               A_SMLAL:
                 begin
-                  add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[1]^.reg));
-                  add_edge(getsupreg(taicpu(p).oper[1]^.reg),getsupreg(taicpu(p).oper[2]^.reg));
-                  add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[2]^.reg));
+                  if current_settings.cputype<cpu_armv6 then
+                    begin
+                      add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[1]^.reg));
+                      add_edge(getsupreg(taicpu(p).oper[1]^.reg),getsupreg(taicpu(p).oper[2]^.reg));
+                      add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[2]^.reg));
+                    end;
                 end;
               A_LDRB,
               A_STRB,

compiler/arm/symcpu.pas

@@ -0,0 +1,215 @@
+{
+    Copyright (c) 2014 by Florian Klaempfl
+
+    Symbol table overrides for ARM
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit symcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  symtype,symdef,symsym,globtype;
+
+type
+  { defs }
+  tcpufiledef = class(tfiledef)
+  end;
+  tcpufiledefclass = class of tcpufiledef;
+
+  tcpuvariantdef = class(tvariantdef)
+  end;
+  tcpuvariantdefclass = class of tcpuvariantdef;
+
+  tcpuformaldef = class(tformaldef)
+  end;
+  tcpuformaldefclass = class of tcpuformaldef;
+
+  tcpuforwarddef = class(tforwarddef)
+  end;
+  tcpuforwarddefclass = class of tcpuforwarddef;
+
+  tcpuundefineddef = class(tundefineddef)
+  end;
+  tcpuundefineddefclass = class of tcpuundefineddef;
+
+  tcpuerrordef = class(terrordef)
+  end;
+  tcpuerrordefclass = class of tcpuerrordef;
+
+  tcpupointerdef = class(tpointerdef)
+  end;
+  tcpupointerdefclass = class of tcpupointerdef;
+
+  tcpurecorddef = class(trecorddef)
+  end;
+  tcpurecorddefclass = class of tcpurecorddef;
+
+  tcpuimplementedinterface = class(timplementedinterface)
+  end;
+  tcpuimplementedinterfaceclass = class of tcpuimplementedinterface;
+
+  tcpuobjectdef = class(tobjectdef)
+  end;
+  tcpuobjectdefclass = class of tcpuobjectdef;
+
+  tcpuclassrefdef = class(tclassrefdef)
+  end;
+  tcpuclassrefdefclass = class of tcpuclassrefdef;
+
+  tcpuarraydef = class(tarraydef)
+  end;
+  tcpuarraydefclass = class of tcpuarraydef;
+
+  tcpuorddef = class(torddef)
+  end;
+  tcpuorddefclass = class of tcpuorddef;
+
+  tcpufloatdef = class(tfloatdef)
+  end;
+  tcpufloatdefclass = class of tcpufloatdef;
+
+  tcpuprocvardef = class(tprocvardef)
+  end;
+  tcpuprocvardefclass = class of tcpuprocvardef;
+
+  tcpuprocdef = class(tprocdef)
+    { the arm paramanager might need to know the total size of the stackframe
+      to avoid cyclic unit dependencies or global variables, this infomatation is
+      stored in total_stackframe_size }
+    total_stackframe_size : aint;
+  end;
+  tcpuprocdefclass = class of tcpuprocdef;
+
+  tcpustringdef = class(tstringdef)
+  end;
+  tcpustringdefclass = class of tcpustringdef;
+
+  tcpuenumdef = class(tenumdef)
+  end;
+  tcpuenumdefclass = class of tcpuenumdef;
+
+  tcpusetdef = class(tsetdef)
+  end;
+  tcpusetdefclass = class of tcpusetdef;
+
+  { syms }
+  tcpulabelsym = class(tlabelsym)
+  end;
+  tcpulabelsymclass = class of tcpulabelsym;
+
+  tcpuunitsym = class(tunitsym)
+  end;
+  tcpuunitsymclass = class of tcpuunitsym;
+
+  tcpunamespacesym = class(tnamespacesym)
+  end;
+  tcpunamespacesymclass = class of tcpunamespacesym;
+
+  tcpuprocsym = class(tprocsym)
+  end;
+  tcpuprocsymclass = class of tcpuprocsym;
+
+  tcputypesym = class(ttypesym)
+  end;
+  tcpuypesymclass = class of tcputypesym;
+
+  tcpufieldvarsym = class(tfieldvarsym)
+  end;
+  tcpufieldvarsymclass = class of tcpufieldvarsym;
+
+  tcpulocalvarsym = class(tlocalvarsym)
+  end;
+  tcpulocalvarsymclass = class of tcpulocalvarsym;
+
+  tcpuparavarsym = class(tparavarsym)
+  end;
+  tcpuparavarsymclass = class of tcpuparavarsym;
+
+  tcpustaticvarsym = class(tstaticvarsym)
+  end;
+  tcpustaticvarsymclass = class of tcpustaticvarsym;
+
+  tcpuabsolutevarsym = class(tabsolutevarsym)
+  end;
+  tcpuabsolutevarsymclass = class of tcpuabsolutevarsym;
+
+  tcpupropertysym = class(tpropertysym)
+  end;
+  tcpupropertysymclass = class of tcpupropertysym;
+
+  tcpuconstsym = class(tconstsym)
+  end;
+  tcpuconstsymclass = class of tcpuconstsym;
+
+  tcpuenumsym = class(tenumsym)
+  end;
+  tcpuenumsymclass = class of tcpuenumsym;
+
+  tcpusyssym = class(tsyssym)
+  end;
+  tcpusyssymclass = class of tcpusyssym;
+
+
+const
+  pbestrealtype : ^tdef = @s64floattype;
+
+
+implementation
+
+begin
+  { used tdef classes }
+  cfiledef:=tcpufiledef;
+  cvariantdef:=tcpuvariantdef;
+  cformaldef:=tcpuformaldef;
+  cforwarddef:=tcpuforwarddef;
+  cundefineddef:=tcpuundefineddef;
+  cerrordef:=tcpuerrordef;
+  cpointerdef:=tcpupointerdef;
+  crecorddef:=tcpurecorddef;
+  cimplementedinterface:=tcpuimplementedinterface;
+  cobjectdef:=tcpuobjectdef;
+  cclassrefdef:=tcpuclassrefdef;
+  carraydef:=tcpuarraydef;
+  corddef:=tcpuorddef;
+  cfloatdef:=tcpufloatdef;
+  cprocvardef:=tcpuprocvardef;
+  cprocdef:=tcpuprocdef;
+  cstringdef:=tcpustringdef;
+  cenumdef:=tcpuenumdef;
+  csetdef:=tcpusetdef;
+
+  { used tsym classes }
+  clabelsym:=tcpulabelsym;
+  cunitsym:=tcpuunitsym;
+  cnamespacesym:=tcpunamespacesym;
+  cprocsym:=tcpuprocsym;
+  ctypesym:=tcputypesym;
+  cfieldvarsym:=tcpufieldvarsym;
+  clocalvarsym:=tcpulocalvarsym;
+  cparavarsym:=tcpuparavarsym;
+  cstaticvarsym:=tcpustaticvarsym;
+  cabsolutevarsym:=tcpuabsolutevarsym;
+  cpropertysym:=tcpupropertysym;
+  cconstsym:=tcpuconstsym;
+  cenumsym:=tcpuenumsym;
+  csyssym:=tcpusyssym;
+end.
+

compiler/assemble.pas

@@ -42,7 +42,7 @@ interface
        AsmOutSize=32768*4;
 
     type
-      TAssembler=class(TAbstractAssembler)
+      TAssembler=class(TObject)
       public
       {filenames}
         path        : TPathStr;
@@ -295,9 +295,9 @@ Implementation
 
         procedure DeleteFilesWithExt(const AExt:string);
         var
-          dir : TSearchRec;
+          dir : TRawByteSearchRec;
         begin
-          if findfirst(s+source_info.dirsep+'*'+AExt,faAnyFile,dir) = 0 then
+          if findfirst(FixPath(s,false)+'*'+AExt,faAnyFile,dir) = 0 then
             begin
               repeat
                 DeleteFile(s+source_info.dirsep+dir.name);
@@ -373,7 +373,10 @@ Implementation
         result:=true;
         if (cs_asm_extern in current_settings.globalswitches) then
           begin
-            AsmRes.AddAsmCommand(command,para,name);
+            if SmartAsm then
+              AsmRes.AddAsmCommand(command,para,Name+'('+TosTr(SmartFilesCount)+')')
+            else
+              AsmRes.AddAsmCommand(command,para,name);
             exit;
           end;
         try
@@ -580,31 +583,6 @@ Implementation
     function TExternalAssembler.MakeCmdLine: TCmdStr;
       begin
         result:=target_asm.asmcmd;
-{$ifdef m68k}
-        { TODO: use a better approach for this }
-        if (target_info.system=system_m68k_amiga) then
-          begin
-            { m68k-amiga has old binutils, which doesn't support -march=* }
-            case current_settings.cputype of
-              cpu_MC68000:
-                result:='-m68000 '+result;
-              cpu_MC68020:
-                result:='-m68020 '+result;
-              { additionally, AmigaOS doesn't work on Coldfire }
-            end;
-          end
-        else
-          begin
-            case current_settings.cputype of
-              cpu_MC68000:
-                result:='-march=68000 '+result;
-              cpu_MC68020:
-                result:='-march=68020 '+result;
-              cpu_Coldfire:
-                result:='-march=cfv4e '+result;
-            end;
-          end;
-{$endif}
 {$ifdef arm}
         if (target_info.system=system_arm_darwin) then
           Replace(result,'$ARCH',lower(cputypestr[current_settings.cputype]));
@@ -632,13 +610,36 @@ Implementation
            Replace(result,'$NOWARN','')
          else
            Replace(result,'$NOWARN','-W');
+         Replace(result,'$EXTRAOPT',asmextraopt);
       end;
 
 
     procedure TExternalAssembler.AsmCreate(Aplace:tcutplace);
+{$ifdef hasamiga}
+      var
+        tempFileName: TPathStr;
+{$endif}
       begin
         if SmartAsm then
          NextSmartName(Aplace);
+{$ifdef hasamiga}
+        { on Amiga/MorphOS try to redirect .s files to the T: assign, which is
+          for temp files, and usually (default setting) located in the RAM: drive.
+          This highly improves assembling speed for complex projects like the
+          compiler itself, especially on hardware with slow disk I/O.
+          Consider this as a poor man's pipe on Amiga, because real pipe handling
+          would be much more complex and error prone to implement. (KB) }
+        if (([cs_asm_extern,cs_asm_leave,cs_link_on_target] * current_settings.globalswitches) = []) then
+         begin
+          { try to have an unique name for the .s file }
+          tempFileName:=HexStr(GetProcessID shr 4,7)+ExtractFileName(AsmFileName);
+{$ifndef morphos}
+          { old Amiga RAM: handler only allows filenames up to 30 char }
+          if Length(tempFileName) < 30 then
+{$endif}
+          AsmFileName:='T:'+tempFileName;
+         end;
+{$endif}
 {$ifdef hasunix}
         if DoPipe then
          begin
@@ -917,7 +918,6 @@ Implementation
                   move(pstart^,hs[1],len);
                   hs[0]:=chr(len);
                   sym:=objdata.symbolref(hs);
-                  have_first_symbol:=true;
                   { Second symbol? }
                   if assigned(relocsym) then
                     begin
@@ -1384,6 +1384,8 @@ Implementation
         relative_reloc: boolean;
       begin
         fillchar(zerobuf,sizeof(zerobuf),0);
+        fillchar(objsym,sizeof(objsym),0);
+        fillchar(objsymend,sizeof(objsymend),0);
         { main loop }
         while assigned(hp) do
          begin
@@ -1487,6 +1489,8 @@ Implementation
                        { Required for DWARF2 support under Windows }
                        ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_SECREL32);
                      end;
+                   aitconst_gotoff_symbol:
+                     ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_GOTOFF);
                    aitconst_uleb128bit,
                    aitconst_sleb128bit :
                      begin

compiler/avr/aasmcpu.pas

@@ -246,12 +246,16 @@ implementation
       begin
         result:=operand_read;
         case opcode of
+          A_CLR,
+          A_MOV, A_MOVW:
+           if opnr=0 then
+             result:=operand_write;
           A_CP,A_CPC,A_CPI,A_PUSH :
             ;
           else
             begin
               if opnr=0 then
-                result:=operand_write;
+                result:=operand_readwrite;
             end;
         end;
       end;
@@ -416,6 +420,8 @@ implementation
                       end;
                     ait_align:
                       inc(CurrOffset,tai_align(curtai).aligntype);
+                    ait_weak,
+                    ait_set,
                     ait_marker:
                       ;
                     ait_label:

compiler/avr/agavrgas.pas

@@ -81,6 +81,7 @@ unit agavrgas;
         var
           s : string;
         begin
+           s:='';
            with ref do
             begin
   {$ifdef extdebug}
@@ -95,9 +96,8 @@ unit agavrgas;
               else if base<>NR_NO then
                 begin
                   if addressmode=AM_PREDRECEMENT then
-                    s:='-'
-                  else
-                    s:='';
+                    s:='-';
+
                   case base of
                     NR_R26:
                       s:=s+'X';
@@ -119,9 +119,7 @@ unit agavrgas;
               else if assigned(symbol) or (offset<>0) then
                 begin
                   if assigned(symbol) then
-                    s:=ReplaceForbiddenAsmSymbolChars(symbol.name)
-                  else
-                     s:='';
+                    s:=ReplaceForbiddenAsmSymbolChars(symbol.name);
 
                   if offset<0 then
                     s:=s+tostr(offset)
@@ -203,7 +201,7 @@ unit agavrgas;
 
             idtxt  : 'AS';
             asmbin : 'as';
-            asmcmd : '-o $OBJ $ASM';
+            asmcmd : '-o $OBJ $EXTRAOPT $ASM';
             supported_targets : [system_avr_embedded];
             flags : [af_needar,af_smartlink_sections];
             labelprefix : '.L';

compiler/avr/aoptcpu.pas

@@ -28,10 +28,12 @@ Unit aoptcpu;
 
 Interface
 
-uses cpubase, aasmtai, aopt, aoptcpub;
+uses cpubase, cgbase, aasmtai, aopt, aoptcpub;
 
 Type
   TCpuAsmOptimizer = class(TAsmOptimizer)
+    Function GetNextInstructionUsingReg(Current: tai; Var Next: tai;reg : TRegister): Boolean;
+
     { uses the same constructor as TAopObj }
     function PeepHoleOptPass1Cpu(var p: tai): boolean; override;
     procedure PeepHoleOptPass2;override;
@@ -40,7 +42,9 @@ Type
 Implementation
 
   uses
-    aasmbase,aasmcpu,cgbase;
+    cpuinfo,
+    aasmbase,aasmcpu,
+    globals,globtype;
 
   function CanBeCond(p : tai) : boolean;
     begin
@@ -48,40 +52,255 @@ Implementation
     end;
 
 
+  function TCpuAsmOptimizer.GetNextInstructionUsingReg(Current: tai;
+    var Next: tai; reg: TRegister): Boolean;
+    begin
+      Next:=Current;
+      repeat
+        Result:=GetNextInstruction(Next,Next);
+      until not(cs_opt_level3 in current_settings.optimizerswitches) or not(Result) or (Next.typ<>ait_instruction) or (RegInInstruction(reg,Next)) or
+        (is_calljmp(taicpu(Next).opcode));
+    end;
+
+
   function TCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean;
     var
-      next1: tai;
+      hp1,hp2,hp3: tai;
+      alloc, dealloc: tai_regalloc;
+      i: integer;
     begin
       result := false;
       case p.typ of
         ait_instruction:
           begin
             case taicpu(p).opcode of
+              A_LDI:
+                begin
+                  { turn
+                    ldi reg0, imm
+                    cp reg1, reg0
+                    dealloc reg0
+                    into
+                    cpi reg1, imm
+                  }
+                  if (taicpu(p).ops=2) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     (taicpu(p).oper[1]^.typ=top_const) and
+                     GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
+                     (not RegModifiedBetween(taicpu(p).oper[0]^.reg, p, hp1)) and
+                     (taicpu(hp1).opcode=A_CP) and
+                     (taicpu(hp1).ops=2) and
+                     (taicpu(hp1).oper[1]^.typ=top_reg) and
+                     (getsupreg(taicpu(hp1).oper[0]^.reg) in [16..31]) and
+                     (taicpu(hp1).oper[1]^.reg=taicpu(p).oper[0]^.reg) and
+                     assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next))) then
+                    begin
+                      taicpu(hp1).opcode:=A_CPI;
+                      taicpu(hp1).loadconst(1, taicpu(p).oper[1]^.val);
+
+                      alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.Previous));
+                      dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next));
+
+                      if assigned(alloc) and assigned(dealloc) then
+                        begin
+                          asml.Remove(alloc);
+                          alloc.Free;
+                          asml.Remove(dealloc);
+                          dealloc.Free;
+                        end;
+
+                      GetNextInstruction(p,hp1);
+                      asml.Remove(p);
+                      p.Free;
+                      p:=hp1;
+
+                      result:=true;
+                    end;
+                end;
+              A_CLR:
+                begin
+                  { turn the common
+                    clr rX
+                    mov/ld rX, rY
+                    into
+                    mov/ld rX, rY
+                  }
+                  if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
+                     (not RegModifiedBetween(taicpu(p).oper[0]^.reg, p, hp1)) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode in [A_MOV,A_LD]) and
+                     (taicpu(hp1).ops>0) and
+                     (taicpu(hp1).oper[0]^.typ=top_reg) and
+                     (taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg) then
+                    begin
+                      asml.Remove(p);
+                      p.Free;
+                      p:=hp1;
+                      result:=true;
+                    end
+                  { turn
+                    clr rX
+                    ...
+                    adc rY, rX
+                    into
+                    ...
+                    adc rY, r1
+                  }
+                  else if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
+                     (not RegModifiedBetween(taicpu(p).oper[0]^.reg, p, hp1)) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode in [A_ADC,A_SBC]) and
+                     (taicpu(hp1).ops=2) and
+                     (taicpu(hp1).oper[1]^.typ=top_reg) and
+                     (taicpu(hp1).oper[1]^.reg=taicpu(p).oper[0]^.reg) and
+                     (taicpu(hp1).oper[0]^.reg<>taicpu(p).oper[0]^.reg) and
+                     assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next))) then
+                    begin
+                      taicpu(hp1).oper[1]^.reg:=NR_R1;
+
+                      alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.Previous));
+                      dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next));
+
+                      if assigned(alloc) and assigned(dealloc) then
+                        begin
+                          asml.Remove(alloc);
+                          alloc.Free;
+                          asml.Remove(dealloc);
+                          dealloc.Free;
+                        end;
+
+                      GetNextInstruction(p,hp1);
+                      asml.Remove(p);
+                      p.free;
+                      p:=hp1;
+
+                      result:=true;
+                    end;
+                end;
+              A_PUSH:
+                begin
+                  { turn
+                    push reg0
+                    push reg1
+                    pop reg3
+                    pop reg2
+                    into
+                    movw reg2,reg0
+                  }
+                  if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     GetNextInstruction(p,hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode=A_PUSH) and
+                     (getsupreg(taicpu(hp1).oper[0]^.reg)=getsupreg(taicpu(p).oper[0]^.reg)+1) and
+                     ((getsupreg(taicpu(p).oper[0]^.reg) mod 2)=0) and
+
+                     GetNextInstruction(hp1,hp2) and
+                     (hp2.typ=ait_instruction) and
+                     (taicpu(hp2).opcode=A_POP) and
+
+                     GetNextInstruction(hp2,hp3) and
+                     (hp3.typ=ait_instruction) and
+                     (taicpu(hp3).opcode=A_POP) and
+                     (getsupreg(taicpu(hp2).oper[0]^.reg)=getsupreg(taicpu(hp3).oper[0]^.reg)+1) and
+                     ((getsupreg(taicpu(hp3).oper[0]^.reg) mod 2)=0) then
+                    begin
+                      taicpu(p).ops:=2;
+                      taicpu(p).opcode:=A_MOVW;
+
+                      taicpu(p).loadreg(1, taicpu(p).oper[0]^.reg);
+                      taicpu(p).loadreg(0, taicpu(hp3).oper[0]^.reg);
+
+                      asml.Remove(hp1);
+                      hp1.Free;
+                      asml.Remove(hp2);
+                      hp2.Free;
+                      asml.Remove(hp3);
+                      hp3.Free;
+
+                      result:=true;
+                    end;
+                end;
               A_MOV:
                 begin
+                  { turn
+                    mov reg0, reg1
+                    push reg0
+                    dealloc reg0
+                    into
+                    push reg1
+                  }
+                  if (taicpu(p).ops=2) and
+                     (taicpu(p).oper[0]^.typ = top_reg) and
+                     (taicpu(p).oper[1]^.typ = top_reg) and
+                     GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+                     (not RegModifiedBetween(taicpu(p).oper[0]^.reg, p, hp1)) and
+                     (hp1.typ = ait_instruction) and
+                     (taicpu(hp1).opcode in [A_PUSH,A_MOV,A_CP,A_CPC,A_ADD,A_SUB,A_EOR,A_AND,A_OR]) and
+                     RegInInstruction(taicpu(p).oper[0]^.reg, hp1) and
+                     (not RegModifiedByInstruction(taicpu(p).oper[0]^.reg, hp1)) and
+                     {(taicpu(hp1).ops=1) and
+                     (taicpu(hp1).oper[0]^.typ = top_reg) and
+                     (taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg) and  }
+                     assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next))) then
+                    begin
+                      for i := 0 to taicpu(hp1).ops-1 do
+                        if taicpu(hp1).oper[i]^.typ=top_reg then
+                          if taicpu(hp1).oper[i]^.reg=taicpu(p).oper[0]^.reg then
+                            taicpu(hp1).oper[i]^.reg:=taicpu(p).oper[1]^.reg;
+
+                      alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.Previous));
+                      dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next));
+
+                      if assigned(alloc) and assigned(dealloc) then
+                        begin
+                          asml.Remove(alloc);
+                          alloc.Free;
+                          asml.Remove(dealloc);
+                          dealloc.Free;
+                        end;
+
+                      GetNextInstruction(p,hp1);
+                      asml.Remove(p);
+                      p.free;
+                      p:=hp1;
+                      result:=true;
+                    end
                   { fold
                     mov reg2,reg0
                     mov reg3,reg1
                     to
                     movw reg2,reg0
                   }
-                  if (taicpu(p).ops=2) and
+                  else if (CPUAVR_HAS_MOVW in cpu_capabilities[current_settings.cputype]) and
+                     (taicpu(p).ops=2) and
                      (taicpu(p).oper[0]^.typ = top_reg) and
                      (taicpu(p).oper[1]^.typ = top_reg) and
-                     getnextinstruction(p,next1) and
-                     (next1.typ = ait_instruction) and
-                     (taicpu(next1).opcode = A_MOV) and
-                     (taicpu(next1).ops=2) and
-                     (taicpu(next1).oper[0]^.typ = top_reg) and
-                     (taicpu(next1).oper[1]^.typ = top_reg) and
-                     (getsupreg(taicpu(next1).oper[0]^.reg)=getsupreg(taicpu(p).oper[0]^.reg)+1) and
+                     getnextinstruction(p,hp1) and
+                     (hp1.typ = ait_instruction) and
+                     (taicpu(hp1).opcode = A_MOV) and
+                     (taicpu(hp1).ops=2) and
+                     (taicpu(hp1).oper[0]^.typ = top_reg) and
+                     (taicpu(hp1).oper[1]^.typ = top_reg) and
+                     (getsupreg(taicpu(hp1).oper[0]^.reg)=getsupreg(taicpu(p).oper[0]^.reg)+1) and
                      ((getsupreg(taicpu(p).oper[0]^.reg) mod 2)=0) and
                      ((getsupreg(taicpu(p).oper[1]^.reg) mod 2)=0) and
-                     (getsupreg(taicpu(next1).oper[1]^.reg)=getsupreg(taicpu(p).oper[1]^.reg)+1) then
+                     (getsupreg(taicpu(hp1).oper[1]^.reg)=getsupreg(taicpu(p).oper[1]^.reg)+1) then
                     begin
+                      alloc:=FindRegAllocBackward(taicpu(hp1).oper[0]^.reg,tai(hp1.Previous));
+                      if assigned(alloc) then
+                        begin
+                          asml.Remove(alloc);
+                          asml.InsertBefore(alloc,p);
+                        end;
+
                       taicpu(p).opcode:=A_MOVW;
-                      asml.remove(next1);
-                      next1.free;
+                      asml.remove(hp1);
+                      hp1.free;
                       result := true;
                     end;
                 end;

compiler/avr/aoptcpub.pas

@@ -36,7 +36,10 @@ Unit aoptcpub; { Assembler OPTimizer CPU specific Base }
 Interface
 
 Uses
-  cpubase,aasmcpu,AOptBase;
+  cpubase,
+  cgbase,
+  aasmcpu,aasmtai,
+  AOptBase;
 
 Type
 
@@ -58,6 +61,7 @@ Type
 { ************************************************************************* }
 
   TAoptBaseCpu = class(TAoptBase)
+    function RegModifiedByInstruction(Reg: TRegister; p1: tai): boolean; override;
   End;
 
 
@@ -103,12 +107,26 @@ Implementation
 { ************************************************************************* }
 { **************************** TCondRegs ********************************** }
 { ************************************************************************* }
-Constructor TCondRegs.init;
-Begin
-End;
-
-Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl}
-Begin
-End;
+  Constructor TCondRegs.init;
+    Begin
+    End;
+
+  Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl}
+    Begin
+    End;
+
+
+  function TAoptBaseCpu.RegModifiedByInstruction(Reg: TRegister; p1: tai): boolean;
+    var
+      i : Longint;
+    begin
+      result:=false;
+      for i:=0 to taicpu(p1).ops-1 do
+        if (taicpu(p1).oper[i]^.typ=top_reg) and (taicpu(p1).oper[i]^.reg=Reg) and (taicpu(p1).spilling_get_operation_type(i) in [operand_write,operand_readwrite]) then
+          begin
+            result:=true;
+            exit;
+          end;
+    end;
 
 End.

compiler/avr/cgcpu.pas

@@ -50,10 +50,10 @@ unit cgcpu;
         procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const paraloc : TCGPara);override;
         procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);override;
         procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara);override;
+        procedure a_load_reg_cgpara(list : TAsmList; size : tcgsize;r : tregister; const cgpara : tcgpara);override;
 
         procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
         procedure a_call_reg(list : TAsmList;reg: tregister);override;
-        procedure a_call_ref(list : TAsmList;ref: treference);override;
 
         procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); override;
         procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: TCGSize; src, dst : TRegister); override;
@@ -99,14 +99,12 @@ unit cgcpu;
           tmpreg : tregister) : treference;
 
         procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
-        procedure g_stackpointer_alloc(list : TAsmList;size : longint);override;
         procedure emit_mov(list: TAsmList;reg2: tregister; reg1: tregister);
 
         procedure a_adjust_sp(list: TAsmList; value: longint);
         function GetLoad(const ref : treference) : tasmop;
         function GetStore(const ref: treference): tasmop;
 
-        procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override;
       protected
         procedure a_op_reg_reg_internal(list: TAsmList; Op: TOpCG; size: TCGSize; src, srchi, dst, dsthi: TRegister);
         procedure a_op_const_reg_internal(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg, reghi: TRegister);
@@ -205,25 +203,138 @@ unit cgcpu;
       end;
 
 
+    procedure tcgavr.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);
+
+      procedure load_para_loc(r : TRegister;paraloc : PCGParaLocation);
+        var
+          ref : treference;
+        begin
+          paramanager.allocparaloc(list,paraloc);
+          case paraloc^.loc of
+             LOC_REGISTER,LOC_CREGISTER:
+               a_load_reg_reg(list,paraloc^.size,paraloc^.size,r,paraloc^.register);
+             LOC_REFERENCE,LOC_CREFERENCE:
+               begin
+                  reference_reset_base(ref,paraloc^.reference.index,paraloc^.reference.offset,2);
+                  a_load_reg_ref(list,paraloc^.size,paraloc^.size,r,ref);
+               end;
+             else
+               internalerror(2002071004);
+          end;
+        end;
+
+      var
+        i, i2 : longint;
+        hp : PCGParaLocation;
+
+      begin
+{        if use_push(cgpara) then
+          begin
+            if tcgsize2size[cgpara.Size] > 2 then
+              begin
+                if tcgsize2size[cgpara.Size] <> 4 then
+                  internalerror(2013031101);
+                if cgpara.location^.Next = nil then
+                  begin
+                    if tcgsize2size[cgpara.location^.size] <> 4 then
+                      internalerror(2013031101);
+                  end
+                else
+                  begin
+                    if tcgsize2size[cgpara.location^.size] <> 2 then
+                      internalerror(2013031101);
+                    if tcgsize2size[cgpara.location^.Next^.size] <> 2 then
+                      internalerror(2013031101);
+                    if cgpara.location^.Next^.Next <> nil then
+                      internalerror(2013031101);
+                  end;
+
+                if tcgsize2size[cgpara.size]>cgpara.alignment then
+                  pushsize:=cgpara.size
+                else
+                  pushsize:=int_cgsize(cgpara.alignment);
+                pushsize2 := int_cgsize(tcgsize2size[pushsize] - 2);
+                list.concat(taicpu.op_reg(A_PUSH,TCgsize2opsize[pushsize2],makeregsize(list,GetNextReg(r),pushsize2)));
+                list.concat(taicpu.op_reg(A_PUSH,S_W,makeregsize(list,r,OS_16)));
+              end
+            else
+              begin
+                cgpara.check_simple_location;
+                if tcgsize2size[cgpara.location^.size]>cgpara.alignment then
+                  pushsize:=cgpara.location^.size
+                else
+                  pushsize:=int_cgsize(cgpara.alignment);
+                list.concat(taicpu.op_reg(A_PUSH,TCgsize2opsize[pushsize],makeregsize(list,r,pushsize)));
+              end;
+
+          end
+        else }
+          begin
+            if not(tcgsize2size[cgpara.Size] in [1..4]) then
+              internalerror(2014011101);
+
+            hp:=cgpara.location;
+
+            i:=0;
+            while i<tcgsize2size[cgpara.Size] do
+              begin
+                if not(assigned(hp)) then
+                  internalerror(2014011102);
+
+                inc(i, tcgsize2size[hp^.Size]);
+
+                if hp^.Loc=LOC_REGISTER then
+                  begin
+                    load_para_loc(r,hp);
+                    hp:=hp^.Next;
+                    r:=GetNextReg(r);
+                  end
+                else
+                  begin
+                    load_para_loc(r,hp);
+
+                    for i2:=1 to tcgsize2size[hp^.Size] do
+                      r:=GetNextReg(r);
+
+                    hp:=hp^.Next;
+                  end;
+              end;
+            if assigned(hp) then
+              internalerror(2014011103);
+          end;
+      end;
+
+
     procedure tcgavr.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const paraloc : TCGPara);
       var
-        ref: treference;
+        i : longint;
+        hp : PCGParaLocation;
       begin
-        paraloc.check_simple_location;
-        paramanager.allocparaloc(list,paraloc.location);
-        case paraloc.location^.loc of
-          LOC_REGISTER,LOC_CREGISTER:
-            a_load_const_reg(list,size,a,paraloc.location^.register);
-          LOC_REFERENCE:
-            begin
-               reference_reset(ref,paraloc.alignment);
-               ref.base:=paraloc.location^.reference.index;
-               ref.offset:=paraloc.location^.reference.offset;
-               a_load_const_ref(list,size,a,ref);
+        if not(tcgsize2size[paraloc.Size] in [1..4]) then
+          internalerror(2014011101);
+
+        hp:=paraloc.location;
+
+        for i:=1 to tcgsize2size[paraloc.Size] do
+          begin
+            if not(assigned(hp)) or
+              (tcgsize2size[hp^.size]<>1) or
+              (hp^.shiftval<>0) then
+              internalerror(2014011105);
+             case hp^.loc of
+               LOC_REGISTER,LOC_CREGISTER:
+                 a_load_const_reg(list,hp^.size,(a shr (i-1)) and $ff,hp^.register);
+               LOC_REFERENCE,LOC_CREFERENCE:
+                 begin
+                   list.concat(taicpu.op_const(A_PUSH,(a shr (i-1)) and $ff));
+                 end;
+               else
+                 internalerror(2002071004);
             end;
-          else
-            internalerror(2002081101);
-        end;
+            hp:=hp^.Next;
+          end;
+        if assigned(hp) then
+          internalerror(2014011104);
       end;
 
 
@@ -271,26 +382,11 @@ unit cgcpu;
 
     procedure tcgavr.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara);
       var
-        ref: treference;
         tmpreg: tregister;
       begin
-        paraloc.check_simple_location;
-        paramanager.allocparaloc(list,paraloc.location);
-        case paraloc.location^.loc of
-          LOC_REGISTER,LOC_CREGISTER:
-            a_loadaddr_ref_reg(list,r,paraloc.location^.register);
-          LOC_REFERENCE:
-            begin
-              reference_reset(ref,paraloc.alignment);
-              ref.base := paraloc.location^.reference.index;
-              ref.offset := paraloc.location^.reference.offset;
-              tmpreg := getintregister(list,OS_ADDR);
-              a_loadaddr_ref_reg(list,r,tmpreg);
-              a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
-            end;
-          else
-            internalerror(2002080701);
-        end;
+        tmpreg:=getaddressregister(list);
+        a_loadaddr_ref_reg(list,r,tmpreg);
+        a_load_reg_cgpara(list,OS_ADDR,tmpreg,paraloc);
       end;
 
 
@@ -321,19 +417,6 @@ unit cgcpu;
       end;
 
 
-    procedure tcgavr.a_call_ref(list : TAsmList;ref: treference);
-      begin
-        a_reg_alloc(list,NR_ZLO);
-        a_reg_alloc(list,NR_ZHI);
-        a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,NR_ZLO);
-        list.concat(taicpu.op_none(A_ICALL));
-        a_reg_dealloc(list,NR_ZLO);
-        a_reg_dealloc(list,NR_ZHI);
-
-        include(current_procinfo.flags,pi_do_call);
-      end;
-
-
      procedure tcgavr.a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister);
        begin
          if not(size in [OS_S8,OS_8,OS_S16,OS_16,OS_S32,OS_32]) then
@@ -414,7 +497,15 @@ unit cgcpu;
            OP_NEG:
              begin
                if src<>dst then
-                 a_load_reg_reg(list,size,size,src,dst);
+                 begin
+                   if size in [OS_S64,OS_64] then
+                     begin
+                       a_load_reg_reg(list,OS_32,OS_32,src,dst);
+                       a_load_reg_reg(list,OS_32,OS_32,srchi,dsthi);
+                     end
+                   else
+                     a_load_reg_reg(list,size,size,src,dst);
+                 end;
 
                if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then
                  begin
@@ -428,7 +519,7 @@ unit cgcpu;
                    tmpreg:=GetNextReg(dst);
                    for i:=2 to tcgsize2size[size] do
                      begin
-                       list.concat(taicpu.op_reg_const(A_SBCI,dst,-1));
+                       list.concat(taicpu.op_reg_const(A_SBCI,tmpreg,-1));
                        NextTmp;
                    end;
                  end;
@@ -488,7 +579,7 @@ unit cgcpu;
                current_asmdata.getjumplabel(l2);
                countreg:=getintregister(list,OS_8);
                a_load_reg_reg(list,size,OS_8,src,countreg);
-               list.concat(taicpu.op_reg_const(A_CP,countreg,0));
+               list.concat(taicpu.op_reg_const(A_CPI,countreg,0));
                a_jmp_flags(list,F_EQ,l2);
                cg.a_label(list,l1);
                case op of
@@ -606,7 +697,7 @@ unit cgcpu;
              end;
            OP_SUB:
              begin
-               list.concat(taicpu.op_reg_const(A_SUBI,reg,a));
+               list.concat(taicpu.op_reg_const(A_SUBI,reg,a and mask));
                if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then
                  begin
                    for i:=2 to tcgsize2size[size] do
@@ -618,6 +709,20 @@ unit cgcpu;
                      end;
                  end;
              end;
+           {OP_ADD:
+             begin
+               list.concat(taicpu.op_reg_const(A_SUBI,reg,(-a) and mask));
+               if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then
+                 begin
+                   for i:=2 to tcgsize2size[size] do
+                     begin
+                       NextReg;
+                       mask:=mask shl 8;
+                       inc(shift,8);
+                       list.concat(taicpu.op_reg_const(A_ADC,reg,(a and mask) shr shift));
+                     end;
+                 end;
+             end; }
          else
            begin
              if size in [OS_64,OS_S64] then
@@ -716,11 +821,11 @@ unit cgcpu;
         else if (ref.base<>NR_NO) and (ref.index<>NR_NO) then
           begin
             maybegetcpuregister(list,tmpreg);
-            emit_mov(list,tmpreg,ref.index);
+            emit_mov(list,tmpreg,ref.base);
             maybegetcpuregister(list,GetNextReg(tmpreg));
-            emit_mov(list,GetNextReg(tmpreg),GetNextReg(ref.index));
-            list.concat(taicpu.op_reg_reg(A_ADD,tmpreg,ref.base));
-            list.concat(taicpu.op_reg_reg(A_ADC,GetNextReg(tmpreg),GetNextReg(ref.base)));
+            emit_mov(list,GetNextReg(tmpreg),GetNextReg(ref.base));
+            list.concat(taicpu.op_reg_reg(A_ADD,tmpreg,ref.index));
+            list.concat(taicpu.op_reg_reg(A_ADC,GetNextReg(tmpreg),GetNextReg(ref.index)));
             ref.base:=tmpreg;
             ref.index:=NR_NO;
           end
@@ -1175,6 +1280,7 @@ unit cgcpu;
       begin
         if a=0 then
           begin
+            swapped:=false;
             { swap parameters? }
             case cmp_op of
               OC_GT:
@@ -1195,7 +1301,7 @@ unit cgcpu;
               OC_A:
                 begin
                   swapped:=true;
-                  cmp_op:=OC_A;
+                  cmp_op:=OC_B;
                 end;
             end;
 
@@ -1227,6 +1333,7 @@ unit cgcpu;
         tmpreg : tregister;
         i : byte;
       begin
+        swapped:=false;
         { swap parameters? }
         case cmp_op of
           OC_GT:
@@ -1247,7 +1354,7 @@ unit cgcpu;
           OC_A:
             begin
               swapped:=true;
-              cmp_op:=OC_A;
+              cmp_op:=OC_B;
             end;
         end;
         if swapped then
@@ -1256,25 +1363,19 @@ unit cgcpu;
             reg1:=reg2;
             reg2:=tmpreg;
           end;
-        list.concat(taicpu.op_reg_reg(A_CP,reg1,reg2));
+        list.concat(taicpu.op_reg_reg(A_CP,reg2,reg1));
 
         for i:=2 to tcgsize2size[size] do
           begin
             reg1:=GetNextReg(reg1);
             reg2:=GetNextReg(reg2);
-            list.concat(taicpu.op_reg_reg(A_CPC,reg1,reg2));
+            list.concat(taicpu.op_reg_reg(A_CPC,reg2,reg1));
           end;
 
         a_jmp_cond(list,cmp_op,l);
       end;
 
 
-    procedure tcgavr.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister);
-      begin
-        Comment(V_Error,'tcgarm.a_bit_scan_reg_reg method not implemented');
-      end;
-
-
     procedure tcgavr.a_jmp_name(list : TAsmList;const s : string);
       var
         ai : taicpu;
@@ -1338,7 +1439,7 @@ unit cgcpu;
         case value of
           0:
             ;
-          -14..-1:
+          {-14..-1:
             begin
               if ((-value) mod 2)<>0 then
                 list.concat(taicpu.op_reg(A_PUSH,NR_R0));
@@ -1349,7 +1450,7 @@ unit cgcpu;
             begin
               for i:=1 to value do
                 list.concat(taicpu.op_reg(A_POP,NR_R0));
-            end;
+            end;}
           else
             begin
               list.concat(taicpu.op_reg_const(A_SUBI,NR_R28,lo(word(-value))));
@@ -1440,6 +1541,8 @@ unit cgcpu;
                 LocalSize:=current_procinfo.calc_stackframe_size;
                 a_adjust_sp(list,LocalSize);
                 regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall);
+                if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+                  regs:=regs+[RS_R28,RS_R29];
 
                 for reg:=RS_R0 to RS_R31 do
                   if reg in regs then
@@ -1772,15 +1875,9 @@ unit cgcpu;
       end;
 
 
-    procedure tcgavr.g_stackpointer_alloc(list: TAsmList; size: longint);
-      begin
-        internalerror(201201071);
-      end;
-
-
     procedure tcgavr.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
       begin
-        internalerror(2011021324);
+        //internalerror(2011021324);
       end;
 
 

compiler/avr/cpubase.pas

@@ -235,11 +235,11 @@ unit cpubase;
       }
       NR_PIC_OFFSET_REG = NR_R9;
       { Results are returned in this register (32-bit values) }
-      NR_FUNCTION_RETURN_REG = NR_R0;
-      RS_FUNCTION_RETURN_REG = RS_R0;
+      NR_FUNCTION_RETURN_REG = NR_R24;
+      RS_FUNCTION_RETURN_REG = RS_R24;
       { Low part of 64bit return value }
-      NR_FUNCTION_RETURN64_LOW_REG = NR_R0;
-      RS_FUNCTION_RETURN64_LOW_REG = RS_R0;
+      NR_FUNCTION_RETURN64_LOW_REG = NR_R22;
+      RS_FUNCTION_RETURN64_LOW_REG = RS_R22;
       { High part of 64bit return value }
       NR_FUNCTION_RETURN64_HIGH_REG = NR_R1;
       RS_FUNCTION_RETURN64_HIGH_REG = RS_R1;
@@ -290,6 +290,7 @@ unit cpubase;
       }
       std_param_align = 4;
 
+      saved_address_registers : array[0..0] of tsuperregister = (RS_INVALID);
       saved_mm_registers : array[0..0] of tsuperregister = (RS_INVALID);
 
 {*****************************************************************************
@@ -322,6 +323,8 @@ unit cpubase;
     { returns the register with the offset of ofs of a continuous set of register starting with r and being continued with rhi }
     function GetOffsetReg64(const r,rhi: TRegister;ofs : shortint): TRegister;
 
+    function is_calljmp(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
+
   implementation
 
     uses
@@ -475,4 +478,10 @@ unit cpubase;
       end;
 
 
+    function is_calljmp(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
+      begin
+        is_calljmp:= o in jmp_instructions;
+      end;
+
+
 end.

compiler/avr/cpuinfo.pas

@@ -100,6 +100,9 @@ Const
      'LIBGCC'
    );
 
+    { We know that there are fields after sramsize
+      but we don't care about this warning }
+   {$WARN 3177 OFF}
    embedded_controllers : array [tcontrollertype] of tcontrollerdatatype =
    ((
    	controllertypestr:'';
@@ -194,16 +197,16 @@ Const
  const
    cpu_capabilities : array[tcputype] of set of tcpuflags =
      ( { cpu_none } [],
-       { cpu_avr1 } [],
-       { cpu_avr2 } [],
-       { cpu_avr25 } [],
-       { cpu_avr3 } [],
-       { cpu_avr31 } [],
-       { cpu_avr35 } [],
-       { cpu_avr4 } [],
-       { cpu_avr5 } [],
-       { cpu_avr51 } [],
-       { cpu_avr6 } []
+       { cpu_avr1 } [CPUAVR_2_BYTE_PC],
+       { cpu_avr2 } [CPUAVR_2_BYTE_PC],
+       { cpu_avr25 } [CPUAVR_HAS_MOVW,CPUAVR_HAS_LPMX,CPUAVR_2_BYTE_PC],
+       { cpu_avr3 } [CPUAVR_HAS_JMP_CALL,CPUAVR_2_BYTE_PC],
+       { cpu_avr31 } [CPUAVR_HAS_JMP_CALL,CPUAVR_HAS_RAMPZ,CPUAVR_HAS_ELPM,CPUAVR_2_BYTE_PC],
+       { cpu_avr35 } [CPUAVR_HAS_JMP_CALL,CPUAVR_HAS_MOVW,CPUAVR_HAS_LPMX,CPUAVR_2_BYTE_PC],
+       { cpu_avr4 } [CPUAVR_HAS_MOVW,CPUAVR_HAS_LPMX,CPUAVR_HAS_MUL,CPUAVR_2_BYTE_PC],
+       { cpu_avr5 } [CPUAVR_HAS_JMP_CALL,CPUAVR_HAS_MOVW,CPUAVR_HAS_LPMX,CPUAVR_HAS_MUL,CPUAVR_2_BYTE_PC],
+       { cpu_avr51 } [CPUAVR_HAS_JMP_CALL,CPUAVR_HAS_MOVW,CPUAVR_HAS_LPMX,CPUAVR_HAS_MUL,CPUAVR_HAS_RAMPZ,CPUAVR_HAS_ELPM,CPUAVR_HAS_ELPMX,CPUAVR_2_BYTE_PC],
+       { cpu_avr6 } [CPUAVR_HAS_JMP_CALL,CPUAVR_HAS_MOVW,CPUAVR_HAS_LPMX,CPUAVR_HAS_MUL,CPUAVR_HAS_RAMPZ,CPUAVR_HAS_ELPM,CPUAVR_HAS_ELPMX,CPUAVR_3_BYTE_PC]
      );
 
 Implementation

compiler/avr/cpunode.pas

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

compiler/avr/cpupara.pas

@@ -38,7 +38,6 @@ unit cpupara;
           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
           function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
-          procedure getintparaloc(pd : tabstractprocdef; nr : longint; 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; forcetempdef: tdef): tcgpara;override;
@@ -68,45 +67,6 @@ unit cpupara;
       end;
 
 
-    procedure tavrparamanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
-      var
-        paraloc : pcgparalocation;
-        psym: tparavarsym;
-        pdef: tdef;
-      begin
-        if nr<1 then
-          internalerror(2002070801);
-        psym:=tparavarsym(pd.paras[nr-1]);
-        pdef:=psym.vardef;
-        if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
-          pdef:=getpointerdef(pdef);
-        cgpara.reset;
-        cgpara.size:=def_cgsize(pdef);
-        cgpara.intsize:=tcgsize2size[cgpara.size];
-        cgpara.alignment:=std_param_align;
-        cgpara.def:=pdef;
-        paraloc:=cgpara.add_location;
-        with paraloc^ do
-          begin
-            size:=def_cgsize(pdef);
-            def:=pdef;
-            { the four first parameters are passed into registers }
-            if nr<=9 then
-              begin
-                loc:=LOC_REGISTER;
-                register:=newreg(R_INTREGISTER,RS_R25-(nr-1)*2,R_SUBWHOLE);
-              end
-            else
-              begin
-                { the other parameters are passed on the stack }
-                loc:=LOC_REFERENCE;
-                reference.index:=NR_STACK_POINTER_REG;
-                reference.offset:=(nr-10)*2;
-              end;
-          end;
-      end;
-
-
     function getparaloc(calloption : tproccalloption; p : tdef) : tcgloc;
       begin
          { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
@@ -181,6 +141,8 @@ unit cpupara;
             result:=not is_smallset(def);
           stringdef :
             result:=tstringdef(def).stringtype in [st_shortstring,st_longstring];
+        else
+          result:=def.size>4;
         end;
       end;
 
@@ -202,7 +164,10 @@ unit cpupara;
             result:=not(def.size in [1,2,4]);
           }
           else
-            result:=inherited ret_in_param(def,pd);
+            if (def.size > 4) then
+              result:=true
+            else
+              result:=inherited ret_in_param(def,pd);
         end;
       end;
 
@@ -481,7 +446,57 @@ unit cpupara;
           { Return in register }
         else
           begin
-            if retcgsize in [OS_64,OS_S64] then
+            case retcgsize of
+              OS_32,OS_S32:
+                begin
+                  paraloc^.loc:=LOC_REGISTER;
+                  paraloc^.register:=NR_R22;
+                  paraloc^.size:=OS_8;
+                  paraloc^.def:=u8inttype;
+
+                  paraloc:=result.add_location;
+                  paraloc^.loc:=LOC_REGISTER;
+                  paraloc^.register:=NR_R23;
+                  paraloc^.size:=OS_8;
+                  paraloc^.def:=u8inttype;
+
+                  paraloc:=result.add_location;
+                  paraloc^.loc:=LOC_REGISTER;
+                  paraloc^.register:=NR_R24;
+                  paraloc^.size:=OS_8;
+                  paraloc^.def:=u8inttype;
+
+                  paraloc:=result.add_location;
+                  paraloc^.loc:=LOC_REGISTER;
+                  paraloc^.register:=NR_R25;
+                  paraloc^.size:=OS_8;
+                  paraloc^.def:=u8inttype;
+                end;
+              OS_16,OS_S16:
+                begin
+                  paraloc^.loc:=LOC_REGISTER;
+                  paraloc^.register:=NR_R24;
+                  paraloc^.size:=OS_8;
+                  paraloc^.def:=u8inttype;
+
+                  paraloc:=result.add_location;
+                  paraloc^.loc:=LOC_REGISTER;
+                  paraloc^.register:=NR_R25;
+                  paraloc^.size:=OS_8;
+                  paraloc^.def:=u8inttype;
+                end;
+              OS_8,OS_S8:
+                begin
+                  paraloc^.loc:=LOC_REGISTER;
+                  paraloc^.register:=NR_R24;
+                  paraloc^.size:=OS_8;
+                  paraloc^.def:=u8inttype;
+                end;
+              else
+                internalerror(2014030101);
+            end;
+
+            {if retcgsize in [OS_64,OS_S64] then
               begin
                 paraloc^.loc:=LOC_REGISTER;
                 paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG;
@@ -497,9 +512,9 @@ unit cpupara;
               begin
                 paraloc^.loc:=LOC_REGISTER;
                 paraloc^.register:=NR_FUNCTION_RETURN_REG;
-                paraloc^.size:=OS_32;
-                paraloc^.def:=u32inttype;
-              end;
+                paraloc^.size:=OS_INT;
+                paraloc^.def:=u16inttype;
+              end;}
           end;
       end;
 

compiler/avr/cpupi.pas

@@ -37,6 +37,7 @@ unit cpupi;
           // procedure after_pass1;override;
           procedure set_first_temp_offset;override;
           function calc_stackframe_size:longint;override;
+          procedure postprocess_code;override;
        end;
 
 
@@ -49,7 +50,8 @@ unit cpupi;
        tgobj,
        symconst,symsym,paramgr,
        cgbase,
-       cgobj;
+       cgobj,
+       aasmcpu;
 
     procedure tavrprocinfo.set_first_temp_offset;
       begin
@@ -63,10 +65,17 @@ unit cpupi;
     function tavrprocinfo.calc_stackframe_size:longint;
       begin
         maxpushedparasize:=align(maxpushedparasize,max(current_settings.alignment.localalignmin,4));
-        result:=0;
+        result:=Align(tg.direction*tg.lasttemp,max(current_settings.alignment.localalignmin,4))+maxpushedparasize;
       end;
 
 
+    procedure tavrprocinfo.postprocess_code;
+      begin
+        { because of the limited branch distance of cond. branches, they must be replaced
+          sometimes by normal jmps and an inverse branch }
+        finalizeavrcode(aktproccode);
+      end;
+
 begin
    cprocinfo:=tavrprocinfo;
 end.

compiler/avr/navradd.pas

@@ -77,6 +77,8 @@ interface
                       GetResFlags:=F_LT;
                     gten:
                       GetResFlags:=F_NotPossible;
+                    else
+                      internalerror(2014082020);
                   end
                 else
                   case NodeType of
@@ -88,6 +90,8 @@ interface
                       GetResFlags:=F_NotPossible;
                     gten:
                       GetResFlags:=F_GE;
+                    else
+                      internalerror(2014082021);
                   end;
               end
             else
@@ -102,6 +106,8 @@ interface
                       GetResFlags:=F_CC;
                     gten:
                       GetResFlags:=F_NotPossible;
+                    else
+                      internalerror(2014082022);
                   end
                 else
                   case NodeType of
@@ -113,6 +119,8 @@ interface
                       GetResFlags:=F_NotPossible;
                     gten:
                       GetResFlags:=F_CS;
+                    else
+                      internalerror(2014082023);
                   end;
               end;
         end;
@@ -220,7 +228,7 @@ interface
     function tavraddnode.pass_1 : tnode;
       begin
         result:=inherited pass_1;
-{
+{$ifdef dummy}
         if not(assigned(result)) then
           begin
             unsigned:=not(is_signed(left.resultdef)) or
@@ -240,7 +248,7 @@ interface
              is_dynamic_array(left.resultdef)
            ) then
           expectloc:=LOC_FLAGS;
-}
+{$endif dummy}
       end;
 
 

compiler/avr/navrmat.pas

@@ -165,7 +165,7 @@ implementation
         secondpass(right);
         location_copy(location,left.location);
 
-{
+{$ifdef dummy}
         { put numerator in register }
         size:=def_cgsize(left.resultdef);
         hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,
@@ -201,7 +201,7 @@ implementation
         {  simple comparison with 0)                                             }
         if is_signed(right.resultdef) then
           cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef);
-}
+{$endif dummy}
       end;
 
 {*****************************************************************************

compiler/avr/raavrgas.pas

@@ -69,14 +69,20 @@ Unit raavrgas;
           name : string[2];
           reg : tregister;
         end;
-{
+
       const
-        extraregs : array[0..19] of treg2str = (
-          (name: 'X'; reg : NR_Z),
-          (name: 'Y'; reg : NR_R1),
-          (name: 'Z'; reg : NR_R2),
+        extraregs : array[0..8] of treg2str = (
+          (name: 'X'; reg : NR_R26),
+          (name: 'XL'; reg : NR_R26),
+          (name: 'XH'; reg : NR_R27),
+          (name: 'Y'; reg : NR_R28),
+          (name: 'YL'; reg : NR_R28),
+          (name: 'YH'; reg : NR_R29),
+          (name: 'Z'; reg : NR_R30),
+          (name: 'ZL'; reg : NR_R30),
+          (name: 'ZH'; reg : NR_R31)
         );
-}
+
       var
         i : longint;
 
@@ -85,9 +91,9 @@ Unit raavrgas;
         { reg found?
           possible aliases are always 2 char
         }
-        if result or (length(s)<>2) then
+        if result or (not (length(s) in [1,2])) then
           exit;
-{
+
         for i:=low(extraregs) to high(extraregs) do
           begin
             if s=extraregs[i].name then
@@ -98,7 +104,6 @@ Unit raavrgas;
                 exit;
               end;
           end;
-}
       end;
 
 
@@ -480,7 +485,16 @@ Unit raavrgas;
               { save the type of register used. }
               tempreg:=actasmregister;
               Consume(AS_REGISTER);
-              if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
+              if (actasmtoken=AS_PLUS) then
+                begin
+                  oper.opr.typ:=OPR_REFERENCE;
+
+                  reference_reset_base(oper.opr.ref,tempreg,0,1);
+                  oper.opr.ref.addressmode:=AM_POSTINCREMENT;
+
+                  consume(AS_PLUS);
+                end
+              else if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
                 Begin
                   if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then
                     Message(asmr_e_invalid_operand_type);
@@ -603,7 +617,7 @@ Unit raavrgas;
         actopcode:=A_NONE;
         for j:=maxlen downto 1 do
           begin
-            actopcode:=tasmop(PtrInt(iasmops.Find(copy(hs,1,j))));
+            actopcode:=tasmop(PtrUInt(iasmops.Find(copy(hs,1,j))));
             if actopcode<>A_NONE then
               begin
                 actasmtoken:=AS_OPCODE;

compiler/avr/symcpu.pas

@@ -0,0 +1,211 @@
+{
+    Copyright (c) 2014 by Florian Klaempfl
+
+    Symbol table overrides for AVR
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit symcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  symtype,symdef,symsym;
+
+type
+  { defs }
+  tcpufiledef = class(tfiledef)
+  end;
+  tcpufiledefclass = class of tcpufiledef;
+
+  tcpuvariantdef = class(tvariantdef)
+  end;
+  tcpuvariantdefclass = class of tcpuvariantdef;
+
+  tcpuformaldef = class(tformaldef)
+  end;
+  tcpuformaldefclass = class of tcpuformaldef;
+
+  tcpuforwarddef = class(tforwarddef)
+  end;
+  tcpuforwarddefclass = class of tcpuforwarddef;
+
+  tcpuundefineddef = class(tundefineddef)
+  end;
+  tcpuundefineddefclass = class of tcpuundefineddef;
+
+  tcpuerrordef = class(terrordef)
+  end;
+  tcpuerrordefclass = class of tcpuerrordef;
+
+  tcpupointerdef = class(tpointerdef)
+  end;
+  tcpupointerdefclass = class of tcpupointerdef;
+
+  tcpurecorddef = class(trecorddef)
+  end;
+  tcpurecorddefclass = class of tcpurecorddef;
+
+  tcpuimplementedinterface = class(timplementedinterface)
+  end;
+  tcpuimplementedinterfaceclass = class of tcpuimplementedinterface;
+
+  tcpuobjectdef = class(tobjectdef)
+  end;
+  tcpuobjectdefclass = class of tcpuobjectdef;
+
+  tcpuclassrefdef = class(tclassrefdef)
+  end;
+  tcpuclassrefdefclass = class of tcpuclassrefdef;
+
+  tcpuarraydef = class(tarraydef)
+  end;
+  tcpuarraydefclass = class of tcpuarraydef;
+
+  tcpuorddef = class(torddef)
+  end;
+  tcpuorddefclass = class of tcpuorddef;
+
+  tcpufloatdef = class(tfloatdef)
+  end;
+  tcpufloatdefclass = class of tcpufloatdef;
+
+  tcpuprocvardef = class(tprocvardef)
+  end;
+  tcpuprocvardefclass = class of tcpuprocvardef;
+
+  tcpuprocdef = class(tprocdef)
+  end;
+  tcpuprocdefclass = class of tcpuprocdef;
+
+  tcpustringdef = class(tstringdef)
+  end;
+  tcpustringdefclass = class of tcpustringdef;
+
+  tcpuenumdef = class(tenumdef)
+  end;
+  tcpuenumdefclass = class of tcpuenumdef;
+
+  tcpusetdef = class(tsetdef)
+  end;
+  tcpusetdefclass = class of tcpusetdef;
+
+  { syms }
+  tcpulabelsym = class(tlabelsym)
+  end;
+  tcpulabelsymclass = class of tcpulabelsym;
+
+  tcpuunitsym = class(tunitsym)
+  end;
+  tcpuunitsymclass = class of tcpuunitsym;
+
+  tcpunamespacesym = class(tnamespacesym)
+  end;
+  tcpunamespacesymclass = class of tcpunamespacesym;
+
+  tcpuprocsym = class(tprocsym)
+  end;
+  tcpuprocsymclass = class of tcpuprocsym;
+
+  tcputypesym = class(ttypesym)
+  end;
+  tcpuypesymclass = class of tcputypesym;
+
+  tcpufieldvarsym = class(tfieldvarsym)
+  end;
+  tcpufieldvarsymclass = class of tcpufieldvarsym;
+
+  tcpulocalvarsym = class(tlocalvarsym)
+  end;
+  tcpulocalvarsymclass = class of tcpulocalvarsym;
+
+  tcpuparavarsym = class(tparavarsym)
+  end;
+  tcpuparavarsymclass = class of tcpuparavarsym;
+
+  tcpustaticvarsym = class(tstaticvarsym)
+  end;
+  tcpustaticvarsymclass = class of tcpustaticvarsym;
+
+  tcpuabsolutevarsym = class(tabsolutevarsym)
+  end;
+  tcpuabsolutevarsymclass = class of tcpuabsolutevarsym;
+
+  tcpupropertysym = class(tpropertysym)
+  end;
+  tcpupropertysymclass = class of tcpupropertysym;
+
+  tcpuconstsym = class(tconstsym)
+  end;
+  tcpuconstsymclass = class of tcpuconstsym;
+
+  tcpuenumsym = class(tenumsym)
+  end;
+  tcpuenumsymclass = class of tcpuenumsym;
+
+  tcpusyssym = class(tsyssym)
+  end;
+  tcpusyssymclass = class of tcpusyssym;
+
+
+const
+  pbestrealtype : ^tdef = @s64floattype;
+
+
+implementation
+
+begin
+  { used tdef classes }
+  cfiledef:=tcpufiledef;
+  cvariantdef:=tcpuvariantdef;
+  cformaldef:=tcpuformaldef;
+  cforwarddef:=tcpuforwarddef;
+  cundefineddef:=tcpuundefineddef;
+  cerrordef:=tcpuerrordef;
+  cpointerdef:=tcpupointerdef;
+  crecorddef:=tcpurecorddef;
+  cimplementedinterface:=tcpuimplementedinterface;
+  cobjectdef:=tcpuobjectdef;
+  cclassrefdef:=tcpuclassrefdef;
+  carraydef:=tcpuarraydef;
+  corddef:=tcpuorddef;
+  cfloatdef:=tcpufloatdef;
+  cprocvardef:=tcpuprocvardef;
+  cprocdef:=tcpuprocdef;
+  cstringdef:=tcpustringdef;
+  cenumdef:=tcpuenumdef;
+  csetdef:=tcpusetdef;
+
+  { used tsym classes }
+  clabelsym:=tcpulabelsym;
+  cunitsym:=tcpuunitsym;
+  cnamespacesym:=tcpunamespacesym;
+  cprocsym:=tcpuprocsym;
+  ctypesym:=tcputypesym;
+  cfieldvarsym:=tcpufieldvarsym;
+  clocalvarsym:=tcpulocalvarsym;
+  cparavarsym:=tcpuparavarsym;
+  cstaticvarsym:=tcpustaticvarsym;
+  cabsolutevarsym:=tcpuabsolutevarsym;
+  cpropertysym:=tcpupropertysym;
+  cconstsym:=tcpuconstsym;
+  cenumsym:=tcpuenumsym;
+  csyssym:=tcpusyssym;
+end.
+

compiler/browcol.pas

@@ -1673,6 +1673,8 @@ end;
                       Symbol^.Flags:=(Symbol^.Flags or sfObject);
                       if tobjectdef(typedef).objecttype=odt_class then
                         Symbol^.Flags:=(Symbol^.Flags or sfClass);
+                      if tobjectdef(typedef).objecttype=odt_class then
+                      if not(df_generic in typedef.defoptions) then
                       ProcessSymTable(Symbol,Symbol^.Items,tobjectdef(typedef).symtable);
                     end;
                   recorddef :

compiler/cclasses.pas

@@ -76,7 +76,7 @@ type
   TListSortCompare = function (Item1, Item2: Pointer): Integer;
   TListCallback = procedure(data,arg:pointer) of object;
   TListStaticCallback = procedure(data,arg:pointer);
-
+  TDynStringArray = Array Of String;
   TFPList = class(TObject)
   private
     FList: PPointerList;
@@ -87,13 +87,13 @@ type
     procedure Put(Index: Integer; Item: Pointer);
     procedure SetCapacity(NewCapacity: Integer);
     procedure SetCount(NewCount: Integer);
-    Procedure RaiseIndexError(Index : Integer);
+    Procedure RaiseIndexError(Index : Integer);{$ifndef VER2_6}noreturn;{$endif VER2_6}
   public
     destructor Destroy; override;
     function Add(Item: Pointer): Integer;
     procedure Clear;
     procedure Delete(Index: Integer);
-    class procedure Error(const Msg: string; Data: PtrInt);
+    class procedure Error(const Msg: string; Data: PtrInt);{$ifndef VER2_6}noreturn;{$endif VER2_6}
     procedure Exchange(Index1, Index2: Integer);
     function Expand: TFPList;
     function Extract(item: Pointer): Pointer;
@@ -224,7 +224,7 @@ type
     function HashOfIndex(Index: Integer): LongWord;
     function GetNextCollision(Index: Integer): Integer;
     procedure Delete(Index: Integer);
-    class procedure Error(const Msg: string; Data: PtrInt);
+    class procedure Error(const Msg: string; Data: PtrInt);{$ifndef VER2_6}noreturn;{$endif VER2_6}
     function Expand: TFPHashList;
     function Extract(item: Pointer): Pointer;
     function IndexOf(Item: Pointer): Integer;
@@ -237,6 +237,8 @@ type
     procedure ShowStatistics;
     procedure ForEachCall(proc2call:TListCallback;arg:pointer);
     procedure ForEachCall(proc2call:TListStaticCallback;arg:pointer);
+    procedure WhileEachCall(proc2call:TListCallback;arg:pointer);
+    procedure WhileEachCall(proc2call:TListStaticCallback;arg:pointer);
     property Capacity: Integer read FCapacity write SetCapacity;
     property Count: Integer read FCount write SetCount;
     property Items[Index: Integer]: Pointer read Get write Put; default;
@@ -273,6 +275,7 @@ type
     procedure Rename(const ANewName:TSymStr);
     property Name:TSymStr read GetName;
     property Hash:Longword read GetHash;
+    property OwnerList: TFPHashObjectList read FOwner;
   end;
 
   TFPHashObjectList = class(TObject)
@@ -308,6 +311,8 @@ type
     procedure ShowStatistics; {$ifdef CCLASSESINLINE}inline;{$endif}
     procedure ForEachCall(proc2call:TObjectListCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif}
     procedure ForEachCall(proc2call:TObjectListStaticCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif}
+    procedure WhileEachCall(proc2call:TObjectListCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif}
+    procedure WhileEachCall(proc2call:TObjectListStaticCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif}
     property Capacity: Integer read GetCapacity write SetCapacity;
     property Count: Integer read GetCount write SetCount;
     property OwnsObjects: Boolean read FFreeObjects write FFreeObjects;
@@ -503,14 +508,14 @@ type
          destructor Destroy; override;
          procedure Clear;
          { finds an entry by key }
-         function Find(Key: Pointer; KeyLen: Integer): PHashSetItem;
+         function Find(Key: Pointer; KeyLen: Integer): PHashSetItem;virtual;
          { finds an entry, creates one if not exists }
          function FindOrAdd(Key: Pointer; KeyLen: Integer;
-           var Found: Boolean): PHashSetItem;
+           var Found: Boolean): PHashSetItem;virtual;
          { finds an entry, creates one if not exists }
-         function FindOrAdd(Key: Pointer; KeyLen: Integer): PHashSetItem;
+         function FindOrAdd(Key: Pointer; KeyLen: Integer): PHashSetItem;virtual;
          { returns Data by given Key }
-         function Get(Key: Pointer; KeyLen: Integer): TObject;
+         function Get(Key: Pointer; KeyLen: Integer): TObject;virtual;
          { removes an entry, returns False if entry wasn't there }
          function Remove(Entry: PHashSetItem): Boolean;
          property Count: LongWord read FCount;
@@ -584,12 +589,74 @@ type
     function FPHash(const s:shortstring):LongWord; inline;
     function FPHash(const a:ansistring):LongWord; inline;
 
+    function ExtractStrings(Separators, WhiteSpace: TSysCharSet; Content: PChar; var Strings: TDynStringArray; AddEmptyStrings : Boolean = False): Integer;
 
 implementation
 
 {*****************************************************************************
                                     Memory debug
 *****************************************************************************}
+    function ExtractStrings(Separators, WhiteSpace: TSysCharSet; Content: PChar; var Strings: TDynStringArray; AddEmptyStrings : Boolean = False): Integer;
+    var
+      b, c : pchar;
+
+      procedure SkipWhitespace;
+        begin
+          while (c^ in Whitespace) do
+            inc (c);
+        end;
+
+      procedure AddString;
+        var
+          l : integer;
+          s : string;
+        begin
+          l := c-b;
+          if (l > 0) or AddEmptyStrings then
+            begin
+              setlength(s, l);
+              if l>0 then
+                move (b^, s[1],l*SizeOf(char));
+              l:=length(Strings);
+              setlength(Strings,l+1);
+              Strings[l]:=S;  
+              inc (result);
+            end;
+        end;
+
+    var
+      quoted : char;
+    begin
+      result := 0;
+      c := Content;
+      Quoted := #0;
+      Separators := Separators + [#13, #10] - ['''','"'];
+      SkipWhitespace;
+      b := c;
+      while (c^ <> #0) do
+        begin
+          if (c^ = Quoted) then
+            begin
+              if ((c+1)^ = Quoted) then
+                inc (c)
+              else
+                Quoted := #0
+            end
+          else if (Quoted = #0) and (c^ in ['''','"']) then
+            Quoted := c^;
+          if (Quoted = #0) and (c^ in Separators) then
+            begin
+              AddString;
+              inc (c);
+              SkipWhitespace;
+              b := c;
+            end
+          else
+            inc (c);
+        end;
+      if (c <> b) then
+        AddString;
+    end;
 
     constructor tmemdebug.create(const s:string);
       begin
@@ -644,7 +711,7 @@ implementation
                TFPObjectList (Copied from rtl/objpas/classes/lists.inc)
 *****************************************************************************}
 
-procedure TFPList.RaiseIndexError(Index : Integer);
+procedure TFPList.RaiseIndexError(Index : Integer);{$ifndef VER2_6}noreturn;{$endif VER2_6}
 begin
   Error(SListIndexError, Index);
 end;
@@ -740,7 +807,7 @@ begin
   end;
 end;
 
-class procedure TFPList.Error(const Msg: string; Data: PtrInt);
+class procedure TFPList.Error(const Msg: string; Data: PtrInt);{$ifndef VER2_6}noreturn;{$endif VER2_6}
 begin
   Raise EListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame), get_caller_frame(get_frame);
 end;
@@ -1438,7 +1505,7 @@ begin
     Self.Delete(Result);
 end;
 
-class procedure TFPHashList.Error(const Msg: string; Data: PtrInt);
+class procedure TFPHashList.Error(const Msg: string; Data: PtrInt);{$ifndef VER2_6}noreturn;{$endif VER2_6}
 begin
   Raise EListError.CreateFmt(Msg,[Data])  at get_caller_addr(get_frame), get_caller_frame(get_frame);
 end;
@@ -1660,6 +1727,38 @@ begin
 end;
 
 
+procedure TFPHashList.WhileEachCall(proc2call:TListCallback;arg:pointer);
+var
+  i : integer;
+  p : pointer;
+begin
+  i:=0;
+  while i<count do
+    begin
+      p:=FHashList^[i].Data;
+      if assigned(p) then
+        proc2call(p,arg);
+      inc(i);
+    end;
+end;
+
+
+procedure TFPHashList.WhileEachCall(proc2call:TListStaticCallback;arg:pointer);
+var
+  i : integer;
+  p : pointer;
+begin
+  i:=0;
+  while i<count do
+    begin
+      p:=FHashList^[i].Data;
+      if assigned(p) then
+        proc2call(p,arg);
+      inc(i);
+    end;
+end;
+
+
 {*****************************************************************************
                                TFPHashObject
 *****************************************************************************}
@@ -1914,6 +2013,18 @@ begin
 end;
 
 
+procedure TFPHashObjectList.WhileEachCall(proc2call:TObjectListCallback;arg:pointer);
+begin
+  FHashList.WhileEachCall(TListCallBack(proc2call),arg);
+end;
+
+
+procedure TFPHashObjectList.WhileEachCall(proc2call:TObjectListStaticCallback;arg:pointer);
+begin
+  FHashList.WhileEachCall(TListStaticCallBack(proc2call),arg);
+end;
+
+
 {****************************************************************************
                              TLinkedListItem
  ****************************************************************************}

compiler/cfileutl.pas

@@ -140,7 +140,7 @@ interface
 { * Since native Amiga commands can't handle Unix-style relative paths used by the compiler,
     and some GNU tools, Unix2AmigaPath is needed to handle such situations (KB) * }
 
-{$IF DEFINED(MORPHOS) OR DEFINED(AMIGA)}
+{$IFDEF HASAMIGA}
 { * PATHCONV is implemented in the Amiga/MorphOS system unit * }
 {$NOTE TODO Amiga: implement PathConv() in System unit, which works with AnsiString}
 function Unix2AmigaPath(path: ShortString): ShortString; external name 'PATHCONV';
@@ -148,6 +148,10 @@ function Unix2AmigaPath(path: ShortString): ShortString; external name 'PATHCONV
 function Unix2AmigaPath(path: String): String;{$IFDEF USEINLINE}inline;{$ENDIF}
 {$ENDIF}
 
+{$if FPC_FULLVERSION < 20701}
+type
+  TRawByteSearchRec = TSearchRec;
+{$endif}
 
 
 implementation
@@ -183,7 +187,7 @@ implementation
       DirCache : TDirectoryCache;
 
 
-{$IF NOT (DEFINED(MORPHOS) OR DEFINED(AMIGA))}
+{$IFNDEF HASAMIGA}
 { Stub function for Unix2Amiga Path conversion functionality, only available in
   Amiga/MorphOS RTL. I'm open for better solutions. (KB) }
 function Unix2AmigaPath(path: String): String;{$IFDEF USEINLINE}inline;{$ENDIF}
@@ -269,7 +273,7 @@ end;
 
     procedure TCachedDirectory.Reload;
       var
-        dir   : TSearchRec;
+        dir   : TRawByteSearchRec;
         entry : PCachedDirectoryEntry;
       begin
         FreeDirectoryEntries;
@@ -299,8 +303,8 @@ end;
                     DirectoryEntries.Add(Dir.Name,Pointer(Ptrint(Dir.Attr)));
                 end;
             until findnext(dir) <> 0;
+            findclose(dir);
           end;
-        findclose(dir);
       end;
 
 
@@ -533,7 +537,7 @@ end;
 {$if defined(unix)}
         if (length(s)>0) and (s[1] in AllowDirectorySeparators) then
           result:=true;
-{$elseif defined(amiga) or defined(morphos)}
+{$elseif defined(hasamiga)}
         (* An Amiga path is absolute, if it has a volume/device name in it (contains ":"),
            otherwise it's always a relative path, no matter if it starts with a directory
            separator or not. (KB) *)
@@ -760,6 +764,7 @@ end;
   begin
     oldpos := 1;
     slashPos := Pos('/', path);
+    TranslatePathToMac:='';
     if (slashPos <> 0) then   {its a unix path}
       begin
         if slashPos = 1 then
@@ -1072,7 +1077,7 @@ end;
             currPath:=FixPath(ExpandFileName(currpath),false);
             if (CurrentDir<>'') and (Copy(currPath,1,length(CurrentDir))=CurrentDir) then
              begin
-{$if defined(amiga) and defined(morphos)}
+{$ifdef hasamiga}
                currPath:= CurrentDir+Copy(currPath,length(CurrentDir)+1,length(currPath));
 {$else}
                currPath:= CurDirRelPath(source_info)+Copy(currPath,length(CurrentDir)+1,length(currPath));
@@ -1122,8 +1127,8 @@ end;
                         end;
                     end;
                 until findnext(dir) <> 0;
+                FindClose(dir);
               end;
-            FindClose(dir);
 {$endif usedircache}
             if not subdirfound then
               WarnNonExistingPath(currpath);
@@ -1475,6 +1480,7 @@ end;
         inquotes:=false;
         result:='';
         i:=1;
+        temp:='';
         while i<=length(QuotedStr) do
           begin
             case QuotedStr[i] of
@@ -1517,6 +1523,10 @@ end;
       var
         quote_script: tscripttype;
       begin
+
+        if do_checkverbosity(V_Executable) then
+          do_comment(V_Executable,'Executing "'+Path+'" with command line "'+
+            ComLine+'"');
         if (cs_link_on_target in current_settings.globalswitches) then
           quote_script:=target_info.script
         else
@@ -1529,7 +1539,21 @@ end;
 
 
     function RequotedExecuteProcess(const Path: AnsiString; const ComLine: array of AnsiString; Flags: TExecuteFlags): Longint;
+      var
+        i : longint;
+        st : string;
       begin
+        if do_checkverbosity(V_Executable) then
+          begin
+            if high(ComLine)=0 then
+              st:=''
+            else
+              st:=ComLine[1];
+            for i:=2 to high(ComLine) do
+              st:=st+' '+ComLine[i];
+            do_comment(V_Executable,'Executing "'+Path+'" with command line "'+
+              st+'"');
+          end;
         result:=sysutils.ExecuteProcess(Path,ComLine,Flags);
       end;
 
@@ -1539,21 +1563,28 @@ end;
         expansion under linux }
 {$ifdef hasunix}
       begin
+        if do_checkverbosity(V_Used) then
+          do_comment(V_Executable,'Executing "'+Command+'" with fpSystem call');
         result := Unix.fpsystem(command);
       end;
 {$else hasunix}
-  {$ifdef amigashell}
+  {$ifdef hasamiga}
       begin
+        if do_checkverbosity(V_Used) then
+          do_comment(V_Executable,'Executing "'+Command+'" using RequotedExecuteProcess');
         result := RequotedExecuteProcess('',command);
       end;
-  {$else amigashell}
+  {$else hasamiga}
       var
         comspec : string;
       begin
         comspec:=GetEnvironmentVariable('COMSPEC');
+        if do_checkverbosity(V_Used) then
+          do_comment(V_Executable,'Executing "'+Command+'" using comspec "'
+            +ComSpec+'"');
         result := RequotedExecuteProcess(comspec,' /C '+command);
       end;
-   {$endif amigashell}
+   {$endif hasamiga}
 {$endif hasunix}
 
 

compiler/cg64f32.pas

@@ -92,8 +92,6 @@ unit cg64f32;
         procedure g_rangecheck64(list: TAsmList; const l:tlocation;fromdef,todef: tdef); override;
       end;
 
-    {# Creates a tregister64 record from 2 32 Bit registers. }
-    function joinreg64(reglo,reghi : tregister) : tregister64;
 
   implementation
 
@@ -107,13 +105,6 @@ unit cg64f32;
                                      Helpers
 ****************************************************************************}
 
-    function joinreg64(reglo,reghi : tregister) : tregister64;
-      begin
-         result.reglo:=reglo;
-         result.reghi:=reghi;
-      end;
-
-
     procedure swap64(var q : int64);
       begin
          q:=(int64(lo(q)) shl 32) or hi(q);
@@ -522,7 +513,7 @@ unit cg64f32;
           LOC_MMREGISTER, LOC_CMMREGISTER:
             a_loadmm_intreg64_reg(list,l.size,reg,l.register);
           else
-            internalerror(200112293);
+            internalerror(200112294);
         end;
       end;
 
@@ -861,14 +852,18 @@ unit cg64f32;
                begin
                  current_asmdata.getjumplabel(neglabel);
                  cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,-1,hreg,neglabel);
-               end;
+               end
+             else
+               { we do not have dynamic dfa, so avoid a warning below about the unused
+                 neglabel }
+               neglabel:=nil;
              { For all other values we have a range check error }
              cg.a_call_name(list,'fpc_rangeerror',false);
 
              { if the high dword = 0, the low dword can be considered a }
              { simple cardinal                                          }
              cg.a_label(list,poslabel);
-             hdef:=torddef.create(u32bit,0,$ffffffff);
+             hdef:=corddef.create(u32bit,0,$ffffffff);
 
              location_copy(temploc,l);
              temploc.size:=OS_32;
@@ -908,7 +903,7 @@ unit cg64f32;
                  { if we get here, the 64bit value lies between }
                  { longint($80000000) and -1 (JM)               }
                  cg.a_label(list,neglabel);
-                 hdef:=torddef.create(s32bit,int64(longint($80000000)),int64(-1));
+                 hdef:=corddef.create(s32bit,int64(longint($80000000)),int64(-1));
                  location_copy(temploc,l);
                  temploc.size:=OS_32;
                  hlcg.g_rangecheck(list,temploc,hdef,todef);

compiler/cgbase.pas

@@ -99,8 +99,6 @@ interface
          {$ENDIF}
          {$IFDEF i8086}
          ,addr_dgroup      // the data segment group
-         ,addr_far         // used for emitting 'call/jmp far label' instructions
-         ,addr_far_ref     // used for emitting 'call far [reference]' instructions
          ,addr_seg         // used for getting the segment of an object, e.g. 'mov ax, SEG symbol'
          {$ENDIF}
          );
@@ -282,6 +280,7 @@ interface
 
        { Invalid register number }
        RS_INVALID    = high(tsuperregister);
+       NR_INVALID    = tregister($fffffffff);
 
        tcgsize2size : Array[tcgsize] of integer =
          { integer values }
@@ -375,6 +374,8 @@ interface
     function int_cgsize(const a: tcgint): tcgsize;{$ifdef USEINLINE}inline;{$endif}
     function int_float_cgsize(const a: tcgint): tcgsize;
 
+    function tcgsize2str(cgsize: tcgsize):string;
+
     { return the inverse condition of opcmp }
     function inverse_opcmp(opcmp: topcmp): topcmp;{$ifdef USEINLINE}inline;{$endif}
 
@@ -624,6 +625,10 @@ implementation
             result:=result+'ms';
           R_SUBMMWHOLE:
             result:=result+'ma';
+          R_SUBMMX:
+            result:=result+'mx';
+          R_SUBMMY:
+            result:=result+'my';
           else
             internalerror(200308252);
         end;
@@ -665,6 +670,12 @@ implementation
       end;
 
 
+    function tcgsize2str(cgsize: tcgsize):string;
+      begin
+        Str(cgsize, Result);
+      end;
+
+
     function inverse_opcmp(opcmp: topcmp): topcmp;{$ifdef USEINLINE}inline;{$endif}
       const
         list: array[TOpCmp] of TOpCmp =

compiler/cghlcpu.pas

@@ -25,7 +25,7 @@
 
 unit cghlcpu;
 
-{$mode objfpc}
+{$i fpcdefs.inc}
 
 interface
 
@@ -38,6 +38,8 @@ uses
   type
     thlbasecgcpu = class(tcg)
      public
+      procedure g_save_registers(list:TAsmList);override;
+      procedure g_restore_registers(list:TAsmList);override;
       procedure g_stackpointer_alloc(list: TAsmList; size: longint); override;
       procedure g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean); override;
       procedure g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean); override;
@@ -206,6 +208,15 @@ implementation
         internalerror(2012042822);
       end;
 
+    procedure thlbasecgcpu.g_save_registers(list: TAsmList);
+      begin
+        { do nothing }
+      end;
+
+    procedure thlbasecgcpu.g_restore_registers(list: TAsmList);
+      begin
+        { do nothing }
+      end;
 
     procedure thlbasecgcpu.g_stackpointer_alloc(list: TAsmList; size: longint);
       begin

compiler/cgobj.pas

@@ -227,7 +227,6 @@ unit cgobj;
           }
           procedure a_call_name(list : TAsmList;const s : string; weak: boolean);virtual; abstract;
           procedure a_call_reg(list : TAsmList;reg : tregister);virtual; abstract;
-          procedure a_call_ref(list : TAsmList;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;const s : string);virtual;
@@ -248,7 +247,11 @@ unit cgobj;
           procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);virtual; abstract;
 
           { bit scan instructions }
-          procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tcgsize; src, dst: TRegister); virtual; abstract;
+          procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tcgsize; src, dst: TRegister); virtual;
+
+          { Multiplication with doubling result size.
+            dstlo or dsthi may be NR_NO, in which case corresponding half of result is discarded. }
+          procedure a_mul_reg_reg_pair(list: TAsmList; size: tcgsize; src1,src2,dstlo,dsthi: TRegister);virtual;
 
           { fpu move instructions }
           procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize:tcgsize; reg1, reg2: tregister); virtual; abstract;
@@ -336,11 +339,12 @@ unit cgobj;
              to emit, and the constant value to emit. This function can opcode OP_NONE to
              remove the opcode and OP_MOVE to replace it with a simple load
 
+             @param(size Size of the operand in constant)
              @param(op The opcode to emit, returns the opcode which must be emitted)
              @param(a  The constant which should be emitted, returns the constant which must
                     be emitted)
           }
-          procedure optimize_op_const(var op: topcg; var a : tcgint);virtual;
+          procedure optimize_op_const(size: TCGSize; var op: topcg; var a : tcgint);virtual;
 
          {#
              This routine is used in exception management nodes. It should
@@ -408,7 +412,7 @@ unit cgobj;
 
              @param(size Number of bytes to allocate)
           }
-          procedure g_stackpointer_alloc(list : TAsmList;size : longint);virtual; abstract;
+          procedure g_stackpointer_alloc(list : TAsmList;size : longint);virtual;
           {# Emits instruction for allocating the locals in entry
              code of a routine. This is one of the first
              routine called in @var(genentrycode).
@@ -458,6 +462,9 @@ unit cgobj;
           { Generate code to exit an unwind-protected region. The default implementation
             produces a simple jump to destination label. }
           procedure g_local_unwind(list: TAsmList; l: TAsmLabel);virtual;
+          { Generate code for integer division by constant,
+            generic version is suitable for 3-address CPUs }
+          procedure g_div_const_reg_reg(list:tasmlist; size: TCgSize; a: tcgint; src,dst: tregister); virtual;
 
          protected
           function g_indirect_sym_load(list:TAsmList;const symname: string; const flags: tindsymflags): tregister;virtual;
@@ -558,6 +565,9 @@ unit cgobj;
         { override to catch 64bit rangechecks }
         procedure g_rangecheck64(list: TAsmList; const l:tlocation; fromdef,todef: tdef);virtual;abstract;
     end;
+
+    { Creates a tregister64 record from 2 32 Bit registers. }
+    function joinreg64(reglo,reghi : tregister) : tregister64;
 {$endif cpu64bitalu}
 
     var
@@ -702,6 +712,8 @@ implementation
     procedure tcg.allocallcpuregisters(list:TAsmList);
       begin
         alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        if uses_registers(R_ADDRESSREGISTER) then
+          alloccpuregisters(list,R_ADDRESSREGISTER,paramanager.get_volatile_registers_address(pocall_default));
 {$if not(defined(i386)) and not(defined(i8086)) and not(defined(avr))}
         if uses_registers(R_FPUREGISTER) then
           alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
@@ -725,6 +737,8 @@ implementation
     procedure tcg.deallocallcpuregisters(list:TAsmList);
       begin
         dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        if uses_registers(R_ADDRESSREGISTER) then
+          dealloccpuregisters(list,R_ADDRESSREGISTER,paramanager.get_volatile_registers_address(pocall_default));
 {$if not(defined(i386)) and not(defined(i8086)) and not(defined(avr))}
         if uses_registers(R_FPUREGISTER) then
           dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
@@ -754,7 +768,7 @@ implementation
           No IE can be generated, because the VMT is written
           without a valid rg[] }
         if assigned(rg[rt]) then
-          rg[rt].add_reg_instruction(instr,r,cg.executionweight);
+          rg[rt].add_reg_instruction(instr,r,executionweight);
       end;
 
 
@@ -940,7 +954,7 @@ implementation
                    { we're at the end of the data, and it can be loaded into
                      the current location's register with a single regular
                      load }
-                   else if (sizeleft in [1,2{$ifndef cpu16bitalu},4{$endif}{$ifdef cpu64bitalu},8{$endif}]) then
+                   else if sizeleft in [1,2,4,8] then
                      begin
                        a_load_ref_reg(list,int_cgsize(sizeleft),location^.size,tmpref,location^.register);
                        if location^.shiftval<0 then
@@ -1126,7 +1140,7 @@ implementation
                end;
              end;
            LOC_FPUREGISTER :
-             cg.a_loadfpu_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref);
+             a_loadfpu_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref);
            LOC_REFERENCE :
              begin
                reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset,align);
@@ -1282,6 +1296,7 @@ implementation
         tmpreg,
         tmpreg2 : tregister;
         i : longint;
+        hisize : tcgsize;
       begin
         if ref.alignment in [1,2] then
           begin
@@ -1294,14 +1309,18 @@ implementation
                   a_load_ref_reg(list,fromsize,tosize,tmpref,register)
                 else
                   begin
+                    if FromSize=OS_16 then
+                      hisize:=OS_8
+                    else
+                      hisize:=OS_S8;
                     { first load in tmpreg, because the target register }
                     { may be used in ref as well                        }
                     if target_info.endian=endian_little then
                       inc(tmpref.offset);
                     tmpreg:=getintregister(list,OS_8);
-                    a_load_ref_reg(list,OS_8,OS_8,tmpref,tmpreg);
-                    tmpreg:=makeregsize(list,tmpreg,OS_16);
-                    a_op_const_reg(list,OP_SHL,OS_16,8,tmpreg);
+                    a_load_ref_reg(list,hisize,hisize,tmpref,tmpreg);
+                    tmpreg:=makeregsize(list,tmpreg,FromSize);
+                    a_op_const_reg(list,OP_SHL,FromSize,8,tmpreg);
                     if target_info.endian=endian_little then
                       dec(tmpref.offset)
                     else
@@ -1433,10 +1452,39 @@ implementation
       end;
 
 
-    procedure tcg.optimize_op_const(var op: topcg; var a : tcgint);
+    procedure tcg.optimize_op_const(size: TCGSize; var op: topcg; var a : tcgint);
       var
         powerval : longint;
+        signext_a, zeroext_a: tcgint;
       begin
+        case size of
+          OS_64,OS_S64:
+            begin
+              signext_a:=int64(a);
+              zeroext_a:=int64(a);
+            end;
+          OS_32,OS_S32:
+            begin
+              signext_a:=longint(a);
+              zeroext_a:=dword(a);
+            end;
+          OS_16,OS_S16:
+            begin
+              signext_a:=smallint(a);
+              zeroext_a:=word(a);
+            end;
+          OS_8,OS_S8:
+            begin
+              signext_a:=shortint(a);
+              zeroext_a:=byte(a);
+            end
+          else
+            begin
+              { Should we internalerror() here instead? }
+              signext_a:=a;
+              zeroext_a:=a;
+            end;
+        end;
         case op of
           OP_OR :
             begin
@@ -1445,13 +1493,13 @@ implementation
                 op:=OP_NONE
               else
               { or with max returns max }
-                if a = -1 then
+                if signext_a = -1 then
                   op:=OP_MOVE;
             end;
           OP_AND :
             begin
               { and with max returns same result }
-              if (a = -1) then
+              if (signext_a = -1) then
                 op:=OP_NONE
               else
               { and with 0 returns 0 }
@@ -1463,7 +1511,7 @@ implementation
               { division by 1 returns result }
               if a = 1 then
                 op:=OP_NONE
-              else if ispowerof2(int64(a), powerval) and not(cs_check_overflow in current_settings.localswitches) then
+              else if ispowerof2(int64(zeroext_a), powerval) and not(cs_check_overflow in current_settings.localswitches) then
                 begin
                   a := powerval;
                   op:= OP_SHR;
@@ -1481,7 +1529,7 @@ implementation
                else
                  if a=0 then
                    op:=OP_MOVE
-               else if ispowerof2(int64(a), powerval) and not(cs_check_overflow in current_settings.localswitches)  then
+               else if ispowerof2(int64(zeroext_a), powerval) and not(cs_check_overflow in current_settings.localswitches)  then
                  begin
                    a := powerval;
                    op:= OP_SHL;
@@ -2047,7 +2095,7 @@ implementation
            (tcgsize2size[tosize]<>4) then
           internalerror(2009112504);
         tg.gettemp(list,8,8,tt_normal,tmpref);
-        cg.a_loadmm_reg_ref(list,fromsize,fromsize,mmreg,tmpref,shuffle);
+        a_loadmm_reg_ref(list,fromsize,fromsize,mmreg,tmpref,shuffle);
         a_load_ref_reg(list,tosize,tosize,tmpref,intreg);
         tg.ungettemp(list,tmpref);
       end;
@@ -2131,7 +2179,7 @@ implementation
            pd:=search_system_proc('fpc_check_object_ext');
            paramanager.getintparaloc(pd,1,cgpara1);
            paramanager.getintparaloc(pd,2,cgpara2);
-           reference_reset_symbol(hrefvmt,current_asmdata.RefAsmSymbol(objdef.vmt_mangledname),0,sizeof(pint));
+           reference_reset_symbol(hrefvmt,current_asmdata.RefAsmSymbol(objdef.vmt_mangledname,AT_DATA),0,sizeof(pint));
            if pd.is_pushleftright then
              begin
                a_load_reg_cgpara(list,OS_ADDR,reg,cgpara1);
@@ -2180,6 +2228,10 @@ implementation
         for r:=low(saved_standard_registers) to high(saved_standard_registers) do
           if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
             inc(size,sizeof(aint));
+        if uses_registers(R_ADDRESSREGISTER) then
+          for r:=low(saved_address_registers) to high(saved_address_registers) do
+            if saved_address_registers[r] in rg[R_ADDRESSREGISTER].used_in_proc then
+              inc(size,sizeof(aint));
 
         { mm registers }
         if uses_registers(R_MMREGISTER) then
@@ -2211,6 +2263,17 @@ implementation
                 include(rg[R_INTREGISTER].preserved_by_proc,saved_standard_registers[r]);
               end;
 
+            if uses_registers(R_ADDRESSREGISTER) then
+              for r:=low(saved_address_registers) to high(saved_address_registers) do
+                begin
+                  if saved_address_registers[r] in rg[R_ADDRESSREGISTER].used_in_proc then
+                    begin
+                      a_load_reg_ref(list,OS_ADDR,OS_ADDR,newreg(R_ADDRESSREGISTER,saved_address_registers[r],R_SUBWHOLE),href);
+                      inc(href.offset,sizeof(aint));
+                    end;
+                  include(rg[R_ADDRESSREGISTER].preserved_by_proc,saved_address_registers[r]);
+                end;
+
             if uses_registers(R_MMREGISTER) then
               begin
                 if (href.offset mod tcgsize2size[OS_VECTOR])<>0 then
@@ -2257,6 +2320,17 @@ implementation
               inc(href.offset,sizeof(aint));
             end;
 
+        if uses_registers(R_ADDRESSREGISTER) then
+          for r:=low(saved_address_registers) to high(saved_address_registers) do
+            if saved_address_registers[r] in rg[R_ADDRESSREGISTER].used_in_proc then
+              begin
+                hreg:=newreg(R_ADDRESSREGISTER,saved_address_registers[r],R_SUBWHOLE);
+                { Allocate register so the optimizer does not remove the load }
+                a_reg_alloc(list,hreg);
+                a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,hreg);
+                inc(href.offset,sizeof(aint));
+              end;
+
         if uses_registers(R_MMREGISTER) then
           begin
             if (href.offset mod tcgsize2size[OS_VECTOR])<>0 then
@@ -2297,7 +2371,7 @@ implementation
 
     procedure tcg.g_exception_reason_load(list : TAsmList; const href : treference);
       begin
-        cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
+        a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
         a_load_ref_reg(list, OS_INT, OS_INT, href, NR_FUNCTION_RESULT_REG);
       end;
 
@@ -2348,16 +2422,6 @@ implementation
       end;
 
 
-    procedure tcg.a_call_ref(list : TAsmList;ref: treference);
-      var
-        tempreg : TRegister;
-      begin
-        tempreg := getintregister(list, OS_ADDR);
-        a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,tempreg);
-        a_call_reg(list,tempreg);
-      end;
-
-
    function tcg.g_indirect_sym_load(list:TAsmList;const symname: string; const flags: tindsymflags): tregister;
       var
         l: tasmsymbol;
@@ -2444,11 +2508,93 @@ implementation
         internalerror(200807238);
       end;
 
+
+    procedure tcg.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tcgsize; src, dst: TRegister);
+      begin
+        internalerror(2014070601);
+      end;
+
+
+    procedure tcg.g_stackpointer_alloc(list: TAsmList; size: longint);
+      begin
+        internalerror(2014070602);
+      end;
+
+
+    procedure tcg.a_mul_reg_reg_pair(list: TAsmList; size: TCgSize; src1,src2,dstlo,dsthi: TRegister);
+      begin
+        internalerror(2014060801);
+      end;
+
+
+    procedure tcg.g_div_const_reg_reg(list:tasmlist; size: TCgSize; a: tcgint; src,dst: tregister);
+      var
+        divreg: tregister;
+        magic: aInt;
+        u_magic: aWord;
+        u_shift: byte;
+        u_add: boolean;
+      begin
+        divreg:=getintregister(list,OS_INT);
+        if (size in [OS_S32,OS_S64]) then
+          begin
+            calc_divconst_magic_signed(tcgsize2size[size]*8,a,magic,u_shift);
+            { load magic value }
+            a_load_const_reg(list,OS_INT,magic,divreg);
+            { multiply, discarding low bits }
+            a_mul_reg_reg_pair(list,size,src,divreg,NR_NO,dst);
+            { add/subtract numerator }
+            if (a>0) and (magic<0) then
+              a_op_reg_reg_reg(list,OP_ADD,OS_INT,src,dst,dst)
+            else if (a<0) and (magic>0) then
+              a_op_reg_reg_reg(list,OP_SUB,OS_INT,src,dst,dst);
+            { shift shift places to the right (arithmetic) }
+            a_op_const_reg_reg(list,OP_SAR,OS_INT,u_shift,dst,dst);
+            { extract and add sign bit }
+            if (a>=0) then
+              a_op_const_reg_reg(list,OP_SHR,OS_INT,tcgsize2size[size]*8-1,src,divreg)
+            else
+              a_op_const_reg_reg(list,OP_SHR,OS_INT,tcgsize2size[size]*8-1,dst,divreg);
+            a_op_reg_reg_reg(list,OP_ADD,OS_INT,dst,divreg,dst);
+          end
+        else if (size in [OS_32,OS_64]) then
+          begin
+            calc_divconst_magic_unsigned(tcgsize2size[size]*8,a,u_magic,u_add,u_shift);
+            { load magic in divreg }
+            a_load_const_reg(list,OS_INT,tcgint(u_magic),divreg);
+            { multiply, discarding low bits }
+            a_mul_reg_reg_pair(list,size,src,divreg,NR_NO,dst);
+            if (u_add) then
+              begin
+                { Calculate "(numerator+result) shr u_shift", avoiding possible overflow }
+                a_op_reg_reg_reg(list,OP_SUB,OS_INT,dst,src,divreg);
+                { divreg=(numerator-result) }
+                a_op_const_reg_reg(list,OP_SHR,OS_INT,1,divreg,divreg);
+                { divreg=(numerator-result)/2 }
+                a_op_reg_reg_reg(list,OP_ADD,OS_INT,divreg,dst,divreg);
+                { divreg=(numerator+result)/2, already shifted by 1, so decrease u_shift. }
+                a_op_const_reg_reg(list,OP_SHR,OS_INT,u_shift-1,divreg,dst);
+              end
+            else
+              a_op_const_reg_reg(list,OP_SHR,OS_INT,u_shift,dst,dst);
+          end
+        else
+          InternalError(2014060601);
+      end;
+
+
 {*****************************************************************************
                                     TCG64
 *****************************************************************************}
 
 {$ifndef cpu64bitalu}
+    function joinreg64(reglo,reghi : tregister) : tregister64;
+      begin
+         result.reglo:=reglo;
+         result.reghi:=reghi;
+      end;
+
+
     procedure tcg64.a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64; regsrc,regdst : tregister64);
       begin
         a_load64_reg_reg(list,regsrc,regdst);

compiler/cgutils.pas

@@ -43,18 +43,15 @@ unit cgutils;
       { Set type definition for cpuregisters }
       tcpuregisterset = set of 0..maxcpuregister;
 
-{$ifdef jvm}
-      tarrayreftype = (art_none,art_indexreg,art_indexref,art_indexconst);
-{$endif jvm}
       { reference record, reordered for best alignment }
       preference = ^treference;
       treference = record
          offset      : asizeint;
          symbol,
          relsymbol   : tasmsymbol;
-{$if defined(x86) or defined(m68k)}
+{$if defined(x86)}
          segment,
-{$endif defined(x86) or defined(m68k)}
+{$endif defined(x86)}
          base,
          index       : tregister;
          refaddr     : trefaddr;
@@ -174,10 +171,17 @@ unit cgutils;
     procedure location_reset_ref(var l : tlocation;lt:TCGRefLoc;lsize:TCGSize; alignment: longint);
     procedure location_copy(var destloc:tlocation; const sourceloc : tlocation);
     procedure location_swap(var destloc,sourceloc : tlocation);
+    function location_reg2string(const locreg: tlocation): string;
 
     { returns r with the given alignment }
     function setalignment(const r : treference;b : byte) : treference;
 
+    { Helper function which calculate "magic" values for replacement of division
+      by constant operation by multiplication. See the "PowerPC compiler developer
+      manual" for more information.
+      N is number of bits to handle, functionality tested for values 32 and 64. }
+    procedure calc_divconst_magic_signed(N: byte; d: aInt; out magic_m: aInt; out magic_s: byte);
+    procedure calc_divconst_magic_unsigned(N: byte; d: aWord; out magic_m: aWord; out magic_add: boolean; out magic_shift: byte);
 
 implementation
 
@@ -271,5 +275,159 @@ uses
       end;
 
 
+    function location_reg2string(const locreg: tlocation): string;
+      begin
+        if not (locreg.loc in [LOC_REGISTER,LOC_CREGISTER,
+            LOC_MMXREGISTER,LOC_CMMXREGISTER,
+            LOC_MMREGISTER,LOC_CMMREGISTER,
+            LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
+          internalerror(2013122301);
+
+        if locreg.loc in [LOC_REGISTER,LOC_CREGISTER] then
+          begin
+            case locreg.size of
+{$if defined(cpu64bitalu)}
+              OS_128,OS_S128:
+                result:=std_regname(locreg.registerhi)+':'+std_regname(locreg.register);
+{$elseif defined(cpu32bitalu)}
+              OS_64,OS_S64:
+                result:=std_regname(locreg.registerhi)+':'+std_regname(locreg.register);
+{$elseif defined(cpu16bitalu)}
+              OS_64,OS_S64:
+                if getsupreg(locreg.register)<first_int_imreg then
+                  result:='??:'+std_regname(locreg.registerhi)+':??:'+std_regname(locreg.register)
+                else
+                  result:=std_regname(GetNextReg(locreg.registerhi))+':'+std_regname(locreg.registerhi)+':'+std_regname(GetNextReg(locreg.register))+':'+std_regname(locreg.register);
+              OS_32,OS_S32:
+                if getsupreg(locreg.register)<first_int_imreg then
+                  result:='??:'+std_regname(locreg.register)
+                else
+                  result:=std_regname(GetNextReg(locreg.register))+':'+std_regname(locreg.register);
+{$elseif defined(cpu8bitalu)}
+              OS_64,OS_S64:
+                if getsupreg(locreg.register)<first_int_imreg then
+                  result:='??:??:??:'+std_regname(locreg.registerhi)+':??:??:??:'+std_regname(locreg.register)
+                else
+                  result:=std_regname(GetNextReg(GetNextReg(GetNextReg(locreg.registerhi))))+':'+std_regname(GetNextReg(GetNextReg(locreg.registerhi)))+':'+std_regname(GetNextReg(locreg.registerhi))+':'+std_regname(locreg.registerhi)+':'+std_regname(GetNextReg(GetNextReg(GetNextReg(locreg.register))))+':'+std_regname(GetNextReg(GetNextReg(locreg.register)))+':'+std_regname(GetNextReg(locreg.register))+':'+std_regname(locreg.register);
+              OS_32,OS_S32:
+                if getsupreg(locreg.register)<first_int_imreg then
+                  result:='??:??:??:'+std_regname(locreg.register)
+                else
+                  result:=std_regname(GetNextReg(GetNextReg(GetNextReg(locreg.register))))+':'+std_regname(GetNextReg(GetNextReg(locreg.register)))+':'+std_regname(GetNextReg(locreg.register))+':'+std_regname(locreg.register);
+              OS_16,OS_S16:
+                if getsupreg(locreg.register)<first_int_imreg then
+                  result:='??:'+std_regname(locreg.register)
+                else
+                  result:=std_regname(GetNextReg(locreg.register))+':'+std_regname(locreg.register);
+{$endif}
+              else
+                result:=std_regname(locreg.register);
+            end;
+          end
+        else
+          begin
+            if locreg.registerhi<>NR_NO then
+              result:=std_regname(locreg.registerhi)+':'+std_regname(locreg.register)
+            else
+              result:=std_regname(locreg.register);
+          end;
+      end;
+
+
+{$push}
+{$r-,q-}
+    procedure calc_divconst_magic_signed(N: byte; d: aInt; out magic_m: aInt; out magic_s: byte);
+      var
+        p: aInt;
+        ad,anc,delta,q1,r1,q2,r2,t: aWord;
+        two_N_minus_1: aWord;
+      begin
+        assert((d<-1) or (d>1));
+        two_N_minus_1:=aWord(1) shl (N-1);
+
+        ad:=abs(d);
+        t:=two_N_minus_1+(aWord(d) shr (N-1));
+        anc:=t-1-t mod ad;               { absolute value of nc }
+        p:=(N-1);                        { initialize p }
+        q1:=two_N_minus_1 div anc;       { initialize q1 = 2**p/abs(nc) }
+        r1:=two_N_minus_1-q1*anc;        { initialize r1 = rem(2**p,abs(nc)) }
+        q2:=two_N_minus_1 div ad;        { initialize q2 = 2**p/abs(d) }
+        r2:=two_N_minus_1-q2*ad;         { initialize r2 = rem(2**p,abs(d)) }
+        repeat
+          inc(p);
+          q1:=2*q1;           { update q1 = 2**p/abs(nc) }
+          r1:=2*r1;           { update r1 = rem(2**p/abs(nc)) }
+          if (r1>=anc) then   { must be unsigned comparison }
+            begin
+              inc(q1);
+              dec(r1,anc);
+            end;
+          q2:=2*q2;           { update q2 = 2p/abs(d) }
+          r2:=2*r2;           { update r2 = rem(2p/abs(d)) }
+          if (r2>=ad) then    { must be unsigned comparison }
+            begin
+              inc(q2);
+              dec(r2,ad);
+            end;
+          delta:=ad-r2;
+        until not ((q1<delta) or ((q1=delta) and (r1=0)));
+        magic_m:=q2+1;
+        if (d<0) then
+          magic_m:=-magic_m;  { resulting magic number }
+        magic_s:=p-N;         { resulting shift }
+      end;
+
+
+    procedure calc_divconst_magic_unsigned(N: byte; d: aWord; out magic_m: aWord; out magic_add: boolean; out magic_shift: byte);
+      var
+        p: aInt;
+        nc,delta,q1,r1,q2,r2,two_N_minus_1 : aWord;
+        mask: aWord;
+      begin
+        two_N_minus_1:=aWord(1) shl (N-1);
+        magic_add:=false;
+{$push}
+{$warnings off }
+        mask:=aWord(not 0) shr ((64-N) and (sizeof(aWord)*8-1));
+        nc:=(mask-(-d) mod aInt(d));
+{$pop}
+        p:=N-1;                       { initialize p }
+        q1:=two_N_minus_1 div nc;     { initialize q1 = 2**p/nc }
+        r1:=two_N_minus_1-q1*nc;      { initialize r1 = rem(2**p,nc) }
+        q2:=(two_N_minus_1-1) div d;  { initialize q2 = (2**p-1)/d }
+        r2:=(two_N_minus_1-1)-q2*d;   { initialize r2 = rem((2**p-1),d) }
+        repeat
+          inc(p);
+          if (r1>=(nc-r1)) then
+            begin
+              q1:=2*q1+1;    { update q1 }
+              r1:=2*r1-nc;   { update r1 }
+            end
+          else
+            begin
+              q1:=2*q1;      { update q1 }
+              r1:=2*r1;      { update r1 }
+            end;
+          if ((r2+1)>=(d-r2)) then
+            begin
+              if (q2>=(two_N_minus_1-1)) then
+                magic_add:=true;
+              q2:=2*q2+1;    { update q2 }
+              r2:=2*r2+1-d;  { update r2 }
+            end
+          else
+            begin
+              if (q2>=two_N_minus_1) then
+                magic_add:=true;
+              q2:=2*q2;      { update q2 }
+              r2:=2*r2+1;    { update r2 }
+            end;
+          delta:=d-1-r2;
+        until not ((p<(2*N)) and ((q1<delta) or ((q1=delta) and (r1=0))));
+        magic_m:=(q2+1) and mask;        { resulting magic number }
+        magic_shift:=p-N;     { resulting shift }
+      end;
+{$pop}
+
 end.
 

compiler/compiler.pas

@@ -65,6 +65,9 @@ uses
 {$ifdef android}
   ,i_android
 {$endif android}
+{$ifdef aros}
+  ,i_aros
+{$endif}
 {$ifdef atari}
   ,i_atari
 {$endif atari}

compiler/compinnr.inc

@@ -115,6 +115,10 @@ const
    in_arctan_real      = 130;
    in_ln_real          = 131;
    in_sin_real         = 132;
+   in_fma_single       = 133;
+   in_fma_double       = 134;
+   in_fma_extended     = 135;
+   in_fma_float128     = 136;
 
 { MMX functions }
   { these contants are used by the mmx unit }

compiler/constexp.pas

@@ -41,7 +41,7 @@ type  Tconstexprint=record
  build trouble when compiling the directory utils, since the cpu directory
  isn't searched there. Therefore we use a procvar and make verbose install
  the errorhandler. A dependency from verbose on this unit is no problem.}
-var   internalerror:errorproc;
+var   internalerrorproc:errorproc;
 
 {Same issue, avoid dependency on cpuinfo because the cpu directory isn't
  searched during utils building.}
@@ -87,7 +87,14 @@ function tostr(const i:Tconstexprint):shortstring;overload;
 implementation
 {****************************************************************************}
 
+{ use a separate procedure here instead of calling internalerrorproc directly because
+  - procedure variables cannot have a noreturn directive
+  - having a procedure and a procedure variable with the same name in the interfaces of different units is confusing }
+procedure internalerror(i:longint);{$ifndef VER2_6}noreturn;{$endif VER2_6}
 
+begin
+  internalerrorproc(i);
+end;
 
 operator := (const u:qword):Tconstexprint;
 

compiler/crefs.pas

@@ -50,11 +50,8 @@ begin
 end;
 
 Function TRefItem.GetCopy : TLinkedListItem;
-var
-  NR : TRefItem;
 begin
-  NR.Create(RefInfo);
-  GetCopy:=NR;
+  Result:=TRefItem.Create(RefInfo);
 end;
 
 procedure TRefLinkedList.WriteToPPU;

compiler/cresstr.pas

@@ -32,7 +32,7 @@ implementation
 
 uses
    SysUtils,
-   cclasses,
+   cclasses,widestr,
    cutils,globtype,globals,systems,
    symconst,symtype,symdef,symsym,
    verbose,fmodule,ppu,
@@ -64,7 +64,7 @@ uses
         constructor Create;
         destructor  Destroy;override;
         procedure CreateResourceStringData;
-        Procedure WriteResourceFile;
+        procedure WriteRSJFile;
         procedure RegisterResourceStrings;
       end;
 
@@ -152,8 +152,8 @@ uses
         { Write unitname entry }
         namelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],@current_module.localsymtable.name^[1],length(current_module.localsymtable.name^),getansistringcodepage,False);
         current_asmdata.asmlists[al_resourcestrings].concat(tai_const.Create_sym_offset(namelab.lab,namelab.ofs));
-        current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(nil));
-        current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(nil));
+        current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_nil_dataptr);
+        current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_nil_dataptr);
         current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_32bit(0));
 {$ifdef cpu64bitaddr}
         current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_32bit(0));
@@ -214,89 +214,73 @@ uses
           current_asmdata.asmlists[al_resourcestrings].concat(Tai_const.create_sym(endsymlab));
       end;
 
-
-    Procedure Tresourcestrings.WriteResourceFile;
-      Type
-        TMode = (quoted,unquoted);
+    procedure Tresourcestrings.WriteRSJFile;
       Var
-        F : Text;
-        Mode : TMode;
-        R : TResourceStringItem;
-        C : char;
-        Col,i : longint;
-        ResFileName : string;
-
-        Procedure Add(Const S : String);
-        begin
-          Write(F,S);
-          inc(Col,length(s));
-        end;
-
+        F: Text;
+        R: TResourceStringItem;
+        ResFileName: string;
+        I: Integer;
+        C: tcompilerwidechar;
+        W: pcompilerwidestring;
       begin
-        ResFileName:=ChangeFileExt(current_module.ppufilename,'.rst');
+        ResFileName:=ChangeFileExt(current_module.ppufilename,'.rsj');
         message1 (general_i_writingresourcefile,ExtractFileName(ResFileName));
         Assign(F,ResFileName);
         {$push}{$i-}
         Rewrite(f);
         {$pop}
-        If IOresult<>0 then
+        if IOresult<>0 then
           begin
             message1(general_e_errorwritingresourcefile,ResFileName);
             exit;
           end;
+        writeln(f,'{"version":1,"strings":[');
         R:=TResourceStringItem(List.First);
         while assigned(R) do
           begin
-            writeln(f);
-            Writeln(f,'# hash value = ',R.Hash);
-            col:=0;
-            Add(R.Name+'=');
-            Mode:=unquoted;
-            For I:=0 to R.Len-1 do
-             begin
-               C:=R.Value[i];
-               If (ord(C)>31) and (Ord(c)<=128) and (c<>'''') then
-                begin
-                  If mode=Quoted then
-                   Add(c)
+            write(f, '{"hash":',R.Hash,',"name":"',R.Name,'","value":"');
+            initwidestring(W);
+            ascii2unicode(R.Value,R.Len,current_settings.sourcecodepage,W);
+            for I := 0 to W^.len - 1 do
+              begin
+                C := W^.Data[I];
+                case C of
+                  Ord('"'), Ord('\'), Ord('/'):
+                    write(f, '\', Chr(C));
+                  8:
+                    write(f, '\b');
+                  9:
+                    write(f, '\t');
+                  10:
+                    write(f, '\n');
+                  13:
+                    write(f, '\r');
+                  12:
+                    write(f, '\f');
                   else
-                   begin
-                     Add(''''+c);
-                     mode:=quoted
-                   end;
-                end
-               else
-                begin
-                  If Mode=quoted then
-                   begin
-                     Add('''');
-                     mode:=unquoted;
-                   end;
-                  Add('#'+tostr(ord(c)));
-                end;
-               If Col>72 then
-                begin
-                  if mode=quoted then
-                   Write (F,'''');
-                  Writeln(F,'+');
-                  Col:=0;
-                  Mode:=unQuoted;
+                  if (C < 32) or (C > 127) then
+                    write(f,'\u',hexStr(Longint(C), 4))
+                  else
+                    write(f,Chr(C));
                 end;
-             end;
-            if mode=quoted then
-             writeln (f,'''');
-            Writeln(f);
+              end;
+            donewidestring(W);
+            write(f,'"}');
             R:=TResourceStringItem(R.Next);
+            if assigned(R) then
+              writeln(f,',')
+            else
+              writeln(f);
           end;
+        writeln(f,']}');
         close(f);
       end;
 
-
     procedure Tresourcestrings.ConstSym_Register(p:TObject;arg:pointer);
       begin
         if (tsym(p).typ=constsym) and
            (tconstsym(p).consttyp=constresourcestring) then
-          List.Concat(tResourceStringItem.Create(TConstsym(p)));
+          List.Concat(TResourceStringItem.Create(TConstsym(p)));
       end;
 
 
@@ -318,7 +302,7 @@ uses
           begin
             current_module.flags:=current_module.flags or uf_has_resourcestrings;
             resstrs.CreateResourceStringData;
-            resstrs.WriteResourceFile;
+            resstrs.WriteRSJFile;
           end;
         resstrs.Free;
       end;

compiler/cstreams.pas

@@ -450,6 +450,11 @@ begin
           l:=0;
          System.Seek(FHandle,l);
        end;
+     else
+       begin
+         CStreamError:=103;
+         l:=Offset;
+       end;
    end;
   {$pop}
   CStreamError:=IOResult;
@@ -549,7 +554,10 @@ begin
     Result:=FMemory
   else
     If NewCapacity=0 then
-      FreeMem (FMemory,Fcapacity)
+      begin
+        FreeMem (FMemory,Fcapacity);
+        Result:=nil;
+      end
     else
       begin
       GetMem (Result,NewCapacity);

compiler/dbgbase.pas

@@ -418,7 +418,9 @@ implementation
         beforeappendsym(list,sym);
         case sym.typ of
           staticvarsym :
-            appendsym_staticvar(list,tstaticvarsym(sym));
+            if not assigned(tstaticvarsym(sym).fieldvarsym) or
+               not(df_generic in tdef(tstaticvarsym(sym).fieldvarsym.owner.defowner).defoptions) then
+              appendsym_staticvar(list,tstaticvarsym(sym));
           unitsym:
             appendsym_unit(list,tunitsym(sym));
           labelsym :
@@ -527,7 +529,11 @@ implementation
           begin
             sym:=tsym(st.SymList[i]);
             if (sym.visibility<>vis_hidden) and
-               (not sym.isdbgwritten) then
+               (not sym.isdbgwritten) and
+               { avoid all generic symbols }
+               not (sp_generic_dummy in sym.symoptions) and
+               not ((sym.typ=typesym) and assigned(ttypesym(sym).typedef) and
+                    (df_generic in ttypesym(sym).typedef.defoptions)) then
               appendsym(list,sym);
           end;
         case st.symtabletype of

compiler/dbgdwarf.pas

@@ -239,6 +239,16 @@ interface
         DW_FORM_ref_sig8 := $20      { reference }
         );
 
+      { values of DW_AT_address_class }
+      Tdwarf_addr = (
+        DW_ADDR_none := 0,
+        DW_ADDR_near16 := 1,
+        DW_ADDR_far16 := 2,
+        DW_ADDR_huge16 := 3,
+        DW_ADDR_near32 := 4,
+        DW_ADDR_far32 := 5
+      );
+
       TDwarfFile = record
         Index: integer;
         Name: PChar;
@@ -365,7 +375,7 @@ interface
         procedure appendsym_property(list:TAsmList;sym:tpropertysym);override;
 
         function symdebugname(sym:tsym): String; virtual;
-        function symname(sym:tsym): String; virtual;
+        function symname(sym: tsym; manglename: boolean): String; virtual;
         procedure append_visibility(vis: tvisibility);
 
         procedure enum_membersyms_callback(p:TObject;arg:pointer);
@@ -921,10 +931,10 @@ implementation
                   begin
                     if not assigned(def.typesym) then
                       internalerror(200610011);
-                    def.dwarf_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym)));
-                    def.dwarf_ref_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym)));
+                    def.dwarf_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym, true)),AT_DATA);
+                    def.dwarf_ref_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym, true)),AT_DATA);
                     if is_class_or_interface_or_dispinterface(def) or is_objectpascal_helper(def) then
-                      tobjectdef(def).dwarf_struct_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym)));
+                      tobjectdef(def).dwarf_struct_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym, true)),AT_DATA);
                     def.dbg_state:=dbg_state_written;
                   end
                 else
@@ -935,10 +945,10 @@ implementation
                        (def.owner.symtabletype=globalsymtable) and
                        (def.owner.iscurrentunit) then
                       begin
-                        def.dwarf_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym)),AB_GLOBAL,AT_DATA);
-                        def.dwarf_ref_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym)),AB_GLOBAL,AT_DATA);
+                        def.dwarf_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_DATA);
+                        def.dwarf_ref_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_DATA);
                         if is_class_or_interface_or_dispinterface(def) or is_objectpascal_helper(def) then
-                          tobjectdef(def).dwarf_struct_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym)),AB_GLOBAL,AT_DATA);
+                          tobjectdef(def).dwarf_struct_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_DATA);
                         include(def.defstates,ds_dwarf_dbg_info_written);
                       end
                     else
@@ -1251,7 +1261,7 @@ implementation
         else
           begin
             AddConstToAbbrev(ord(DW_FORM_ref4));
-            current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_info0'),sym));
+            current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_info0',AB_LOCAL,AT_DATA),sym));
           end;
       end;
 
@@ -1361,7 +1371,7 @@ implementation
                 { base type such as byte/shortint/word/... }
                 if assigned(def.typesym) then
                   append_entry(DW_TAG_base_type,false,[
-                    DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+                    DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
                     DW_AT_encoding,DW_FORM_data1,sign,
                     DW_AT_byte_size,DW_FORM_data1,fullbytesize])
                 else
@@ -1375,7 +1385,7 @@ implementation
                   {       to be always clipped to s32bit for some reason }
                   if assigned(def.typesym) then
                     append_entry(DW_TAG_subrange_type,false,[
-                      DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+                      DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
                       DW_AT_lower_bound,signform,int64(def.low),
                       DW_AT_upper_bound,signform,int64(def.high)
                       ])
@@ -1534,7 +1544,7 @@ implementation
             if assigned(def.typesym) then
               begin
                 append_entry(DW_TAG_base_type,false,[
-                  DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+                  DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
                   DW_AT_encoding,DW_FORM_data1,DW_ATE_float,
                   DW_AT_byte_size,DW_FORM_data1,def.size
                   ]);
@@ -1559,7 +1569,7 @@ implementation
             { we should use DW_ATE_signed_fixed, however it isn't supported yet by GDB (FK) }
             if assigned(def.typesym) then
               append_entry(DW_TAG_base_type,false,[
-                DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+                DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
                 DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
                 DW_AT_byte_size,DW_FORM_data1,8
                 ])
@@ -1571,7 +1581,7 @@ implementation
           s64comp:
             if assigned(def.typesym) then
               append_entry(DW_TAG_base_type,false,[
-                DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+                DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
                 DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
                 DW_AT_byte_size,DW_FORM_data1,8
                 ])
@@ -1594,7 +1604,7 @@ implementation
       begin
         if assigned(def.typesym) then
           append_entry(DW_TAG_enumeration_type,true,[
-            DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+            DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
             DW_AT_byte_size,DW_FORM_data1,def.size
             ])
         else
@@ -1615,7 +1625,7 @@ implementation
             if hp.value>def.maxval then
               break;
             append_entry(DW_TAG_enumerator,false,[
-              DW_AT_name,DW_FORM_string,symname(hp)+#0,
+              DW_AT_name,DW_FORM_string,symname(hp, false)+#0,
               DW_AT_const_value,DW_FORM_data4,hp.value
             ]);
             finish_entry;
@@ -1658,7 +1668,7 @@ implementation
             { no known size, no known upper bound }
             if assigned(def.typesym) then
               append_entry(DW_TAG_array_type,true,[
-                DW_AT_name,DW_FORM_string,symname(def.typesym)+#0
+                DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0
                 ])
             else
               append_entry(DW_TAG_array_type,true,[]);
@@ -1675,7 +1685,7 @@ implementation
             size:=def.size;
             if assigned(def.typesym) then
               append_entry(DW_TAG_array_type,true,[
-                DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+                DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
                 DW_AT_byte_size,DW_FORM_udata,size
                 ])
             else
@@ -1785,7 +1795,10 @@ implementation
           finish_children;
 
           { now the data array }
-          current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(arr,0));
+          if arr.bind=AB_GLOBAL then
+            current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(arr,0))
+          else
+            current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(arr,0));
           append_entry(DW_TAG_array_type,true,[
             DW_AT_byte_size,DW_FORM_udata,def.size,
             DW_AT_byte_stride,DW_FORM_udata,1
@@ -1793,7 +1806,7 @@ implementation
           append_labelentry_ref(DW_AT_type,def_dwarf_lab(cansichartype));
           finish_entry;
           append_entry(DW_TAG_subrange_type,false,[
-            DW_AT_lower_bound,DW_FORM_udata,0,
+            DW_AT_lower_bound,DW_FORM_udata,1,
             DW_AT_upper_bound,DW_FORM_udata,qword(slen)
             ]);
           append_labelentry_ref(DW_AT_type,def_dwarf_lab(lendef));
@@ -1854,7 +1867,7 @@ implementation
         begin
           if assigned(def.typesym) then
             append_entry(DW_TAG_subroutine_type,true,[
-              DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+              DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
               DW_AT_prototyped,DW_FORM_flag,true
             ])
           else
@@ -1869,7 +1882,7 @@ implementation
           for i:=0 to def.paras.count-1 do
             begin
               append_entry(DW_TAG_formal_parameter,false,[
-                DW_AT_name,DW_FORM_string,symname(tsym(def.paras[i]))+#0
+                DW_AT_name,DW_FORM_string,symname(tsym(def.paras[i]), false)+#0
               ]);
               append_labelentry_ref(DW_AT_type,def_dwarf_lab(tparavarsym(def.paras[i]).vardef));
               finish_entry;
@@ -1916,7 +1929,10 @@ implementation
 
             finish_children;
 
-            current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(proc,0));
+            if proc.bind=AB_GLOBAL then
+              current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(proc,0))
+            else
+              current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(proc,0));
             doappend;
           end
         else
@@ -1931,10 +1947,14 @@ implementation
         current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Definition '+def.typename)));
 
         labsym:=def_dwarf_lab(def);
-        if ds_dwarf_dbg_info_written in def.defstates then
-          current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0))
-        else
-          current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
+        case labsym.bind of
+          AB_GLOBAL:
+            current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0));
+          AB_LOCAL:
+            current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
+          else
+            internalerror(2013082001);
+        end;
 
         { On Darwin, dwarf info is not linked in the final binary,
           but kept in the individual object files. This allows for
@@ -1997,7 +2017,7 @@ implementation
           begin
             current_asmdata.getaddrlabel(TAsmLabel(pointer(labsym)));
             append_entry(DW_TAG_typedef,false,[
-              DW_AT_name,DW_FORM_string,symname(def.typesym)+#0
+              DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0
             ]);
             append_labelentry_ref(DW_AT_type,labsym);
             finish_entry;
@@ -2013,10 +2033,14 @@ implementation
         { create a derived reference type for pass-by-reference parameters }
         { (gdb doesn't support DW_AT_variable_parameter yet)               }
         labsym:=def_dwarf_ref_lab(def);
-        if ds_dwarf_dbg_info_written in def.defstates then
-          current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0))
-        else
-          current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
+        case labsym.bind of
+          AB_GLOBAL:
+            current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0));
+          AB_LOCAL:
+            current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
+          else
+            internalerror(2013082002);
+        end;
         append_entry(DW_TAG_reference_type,false,[]);
         append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
         finish_entry;
@@ -2090,7 +2114,7 @@ implementation
         current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Procdef '+def.fullprocname(true))));
         if not is_objc_class_or_protocol(def.struct) then
           append_entry(DW_TAG_subprogram,true,
-            [DW_AT_name,DW_FORM_string,symname(def.procsym)+#0
+            [DW_AT_name,DW_FORM_string,symname(def.procsym, false)+#0
             { data continues below }
             { problem: base reg isn't known here
               DW_AT_frame_base,DW_FORM_block1,1
@@ -2294,7 +2318,7 @@ implementation
 
     procedure TDebugInfoDwarf.appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
       begin
-        appendsym_var_with_name_type_offset(list,sym,symname(sym),sym.vardef,0,[]);
+        appendsym_var_with_name_type_offset(list,sym,symname(sym, false),sym.vardef,0,[]);
       end;
 
 
@@ -2306,6 +2330,8 @@ implementation
         has_high_reg : boolean;
         dreg,dreghigh : byte;
       begin
+        blocksize:=0;
+        dreghigh:=0;
         { external symbols can't be resolved at link time, so we
           can't generate stabs for them
 
@@ -2383,7 +2409,7 @@ implementation
                     else
                       begin
                         templist.concat(tai_const.create_8bit(ord(DW_OP_addr)));
-                        templist.concat(tai_const.createname(sym.mangledname,offset));
+                        templist.concat(tai_const.Create_type_name(aitconst_ptr,sym.mangledname,offset));
                         blocksize:=1+sizeof(puint);
                       end;
                   end;
@@ -2528,7 +2554,7 @@ implementation
 
     procedure TDebugInfoDwarf.appendsym_fieldvar(list:TAsmList;sym: tfieldvarsym);
       begin
-        appendsym_fieldvar_with_name_offset(list,sym,symname(sym),sym.vardef,0);
+        appendsym_fieldvar_with_name_offset(list,sym,symname(sym, false),sym.vardef,0);
       end;
 
 
@@ -2575,7 +2601,7 @@ implementation
             if (target_info.endian=endian_little) then
               bitoffset:=(fieldnatsize*8)-bitoffset-sym.vardef.packedbitsize;
             append_entry(DW_TAG_member,false,[
-              DW_AT_name,DW_FORM_string,symname(sym)+#0,
+              DW_AT_name,DW_FORM_string,symname(sym, false)+#0,
               { gcc also generates both a bit and byte size attribute }
               { we don't support ordinals >= 256 bits }
               DW_AT_byte_size,DW_FORM_data1,fieldnatsize,
@@ -2616,7 +2642,7 @@ implementation
 
         if ismember then
           append_entry(DW_TAG_member,false,[
-            DW_AT_name,DW_FORM_string,symname(sym)+#0,
+            DW_AT_name,DW_FORM_string,symname(sym, false)+#0,
           { The DW_AT_declaration tag is invalid according to the DWARF specifications.
             But gcc adds this to static const members and gdb checks
             for this flag. So we have to set it also.
@@ -2626,7 +2652,7 @@ implementation
             ])
         else
           append_entry(DW_TAG_variable,false,[
-            DW_AT_name,DW_FORM_string,symname(sym)+#0
+            DW_AT_name,DW_FORM_string,symname(sym, false)+#0
             ]);
         { for string constants, constdef isn't set because they have no real type }
         case sym.consttyp of
@@ -2666,7 +2692,7 @@ implementation
                 begin
                   AddConstToAbbrev(ord(DW_FORM_block));
                   current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sym.value.len+sizeof(pint)));
-                  current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_pint(sym.value.len));
+                  current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_pint_unaligned(sym.value.len));
                 end;
               i:=0;
               size:=sym.value.len;
@@ -2795,10 +2821,10 @@ implementation
           begin
             if (tosym.typ=fieldvarsym) then
               internalerror(2009031404);
-            appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym),sym.propdef,offset,[])
+            appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym, false),sym.propdef,offset,[])
           end
         else
-          appendsym_fieldvar_with_name_offset(list,tfieldvarsym(tosym),symname(sym),sym.propdef,offset)
+          appendsym_fieldvar_with_name_offset(list,tfieldvarsym(tosym),symname(sym, false),sym.propdef,offset)
       end;
 
 
@@ -2838,13 +2864,13 @@ implementation
                  end;
                *)
                templist.concat(tai_const.create_8bit(3));
-               templist.concat(tai_const.create_pint(sym.addroffset));
+               templist.concat(tai_const.create_pint_unaligned(sym.addroffset));
                blocksize:=1+sizeof(puint);
             end;
           toasm :
             begin
               templist.concat(tai_const.create_8bit(3));
-              templist.concat(tai_const.createname(sym.mangledname,0));
+              templist.concat(tai_const.create_type_name(aitconst_ptr,sym.mangledname,0));
               blocksize:=1+sizeof(puint);
             end;
           tovar:
@@ -2857,15 +2883,17 @@ implementation
                   flags:=[];
                   if (sym.owner.symtabletype=localsymtable) then
                     include(flags,dvf_force_local_var);
-                  appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym),tabstractvarsym(sym).vardef,offset,flags);
+                  appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym, false),tabstractvarsym(sym).vardef,offset,flags);
                 end;
               templist.free;
               exit;
             end;
+          else
+            internalerror(2013120111);
         end;
 
         append_entry(DW_TAG_variable,false,[
-          DW_AT_name,DW_FORM_string,symname(sym)+#0,
+          DW_AT_name,DW_FORM_string,symname(sym, false)+#0,
           {
           DW_AT_decl_file,DW_FORM_data1,0,
           DW_AT_decl_line,DW_FORM_data1,
@@ -2886,7 +2914,7 @@ implementation
 
     procedure TDebugInfoDwarf.beforeappendsym(list:TAsmList;sym:tsym);
       begin
-        current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Symbol '+symname(sym))));
+        current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Symbol '+symname(sym, true))));
       end;
 
 
@@ -2960,7 +2988,7 @@ implementation
         if use_64bit_headers then
           linelist.concat(tai_const.create_32bit_unaligned(longint($FFFFFFFF)));
         linelist.concat(tai_const.create_rel_sym(offsetreltype,
-          lbl,current_asmdata.RefAsmSymbol(target_asm.labelprefix+'edebug_line0')));
+          lbl,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'edebug_line0',AB_LOCAL,AT_DATA)));
         linelist.concat(tai_label.create(lbl));
 
         { version }
@@ -2969,7 +2997,7 @@ implementation
         { header length }
         current_asmdata.getlabel(lbl,alt_dbgfile);
         linelist.concat(tai_const.create_rel_sym(offsetreltype,
-          lbl,current_asmdata.RefAsmSymbol(target_asm.labelprefix+'ehdebug_line0')));
+          lbl,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'ehdebug_line0',AB_LOCAL,AT_DATA)));
         linelist.concat(tai_label.create(lbl));
 
         { minimum_instruction_length }
@@ -3078,6 +3106,7 @@ implementation
         def: tdef;
         dbgname: string;
         vardatatype: ttypesym;
+        bind: tasmsymbind;
       begin
         current_module.flags:=current_module.flags or uf_has_dwarf_debuginfo;
         storefilepos:=current_filepos;
@@ -3109,7 +3138,7 @@ implementation
         if use_64bit_headers then
           current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(longint($FFFFFFFF)));
         current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,
-          lenstartlabel,current_asmdata.RefAsmSymbol(target_asm.labelprefix+'edebug_info0')));
+          lenstartlabel,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'edebug_info0',AB_LOCAL,AT_DATA)));
 
         current_asmdata.asmlists[al_dwarf_info].concat(tai_label.create(lenstartlabel));
         { version }
@@ -3117,11 +3146,11 @@ implementation
         { abbrev table (=relative from section start)}
         if not(tf_dwarf_relative_addresses in target_info.flags) then
           current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(offsetabstype,
-            current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_abbrev0')))
+            current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_abbrev0',AB_LOCAL,AT_DATA)))
         else
           current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,
-            current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_abbrevsection0'),
-            current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_abbrev0')));
+            current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_abbrevsection0',AB_LOCAL,AT_DATA),
+            current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_abbrev0',AB_LOCAL,AT_DATA)));
 
         { address size }
         current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sizeof(pint)));
@@ -3136,23 +3165,28 @@ implementation
 
         { reference to line info section }
         if not(tf_dwarf_relative_addresses in target_info.flags) then
-          append_labelentry_dataptr_abs(DW_AT_stmt_list,current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_line0'))
+          append_labelentry_dataptr_abs(DW_AT_stmt_list,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_line0',AB_LOCAL,AT_DATA))
         else
           append_labelentry_dataptr_rel(DW_AT_stmt_list,
-            current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_linesection0'),
-            current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_line0'));
+            current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_linesection0',AB_LOCAL,AT_DATA),
+            current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_line0',AB_LOCAL,AT_DATA));
 
         if (m_objectivec1 in current_settings.modeswitches) then
           append_attribute(DW_AT_APPLE_major_runtime_vers,DW_FORM_data1,[1]);
 
         dbgname:=make_mangledname('DEBUGSTART',current_module.localsymtable,'');
         if (target_info.system in systems_darwin) then
-          dbgname:='L'+dbgname;
-        append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(dbgname));
+          begin
+            bind:=AB_LOCAL;
+            dbgname:='L'+dbgname;
+          end
+        else
+          bind:=AB_GLOBAL;
+        append_labelentry(DW_AT_low_pc,current_asmdata.DefineAsmSymbol(dbgname,bind,AT_DATA));
         dbgname:=make_mangledname('DEBUGEND',current_module.localsymtable,'');
         if (target_info.system in systems_darwin) then
           dbgname:='L'+dbgname;
-        append_labelentry(DW_AT_high_pc,current_asmdata.RefAsmSymbol(dbgname));
+        append_labelentry(DW_AT_high_pc,current_asmdata.DefineAsmSymbol(dbgname,bind,AT_DATA));
 
         finish_entry;
 
@@ -3236,7 +3270,7 @@ implementation
       end;
 
 
-    function TDebugInfoDwarf.symname(sym: tsym): String;
+    function TDebugInfoDwarf.symname(sym: tsym; manglename: boolean): String;
       begin
         if (sym.typ=paravarsym) and
            (vo_is_self in tparavarsym(sym).varoptions) then
@@ -3256,9 +3290,20 @@ implementation
         else if (ds_dwarf_method_class_prefix in current_settings.debugswitches) and
                 (sym.typ=procsym) and
                 (tprocsym(sym).owner.symtabletype in [objectsymtable,recordsymtable]) then
-          result:=tprocsym(sym).owner.name^+'__'+symdebugname(sym)
+          begin
+            result:=tprocsym(sym).owner.name^+'__';
+            if manglename then
+              result := result + sym.name
+            else
+              result := result + symdebugname(sym);
+          end
         else
-          result:=symdebugname(sym);
+          begin
+            if manglename then
+              result := sym.name
+            else
+              result := symdebugname(sym);
+          end;
       end;
 
 
@@ -3483,7 +3528,7 @@ implementation
           file recs. are less than 1k so using data2 is enough }
         if assigned(def.typesym) then
           append_entry(DW_TAG_structure_type,false,[
-           DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+           DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
            DW_AT_byte_size,DW_FORM_udata,def.size
           ])
         else
@@ -3626,7 +3671,7 @@ implementation
 
             if assigned(def.typesym) then
               append_entry(DW_TAG_set_type,false,[
-                DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+                DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
                 DW_AT_byte_size,DW_FORM_data2,def.size
                 ])
             else
@@ -3641,7 +3686,10 @@ implementation
                   current_asmdata.getaddrlabel(lab);
                 append_labelentry_ref(DW_AT_type,lab);
                 finish_entry;
-                current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lab,0));
+                if lab.bind=AB_GLOBAL then
+                  current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(lab,0))
+                else
+                  current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lab,0));
                 { Sets of e.g. [1..5] are actually stored as a set of [0..7],
                   so write the exact boundaries of the set here. Let's hope no
                   debugger ever rejects this because this "subrange" type can
@@ -3659,7 +3707,7 @@ implementation
             { info of modules that contain set tags                          }
             if assigned(def.typesym) then
               append_entry(DW_TAG_base_type,false,[
-                DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+                DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
                 DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
                 DW_AT_byte_size,DW_FORM_data2,def.size
                 ])
@@ -3727,7 +3775,7 @@ implementation
 
         if assigned(def.typesym) then
           append_entry(DW_TAG_array_type,true,[
-            DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+            DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
             DW_AT_data_location,DW_FORM_block1,2
             ])
         else
@@ -3898,7 +3946,7 @@ implementation
       begin
         if assigned(def.typesym) then
           append_entry(DW_TAG_file_type,false,[
-            DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+            DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
             DW_AT_byte_size,DW_FORM_data2,def.size
             ])
         else
@@ -4036,7 +4084,7 @@ implementation
         { ??? can a undefined def have a typename ? }
         if assigned(def.typesym) then
           append_entry(DW_TAG_unspecified_type,false,[
-            DW_AT_name,DW_FORM_string,symname(def.typesym)+#0
+            DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0
             ])
         else
           append_entry(DW_TAG_unspecified_type,false,[

compiler/dbgstabs.pas

@@ -76,6 +76,7 @@ interface
         global_stab_number : word;
         vardatadef: trecorddef;
         tagtypeprefix: ansistring;
+        function use_tag_prefix(def : tdef) : boolean;
         { tsym writing }
         function  sym_var_value(const s:string;arg:pointer):string;
         function  sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):ansistring;
@@ -187,6 +188,8 @@ implementation
         result := Sym.Name
       else
         result := Sym.RealName;
+      if (Sym.typ=typesym) and (ttypesym(Sym).Fprettyname<>'') then
+        result:=ttypesym(Sym).FPrettyName;
       if target_asm.dollarsign<>'$' then
         result:=ReplaceForbiddenAsmSymbolChars(result);
     end;
@@ -241,6 +244,7 @@ implementation
       len:=0;
       varcounter:=0;
       varptr:=@varvaluedata[0];
+      varvalues[0]:=nil;
       while i<=length(s) do
         begin
           if (s[i]='$') and (i<length(s)) then
@@ -548,6 +552,16 @@ implementation
           appenddef(TAsmList(arg),tfieldvarsym(p).vardef);
       end;
 
+    function TDebugInfoStabs.use_tag_prefix(def : tdef) : boolean;
+      begin
+        { stringdefs are not all considered as 'taggable',
+          because ansi, unicode and wide strings are
+          just associated to pointer types }
+        use_tag_prefix:=(def.typ in tagtypes) and
+                      ((def.typ<>stringdef) or
+                       (tstringdef(tdef).stringtype in [st_shortstring,st_longstring]));
+      end;
+
 
     procedure TDebugInfoStabs.write_def_stabstr(list:TAsmList;def:tdef;const ss:ansistring);
       var
@@ -556,7 +570,7 @@ implementation
         st    : ansistring;
       begin
         { type prefix }
-        if def.typ in tagtypes then
+        if use_tag_prefix(def) then
           stabchar := tagtypeprefix
         else
           stabchar := 't';
@@ -1394,20 +1408,16 @@ implementation
             if target_info.system in systems_dotted_function_names then
               mangledname:='.'+mangledname;
             // LBRAC
-            ss:=tostr(STABS_N_LBRAC)+',0,0,'+mangledname;
-            if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
-              begin
-                ss:=ss+'-';
-                ss:=ss+mangledname;
-              end;
+            if af_stabs_use_function_absolute_addresses in target_asm.flags then
+              ss:=tostr(STABS_N_LBRAC)+',0,0,'+mangledname
+            else
+              ss:=tostr(STABS_N_LBRAC)+',0,0,0';
             result.concat(Tai_stab.Create_ansistr(stab_stabn,ss));
+
             // RBRAC
             ss:=tostr(STABS_N_RBRAC)+',0,0,'+stabsendlabel.name;
             if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
-              begin
-                ss:=ss+'-';
-                ss:=ss+mangledname;
-              end;
+              ss:=ss+'-'+mangledname;
             result.concat(Tai_stab.Create_ansistr(stab_stabn,ss));
 
             { the stabsendlabel must come after all other stabs for this }
@@ -1582,7 +1592,7 @@ implementation
                 if target_dbg.id=dbg_stabs then
                   st:='s'''+backspace_quote(octal_quote(strpas(pchar(sym.value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']),['"','\',#10,#13])+''''
                 else
-                  st:='s'''+stabx_quote_const(octal_quote(strpas(pchar(sym.value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']))
+                  st:='s'''+stabx_quote_const(octal_quote(strpas(pchar(sym.value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']))+''''
               else
                 st:='<constant string too long>';
             end;

compiler/dbgstabx.pas

@@ -132,7 +132,7 @@ implementation
       st    : ansistring;
     begin
       { type prefix }
-      if def.typ in tagtypes then
+      if use_tag_prefix(def) then
         stabchar := tagtypeprefix
       else
         stabchar := 't';
@@ -274,6 +274,7 @@ implementation
       if vo_is_external in sym.varoptions then
         exit;
       ismem:=not(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER,LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]);
+      isglobal:=false;
       if ismem then
         isglobal:=current_asmdata.RefAsmSymbol(sym.mangledname).bind=AB_GLOBAL;
 
@@ -299,7 +300,7 @@ implementation
       hp, inclinsertpos, last : tai;
       infile : tinputfile;
       i,
-      linenr,
+      linenr, stabx_func_level,
       nolineinfolevel: longint;
       nextlineisfunstart: boolean;
     begin
@@ -311,6 +312,7 @@ implementation
       hp:=Tai(list.first);
       nextlineisfunstart:=false;
       nolineinfolevel:=0;
+      stabx_func_level:=0;
       last:=nil;
       while assigned(hp) do
         begin
@@ -326,7 +328,11 @@ implementation
               if tai_symbol_end(hp).sym.typ = AT_FUNCTION then
                 begin
                   { end of function }
-                  list.insertbefore(Tai_stab.Create_str(stabx_ef,tostr(currfileinfo.line)),hp);
+                  if stabx_func_level > 0 then
+                    begin
+                      list.insertbefore(Tai_stab.Create_str(stabx_ef,tostr(currfileinfo.line)),hp);
+                      dec(stabx_func_level);
+                    end;
                 end;
             ait_marker :
               begin
@@ -380,6 +386,7 @@ implementation
                         may have been created in another file in case the body
                         is completely declared in an include file }
                       list.insertbefore(Tai_stab.Create_str(stabx_bf,tostr(currfileinfo.line)),hp);
+                      inc(stabx_func_level);
                       { -1 to avoid outputting a relative line 0 in the
                         function, because that means something different }
                       dec(curfunstartfileinfo.line);
@@ -388,6 +395,13 @@ implementation
 
                 end;
 
+              { implicit functions have no file information }
+              if nextlineisfunstart then
+                begin
+                  list.insertbefore(Tai_stab.Create_str(stabx_bf,tostr(currfileinfo.line)),hp);
+                  inc(stabx_func_level);
+                  nextlineisfunstart:=false;
+                end;
               if nolineinfolevel=0 then
                 begin
                   { line changed ? }

compiler/defcmp.pas

@@ -152,12 +152,24 @@ interface
     { parentdef's resultdef                                                          }
     function compatible_childmethod_resultdef(parentretdef, childretdef: tdef): boolean;
 
+    { Checks whether the class impldef or one of its parent classes implements }
+    { the interface intfdef and returns the corresponding "implementation link }
+    function find_implemented_interface(impldef,intfdef:tobjectdef):timplementedinterface;
+
+    { Checks whether to defs are related to each other. Thereby the following  }
+    { cases of curdef are implemented:                                         }
+    { - stringdef: on JVM JLObject, JLString and AnsiString are compatible     }
+    { - recorddef: on JVM records are compatible to java_fpcbaserecordtype     }
+    {              and JLObject                                                }
+    { - objectdef: if it inherits from otherdef or they are equal              }
+    function def_is_related(curdef,otherdef:tdef):boolean;
+
 
 implementation
 
     uses
       verbose,systems,constexp,
-      symtable,symsym,
+      symtable,symsym,symcpu,
       defutil,symutil;
 
 
@@ -201,6 +213,7 @@ implementation
       var
          subeq,eq : tequaltype;
          hd1,hd2 : tdef;
+         def_generic : tstoreddef;
          hct : tconverttype;
          hobjdef : tobjectdef;
          hpd : tprocdef;
@@ -312,6 +325,42 @@ implementation
                  exit;
                end;
            end;
+         { handling of partial specializations }
+         if (
+               (df_generic in def_to.defoptions) and
+               (df_specialization in def_from.defoptions) and
+               (tstoreddef(def_from).genericdef=def_to)
+             ) or (
+               (df_generic in def_from.defoptions) and
+               (df_specialization in def_to.defoptions) and
+               (tstoreddef(def_to).genericdef=def_from)
+             ) then
+           begin
+             if tstoreddef(def_from).genericdef=def_to then
+               def_generic:=tstoreddef(def_to)
+             else
+               def_generic:=tstoreddef(def_from);
+             if not assigned(def_generic.genericparas) then
+               internalerror(2014052306);
+             diff:=false;
+             for i:=0 to def_generic.genericparas.count-1 do
+               begin
+                 symfrom:=tsym(def_generic.genericparas[i]);
+                 if symfrom.typ<>typesym then
+                   internalerror(2014052307);
+                 if ttypesym(symfrom).typedef.typ<>undefineddef then
+                   diff:=true;
+                 if diff then
+                   break;
+               end;
+             if not diff then
+               begin
+                 doconv:=tc_equal;
+                 { the definitions are not exactly the same, but only equal }
+                 compare_defs_ext:=te_equal;
+                 exit;
+               end;
+           end;
 
          { we walk the wanted (def_to) types and check then the def_from
            types if there is a conversion possible }
@@ -659,15 +708,17 @@ implementation
                           if is_pchar(def_from) then
                            begin
                              doconv:=tc_pchar_2_string;
-                             { prefer ansistrings because pchars can overflow shortstrings, }
-                             { but only if ansistrings are the default (JM)                 }
-                             if (is_shortstring(def_to) and
-                                 not(cs_refcountedstrings in current_settings.localswitches)) or
-                                (is_ansistring(def_to) and
-                                 (cs_refcountedstrings in current_settings.localswitches)) then
-                               eq:=te_convert_l1
+                             { prefer ansistrings/unicodestrings because pchars
+                               can overflow shortstrings; don't use l1/l2/l3
+                               because then pchar -> ansistring has the same
+                               preference as conststring -> pchar, and this
+                               breaks webtbs/tw3328.pp }
+                             if is_ansistring(def_to) then
+                               eq:=te_convert_l2
+                             else if is_wide_or_unicode_string(def_to) then
+                               eq:=te_convert_l3
                              else
-                               eq:=te_convert_l2;
+                              eq:=te_convert_l4
                            end
                           else if is_pwidechar(def_from) then
                            begin
@@ -675,6 +726,8 @@ implementation
                              if is_wide_or_unicode_string(def_to) then
                                eq:=te_convert_l1
                              else
+                               { shortstring and ansistring can both result in
+                                 data loss, so don't prefer one over the other }
                                eq:=te_convert_l3;
                            end;
                        end;
@@ -1140,7 +1193,10 @@ implementation
                         (is_pchar(def_to) or is_pwidechar(def_to)) then
                       begin
                         doconv:=tc_cstring_2_pchar;
-                        eq:=te_convert_l2;
+                        if is_pwidechar(def_to)=(m_default_unicodestring in current_settings.modeswitches) then
+                          eq:=te_convert_l2
+                        else
+                          eq:=te_convert_l3
                       end
                      else
                       if (cdo_explicit in cdoptions) or (fromtreetype = arrayconstructorn) then
@@ -1171,7 +1227,10 @@ implementation
                            (is_pchar(def_to) or is_pwidechar(def_to)) then
                          begin
                            doconv:=tc_cchar_2_pchar;
-                           eq:=te_convert_l1;
+                           if is_pwidechar(def_to)=(m_default_unicodestring in current_settings.modeswitches) then
+                             eq:=te_convert_l1
+                           else
+                             eq:=te_convert_l2
                          end
                         else
                          if (m_delphi in current_settings.modeswitches) and is_integer(def_from) then
@@ -1280,7 +1339,7 @@ implementation
                    begin
 {$ifdef x86}
                      { check for far pointers }
-                     if (tpointerdef(def_from).x86pointertyp<>tpointerdef(def_to).x86pointertyp) then
+                     if (tcpupointerdef(def_from).x86pointertyp<>tcpupointerdef(def_to).x86pointertyp) then
                        begin
                          if fromtreetype=niln then
                            eq:=te_equal
@@ -1309,7 +1368,7 @@ implementation
                       if (
                           (tpointerdef(def_from).pointeddef.typ=objectdef) and
                           (tpointerdef(def_to).pointeddef.typ=objectdef) and
-                          tobjectdef(tpointerdef(def_from).pointeddef).is_related(
+                          def_is_related(tobjectdef(tpointerdef(def_from).pointeddef),
                             tobjectdef(tpointerdef(def_to).pointeddef))
                          ) then
                        begin
@@ -1506,7 +1565,7 @@ implementation
              begin
                { object pascal objects }
                if (def_from.typ=objectdef) and
-                  (tobjectdef(def_from).is_related(tobjectdef(def_to))) then
+                  (def_is_related(tobjectdef(def_from),tobjectdef(def_to))) then
                 begin
                   doconv:=tc_equal;
                   { also update in htypechk.pas/var_para_allowed if changed
@@ -1578,7 +1637,7 @@ implementation
                         hobjdef:=tobjectdef(def_from);
                         while assigned(hobjdef) do
                           begin
-                             if hobjdef.find_implemented_interface(tobjectdef(def_to))<>nil then
+                             if find_implemented_interface(hobjdef,tobjectdef(def_to))<>nil then
                                begin
                                   if is_interface(def_to) then
                                     doconv:=tc_class_2_intf
@@ -1653,7 +1712,7 @@ implementation
                     begin
                       doconv:=tc_equal;
                       if (cdo_explicit in cdoptions) or
-                         tobjectdef(tclassrefdef(def_from).pointeddef).is_related(
+                         def_is_related(tobjectdef(tclassrefdef(def_from).pointeddef),
                            tobjectdef(tclassrefdef(def_to).pointeddef)) then
                         eq:=te_convert_l1;
                     end;
@@ -2109,8 +2168,8 @@ implementation
 
     function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef;checkincompatibleuniv: boolean):tequaltype;
       var
-        eq : tequaltype;
-        po_comp : tprocoptions;
+        eq: tequaltype;
+        po_comp: tprocoptions;
         pa_comp: tcompare_paras_options;
       begin
          proc_to_procvar_equal:=te_incompatible;
@@ -2144,8 +2203,10 @@ implementation
          if checkincompatibleuniv then
            include(pa_comp,cpo_warn_incompatible_univ);
          { check return value and options, methodpointer is already checked }
-         po_comp:=[po_staticmethod,po_interrupt,
-                   po_iocheck,po_varargs];
+         po_comp:=[po_interrupt,po_iocheck,po_varargs];
+         { check static only if we compare method pointers }
+         if def1.is_methodpointer then
+           include(po_comp,po_staticmethod);
          if (m_delphi in current_settings.modeswitches) then
            exclude(po_comp,po_varargs);
          if (def1.proccalloption=def2.proccalloption) and
@@ -2177,8 +2238,166 @@ implementation
            (childretdef.typ=objectdef) and
            is_class_or_interface_or_objc_or_java(parentretdef) and
            is_class_or_interface_or_objc_or_java(childretdef) and
-           (tobjectdef(childretdef).is_related(tobjectdef(parentretdef))))
+           (def_is_related(tobjectdef(childretdef),tobjectdef(parentretdef))))
+      end;
+
+
+    function find_implemented_interface(impldef,intfdef:tobjectdef):timplementedinterface;
+      var
+        implintf : timplementedinterface;
+        i : longint;
+      begin
+        if not assigned(impldef) then
+          internalerror(2013102301);
+        if not assigned(intfdef) then
+          internalerror(2013102302);
+        result:=nil;
+        if not assigned(impldef.implementedinterfaces) then
+          exit;
+        for i:=0 to impldef.implementedinterfaces.count-1 do
+          begin
+            implintf:=timplementedinterface(impldef.implementedinterfaces[i]);
+            if equal_defs(implintf.intfdef,intfdef) then
+              begin
+                result:=implintf;
+                exit;
+              end;
+          end;
       end;
 
 
+    function stringdef_is_related(curdef:tstringdef;otherdef:tdef):boolean;
+      begin
+        result:=
+          (target_info.system in systems_jvm) and
+          (((curdef.stringtype in [st_unicodestring,st_widestring]) and
+            ((otherdef=java_jlobject) or
+             (otherdef=java_jlstring))) or
+           ((curdef.stringtype=st_ansistring) and
+            ((otherdef=java_jlobject) or
+             (otherdef=java_ansistring))));
+      end;
+
+
+    function recorddef_is_related(curdef:trecorddef;otherdef:tdef):boolean;
+      begin
+        { records are implemented via classes in the JVM target, and are
+          all descendents of the java_fpcbaserecordtype class }
+        result:=false;
+        if (target_info.system in systems_jvm) then
+          begin
+            if otherdef.typ=objectdef then
+              begin
+                otherdef:=find_real_class_definition(tobjectdef(otherdef),false);
+                if (otherdef=java_jlobject) or
+                   (otherdef=java_fpcbaserecordtype) then
+                  result:=true
+              end;
+          end;
+      end;
+
+
+    { true if prot implements d (or if they are equal) }
+    function is_related_interface_multiple(prot:tobjectdef;d:tdef):boolean;
+      var
+        i : longint;
+      begin
+        { objcprotocols have multiple inheritance, all protocols from which
+          the current protocol inherits are stored in implementedinterfaces }
+        result:=prot=d;
+        if result then
+          exit;
+
+        for i:=0 to prot.implementedinterfaces.count-1 do
+          begin
+            result:=is_related_interface_multiple(timplementedinterface(prot.implementedinterfaces[i]).intfdef,d);
+            if result then
+              exit;
+          end;
+      end;
+
+
+    function objectdef_is_related(curdef:tobjectdef;otherdef:tdef):boolean;
+      var
+         realself,
+         hp : tobjectdef;
+      begin
+        if (otherdef.typ=objectdef) then
+          otherdef:=find_real_class_definition(tobjectdef(otherdef),false);
+        realself:=find_real_class_definition(curdef,false);
+        if realself=otherdef then
+          begin
+            result:=true;
+            exit;
+          end;
+
+        if (otherdef.typ<>objectdef) then
+          begin
+            result:=false;
+            exit;
+          end;
+
+        { Objective-C protocols and Java interfaces can use multiple
+           inheritance }
+        if (realself.objecttype in [odt_objcprotocol,odt_interfacejava]) then
+          begin
+            result:=is_related_interface_multiple(realself,otherdef);
+            exit;
+          end;
+
+        { formally declared Objective-C and Java classes match Objective-C/Java
+          classes with the same name. In case of Java, the package must also
+          match (still required even though we looked up the real definitions
+          above, because these may be two different formal declarations that
+          cannot be resolved yet) }
+        if (realself.objecttype in [odt_objcclass,odt_javaclass]) and
+           (tobjectdef(otherdef).objecttype=curdef.objecttype) and
+           ((oo_is_formal in curdef.objectoptions) or
+            (oo_is_formal in tobjectdef(otherdef).objectoptions)) and
+           (curdef.objrealname^=tobjectdef(otherdef).objrealname^) then
+          begin
+            { check package name for Java }
+            if curdef.objecttype=odt_objcclass then
+              result:=true
+            else
+              begin
+                result:=
+                  assigned(curdef.import_lib)=assigned(tobjectdef(otherdef).import_lib);
+                if result and
+                   assigned(curdef.import_lib) then
+                  result:=curdef.import_lib^=tobjectdef(otherdef).import_lib^;
+              end;
+            exit;
+          end;
+
+        hp:=realself.childof;
+        while assigned(hp) do
+          begin
+             if equal_defs(hp,otherdef) then
+               begin
+                  result:=true;
+                  exit;
+               end;
+             hp:=hp.childof;
+          end;
+        result:=false;
+      end;
+
+
+    function def_is_related(curdef,otherdef:tdef):boolean;
+      begin
+        if not assigned(curdef) then
+          internalerror(2013102303);
+        case curdef.typ of
+          stringdef:
+            result:=stringdef_is_related(tstringdef(curdef),otherdef);
+          recorddef:
+            result:=recorddef_is_related(trecorddef(curdef),otherdef);
+          objectdef:
+            result:=objectdef_is_related(tobjectdef(curdef),otherdef);
+          else
+            result:=false;
+        end;
+      end;
+
 end.

compiler/defutil.pas

@@ -228,6 +228,9 @@ interface
     {# Returns true, if definition is a "real" real (i.e. single/double/extended) }
     function is_real(def : tdef) : boolean;
 
+    {# Returns true for single,double,extended and cextended }
+    function is_real_or_cextended(def : tdef) : boolean;
+
     { true, if def is a 8 bit int type }
     function is_8bitint(def : tdef) : boolean;
 
@@ -328,18 +331,10 @@ interface
     { returns true of def is a methodpointer }
     function is_methodpointer(def : tdef) : boolean;
 
-{$ifdef i8086}
-    {# Returns true if p is a far pointer def }
-    function is_farpointer(p : tdef) : boolean;
-
-    {# Returns true if p is a huge pointer def }
-    function is_hugepointer(p : tdef) : boolean;
-{$endif i8086}
-
 implementation
 
     uses
-       verbose,cutils;
+       verbose,cutils,symcpu;
 
     { returns true, if def uses FPU }
     function is_fpu(def : tdef) : boolean;
@@ -395,6 +390,13 @@ implementation
       end;
 
 
+    function is_real_or_cextended(def: tdef): boolean;
+      begin
+        result:=(def.typ=floatdef) and
+          (tfloatdef(def).floattype in [s32real,s64real,s80real,sc80real]);
+      end;
+
+
     function range_to_basetype(l,h:TConstExprInt):tordtype;
       begin
         { prefer signed over unsigned }
@@ -675,10 +677,10 @@ implementation
     { true, if p points to an open array def }
     function is_open_array(p : tdef) : boolean;
       begin
-         { check for s32inttype is needed, because for u32bit the high
+         { check for ptrsinttype is needed, because for unsigned the high
            range is also -1 ! (PFV) }
          result:=(p.typ=arraydef) and
-                 (tarraydef(p).rangedef=s32inttype) and
+                 (tarraydef(p).rangedef=ptrsinttype) and
                  (tarraydef(p).lowrange=0) and
                  (tarraydef(p).highrange=-1) and
                  ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])=[]);
@@ -1201,12 +1203,11 @@ implementation
                 result:=tcgsize(ord(result)+(ord(OS_S8)-ord(OS_8)));
             end;
           classrefdef,
-          pointerdef,
-          formaldef:
+          pointerdef:
             begin
 {$ifdef x86}
               if (def.typ=pointerdef) and
-                 (tpointerdef(def).x86pointertyp in [x86pt_far,x86pt_huge]) then
+                 (tcpupointerdef(def).x86pointertyp in [x86pt_far,x86pt_huge]) then
                 begin
                   {$if defined(i8086)}
                     result := OS_32;
@@ -1218,24 +1219,16 @@ implementation
                 end
               else
 {$endif x86}
-                result := OS_ADDR;
+                result := int_cgsize(def.size);
             end;
+          formaldef:
+            result := int_cgsize(voidpointertype.size);
           procvardef:
             result:=int_cgsize(def.size);
           stringdef :
-            begin
-              if is_ansistring(def) or is_wide_or_unicode_string(def) then
-                result := OS_ADDR
-              else
-                result:=int_cgsize(def.size);
-            end;
+            result:=int_cgsize(def.size);
           objectdef :
-            begin
-              if is_implicit_pointer_object_type(def) then
-                result := OS_ADDR
-              else
-                result:=int_cgsize(def.size);
-            end;
+            result:=int_cgsize(def.size);
           floatdef:
             if cs_fp_emulation in current_settings.moduleswitches then
               result:=int_cgsize(def.size)
@@ -1245,15 +1238,10 @@ implementation
             result:=int_cgsize(def.size);
           arraydef :
             begin
-              if not is_special_array(def) then
+              if is_dynamic_array(def) or not is_special_array(def) then
                 result := int_cgsize(def.size)
               else
-                begin
-                  if is_dynamic_array(def) then
-                    result := OS_ADDR
-                  else
-                    result := OS_NO;
-                end;
+                result := OS_NO;
             end;
           else
             begin
@@ -1437,18 +1425,4 @@ implementation
         result:=(def.typ=procvardef) and (po_methodpointer in tprocvardef(def).procoptions);
       end;
 
-{$ifdef i8086}
-    { true if p is a far pointer def }
-    function is_farpointer(p : tdef) : boolean;
-      begin
-        result:=(p.typ=pointerdef) and (tpointerdef(p).x86pointertyp=x86pt_far);
-      end;
-
-    { true if p is a huge pointer def }
-    function is_hugepointer(p : tdef) : boolean;
-      begin
-        result:=(p.typ=pointerdef) and (tpointerdef(p).x86pointertyp=x86pt_huge);
-      end;
-{$endif i8086}
-
 end.

compiler/dirparse.pas

@@ -0,0 +1,335 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    This unit implements some support functions for the parsing of directives
+    and option strings
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+unit dirparse;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      globtype,
+      systems;
+
+    function UpdateAlignmentStr(s:string;var a:talignmentinfo):boolean;
+    function UpdateOptimizerStr(s:string;var a:toptimizerswitches):boolean;
+    function UpdateWpoStr(s: string; var a: twpoptimizerswitches): boolean;
+    function UpdateDebugStr(s:string;var a:tdebugswitches):boolean;
+    function UpdateTargetSwitchStr(s: string; var a: ttargetswitches; global: boolean): boolean;
+
+implementation
+
+    uses
+      globals,
+      cutils,
+      symtable;
+
+    function UpdateAlignmentStr(s:string;var a:talignmentinfo):boolean;
+      var
+        tok  : string;
+        vstr : string;
+        l    : longint;
+        code : integer;
+        b    : talignmentinfo;
+      begin
+        UpdateAlignmentStr:=true;
+        uppervar(s);
+        fillchar(b,sizeof(b),0);
+        repeat
+          tok:=GetToken(s,'=');
+          if tok='' then
+           break;
+          vstr:=GetToken(s,',');
+          val(vstr,l,code);
+          if tok='PROC' then
+           b.procalign:=l
+          else if tok='JUMP' then
+           b.jumpalign:=l
+          else if tok='LOOP' then
+           b.loopalign:=l
+          else if tok='CONSTMIN' then
+           begin
+             b.constalignmin:=l;
+             if l>b.constalignmax then
+               b.constalignmax:=l;
+           end
+          else if tok='CONSTMAX' then
+           b.constalignmax:=l
+          else if tok='VARMIN' then
+           begin
+             b.varalignmin:=l;
+             if l>b.varalignmax then
+               b.varalignmax:=l;
+           end
+          else if tok='VARMAX' then
+           b.varalignmax:=l
+          else if tok='LOCALMIN' then
+           begin
+             b.localalignmin:=l;
+             if l>b.localalignmax then
+               b.localalignmax:=l;
+           end
+          else if tok='LOCALMAX' then
+           b.localalignmax:=l
+          else if tok='RECORDMIN' then
+           begin
+             b.recordalignmin:=l;
+             if l>b.recordalignmax then
+               b.recordalignmax:=l;
+           end
+          else if tok='RECORDMAX' then
+           b.recordalignmax:=l
+          else { Error }
+           UpdateAlignmentStr:=false;
+        until false;
+        Result:=Result and UpdateAlignment(a,b);
+      end;
+
+
+    function UpdateOptimizerStr(s:string;var a:toptimizerswitches):boolean;
+      var
+        tok   : string;
+        doset,
+        found : boolean;
+        opt   : toptimizerswitch;
+      begin
+        result:=true;
+        uppervar(s);
+        repeat
+          tok:=GetToken(s,',');
+          if tok='' then
+           break;
+          if Copy(tok,1,2)='NO' then
+            begin
+              delete(tok,1,2);
+              doset:=false;
+            end
+          else
+            doset:=true;
+          found:=false;
+          for opt:=low(toptimizerswitch) to high(toptimizerswitch) do
+            begin
+              if OptimizerSwitchStr[opt]=tok then
+                begin
+                  found:=true;
+                  break;
+                end;
+            end;
+          if found then
+            begin
+              if doset then
+                include(a,opt)
+              else
+                exclude(a,opt);
+            end
+          else
+            result:=false;
+        until false;
+      end;
+
+
+    function UpdateWpoStr(s: string; var a: twpoptimizerswitches): boolean;
+      var
+        tok   : string;
+        doset,
+        found : boolean;
+        opt   : twpoptimizerswitch;
+      begin
+        result:=true;
+        uppervar(s);
+        repeat
+          tok:=GetToken(s,',');
+          if tok='' then
+           break;
+          if Copy(tok,1,2)='NO' then
+            begin
+              delete(tok,1,2);
+              doset:=false;
+            end
+          else
+            doset:=true;
+          found:=false;
+          if (tok = 'ALL') then
+            begin
+              for opt:=low(twpoptimizerswitch) to high(twpoptimizerswitch) do
+                if doset then
+                  include(a,opt)
+                else
+                  exclude(a,opt);
+            end
+          else
+            begin
+              for opt:=low(twpoptimizerswitch) to high(twpoptimizerswitch) do
+                begin
+                  if WPOptimizerSwitchStr[opt]=tok then
+                    begin
+                      found:=true;
+                      break;
+                    end;
+                end;
+              if found then
+                begin
+                  if doset then
+                    include(a,opt)
+                  else
+                    exclude(a,opt);
+                end
+              else
+                result:=false;
+            end;
+        until false;
+      end;
+
+
+    function UpdateDebugStr(s:string;var a:tdebugswitches):boolean;
+      var
+        tok   : string;
+        doset,
+        found : boolean;
+        opt   : tdebugswitch;
+      begin
+        result:=true;
+        uppervar(s);
+        repeat
+          tok:=GetToken(s,',');
+          if tok='' then
+           break;
+          if Copy(tok,1,2)='NO' then
+            begin
+              delete(tok,1,2);
+              doset:=false;
+            end
+          else
+            doset:=true;
+          found:=false;
+          for opt:=low(tdebugswitch) to high(tdebugswitch) do
+            begin
+              if DebugSwitchStr[opt]=tok then
+                begin
+                  found:=true;
+                  break;
+                end;
+            end;
+          if found then
+            begin
+              if doset then
+                include(a,opt)
+              else
+                exclude(a,opt);
+            end
+          else
+            result:=false;
+        until false;
+      end;
+
+
+    function UpdateTargetSwitchStr(s: string; var a: ttargetswitches; global: boolean): boolean;
+      var
+        tok,
+        value : string;
+        setstr: string[2];
+        equalspos: longint;
+        doset,
+        gotvalue,
+        found : boolean;
+        opt   : ttargetswitch;
+      begin
+        result:=true;
+        value:='';
+        repeat
+          tok:=GetToken(s,',');
+          if tok='' then
+           break;
+          setstr:=upper(copy(tok,length(tok),1));
+          if setstr='-' then
+            begin
+              setlength(tok,length(tok)-1);
+              doset:=false;
+            end
+          else
+            doset:=true;
+          { value specified? }
+          gotvalue:=false;
+          equalspos:=pos('=',tok);
+          if equalspos<>0 then
+            begin
+              value:=copy(tok,equalspos+1,length(tok));
+              delete(tok,equalspos,length(tok));
+              gotvalue:=true;
+            end;
+          found:=false;
+          uppervar(tok);
+          for opt:=low(ttargetswitch) to high(ttargetswitch) do
+            begin
+              if TargetSwitchStr[opt].name=tok then
+                begin
+                  found:=true;
+                  break;
+                end;
+            end;
+          if found then
+            begin
+              if not global and
+                 TargetSwitchStr[opt].isglobal then
+                result:=false
+              else if not TargetSwitchStr[opt].hasvalue then
+                begin
+                  if gotvalue then
+                    result:=false;
+                  if (TargetSwitchStr[opt].define<>'') and (doset xor (opt in a)) then
+                    if doset then
+                      def_system_macro(TargetSwitchStr[opt].define)
+                    else
+                      undef_system_macro(TargetSwitchStr[opt].define);
+                  if doset then
+                    include(a,opt)
+                  else
+                    exclude(a,opt)
+                end
+              else
+                begin
+                  if not gotvalue or
+                     not doset then
+                    result:=false
+                  else
+                    begin
+                      case opt of
+                        ts_auto_getter_prefix:
+                          prop_auto_getter_prefix:=value;
+                        ts_auto_setter_predix:
+                          prop_auto_setter_prefix:=value;
+                        else
+                          begin
+                            writeln('Internalerror 2012053001');
+                            halt(1);
+                          end;
+                      end;
+                    end;
+                end;
+            end
+          else
+            result:=false;
+        until false;
+      end;
+
+end.

compiler/finput.pas

@@ -226,7 +226,7 @@ uses
          close;
       { free memory }
         if assigned(linebuf) then
-         freemem(linebuf,maxlinebuf shl 2);
+         freemem(linebuf,maxlinebuf*sizeof(linebuf^[0]));
       end;
 
 
@@ -368,24 +368,16 @@ uses
 
 
     procedure tinputfile.setline(line,linepos:longint);
-      var
-        oldlinebuf  : plongintarr;
       begin
         if line<1 then
          exit;
         while (line>=maxlinebuf) do
-         begin
-           oldlinebuf:=linebuf;
-         { create new linebuf and move old info }
-           getmem(linebuf,(maxlinebuf+linebufincrease) shl 2);
-           if assigned(oldlinebuf) then
-            begin
-              move(oldlinebuf^,linebuf^,maxlinebuf shl 2);
-              freemem(oldlinebuf,maxlinebuf shl 2);
-            end;
-           fillchar(linebuf^[maxlinebuf],linebufincrease shl 2,0);
-           inc(maxlinebuf,linebufincrease);
-         end;
+          begin
+            { create new linebuf and move old info }
+            linebuf:=reallocmem(linebuf,(maxlinebuf+linebufincrease)*sizeof(linebuf^[0]));
+            fillchar(linebuf^[maxlinebuf],linebufincrease*sizeof(linebuf^[0]),0);
+            inc(maxlinebuf,linebufincrease);
+          end;
         linebuf^[line]:=linepos;
       end;
 

compiler/fmodule.pas

@@ -44,7 +44,7 @@ interface
     uses
        cutils,cclasses,cfileutl,
        globtype,finput,ogbase,
-       symbase,symsym,
+       symbase,symconst,symsym,symcpu,
        wpobase,
        aasmbase,aasmtai,aasmdata;
 
@@ -142,7 +142,7 @@ interface
         checkforwarddefs,
         deflist,
         symlist       : TFPObjectList;
-        ptrdefs       : THashSet; { list of pointerdefs created in this module so we can reuse them (not saved/restored) }
+        ptrdefs       : tPtrDefHashSet; { list of pointerdefs created in this module so we can reuse them (not saved/restored) }
         arraydefs     : THashSet; { list of single-element-arraydefs created in this module so we can reuse them (not saved/restored) }
         ansistrdef    : tobject; { an ansistring def redefined for the current module }
         wpoinfo       : tunitwpoinfobase; { whole program optimization-related information that is generated during the current run for this unit }
@@ -184,6 +184,11 @@ interface
           the full name of the type and the data is a TFPObjectList of
           tobjectdef instances (the helper defs) }
         extendeddefs: TFPHashObjectList;
+        { contains a list of the current topmost non-generic symbol for a
+          typename of which at least one generic exists; the key is the
+          non-generic typename and the data is a TFPObjectList of tgenericdummyentry
+          instances whereby the last one is the current top most one }
+        genericdummysyms: TFPHashObjectList;
 
         { this contains a list of units that needs to be waited for until the
           unit can be finished (code generated, etc.); this is needed to handle
@@ -216,7 +221,6 @@ interface
         procedure flagdependent(callermodule:tmodule);
         function  addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
         procedure updatemaps;
-        procedure check_hints;
         function  derefidx_unit(id:longint):longint;
         function  resolve_unit(id:longint):tmodule;
         procedure allunitsused;
@@ -235,6 +239,7 @@ interface
           u               : tmodule;
           unitsym         : tunitsym;
           constructor create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
+          procedure check_hints;
        end;
 
        tdependent_unit = class(tlinkedlistitem)
@@ -470,6 +475,27 @@ implementation
       end;
 
 
+    procedure tused_unit.check_hints;
+      var
+        uname: pshortstring;
+      begin
+        uname:=u.realmodulename;
+        if mo_hint_deprecated in u.moduleoptions then
+          if (mo_has_deprecated_msg in u.moduleoptions) and (u.deprecatedmsg <> nil) then
+            MessagePos2(unitsym.fileinfo,sym_w_deprecated_unit_with_msg,uname^,u.deprecatedmsg^)
+          else
+            MessagePos1(unitsym.fileinfo,sym_w_deprecated_unit,uname^);
+        if mo_hint_experimental in u.moduleoptions then
+          MessagePos1(unitsym.fileinfo,sym_w_experimental_unit,uname^);
+        if mo_hint_platform in u.moduleoptions then
+          MessagePos1(unitsym.fileinfo,sym_w_non_portable_unit,uname^);
+        if mo_hint_library in u.moduleoptions then
+          MessagePos1(unitsym.fileinfo,sym_w_library_unit,uname^);
+        if mo_hint_unimplemented in u.moduleoptions then
+          MessagePos1(unitsym.fileinfo,sym_w_non_implemented_unit,uname^);
+      end;
+
+
 {****************************************************************************
                             TDENPENDENT_UNIT
  ****************************************************************************}
@@ -541,12 +567,13 @@ implementation
         derefdataintflen:=0;
         deflist:=TFPObjectList.Create(false);
         symlist:=TFPObjectList.Create(false);
-        ptrdefs:=THashSet.Create(64,true,false);
+        ptrdefs:=cPtrDefHashSet.Create;
         arraydefs:=THashSet.Create(64,true,false);
         ansistrdef:=nil;
         wpoinfo:=nil;
         checkforwarddefs:=TFPObjectList.Create(false);
         extendeddefs:=TFPHashObjectList.Create(true);
+        genericdummysyms:=tfphashobjectlist.create(true);
         waitingforunit:=tfpobjectlist.create(false);
         waitingunits:=tfpobjectlist.create(false);
         globalsymtable:=nil;
@@ -574,7 +601,7 @@ implementation
         tcinitcode:=nil;
         _exports:=TLinkedList.Create;
         dllscannerinputlist:=TFPHashList.Create;
-        asmdata:=casmdata.create(realmodulename^);
+        asmdata:=casmdata.create(modulename);
         InitDebugInfo(self,false);
       end;
 
@@ -636,6 +663,7 @@ implementation
         stringdispose(mainname);
         FImportLibraryList.Free;
         extendeddefs.Free;
+        genericdummysyms.free;
         waitingforunit.free;
         waitingunits.free;
         stringdispose(asmprefix);
@@ -716,7 +744,7 @@ implementation
         symlist.free;
         symlist:=TFPObjectList.Create(false);
         ptrdefs.free;
-        ptrdefs:=THashSet.Create(64,true,false);
+        ptrdefs:=cPtrDefHashSet.Create;
         arraydefs.free;
         arraydefs:=THashSet.Create(64,true,false);
         wpoinfo.free;
@@ -743,7 +771,7 @@ implementation
         derefdataintflen:=0;
         sourcefiles.free;
         sourcefiles:=tinputfilemanager.create;
-        asmdata:=casmdata.create(realmodulename^);
+        asmdata:=casmdata.create(modulename);
         InitDebugInfo(self,current_debuginfo_reset);
         _exports.free;
         _exports:=tlinkedlist.create;
@@ -892,22 +920,6 @@ implementation
           end;
       end;
 
-    procedure tmodule.check_hints;
-      begin
-        if mo_hint_deprecated in moduleoptions then
-          if (mo_has_deprecated_msg in moduleoptions) and (deprecatedmsg <> nil) then
-            Message2(sym_w_deprecated_unit_with_msg,realmodulename^,deprecatedmsg^)
-          else
-            Message1(sym_w_deprecated_unit,realmodulename^);
-        if mo_hint_experimental in moduleoptions then
-          Message1(sym_w_experimental_unit,realmodulename^);
-        if mo_hint_platform in moduleoptions then
-          Message1(sym_w_non_portable_unit,realmodulename^);
-        if mo_hint_library in moduleoptions then
-          Message1(sym_w_library_unit,realmodulename^);
-        if mo_hint_unimplemented in moduleoptions then
-          Message1(sym_w_non_implemented_unit,realmodulename^);
-      end;
 
 
     function tmodule.derefidx_unit(id:longint):longint;
@@ -1017,8 +1029,7 @@ implementation
         modulename:=stringdup(upper(s));
         realmodulename:=stringdup(s);
         { also update asmlibrary names }
-        current_asmdata.name:=modulename^;
-        current_asmdata.realname:=realmodulename^;
+        current_asmdata.name:=modulename;
       end;
 
 

compiler/fpcdefs.inc

@@ -52,7 +52,7 @@
   {//$define SUPPORT_MMX}
   {$define cpumm}
   {$define fewintregisters}
-  {$define cpurox}
+  {//$define cpurox}
   {$define SUPPORT_SAFECALL}
   {$define cpuneedsmulhelper}
   { TODO: add another define in order to disable the div helper for 16-bit divs? }
@@ -74,6 +74,7 @@
   {$define cpurox}
   {$define SUPPORT_SAFECALL}
   {$define SUPPORT_GET_FRAME}
+  {$define cpucapabilities}
 {$endif i386}
 
 {$ifdef x86_64}
@@ -89,6 +90,7 @@
   {$define cpurefshaveindexreg}
   {$define SUPPORT_SAFECALL}
   {$define SUPPORT_GET_FRAME}
+  {$define cpucapabilities}
 {$endif x86_64}
 
 {$ifdef ia64}
@@ -124,7 +126,6 @@
   {$define cpumm}
   {$define cpurox}
   {$define cpurefshaveindexreg}
-  {$define fpc_compiler_has_fixup_jmps}
 {$endif powerpc}
 
 {$ifdef powerpc64}
@@ -135,7 +136,7 @@
   {$define cpumm}
   {$define cpurox}
   {$define cpurefshaveindexreg}
-  {$define fpc_compiler_has_fixup_jmps}
+  {$define cpuno32bitops}
 {$endif powerpc64}
 
 {$ifdef arm}
@@ -148,6 +149,7 @@
   {$define cpurox}
   {$define cputargethasfixedstack}
   {$define cpurefshaveindexreg}
+  {$define cpucapabilities}
   {$define SUPPORT_SAFECALL}
   {$define SUPPORT_GET_FRAME}
   { default to armel }
@@ -175,6 +177,8 @@
   {$define cpuflags}
   {$define cpufpemu}
   {$define cpurefshaveindexreg}
+  {$define cpucapabilities}
+  {$define cpuneedsdiv32helper}
 {$endif m68k}
 
 {$ifdef avr}
@@ -187,6 +191,7 @@
   {$define cpuneedsdiv32helper}
   {$define cpuneedsmulhelper}
   {$define cpurefshaveindexreg}
+  {$define cpucapabilities}
 {$endif avr}
 
 {$ifdef mipsel}
@@ -211,12 +216,13 @@
   {$else}
     {$error mips64 not yet supported}
   {$endif}
-  { define cpuflags}
+  {$define cpuflags} { Flags are emulated }
   {$define cputargethasfixedstack}
   {$define cpurequiresproperalignment}
   { define cpumm}
   {$define cpurefshaveindexreg}
-  {$define fpc_compiler_has_fixup_jmps}
+  {$define SUPPORT_GET_FRAME}
+  {$define SUPPORT_SAFECALL}
 {$endif mips}
 
 {$ifdef jvm}

compiler/fppu.pas

@@ -108,7 +108,7 @@ interface
 implementation
 
 uses
-  SysUtils,strutils,
+  SysUtils,
   cfileutl,
   systems,version,
   symtable, symsym,
@@ -230,6 +230,41 @@ var
            Message(unit_u_ppu_invalid_target,@queuecomment);
            exit;
          end;
+{$ifdef i8086}
+      { check i8086 memory model flags }
+        if ((ppufile.header.flags and uf_i8086_far_code)<>0) xor
+            (current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge]) then
+         begin
+           ppufile.free;
+           ppufile:=nil;
+           Message(unit_u_ppu_invalid_memory_model,@queuecomment);
+           exit;
+         end;
+        if ((ppufile.header.flags and uf_i8086_far_data)<>0) xor
+            (current_settings.x86memorymodel in [mm_compact,mm_large]) then
+         begin
+           ppufile.free;
+           ppufile:=nil;
+           Message(unit_u_ppu_invalid_memory_model,@queuecomment);
+           exit;
+         end;
+        if ((ppufile.header.flags and uf_i8086_huge_data)<>0) xor
+            (current_settings.x86memorymodel=mm_huge) then
+         begin
+           ppufile.free;
+           ppufile:=nil;
+           Message(unit_u_ppu_invalid_memory_model,@queuecomment);
+           exit;
+         end;
+        if ((ppufile.header.flags and uf_i8086_cs_equals_ds)<>0) xor
+            (current_settings.x86memorymodel=mm_tiny) then
+         begin
+           ppufile.free;
+           ppufile:=nil;
+           Message(unit_u_ppu_invalid_memory_model,@queuecomment);
+           exit;
+         end;
+{$endif i8086}
 {$ifdef cpufpemu}
        { check if floating point emulation is on?
          fpu emulation isn't unit levelwise because it affects calling convention }
@@ -1061,6 +1096,16 @@ var
           flags:=flags or uf_release;
          if assigned(localsymtable) then
            flags:=flags or uf_local_symtable;
+{$ifdef i8086}
+         if current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge] then
+           flags:=flags or uf_i8086_far_code;
+         if current_settings.x86memorymodel in [mm_compact,mm_large] then
+           flags:=flags or uf_i8086_far_data;
+         if current_settings.x86memorymodel=mm_huge then
+           flags:=flags or uf_i8086_huge_data;
+         if current_settings.x86memorymodel=mm_tiny then
+           flags:=flags or uf_i8086_cs_equals_ds;
+{$endif i8086}
 {$ifdef cpufpemu}
          if (cs_fp_emulation in current_settings.moduleswitches) then
            flags:=flags or uf_fpu_emulation;

compiler/generic/symcpu.pas

@@ -0,0 +1,211 @@
+{
+    Copyright (c) 2014 by Florian Klaempfl
+
+    Symbol table overrides for <generic>
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit symcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  symtype,symdef,symsym;
+
+type
+  { defs }
+  tcpufiledef = class(tfiledef)
+  end;
+  tcpufiledefclass = class of tcpufiledef;
+
+  tcpuvariantdef = class(tvariantdef)
+  end;
+  tcpuvariantdefclass = class of tcpuvariantdef;
+
+  tcpuformaldef = class(tformaldef)
+  end;
+  tcpuformaldefclass = class of tcpuformaldef;
+
+  tcpuforwarddef = class(tforwarddef)
+  end;
+  tcpuforwarddefclass = class of tcpuforwarddef;
+
+  tcpuundefineddef = class(tundefineddef)
+  end;
+  tcpuundefineddefclass = class of tcpuundefineddef;
+
+  tcpuerrordef = class(terrordef)
+  end;
+  tcpuerrordefclass = class of tcpuerrordef;
+
+  tcpupointerdef = class(tpointerdef)
+  end;
+  tcpupointerdefclass = class of tcpupointerdef;
+
+  tcpurecorddef = class(trecorddef)
+  end;
+  tcpurecorddefclass = class of tcpurecorddef;
+
+  tcpuimplementedinterface = class(timplementedinterface)
+  end;
+  tcpuimplementedinterfaceclass = class of tcpuimplementedinterface;
+
+  tcpuobjectdef = class(tobjectdef)
+  end;
+  tcpuobjectdefclass = class of tcpuobjectdef;
+
+  tcpuclassrefdef = class(tclassrefdef)
+  end;
+  tcpuclassrefdefclass = class of tcpuclassrefdef;
+
+  tcpuarraydef = class(tarraydef)
+  end;
+  tcpuarraydefclass = class of tcpuarraydef;
+
+  tcpuorddef = class(torddef)
+  end;
+  tcpuorddefclass = class of tcpuorddef;
+
+  tcpufloatdef = class(tfloatdef)
+  end;
+  tcpufloatdefclass = class of tcpufloatdef;
+
+  tcpuprocvardef = class(tprocvardef)
+  end;
+  tcpuprocvardefclass = class of tcpuprocvardef;
+
+  tcpuprocdef = class(tprocdef)
+  end;
+  tcpuprocdefclass = class of tcpuprocdef;
+
+  tcpustringdef = class(tstringdef)
+  end;
+  tcpustringdefclass = class of tcpustringdef;
+
+  tcpuenumdef = class(tenumdef)
+  end;
+  tcpuenumdefclass = class of tcpuenumdef;
+
+  tcpusetdef = class(tsetdef)
+  end;
+  tcpusetdefclass = class of tcpusetdef;
+
+  { syms }
+  tcpulabelsym = class(tlabelsym)
+  end;
+  tcpulabelsymclass = class of tcpulabelsym;
+
+  tcpuunitsym = class(tunitsym)
+  end;
+  tcpuunitsymclass = class of tcpuunitsym;
+
+  tcpunamespacesym = class(tnamespacesym)
+  end;
+  tcpunamespacesymclass = class of tcpunamespacesym;
+
+  tcpuprocsym = class(tprocsym)
+  end;
+  tcpuprocsymclass = class of tcpuprocsym;
+
+  tcputypesym = class(ttypesym)
+  end;
+  tcpuypesymclass = class of tcputypesym;
+
+  tcpufieldvarsym = class(tfieldvarsym)
+  end;
+  tcpufieldvarsymclass = class of tcpufieldvarsym;
+
+  tcpulocalvarsym = class(tlocalvarsym)
+  end;
+  tcpulocalvarsymclass = class of tcpulocalvarsym;
+
+  tcpuparavarsym = class(tparavarsym)
+  end;
+  tcpuparavarsymclass = class of tcpuparavarsym;
+
+  tcpustaticvarsym = class(tstaticvarsym)
+  end;
+  tcpustaticvarsymclass = class of tcpustaticvarsym;
+
+  tcpuabsolutevarsym = class(tabsolutevarsym)
+  end;
+  tcpuabsolutevarsymclass = class of tcpuabsolutevarsym;
+
+  tcpupropertysym = class(tpropertysym)
+  end;
+  tcpupropertysymclass = class of tcpupropertysym;
+
+  tcpuconstsym = class(tconstsym)
+  end;
+  tcpuconstsymclass = class of tcpuconstsym;
+
+  tcpuenumsym = class(tenumsym)
+  end;
+  tcpuenumsymclass = class of tcpuenumsym;
+
+  tcpusyssym = class(tsyssym)
+  end;
+  tcpusyssymclass = class of tcpusyssym;
+
+
+const
+  pbestrealtype : ^tdef = @<somestandardfloattype>;
+
+
+implementation
+
+begin
+  { used tdef classes }
+  cfiledef:=tcpufiledef;
+  cvariantdef:=tcpuvariantdef;
+  cformaldef:=tcpuformaldef;
+  cforwarddef:=tcpuforwarddef;
+  cundefineddef:=tcpuundefineddef;
+  cerrordef:=tcpuerrordef;
+  cpointerdef:=tcpupointerdef;
+  crecorddef:=tcpurecorddef;
+  cimplementedinterface:=tcpuimplementedinterface;
+  cobjectdef:=tcpuobjectdef;
+  cclassrefdef:=tcpuclassrefdef;
+  carraydef:=tcpuarraydef;
+  corddef:=tcpuorddef;
+  cfloatdef:=tcpufloatdef;
+  cprocvardef:=tcpuprocvardef;
+  cprocdef:=tcpuprocdef;
+  cstringdef:=tcpustringdef;
+  cenumdef:=tcpuenumdef;
+  csetdef:=tcpusetdef;
+
+  { used tsym classes }
+  clabelsym:=tcpulabelsym;
+  cunitsym:=tcpuunitsym;
+  cnamespacesym:=tcpunamespacesym;
+  cprocsym:=tcpuprocsym;
+  ctypesym:=tcputypesym;
+  cfieldvarsym:=tcpufieldvarsym;
+  clocalvarsym:=tcpulocalvarsym;
+  cparavarsym:=tcpuparavarsym;
+  cstaticvarsym:=tcpustaticvarsym;
+  cabsolutevarsym:=tcpuabsolutevarsym;
+  cpropertysym:=tcpupropertysym;
+  cconstsym:=tcpuconstsym;
+  cenumsym:=tcpuenumsym;
+  csyssym:=tcpusyssym;
+end.
+

compiler/globals.pas

@@ -154,11 +154,17 @@ interface
 
          disabledircache : boolean;
 
+{$if defined(i8086)}
          x86memorymodel  : tx86memorymodel;
+{$endif defined(i8086)}
+
+{$if defined(ARM)}
+         instructionset : tinstructionset;
+{$endif defined(ARM)}
 
         { CPU targets with microcontroller support can add a controller specific unit }
 {$if defined(ARM) or defined(AVR) or defined(MIPSEL)}
-        controllertype   : tcontrollertype;
+         controllertype   : tcontrollertype;
 {$endif defined(ARM) or defined(AVR) or defined(MIPSEL)}
          { WARNING: this pointer cannot be written as such in record token }
          pmessage : pmessagestaterecord;
@@ -222,6 +228,9 @@ interface
        wpofeedbackinput,
        wpofeedbackoutput : TPathStr;
 
+       { external assembler extra option }
+       asmextraopt       : string;
+
        { things specified with parameters }
        paratarget        : tsystem;
        paratargetdbg     : tdbg;
@@ -247,8 +256,11 @@ interface
        do_build,
        do_release,
        do_make       : boolean;
+       { Path to ppc }
+       exepath       : TPathStr;
+       { Path to unicode charmap/collation binaries }
+       unicodepath   : TPathStr;
        { path for searching units, different paths can be seperated by ; }
-       exepath            : TPathStr;  { Path to ppc }
        librarysearchpath,
        unitsearchpath,
        objectsearchpath,
@@ -310,6 +322,7 @@ interface
        pendingstate       : tpendingstate;
      { Memory sizes }
        heapsize,
+       maxheapsize,
        stacksize,
        jmp_buf_size,
        jmp_buf_align : longint;
@@ -318,7 +331,7 @@ interface
      { parameter switches }
        debugstop : boolean;
 {$EndIf EXTDEBUG}
-       { Application type (platform specific) 
+       { Application type (platform specific)
          see globtype.pas for description }
        apptype : tapptype;
 
@@ -381,7 +394,7 @@ interface
         globalswitches : [cs_check_unit_name,cs_link_static];
         targetswitches : [];
         moduleswitches : [cs_extsyntax,cs_implicit_exceptions];
-        localswitches : [cs_check_io,cs_typed_const_writable,cs_pointermath];
+        localswitches : [cs_check_io,cs_typed_const_writable,cs_pointermath{$ifdef i8086},cs_force_far_calls{$endif}];
         modeswitches : fpcmodeswitches;
         optimizerswitches : [];
         genwpoptimizerswitches : [];
@@ -391,7 +404,11 @@ interface
         setalloc : 0;
         packenum : 4;
 
+{$ifdef i8086}
+        packrecords     : 1;
+{$else i8086}
         packrecords     : 0;
+{$endif i8086}
         maxfpuregisters : 0;
 
 { Note: GENERIC_CPU is sued together with generic subdirectory to
@@ -479,7 +496,12 @@ interface
         minfpconstprec : s32real;
 
         disabledircache : false;
+{$if defined(i8086)}
         x86memorymodel : mm_small;
+{$endif defined(i8086)}
+{$if defined(ARM)}
+        instructionset : is_arm;
+{$endif defined(ARM)}
 {$if defined(ARM) or defined(AVR) or defined(MIPSEL)}
         controllertype : ct_none;
 {$endif defined(ARM) or defined(AVR) or defined(MIPSEL)}
@@ -511,16 +533,12 @@ interface
 
     function SetAktProcCall(const s:string; var a:tproccalloption):boolean;
     function Setabitype(const s:string;var a:tabi):boolean;
-    function Setcputype(const s:string;var a:tcputype):boolean;
+    function Setoptimizecputype(const s:string;var a:tcputype):boolean;
+    function Setcputype(const s:string;var a:tsettings):boolean;
     function SetFpuType(const s:string;var a:tfputype):boolean;
 {$if defined(arm) or defined(avr) or defined(mipsel)}
     function SetControllerType(const s:string;var a:tcontrollertype):boolean;
 {$endif defined(arm) or defined(avr) or defined(mipsel)}
-    function UpdateAlignmentStr(s:string;var a:talignmentinfo):boolean;
-    function UpdateOptimizerStr(s:string;var a:toptimizerswitches):boolean;
-    function UpdateWpoStr(s: string; var a: twpoptimizerswitches): boolean;
-    function UpdateDebugStr(s:string;var a:tdebugswitches):boolean;
-    function UpdateTargetSwitchStr(s: string; var a: ttargetswitches; global: boolean): boolean;
     function IncludeFeature(const s : string) : boolean;
     function SetMinFPConstPrec(const s: string; var a: tfloattype) : boolean;
 
@@ -549,11 +567,7 @@ implementation
       macutils,
 {$endif}
 {$ifdef mswindows}
-{$ifdef VER2_4}
-      cwindirs,
-{$else VER2_4}
       windirs,
-{$endif VER2_4}
 {$endif}
       comphook;
 
@@ -877,7 +891,7 @@ implementation
       {$endif}
       {$ifdef mswindows}
         GetEnvPchar:=nil;
-        p:=GetEnvironmentStrings;
+        p:=GetEnvironmentStringsA;
         hp:=p;
         while hp^<>#0 do
          begin
@@ -905,7 +919,7 @@ implementation
         {$undef GETENVOK}
       {$else}
         GetEnvPchar:=StrPNew(GetEnvironmentVariable(envname));
-        if (length(GetEnvPChar)=0) then 
+        if (length(GetEnvPChar)=0) then
           begin
             FreeEnvPChar(GetEnvPChar);
             GetEnvPChar:=nil;
@@ -923,11 +937,6 @@ implementation
       {$endif}
       end;
 
-{$if defined(MORPHOS) or defined(AMIGA)}
-  {$define AMIGASHELL}
-{$endif}
-
-{$UNDEF AMIGASHELL}
       function is_number_float(d : double) : boolean;
         var
            bytearray : array[0..7] of byte;
@@ -1101,13 +1110,15 @@ implementation
              (abiinfo[t].name=hs) then
             begin
               a:=t;
-              result:=true;
+              { abi_old_win32_gnu is a win32 i386 specific "feature" }
+              if (t<>abi_old_win32_gnu) or (target_info.system=system_i386_win32) then
+                result:=true;
               break;
             end;
       end;
 
 
-    function Setcputype(const s:string;var a:tcputype):boolean;
+    function Setoptimizecputype(const s:string;var a:tcputype):boolean;
       var
         t  : tcputype;
         hs : string;
@@ -1124,6 +1135,33 @@ implementation
       end;
 
 
+    function Setcputype(const s:string;var a:tsettings):boolean;
+      var
+        t  : tcputype;
+        hs : string;
+      begin
+        result:=false;
+        hs:=Upper(s);
+        for t:=low(tcputype) to high(tcputype) do
+          if cputypestr[t]=hs then
+            begin
+              a.cputype:=t;
+              result:=true;
+              break;
+            end;
+{$ifdef arm}
+        { set default instruction set for arm }
+        if result then
+          begin
+            if a.cputype in [cpu_armv6m,cpu_armv6t2,cpu_armv7m,cpu_armv7em] then
+              a.instructionset:=is_thumb
+            else
+              a.instructionset:=is_arm;
+          end;
+{$endif arm}
+      end;
+
+
     function SetFpuType(const s:string;var a:tfputype):boolean;
       var
         t : tfputype;
@@ -1158,289 +1196,6 @@ implementation
 {$endif defined(arm) or defined(avr) or defined(mipsel)}
 
 
-    function UpdateAlignmentStr(s:string;var a:talignmentinfo):boolean;
-      var
-        tok  : string;
-        vstr : string;
-        l    : longint;
-        code : integer;
-        b    : talignmentinfo;
-      begin
-        UpdateAlignmentStr:=true;
-        uppervar(s);
-        fillchar(b,sizeof(b),0);
-        repeat
-          tok:=GetToken(s,'=');
-          if tok='' then
-           break;
-          vstr:=GetToken(s,',');
-          val(vstr,l,code);
-          if tok='PROC' then
-           b.procalign:=l
-          else if tok='JUMP' then
-           b.jumpalign:=l
-          else if tok='LOOP' then
-           b.loopalign:=l
-          else if tok='CONSTMIN' then
-           begin
-             b.constalignmin:=l;
-             if l>b.constalignmax then
-               b.constalignmax:=l;
-           end
-          else if tok='CONSTMAX' then
-           b.constalignmax:=l
-          else if tok='VARMIN' then
-           begin
-             b.varalignmin:=l;
-             if l>b.varalignmax then
-               b.varalignmax:=l;
-           end
-          else if tok='VARMAX' then
-           b.varalignmax:=l
-          else if tok='LOCALMIN' then
-           begin
-             b.localalignmin:=l;
-             if l>b.localalignmax then
-               b.localalignmax:=l;
-           end
-          else if tok='LOCALMAX' then
-           b.localalignmax:=l
-          else if tok='RECORDMIN' then
-           begin
-             b.recordalignmin:=l;
-             if l>b.recordalignmax then
-               b.recordalignmax:=l;
-           end
-          else if tok='RECORDMAX' then
-           b.recordalignmax:=l
-          else { Error }
-           UpdateAlignmentStr:=false;
-        until false;
-        Result:=Result and UpdateAlignment(a,b);
-      end;
-
-
-    function UpdateOptimizerStr(s:string;var a:toptimizerswitches):boolean;
-      var
-        tok   : string;
-        doset,
-        found : boolean;
-        opt   : toptimizerswitch;
-      begin
-        result:=true;
-        uppervar(s);
-        repeat
-          tok:=GetToken(s,',');
-          if tok='' then
-           break;
-          if Copy(tok,1,2)='NO' then
-            begin
-              delete(tok,1,2);
-              doset:=false;
-            end
-          else
-            doset:=true;
-          found:=false;
-          for opt:=low(toptimizerswitch) to high(toptimizerswitch) do
-            begin
-              if OptimizerSwitchStr[opt]=tok then
-                begin
-                  found:=true;
-                  break;
-                end;
-            end;
-          if found then
-            begin
-              if doset then
-                include(a,opt)
-              else
-                exclude(a,opt);
-            end
-          else
-            result:=false;
-        until false;
-      end;
-
-
-    function UpdateWpoStr(s: string; var a: twpoptimizerswitches): boolean;
-      var
-        tok   : string;
-        doset,
-        found : boolean;
-        opt   : twpoptimizerswitch;
-      begin
-        result:=true;
-        uppervar(s);
-        repeat
-          tok:=GetToken(s,',');
-          if tok='' then
-           break;
-          if Copy(tok,1,2)='NO' then
-            begin
-              delete(tok,1,2);
-              doset:=false;
-            end
-          else
-            doset:=true;
-          found:=false;
-          if (tok = 'ALL') then
-            begin
-              for opt:=low(twpoptimizerswitch) to high(twpoptimizerswitch) do
-                if doset then
-                  include(a,opt)
-                else
-                  exclude(a,opt);
-            end
-          else
-            begin
-              for opt:=low(twpoptimizerswitch) to high(twpoptimizerswitch) do
-                begin
-                  if WPOptimizerSwitchStr[opt]=tok then
-                    begin
-                      found:=true;
-                      break;
-                    end;
-                end;
-              if found then
-                begin
-                  if doset then
-                    include(a,opt)
-                  else
-                    exclude(a,opt);
-                end
-              else
-                result:=false;
-            end;
-        until false;
-      end;
-
-
-    function UpdateDebugStr(s:string;var a:tdebugswitches):boolean;
-      var
-        tok   : string;
-        doset,
-        found : boolean;
-        opt   : tdebugswitch;
-      begin
-        result:=true;
-        uppervar(s);
-        repeat
-          tok:=GetToken(s,',');
-          if tok='' then
-           break;
-          if Copy(tok,1,2)='NO' then
-            begin
-              delete(tok,1,2);
-              doset:=false;
-            end
-          else
-            doset:=true;
-          found:=false;
-          for opt:=low(tdebugswitch) to high(tdebugswitch) do
-            begin
-              if DebugSwitchStr[opt]=tok then
-                begin
-                  found:=true;
-                  break;
-                end;
-            end;
-          if found then
-            begin
-              if doset then
-                include(a,opt)
-              else
-                exclude(a,opt);
-            end
-          else
-            result:=false;
-        until false;
-      end;
-
-
-    function UpdateTargetSwitchStr(s: string; var a: ttargetswitches; global: boolean): boolean;
-      var
-        tok,
-        value : string;
-        setstr: string[2];
-        equalspos: longint;
-        doset,
-        gotvalue,
-        found : boolean;
-        opt   : ttargetswitch;
-      begin
-        result:=true;
-        repeat
-          tok:=GetToken(s,',');
-          if tok='' then
-           break;
-          setstr:=upper(copy(tok,length(tok),1));
-          if setstr='-' then
-            begin
-              setlength(tok,length(tok)-1);
-              doset:=false;
-            end
-          else
-            doset:=true;
-          { value specified? }
-          gotvalue:=false;
-          equalspos:=pos('=',tok);
-          if equalspos<>0 then
-            begin
-              value:=copy(tok,equalspos+1,length(tok));
-              delete(tok,equalspos,length(tok));
-              gotvalue:=true;
-            end;
-          found:=false;
-          uppervar(tok);
-          for opt:=low(ttargetswitch) to high(ttargetswitch) do
-            begin
-              if TargetSwitchStr[opt].name=tok then
-                begin
-                  found:=true;
-                  break;
-                end;
-            end;
-          if found then
-            begin
-              if not global and
-                 TargetSwitchStr[opt].isglobal then
-                result:=false
-              else if not TargetSwitchStr[opt].hasvalue then
-                begin
-                  if gotvalue then
-                    result:=false;
-                  if doset then
-                    include(a,opt)
-                  else
-                    exclude(a,opt)
-                end
-              else
-                begin
-                  if not gotvalue or
-                     not doset then
-                    result:=false
-                  else
-                    begin
-                      case opt of
-                        ts_auto_getter_prefix:
-                          prop_auto_getter_prefix:=value;
-                        ts_auto_setter_predix:
-                          prop_auto_setter_prefix:=value;
-                        else
-                          begin
-                            writeln('Internalerror 2012053001');
-                            halt(1);
-                          end;
-                      end;
-                    end;
-                end;
-            end
-          else
-            result:=false;
-        until false;
-      end;
-
-
     function IncludeFeature(const s : string) : boolean;
       var
         i : tfeature;
@@ -1549,6 +1304,7 @@ implementation
 {$endif need_path_search}
      begin
        localexepath:=GetEnvironmentVariable('PPC_EXEC_PATH');
+       exeName := '';
        if localexepath='' then
          begin
            exeName := FixFileName(system.paramstr(0));
@@ -1614,6 +1370,7 @@ implementation
         sysrootpath:='';
 
         { Search Paths }
+        unicodepath:='';
         librarysearchpath:=TSearchPathList.Create;
         unitsearchpath:=TSearchPathList.Create;
         includesearchpath:=TSearchPathList.Create;

compiler/globtype.pas

@@ -143,7 +143,11 @@ interface
          cs_external_var, cs_externally_visible,
          { jvm specific }
          cs_check_var_copyout,
-         cs_zerobasedstrings
+         cs_zerobasedstrings,
+         { i8086 specific }
+         cs_force_far_calls,
+         cs_hugeptr_arithmetic_normalization,
+         cs_hugeptr_comparison_normalization
        );
        tlocalswitches = set of tlocalswitch;
 
@@ -162,7 +166,9 @@ interface
          { browser switches are back }
          cs_browser,cs_local_browser,
          { target specific }
-         cs_executable_stack
+         cs_executable_stack,
+         { i8086 specific }
+         cs_huge_code
        );
        tmoduleswitches = set of tmoduleswitch;
 
@@ -232,7 +238,16 @@ interface
            these strings as prefixes for the generated getters/setter names }
          ts_auto_getter_prefix,
          ts_auto_setter_predix,
-         ts_thumb_interworking
+         ts_thumb_interworking,
+         { lowercase the first character of routine names, used to generate
+           names that are compliant with Java coding standards from code
+           written according to Delphi coding standards }
+         ts_lowercase_proc_start,
+         { initialise local variables on the JVM target so you won't get
+           accidental uses of uninitialised values }
+         ts_init_locals,
+         { emit a CLD instruction before using the x86 string instructions }
+         ts_cld
        );
        ttargetswitches = set of ttargetswitch;
 
@@ -244,7 +259,8 @@ interface
          f_heap,f_init_final,f_rtti,f_classes,f_exceptions,f_exitcode,
          f_ansistrings,f_widestrings,f_textio,f_consoleio,f_fileio,
          f_random,f_variants,f_objects,f_dynarrays,f_threading,f_commandargs,
-         f_processes,f_stackcheck,f_dynlibs,f_softfpu,f_objectivec1,f_resources
+         f_processes,f_stackcheck,f_dynlibs,f_softfpu,f_objectivec1,f_resources,
+         f_unicodestring
        );
        tfeatures = set of tfeature;
 
@@ -254,7 +270,7 @@ 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_useebp,
+         cs_opt_nodedfa,cs_opt_loopstrength,cs_opt_scheduler,cs_opt_autoinline,cs_useebp,cs_userbp,
          cs_opt_reorder_fields,cs_opt_fastmath,
          { Allow removing expressions whose result is not used, even when this
            can change program behaviour (range check errors disappear,
@@ -265,7 +281,10 @@ interface
          }
          cs_opt_dead_values,
          { compiler checks for empty procedures/methods and removes calls to them if possible }
-         cs_opt_remove_emtpy_proc
+         cs_opt_remove_emtpy_proc,
+         cs_opt_constant_propagate,
+         cs_opt_dead_store_eliminate,
+         cs_opt_forcenostackframe
        );
        toptimizerswitches = set of toptimizerswitch;
 
@@ -289,15 +308,18 @@ interface
           hasvalue: boolean;
           { target switch can be used only globally }
           isglobal: boolean;
+          define: string[15];
        end;
 
     const
-       OptimizerSwitchStr : array[toptimizerswitch] of string[16] = ('',
+       OptimizerSwitchStr : array[toptimizerswitch] of string[17] = ('',
          'LEVEL1','LEVEL2','LEVEL3',
          'REGVAR','UNCERTAIN','SIZE','STACKFRAME',
          'PEEPHOLE','ASMCSE','LOOPUNROLL','TAILREC','CSE',
-         'DFA','STRENGTH','SCHEDULE','AUTOINLINE','USEEBP',
-         'ORDERFIELDS','FASTMATH','DEADVALUES','REMOVEEMPTYPROCS'
+         'DFA','STRENGTH','SCHEDULE','AUTOINLINE','USEEBP','USERBP',
+         'ORDERFIELDS','FASTMATH','DEADVALUES','REMOVEEMPTYPROCS',
+         'CONSTPROP',
+         'DEADSTORE','FORCENOSTACKFRAME'
        );
        WPOptimizerSwitchStr : array [twpoptimizerswitch] of string[14] = (
          'DEVIRTCALLS','OPTVMTS','SYMBOLLIVENESS'
@@ -307,19 +329,22 @@ interface
          'DWARFSETS','STABSABSINCLUDES','DWARFMETHODCLASSPREFIX');
 
        TargetSwitchStr : array[ttargetswitch] of ttargetswitchinfo = (
-         (name: '';                    hasvalue: false; isglobal: true ),
-         (name: 'SMALLTOC';            hasvalue: false; isglobal: true ),
-         (name: 'COMPACTINTARRAYINIT'; hasvalue: false; isglobal: true ),
-         (name: 'ENUMFIELDINIT';       hasvalue: false; isglobal: true ),
-         (name: 'AUTOGETTERPREFIX';    hasvalue: true ; isglobal: false),
-         (name: 'AUTOSETTERPREFIX';    hasvalue: true ; isglobal: false),
-         (name: 'THUMBINTERWORKING';   hasvalue: false; isglobal: true )
+         (name: '';                    hasvalue: false; isglobal: true ; define: ''),
+         (name: 'SMALLTOC';            hasvalue: false; isglobal: true ; define: ''),
+         (name: 'COMPACTINTARRAYINIT'; hasvalue: false; isglobal: true ; define: ''),
+         (name: 'ENUMFIELDINIT';       hasvalue: false; isglobal: true ; define: ''),
+         (name: 'AUTOGETTERPREFIX';    hasvalue: true ; isglobal: false; define: ''),
+         (name: 'AUTOSETTERPREFIX';    hasvalue: true ; isglobal: false; define: ''),
+         (name: 'THUMBINTERWORKING';   hasvalue: false; isglobal: true ; define: ''),
+         (name: 'LOWERCASEPROCSTART';  hasvalue: false; isglobal: true ; define: ''),
+         (name: 'INITLOCALS';          hasvalue: false; isglobal: true ; define: ''),
+         (name: 'CLD';                 hasvalue: false; isglobal: true ; define: 'FPC_ENABLED_CLD')
        );
 
        { switches being applied to all CPUs at the given level }
-       genericlevel1optimizerswitches = [cs_opt_level1];
+       genericlevel1optimizerswitches = [cs_opt_level1,cs_opt_peephole];
        genericlevel2optimizerswitches = [cs_opt_level2,cs_opt_remove_emtpy_proc];
-       genericlevel3optimizerswitches = [cs_opt_level3];
+       genericlevel3optimizerswitches = [cs_opt_level3,cs_opt_constant_propagate,cs_opt_nodedfa];
        genericlevel4optimizerswitches = [cs_opt_reorder_fields,cs_opt_dead_values,cs_opt_fastmath];
 
        { whole program optimizations whose information generation requires
@@ -327,11 +352,12 @@ interface
        }
        WPOptimizationsNeedingAllUnitInfo = [cs_wpo_devirtualize_calls,cs_wpo_optimize_vmts];
 
-       featurestr : array[tfeature] of string[12] = (
+       featurestr : array[tfeature] of string[14] = (
          'HEAP','INITFINAL','RTTI','CLASSES','EXCEPTIONS','EXITCODE',
          'ANSISTRINGS','WIDESTRINGS','TEXTIO','CONSOLEIO','FILEIO',
          'RANDOM','VARIANTS','OBJECTS','DYNARRAYS','THREADING','COMMANDARGS',
-         'PROCESSES','STACKCHECK','DYNLIBS','SOFTFPU','OBJECTIVEC1','RESOURCES'
+         'PROCESSES','STACKCHECK','DYNLIBS','SOFTFPU','OBJECTIVEC1','RESOURCES',
+         'UNICODESTRINGS'
        );
 
     type
@@ -372,8 +398,10 @@ interface
          m_final_fields,        { allows declaring fields as "final", which means they must be initialised
                                   in the (class) constructor and are constant from then on (same as final
                                   fields in Java) }
-         m_default_unicodestring { makes the default string type in $h+ mode unicodestring rather than
-                                   ansistring; similarly, char becomes unicodechar rather than ansichar }
+         m_default_unicodestring, { makes the default string type in $h+ mode unicodestring rather than
+                                    ansistring; similarly, char becomes unicodechar rather than ansichar }
+         m_type_helpers         { allows the declaration of "type helper" (non-Delphi) or "record helper"
+                                  (Delphi) for primitive types }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -391,7 +419,8 @@ interface
          app_tool,      { tool application, (MPW tool for MacOS, MacOS only) }
          app_arm7,      { for Nintendo DS target }
          app_arm9,      { for Nintendo DS target }
-         app_bundle     { dynamically loadable bundle, Darwin only }
+         app_bundle,    { dynamically loadable bundle, Darwin only }
+         app_com        { DOS .COM file }
        );
 
        { interface types }
@@ -536,7 +565,8 @@ interface
          'ISOUNARYMINUS',
          'SYSTEMCODEPAGE',
          'FINALFIELDS',
-         'UNICODESTRINGS');
+         'UNICODESTRINGS',
+         'TYPEHELPERS');
 
 
      type
@@ -581,7 +611,11 @@ interface
          { subroutine contains inherited call }
          pi_has_inherited,
          { subroutine has nested exit }
-         pi_has_nested_exit
+         pi_has_nested_exit,
+         { allocates memory on stack, so stack is unbalanced on exit }
+         pi_has_stack_allocs,
+         { set if the stack frame of the procedure is estimated }
+         pi_estimatestacksize
        );
        tprocinfoflags=set of tprocinfoflag;
 

compiler/hlcg2ll.pas

@@ -78,9 +78,6 @@ unit hlcg2ll;
           procedure do_register_allocation(list:TAsmList;headertai:tai); inline;
           procedure translate_register(var reg : tregister); inline;
 
-          {# Emit a label to the instruction stream. }
-          procedure a_label(list : TAsmList;l : tasmlabel); inline;
-
           {# Allocates register r by inserting a pai_realloc record }
           procedure a_reg_alloc(list : TAsmList;r : tregister); inline;
           {# Deallocates register r by inserting a pa_regdealloc record}
@@ -154,7 +151,6 @@ unit hlcg2ll;
 
           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 }
           function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef): tcgpara;override;
@@ -314,7 +310,6 @@ unit hlcg2ll;
           procedure g_local_unwind(list: TAsmList; l: TAsmLabel);override;
 
           procedure location_force_reg(list:TAsmList;var l:tlocation;src_size,dst_size:tdef;maybeconst:boolean);override;
-          procedure location_force_fpureg(list:TAsmList;var l: tlocation;size: tdef;maybeconst:boolean);override;
           procedure location_force_mem(list:TAsmList;var l:tlocation;size:tdef);override;
           procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);override;
 //          procedure location_force_mmreg(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);override;
@@ -414,11 +409,6 @@ implementation
       cg.translate_register(reg);
     end;
 
-  procedure thlcg2ll.a_label(list: TAsmList; l: tasmlabel); inline;
-    begin
-      cg.a_label(list,l);
-    end;
-
   procedure thlcg2ll.a_reg_alloc(list: TAsmList; r: tregister);
     begin
       cg.a_reg_alloc(list,r);
@@ -470,11 +460,6 @@ implementation
       cg.a_call_reg(list,reg);
     end;
 
-  procedure thlcg2ll.a_call_ref(list: TAsmList; pd: tabstractprocdef; const ref: treference);
-    begin
-      cg.a_call_ref(list,ref);
-    end;
-
   function thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara;
     begin
       cg.a_call_name_static(list,s);
@@ -1029,7 +1014,7 @@ implementation
       hl: tasmlabel;
       oldloc : tlocation;
       const_location: boolean;
-      dst_cgsize: tcgsize;
+      dst_cgsize,tmpsize: tcgsize;
     begin
       oldloc:=l;
       dst_cgsize:=def_cgsize(dst_size);
@@ -1059,7 +1044,7 @@ implementation
 {$ifdef cpuflags}
               LOC_FLAGS :
                 begin
-                  cg.g_flags2reg(list,OS_INT,l.resflags,hregister);
+                  cg.g_flags2reg(list,OS_32,l.resflags,hregister);
                   cg.a_reg_dealloc(list,NR_DEFAULTFLAGS);
                 end;
 {$endif cpuflags}
@@ -1072,6 +1057,9 @@ implementation
                   cg.a_label(list,current_procinfo.CurrFalseLabel);
                   cg.a_load_const_reg(list,OS_INT,0,hregister);
                   cg.a_label(list,hl);
+{$if defined(cpu8bitalu) or defined(cpu16bitalu)}
+                  cg.a_load_reg_reg(list,OS_INT,OS_32,hregister,hregister);
+{$endif}
                 end;
               else
                 a_load_loc_reg(list,src_size,u32inttype,l,hregister);
@@ -1083,7 +1071,7 @@ implementation
                if l.loc=LOC_CONSTANT then
                 begin
                   if (longint(l.value)<0) then
-                   cg.a_load_const_reg(list,OS_32,aint($ffffffff),hregisterhi)
+                   cg.a_load_const_reg(list,OS_32,longint($ffffffff),hregisterhi)
                   else
                    cg.a_load_const_reg(list,OS_32,0,hregisterhi);
                 end
@@ -1157,13 +1145,21 @@ implementation
 {$endif cpuflags}
             LOC_JUMP :
               begin
+                tmpsize:=dst_cgsize;
+{$if defined(cpu8bitalu) or defined(cpu16bitalu)}
+                if TCGSize2Size[dst_cgsize]>TCGSize2Size[OS_INT] then
+                  tmpsize:=OS_INT;
+{$endif}
                 cg.a_label(list,current_procinfo.CurrTrueLabel);
-                cg.a_load_const_reg(list,dst_cgsize,1,hregister);
+                cg.a_load_const_reg(list,tmpsize,1,hregister);
                 current_asmdata.getjumplabel(hl);
                 cg.a_jmp_always(list,hl);
                 cg.a_label(list,current_procinfo.CurrFalseLabel);
-                cg.a_load_const_reg(list,dst_cgsize,0,hregister);
+                cg.a_load_const_reg(list,tmpsize,0,hregister);
                 cg.a_label(list,hl);
+{$if defined(cpu8bitalu) or defined(cpu16bitalu)}
+                cg.a_load_reg_reg(list,tmpsize,dst_cgsize,hregister,hregister);
+{$endif}
               end;
             else
               begin
@@ -1217,11 +1213,6 @@ implementation
           location_freetemp(list,oldloc);
     end;
 
-  procedure thlcg2ll.location_force_fpureg(list: TAsmList; var l: tlocation; size: tdef; maybeconst: boolean);
-    begin
-      ncgutil.location_force_fpureg(list,l,maybeconst);
-    end;
-
   procedure thlcg2ll.location_force_mem(list: TAsmList; var l: tlocation; size: tdef);
     var
       r: treference;
@@ -1419,10 +1410,16 @@ implementation
                by typecasting an int64 constant to a record of 8 bytes }
              if locsize = OS_F64 then
                begin
-                 tmploc:=l;
-                 location_force_mem(list,tmploc,size);
-                 cg.a_load_loc_cgpara(list,tmploc,cgpara);
-                 location_freetemp(list,tmploc);
+                 if (cgpara.Location^.Next=nil) and (l.size in [OS_64,OS_S64]) and
+                   (cgpara.size in [OS_64,OS_S64]) then
+                   cg64.a_load64_reg_cgpara(list,l.register64,cgpara)
+                 else
+                   begin
+                     tmploc:=l;
+                     location_force_mem(list,tmploc,size);
+                     cg.a_load_loc_cgpara(list,tmploc,cgpara);
+                     location_freetemp(list,tmploc);
+                   end;
                end
              else
 {$endif not cpu64bitalu}
@@ -1437,6 +1434,10 @@ implementation
     var
       tmploc: tlocation;
     begin
+      { skip e.g. empty records }
+      if (cgpara.location^.loc = LOC_VOID) then
+        exit;
+
       { Handle Floating point types differently
 
         This doesn't depend on emulator settings, emulator settings should

compiler/hlcgobj.pas

@@ -37,12 +37,22 @@ unit hlcgobj;
        cclasses,globtype,constexp,
        cpubase,cgbase,cgutils,parabase,
        aasmbase,aasmtai,aasmdata,aasmcpu,
-       symconst,symtype,symdef,
-       node
+       symconst,symtype,symsym,symdef,
+       node,nutils
        ;
 
     type
        tsubsetloadopt = (SL_REG,SL_REGNOSRCMASK,SL_SETZERO,SL_SETMAX);
+
+       preplaceregrec = ^treplaceregrec;
+       treplaceregrec = record
+         old, new: tregister;
+         oldhi, newhi: tregister;
+         ressym: tsym;
+         { moved sym }
+         sym : tabstractnormalvarsym;
+       end;
+
        {# @abstract(Abstract high level code generator)
           This class implements an abstract instruction generator. All
           methods of this class are generic and are mapped to low level code
@@ -97,6 +107,21 @@ unit hlcgobj;
              result loading, this is the register type used }
           function def2regtyp(def: tdef): tregistertype; virtual;
 
+          {# Returns a reference with its base address set from a pointer that
+             has been loaded in a register.
+
+             A generic version is provided. This routine should be overridden
+             on platforms which support pointers with different sizes (for
+             example i8086 near and far pointers) or require some other sort of
+             special consideration when converting a pointer in a register to a
+             reference.
+
+             @param(ref where the result is returned)
+             @param(regsize the type of the pointer, contained in the reg parameter)
+             @param(reg register containing the value of a pointer)
+          }
+          procedure reference_reset_base(var ref: treference; regsize: tdef; reg: tregister; offset, alignment: longint); virtual;
+
           {# Emit a label to the instruction stream. }
           procedure a_label(list : TAsmList;l : tasmlabel); inline;
 
@@ -194,7 +219,6 @@ unit hlcgobj;
           }
           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 }
           function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef): tcgpara;virtual;
@@ -478,6 +502,13 @@ unit hlcgobj;
           procedure location_get_data_ref(list:TAsmList;def: tdef; const l:tlocation;var ref:treference;loadref:boolean; alignment: longint);virtual;
 
           procedure maketojumpbool(list:TAsmList; p : tnode);virtual;
+          { if the result of n is a LOC_C(..)REGISTER, try to find the corresponding
+            loadn and change its location to a new register (= SSA). In case reload
+            is true, transfer the old to the new register                            }
+          procedure maybe_change_load_node_reg(list: TAsmList; var n: tnode; reload: boolean); virtual;
+         private
+          function do_replace_node_regs(var n: tnode; para: pointer): foreachnoderesult; virtual;
+         public
 
           procedure gen_proc_symbol(list:TAsmList);virtual;
           procedure gen_proc_symbol_end(list:TAsmList);virtual;
@@ -556,9 +587,12 @@ implementation
        globals,systems,
        fmodule,export,
        verbose,defutil,paramgr,
-       symbase,symsym,symtable,
-       ncon,nld,ncgrtti,pass_1,pass_2,
+       symbase,symtable,
+       nbas,ncon,nld,ncgrtti,pass_1,pass_2,
        cpuinfo,cgobj,tgobj,cutils,procinfo,
+{$ifdef x86}
+       cgx86,
+{$endif x86}
        ncgutil,ngenutil;
 
 
@@ -610,12 +644,6 @@ implementation
       result:=cg.getmmregister(list,def_cgsize(size));
     end;
 
-(*
-  function thlcgobj.getmmregister(list: TAsmList; size: tdef): Tregister;
-    begin
-      result:=cg.getmmregister(list,def_cgsize(size));
-    end;
-*)
   function thlcgobj.getflagregister(list: TAsmList; size: tdef): Tregister;
     begin
       result:=cg.getflagregister(list,def_cgsize(size));
@@ -714,6 +742,14 @@ implementation
         end;
     end;
 
+  procedure thlcgobj.reference_reset_base(var ref: treference; regsize: tdef;
+    reg: tregister; offset, alignment: longint);
+    begin
+      reference_reset(ref,alignment);
+      ref.base:=reg;
+      ref.offset:=offset;
+    end;
+
   procedure thlcgobj.a_label(list: TAsmList; l: tasmlabel); inline;
     begin
       cg.a_label(list,l);
@@ -752,7 +788,7 @@ implementation
            a_load_reg_reg(list,size,cgpara.location^.def,r,cgpara.location^.register);
          LOC_REFERENCE,LOC_CREFERENCE:
            begin
-              reference_reset_base(ref,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
+              reference_reset_base(ref,voidstackpointertype,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
               a_load_reg_ref(list,size,cgpara.location^.def,r,ref);
            end;
          LOC_MMREGISTER,LOC_CMMREGISTER:
@@ -782,7 +818,7 @@ implementation
             a_load_const_reg(list,cgpara.location^.def,a,cgpara.location^.register);
           LOC_REFERENCE,LOC_CREFERENCE:
             begin
-               reference_reset_base(ref,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
+               reference_reset_base(ref,voidstackpointertype,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
                a_load_const_ref(list,cgpara.location^.def,a,ref);
             end
           else
@@ -834,7 +870,7 @@ implementation
                  { we're at the end of the data, and it can be loaded into
                    the current location's register with a single regular
                    load }
-                 else if (sizeleft in [1,2{$ifndef cpu16bitalu},4{$endif}{$ifdef cpu64bitalu},8{$endif}]) then
+                 else if sizeleft in [1,2,4,8] then
                    begin
                      { don't use cgsize_orddef(int_cgsize(sizeleft)) as fromdef,
                        because that may be larger than location^.register in
@@ -913,7 +949,7 @@ implementation
               begin
                  if assigned(location^.next) then
                    internalerror(2010052906);
-                 reference_reset_base(ref,location^.reference.index,location^.reference.offset,newalignment(cgpara.alignment,cgpara.intsize-sizeleft));
+                 reference_reset_base(ref,voidstackpointertype,location^.reference.index,location^.reference.offset,newalignment(cgpara.alignment,cgpara.intsize-sizeleft));
                  if (def_cgsize(size)<>OS_NO) and
                     (size.size=sizeleft) and
                     (sizeleft<=sizeof(aint)) then
@@ -938,7 +974,7 @@ implementation
                  end;
               end
             else
-              internalerror(2010053111);
+              internalerror(2014032101);
           end;
           inc(tmpref.offset,tcgsize2size[location^.size]);
           dec(sizeleft,tcgsize2size[location^.size]);
@@ -981,22 +1017,6 @@ implementation
          end;
     end;
 
-  procedure thlcgobj.a_call_ref(list: TAsmList; pd: tabstractprocdef; const ref: treference);
-    var
-      reg: tregister;
-      size: tdef;
-    begin
-      { the loaded data is always a pointer to a procdef. A procvardef is
-        implicitly a pointer already, but a procdef isn't -> create one }
-      if pd.typ=procvardef then
-        size:=pd
-      else
-        size:=getpointerdef(pd);
-      reg:=getaddressregister(list,size);
-      a_load_ref_reg(list,size,size,ref,reg);
-      a_call_reg(list,pd,reg);
-    end;
-
   function thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara;
     begin
       result:=a_call_name(list,pd,s,forceresdef,false);
@@ -1556,6 +1576,8 @@ implementation
                   tmpreg:=getintregister(list,locsize);
                   a_load_const_reg(list,locsize,loc.value,tmpreg);
                 end;
+              else
+                internalerror(2013112909);
             end;
             a_bit_test_reg_reg_reg(list,bitnumbersize,locsize,destsize,bitnumber,tmpreg,destreg);
           end;
@@ -2223,7 +2245,9 @@ implementation
       tmpreg: tregister;
       subsetregdef: torddef;
       stopbit: byte;
+
     begin
+      tmpreg:=NR_NO;
       subsetregdef:=cgsize_orddef(sreg.subsetregsize);
       stopbit:=sreg.startbit+sreg.bitlen;
       // on x86(64), 1 shl 32(64) = 1 instead of 0
@@ -2239,7 +2263,10 @@ implementation
            if (slopt<>SL_REGNOSRCMASK) then
             a_op_const_reg(list,OP_AND,subsetregdef,tcgint(not(bitmask)),tmpreg);
         end;
-      if (slopt<>SL_SETMAX) then
+      if (slopt<>SL_SETMAX) and
+      { the "and" is not needed if the whole register is modified (except for SL_SETZERO),
+        because later on we do a move in this case instead of an or }
+        ((sreg.bitlen<>AIntBits) or (slopt=SL_SETZERO)) then
         a_op_const_reg(list,OP_AND,subsetregdef,tcgint(bitmask),sreg.subsetreg);
 
       case slopt of
@@ -2251,8 +2278,11 @@ implementation
               sreg.subsetreg)
           else
             a_load_const_reg(list,subsetregdef,-1,sreg.subsetreg);
+        { if the whole register is modified, no "or" is needed }
+        else if sreg.bitlen=AIntBits then
+          a_load_reg_reg(list,subsetregdef,subsetregdef,tmpreg,sreg.subsetreg)
         else
-          a_op_reg_reg(list,OP_OR,subsetregdef,tmpreg,sreg.subsetreg);
+          a_op_reg_reg(list,OP_OR,subsetregdef,tmpreg,sreg.subsetreg)
        end;
     end;
 
@@ -2358,7 +2388,7 @@ implementation
           LOC_REFERENCE,LOC_CREFERENCE:
             begin
               cgpara.check_simple_location;
-              reference_reset_base(ref,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
+              reference_reset_base(ref,voidstackpointertype,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
               a_loadfpu_reg_ref(list,fromsize,cgpara.def,r,ref);
             end;
           LOC_REGISTER,LOC_CREGISTER:
@@ -2389,7 +2419,7 @@ implementation
         LOC_REFERENCE,LOC_CREFERENCE:
           begin
             cgpara.check_simple_location;
-            reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
+            reference_reset_base(href,voidstackpointertype,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
             { concatcopy should choose the best way to copy the data }
             g_concatcopy(list,fromsize,ref,href);
           end;
@@ -2469,7 +2499,7 @@ implementation
           a_loadmm_reg_reg(list,fromsize,cgpara.def,reg,cgpara.location^.register,shuffle);
         LOC_REFERENCE,LOC_CREFERENCE:
           begin
-            reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
+            reference_reset_base(href,voidstackpointertype,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
             a_loadmm_reg_ref(list,fromsize,cgpara.def,reg,href,shuffle);
           end;
         LOC_REGISTER,LOC_CREGISTER:
@@ -2963,7 +2993,7 @@ implementation
       cgpara1,cgpara2,cgpara3 : TCGPara;
       pd : tprocdef;
     begin
-      pd:=search_system_proc('fpc_shortstr_assign');
+      pd:=search_system_proc('fpc_shortstr_to_shortstr');
       cgpara1.init;
       cgpara2.init;
       cgpara3.init;
@@ -2972,15 +3002,15 @@ implementation
       paramanager.getintparaloc(pd,3,cgpara3);
       if pd.is_pushleftright then
         begin
-          a_load_const_cgpara(list,s32inttype,strdef.len,cgpara1);
-          a_loadaddr_ref_cgpara(list,strdef,source,cgpara2);
-          a_loadaddr_ref_cgpara(list,strdef,dest,cgpara3);
+          a_loadaddr_ref_cgpara(list,strdef,dest,cgpara1);
+          a_load_const_cgpara(list,s32inttype,strdef.len,cgpara2);
+          a_loadaddr_ref_cgpara(list,strdef,source,cgpara3);
         end
       else
         begin
-          a_loadaddr_ref_cgpara(list,strdef,dest,cgpara3);
-          a_loadaddr_ref_cgpara(list,strdef,source,cgpara2);
-          a_load_const_cgpara(list,s32inttype,strdef.len,cgpara1);
+          a_loadaddr_ref_cgpara(list,strdef,source,cgpara3);
+          a_load_const_cgpara(list,s32inttype,strdef.len,cgpara2);
+          a_loadaddr_ref_cgpara(list,strdef,dest,cgpara1);
         end;
       paramanager.freecgpara(list,cgpara3);
       paramanager.freecgpara(list,cgpara2);
@@ -3559,6 +3589,8 @@ implementation
           toreg:=getaddressregister(list,regsize);
         R_FPUREGISTER:
           toreg:=getfpuregister(list,regsize);
+        else
+          internalerror(2013112910);
       end;
       a_load_reg_reg(list,regsize,regsize,fromreg,toreg);
     end;
@@ -3574,6 +3606,8 @@ implementation
             toreg:=getaddressregister(list,regsize);
           R_FPUREGISTER:
             toreg:=getfpuregister(list,regsize);
+        else
+          internalerror(2013112915);
         end;
         a_load_reg_reg(list,regsize,regsize,fromreg,toreg);
       end;
@@ -3678,7 +3712,7 @@ implementation
         begin
           { if it's in an mm register, store to memory first }
           if (l.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
-            internalerror(2011012903);
+            location_force_mem(list,l,size);
           reg:=getfpuregister(list,size);
           a_loadfpu_loc_reg(list,size,size,l,reg);
           location_freetemp(list,l);
@@ -3794,14 +3828,14 @@ implementation
             begin
               if not loadref then
                 internalerror(200410231);
-              reference_reset_base(ref,l.register,0,alignment);
+              reference_reset_base(ref,voidpointertype,l.register,0,alignment);
             end;
           LOC_REFERENCE,
           LOC_CREFERENCE :
             begin
               if loadref then
                 begin
-                  reference_reset_base(ref,getaddressregister(list,voidpointertype),0,alignment);
+                  reference_reset_base(ref,voidpointertype,getaddressregister(list,voidpointertype),0,alignment);
                   { it's a pointer to def }
                   a_load_ref_reg(list,voidpointertype,voidpointertype,l.reference,ref.base);
                 end
@@ -3872,12 +3906,225 @@ implementation
     end;
 
 
-  function use_ent : boolean;
+  procedure thlcgobj.maybe_change_load_node_reg(list: TAsmList; var n: tnode; reload: boolean);
+    var
+      rr: treplaceregrec;
+      varloc : tai_varloc;
     begin
-	  use_ent := (target_info.system in [system_mipsel_linux,system_mipseb_linux,system_mipsel_embedded])
-	             or (target_info.cpu=cpu_alpha);
+      if not (n.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) or
+        ([fc_inflowcontrol,fc_gotolabel,fc_lefthandled] * flowcontrol <> []) then
+        exit;
+      rr.old := n.location.register;
+      rr.ressym := nil;
+      rr.sym := nil;
+      rr.oldhi := NR_NO;
+      case n.location.loc of
+        LOC_CREGISTER:
+          begin
+{$ifdef cpu64bitalu}
+            if (n.location.size in [OS_128,OS_S128]) then
+              begin
+                rr.oldhi := n.location.register128.reghi;
+                rr.new := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+                rr.newhi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+              end
+            else
+{$else cpu64bitalu}
+            if (n.location.size in [OS_64,OS_S64]) then
+              begin
+                rr.oldhi := n.location.register64.reghi;
+                rr.new := cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+                rr.newhi := cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+              end
+            else
+{$endif cpu64bitalu}
+              rr.new := cg.getintregister(current_asmdata.CurrAsmList,n.location.size);
+          end;
+        LOC_CFPUREGISTER:
+          rr.new := cg.getfpuregister(current_asmdata.CurrAsmList,n.location.size);
+{$ifdef SUPPORT_MMX}
+        LOC_CMMXREGISTER:
+          rr.new := tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList);
+{$endif SUPPORT_MMX}
+        LOC_CMMREGISTER:
+          rr.new := cg.getmmregister(current_asmdata.CurrAsmList,n.location.size);
+        else
+          exit;
+      end;
+
+      { self is implicitly returned from constructors, even if there are no
+        references to it; additionally, funcretsym is not set for constructor
+        procdefs }
+      if (current_procinfo.procdef.proctypeoption=potype_constructor) then
+        rr.ressym:=tsym(current_procinfo.procdef.parast.Find('self'))
+      else if not is_void(current_procinfo.procdef.returndef) and
+         assigned(current_procinfo.procdef.funcretsym) and
+         (tabstractvarsym(current_procinfo.procdef.funcretsym).refs <> 0) then
+        rr.ressym:=current_procinfo.procdef.funcretsym;
+
+      if not foreachnode(n,@do_replace_node_regs,@rr) then
+        exit;
+
+      if reload then
+        case n.location.loc of
+          LOC_CREGISTER:
+            begin
+{$ifdef cpu64bitalu}
+              if (n.location.size in [OS_128,OS_S128]) then
+                cg128.a_load128_reg_reg(list,n.location.register128,joinreg128(rr.new,rr.newhi))
+              else
+{$else cpu64bitalu}
+              if (n.location.size in [OS_64,OS_S64]) then
+                cg64.a_load64_reg_reg(list,n.location.register64,joinreg64(rr.new,rr.newhi))
+              else
+{$endif cpu64bitalu}
+                cg.a_load_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new);
+            end;
+          LOC_CFPUREGISTER:
+            cg.a_loadfpu_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new);
+{$ifdef SUPPORT_MMX}
+          LOC_CMMXREGISTER:
+            cg.a_loadmm_reg_reg(list,OS_M64,OS_M64,n.location.register,rr.new,nil);
+{$endif SUPPORT_MMX}
+          LOC_CMMREGISTER:
+            cg.a_loadmm_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new,nil);
+          else
+            internalerror(2006090920);
+        end;
+
+      { now that we've change the loadn/temp, also change the node result location }
+{$ifdef cpu64bitalu}
+      if (n.location.size in [OS_128,OS_S128]) then
+        begin
+          n.location.register128.reglo := rr.new;
+          n.location.register128.reghi := rr.newhi;
+          if assigned(rr.sym) and
+             ((rr.sym.currentregloc.register<>rr.new) or
+              (rr.sym.currentregloc.registerhi<>rr.newhi)) then
+            begin
+              varloc:=tai_varloc.create128(rr.sym,rr.new,rr.newhi);
+              varloc.oldlocation:=rr.sym.currentregloc.register;
+              varloc.oldlocationhi:=rr.sym.currentregloc.registerhi;
+              rr.sym.currentregloc.register:=rr.new;
+              rr.sym.currentregloc.registerHI:=rr.newhi;
+              list.concat(varloc);
+            end;
+        end
+      else
+{$else cpu64bitalu}
+      if (n.location.size in [OS_64,OS_S64]) then
+        begin
+          n.location.register64.reglo := rr.new;
+          n.location.register64.reghi := rr.newhi;
+          if assigned(rr.sym) and
+             ((rr.sym.currentregloc.register<>rr.new) or
+              (rr.sym.currentregloc.registerhi<>rr.newhi)) then
+            begin
+              varloc:=tai_varloc.create64(rr.sym,rr.new,rr.newhi);
+              varloc.oldlocation:=rr.sym.currentregloc.register;
+              varloc.oldlocationhi:=rr.sym.currentregloc.registerhi;
+              rr.sym.currentregloc.register:=rr.new;
+              rr.sym.currentregloc.registerHI:=rr.newhi;
+              list.concat(varloc);
+            end;
+        end
+      else
+{$endif cpu64bitalu}
+        begin
+          n.location.register := rr.new;
+          if assigned(rr.sym) and (rr.sym.currentregloc.register<>rr.new) then
+            begin
+              varloc:=tai_varloc.create(rr.sym,rr.new);
+              varloc.oldlocation:=rr.sym.currentregloc.register;
+              rr.sym.currentregloc.register:=rr.new;
+              list.concat(varloc);
+            end;
+        end;
     end;
 
+
+  function thlcgobj.do_replace_node_regs(var n: tnode; para: pointer): foreachnoderesult;
+    var
+      rr: preplaceregrec absolute para;
+    begin
+      result := fen_false;
+      if (nf_is_funcret in n.flags) and (fc_exit in flowcontrol) then
+        exit;
+      case n.nodetype of
+        loadn:
+          begin
+            if (tloadnode(n).symtableentry.typ in [localvarsym,paravarsym,staticvarsym]) and
+               (tabstractvarsym(tloadnode(n).symtableentry).varoptions * [vo_is_dll_var, vo_is_thread_var] = []) and
+               not assigned(tloadnode(n).left) and
+               ((tloadnode(n).symtableentry <> rr^.ressym) or
+                not(fc_exit in flowcontrol)
+               ) and
+               (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
+               (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register = rr^.old) then
+              begin
+{$ifdef cpu64bitalu}
+                { it's possible a 128 bit location was shifted and/xor typecasted }
+                { in a 64 bit value, so only 1 register was left in the location }
+                if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.size in [OS_128,OS_S128]) then
+                  if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register128.reghi = rr^.oldhi) then
+                    tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register128.reghi := rr^.newhi
+                  else
+                    exit;
+{$else cpu64bitalu}
+                { it's possible a 64 bit location was shifted and/xor typecasted }
+                { in a 32 bit value, so only 1 register was left in the location }
+                if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.size in [OS_64,OS_S64]) then
+                  if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi = rr^.oldhi) then
+                    tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi := rr^.newhi
+                  else
+                    exit;
+{$endif cpu64bitalu}
+                tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register := rr^.new;
+                rr^.sym := tabstractnormalvarsym(tloadnode(n).symtableentry);
+                result := fen_norecurse_true;
+              end;
+          end;
+        temprefn:
+          begin
+            if (ti_valid in ttemprefnode(n).tempinfo^.flags) and
+               (ttemprefnode(n).tempinfo^.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
+               (ttemprefnode(n).tempinfo^.location.register = rr^.old) then
+              begin
+{$ifdef cpu64bitalu}
+                { it's possible a 128 bit location was shifted and/xor typecasted }
+                { in a 64 bit value, so only 1 register was left in the location }
+                if (ttemprefnode(n).tempinfo^.location.size in [OS_128,OS_S128]) then
+                  if (ttemprefnode(n).tempinfo^.location.register128.reghi = rr^.oldhi) then
+                    ttemprefnode(n).tempinfo^.location.register128.reghi := rr^.newhi
+                  else
+                    exit;
+{$else cpu64bitalu}
+                { it's possible a 64 bit location was shifted and/xor typecasted }
+                { in a 32 bit value, so only 1 register was left in the location }
+                if (ttemprefnode(n).tempinfo^.location.size in [OS_64,OS_S64]) then
+                  if (ttemprefnode(n).tempinfo^.location.register64.reghi = rr^.oldhi) then
+                    ttemprefnode(n).tempinfo^.location.register64.reghi := rr^.newhi
+                  else
+                    exit;
+{$endif cpu64bitalu}
+                ttemprefnode(n).tempinfo^.location.register := rr^.new;
+                result := fen_norecurse_true;
+              end;
+          end;
+        { optimize the searching a bit }
+        derefn,addrn,
+        calln,inlinen,casen,
+        addn,subn,muln,
+        andn,orn,xorn,
+        ltn,lten,gtn,gten,equaln,unequaln,
+        slashn,divn,shrn,shln,notn,
+        inn,
+        asn,isn:
+          result := fen_norecurse_false;
+      end;
+    end;
+
+
   procedure thlcgobj.gen_proc_symbol(list: TAsmList);
     var
       item,
@@ -3888,7 +4135,7 @@ implementation
       while assigned(item) do
         begin
 {$ifdef arm}
-          if current_settings.cputype in cpu_thumb2+cpu_thumb then
+          if GenerateThumbCode or GenerateThumb2Code then
             list.concat(tai_thumb_func.create);
 {$endif arm}
           { "double link" all procedure entry symbols via .reference }
@@ -3911,15 +4158,11 @@ implementation
           previtem:=item;
           item := TCmdStrListItem(item.next);
         end;
-	  if (use_ent) then
-	    list.concat(Tai_ent.create(current_procinfo.procdef.mangledname));
       current_procinfo.procdef.procstarttai:=tai(list.last);
     end;
 
   procedure thlcgobj.gen_proc_symbol_end(list: TAsmList);
     begin
-	  if (use_ent) then
-	    list.concat(Tai_ent_end.create(current_procinfo.procdef.mangledname));
       list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
 
       current_procinfo.procdef.procendtai:=tai(list.last);
@@ -4085,7 +4328,7 @@ implementation
          if assigned(hp^.def) and
             is_managed_type(hp^.def) then
           begin
-            reference_reset_base(href,current_procinfo.framepointer,hp^.pos,sizeof(pint));
+            reference_reset_base(href,voidstackpointertype,current_procinfo.framepointer,hp^.pos,voidstackpointertype.size);
             g_initialize(list,hp^.def,href);
           end;
          hp:=hp^.next;
@@ -4133,7 +4376,7 @@ implementation
             is_managed_type(hp^.def) then
           begin
             include(current_procinfo.flags,pi_needs_implicit_finally);
-            reference_reset_base(href,current_procinfo.framepointer,hp^.pos,sizeof(pint));
+            reference_reset_base(href,voidstackpointertype,current_procinfo.framepointer,hp^.pos,voidstackpointertype.size);
             g_finalize(list,hp^.def,href);
           end;
          hp:=hp^.next;
@@ -4237,7 +4480,13 @@ implementation
                 ) and
                not(vo_is_funcret in tstaticvarsym(p).varoptions) and
                not(vo_is_external in tstaticvarsym(p).varoptions) and
-               is_managed_type(tstaticvarsym(p).vardef) then
+               is_managed_type(tstaticvarsym(p).vardef) and
+               not (
+                   assigned(tstaticvarsym(p).fieldvarsym) and
+                   assigned(tstaticvarsym(p).fieldvarsym.owner.defowner) and
+                   (df_generic in tdef(tstaticvarsym(p).fieldvarsym.owner.defowner).defoptions)
+                 )
+               then
               finalize_sym(TAsmList(arg),tsym(p));
           end;
         procsym :
@@ -4302,9 +4551,6 @@ implementation
     end;
 
 
-
-
-
 { generates the code for incrementing the reference count of parameters and
   initialize out parameters }
   { generates the code for incrementing the reference count of parameters and
@@ -4633,8 +4879,15 @@ implementation
               anything }
             if not reusepara then
               begin
-                reference_reset_base(href,para.location^.reference.index,para.location^.reference.offset,para.alignment);
-                a_load_ref_ref(list,para.def,para.def,href,destloc.reference);
+                case para.location^.loc of
+                  LOC_REFERENCE,LOC_CREFERENCE:
+                    begin
+                      reference_reset_base(href,voidstackpointertype,para.location^.reference.index,para.location^.reference.offset,para.alignment);
+                      a_load_ref_ref(list,para.def,para.def,href,destloc.reference);
+                    end;
+                  else
+                    internalerror(2013102301);
+                end;
               end;
           end;
         { TODO other possible locations }

compiler/htypechk.pas

@@ -870,6 +870,8 @@ implementation
       begin
         isbinaryoverloaded:=false;
         operpd:=nil;
+        ppn:=nil;
+
         { load easier access variables }
         ld:=tbinarynode(t).left.resultdef;
         rd:=tbinarynode(t).right.resultdef;
@@ -972,6 +974,8 @@ implementation
     { marks an lvalue as "unregable" }
     procedure make_not_regable_intern(p : tnode; how: tregableinfoflags; records_only: boolean);
       begin
+        if ra_addr_taken in how then
+          include(p.flags,nf_address_taken);
         repeat
           case p.nodetype of
             subscriptn:
@@ -1135,8 +1139,13 @@ implementation
                      exclude(varstateflags,vsf_must_be_valid);
                    tc_pchar_2_string,
                    tc_pointer_2_array :
-                     include(varstateflags,vsf_must_be_valid);
-                 end;
+                     begin
+                       include(varstateflags,vsf_must_be_valid);
+                       { when a pointer is used for array access, the
+                         pointer itself is read and never written }
+                       newstate := vs_read;
+                     end;
+               end;
                  p:=tunarynode(p).left;
                end;
              subscriptn :
@@ -1148,6 +1157,9 @@ implementation
              vecn:
                begin
                  set_varstate(tbinarynode(p).right,vs_read,[vsf_must_be_valid]);
+                 { dyn. arrays and dyn. strings are read }
+                 if is_implicit_array_pointer(tunarynode(p).left.resultdef) then
+                   newstate:=vs_read;
                  if (newstate in [vs_read,vs_readwritten]) or
                     not(tunarynode(p).left.resultdef.typ in [stringdef,arraydef]) then
                    include(varstateflags,vsf_must_be_valid)
@@ -1472,7 +1484,7 @@ implementation
                         is_open_array(fromdef) or
                         is_open_array(todef) or
                         ((fromdef.typ=pointerdef) and (todef.typ=arraydef)) or
-                        (fromdef.is_related(todef))) and
+                        (def_is_related(fromdef,todef))) and
                     (fromdef.size<>todef.size) then
                   begin
                     { in TP it is allowed to typecast to smaller types. But the variable can't
@@ -1505,8 +1517,8 @@ implementation
                      begin
                        { pointer -> array conversion is done then we need to see it
                          as a deref, because a ^ is then not required anymore }
-                       if (ttypeconvnode(hp).left.resultdef.typ=pointerdef) then
-                        gotderef:=true;
+                       if ttypeconvnode(hp).convtype=tc_pointer_2_array then
+                         gotderef:=true;
                      end;
                  end;
                  hp:=ttypeconvnode(hp).left;
@@ -1964,7 +1976,7 @@ implementation
                   (tobjectdef(def_from).objecttype=odt_object) and
                   (tobjectdef(def_to).objecttype=odt_object)
                  ) and
-                 (tobjectdef(def_from).is_related(tobjectdef(def_to))) then
+                 (def_is_related(tobjectdef(def_from),tobjectdef(def_to))) then
                 eq:=te_convert_l1;
             end;
           filedef :
@@ -2215,7 +2227,7 @@ implementation
                  break;
              end;
            if is_objectpascal_helper(structdef) and
-              (tobjectdef(structdef).typ in [recorddef,objectdef]) then
+              (tobjectdef(structdef).extendeddef.typ in [recorddef,objectdef]) then
              begin
                { search methods in the extended type as well }
                srsym:=tprocsym(tabstractrecorddef(tobjectdef(structdef).extendeddef).symtable.FindWithHash(hashedid));
@@ -2696,8 +2708,8 @@ implementation
               { for value and const parameters check precision of real, give
                 penalty for loosing of precision. var and out parameters must match exactly }
                if not(currpara.varspez in [vs_var,vs_out]) and
-                  is_real(def_from) and
-                  is_real(def_to) then
+                  is_real_or_cextended(def_from) and
+                  is_real_or_cextended(def_to) then
                  begin
                    eq:=te_equal;
                    if is_extended(def_to) then
@@ -2728,7 +2740,7 @@ implementation
                   (def_from.typ=objectdef) and
                   (def_to.typ=objectdef) and
                   (tobjectdef(def_from).objecttype=tobjectdef(def_to).objecttype) and
-                  tobjectdef(def_from).is_related(tobjectdef(def_to)) then
+                  def_is_related(tobjectdef(def_from),tobjectdef(def_to)) then
                  begin
                    eq:=te_convert_l1;
                    objdef:=tobjectdef(def_from);
@@ -3226,7 +3238,7 @@ implementation
                   the struct in which the current best method was found }
                 if assigned(pd.struct) and
                    (pd.struct<>tprocdef(bestpd).struct) and
-                   tprocdef(bestpd).struct.is_related(pd.struct) then
+                   def_is_related(tprocdef(bestpd).struct,pd.struct) then
                   break;
                 if (pd.proctypeoption=bestpd.proctypeoption) and
                    ((pd.procoptions*[po_classmethod,po_methodpointer])=(bestpd.procoptions*[po_classmethod,po_methodpointer])) and

compiler/i386/aopt386.pas

@@ -64,13 +64,16 @@ Begin
    { or nil                                                                }
      While Assigned(BlockStart) Do
        Begin
-         if pass = 0 then
-           PrePeepHoleOpts(AsmL, BlockStart, BlockEnd);
-        { Peephole optimizations }
-         PeepHoleOptPass1(AsmL, BlockStart, BlockEnd);
-        { Only perform them twice in the first pass }
-         if pass = 0 then
-           PeepHoleOptPass1(AsmL, BlockStart, BlockEnd);
+         if (cs_opt_peephole in current_settings.optimizerswitches) then
+           begin
+            if (pass = 0) then
+              PrePeepHoleOpts(AsmL, BlockStart, BlockEnd);
+              { Peephole optimizations }
+               PeepHoleOptPass1(AsmL, BlockStart, BlockEnd);
+              { Only perform them twice in the first pass }
+               if pass = 0 then
+                 PeepHoleOptPass1(AsmL, BlockStart, BlockEnd);
+           end;
         { Data flow analyzer }
          If (cs_opt_asmcse in current_settings.optimizerswitches) Then
            begin
@@ -79,9 +82,12 @@ Begin
                changed := CSE(asmL, blockStart, blockEnd, pass) or changed;
            end;
         { More peephole optimizations }
-         PeepHoleOptPass2(AsmL, BlockStart, BlockEnd);
-         if lastLoop then
-           PostPeepHoleOpts(AsmL, BlockStart, BlockEnd);
+         if (cs_opt_peephole in current_settings.optimizerswitches) then
+           begin
+             PeepHoleOptPass2(AsmL, BlockStart, BlockEnd);
+             if lastLoop then
+               PostPeepHoleOpts(AsmL, BlockStart, BlockEnd);
+           end;
 
         { Free memory }
         dfa.clear;

compiler/i386/cgcpu.pas

@@ -30,7 +30,7 @@ unit cgcpu;
        cgbase,cgobj,cg64f32,cgx86,
        aasmbase,aasmtai,aasmdata,aasmcpu,
        cpubase,parabase,cgutils,
-       symconst,symdef
+       symconst,symdef,symsym
        ;
 
     type
@@ -200,7 +200,7 @@ unit cgcpu;
         if use_push(cgpara) then
           begin
             { Record copy? }
-            if (cgpara.size in [OS_NO,OS_F64]) or (size=OS_NO) then
+            if (cgpara.size=OS_NO) or (size=OS_NO) then
               begin
                 cgpara.check_simple_location;
                 len:=align(cgpara.intsize,cgpara.alignment);
@@ -212,9 +212,19 @@ unit cgcpu;
               begin
                 if tcgsize2size[cgpara.size]<>tcgsize2size[size] then
                   internalerror(200501161);
-                { We need to push the data in reverse order,
-                  therefor we use a recursive algorithm }
-                pushdata(cgpara.location,0);
+                if (cgpara.size=OS_F64) then
+                  begin
+                    href:=r;
+                    make_simple_ref(list,href);
+                    inc(href.offset,4);
+                    list.concat(taicpu.op_ref(A_PUSH,S_L,href));
+                    dec(href.offset,4);
+                    list.concat(taicpu.op_ref(A_PUSH,S_L,href));
+                  end
+                else
+                  { We need to push the data in reverse order,
+                    therefor we use a recursive algorithm }
+                  pushdata(cgpara.location,0);
               end
           end
         else
@@ -294,17 +304,15 @@ unit cgcpu;
 
     procedure tcg386.g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);
 
-      procedure increase_fp(a : tcgint);
+      procedure increase_sp(a : tcgint);
         var
           href : treference;
         begin
-          reference_reset_base(href,current_procinfo.framepointer,a,0);
+          reference_reset_base(href,NR_STACK_POINTER_REG,a,0);
           { normally, lea is a better choice than an add }
-          list.concat(Taicpu.op_ref_reg(A_LEA,TCGSize2OpSize[OS_ADDR],href,current_procinfo.framepointer));
+          list.concat(Taicpu.op_ref_reg(A_LEA,TCGSize2OpSize[OS_ADDR],href,NR_STACK_POINTER_REG));
         end;
 
-      var
-        stacksize : longint;
       begin
         { MMX needs to call EMMS }
         if assigned(rg[R_MMXREGISTER]) and
@@ -314,21 +322,22 @@ unit cgcpu;
         { remove stackframe }
         if not nostackframe then
           begin
-            if current_procinfo.framepointer=NR_STACK_POINTER_REG then
+            if (current_procinfo.framepointer=NR_STACK_POINTER_REG) or
+               (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
               begin
-                stacksize:=current_procinfo.calc_stackframe_size;
-                if (target_info.stackalign>4) and
-                   ((stacksize <> 0) or
-                    (pi_do_call in current_procinfo.flags) or
-                    { can't detect if a call in this case -> use nostackframe }
-                    { if you (think you) know what you are doing              }
-                    (po_assembler in current_procinfo.procdef.procoptions)) then
-                  stacksize := align(stacksize+sizeof(aint),target_info.stackalign) - sizeof(aint);
-                if stacksize<>0 then
-                  increase_fp(stacksize);
+                if current_procinfo.final_localsize<>0 then
+                  increase_sp(current_procinfo.final_localsize);
+                if (not paramanager.use_fixed_stack) then
+                  internal_restore_regs(list,true);
+                if (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
+                  list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[OS_ADDR],NR_FRAME_POINTER_REG));
               end
             else
-              list.concat(Taicpu.op_none(A_LEAVE,S_NO));
+              begin
+                if (not paramanager.use_fixed_stack) then
+                  internal_restore_regs(list,not (pi_has_stack_allocs in current_procinfo.flags));
+                list.concat(Taicpu.op_none(A_LEAVE,S_NO));
+              end;
             list.concat(tai_regalloc.dealloc(current_procinfo.framepointer,nil));
           end;
 
@@ -381,7 +390,8 @@ unit cgcpu;
            { but not on win32 }
            { and not for safecall with hidden exceptions, because the result }
            { wich contains the exception is passed in EAX }
-           if (target_info.system <> system_i386_win32) and
+           if ((target_info.system <> system_i386_win32) or
+               (target_info.abi=abi_old_win32_gnu)) and
               not ((current_procinfo.procdef.proccalloption = pocall_safecall) and
                (tf_safecall_exceptions in target_info.flags)) and
               paramanager.ret_in_param(current_procinfo.procdef.returndef,
@@ -405,7 +415,7 @@ unit cgcpu;
 
     procedure tcg386.g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);
       var
-        power,len  : longint;
+        power  : longint;
         opsize : topsize;
 {$ifndef __NOWINPECOFF__}
         again,ok : tasmlabel;
@@ -415,9 +425,21 @@ unit cgcpu;
         getcpuregister(list,NR_EDI);
         a_load_loc_reg(list,OS_INT,lenloc,NR_EDI);
         list.concat(Taicpu.op_reg(A_INC,S_L,NR_EDI));
-        { Now EDI contains (high+1). Copy it to ECX for later use. }
-        getcpuregister(list,NR_ECX);
-        list.concat(Taicpu.op_reg_reg(A_MOV,S_L,NR_EDI,NR_ECX));
+        { Now EDI contains (high+1). }
+
+        { special case handling for elesize=8, 4 and 2:
+          set ECX = (high+1) instead of ECX = (high+1)*elesize.
+
+          In the case of elesize=4 and 2, this allows us to avoid the SHR later.
+          In the case of elesize=8, we can later use a SHL ECX, 1 instead of
+          SHR ECX, 2 which is one byte shorter. }
+        if (elesize=8) or (elesize=4) or (elesize=2) then
+          begin
+            { Now EDI contains (high+1). Copy it to ECX for later use. }
+            getcpuregister(list,NR_ECX);
+            list.concat(Taicpu.op_reg_reg(A_MOV,S_L,NR_EDI,NR_ECX));
+          end;
+        { EDI := EDI * elesize }
         if (elesize<>1) then
          begin
            if ispowerof2(elesize, power) then
@@ -425,6 +447,12 @@ unit cgcpu;
            else
              list.concat(Taicpu.op_const_reg(A_IMUL,S_L,elesize,NR_EDI));
          end;
+        if (elesize<>8) and (elesize<>4) and (elesize<>2) then
+          begin
+            { Now EDI contains (high+1)*elesize. Copy it to ECX for later use. }
+            getcpuregister(list,NR_ECX);
+            list.concat(Taicpu.op_reg_reg(A_MOV,S_L,NR_EDI,NR_ECX));
+          end;
 {$ifndef __NOWINPECOFF__}
         { windows guards only a few pages for stack growing, }
         { so we have to access every page first              }
@@ -458,27 +486,40 @@ unit cgcpu;
         a_loadaddr_ref_reg(list,ref,NR_ESI);
 
         { calculate size }
-        len:=elesize;
         opsize:=S_B;
-        if (len and 3)=0 then
+        if elesize=8 then
+          begin
+            opsize:=S_L;
+            { ECX is number of qwords, convert to dwords }
+            list.concat(Taicpu.op_const_reg(A_SHL,S_L,1,NR_ECX))
+          end
+        else if elesize=4 then
+          begin
+            opsize:=S_L;
+            { ECX is already number of dwords, so no need to SHL/SHR }
+          end
+        else if elesize=2 then
+          begin
+            opsize:=S_W;
+            { ECX is already number of words, so no need to SHL/SHR }
+          end
+        else
+         if (elesize and 3)=0 then
          begin
            opsize:=S_L;
-           len:=len shr 2;
+           { ECX is number of bytes, convert to dwords }
+           list.concat(Taicpu.op_const_reg(A_SHR,S_L,2,NR_ECX))
          end
         else
-         if (len and 1)=0 then
+         if (elesize and 1)=0 then
           begin
             opsize:=S_W;
-            len:=len shr 1;
+            { ECX is number of bytes, convert to words }
+            list.concat(Taicpu.op_const_reg(A_SHR,S_L,1,NR_ECX))
           end;
 
-        if len>1 then
-          begin
-            if ispowerof2(len, power) then
-              list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,NR_ECX))
-            else
-              list.concat(Taicpu.op_const_reg(A_IMUL,S_L,len,NR_ECX));
-          end;
+        if ts_cld in current_settings.targetswitches then
+          list.concat(Taicpu.op_none(A_CLD,S_NO));
         list.concat(Taicpu.op_none(A_REP,S_NO));
         case opsize of
           S_B : list.concat(Taicpu.Op_none(A_MOVSB,S_NO));
@@ -492,6 +533,7 @@ unit cgcpu;
         { patch the new address, but don't use a_load_reg_reg, that will add a move instruction
           that can confuse the reg allocator }
         list.concat(Taicpu.Op_reg_reg(A_MOV,S_L,NR_ESP,destreg));
+        include(current_procinfo.flags,pi_has_stack_allocs);
       end;
 
 
@@ -523,7 +565,7 @@ unit cgcpu;
       begin
         if not paramanager.use_fixed_stack then
           begin
-            cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
+            a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
             list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[OS_INT],NR_FUNCTION_RESULT_REG))
           end
         else
@@ -552,7 +594,7 @@ unit cgcpu;
                (current_settings.optimizecputype in [cpu_Pentium2,cpu_Pentium3,cpu_Pentium4]) } then
               begin
                 current_module.requires_ebx_pic_helper:=true;
-                cg.a_call_name_static(list,'fpc_geteipasebx');
+                a_call_name_static(list,'fpc_geteipasebx');
               end
             else
               begin
@@ -578,17 +620,17 @@ unit cgcpu;
       possible calling conventions:
                     default stdcall cdecl pascal register
       default(0):      OK     OK    OK     OK       OK
-      virtual(1):      OK     OK    OK     OK       OK(2)
+      virtual(1):      OK     OK    OK     OK       OK(2 or 1)
 
       (0):
           set self parameter to correct value
           jmp mangledname
 
-      (1): The wrapper code use %eax to reach the virtual method address
+      (1): The wrapper code use %ecx to reach the virtual method address
            set self to correct value
            move self,%eax
-           mov  0(%eax),%eax ; load vmt
-           jmp  vmtoffs(%eax) ; method offs
+           mov  0(%eax),%ecx ; load vmt
+           jmp  vmtoffs(%ecx) ; method offs
 
       (2): Virtual use values pushed on stack to reach the method address
            so the following code be generated:
@@ -604,6 +646,30 @@ unit cgcpu;
 
       }
 
+      { returns whether ECX is used (either as a parameter or is nonvolatile and shouldn't be changed) }
+      function is_ecx_used: boolean;
+        var
+          i: Integer;
+          hp: tparavarsym;
+          paraloc: PCGParaLocation;
+        begin
+          if not (RS_ECX in paramanager.get_volatile_registers_int(procdef.proccalloption)) then
+            exit(true);
+          for i:=0 to procdef.paras.count-1 do
+           begin
+             hp:=tparavarsym(procdef.paras[i]);
+             procdef.init_paraloc_info(calleeside);
+             paraloc:=hp.paraloc[calleeside].Location;
+             while paraloc<>nil do
+               begin
+                 if (paraloc^.Loc=LOC_REGISTER) and (getsupreg(paraloc^.register)=RS_ECX) then
+                   exit(true);
+                 paraloc:=paraloc^.Next;
+               end;
+           end;
+          Result:=false;
+        end;
+
       procedure getselftoeax(offs: longint);
         var
           href : treference;
@@ -618,27 +684,27 @@ unit cgcpu;
               else
                 selfoffsetfromsp:=sizeof(aint);
               reference_reset_base(href,NR_ESP,selfoffsetfromsp+offs,4);
-              cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
+              a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
             end;
         end;
 
-      procedure loadvmttoeax;
+      procedure loadvmtto(reg: tregister);
         var
           href : treference;
         begin
-          { mov  0(%eax),%eax ; load vmt}
+          { mov  0(%eax),%reg ; load vmt}
           reference_reset_base(href,NR_EAX,0,4);
-          cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
+          a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,reg);
         end;
 
-      procedure op_oneaxmethodaddr(op: TAsmOp);
+      procedure op_onregmethodaddr(op: TAsmOp; reg: tregister);
         var
           href : treference;
         begin
           if (procdef.extnumber=$ffff) then
             Internalerror(200006139);
-          { call/jmp  vmtoffs(%eax) ; method offs }
-          reference_reset_base(href,NR_EAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
+          { call/jmp  vmtoffs(%reg) ; method offs }
+          reference_reset_base(href,reg,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
           list.concat(taicpu.op_ref(op,S_L,href));
         end;
 
@@ -651,7 +717,7 @@ unit cgcpu;
             Internalerror(200006139);
           { mov vmtoffs(%eax),%eax ; method offs }
           reference_reset_base(href,NR_EAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
-          cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
+          a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
         end;
 
 
@@ -686,13 +752,13 @@ unit cgcpu;
         if (po_virtualmethod in procdef.procoptions) and
             not is_objectpascal_helper(procdef.struct) then
           begin
-            if (procdef.proccalloption=pocall_register) then
+            if (procdef.proccalloption=pocall_register) and is_ecx_used then
               begin
                 { case 2 }
                 list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EBX)); { allocate space for address}
                 list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EAX));
                 getselftoeax(8);
-                loadvmttoeax;
+                loadvmtto(NR_EAX);
                 loadmethodoffstoeax;
                 { mov %eax,4(%esp) }
                 reference_reset_base(href,NR_ESP,4,4);
@@ -706,8 +772,8 @@ unit cgcpu;
               begin
                 { case 1 }
                 getselftoeax(0);
-                loadvmttoeax;
-                op_oneaxmethodaddr(A_JMP);
+                loadvmtto(NR_ECX);
+                op_onregmethodaddr(A_JMP,NR_ECX);
               end;
           end
         { case 0 }

compiler/i386/cpubase.inc

@@ -38,6 +38,7 @@
         S_YMM
       );
 
+      TOpSizes = set of topsize;
 
 {*****************************************************************************
                                 Registers
@@ -138,6 +139,7 @@
       }
       saved_standard_registers : array[0..3] of tsuperregister = (RS_EBX,RS_ESI,RS_EDI,RS_EBP);
 
+      saved_address_registers : array[0..0] of tsuperregister = (RS_INVALID);
       saved_mm_registers : array[0..0] of tsuperregister = (RS_INVALID);
       {# Required parameter alignment when calling a routine declared as
          stdcall and cdecl. The alignment value should be the one defined

compiler/i386/cpuelf.pas

@@ -110,6 +110,8 @@ implementation
           result:=R_386_GOTPC;
         RELOC_PLT32 :
           result:=R_386_PLT32;
+        RELOC_GOTOFF:
+          result:=R_386_GOTOFF;
       else
         result:=0;
         InternalError(2012082301);
@@ -507,7 +509,7 @@ implementation
                               system_i386_openbsd,system_i386_netbsd,
                               system_i386_Netware,system_i386_netwlibc,
                               system_i386_solaris,system_i386_embedded,
-                              system_i386_android];
+                              system_i386_android,system_i386_aros];
          flags : [af_outputbinary,af_smartlink_sections,af_supports_dwarf];
          labelprefix : '.L';
          comment : '';

compiler/i386/cpuinfo.pas

@@ -46,7 +46,10 @@ Type
        cpu_Pentium2,
        cpu_Pentium3,
        cpu_Pentium4,
-       cpu_PentiumM
+       cpu_PentiumM,
+       cpu_core_i,
+       cpu_core_avx,
+       cpu_core_avx2
       );
 
    tfputype =
@@ -85,7 +88,10 @@ Const
      'PENTIUM2',
      'PENTIUM3',
      'PENTIUM4',
-     'PENTIUMM'
+     'PENTIUMM',
+     'COREI',
+     'COREAVX',
+     'COREAVX2'
    );
 
    fputypestr : array[tfputype] of string[6] = ('',
@@ -117,12 +123,40 @@ Const
                                   cs_opt_tailrecursion,cs_opt_nodecse,cs_useebp,
 				  cs_opt_reorder_fields,cs_opt_fastmath];
 
-   level1optimizerswitches = genericlevel1optimizerswitches + [cs_opt_peephole];
+   level1optimizerswitches = genericlevel1optimizerswitches;
    level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches +
      [cs_opt_regvar,cs_opt_stackframe,cs_opt_tailrecursion,cs_opt_nodecse];
    level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}];
    level4optimizerswitches = genericlevel4optimizerswitches + level3optimizerswitches + [cs_useebp];
 
+type
+   tcpuflags =
+      (CPUX86_HAS_SSEUNIT,
+       CPUX86_HAS_BMI1,
+       CPUX86_HAS_BMI2,
+       CPUX86_HAS_POPCNT,
+       CPUX86_HAS_AVXUNIT,
+       CPUX86_HAS_LZCNT,
+       CPUX86_HAS_MOVBE,
+       CPUX86_HAS_FMA,
+       CPUX86_HAS_FMA4
+      );
+
+ const
+   cpu_capabilities : array[tcputype] of set of tcpuflags = (
+     { cpu_none      } [],
+     { cpu_386       } [],
+     { cpu_Pentium   } [],
+     { cpu_Pentium2  } [],
+     { cpu_Pentium3  } [CPUX86_HAS_SSEUNIT],
+     { cpu_Pentium4  } [CPUX86_HAS_SSEUNIT],
+     { cpu_PentiumM  } [CPUX86_HAS_SSEUNIT],
+     { cpu_core_i    } [CPUX86_HAS_SSEUNIT,CPUX86_HAS_POPCNT],
+     { cpu_core_avx  } [CPUX86_HAS_SSEUNIT,CPUX86_HAS_POPCNT,CPUX86_HAS_AVXUNIT],
+     { cpu_core_avx2 } [CPUX86_HAS_SSEUNIT,CPUX86_HAS_POPCNT,CPUX86_HAS_AVXUNIT,CPUX86_HAS_BMI1,CPUX86_HAS_BMI2,CPUX86_HAS_LZCNT,CPUX86_HAS_MOVBE,CPUX86_HAS_FMA]
+   );
+
+
 Implementation
 
 end.

compiler/i386/cpunode.pas

@@ -51,10 +51,16 @@ unit cpunode;
 
        n386add,
        n386cal,
+       n386ld,
        n386mem,
        n386set,
        n386inl,
-       n386mat
+{$ifdef TEST_WIN32_SEH}
+       n386flw,
+{$endif TEST_WIN32_SEH}
+       n386mat,
+       { symtable }
+       symcpu
        ;
 
 end.

compiler/i386/cpupara.pas

@@ -40,12 +40,6 @@ unit cpupara;
           function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override;
-          { Returns the location for the nr-st 32 Bit int parameter
-            if every parameter before is an 32 Bit int parameter as well
-            and if the calling conventions for the helper routines of the
-            rtl are used.
-          }
-          procedure getintparaloc(pd : tabstractprocdef; nr : longint; 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;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override;
@@ -249,6 +243,7 @@ unit cpupara;
           pocall_safecall,
           pocall_stdcall,
           pocall_cdecl,
+          pocall_syscall,
           pocall_cppdecl,
           pocall_mwpascal :
             result:=[RS_EAX,RS_EDX,RS_ECX];
@@ -274,51 +269,6 @@ unit cpupara;
       end;
 
 
-    procedure ti386paramanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
-      var
-        paraloc : pcgparalocation;
-        psym: tparavarsym;
-        pdef: tdef;
-      begin
-        psym:=tparavarsym(pd.paras[nr-1]);
-        pdef:=psym.vardef;
-        if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
-          pdef:=getpointerdef(pdef);
-        cgpara.reset;
-        cgpara.size:=def_cgsize(pdef);
-        cgpara.intsize:=tcgsize2size[cgpara.size];
-        cgpara.alignment:=get_para_align(pd.proccalloption);
-        cgpara.def:=pdef;
-        paraloc:=cgpara.add_location;
-        with paraloc^ do
-         begin
-           size:=def_cgsize(pdef);
-           def:=pdef;
-           if pd.proccalloption=pocall_register then
-             begin
-               if (nr<=length(parasupregs)) then
-                 begin
-                   if nr=0 then
-                     internalerror(200309271);
-                   loc:=LOC_REGISTER;
-                   register:=newreg(R_INTREGISTER,parasupregs[nr-1],R_SUBWHOLE);
-                 end
-               else
-                 begin
-                   loc:=LOC_REFERENCE;
-                   reference.index:=NR_STACK_POINTER_REG;
-                   { the previous parameters didn't take up room in memory }
-                   reference.offset:=sizeof(aint)*(nr-length(parasupregs)-1)
-                 end;
-             end
-           else
-             begin
-               loc:=LOC_REFERENCE;
-               reference.index:=NR_STACK_POINTER_REG;
-               reference.offset:=sizeof(aint)*nr;
-             end;
-          end;
-      end;
 
 
     function  ti386paramanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;

compiler/i386/cputarg.pas

@@ -86,6 +86,9 @@ implementation
     {$ifndef NOTARGETEMBEDDED}
       ,t_embed
     {$endif}
+    {$ifndef NOTARGETAROS}
+      ,t_aros
+    {$endif}
 
 {**************************************
              Assemblers

compiler/i386/csopt386.pas

@@ -353,6 +353,7 @@ var
 
   function getNextRegToTest(var prev: tai; currentReg: tsuperregister): tsuperregister;
   begin
+    getNextRegToTest := RS_INVALID;
     if not checkingPrevSequences then
       begin
         if (currentreg = RS_INVALID) then
@@ -423,9 +424,13 @@ begin {CheckSequence}
   TmpResult := False;
   FillChar(OrgRegInfo, Sizeof(OrgRegInfo), 0);
   FillChar(startRegInfo, sizeof(startRegInfo), 0);
+  FillChar(HighRegInfo, sizeof(HighRegInfo), 0);
+  FillChar(prevreginfo, sizeof(prevreginfo), 0);
   OrgRegFound := 0;
   HighFound := 0;
   OrgRegResult := False;
+  highPrev := nil;
+  orgPrev := nil;
   with startRegInfo do
     begin
       newRegsEncountered := [RS_EBP, RS_ESP];
@@ -1074,6 +1079,7 @@ var
   prev: tai;
   newOrgRegRState, newOrgRegWState: byte;
 begin
+  newOrgRegwState := 0;
   if getLastInstruction(hp,prev) then
     with ptaiprop(prev.optinfo)^ do
       begin
@@ -1429,6 +1435,7 @@ var
 
 begin
   replacereg := false;
+  readStateChanged := false;
   if canreplacereg(orgsupreg,newsupreg,p,orgregcanbemodified,newregmodified, orgregread, removelast,endp) then
     begin
 {$ifdef replaceregdebug}
@@ -1595,12 +1602,12 @@ var
   regcounter: tsuperregister;
   optimizable: boolean;
 begin
+  memtoreg := NR_NO;
+
   if not getlastinstruction(t,hp) or
      not issimplememloc(ref) then
-    begin
-      memtoreg := NR_NO;
-      exit;
-    end;
+    exit;
+
   p := ptaiprop(hp.optinfo);
   optimizable := false;
   for regcounter := RS_EAX to RS_EDI do
@@ -1832,15 +1839,18 @@ procedure doCSE(asml: TAsmList; First, Last: tai; findPrevSeqs, doSubOpts: boole
  removed immediately because sometimes an instruction needs to be checked in
  two different sequences}
 var cnt, cnt2, {cnt3,} orgNrofMods: longint;
-    p, hp1, hp2, prevSeq: tai;
-    hp4: tai;
-    hp5 : tai;
+    p, hp1, hp2, hp4, hp5, prevSeq: tai;
     reginfo: toptreginfo;
     memreg: tregister;
     regcounter: tsuperregister;
 begin
   p := First;
   SkipHead(p);
+  hp1 := nil;
+  hp2 := nil;
+  hp4 := nil;
+  hp5 := nil;
+  cnt := 0;
   while (p <> Last) do
     begin
       case p.typ of

compiler/i386/daopt386.pas

@@ -901,6 +901,7 @@ var
   Cnt: Word;
 begin
   TmpResult := False;
+  Result := False;
   if supreg = RS_INVALID then
     exit;
   if (p1.typ = ait_instruction) then

compiler/i386/hlcgcpu.pas

@@ -78,10 +78,10 @@ implementation
                      (cgpara.location^.reference.index=NR_STACK_POINTER_REG) then
                     begin
                       cg.g_stackpointer_alloc(list,stacksize);
-                      reference_reset_base(href,NR_STACK_POINTER_REG,0,sizeof(pint));
+                      reference_reset_base(href,voidstackpointertype,NR_STACK_POINTER_REG,0,voidstackpointertype.size);
                     end
                   else
-                    reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
+                    reference_reset_base(href,voidstackpointertype,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
                   cg.a_loadfpu_reg_ref(list,locsize,locsize,l.register,href);
                 end;
               LOC_FPUREGISTER:
@@ -123,10 +123,10 @@ implementation
                      (cgpara.location^.reference.index=NR_STACK_POINTER_REG) then
                     begin
                       cg.g_stackpointer_alloc(list,stacksize);
-                      reference_reset_base(href,NR_STACK_POINTER_REG,0,sizeof(pint));
+                      reference_reset_base(href,voidstackpointertype,NR_STACK_POINTER_REG,0,voidstackpointertype.size);
                     end
                   else
-                    reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
+                    reference_reset_base(href,voidstackpointertype,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
                   cg.a_loadmm_reg_ref(list,locsize,locsize,l.register,href,mms_movescalar);
                 end;
               LOC_FPUREGISTER:
@@ -152,7 +152,7 @@ implementation
                     cg.a_load_ref_cgpara(list,locsize,l.reference,cgpara)
                   else
                     begin
-                      reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
+                      reference_reset_base(href,voidstackpointertype,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
                       cg.g_concatcopy(list,l.reference,href,stacksize);
                     end;
                 end;

compiler/i386/i386att.inc

@@ -161,10 +161,8 @@
 'iret',
 'iret',
 'iretw',
-'iretq',
 'jcxz',
 'jecxz',
-'jrcxz',
 'jmp',
 'lahf',
 'lar',
@@ -200,7 +198,6 @@
 'movq',
 'movsb',
 'movsl',
-'movsq',
 'movsw',
 'movs',
 'movz',
@@ -272,7 +269,6 @@
 'popf',
 'popfl',
 'popfw',
-'popfq',
 'por',
 'prefetch',
 'prefetchw',
@@ -306,7 +302,6 @@
 'pushf',
 'pushfl',
 'pushfw',
-'pushfq',
 'pxor',
 'rcl',
 'rcr',
@@ -334,7 +329,6 @@
 'sbb',
 'scasb',
 'scasl',
-'scasq',
 'scasw',
 'cs',
 'ds',
@@ -596,10 +590,6 @@
 'xsha256',
 'dmint',
 'rdm',
-'movabs',
-'movslq',
-'cqto',
-'cmpxchg16b',
 'movntss',
 'movntsd',
 'insertq',
@@ -637,11 +627,9 @@
 'pcmpeqq',
 'pextrb',
 'pextrd',
-'pextrq',
 'phminposuw',
 'pinsrb',
 'pinsrd',
-'pinsrq',
 'pmaxsb',
 'pmaxsd',
 'pmaxud',
@@ -682,9 +670,6 @@
 'aesdeclast',
 'aesimc',
 'aeskeygenassist',
-'stosq',
-'lodsq',
-'cmpsq',
 'vaddpd',
 'vaddps',
 'vaddsd',
@@ -946,8 +931,90 @@
 'vzeroupper',
 'andn',
 'bextr',
+'tzcnt',
 'rorx',
 'sarx',
 'shlx',
-'shrx'
+'shrx',
+'vbroadcasti128',
+'vextracti128',
+'vinserti128',
+'vpblendd',
+'vpbroadcastb',
+'vpbroadcastd',
+'vpbroadcastq',
+'vpbroadcastw',
+'vperm2i128',
+'vpermd',
+'vpermpd',
+'vpermps',
+'vpermq',
+'vpmaskmovd',
+'vpmaskmovq',
+'vpsllvd',
+'vpsllvq',
+'vpsravd',
+'vpsrlvd',
+'vpsrlvq',
+'vfmadd132pd',
+'vfmadd213pd',
+'vfmadd231pd',
+'vfmaddpd',
+'vfmadd132ps',
+'vfmadd213ps',
+'vfmadd231ps',
+'vfmadd132sd',
+'vfmadd213sd',
+'vfmadd231sd',
+'vfmadd132ss',
+'vfmadd213ss',
+'vfmadd231ss',
+'vfmaddsub132pd',
+'vfmaddsub213pd',
+'vfmaddsub231pd',
+'vfmaddsub132ps',
+'vfmaddsub213ps',
+'vfmaddsub231ps',
+'vfmsubadd132pd',
+'vfmsubadd213pd',
+'vfmsubadd231pd',
+'vfmsubadd132ps',
+'vfmsubadd213ps',
+'vfmsubadd231ps',
+'vfmsub132pd',
+'vfmsub213pd',
+'vfmsub231pd',
+'vfmsub132ps',
+'vfmsub213ps',
+'vfmsub231ps',
+'vfmsub132sd',
+'vfmsub213sd',
+'vfmsub231sd',
+'vfmsub132ss',
+'vfmsub213ss',
+'vfmsub231ss',
+'vfnmadd132pd',
+'vfnmadd213pd',
+'vfnmadd231pd',
+'vfnmadd132ps',
+'vfnmadd213ps',
+'vfnmadd231ps',
+'vfnmadd132sd',
+'vfnmadd213sd',
+'vfnmadd231sd',
+'vfnmadd132ss',
+'vfnmadd213ss',
+'vfnmadd231ss',
+'vfnmsub132pd',
+'vfnmsub213pd',
+'vfnmsub231pd',
+'vfnmsub132ps',
+'vfnmsub213ps',
+'vfnmsub231ps',
+'vfnmsub132sd',
+'vfnmsub213sd',
+'vfnmsub231sd',
+'vfnmsub132ss',
+'vfnmsub213ss',
+'vfnmsub231ss'
 );

compiler/i386/i386atts.inc

@@ -163,8 +163,6 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
-attsufNONE,
-attsufNONE,
 attsufINT,
 attsufNONE,
 attsufINT,
@@ -201,7 +199,6 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
-attsufNONE,
 attsufINTdual,
 attsufINTdual,
 attsufINT,
@@ -273,7 +270,6 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
-attsufNONE,
 attsufINT,
 attsufINT,
 attsufNONE,
@@ -307,7 +303,6 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
-attsufNONE,
 attsufINT,
 attsufINT,
 attsufNONE,
@@ -342,7 +337,6 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
-attsufNONE,
 attsufINT,
 attsufINT,
 attsufINT,
@@ -599,11 +593,76 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufNONE,
 attsufINT,
 attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufINT,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
 attsufINT,
 attsufNONE,
 attsufNONE,
@@ -642,6 +701,21 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufMM,
+attsufMM,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufMM,
+attsufMM,
+attsufNONE,
+attsufNONE,
+attsufMM,
+attsufNONE,
+attsufNONE,
+attsufNONE,
+attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
@@ -669,13 +743,11 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
-attsufINT,
 attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
-attsufINT,
 attsufNONE,
 attsufNONE,
 attsufNONE,
@@ -716,17 +788,12 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
-attsufMM,
-attsufMM,
 attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
-attsufMM,
-attsufMM,
 attsufNONE,
 attsufNONE,
-attsufMM,
 attsufNONE,
 attsufNONE,
 attsufNONE,

compiler/i386/i386int.inc

@@ -161,10 +161,8 @@
 'iret',
 'iretd',
 'iretw',
-'iretq',
 'jcxz',
 'jecxz',
-'jrcxz',
 'jmp',
 'lahf',
 'lar',
@@ -200,7 +198,6 @@
 'movq',
 'movsb',
 'movsd',
-'movsq',
 'movsw',
 'movsx',
 'movzx',
@@ -272,7 +269,6 @@
 'popf',
 'popfd',
 'popfw',
-'popfq',
 'por',
 'prefetch',
 'prefetchw',
@@ -306,7 +302,6 @@
 'pushf',
 'pushfd',
 'pushfw',
-'pushfq',
 'pxor',
 'rcl',
 'rcr',
@@ -334,7 +329,6 @@
 'sbb',
 'scasb',
 'scasd',
-'scasq',
 'scasw',
 'segcs',
 'segds',
@@ -596,10 +590,6 @@
 'xsha256',
 'dmint',
 'rdm',
-'movabs',
-'movsxd',
-'cqo',
-'cmpxchg16b',
 'movntss',
 'movntsd',
 'insertq',
@@ -637,11 +627,9 @@
 'pcmpeqq',
 'pextrb',
 'pextrd',
-'pextrq',
 'phminposuw',
 'pinsrb',
 'pinsrd',
-'pinsrq',
 'pmaxsb',
 'pmaxsd',
 'pmaxud',
@@ -682,9 +670,6 @@
 'aesdeclast',
 'aesimc',
 'aeskeygenassist',
-'stosq',
-'lodsq',
-'cmpsq',
 'vaddpd',
 'vaddps',
 'vaddsd',
@@ -946,8 +931,90 @@
 'vzeroupper',
 'andn',
 'bextr',
+'tzcnt',
 'rorx',
 'sarx',
 'shlx',
-'shrx'
+'shrx',
+'vbroadcasti128',
+'vextracti128',
+'vinserti128',
+'vpblendd',
+'vpbroadcastb',
+'vpbroadcastd',
+'vpbroadcastq',
+'vpbroadcastw',
+'vperm2i128',
+'vpermd',
+'vpermpd',
+'vpermps',
+'vpermq',
+'vpmaskmovd',
+'vpmaskmovq',
+'vpsllvd',
+'vpsllvq',
+'vpsravd',
+'vpsrlvd',
+'vpsrlvq',
+'vfmadd132pd',
+'vfmadd213pd',
+'vfmadd231pd',
+'vfmaddpd',
+'vfmadd132ps',
+'vfmadd213ps',
+'vfmadd231ps',
+'vfmadd132sd',
+'vfmadd213sd',
+'vfmadd231sd',
+'vfmadd132ss',
+'vfmadd213ss',
+'vfmadd231ss',
+'vfmaddsub132pd',
+'vfmaddsub213pd',
+'vfmaddsub231pd',
+'vfmaddsub132ps',
+'vfmaddsub213ps',
+'vfmaddsub231ps',
+'vfmsubadd132pd',
+'vfmsubadd213pd',
+'vfmsubadd231pd',
+'vfmsubadd132ps',
+'vfmsubadd213ps',
+'vfmsubadd231ps',
+'vfmsub132pd',
+'vfmsub213pd',
+'vfmsub231pd',
+'vfmsub132ps',
+'vfmsub213ps',
+'vfmsub231ps',
+'vfmsub132sd',
+'vfmsub213sd',
+'vfmsub231sd',
+'vfmsub132ss',
+'vfmsub213ss',
+'vfmsub231ss',
+'vfnmadd132pd',
+'vfnmadd213pd',
+'vfnmadd231pd',
+'vfnmadd132ps',
+'vfnmadd213ps',
+'vfnmadd231ps',
+'vfnmadd132sd',
+'vfnmadd213sd',
+'vfnmadd231sd',
+'vfnmadd132ss',
+'vfnmadd213ss',
+'vfnmadd231ss',
+'vfnmsub132pd',
+'vfnmsub213pd',
+'vfnmsub231pd',
+'vfnmsub132ps',
+'vfnmsub213ps',
+'vfnmsub231ps',
+'vfnmsub132sd',
+'vfnmsub213sd',
+'vfnmsub231sd',
+'vfnmsub132ss',
+'vfnmsub213ss',
+'vfnmsub231ss'
 );