* merged r12206 through r15734 from trunk and fixed some resulting

    compilation problems

git-svn-id: branches/llvm@15751 -

Makefile

@@ -1,10 +1,10 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/10/22]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2009/12/07]
 #
 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 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 sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd 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 powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
+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 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 sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris 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 powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
 BSDs = freebsd netbsd openbsd darwin
-UNIXs = linux $(BSDs) solaris qnx
+UNIXs = linux $(BSDs) solaris qnx haiku
 LIMIT83fs = go32v2 os2 emx watcom
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
@@ -59,9 +59,11 @@ endif
 endif
 ifdef COMSPEC
 ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),)
+ifndef RUNBATCH
 RUNBATCH=$(COMSPEC) /C
 endif
 endif
+endif
 ifdef inUnix
 PATHSEP=/
 else
@@ -263,7 +265,7 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
 endif
 PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
 override PACKAGE_NAME=fpc
-override PACKAGE_VERSION=2.3.1
+override PACKAGE_VERSION=2.5.1
 ifndef inOS2
 override FPCDIR:=$(BASEDIR)
 export FPCDIR
@@ -492,6 +494,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
+ifeq ($(FULL_TARGET),x86_64-solaris)
+override TARGET_DIRS+=compiler rtl utils packages ide installer
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
@@ -543,6 +548,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
+ifeq ($(FULL_TARGET),mipsel-linux)
+override TARGET_DIRS+=compiler rtl utils packages ide installer
+endif
 override INSTALL_FPCPACKAGE=y
 ifdef REQUIRE_UNITSDIR
 override UNITSDIR+=$(REQUIRE_UNITSDIR)
@@ -762,6 +770,7 @@ endif
 ifeq ($(OS_TARGET),go32v2)
 STATICLIBPREFIX=
 SHORTSUFFIX=dos
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),watcom)
 STATICLIBPREFIX=
@@ -769,6 +778,7 @@ OEXT=.obj
 ASMEXT=.asm
 SHAREDLIBEXT=.dll
 SHORTSUFFIX=wat
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),linux)
 BATCHEXT=.sh
@@ -805,6 +815,7 @@ STATICLIBPREFIX=
 SHAREDLIBEXT=.dll
 SHORTSUFFIX=os2
 ECHO=echo
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),emx)
 BATCHEXT=.cmd
@@ -813,6 +824,7 @@ STATICLIBPREFIX=
 SHAREDLIBEXT=.dll
 SHORTSUFFIX=emx
 ECHO=echo
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),amiga)
 EXEEXT=
@@ -852,17 +864,20 @@ ifeq ($(OS_TARGET),netware)
 EXEEXT=.nlm
 STATICLIBPREFIX=
 SHORTSUFFIX=nw
+IMPORTLIBPREFIX=imp
 endif
 ifeq ($(OS_TARGET),netwlibc)
 EXEEXT=.nlm
 STATICLIBPREFIX=
 SHORTSUFFIX=nwl
+IMPORTLIBPREFIX=imp
 endif
 ifeq ($(OS_TARGET),macos)
 BATCHEXT=
 EXEEXT=
 DEBUGSYMEXT=.xcoff
 SHORTSUFFIX=mac
+IMPORTLIBPREFIX=imp
 endif
 ifeq ($(OS_TARGET),darwin)
 BATCHEXT=.sh
@@ -889,14 +904,17 @@ STATICLIBEXT=.a1
 SHAREDLIBEXT=.so1
 STATICLIBPREFIX=
 SHORTSUFFIX=v1
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),go32v2)
 STATICLIBPREFIX=
 SHORTSUFFIX=dos
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),watcom)
 STATICLIBPREFIX=
 SHORTSUFFIX=wat
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),linux)
 BATCHEXT=.sh
@@ -943,6 +961,7 @@ STATICLIBEXT=.ao2
 SHAREDLIBEXT=.dll
 SHORTSUFFIX=os2
 ECHO=echo
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),amiga)
 EXEEXT=
@@ -1003,6 +1022,7 @@ STATICLIBEXT=.a
 SHAREDLIBEXT=.nlm
 EXEEXT=.nlm
 SHORTSUFFIX=nw
+IMPORTLIBPREFIX=imp
 endif
 ifeq ($(OS_TARGET),netwlibc)
 STATICLIBPREFIX=
@@ -1014,6 +1034,7 @@ STATICLIBEXT=.a
 SHAREDLIBEXT=.nlm
 EXEEXT=.nlm
 SHORTSUFFIX=nwl
+IMPORTLIBPREFIX=imp
 endif
 ifeq ($(OS_TARGET),macos)
 BATCHEXT=
@@ -1025,6 +1046,7 @@ STATICLIBEXT=.a
 EXEEXT=
 DEBUGSYMEXT=.xcoff
 SHORTSUFFIX=mac
+IMPORTLIBPREFIX=imp
 endif
 endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
@@ -2110,6 +2132,14 @@ TARGET_DIRS_PACKAGES=1
 TARGET_DIRS_IDE=1
 TARGET_DIRS_INSTALLER=1
 endif
+ifeq ($(FULL_TARGET),x86_64-solaris)
+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),x86_64-darwin)
 TARGET_DIRS_COMPILER=1
 TARGET_DIRS_RTL=1
@@ -2246,6 +2276,14 @@ TARGET_DIRS_PACKAGES=1
 TARGET_DIRS_IDE=1
 TARGET_DIRS_INSTALLER=1
 endif
+ifeq ($(FULL_TARGET),mipsel-linux)
+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
 ifdef TARGET_DIRS_COMPILER
 compiler_all:
 	$(MAKE) -C compiler all
@@ -2553,10 +2591,11 @@ help:
 compiler_cycle:
 	$(MAKE) -C compiler cycle
 BUILDSTAMP=build-stamp.$(FULL_TARGET)
-.PHONY: all clean distclean build install installbase installother zipinstallbase zipinstallotherzipinstall singlezipinstall
+.PHONY: all clean distclean build buildbase install installbase installother zipinstallbase zipinstallotherzipinstall singlezipinstall
 all: build
 clean: $(addsuffix _distclean,$(TARGET_DIRS))
 	-$(DEL) build-stamp.*
+	-$(DEL) base.build-stamp.*
 distclean: clean
 build: $(BUILDSTAMP)
 $(BUILDSTAMP):
@@ -2576,6 +2615,12 @@ ifdef IDE
 	$(MAKE) installer_all $(BUILDOPTS)
 endif
 	$(ECHOREDIR) Build > $(BUILDSTAMP)
+buildbase: base.$(BUILDSTAMP)
+base.$(BUILDSTAMP):
+	$(MAKE) compiler_cycle RELEASE=1
+	$(MAKE) rtl_clean $(CLEANOPTS)
+	$(MAKE) rtl_$(ALLTARGET) $(BUILDOPTS)
+	$(ECHOREDIR) Build > base.$(BUILDSTAMP)
 installbase:
 	$(MKDIR) $(INSTALL_BASEDIR)
 	$(MKDIR) $(INSTALL_BINDIR)

Makefile.fpc

@@ -4,7 +4,7 @@
 
 [package]
 name=fpc
-version=2.3.1
+version=2.5.1
 
 [target]
 dirs=compiler rtl utils packages ide installer
@@ -204,12 +204,13 @@ compiler_cycle:
 
 BUILDSTAMP=build-stamp.$(FULL_TARGET)
 
-.PHONY: all clean distclean build install installbase installother zipinstallbase zipinstallotherzipinstall singlezipinstall
+.PHONY: all clean distclean build buildbase install installbase installother zipinstallbase zipinstallotherzipinstall singlezipinstall
 
 all: build
 
 clean: $(addsuffix _distclean,$(TARGET_DIRS))
         -$(DEL) build-stamp.*
+        -$(DEL) base.build-stamp.*
 
 distclean: clean
 
@@ -235,6 +236,16 @@ ifdef IDE
 endif
         $(ECHOREDIR) Build > $(BUILDSTAMP)
 
+buildbase: base.$(BUILDSTAMP)
+base.$(BUILDSTAMP):
+# create new compiler
+        $(MAKE) compiler_cycle RELEASE=1
+# clean
+        $(MAKE) rtl_clean $(CLEANOPTS)
+# build everything
+        $(MAKE) rtl_$(ALLTARGET) $(BUILDOPTS)
+        $(ECHOREDIR) Build > base.$(BUILDSTAMP)
+
 installbase:
 # create dirs
         $(MKDIR) $(INSTALL_BASEDIR)

compiler/Makefile

@@ -1,10 +1,10 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/10/22]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2010/06/22]
 #
 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 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 sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd 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 powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
+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 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 sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris 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 powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
 BSDs = freebsd netbsd openbsd darwin
-UNIXs = linux $(BSDs) solaris qnx
+UNIXs = linux $(BSDs) solaris qnx haiku
 LIMIT83fs = go32v2 os2 emx watcom
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
@@ -59,9 +59,11 @@ endif
 endif
 ifdef COMSPEC
 ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),)
+ifndef RUNBATCH
 RUNBATCH=$(COMSPEC) /C
 endif
 endif
+endif
 ifdef inUnix
 PATHSEP=/
 else
@@ -263,9 +265,9 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
 endif
 PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
 override PACKAGE_NAME=compiler
-override PACKAGE_VERSION=2.2.2
+override PACKAGE_VERSION=2.5.1
 unexport FPC_VERSION FPC_COMPILERINFO
-CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64 m68k armeb
+CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64 m68k armeb mipsel mips
 ALLTARGETS=$(CYCLETARGETS)
 ifdef ALPHA
 PPC_TARGET=alpha
@@ -294,6 +296,12 @@ endif
 ifdef ARMEB
 PPC_TARGET=armeb
 endif
+ifdef MIPS
+PPC_TARGET=mips
+endif
+ifdef MIPSEL
+PPC_TARGET=mipsel
+endif
 ifndef PPC_TARGET
 PPC_TARGET=$(CPU_TARGET)
 endif
@@ -344,25 +352,28 @@ endif
 ifeq ($(CPC_TARGET),arm)
 CPUSUF=arm
 endif
-NOCPUDEF=1
-MSGFILE=msg/error$(FPCLANG).msg
-ifeq ($(OS_TARGET),linux)
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override LOCALOPT+=-dUNIX
-endif
-endif
-ifeq ($(OS_TARGET),freebsd)
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override LOCALOPT+=-dUNIX
+ifeq ($(CPC_TARGET),mips)
+CPUSUF=mips
 endif
+ifeq ($(CPC_TARGET),mipsel)
+CPUSUF=mipsel
 endif
+NOCPUDEF=1
+MSGFILE=msg/error$(FPCLANG).msg
+SVNVERSION:=$(wildcard $(addsuffix /svnversion$(SRCEXEEXT),$(SEARCHPATH)))
 REVINC:=$(wildcard revision.inc)
 ifneq ($(REVINC),)
 override LOCALOPT+=-dREVINC
 ifeq ($(REVSTR),)
-SVNVERSION:=$(wildcard svnversion$(EXEEXT))
-REVSTR:=$(shell svnversion .)
+ifneq ($(SVNVERSION),)
+REVSTR:=$(shell $(SVNVERSION) -c .)
 export REVSTR
+else
+ifeq ($(REVINC),force)
+REVSTR:=exported
+export REVSTR
+endif
+endif
 endif
 endif
 override LOCALOPT+=-d$(CPC_TARGET) -dGDB -dBROWSERLOG
@@ -392,6 +403,19 @@ endif
 ifeq ($(PPC_TARGET),arm)
 override LOCALOPT+=
 endif
+ifeq ($(PPC_TARGET),mipsel)
+override LOCALOPT+=-Fumips
+endif
+OPTWPOCOLLECT=-OWdevirtcalls,optvmts -FW$(BASEDIR)/pp1.wpo
+OPTWPOPERFORM=-Owdevirtcalls,optvmts -Fw$(BASEDIR)/pp1.wpo
+ifneq ($(findstring $(OS_TARGET),darwin linux freebsd solaris),)
+ifdef LINKSMART
+ifdef CREATESMART
+OPTWPOCOLLECT+=-OWsymbolliveness -Xs-
+OPTWPOPERFORM+=-Owsymbolliveness
+endif
+endif
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_DIRS+=utils
 endif
@@ -452,6 +476,9 @@ endif
 ifeq ($(FULL_TARGET),i386-symbian)
 override TARGET_DIRS+=utils
 endif
+ifeq ($(FULL_TARGET),i386-nativent)
+override TARGET_DIRS+=utils
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override TARGET_DIRS+=utils
 endif
@@ -515,6 +542,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override TARGET_DIRS+=utils
 endif
+ifeq ($(FULL_TARGET),x86_64-solaris)
+override TARGET_DIRS+=utils
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override TARGET_DIRS+=utils
 endif
@@ -566,6 +596,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override TARGET_DIRS+=utils
 endif
+ifeq ($(FULL_TARGET),mipsel-linux)
+override TARGET_DIRS+=utils
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_PROGRAMS+=pp
 endif
@@ -626,6 +659,9 @@ endif
 ifeq ($(FULL_TARGET),i386-symbian)
 override TARGET_PROGRAMS+=pp
 endif
+ifeq ($(FULL_TARGET),i386-nativent)
+override TARGET_PROGRAMS+=pp
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override TARGET_PROGRAMS+=pp
 endif
@@ -689,6 +725,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override TARGET_PROGRAMS+=pp
 endif
+ifeq ($(FULL_TARGET),x86_64-solaris)
+override TARGET_PROGRAMS+=pp
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override TARGET_PROGRAMS+=pp
 endif
@@ -740,6 +779,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override TARGET_PROGRAMS+=pp
 endif
+ifeq ($(FULL_TARGET),mipsel-linux)
+override TARGET_PROGRAMS+=pp
+endif
 override INSTALL_FPCPACKAGE=y
 ifeq ($(FULL_TARGET),i386-linux)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
@@ -801,6 +843,9 @@ endif
 ifeq ($(FULL_TARGET),i386-symbian)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
+ifeq ($(FULL_TARGET),i386-nativent)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
@@ -864,6 +909,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
+ifeq ($(FULL_TARGET),x86_64-solaris)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
@@ -915,6 +963,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
+ifeq ($(FULL_TARGET),mipsel-linux)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -975,6 +1026,9 @@ endif
 ifeq ($(FULL_TARGET),i386-symbian)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
+ifeq ($(FULL_TARGET),i386-nativent)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -1038,6 +1092,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
+ifeq ($(FULL_TARGET),x86_64-solaris)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -1089,6 +1146,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
+ifeq ($(FULL_TARGET),mipsel-linux)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override COMPILER_TARGETDIR+=.
 endif
@@ -1149,6 +1209,9 @@ endif
 ifeq ($(FULL_TARGET),i386-symbian)
 override COMPILER_TARGETDIR+=.
 endif
+ifeq ($(FULL_TARGET),i386-nativent)
+override COMPILER_TARGETDIR+=.
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override COMPILER_TARGETDIR+=.
 endif
@@ -1212,6 +1275,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override COMPILER_TARGETDIR+=.
 endif
+ifeq ($(FULL_TARGET),x86_64-solaris)
+override COMPILER_TARGETDIR+=.
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override COMPILER_TARGETDIR+=.
 endif
@@ -1263,6 +1329,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_TARGETDIR+=.
 endif
+ifeq ($(FULL_TARGET),mipsel-linux)
+override COMPILER_TARGETDIR+=.
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -1323,6 +1392,9 @@ endif
 ifeq ($(FULL_TARGET),i386-symbian)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),i386-nativent)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -1386,6 +1458,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),x86_64-solaris)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -1437,6 +1512,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),mipsel-linux)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
 ifdef REQUIRE_UNITSDIR
 override UNITSDIR+=$(REQUIRE_UNITSDIR)
 endif
@@ -1655,6 +1733,7 @@ endif
 ifeq ($(OS_TARGET),go32v2)
 STATICLIBPREFIX=
 SHORTSUFFIX=dos
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),watcom)
 STATICLIBPREFIX=
@@ -1662,6 +1741,7 @@ OEXT=.obj
 ASMEXT=.asm
 SHAREDLIBEXT=.dll
 SHORTSUFFIX=wat
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),linux)
 BATCHEXT=.sh
@@ -1698,6 +1778,7 @@ STATICLIBPREFIX=
 SHAREDLIBEXT=.dll
 SHORTSUFFIX=os2
 ECHO=echo
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),emx)
 BATCHEXT=.cmd
@@ -1706,6 +1787,7 @@ STATICLIBPREFIX=
 SHAREDLIBEXT=.dll
 SHORTSUFFIX=emx
 ECHO=echo
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),amiga)
 EXEEXT=
@@ -1745,17 +1827,20 @@ ifeq ($(OS_TARGET),netware)
 EXEEXT=.nlm
 STATICLIBPREFIX=
 SHORTSUFFIX=nw
+IMPORTLIBPREFIX=imp
 endif
 ifeq ($(OS_TARGET),netwlibc)
 EXEEXT=.nlm
 STATICLIBPREFIX=
 SHORTSUFFIX=nwl
+IMPORTLIBPREFIX=imp
 endif
 ifeq ($(OS_TARGET),macos)
 BATCHEXT=
 EXEEXT=
 DEBUGSYMEXT=.xcoff
 SHORTSUFFIX=mac
+IMPORTLIBPREFIX=imp
 endif
 ifeq ($(OS_TARGET),darwin)
 BATCHEXT=.sh
@@ -1772,6 +1857,10 @@ ifeq ($(OS_TARGET),symbian)
 SHAREDLIBEXT=.dll
 SHORTSUFFIX=symbian
 endif
+ifeq ($(OS_TARGET),NativeNT)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=nativent
+endif
 else
 ifeq ($(OS_TARGET),go32v1)
 PPUEXT=.pp1
@@ -1782,14 +1871,17 @@ STATICLIBEXT=.a1
 SHAREDLIBEXT=.so1
 STATICLIBPREFIX=
 SHORTSUFFIX=v1
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),go32v2)
 STATICLIBPREFIX=
 SHORTSUFFIX=dos
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),watcom)
 STATICLIBPREFIX=
 SHORTSUFFIX=wat
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),linux)
 BATCHEXT=.sh
@@ -1836,6 +1928,7 @@ STATICLIBEXT=.ao2
 SHAREDLIBEXT=.dll
 SHORTSUFFIX=os2
 ECHO=echo
+IMPORTLIBPREFIX=
 endif
 ifeq ($(OS_TARGET),amiga)
 EXEEXT=
@@ -1896,6 +1989,7 @@ STATICLIBEXT=.a
 SHAREDLIBEXT=.nlm
 EXEEXT=.nlm
 SHORTSUFFIX=nw
+IMPORTLIBPREFIX=imp
 endif
 ifeq ($(OS_TARGET),netwlibc)
 STATICLIBPREFIX=
@@ -1907,6 +2001,7 @@ STATICLIBEXT=.a
 SHAREDLIBEXT=.nlm
 EXEEXT=.nlm
 SHORTSUFFIX=nwl
+IMPORTLIBPREFIX=imp
 endif
 ifeq ($(OS_TARGET),macos)
 BATCHEXT=
@@ -1918,6 +2013,7 @@ STATICLIBEXT=.a
 EXEEXT=
 DEBUGSYMEXT=.xcoff
 SHORTSUFFIX=mac
+IMPORTLIBPREFIX=imp
 endif
 endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
@@ -2250,6 +2346,9 @@ endif
 ifeq ($(FULL_TARGET),i386-symbian)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),i386-nativent)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -2313,6 +2412,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),x86_64-solaris)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -2364,6 +2466,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),mipsel-linux)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifdef REQUIRE_PACKAGES_RTL
 PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
 ifneq ($(PACKAGEDIR_RTL),)
@@ -2373,9 +2478,9 @@ else
 UNITDIR_RTL=$(PACKAGEDIR_RTL)
 endif
 ifdef CHECKDEPEND
-$(PACKAGEDIR_RTL)/$(FPCMADE):
-	$(MAKE) -C $(PACKAGEDIR_RTL) $(FPCMADE)
-override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(FPCMADE)
+$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_RTL)/$(OS_TARGET) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE)
 endif
 else
 PACKAGEDIR_RTL=
@@ -2753,7 +2858,7 @@ ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR))
 ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))
 ifdef USETAR
 ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(TAREXT)
-ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) *
+ZIPCMD_ZIP:=$(TARPROG) c$(TAROPT)f $(ZIPDESTFILE) *
 else
 ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(ZIPEXT)
 ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
@@ -2798,6 +2903,9 @@ fpc_zipdistinstall:
 ifdef EXEFILES
 override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
 endif
+ifdef CLEAN_PROGRAMS
+override CLEANEXEFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEEXT), $(CLEAN_PROGRAMS)))
+endif
 ifdef CLEAN_UNITS
 override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
 endif
@@ -2844,6 +2952,9 @@ endif
 ifdef CLEANRSTFILES
 	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
 endif
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
@@ -3027,6 +3138,9 @@ endif
 ifeq ($(FULL_TARGET),i386-symbian)
 TARGET_DIRS_UTILS=1
 endif
+ifeq ($(FULL_TARGET),i386-nativent)
+TARGET_DIRS_UTILS=1
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 TARGET_DIRS_UTILS=1
 endif
@@ -3090,6 +3204,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 TARGET_DIRS_UTILS=1
 endif
+ifeq ($(FULL_TARGET),x86_64-solaris)
+TARGET_DIRS_UTILS=1
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 TARGET_DIRS_UTILS=1
 endif
@@ -3141,6 +3258,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 TARGET_DIRS_UTILS=1
 endif
+ifeq ($(FULL_TARGET),mipsel-linux)
+TARGET_DIRS_UTILS=1
+endif
 ifdef TARGET_DIRS_UTILS
 utils_all:
 	$(MAKE) -C utils all
@@ -3230,9 +3350,6 @@ override DIFF:=$(CMP) -i218
 endif
 endif
 override COMPILER+=$(LOCALOPT)
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override COMPILER:=$(patsubst -O%,,$(COMPILER))
-endif
 PASDOC:=$(strip $(wildcard $(addsuffix /pasdoc.exe,$(SEARCHPATH))))
 ifeq ($(PASDOC),)
 PASDOC:=$(strip $(wildcard $(addsuffix /pasdoc,$(SEARCHPATH))))
@@ -3251,6 +3368,8 @@ PPCROSSNAME=ppcross$(CPUSUF)$(SRCEXEEXT)
 TEMPNAME1=ppc1$(EXEEXT)
 TEMPNAME2=ppc2$(EXEEXT)
 TEMPNAME3=ppc3$(EXEEXT)
+TEMPWPONAME1=ppcwpo1$(EXEEXT)
+TEMPWPONAME2=ppcwpo2$(EXEEXT)
 MAKEDEP=ppdep$(EXEEXT)
 MSG2INC=./msg2inc$(EXEEXT)
 ifdef CROSSINSTALL
@@ -3258,7 +3377,7 @@ INSTALLEXEFILE=$(PPCROSSNAME)
 else
 INSTALLEXEFILE=$(EXENAME)
 endif
-PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64
+PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64 mips mipsel
 .PHONY: $(PPC_TARGETS)
 $(PPC_TARGETS):
 	$(MAKE) PPC_TARGET=$@ CPU_UNITDIR=$@ all
@@ -3288,9 +3407,9 @@ ppuclean:
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 	-$(DEL) $(addsuffix /*$(PPUEXT),$(COMPILERSOURCEDIR))
 tempclean:
-	-$(DEL) $(PPCROSSNAME) $(TEMPNAME) $(TEMPNAME1) $(TEMPNAME2) $(TEMPNAME3) $(MSG2INC)
+	-$(DEL) $(PPCROSSNAME) $(TEMPNAME) $(TEMPNAME1) $(TEMPNAME2) $(TEMPNAME3) $(MSG2INC) pp1.wpo pp2.wpo
 execlean :
-	-$(DEL) ppc386$(EXEEXT) ppcaxp$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) $(EXENAME)
+	-$(DEL) ppc386$(EXEEXT) ppcaxp$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2)
 $(addsuffix _clean,$(ALLTARGETS)):
 	-$(DELTREE) $(addprefix $(subst _clean,,$@),/units)
 	-$(DEL) $(addprefix $(subst _clean,,$@)/,*$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT))
@@ -3307,23 +3426,71 @@ msgtxt.inc: $(MSGFILE)
 msg: msgtxt.inc
 insdatx86 : $(COMPILER_UNITTARGETDIR) x86/x86ins.dat
 	$(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkx86ins.pp
-	cd x86; ../utils/mkx86ins; mv -f *.inc ../i386
-	cd x86;../utils/mkx86ins x86_64; mv -f *.inc ../x86_64
+	cd x86 && ../utils/mkx86ins$(SRCEXEEXT) && mv -f *.inc ../i386
+	cd x86 && ../utils/mkx86ins$(SRCEXEEXT) x86_64 && mv -f *.inc ../x86_64
 insdatarm : arm/armins.dat
-	$(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkarmins.pp
-	cd arm; ../utils/mkarmins
+	    $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkarmins.pp
+	cd arm && ../utils/mkarmins$(SRCEXEEXT)
 insdat: insdatx86 insdatarm
+regdatarm : arm/armreg.dat
+	    $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkarmreg.pp
+	cd arm && ../utils/mkarmreg$(SRCEXEEXT)
+revision.inc :
+ifneq ($(REVSTR),)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
+	$(ECHOREDIR) "'$(REVSTR)'" > revision.inc
+else
+	$(ECHOREDIR) '$(REVSTR)' > revision.inc
+endif
+else
+	$(ECHOREDIR) "'$(REVSTR)'" > revision.inc
+endif
+else
+	$(MAKE) revision.inc REVINC=force
+endif
+.PHONY : revision
+revision :
+	$(DEL) revision.inc
+	$(MAKE) revision.inc
 $(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg \
 	     $(wildcard systems/*.pas) $(wilcard systems/*.inc) \
 	     $(wildcard $(CPC_TARGET)/*.pas) $(wildcard $(CPC_TARGET)/*.inc)
 ifneq ($(REVSTR),)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
+	$(ECHOREDIR) "'$(REVSTR)'" > revision.inc
+else
+	$(ECHOREDIR) '$(REVSTR)' > revision.inc
+endif
+else
 	$(ECHOREDIR) "'$(REVSTR)'" > revision.inc
+endif
+	$(COMPILER) version.pas
 endif
 	$(COMPILER) pp.pas
 	$(EXECPPAS)
 	$(MOVE) $(COMPILER_TARGETDIR)/$(PPEXENAME) $(EXENAME)
 ifeq ($(CPU_SOURCE),$(PPC_TARGET))
 ifeq ($(OS_SOURCE),$(OS_TARGET))
+ifndef NOWPOCYCLE
+ifdef RELEASE
+DOWPOCYCLE=1
+wpocycle:
+	$(RM) $(EXENAME)
+	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(LOCALOPT) $(OPTWPOCOLLECT)' 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
+	$(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
+	$(COPY) $(EXENAME) $(TEMPWPONAME2)
+endif
+endif
+ifndef DOWPOCYCLE
+wpocycle:
+endif
 ifdef DIFF
 ifdef OLDFPC
 ifneq ($(OS_TARGET),darwin)
@@ -3364,6 +3531,7 @@ cycle:
 	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME2)' next
 	$(DIFF) $(TEMPNAME3) $(EXENAME)
 	$(MAKE) $(addsuffix _all,$(TARGET_DIRS)) 'FPC=$(BASEDIR)/$(EXENAME)'
+	$(MAKE) wpocycle
 	$(MAKE) echotime
 else
 cycle:
@@ -3373,9 +3541,11 @@ cycle:
 	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
 ifndef CROSSINSTALL
 	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' rtlclean rtl
+ifneq ($(OS_TARGET),embedded)
 	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' cycleclean compiler
 endif
 endif
+endif
 else
 cycle:
 override FPC=
@@ -3385,9 +3555,11 @@ override FPC=
 	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) PPC_TARGET=$(CPU_TARGET) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
 ifndef CROSSINSTALL
 	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(OPT) $(CROSSOPT)' rtlclean rtl
+ifneq ($(OS_TARGET),embedded)
 	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(OPT) $(CROSSOPT)' cycleclean compiler
 endif
 endif
+endif
 cycledep:
 	$(MAKE) cycle USEDEPEND=1
 extcycle:

compiler/Makefile.fpc

@@ -4,7 +4,7 @@
 
 [package]
 name=compiler
-version=2.2.2
+version=2.5.1
 
 [target]
 programs=pp
@@ -32,7 +32,7 @@ fpcdir=..
 unexport FPC_VERSION FPC_COMPILERINFO
 
 # Which platforms are ready for inclusion in the cycle
-CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64 m68k armeb
+CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64 m68k armeb mipsel mips
 
 # All supported targets used for clean
 ALLTARGETS=$(CYCLETARGETS)
@@ -65,6 +65,12 @@ endif
 ifdef ARMEB
 PPC_TARGET=armeb
 endif
+ifdef MIPS
+PPC_TARGET=mips
+endif
+ifdef MIPSEL
+PPC_TARGET=mipsel
+endif
 
 # Default is to generate a compiler for the same
 # platform as CPU_TARGET (a native compiler)
@@ -142,6 +148,12 @@ endif
 ifeq ($(CPC_TARGET),arm)
 CPUSUF=arm
 endif
+ifeq ($(CPC_TARGET),mips)
+CPUSUF=mips
+endif
+ifeq ($(CPC_TARGET),mipsel)
+CPUSUF=mipsel
+endif
 
 # Do not define the default -d$(CPU_TARGET) because that
 # will conflict with our -d$(CPC_TARGET)
@@ -150,26 +162,26 @@ NOCPUDEF=1
 # Default message file
 MSGFILE=msg/error$(FPCLANG).msg
 
-# Define Unix also for Linux
-ifeq ($(OS_TARGET),linux)
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override LOCALOPT+=-dUNIX
-endif
-endif
-
-ifeq ($(OS_TARGET),freebsd)
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override LOCALOPT+=-dUNIX
-endif
-endif
 
+SVNVERSION:=$(wildcard $(addsuffix /svnversion$(SRCEXEEXT),$(SEARCHPATH)))
+# Check if revision.inc is present
 REVINC:=$(wildcard revision.inc)
 ifneq ($(REVINC),)
+# File revision.inc is present
+#Use it to compile version.pas unit
 override LOCALOPT+=-dREVINC
+# Automatically update revision.inc if
+# svnversion executable is available
 ifeq ($(REVSTR),)
-SVNVERSION:=$(wildcard svnversion$(EXEEXT))
-REVSTR:=$(shell svnversion .)
+ifneq ($(SVNVERSION),)
+REVSTR:=$(shell $(SVNVERSION) -c .)
 export REVSTR
+else
+ifeq ($(REVINC),force)
+REVSTR:=exported
+export REVSTR
+endif
+endif
 endif
 endif
 
@@ -218,6 +230,26 @@ ifeq ($(PPC_TARGET),arm)
 override LOCALOPT+=
 endif
 
+# mipsel specific
+ifeq ($(PPC_TARGET),mipsel)
+override LOCALOPT+=-Fumips
+endif
+
+
+OPTWPOCOLLECT=-OWdevirtcalls,optvmts -FW$(BASEDIR)/pp1.wpo
+OPTWPOPERFORM=-Owdevirtcalls,optvmts -Fw$(BASEDIR)/pp1.wpo
+# symbol liveness WPO requires nm, smart linking and no stripping (the latter
+# is forced by the Makefile when necessary)
+ifneq ($(findstring $(OS_TARGET),darwin linux freebsd solaris),)
+ifdef LINKSMART
+ifdef CREATESMART
+OPTWPOCOLLECT+=-OWsymbolliveness -Xs-
+OPTWPOPERFORM+=-Owsymbolliveness
+endif
+endif
+endif
+
+
 [rules]
 #####################################################################
 # Setup Targets
@@ -232,11 +264,6 @@ endif
 # Add Local options
 override COMPILER+=$(LOCALOPT)
 
-# Disable optimizer when compiled with 1.0.x
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override COMPILER:=$(patsubst -O%,,$(COMPILER))
-endif
-
 
 #####################################################################
 # PASDoc
@@ -266,6 +293,8 @@ PPCROSSNAME=ppcross$(CPUSUF)$(SRCEXEEXT)
 TEMPNAME1=ppc1$(EXEEXT)
 TEMPNAME2=ppc2$(EXEEXT)
 TEMPNAME3=ppc3$(EXEEXT)
+TEMPWPONAME1=ppcwpo1$(EXEEXT)
+TEMPWPONAME2=ppcwpo2$(EXEEXT)
 MAKEDEP=ppdep$(EXEEXT)
 MSG2INC=./msg2inc$(EXEEXT)
 ifdef CROSSINSTALL
@@ -278,7 +307,7 @@ endif
 # CPU targets
 #####################################################################
 
-PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64
+PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64 mips mipsel
 
 .PHONY: $(PPC_TARGETS)
 
@@ -326,10 +355,10 @@ ppuclean:
         -$(DEL) $(addsuffix /*$(PPUEXT),$(COMPILERSOURCEDIR))
 
 tempclean:
-        -$(DEL) $(PPCROSSNAME) $(TEMPNAME) $(TEMPNAME1) $(TEMPNAME2) $(TEMPNAME3) $(MSG2INC)
+        -$(DEL) $(PPCROSSNAME) $(TEMPNAME) $(TEMPNAME1) $(TEMPNAME2) $(TEMPNAME3) $(MSG2INC) pp1.wpo pp2.wpo
 
 execlean :
-        -$(DEL) ppc386$(EXEEXT) ppcaxp$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) $(EXENAME)
+        -$(DEL) ppc386$(EXEEXT) ppcaxp$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2)
 
 $(addsuffix _clean,$(ALLTARGETS)):
         -$(DELTREE) $(addprefix $(subst _clean,,$@),/units)
@@ -361,21 +390,57 @@ msg: msgtxt.inc
 
 insdatx86 : $(COMPILER_UNITTARGETDIR) x86/x86ins.dat
 	$(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkx86ins.pp
-        cd x86; ../utils/mkx86ins; mv -f *.inc ../i386
-        cd x86;../utils/mkx86ins x86_64; mv -f *.inc ../x86_64
+        cd x86 && ../utils/mkx86ins$(SRCEXEEXT) && mv -f *.inc ../i386
+        cd x86 && ../utils/mkx86ins$(SRCEXEEXT) x86_64 && mv -f *.inc ../x86_64
 
 insdatarm : arm/armins.dat
-	$(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkarmins.pp
-        cd arm; ../utils/mkarmins
+	    $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkarmins.pp
+        cd arm && ../utils/mkarmins$(SRCEXEEXT)
 
 insdat: insdatx86 insdatarm
 
+regdatarm : arm/armreg.dat
+	    $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkarmreg.pp
+        cd arm && ../utils/mkarmreg$(SRCEXEEXT)
+
+# revision.inc rule
+revision.inc :
+ifneq ($(REVSTR),)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
+        $(ECHOREDIR) "'$(REVSTR)'" > revision.inc
+else
+        $(ECHOREDIR) '$(REVSTR)' > revision.inc
+endif
+else
+        $(ECHOREDIR) "'$(REVSTR)'" > revision.inc
+endif
+else
+	$(MAKE) revision.inc REVINC=force
+endif
+
+.PHONY : revision
+
+revision :
+	$(DEL) revision.inc
+	$(MAKE) revision.inc
+
 # Make only the compiler
+# ECHOREDIR sometimes does not remove double quotes
 $(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg \
              $(wildcard systems/*.pas) $(wilcard systems/*.inc) \
              $(wildcard $(CPC_TARGET)/*.pas) $(wildcard $(CPC_TARGET)/*.inc)
 ifneq ($(REVSTR),)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
         $(ECHOREDIR) "'$(REVSTR)'" > revision.inc
+else
+        $(ECHOREDIR) '$(REVSTR)' > revision.inc
+endif
+else
+        $(ECHOREDIR) "'$(REVSTR)'" > revision.inc
+endif
+        $(COMPILER) version.pas
 endif
         $(COMPILER) pp.pas
         $(EXECPPAS)
@@ -407,6 +472,28 @@ ifeq ($(OS_SOURCE),$(OS_TARGET))
 # Normal cycle
 #
 
+ifndef NOWPOCYCLE
+ifdef RELEASE
+DOWPOCYCLE=1
+# Two WPO cycles in case of RELEASE=1
+wpocycle:
+# don't use cycle_clean, it will delete the compiler utilities again
+        $(RM) $(EXENAME)
+        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(LOCALOPT) $(OPTWPOCOLLECT)' 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
+        $(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
+        $(COPY) $(EXENAME) $(TEMPWPONAME2)
+endif
+endif
+
+ifndef DOWPOCYCLE
+wpocycle:
+endif
+
 # Used to avoid unnecessary steps
 ifdef DIFF
 ifdef OLDFPC
@@ -453,6 +540,7 @@ cycle:
         $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME2)' next
         $(DIFF) $(TEMPNAME3) $(EXENAME)
         $(MAKE) $(addsuffix _all,$(TARGET_DIRS)) 'FPC=$(BASEDIR)/$(EXENAME)'
+        $(MAKE) wpocycle
         $(MAKE) echotime
 
 else
@@ -471,8 +559,11 @@ cycle:
 # ppc<ARCH> (target native)
 ifndef CROSSINSTALL
         $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' rtlclean rtl
+# building a native compiler for embedded targets is not possible
+ifneq ($(OS_TARGET),embedded)
         $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' cycleclean compiler
 endif
+endif
 
 endif
 
@@ -498,8 +589,11 @@ override FPC=
 # ppc<ARCH> (target native)
 ifndef CROSSINSTALL
         $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(OPT) $(CROSSOPT)' rtlclean rtl
+# building a native compiler for embedded targets is not possible
+ifneq ($(OS_TARGET),embedded)
         $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(OPT) $(CROSSOPT)' cycleclean compiler
 endif
+endif
 
 endif
 

compiler/aasmbase.pas

@@ -37,7 +37,10 @@ interface
        ;
 
     type
-       TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL,AB_WEAK_EXTERNAL);
+       TAsmsymbind=(
+         AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL,AB_WEAK_EXTERNAL,
+         { global in the current program/library, but not visible outside it }
+         AB_PRIVATE_EXTERN,AB_LAZY);
 
        TAsmsymtype=(
          AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL,
@@ -70,6 +73,10 @@ interface
          sec_pdata,
          { used for darwin import stubs }
          sec_stub,
+         sec_data_nonlazy,
+         sec_data_lazy,
+         sec_init_func,
+         sec_term_func,
          { stabs }
          sec_stab,sec_stabstr,
          { win32 }
@@ -91,7 +98,43 @@ interface
          { Table of contents section }
          sec_toc,
          sec_init,
-         sec_fini
+         sec_fini,
+         {Objective-C common and fragile ABI }
+         sec_objc_class,
+         sec_objc_meta_class,
+         sec_objc_cat_cls_meth,
+         sec_objc_cat_inst_meth,
+         sec_objc_protocol,
+         sec_objc_string_object,
+         sec_objc_cls_meth,
+         sec_objc_inst_meth,
+         sec_objc_cls_refs,
+         sec_objc_message_refs,
+         sec_objc_symbols,
+         sec_objc_category,
+         sec_objc_class_vars,
+         sec_objc_instance_vars,
+         sec_objc_module_info,
+         sec_objc_class_names,
+         sec_objc_meth_var_types,
+         sec_objc_meth_var_names,
+         sec_objc_selector_strs,
+         sec_objc_protocol_ext,
+         sec_objc_class_ext,
+         sec_objc_property,
+         sec_objc_image_info,
+         sec_objc_cstring_object,
+         sec_objc_sel_fixup,
+         { Objective-C non-fragile ABI }
+         sec_objc_data,
+         sec_objc_const,
+         sec_objc_sup_refs,
+         sec_data_coalesced,
+         sec_objc_classlist,
+         sec_objc_nlclasslist,
+         sec_objc_catlist,
+         sec_objc_nlcatlist,
+         sec_objc_protolist
        );
 
        TAsmSectionOrder = (secorder_begin,secorder_default,secorder_end);
@@ -329,11 +372,18 @@ implementation
 *****************************************************************************}
 
     constructor TAsmLabel.Createlocal(AList:TFPHashObjectList;nr:longint;ltyp:TAsmLabelType);
+      var
+        asmtyp: TAsmsymtype;
       begin
-        if ltyp=alt_addr then
-          inherited Create(AList,target_asm.labelprefix+asmlabeltypeprefix[ltyp]+tostr(nr),AB_LOCAL,AT_ADDR)
-        else
-          inherited Create(AList,target_asm.labelprefix+asmlabeltypeprefix[ltyp]+tostr(nr),AB_LOCAL,AT_LABEL);
+        case ltyp of
+          alt_addr:
+            asmtyp:=AT_ADDR;
+          alt_data:
+            asmtyp:=AT_DATA;
+          else
+            asmtyp:=AT_LABEL;
+        end;
+        inherited Create(AList,target_asm.labelprefix+asmlabeltypeprefix[ltyp]+tostr(nr),AB_LOCAL,asmtyp);
         labelnr:=nr;
         labeltype:=ltyp;
         is_set:=false;
@@ -358,7 +408,8 @@ implementation
         TAsmLabel(result).labeltype:=labeltype;
         TAsmLabel(result).is_set:=false;
         case bind of
-          AB_GLOBAL:
+          AB_GLOBAL,
+          AB_PRIVATE_EXTERN:
             result.increfs;
           AB_LOCAL:
             ;

compiler/aasmdata.pas

@@ -57,12 +57,17 @@ interface
         al_exports,
         al_resources,
         al_rtti,
-        al_dwarf,
+        al_dwarf_frame,
         al_dwarf_info,
         al_dwarf_abbrev,
         al_dwarf_line,
         al_picdata,
         al_resourcestrings,
+        { Objective-C related sections }
+        al_objc_data,
+        { keep pool data separate, so we can generate new pool entries
+          while emitting other data }
+        al_objc_pools,
         al_end
       );
 
@@ -76,7 +81,13 @@ interface
          sp_longstr,
          sp_ansistr,
          sp_widestr,
-         sp_unicodestr
+         sp_unicodestr,
+         sp_objcclassnamerefs,
+         sp_varnamerefs,
+         sp_objcclassnames,
+         sp_objcvarnames,
+         sp_objcvartypes,
+         sp_objcprotocolrefs
       );
       
     const
@@ -93,12 +104,14 @@ interface
         'al_exports',
         'al_resources',
         'al_rtti',
-        'al_dwarf',
+        'al_dwarf_frame',
         'al_dwarf_info',
         'al_dwarf_abbrev',
         'al_dwarf_line',
         'al_picdata',
         'al_resourcestrings',
+        'al_objc_data',
+        'al_objc_pools',
         'al_end'
       );
 
@@ -139,6 +152,7 @@ interface
         { Assembler lists }
         AsmLists      : array[TAsmListType] of TAsmList;
         CurrAsmList   : TAsmList;
+        WideInits     : TLinkedList;
         { hash tables for reusing constant storage }
         ConstPools    : array[TConstPoolType] of THashSet;
         constructor create(const n:string);
@@ -161,6 +175,13 @@ interface
         property AsmCFI:TAsmCFI read FAsmCFI;
       end;
 
+      TTCInitItem = class(TLinkedListItem)
+        sym: tsym;
+        offset: aint;
+        datalabel: TAsmLabel;
+        constructor Create(asym: tsym; aoffset: aint; alabel: TAsmLabel);
+      end;
+
     var
       CAsmCFI : TAsmCFIClass;
       current_asmdata : TAsmData;
@@ -228,6 +249,18 @@ implementation
       begin
       end;
 
+{*****************************************************************************
+                                 TTCInitItem
+*****************************************************************************}
+
+
+    constructor TTCInitItem.Create(asym: tsym; aoffset: aint; alabel: TAsmLabel);
+      begin
+        inherited Create;
+        sym:=asym;
+        offset:=aoffset;
+        datalabel:=alabel;
+      end;
 
 {*****************************************************************************
                                  TAsmList
@@ -298,9 +331,10 @@ implementation
         CurrAsmList:=TAsmList.create;
         for hal:=low(TAsmListType) to high(TAsmListType) do
           AsmLists[hal]:=TAsmList.create;
+        WideInits :=TLinkedList.create;
         { PIC data }
         if (target_info.system in [system_powerpc_darwin,system_powerpc64_darwin,system_i386_darwin,system_arm_darwin]) then
-          AsmLists[al_picdata].concat(tai_directive.create(asd_non_lazy_symbol_pointer,''));
+          new_section(AsmLists[al_picdata],sec_data_nonlazy,'',sizeof(pint));
         { CFI }
         FAsmCFI:=CAsmCFI.Create;
       end;
@@ -332,6 +366,7 @@ implementation
 {$ifdef MEMDEBUG}
          memasmlists.start;
 {$endif}
+        WideInits.free;
          for hal:=low(TAsmListType) to high(TAsmListType) do
            AsmLists[hal].free;
          CurrAsmList.free;

compiler/aasmtai.pas

@@ -83,6 +83,9 @@ interface
 {$ifdef support_llvm}
           ait_llvmins,
 {$endif support_llvm}
+{$ifdef arm}
+          ait_thumb_func,
+{$endif arm}
           { used to split into tiny assembler files }
           ait_cutobject,
           ait_regalloc,
@@ -103,7 +106,6 @@ interface
           aitconst_rva_symbol,
           aitconst_secrel32_symbol,
           { darwin only }
-          aitconst_indirect_symbol,
           { From gcc/config/darwin.c (darwin_asm_output_dwarf_delta):
             ***
             Output a difference of two labels that will be an assembly time
@@ -174,6 +176,9 @@ interface
 {$ifdef support_llvm}
           'ait_llvmins',
 {$endif support_llvm}
+{$ifdef arm}
+          'thumb_func',
+{$endif arm}
           'cut',
           'regalloc',
           'tempalloc',
@@ -187,6 +192,7 @@ interface
        { ARM only }
        ,top_regset
        ,top_shifterop
+       ,top_conditioncode
 {$endif arm}
 {$ifdef m68k}
        { m68k only }
@@ -223,8 +229,9 @@ interface
           { local varsym that will be inserted in pass_generate_code }
           top_local  : (localoper:plocaloper);
       {$ifdef arm}
-          top_regset : (regset:^tcpuregisterset);
+          top_regset : (regset:^tcpuregisterset; regtyp: tregistertype; subreg: tsubregister);
           top_shifterop : (shifterop : pshifterop);
+          top_conditioncode: (cc: TAsmCond);
       {$endif arm}
       {$ifdef m68k}
           top_regset : (regset:^tcpuregisterset);
@@ -251,6 +258,9 @@ interface
                      ait_stab,ait_function_name,
                      ait_cutobject,ait_marker,ait_align,ait_section,ait_comment,
                      ait_const,
+{$ifdef arm}
+                     ait_thumb_func,
+{$endif arm}
                      ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_real_128bit,
                      ait_symbol
                     ];
@@ -263,7 +273,7 @@ interface
       TAsmMarker = (
         mark_NoPropInfoStart,mark_NoPropInfoEnd,
         mark_AsmBlockStart,mark_AsmBlockEnd,
-        mark_InlineStart,mark_InlineEnd,mark_BlockStart,
+        mark_NoLineInfoStart,mark_NoLineInfoEnd,mark_BlockStart,
         mark_Position
       );
 
@@ -272,9 +282,10 @@ interface
       TStabType = (stab_stabs,stab_stabn,stab_stabd);
 
       TAsmDirective=(
-        asd_non_lazy_symbol_pointer,asd_indirect_symbol,asd_lazy_symbol_pointer,
-        asd_extern,asd_nasm_import, asd_toc_entry, asd_mod_init_func, asd_mod_term_func,
-        asd_reference,asd_no_dead_strip,asd_weak_reference
+        asd_indirect_symbol,
+        asd_extern,asd_nasm_import, asd_toc_entry,
+        asd_reference,asd_no_dead_strip,asd_weak_reference,asd_lazy_reference,
+        asd_weak_definition
       );
 
     const
@@ -282,9 +293,9 @@ interface
       tempallocstr : array[boolean] of string[10]=('released','allocated');
       stabtypestr : array[TStabType] of string[5]=('stabs','stabn','stabd');
       directivestr : array[TAsmDirective] of string[23]=(
-        'non_lazy_symbol_pointer','indirect_symbol','lazy_symbol_pointer',
-        'extern','nasm_import', 'tc', 'mod_init_func', 'mod_term_func', 'reference',
-        'no_dead_strip','weak_reference'
+        'indirect_symbol',
+        'extern','nasm_import', 'tc', 'reference',
+        'no_dead_strip','weak_reference','lazy_reference','weak_definition'
       );
 
     type
@@ -333,13 +344,16 @@ interface
 
        { Generates a common label }
        tai_symbol = class(tai)
-          is_global : boolean;
           sym       : tasmsymbol;
+          value     : puint;
           size      : longint;
+          is_global,
+          has_value : boolean;
           constructor Create(_sym:tasmsymbol;siz:longint);
           constructor Create_Global(_sym:tasmsymbol;siz:longint);
           constructor Createname(const _name : string;_symtyp:Tasmsymtype;siz:longint);
           constructor Createname_global(const _name : string;_symtyp:Tasmsymtype;siz:longint);
+          constructor Createname_global_value(const _name : string;_symtyp:Tasmsymtype;siz:longint;val:ptruint);
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure derefimpl;override;
@@ -391,10 +405,12 @@ interface
           secalign : byte;
           name     : pshortstring;
           sec      : TObjSection; { used in binary writer }
-          constructor Create(Asectype:TAsmSectiontype;Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default);
           destructor Destroy;override;
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
+         private
+          { sections should be created via new_section() }
+          constructor Create(Asectype:TAsmSectiontype;Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default);
        end;
 
 
@@ -428,6 +444,7 @@ interface
           constructor Create_32bit(_value : longint);
           constructor Create_16bit(_value : word);
           constructor Create_8bit(_value : byte);
+          constructor Create_char(size: integer; _value: dword);
           constructor Create_sleb128bit(_value : int64);
           constructor Create_uleb128bit(_value : qword);
           constructor Create_aint(_value : aint);
@@ -437,7 +454,6 @@ interface
           constructor Create_sym_offset(_sym:tasmsymbol;ofs:aint);
           constructor Create_rel_sym(_typ:taiconst_type;_sym,_endsym:tasmsymbol);
           constructor Create_rva_sym(_sym:tasmsymbol);
-          constructor Create_indirect_sym(_sym:tasmsymbol);
           constructor Createname(const name:string;ofs:aint);
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -472,7 +488,8 @@ interface
        { Generates an extended float (80 bit real) }
        tai_real_80bit = class(tai)
           value : ts80real;
-          constructor Create(_value : ts80real);
+          savesize : byte;
+          constructor Create(_value : ts80real; _savesize: byte);
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
        end;
@@ -636,7 +653,7 @@ interface
            constructor Create_zeros(b:byte);
            constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
            procedure ppuwrite(ppufile:tcompilerppufile);override;
-           function calculatefillbuf(var buf : tfillbuffer):pchar;virtual;
+           function calculatefillbuf(var buf : tfillbuffer;executable : boolean):pchar;virtual;
         end;
         tai_align_class = class of tai_align_abstract;
 
@@ -710,8 +727,7 @@ implementation
                                    Aglobal:boolean;Asectype:TAsmSectiontype;Aalign:byte);
       begin
         maybe_new_object_file(list);
-        list.concat(tai_section.create(Asectype,Aname,Aalign));
-        list.concat(cai_align.create(Aalign));
+        new_section(list,Asectype,Aname,Aalign);
         if Aglobal or
            create_smartlink then
           list.concat(tai_symbol.createname_global(Aname,Asymtyp,0))
@@ -956,7 +972,9 @@ implementation
          typ:=ait_symbol;
          sym:=_sym;
          size:=siz;
-         sym.bind:=AB_GLOBAL;
+         { don't override PRIVATE_EXTERN with GLOBAL }
+         if not(sym.bind in [AB_GLOBAL,AB_PRIVATE_EXTERN]) then
+           sym.bind:=AB_GLOBAL;
          is_global:=true;
       end;
 
@@ -981,6 +999,14 @@ implementation
       end;
 
 
+    constructor tai_symbol.createname_global_value(const _name: string;_symtyp: tasmsymtype; siz: longint; val: ptruint);
+      begin
+        Createname_global(_name,_symtyp,siz);
+        value:=val;
+        has_value:=true;
+      end;
+
+
     constructor tai_symbol.ppuload(t:taitype;ppufile:tcompilerppufile);
       begin
         inherited ppuload(t,ppufile);
@@ -1148,6 +1174,27 @@ implementation
       end;
 
 
+    constructor tai_const.Create_char(size: integer; _value: dword);
+      begin
+         inherited Create;
+         typ:=ait_const;
+         case size of
+            1:
+              begin
+                consttype:=aitconst_8bit;
+                value:=byte(_value)
+              end;
+             2:
+               begin
+                 consttype:=aitconst_16bit;
+                 value:=word(_value)
+               end
+             else
+               InternalError(2010030701)
+         end
+      end;
+
+
     constructor tai_const.Create_sleb128bit(_value : int64);
       begin
          inherited Create;
@@ -1246,13 +1293,6 @@ implementation
       end;
 
 
-    constructor tai_const.Create_indirect_sym(_sym:tasmsymbol);
-      begin
-         self.create_sym_offset(_sym,0);
-         consttype:=aitconst_indirect_symbol;
-      end;
-
-
     constructor tai_const.Createname(const name:string;ofs:aint);
       begin
          self.create_sym_offset(current_asmdata.RefAsmSymbol(name),ofs);
@@ -1301,11 +1341,10 @@ implementation
             result:=1;
           aitconst_16bit :
             result:=2;
-          aitconst_32bit :
+          aitconst_32bit,aitconst_darwin_dwarf_delta32:
             result:=4;
-          aitconst_64bit :
+          aitconst_64bit,aitconst_darwin_dwarf_delta64:
             result:=8;
-          aitconst_indirect_symbol,
           aitconst_secrel32_symbol,
           aitconst_rva_symbol :
             if target_info.system=system_x86_64_win64 then
@@ -1396,12 +1435,13 @@ implementation
                                TAI_real_80bit
  ****************************************************************************}
 
-    constructor tai_real_80bit.Create(_value : ts80real);
+    constructor tai_real_80bit.Create(_value : ts80real; _savesize: byte);
 
       begin
          inherited Create;
          typ:=ait_real_80bit;
          value:=_value;
+         savesize:=_savesize;
       end;
 
 
@@ -1409,6 +1449,7 @@ implementation
       begin
         inherited ppuload(t,ppufile);
         value:=ppufile.getreal;
+        savesize:=ppufile.getbyte;
       end;
 
 
@@ -1416,6 +1457,7 @@ implementation
       begin
         inherited ppuwrite(ppufile);
         ppufile.putreal(value);
+        ppufile.putbyte(savesize);
       end;
 
 
@@ -1542,7 +1584,7 @@ implementation
         typ:=ait_label;
         labsym:=_labsym;
         labsym.is_set:=true;
-        is_global:=(labsym.bind=AB_GLOBAL);
+        is_global:=(labsym.bind in [AB_GLOBAL,AB_PRIVATE_EXTERN]);
       end;
 
 
@@ -1940,7 +1982,7 @@ implementation
       var
         r : treference;
       begin
-        reference_reset_symbol(r,s,sofs);
+        reference_reset_symbol(r,s,sofs,1);
         r.refaddr:=addr_full;
         loadref(opidx,r);
       end;
@@ -2382,7 +2424,7 @@ implementation
        end;
 
 
-     function tai_align_abstract.calculatefillbuf(var buf : tfillbuffer):pchar;
+     function tai_align_abstract.calculatefillbuf(var buf : tfillbuffer;executable : boolean):pchar;
        begin
          if fillsize>sizeof(buf) then
            internalerror(200404293);

compiler/aggas.pas

@@ -38,7 +38,6 @@ interface
 {$endif support_llvm}
       ;
 
-
     type
       TCPUInstrWriter = class;
       {# This is a derived class which is used to write
@@ -92,8 +91,7 @@ interface
        protected
         function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
         procedure WriteWeakSymbolDef(s: tasmsymbol); override;
-       private
-        debugframecount: aint;
+
        end;
 
 
@@ -226,7 +224,7 @@ implementation
       ait_const2str : array[aitconst_128bit..aitconst_darwin_dwarf_delta32] of string[20]=(
         #9'.fixme128'#9,#9'.quad'#9,#9'.long'#9,#9'.short'#9,#9'.byte'#9,
         #9'.sleb128'#9,#9'.uleb128'#9,
-        #9'.rva'#9,#9'.secrel32'#9,#9'.indirect_symbol'#9,#9'.quad'#9,#9'.long'#9
+        #9'.rva'#9,#9'.secrel32'#9,#9'.quad'#9,#9'.long'#9
       );
 
 {****************************************************************************}
@@ -258,7 +256,7 @@ implementation
 
     function TGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
       const
-        secnames : array[TAsmSectiontype] of string[17] = ('',
+        secnames : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('',
           '.text',
           '.data',
 { why doesn't .rodata work? (FK) }
@@ -282,6 +280,10 @@ implementation
           '.threadvar',
           '.pdata',
           '', { stubs }
+          '__DATA,__nl_symbol_ptr',
+          '__DATA,__la_symbol_ptr',
+          '__DATA,__mod_init_func',
+          '__DATA,__mod_term_func',
           '.stab',
           '.stabstr',
           '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
@@ -290,9 +292,43 @@ implementation
           '.fpc',
           '.toc',
           '.init',
-          '.fini'
+          '.fini',
+          '.objc_class',
+          '.objc_meta_class',
+          '.objc_cat_cls_meth',
+          '.objc_cat_inst_meth',
+          '.objc_protocol',
+          '.objc_string_object',
+          '.objc_cls_meth',
+          '.objc_inst_meth',
+          '.objc_cls_refs',
+          '.objc_message_refs',
+          '.objc_symbols',
+          '.objc_category',
+          '.objc_class_vars',
+          '.objc_instance_vars',
+          '.objc_module_info',
+          '.objc_class_names',
+          '.objc_meth_var_types',
+          '.objc_meth_var_names',
+          '.objc_selector_strs',
+          '.objc_protocol_ext',
+          '.objc_class_ext',
+          '.objc_property',
+          '.objc_image_info',
+          '.objc_cstring_object',
+          '.objc_sel_fixup',
+          '__DATA,__objc_data',
+          '__DATA,__objc_const',
+          '.objc_superrefs',
+          '__DATA, __datacoal_nt,coalesced',
+          '.objc_classlist',
+          '.objc_nlclasslist',
+          '.objc_catlist',
+          '.obcj_nlcatlist',
+          '.objc_protolist'
         );
-        secnames_pic : array[TAsmSectiontype] of string[17] = ('',
+        secnames_pic : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('',
           '.text',
           '.data.rel',
           '.data.rel',
@@ -301,6 +337,10 @@ implementation
           '.threadvar',
           '.pdata',
           '', { stubs }
+          '__DATA,__nl_symbol_ptr',
+          '__DATA,__la_symbol_ptr',
+          '__DATA,__mod_init_func',
+          '__DATA,__mod_term_func',
           '.stab',
           '.stabstr',
           '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
@@ -309,7 +349,41 @@ implementation
           '.fpc',
           '.toc',
           '.init',
-          '.fini'
+          '.fini',
+          '.objc_class',
+          '.objc_meta_class',
+          '.objc_cat_cls_meth',
+          '.objc_cat_inst_meth',
+          '.objc_protocol',
+          '.objc_string_object',
+          '.objc_cls_meth',
+          '.objc_inst_meth',
+          '.objc_cls_refs',
+          '.objc_message_refs',
+          '.objc_symbols',
+          '.objc_category',
+          '.objc_class_vars',
+          '.objc_instance_vars',
+          '.objc_module_info',
+          '.objc_class_names',
+          '.objc_meth_var_types',
+          '.objc_meth_var_names',
+          '.objc_selector_strs',
+          '.objc_protocol_ext',
+          '.objc_class_ext',
+          '.objc_property',
+          '.objc_image_info',
+          '.objc_cstring_object',
+          '.objc_sel_fixup',
+          '__DATA, __objc_data',
+          '__DATA, __objc_const',
+          '.objc_superrefs',
+          '__DATA, __datacoal_nt,coalesced',
+          '.objc_classlist',
+          '.objc_nlclasslist',
+          '.objc_catlist',
+          '.obcj_nlcatlist',
+          '.objc_protolist'
         );
       var
         sep     : string[3];
@@ -336,7 +410,7 @@ implementation
           secname:='.tls';
 
         { go32v2 stub only loads .text and .data sections, and allocates space for .bss.
-          Thus, data which normally goes into .rodata and .rodata_norel sections must 
+          Thus, data which normally goes into .rodata and .rodata_norel sections must
           end up in .data section }
         if (atype in [sec_rodata,sec_rodata_norel]) and
           (target_info.system=system_i386_go32v2) then
@@ -348,8 +422,9 @@ implementation
         if not(target_info.system in systems_darwin) and
            create_smartlink_sections and
            (aname<>'') and
-           (atype <> sec_toc) and
-           (atype<>sec_bss) then
+           (atype<>sec_toc) and
+           { on embedded systems every byte counts, so smartlink bss too }
+           ((atype<>sec_bss) or (target_info.system in systems_embedded)) then
           begin
             case aorder of
               secorder_begin :
@@ -382,7 +457,7 @@ implementation
          system_x86_64_darwin,
          system_arm_darwin:
            begin
-             if (atype = sec_stub) then
+             if (atype in [sec_stub,sec_objc_data,sec_objc_const,sec_data_coalesced]) then
                AsmWrite('.section ');
            end
          else
@@ -476,17 +551,48 @@ implementation
 
     procedure TGNUAssembler.WriteTree(p:TAsmList);
 
-    function needsObject(hp : tai_symbol) : boolean;
-      begin
-        needsObject :=
-            (
-              assigned(hp.next) and
-               (tai(hp.next).typ in [ait_const,ait_datablock,
-                ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit])
-            ) or
-            (hp.sym.typ=AT_DATA);
-
-      end;
+      function needsObject(hp : tai_symbol) : boolean;
+        begin
+          needsObject :=
+              (
+                assigned(hp.next) and
+                 (tai(hp.next).typ in [ait_const,ait_datablock,
+                  ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit])
+              ) or
+              (hp.sym.typ=AT_DATA);
+  
+        end;
+  
+  
+      procedure doalign(alignment: byte; use_op: boolean; fillop: byte; out last_align: longint);
+        var
+          i: longint;
+        begin
+          last_align:=alignment;
+          if alignment>1 then
+            begin
+              if not(target_info.system in systems_darwin) then
+                begin
+                  AsmWrite(#9'.balign '+tostr(alignment));
+                  if use_op then
+                    AsmWrite(','+tostr(fillop))
+{$ifdef x86}
+                  { force NOP as alignment op code }
+                  else if LastSecType=sec_code then
+                    AsmWrite(',0x90');
+{$endif x86}
+                end
+              else
+                begin
+                  { darwin as only supports .align }
+                  if not ispowerof2(alignment,i) then
+                    internalerror(2003010305);
+                  AsmWrite(#9'.align '+tostr(i));
+                  last_align:=i;
+                end;
+              AsmLn;
+            end;
+        end;
 
     var
       ch       : char;
@@ -519,6 +625,7 @@ implementation
       hp:=tai(p.first);
       while assigned(hp) do
        begin
+         prefetch(pointer(hp.next)^);
          if not(hp.typ in SkipLineInfo) then
           begin
             hp1 := hp as tailineinfo;
@@ -614,30 +721,7 @@ implementation
 
            ait_align :
              begin
-               last_align := tai_align_abstract(hp).aligntype;
-               if tai_align_abstract(hp).aligntype>1 then
-                 begin
-                   if not(target_info.system in systems_darwin) then
-                     begin
-                       AsmWrite(#9'.balign '+tostr(tai_align_abstract(hp).aligntype));
-                       if tai_align_abstract(hp).use_op then
-                         AsmWrite(','+tostr(tai_align_abstract(hp).fillop))
-{$ifdef x86}
-                       { force NOP as alignment op code }
-                       else if LastSecType=sec_code then
-                         AsmWrite(',0x90');
-{$endif x86}
-                     end
-                   else
-                     begin
-                       { darwin as only supports .align }
-                       if not ispowerof2(tai_align_abstract(hp).aligntype,i) then
-                         internalerror(2003010305);
-                       AsmWrite(#9'.align '+tostr(i));
-                       last_align := i;
-                     end;
-                   AsmLn;
-                 end;
+               doalign(tai_align_abstract(hp).aligntype,tai_align_abstract(hp).use_op,tai_align_abstract(hp).fillop,last_align);
              end;
 
            ait_section :
@@ -773,7 +857,6 @@ implementation
                  aitconst_8bit,
                  aitconst_rva_symbol,
                  aitconst_secrel32_symbol,
-                 aitconst_indirect_symbol,
                  aitconst_darwin_dwarf_delta32,
                  aitconst_darwin_dwarf_delta64:
                    begin
@@ -812,7 +895,12 @@ implementation
                                  s:=s+tostr_with_plus(tai_const(hp).value);
                              end
                            else
+{$ifdef cpu64bitaddr}
                              s:=tostr(tai_const(hp).value);
+{$else cpu64bitaddr}
+                             { 64 bit constants are already handled above in this case }
+                             s:=tostr(longint(tai_const(hp).value));
+{$endif cpu64bitaddr}
                            AsmWrite(s);
                            inc(l,length(s));
                            { Values with symbols are written on a single line to improve
@@ -859,6 +947,8 @@ implementation
                    AsmWrite(',');
                   AsmWrite(tostr(t80bitarray(e)[i]));
                 end;
+               for i:=11 to tai_real_80bit(hp).savesize do
+                 AsmWrite(',0');
                AsmLn;
              end;
 {$endif cpuextended}
@@ -970,7 +1060,12 @@ implementation
              begin
                if (tai_label(hp).labsym.is_used) then
                 begin
-                  if tai_label(hp).labsym.bind=AB_GLOBAL then
+                  if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then
+                    begin
+                      AsmWrite(#9'.private_extern ');
+                      AsmWriteln(tai_label(hp).labsym.name);
+                    end;
+                  if tai_label(hp).labsym.bind in [AB_GLOBAL,AB_PRIVATE_EXTERN] then
                    begin
                      AsmWrite('.globl'#9);
                      AsmWriteLn(tai_label(hp).labsym.name);
@@ -982,6 +1077,11 @@ implementation
 
            ait_symbol :
              begin
+               if (tai_symbol(hp).sym.bind=AB_PRIVATE_EXTERN) then
+                 begin
+                   AsmWrite(#9'.private_extern ');
+                   AsmWriteln(tai_symbol(hp).sym.name);
+                 end;
                if (target_info.system = system_powerpc64_linux) and
                  (tai_symbol(hp).sym.typ = AT_FUNCTION) and (cs_profile in current_settings.moduleswitches) then
                  begin
@@ -1022,8 +1122,17 @@ implementation
                          AsmWriteLn(',' + sepChar + 'function');
                      end;
                  end;
-               AsmWriteLn(tai_symbol(hp).sym.name + ':');
+               if not(tai_symbol(hp).has_value) then
+                 AsmWriteLn(tai_symbol(hp).sym.name + ':')
+               else
+                 AsmWriteLn(tai_symbol(hp).sym.name + '=' + tostr(tai_symbol(hp).value));
+             end;
+{$ifdef arm}
+           ait_thumb_func:
+             begin
+               AsmWriteLn(#9'.thumb_func');
              end;
+{$endif arm}
 
            ait_symbol_end :
              begin
@@ -1088,9 +1197,9 @@ implementation
              end;
 
            ait_marker :
-             if tai_marker(hp).kind=mark_InlineStart then
+             if tai_marker(hp).kind=mark_NoLineInfoStart then
                inc(InlineLevel)
-             else if tai_marker(hp).kind=mark_InlineEnd then
+             else if tai_marker(hp).kind=mark_NoLineInfoEnd then
                dec(InlineLevel);
 
            ait_directive :
@@ -1175,6 +1284,13 @@ 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) and
+         not(cs_executable_stack in current_settings.moduleswitches) then
+        begin
+          AsmWriteLn('.section .note.GNU-stack,"",%progbits');
+        end;
+
       AsmLn;
 {$ifdef EXTDEBUG}
       if assigned(current_module.mainsource) then
@@ -1198,8 +1314,7 @@ implementation
             sec_debug_frame,
             sec_eh_frame:
               begin
-                result := '.section __DWARFA,__debug_frame,coalesced,no_toc+strip_static_syms'#10'EH_frame'+tostr(debugframecount)+':';
-                inc(debugframecount);
+                result := '.section __DWARF,__debug_info,regular,debug';
                 exit;
               end;
             sec_debug_line:
@@ -1242,6 +1357,131 @@ implementation
                     exit;
                   end;
               end;
+            sec_data_nonlazy:
+              begin
+                result:='.section __DATA, __nl_symbol_ptr,non_lazy_symbol_pointers';
+                exit;
+              end;
+            sec_data_lazy:
+              begin
+                result:='.section __DATA, __la_symbol_ptr,lazy_symbol_pointers';
+                exit;
+              end;
+            sec_init_func:
+              begin
+                result:='.section __DATA, __mod_init_func, mod_init_funcs';
+                exit;
+              end;
+            sec_term_func:
+              begin
+                result:='.section __DATA, __mod_term_func, mod_term_funcs';
+                exit;
+              end;
+            sec_objc_protocol_ext:
+              begin
+                result:='.section __OBJC, __protocol_ext, regular, no_dead_strip';
+                exit;
+              end;
+            sec_objc_class_ext:
+              begin
+                result:='.section __OBJC, __class_ext, regular, no_dead_strip';
+                exit;
+              end;
+            sec_objc_property:
+              begin
+                result:='.section __OBJC, __property, regular, no_dead_strip';
+                exit;
+              end;
+            sec_objc_image_info:
+              begin
+                result:='.section __OBJC, __image_info, regular, no_dead_strip';
+                exit;
+              end;
+            sec_objc_cstring_object:
+              begin
+                result:='.section __OBJC, __cstring_object, regular, no_dead_strip';
+                exit;
+              end;
+            sec_objc_sel_fixup:
+              begin
+                result:='.section __OBJC, __sel_fixup, regular, no_dead_strip';
+                exit;
+              end;
+            sec_objc_message_refs:
+              begin
+                if (target_info.system in systems_objc_nfabi) then
+                  begin
+                    result:='.section __DATA, __objc_selrefs, literal_pointers, no_dead_strip';
+                    exit;
+                  end;
+              end;
+            sec_objc_cls_refs:
+              begin
+                if (target_info.system in systems_objc_nfabi) then
+                  begin
+                    result:='.section __DATA, __objc_clsrefs, regular, no_dead_strip';
+                    exit;
+                  end;
+              end;
+            sec_objc_meth_var_names,
+            sec_objc_class_names:
+              begin
+                if (target_info.system in systems_objc_nfabi) then
+                  begin
+                    result:='.cstring';
+                    exit
+                  end;
+              end;
+            sec_objc_inst_meth,
+            sec_objc_cls_meth,
+            sec_objc_cat_inst_meth,
+            sec_objc_cat_cls_meth:
+              begin
+                if (target_info.system in systems_objc_nfabi) then
+                  begin
+                    result:='.section __DATA, __objc_const';
+                    exit;
+                  end;
+              end;
+            sec_objc_meta_class,
+            sec_objc_class:
+              begin
+                if (target_info.system in systems_objc_nfabi) then
+                  begin
+                    result:='.section __DATA, __objc_data';
+                    exit;
+                  end;
+              end;
+            sec_objc_sup_refs:
+              begin
+                result:='.section __DATA, __objc_superrefs, regular, no_dead_strip';
+                exit
+              end;
+            sec_objc_classlist:
+              begin
+                result:='.section __DATA, __objc_classlist, regular, no_dead_strip';
+                exit
+              end;
+            sec_objc_nlclasslist:
+              begin
+                result:='.section __DATA, __objc_nlclasslist, regular, no_dead_strip';
+                exit
+              end;
+            sec_objc_catlist:
+              begin
+                result:='.section __DATA, __objc_catlist, regular, no_dead_strip';
+                exit
+              end;
+            sec_objc_nlcatlist:
+              begin
+                result:='.section __DATA, __objc_nlcatlist, regular, no_dead_strip';
+                exit
+              end;
+            sec_objc_protolist:
+              begin
+                result:='.section __DATA, __objc_protolist, coalesced, no_dead_strip';
+                exit;
+              end;
           end;
         result := inherited sectionname(atype,aname,aorder);
       end;
@@ -1272,6 +1512,10 @@ implementation
          sec_code (* sec_pdata *),
          { used for darwin import stubs }
          sec_code (* sec_stub *),
+         sec_data,(* sec_data_nonlazy *)
+         sec_data,(* sec_data_lazy *)
+         sec_data,(* sec_init_func *)
+         sec_data,(* sec_term_func *)
          { stabs }
          sec_stab,sec_stabstr,
          { win32 }
@@ -1293,7 +1537,41 @@ implementation
          { Table of contents section }
          sec_code (* sec_toc *),
          sec_code (* sec_init *),
-         sec_code (* sec_fini *)
+         sec_code (* sec_fini *),
+         sec_none (* sec_objc_class *),
+         sec_none (* sec_objc_meta_class *),
+         sec_none (* sec_objc_cat_cls_meth *),
+         sec_none (* sec_objc_cat_inst_meth *),
+         sec_none (* sec_objc_protocol *),
+         sec_none (* sec_objc_string_object *),
+         sec_none (* sec_objc_cls_meth *),
+         sec_none (* sec_objc_inst_meth *),
+         sec_none (* sec_objc_cls_refs *),
+         sec_none (* sec_objc_message_refs *),
+         sec_none (* sec_objc_symbols *),
+         sec_none (* sec_objc_category *),
+         sec_none (* sec_objc_class_vars *),
+         sec_none (* sec_objc_instance_vars *),
+         sec_none (* sec_objc_module_info *),
+         sec_none (* sec_objc_class_names *),
+         sec_none (* sec_objc_meth_var_types *),
+         sec_none (* sec_objc_meth_var_names *),
+         sec_none (* sec_objc_selector_strs *),
+         sec_none (* sec_objc_protocol_ext *),
+         sec_none (* sec_objc_class_ext *),
+         sec_none (* sec_objc_property *),
+         sec_none (* sec_objc_image_info *),
+         sec_none (* sec_objc_cstring_object *),
+         sec_none (* sec_objc_sel_fixup *),
+         sec_none (* sec_objc_data *),
+         sec_none (* sec_objc_const *),
+         sec_none (* sec_objc_sup_refs *),
+         sec_none (* sec_data_coalesced *),
+         sec_none (* sec_objc_classlist *),
+         sec_none (* sec_objc_nlclasslist *),
+         sec_none (* sec_objc_catlist *),
+         sec_none (* sec_objc_nlcatlist *),
+         sec_none (* sec_objc_protlist *)
         );
       begin
         Result := inherited SectionName (SecXTable [AType], AName, AOrder);

compiler/alpha/cgcpu.pas

@@ -51,6 +51,8 @@ tcgalpha = class(tcg)
   procedure g_restore_frame_pointer(list : TAsmList);override;
 end;
 
+procedure create_codegen;
+
 implementation
 
 uses
@@ -157,4 +159,9 @@ begin
 end;
 
 
+procedure create_codegen;
+  begin
+    cg:=tcgalpha.create;
+  end;
+
 end.

compiler/aopt.pas

@@ -47,9 +47,10 @@ Unit aopt;
         procedure clear;
         procedure pass_1;
       End;
+      TAsmOptimizerClass = class of TAsmOptimizer;
 
     var
-      casmoptimizer : class of tasmoptimizer;
+      casmoptimizer : TAsmOptimizerClass;
 
     procedure Optimize(AsmL:TAsmList);
 
@@ -73,7 +74,7 @@ Unit aopt;
       Var LabelFound: Boolean;
           p: tai;
       Begin
-        LabelInfo^.LowLabel := High(AWord);
+        LabelInfo^.LowLabel := High(longint);
         LabelInfo^.HighLabel := 0;
         LabelInfo^.LabelDif := 0;
         LabelInfo^.LabelTable:=nil;
@@ -90,9 +91,9 @@ Unit aopt;
                    (tai_Label(p).labsym.is_used) Then
                   Begin
                     LabelFound := True;
-                    If (tai_Label(p).labsym.labelnr < int64(LowLabel)) Then
+                    If (tai_Label(p).labsym.labelnr < LowLabel) Then
                       LowLabel := tai_Label(p).labsym.labelnr;
-                    If (tai_Label(p).labsym.labelnr > int64(HighLabel)) Then
+                    If (tai_Label(p).labsym.labelnr > HighLabel) Then
                       HighLabel := tai_Label(p).labsym.labelnr
                   End;
                 GetNextInstruction(p, p)
@@ -190,7 +191,7 @@ Unit aopt;
             LabelInfo^.labeltable := nil;
           end;
         LabelInfo^.labeldif:=0;
-        LabelInfo^.lowlabel:=high(AWord);
+        LabelInfo^.lowlabel:=high(longint);
         LabelInfo^.highlabel:=0;
       end;
 

compiler/aoptbase.pas

@@ -141,6 +141,11 @@ unit aoptbase;
   {$endif RefsHaveIndexReg}
   End;
 
+  function labelCanBeSkipped(p: tai_label): boolean;
+  begin
+    labelCanBeSkipped := not(p.labsym.is_used) or (p.labsym.labeltype<>alt_jump);
+  end;
+
   Function TAOptBase.GetNextInstruction(Current: tai; Var Next: tai): Boolean;
   Begin
     Repeat
@@ -153,7 +158,7 @@ unit aoptbase;
              ) or
 {$endif SPARC}
              ((Current.typ = ait_label) And
-              Not(Tai_Label(Current).labsym.is_used))) Do
+              labelCanBeSkipped(Tai_Label(Current)))) Do
         Current := tai(Current.Next);
       If Assigned(Current) And
          (Current.typ = ait_Marker) And
@@ -171,7 +176,7 @@ unit aoptbase;
     If Assigned(Current) And
        Not((Current.typ In SkipInstr) or
            ((Current.typ = ait_label) And
-            Not(Tai_Label(Current).labsym.is_used)))
+            labelCanBeSkipped(Tai_Label(Current))))
       Then GetNextInstruction := True
       Else
         Begin
@@ -189,7 +194,7 @@ unit aoptbase;
               Not(Tai_Marker(Current).Kind in [mark_AsmBlockEnd,mark_NoPropInfoEnd])) or
              (Current.typ In SkipInstr) or
              ((Current.typ = ait_label) And
-               Not(Tai_Label(Current).labsym.is_used))) Do
+              labelCanBeSkipped(Tai_Label(Current)))) Do
         Current := Tai(Current.previous);
       If Assigned(Current) And
          (Current.typ = ait_Marker) And
@@ -206,7 +211,7 @@ unit aoptbase;
     If Not(Assigned(Current)) or
        (Current.typ In SkipInstr) or
        ((Current.typ = ait_label) And
-        Not(Tai_Label(Current).labsym.is_used)) or
+        labelCanBeSkipped(Tai_Label(Current))) or
        ((Current.typ = ait_Marker) And
         (Tai_Marker(Current).Kind = mark_AsmBlockEnd))
       Then

compiler/aoptda.pas

@@ -36,6 +36,10 @@ Unit aoptda;
       TAOptDFA = class
         { uses the same constructor as TAoptCpu = constructor from TAoptObj }
 
+        { How many instructions are between the current instruction and the }
+        { last one that modified the register                               }
+        InstrSinceLastMod: TInstrSinceLastMod;
+
         { gathers the information regarding the contents of every register }
         { at the end of every instruction                                  }
         Procedure DoDFA;
@@ -43,10 +47,6 @@ Unit aoptda;
         { handles the processor dependent dataflow analizing               }
         Procedure CpuDFA(p: PInstr); Virtual; Abstract;
 
-        { How many instructions are between the current instruction and the }
-        { last one that modified the register                               }
-        InstrSinceLastMod: TInstrSinceLastMod;
-
         { convert a TInsChange value into the corresponding register }
         //!!!!!!!!!! Function TCh2Reg(Ch: TInsChange): TRegister; Virtual;
         { returns whether the instruction P reads from register Reg }

compiler/aoptobj.pas

@@ -216,8 +216,8 @@ Unit AoptObj;
       TLabelInfo = Record
         { the highest and lowest label number occurring in the current code }
         { fragment                                                          }
-        LowLabel, HighLabel: AWord;
-        LabelDif: AWord;
+        LowLabel, HighLabel: longint;
+        LabelDif: cardinal;
         { table that contains the addresses of the Pai_Label objects associated
           with each label number                                                }
         LabelTable: PLabelTable;

compiler/arm/aasmcpu.pas

@@ -87,6 +87,7 @@ uses
       OT_REG32     = $00201004;
       OT_REG64     = $00201008;
       OT_VREG      = $00201010;  { vector register }
+      OT_REGF      = $00201020;  { coproc register }
       OT_MEMORY    = $00204000;  { register number in 'basereg'  }
       OT_MEM8      = $00204001;
       OT_MEM16     = $00204002;
@@ -102,6 +103,8 @@ uses
       { co proc. ld/st operations }
       OT_AM5       = $00080000;
       OT_AMMASK    = $000f0000;
+      { IT instruction }
+      OT_CONDITION = $00100000;
 
       OT_MEMORYAM2 = OT_MEMORY or OT_AM2;
       OT_MEMORYAM3 = OT_MEMORY or OT_AM3;
@@ -157,7 +160,8 @@ uses
          oppostfix : TOpPostfix;
          roundingmode : troundingmode;
          procedure loadshifterop(opidx:longint;const so:tshifterop);
-         procedure loadregset(opidx:longint;const s:tcpuregisterset);
+         procedure loadregset(opidx:longint; regsetregtype: tregistertype; regsetsubregtype: tsubregister; const s:tcpuregisterset);
+         procedure loadconditioncode(opidx:longint;const cond:tasmcond);
          constructor op_none(op : tasmop);
 
          constructor op_reg(op : tasmop;_op1 : tregister);
@@ -168,7 +172,7 @@ uses
          constructor op_reg_ref(op : tasmop;_op1 : tregister;const _op2 : treference);
          constructor op_reg_const(op:tasmop; _op1: tregister; _op2: aint);
 
-         constructor op_ref_regset(op:tasmop; _op1: treference; _op2: tcpuregisterset);
+         constructor op_ref_regset(op:tasmop; _op1: treference; regtype: tregistertype; subreg: tsubregister; _op2: tcpuregisterset);
 
          constructor op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
          constructor op_reg_reg_const(op : tasmop;_op1,_op2 : tregister; _op3: aint);
@@ -179,6 +183,9 @@ uses
          { SFM/LFM }
          constructor op_reg_const_ref(op : tasmop;_op1 : tregister;_op2 : aint;_op3 : treference);
 
+         { ITxxx }
+         constructor op_cond(op: tasmop; cond: tasmcond);
+
          { *M*LL }
          constructor op_reg_reg_reg_reg(op : tasmop;_op1,_op2,_op3,_op4 : tregister);
 
@@ -228,6 +235,10 @@ uses
         { nothing to add }
       end;
 
+      tai_thumb_func = class(tai)
+        constructor create;
+      end;
+
     function spilling_create_load(const ref:treference;r:tregister):Taicpu;
     function spilling_create_store(r:tregister; const ref:treference):Taicpu;
 
@@ -268,7 +279,7 @@ implementation
       end;
 
 
-    procedure taicpu.loadregset(opidx:longint;const s:tcpuregisterset);
+    procedure taicpu.loadregset(opidx:longint; regsetregtype: tregistertype; regsetsubregtype: tsubregister; const s:tcpuregisterset);
       var
         i : byte;
       begin
@@ -276,15 +287,42 @@ implementation
         with oper[opidx]^ do
          begin
            if typ<>top_regset then
-             clearop(opidx);
-           new(regset);
-           regset^:=s;
-           typ:=top_regset;
-           for i:=RS_R0 to RS_R15 do
              begin
-               if assigned(add_reg_instruction_hook) and (i in regset^) then
-                 add_reg_instruction_hook(self,newreg(R_INTREGISTER,i,R_SUBWHOLE));
+               clearop(opidx);
+               new(regset);
              end;
+           regset^:=s;
+           regtyp:=regsetregtype;
+           subreg:=regsetsubregtype;
+           typ:=top_regset;
+           case regsetregtype of
+             R_INTREGISTER:
+               for i:=RS_R0 to RS_R15 do
+                 begin
+                   if assigned(add_reg_instruction_hook) and (i in regset^) then
+                     add_reg_instruction_hook(self,newreg(R_INTREGISTER,i,regsetsubregtype));
+                 end;
+             R_MMREGISTER:
+               { both RS_S0 and RS_D0 range from 0 to 31 }
+               for i:=RS_D0 to RS_D31 do
+                 begin
+                   if assigned(add_reg_instruction_hook) and (i in regset^) then
+                     add_reg_instruction_hook(self,newreg(R_MMREGISTER,i,regsetsubregtype));
+                 end;
+           end;
+         end;
+      end;
+
+
+    procedure taicpu.loadconditioncode(opidx:longint;const cond:tasmcond);
+      begin
+        allocate_oper(opidx+1);
+        with oper[opidx]^ do
+         begin
+           if typ<>top_conditioncode then
+             clearop(opidx);
+           cc:=cond;
+           typ:=top_conditioncode;
          end;
       end;
 
@@ -342,12 +380,12 @@ implementation
       end;
 
 
-    constructor taicpu.op_ref_regset(op:tasmop; _op1: treference; _op2: tcpuregisterset);
+    constructor taicpu.op_ref_regset(op:tasmop; _op1: treference; regtype: tregistertype; subreg: tsubregister; _op2: tcpuregisterset);
       begin
          inherited create(op);
          ops:=2;
          loadref(0,_op1);
-         loadregset(1,_op2);
+         loadregset(1,regtype,subreg,_op2);
       end;
 
 
@@ -401,6 +439,14 @@ implementation
       end;
 
 
+    constructor taicpu.op_cond(op: tasmop; cond: tasmcond);
+      begin
+        inherited create(op);
+        ops:=0;
+        condition := cond;
+      end;
+
+
      constructor taicpu.op_reg_reg_sym_ofs(op : tasmop;_op1,_op2 : tregister; _op3: tasmsymbol;_op3ofs: longint);
        begin
          inherited create(op);
@@ -489,7 +535,8 @@ implementation
       begin
         { allow the register allocator to remove unnecessary moves }
         result:=(((opcode=A_MOV) and (regtype = R_INTREGISTER)) or
-                 ((opcode=A_MVF) and (regtype = R_FPUREGISTER) and (oppostfix in [PF_None,PF_D]))
+                 ((opcode=A_MVF) and (regtype = R_FPUREGISTER) and (oppostfix in [PF_None,PF_D])) or
+                 (((opcode=A_FCPYS) or (opcode=A_FCPYD)) and (regtype = R_MMREGISTER))
                 ) and
                 (condition=C_None) and
                 (ops=2) and
@@ -500,6 +547,8 @@ implementation
 
 
     function spilling_create_load(const ref:treference;r:tregister):Taicpu;
+      var
+        op: tasmop;
       begin
         case getregtype(r) of
           R_INTREGISTER :
@@ -509,6 +558,18 @@ implementation
               and avoid exceptions
             }
             result:=taicpu.op_reg_const_ref(A_LFM,r,1,ref);
+          R_MMREGISTER :
+            begin
+              case getsubreg(r) of
+                R_SUBFD:
+                  op:=A_FLDD;
+                R_SUBFS:
+                  op:=A_FLDS;
+                else
+                  internalerror(2009112905);
+              end;
+              result:=taicpu.op_reg_ref(op,r,ref);
+            end;
           else
             internalerror(200401041);
         end;
@@ -516,6 +577,8 @@ implementation
 
 
     function spilling_create_store(r:tregister; const ref:treference):Taicpu;
+      var
+        op: tasmop;
       begin
         case getregtype(r) of
           R_INTREGISTER :
@@ -525,6 +588,18 @@ implementation
               and avoid exceptions
             }
             result:=taicpu.op_reg_const_ref(A_SFM,r,1,ref);
+          R_MMREGISTER :
+            begin
+              case getsubreg(r) of
+                R_SUBFD:
+                  op:=A_FSTD;
+                R_SUBFS:
+                  op:=A_FSTS;
+                else
+                  internalerror(2009112904);
+              end;
+              result:=taicpu.op_reg_ref(op,r,ref);
+            end;
           else
             internalerror(200401041);
         end;
@@ -546,33 +621,63 @@ implementation
           A_RFS,A_RFC,A_RDF,
           A_RMF,A_RPW,A_RSF,A_SUF,A_ABS,A_ACS,A_ASN,A_ATN,A_COS,
           A_EXP,A_LOG,A_LGN,A_MVF,A_MNF,A_FRD,A_MUF,A_POL,A_RND,A_SIN,A_SQT,A_TAN,
-          A_LFM:
+          A_LFM,
+          A_FLDS,A_FLDD,
+          A_FMRX,A_FMXR,A_FMSTAT,
+          A_FMSR,A_FMRS,A_FMDRR,
+          A_FCPYS,A_FCPYD,A_FCVTSD,A_FCVTDS,
+          A_FABSS,A_FABSD,A_FSQRTS,A_FSQRTD,A_FMULS,A_FMULD,
+          A_FADDS,A_FADDD,A_FSUBS,A_FSUBD,A_FDIVS,A_FDIVD,
+          A_FMACS,A_FMACD,A_FMSCS,A_FMSCD,A_FNMACS,A_FNMACD,
+          A_FNMSCS,A_FNMSCD,A_FNMULS,A_FNMULD,
+          A_FMDHR,A_FMRDH,A_FMDLR,A_FMRDL,
+          A_FNEGS,A_FNEGD,
+          A_FSITOS,A_FSITOD,A_FTOSIS,A_FTOSID,
+          A_FTOUIS,A_FTOUID,A_FUITOS,A_FUITOD:
             if opnr=0 then
               result:=operand_write
             else
               result:=operand_read;
           A_BIC,A_BKPT,A_B,A_BL,A_BLX,A_BX,
           A_CMN,A_CMP,A_TEQ,A_TST,
-          A_CMF,A_CMFE,A_WFS,A_CNF:
+          A_CMF,A_CMFE,A_WFS,A_CNF,
+          A_FCMPS,A_FCMPD,A_FCMPES,A_FCMPED,A_FCMPEZS,A_FCMPEZD,
+          A_FCMPZS,A_FCMPZD:
             result:=operand_read;
           A_SMLAL,A_UMLAL:
             if opnr in [0,1] then
               result:=operand_readwrite
             else
               result:=operand_read;
-           A_SMULL,A_UMULL:
+           A_SMULL,A_UMULL,
+           A_FMRRD:
             if opnr in [0,1] then
               result:=operand_write
             else
               result:=operand_read;
           A_STR,A_STRB,A_STRBT,
-          A_STRH,A_STRT,A_STF,A_SFM:
+          A_STRH,A_STRT,A_STF,A_SFM,
+          A_FSTS,A_FSTD:
             { important is what happens with the involved registers }
             if opnr=0 then
               result := operand_read
             else
               { check for pre/post indexed }
               result := operand_read;
+          //Thumb2
+          A_LSL, A_LSR, A_ROR, A_ASR, A_SDIV, A_UDIV,A_MOVT:
+            if opnr in [0] then
+              result:=operand_write
+            else
+              result:=operand_read;
+          A_LDREX:
+            if opnr in [0] then
+              result:=operand_write
+            else
+              result:=operand_read;
+          A_STREX:
+            if opnr in [0,1,2] then
+              result:=operand_write;
           else
             internalerror(200403151);
         end;
@@ -633,11 +738,51 @@ implementation
       end;
 
 
+    Function SimpleGetNextInstruction(Current: tai; Var Next: tai): Boolean;
+      Begin
+        Current:=tai(Current.Next);
+        While Assigned(Current) And (Current.typ In SkipInstr) Do
+          Current:=tai(Current.Next);
+        Next:=Current;
+        If Assigned(Next) And Not(Next.typ In SkipInstr) Then
+           Result:=True
+          Else
+            Begin
+              Next:=Nil;
+              Result:=False;
+            End;
+      End;
+
+
+(*
+    function armconstequal(hp1,hp2: tai): boolean;
+      begin
+        result:=false;
+        if hp1.typ<>hp2.typ then
+          exit;
+        case hp1.typ of
+          tai_const:
+            result:=
+              (tai_const(hp2).sym=tai_const(hp).sym) and
+              (tai_const(hp2).value=tai_const(hp).value) and
+              (tai(hp2.previous).typ=ait_label);
+            tai_const:
+              result:=
+                (tai_const(hp2).sym=tai_const(hp).sym) and
+                (tai_const(hp2).value=tai_const(hp).value) and
+                (tai(hp2.previous).typ=ait_label);
+        end;
+      end;
+*)
+
     procedure insertpcrelativedata(list,listtoinsert : TAsmList);
       var
-        curpos,
+        curinspos,
         penalty,
-        lastpos : longint;
+        lastinspos,
+        { increased for every data element > 4 bytes inserted }
+        extradataoffset,
+        limit: longint;
         curop : longint;
         curtai : tai;
         curdatatai,hp,hp2 : tai;
@@ -647,81 +792,120 @@ implementation
         removeref : boolean;
       begin
         curdata:=TAsmList.create;
-        lastpos:=-1;
-        curpos:=0;
+        lastinspos:=-1;
+        curinspos:=0;
+        extradataoffset:=0;
+        limit:=1016;
         curtai:=tai(list.first);
         doinsert:=false;
         while assigned(curtai) do
           begin
             { instruction? }
-            if curtai.typ=ait_instruction then
-              begin
-                { walk through all operand of the instruction }
-                for curop:=0 to taicpu(curtai).ops-1 do
-                  begin
-                    { reference? }
-                    if (taicpu(curtai).oper[curop]^.typ=top_ref) then
-                      begin
-                        { pc relative symbol? }
-                        curdatatai:=tai(taicpu(curtai).oper[curop]^.ref^.symboldata);
-                        if assigned(curdatatai) and
-                          { move only if we're at the first reference of a label }
-                          (taicpu(curtai).oper[curop]^.ref^.offset=0) then
-                          begin
-                            { check if symbol already used. }
-                            { if yes, reuse the symbol }
-                            hp:=tai(curdatatai.next);
-                            removeref:=false;
-                            if assigned(hp) and (hp.typ=ait_const) then
-                              begin
-                                hp2:=tai(curdata.first);
-                                while assigned(hp2) do
-                                  begin
-                                    if (hp2.typ=ait_const) and (tai_const(hp2).sym=tai_const(hp).sym)
-                                      and (tai_const(hp2).value=tai_const(hp).value) and (tai(hp2.previous).typ=ait_label)
-                                    then
+            case curtai.typ of
+              ait_instruction:
+                begin
+                  { walk through all operand of the instruction }
+                  for curop:=0 to taicpu(curtai).ops-1 do
+                    begin
+                      { reference? }
+                      if (taicpu(curtai).oper[curop]^.typ=top_ref) then
+                        begin
+                          { pc relative symbol? }
+                          curdatatai:=tai(taicpu(curtai).oper[curop]^.ref^.symboldata);
+                          if assigned(curdatatai) and
+                            { move only if we're at the first reference of a label }
+                            (taicpu(curtai).oper[curop]^.ref^.offset=0) then
+                            begin
+                              { check if symbol already used. }
+                              { if yes, reuse the symbol }
+                              hp:=tai(curdatatai.next);
+                              removeref:=false;
+                              if assigned(hp) then
+                                begin
+                                  case hp.typ of
+                                    ait_const:
+                                      begin
+                                        if (tai_const(hp).consttype=aitconst_64bit) then
+                                          inc(extradataoffset);
+                                      end;
+                                    ait_comp_64bit,
+                                    ait_real_64bit:
+                                      begin
+                                        inc(extradataoffset);
+                                      end;
+                                    ait_real_80bit:
                                       begin
-                                        with taicpu(curtai).oper[curop]^.ref^ do
-                                          begin
-                                            symboldata:=hp2.previous;
-                                            symbol:=tai_label(hp2.previous).labsym;
-                                          end;
-                                        removeref:=true;
-                                        break;
+                                        inc(extradataoffset,2);
                                       end;
-                                    hp2:=tai(hp2.next);
                                   end;
-                              end;
-                            { move or remove symbol reference }
-                            repeat
-                              hp:=tai(curdatatai.next);
-                              listtoinsert.remove(curdatatai);
-                              if removeref then
-                                curdatatai.free
-                              else
-                                curdata.concat(curdatatai);
-                              curdatatai:=hp;
-                            until (curdatatai=nil) or (curdatatai.typ=ait_label);
-                            if lastpos=-1 then
-                              lastpos:=curpos;
-                          end;
-                      end;
-                  end;
-                inc(curpos);
-              end
-            else
-              if curtai.typ=ait_const then
-                inc(curpos);
-
+                                  if (hp.typ=ait_const) then
+                                    begin
+                                      hp2:=tai(curdata.first);
+                                      while assigned(hp2) do
+                                        begin
+    {                                      if armconstequal(hp2,hp) then }
+                                          if (hp2.typ=ait_const) and (tai_const(hp2).sym=tai_const(hp).sym)
+                                            and (tai_const(hp2).value=tai_const(hp).value) and (tai(hp2.previous).typ=ait_label)
+                                          then
+                                            begin
+                                              with taicpu(curtai).oper[curop]^.ref^ do
+                                                begin
+                                                  symboldata:=hp2.previous;
+                                                  symbol:=tai_label(hp2.previous).labsym;
+                                                end;
+                                              removeref:=true;
+                                              break;
+                                            end;
+                                          hp2:=tai(hp2.next);
+                                        end;
+                                    end;
+                                end;
+                              { move or remove symbol reference }
+                              repeat
+                                hp:=tai(curdatatai.next);
+                                listtoinsert.remove(curdatatai);
+                                if removeref then
+                                  curdatatai.free
+                                else
+                                  curdata.concat(curdatatai);
+                                curdatatai:=hp;
+                              until (curdatatai=nil) or (curdatatai.typ=ait_label);
+                              if lastinspos=-1 then
+                                lastinspos:=curinspos;
+                            end;
+                        end;
+                    end;
+                  inc(curinspos);
+                end;
+              ait_const:
+                begin
+                  inc(curinspos);
+                  if (tai_const(curtai).consttype=aitconst_64bit) then
+                    inc(curinspos);
+                end;
+              ait_real_32bit:
+                begin
+                  inc(curinspos);
+                end;
+              ait_comp_64bit,
+              ait_real_64bit:
+                begin
+                  inc(curinspos,2);
+                end;
+              ait_real_80bit:
+                begin
+                  inc(curinspos,3);
+                end;
+            end;
             { special case for case jump tables }
-            if assigned(curtai.next) and
-              (taicpu(curtai.next).typ=ait_instruction) and
-              (taicpu(curtai.next).opcode=A_LDR) and
-              (taicpu(curtai.next).oper[0]^.typ=top_reg) and
-              (taicpu(curtai.next).oper[0]^.reg=NR_PC) then
+            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
               begin
                 penalty:=1;
-                hp:=tai(curtai.next.next);
+                hp:=tai(hp.next);
                 while assigned(hp) and (hp.typ=ait_const) do
                   begin
                     inc(penalty);
@@ -731,8 +915,16 @@ implementation
             else
               penalty:=0;
 
+            { 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;
+
             { don't miss an insert }
-            doinsert:=doinsert or (curpos-lastpos+penalty>1016);
+            doinsert:=doinsert or
+              (curinspos-lastinspos+penalty+extradataoffset>limit);
 
             { split only at real instructions else the test below fails }
             if doinsert and (curtai.typ=ait_instruction) and
@@ -747,7 +939,9 @@ implementation
                    )
               ) then
               begin
-                lastpos:=curpos;
+                lastinspos:=curinspos;
+                extradataoffset:=0;
+                limit:=1016;
                 doinsert:=false;
                 hp:=tai(curtai.next);
                 current_asmdata.getjumplabel(l);
@@ -2499,6 +2693,12 @@ static char *CC[] =
 *)
 {$endif dummy}
 
+  constructor tai_thumb_func.create;
+    begin
+      inherited create;
+      typ:=ait_thumb_func;
+    end;
+
 begin
   cai_align:=tai_align;
 end.

compiler/arm/agarmgas.pas

@@ -38,15 +38,16 @@ unit agarmgas;
       TARMGNUAssembler=class(TGNUassembler)
         constructor create(smart: boolean); override;
         function MakeCmdLine: TCmdStr; override;
+        procedure WriteExtraHeader; override;
       end;
 
-     TArmInstrWriter=class(TCPUInstrWriter)
+      TArmInstrWriter=class(TCPUInstrWriter)
         procedure WriteInstruction(hp : tai);override;
-     end;
+      end;
 
-    TArmAppleGNUAssembler=class(TAppleGNUassembler)
-      constructor create(smart: boolean); override;
-    end;
+      TArmAppleGNUAssembler=class(TAppleGNUassembler)
+        constructor create(smart: boolean); override;
+      end;
 
 
     const
@@ -79,10 +80,22 @@ unit agarmgas;
         result:=inherited MakeCmdLine;
         if (current_settings.fputype = fpu_soft) then
           result:='-mfpu=softvfp '+result;
+
+        if current_settings.cputype = cpu_cortexm3 then
+          result:='-mcpu=cortex-m3 -mthumb -mthumb-interwork '+result;
+        if current_settings.cputype = cpu_armv7m then
+          result:='-march=armv7m -mthumb -mthumb-interwork '+result;
+      end;
+
+    procedure TArmGNUAssembler.WriteExtraHeader;
+      begin
+        inherited WriteExtraHeader;
+        if current_settings.cputype in cpu_thumb2 then
+          AsmWriteLn(#9'.syntax unified');
       end;
 
 {****************************************************************************}
-{                      GNU/Apple PPC Assembler writer                        }
+{                      GNU/Apple ARM Assembler writer                        }
 {****************************************************************************}
 
     constructor TArmAppleGNUAssembler.create(smart: boolean);
@@ -184,11 +197,13 @@ unit agarmgas;
                   begin
                     if not(first) then
                       getopstr:=getopstr+',';
-                    getopstr:=getopstr+gas_regname(newreg(R_INTREGISTER,r,R_SUBWHOLE));
+                    getopstr:=getopstr+gas_regname(newreg(o.regtyp,r,o.subreg));
                     first:=false;
                   end;
               getopstr:=getopstr+'}';
             end;
+          top_conditioncode:
+            getopstr:=cond2str[o.cc];
           top_ref:
             if o.ref^.refaddr=addr_full then
               begin
@@ -215,7 +230,15 @@ unit agarmgas;
         sep: string[3];
     begin
       op:=taicpu(hp).opcode;
-      s:=#9+gas_op2str[op]+cond2str[taicpu(hp).condition]+oppostfix2str[taicpu(hp).oppostfix];
+      if current_settings.cputype in cpu_thumb2 then
+        begin
+          if taicpu(hp).ops = 0 then
+            s:=#9+gas_op2str[op]+' '+cond2str[taicpu(hp).condition]+oppostfix2str[taicpu(hp).oppostfix]
+          else
+            s:=#9+gas_op2str[op]+oppostfix2str[taicpu(hp).oppostfix]+cond2str[taicpu(hp).condition]; // Conditional infixes are deprecated in unified syntax
+        end
+      else
+        s:=#9+gas_op2str[op]+cond2str[taicpu(hp).condition]+oppostfix2str[taicpu(hp).oppostfix];
       if taicpu(hp).ops<>0 then
         begin
           sep:=#9;
@@ -226,7 +249,7 @@ unit agarmgas;
                // writeln(taicpu(hp).fileinfo.line);
 
                { LDM and STM use references as first operand but they are written like a register }
-               if (i=0) and (op in [A_LDM,A_STM]) then
+               if (i=0) and (op in [A_LDM,A_STM,A_FSTM,A_FLDM]) then
                  begin
                    case taicpu(hp).oper[0]^.typ of
                      top_ref:
@@ -269,7 +292,7 @@ unit agarmgas;
             idtxt  : 'AS';
             asmbin : 'as';
             asmcmd : '-o $OBJ $ASM';
-            supported_target : system_any;
+            supported_targets : [system_arm_linux,system_arm_wince,system_arm_gba,system_arm_palmos,system_arm_nds,system_arm_embedded,system_arm_symbian];
             flags : [af_allowdirect,af_needar,af_smartlink_sections];
             labelprefix : '.L';
             comment : '# ';
@@ -280,9 +303,9 @@ unit agarmgas;
             id     : as_darwin;
             idtxt  : 'AS-Darwin';
             asmbin : 'as';
-            asmcmd : '-o $OBJ $ASM -arch arm';
-            supported_target : system_any;
-            flags : [af_allowdirect,af_needar,af_smartlink_sections,af_supports_dwarf];
+            asmcmd : '-o $OBJ $ASM -arch $ARCH';
+            supported_targets : [system_arm_darwin];
+            flags : [af_allowdirect,af_needar,af_smartlink_sections,af_supports_dwarf,af_stabs_use_function_absolute_addresses];
             labelprefix : 'L';
             comment : '# ';
           );

compiler/arm/aoptcpu.pas

@@ -36,6 +36,12 @@ Type
     function PeepHoleOptPass1Cpu(var p: tai): boolean; override;
     procedure PeepHoleOptPass2;override;
   End;
+  
+  
+  TCpuThumb2AsmOptimizer = class(TCpuAsmOptimizer)
+    { uses the same constructor as TAopObj }
+    procedure PeepHoleOptPass2;override;
+  End;
 
 Implementation
 
@@ -74,6 +80,7 @@ Implementation
                      getnextinstruction(p,next1) and
                      (next1.typ = ait_instruction) and
                      (taicpu(next1).opcode = A_MOV) and
+                     (taicpu(p).condition=taicpu(next1).condition) and
                      (taicpu(next1).ops=3) and
                      (taicpu(next1).oper[0]^.typ = top_reg) and
                      (taicpu(p).oper[0]^.reg=taicpu(next1).oper[0]^.reg) and
@@ -107,6 +114,35 @@ Implementation
                       result := true;
                     end;
                 end;
+              A_AND:
+                begin
+                  {
+                    change
+                    and reg2,reg1,const1
+                    and reg2,reg2,const2
+                    to
+                    and reg2,reg1,(const1 and const2)
+                  }
+                  if (taicpu(p).oper[0]^.typ = top_reg) and
+                     (taicpu(p).oper[1]^.typ = top_reg) and
+                     (taicpu(p).oper[2]^.typ = top_const) and
+                     GetNextInstruction(p, hp1) and
+                     (tai(hp1).typ = ait_instruction) and
+                     (taicpu(hp1).opcode = A_AND) and
+                     (taicpu(p).condition=taicpu(hp1).condition) and
+                     (taicpu(p).oppostfix=PF_None) and
+                     (taicpu(hp1).oper[0]^.typ = top_reg) and
+                     (taicpu(hp1).oper[1]^.typ = top_reg) and
+                     (taicpu(hp1).oper[2]^.typ = top_const) and
+                     (taicpu(p).oper[0]^.reg = taicpu(hp1).oper[0]^.reg) and
+                     (taicpu(hp1).oper[0]^.reg = taicpu(hp1).oper[1]^.reg) then
+                    begin
+                      taicpu(p).loadConst(2,taicpu(p).oper[2]^.val and taicpu(hp1).oper[2]^.val);
+                      taicpu(p).oppostfix:=taicpu(hp1).oppostfix;
+                      asml.remove(hp1);
+                      hp1.free;
+                    end;
+                end;
             end;
           end;
       end;
@@ -292,6 +328,12 @@ Implementation
         end;
     end;
 
+
+  procedure TCpuThumb2AsmOptimizer.PeepHoleOptPass2;
+    begin
+      { TODO: Add optimizer code }
+    end;
+
 begin
   casmoptimizer:=TCpuAsmOptimizer;
 End.

compiler/arm/armatt.inc

@@ -47,11 +47,14 @@
 'mcr',
 'mla',
 'mov',
+'mrs',
+'msr',
 'mnf',
 'muf',
 'mul',
 'mvf',
 'mvn',
+'nop',
 'orr',
 'rdf',
 'rfs',
@@ -131,9 +134,7 @@
 'fdivd',
 'fdivs',
 'fldd',
-'fldmd',
-'fldms',
-'fldmx',
+'fldm',
 'flds',
 'fmacd',
 'fmacs',
@@ -163,9 +164,7 @@
 'fsqrtd',
 'fsqrts',
 'fstd',
-'fstmd',
-'fstms',
-'fstmx',
+'fstm',
 'fsts',
 'fsubd',
 'fsubs',
@@ -174,5 +173,31 @@
 'ftouid',
 'ftouis',
 'fuitod',
-'fuitos'
+'fuitos',
+'fmdrr',
+'fmrrd',
+'asr',
+'lsr',
+'lsl',
+'ror',
+'sdiv',
+'udiv',
+'movt',
+'ldrex',
+'strex',
+'it',
+'ite',
+'itt',
+'itee',
+'itte',
+'itet',
+'ittt',
+'iteee',
+'ittee',
+'itete',
+'ittte',
+'iteet',
+'ittet',
+'itett',
+'itttt'
 );

compiler/arm/armatts.inc

@@ -174,5 +174,30 @@ 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
 );

compiler/arm/armins.dat

@@ -246,13 +246,13 @@ reg32,reg32,reg32,reg32  \x15\x00\x20\x90               ARM7
 ; [MRC]
 ; reg32,reg32         \321\301\1\x13\110                  ARM7
 
-; [MRScc]
-; reg32,reg32         \x10\x01\x0F                        ARM7
+[MRScc]
+reg32,reg32         \x10\x01\x0F                        ARM7
 
-; [MSRcc]
-; reg32,reg32         \x11\x01\x29\xF0                    ARM7
-; regf,reg32          \x12\x01\x28\xF0                    ARM7
-; regf,imm            \x13\x03\x28\xF0                    ARM7
+[MSRcc]
+reg32,reg32         \x11\x01\x29\xF0                    ARM7
+regf,reg32          \x12\x01\x28\xF0                    ARM7
+regf,imm            \x13\x03\x28\xF0                    ARM7
 
 [MNFcc]
 
@@ -271,6 +271,8 @@ fpureg,immfpu              \xF2                      FPA
 ; reg32,reg32,imm     \xA\x1\xE0                     ARM7
 ; reg32,imm           \xB\x3\xE0                     ARM7
 
+[NOP]
+
 [ORRcc]
 reg32,reg32,reg32        \4\x1\x80                     ARM7
 reg32,reg32,reg32,reg32  \5\x1\x80                     ARM7
@@ -484,11 +486,7 @@ reg32,reg32,reg32,reg32  \x16\x00\x80\x90		 ARM7
 
 [FLDDcc]
 
-[FLDMDcc]
-
-[FLDMScc]
-
-[FLDMXcc]
+[FLDMcc]
 
 [FLDScc]
 
@@ -548,11 +546,7 @@ reg32,reg32,reg32,reg32  \x16\x00\x80\x90		 ARM7
 
 [FSTDcc]
 
-[FSTMDcc]
-
-[FSTMScc]
-
-[FSTMXcc]
+[FSTMcc]
 
 [FSTScc]
 
@@ -571,3 +565,57 @@ reg32,reg32,reg32,reg32  \x16\x00\x80\x90		 ARM7
 [FUITODcc]
 
 [FUITOScc]
+
+[FMDRRcc]
+
+[FMRRDcc]
+
+; Thumb-2
+
+[ASRcc]
+
+[LSRcc]
+
+[LSLcc]
+
+[RORcc]
+
+[SDIVcc]
+
+[UDIVcc]
+
+[MOVTcc]
+
+[LDREXcc]
+
+[STREXcc]
+
+[IT]
+
+[ITE]
+
+[ITT]
+
+[ITEE]
+
+[ITTE]
+
+[ITET]
+
+[ITTT]
+
+[ITEEE]
+
+[ITTEE]
+
+[ITETE]
+
+[ITTTE]
+
+[ITEET]
+
+[ITTET]
+
+[ITETT]
+
+[ITTTT]

compiler/arm/armnop.inc

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

compiler/arm/armop.inc

@@ -47,11 +47,14 @@ A_LOG,
 A_MCR,
 A_MLA,
 A_MOV,
+A_MRS,
+A_MSR,
 A_MNF,
 A_MUF,
 A_MUL,
 A_MVF,
 A_MVN,
+A_NOP,
 A_ORR,
 A_RDF,
 A_RFS,
@@ -131,9 +134,7 @@ A_FCVTSD,
 A_FDIVD,
 A_FDIVS,
 A_FLDD,
-A_FLDMD,
-A_FLDMS,
-A_FLDMX,
+A_FLDM,
 A_FLDS,
 A_FMACD,
 A_FMACS,
@@ -163,9 +164,7 @@ A_FSITOS,
 A_FSQRTD,
 A_FSQRTS,
 A_FSTD,
-A_FSTMD,
-A_FSTMS,
-A_FSTMX,
+A_FSTM,
 A_FSTS,
 A_FSUBD,
 A_FSUBS,
@@ -174,5 +173,31 @@ A_FTOSIS,
 A_FTOUID,
 A_FTOUIS,
 A_FUITOD,
-A_FUITOS
+A_FUITOS,
+A_FMDRR,
+A_FMRRD,
+A_ASR,
+A_LSR,
+A_LSL,
+A_ROR,
+A_SDIV,
+A_UDIV,
+A_MOVT,
+A_LDREX,
+A_STREX,
+A_IT,
+A_ITE,
+A_ITT,
+A_ITEE,
+A_ITTE,
+A_ITET,
+A_ITTT,
+A_ITEEE,
+A_ITTEE,
+A_ITETE,
+A_ITTTE,
+A_ITEET,
+A_ITTET,
+A_ITETT,
+A_ITTTT
 );

compiler/arm/armreg.dat

@@ -2,83 +2,107 @@
 ; ARM registers
 ;
 ; layout
-; <name>,<type>,<value>,<stdname>,<stab idx>,<dwarf idx>
+; <name>,<type>,<subtype>,<value>,<stdname>,<stab idx>,<dwarf idx>
 ;
-NO,$00,$00,INVALID,-1,-1
+NO,$00,$00,$00,INVALID,-1,-1
 ; Integer registers
-R0,$01,$00,r0,0,0
-R1,$01,$01,r1,1,1
-R2,$01,$02,r2,2,2
-R3,$01,$03,r3,3,3
-R4,$01,$04,r4,4,4
-R5,$01,$05,r5,5,5
-R6,$01,$06,r6,6,6
-R7,$01,$07,r7,7,7
-R8,$01,$08,r8,8,8
-R9,$01,$09,r9,9,9
-R10,$01,$0a,r10,10,10
-R11,$01,$0b,r11,11,11
-R12,$01,$0c,r12,12,12
-R13,$01,$0d,r13,13,13
-R14,$01,$0e,r14,14,14
-R15,$01,$0f,r15,15,15
+R0,$01,$00,$00,r0,0,0
+R1,$01,$00,$01,r1,1,1
+R2,$01,$00,$02,r2,2,2
+R3,$01,$00,$03,r3,3,3
+R4,$01,$00,$04,r4,4,4
+R5,$01,$00,$05,r5,5,5
+R6,$01,$00,$06,r6,6,6
+R7,$01,$00,$07,r7,7,7
+R8,$01,$00,$08,r8,8,8
+R9,$01,$00,$09,r9,9,9
+R10,$01,$00,$0a,r10,10,10
+R11,$01,$00,$0b,r11,11,11
+R12,$01,$00,$0c,r12,12,12
+R13,$01,$00,$0d,r13,13,13
+R14,$01,$00,$0e,r14,14,14
+R15,$01,$00,$0f,r15,15,15
 
 ; Float registers
-F0,$02,$00,f0,32,16
-F1,$02,$01,f1,32,17
-F2,$02,$02,f2,32,18
-F3,$02,$03,f3,32,19
-F4,$02,$04,f4,32,20
-F5,$02,$05,f5,32,21
-F6,$02,$06,f6,32,22
-F7,$02,$07,f7,32,23
+F0,$02,$00,$00,f0,32,16
+F1,$02,$00,$01,f1,32,17
+F2,$02,$00,$02,f2,32,18
+F3,$02,$00,$03,f3,32,19
+F4,$02,$00,$04,f4,32,20
+F5,$02,$00,$05,f5,32,21
+F6,$02,$00,$06,f6,32,22
+F7,$02,$00,$07,f7,32,23
 
 ; MM registers
-S0,$03,$00,s0,0,0
-S1,$03,$00,s1,0,0
-D0,$03,$00,d0,0,0
-S2,$03,$00,s2,0,0
-S3,$03,$00,s3,0,0
-D1,$03,$00,d1,0,0
-S4,$03,$00,s4,0,0
-S5,$03,$00,s5,0,0
-D2,$03,$00,d2,0,0
-S6,$03,$00,s6,0,0
-S7,$03,$00,s7,0,0
-D3,$03,$00,d3,0,0
-S8,$03,$00,s8,0,0
-S9,$03,$00,s9,0,0
-D4,$03,$00,d4,0,0
-S10,$03,$00,s10,0,0
-S11,$03,$00,s11,0,0
-D5,$03,$00,d5,0,0
-S12,$03,$00,s12,0,0
-S13,$03,$00,s13,0,0
-D6,$03,$00,d6,0,0
-S14,$03,$00,s14,0,0
-S15,$03,$00,s15,0,0
-D7,$03,$00,d7,0,0
-S16,$03,$00,s16,0,0
-S17,$03,$00,s17,0,0
-D8,$03,$00,d8,0,0
-S18,$03,$00,s18,0,0
-S19,$03,$00,s19,0,0
-D9,$03,$00,d9,0,0
-S20,$03,$00,s20,0,0
-S21,$03,$00,s21,0,0
-D10,$03,$00,d10,0,0
-S22,$03,$00,s22,0,0
-S23,$03,$00,s23,0,0
-D11,$03,$00,d11,0,0
-S24,$03,$00,s24,0,0
-S25,$03,$00,s25,0,0
-D12,$03,$00,d12,0,0
-S26,$03,$00,s26,0,0
-S27,$03,$00,s27,0,0
-D13,$03,$00,d13,0,0
-S28,$03,$00,s28,0,0
-S29,$03,$00,s29,0,0
-D14,$03,$00,d14,0,0
-S30,$03,$00,s20,0,0
-S31,$03,$00,s21,0,0
-D15,$03,$00,d15,0,0
+; S0/S1/D0 etc have the same register number because the register allocated
+; cannot deal with D0 conflicting with both S0 and S1. This unfortunately
+; means that we can only use 16 single precision registers instead of 32,
+; even if no double precision ones are used...
+S0,$04,$06,$00,s0,0,0
+S1,$04,$06,$00,s1,0,0
+D0,$04,$07,$00,d0,0,0
+S2,$04,$06,$01,s2,0,0
+S3,$04,$06,$01,s3,0,0
+D1,$04,$07,$01,d1,0,0
+S4,$04,$06,$02,s4,0,0
+S5,$04,$06,$02,s5,0,0
+D2,$04,$07,$02,d2,0,0
+S6,$04,$06,$03,s6,0,0
+S7,$04,$06,$03,s7,0,0
+D3,$04,$07,$03,d3,0,0
+S8,$04,$06,$04,s8,0,0
+S9,$04,$06,$04,s9,0,0
+D4,$04,$07,$04,d4,0,0
+S10,$04,$06,$05,s10,0,0
+S11,$04,$06,$05,s11,0,0
+D5,$04,$07,$05,d5,0,0
+S12,$04,$06,$06,s12,0,0
+S13,$04,$06,$06,s13,0,0
+D6,$04,$07,$06,d6,0,0
+S14,$04,$06,$07,s14,0,0
+S15,$04,$06,$07,s15,0,0
+D7,$04,$07,$07,d7,0,0
+S16,$04,$06,$08,s16,0,0
+S17,$04,$06,$08,s17,0,0
+D8,$04,$07,$08,d8,0,0
+S18,$04,$06,$09,s18,0,0
+S19,$04,$06,$09,s19,0,0
+D9,$04,$07,$09,d9,0,0
+S20,$04,$06,$0A,s20,0,0
+S21,$04,$06,$0A,s21,0,0
+D10,$04,$07,$0A,d10,0,0
+S22,$04,$06,$0B,s22,0,0
+S23,$04,$06,$0B,s23,0,0
+D11,$04,$07,$0B,d11,0,0
+S24,$04,$06,$0C,s24,0,0
+S25,$04,$06,$0C,s25,0,0
+D12,$04,$07,$0C,d12,0,0
+S26,$04,$06,$0D,s26,0,0
+S27,$04,$06,$0D,s27,0,0
+D13,$04,$07,$0D,d13,0,0
+S28,$04,$06,$0E,s28,0,0
+S29,$04,$06,$0E,s29,0,0
+D14,$04,$07,$0E,d14,0,0
+S30,$04,$06,$0F,s20,0,0
+S31,$04,$06,$0F,s21,0,0
+D15,$04,$07,$0F,d15,0,0
+D16,$04,$07,$10,d16,0,0
+D17,$04,$07,$11,d17,0,0
+D18,$04,$07,$12,d18,0,0
+D19,$04,$07,$13,d19,0,0
+D20,$04,$07,$14,d20,0,0
+D21,$04,$07,$15,d21,0,0
+D22,$04,$07,$16,d22,0,0
+D23,$04,$07,$17,d23,0,0
+D24,$04,$07,$18,d24,0,0
+D25,$04,$07,$19,d25,0,0
+D26,$04,$07,$1A,d26,0,0
+D27,$04,$07,$1B,d27,0,0
+D28,$04,$07,$1C,d28,0,0
+D29,$04,$07,$1D,d29,0,0
+D30,$04,$07,$1E,d30,0,0
+D31,$04,$07,$1F,d31,0,0
+
+; special registers
+CPSR_C,$05,$00,$00,cpsr_c,0,0
+FPSCR,$05,$00,$01,fpscr,0,0

compiler/arm/armtab.inc

@@ -399,6 +399,34 @@
     code    : #21#0#32#144;
     flags   : if_arm7
   ),
+  (
+    opcode  : A_MRS;
+    ops     : 2;
+    optypes : (ot_reg32,ot_reg32,ot_none,ot_none);
+    code    : #16#1#15;
+    flags   : if_arm7
+  ),
+  (
+    opcode  : A_MSR;
+    ops     : 2;
+    optypes : (ot_reg32,ot_reg32,ot_none,ot_none);
+    code    : #17#1#41#240;
+    flags   : if_arm7
+  ),
+  (
+    opcode  : A_MSR;
+    ops     : 2;
+    optypes : (ot_regf,ot_reg32,ot_none,ot_none);
+    code    : #18#1#40#240;
+    flags   : if_arm7
+  ),
+  (
+    opcode  : A_MSR;
+    ops     : 2;
+    optypes : (ot_regf,ot_immediate,ot_none,ot_none);
+    code    : #19#3#40#240;
+    flags   : if_arm7
+  ),
   (
     opcode  : A_MUL;
     ops     : 3;

compiler/arm/cpubase.pas

@@ -104,8 +104,11 @@ unit cpubase;
         {$i rarmdwa.inc}
       );
       { registers which may be destroyed by calls }
-      VOLATILE_INTREGISTERS = [RS_R0..RS_R3,RS_R12..RS_R15];
+      VOLATILE_INTREGISTERS = [RS_R0..RS_R3,RS_R12..RS_R14];
       VOLATILE_FPUREGISTERS = [RS_F0..RS_F3];
+      VOLATILE_MMREGISTERS =  [RS_D0..RS_D7,RS_D16..RS_D31];
+
+      VOLATILE_INTREGISTERS_DARWIN = [RS_R0..RS_R3,RS_R9,RS_R12..RS_R14];
 
     type
       totherregisterset = set of tregisterindex;
@@ -127,7 +130,11 @@ unit cpubase;
         { load/store }
         PF_B,PF_SB,PF_BT,PF_H,PF_SH,PF_T,
         { multiple load/store address modes }
-        PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA
+        PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA,
+        { multiple load/store vfp address modes }
+        PF_IAD,PF_DBD,PF_FDD,PF_EAD,
+        PF_IAS,PF_DBS,PF_FDS,PF_EAS,
+        PF_IAX,PF_DBX,PF_FDX,PF_EAX
       );
 
       TRoundingMode = (RM_None,RM_P,RM_M,RM_Z);
@@ -138,11 +145,14 @@ unit cpubase;
         PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,
         PF_S,PF_D,PF_E,PF_None,PF_None);
 
-      oppostfix2str : array[TOpPostfix] of string[2] = ('',
+      oppostfix2str : array[TOpPostfix] of string[3] = ('',
         's',
         'd','e','p','ep',
         'b','sb','bt','h','sh','t',
-        'ia','ib','da','db','fd','fa','ed','ea');
+        'ia','ib','da','db','fd','fa','ed','ea',
+        'iad','dbd','fdd','ead',
+        'ias','dbs','fds','eas',
+        'iax','dbx','fdx','eax');
 
       roundingmode2str : array[TRoundingMode] of string[1] = ('',
         'p','m','z');
@@ -354,7 +364,7 @@ unit cpubase;
 
     { Returns the tcgsize corresponding with the size of reg.}
     function reg_cgsize(const reg: tregister) : tcgsize;
-    function cgsize2subreg(s:Tcgsize):Tsubregister;
+    function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister;
     function is_calljmp(o:tasmop):boolean;
     procedure inverse_flags(var f: TResFlags);
     function flags_to_cond(const f: TResFlags) : TAsmCond;
@@ -391,9 +401,23 @@ unit cpubase;
       );
 
 
-    function cgsize2subreg(s:Tcgsize):Tsubregister;
+    function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister;
       begin
-        cgsize2subreg:=R_SUBWHOLE;
+        case regtype of
+          R_MMREGISTER:
+            begin
+              case s of
+                OS_F32:
+                  cgsize2subreg:=R_SUBFS;
+                OS_F64:
+                  cgsize2subreg:=R_SUBFD;
+                else
+                  internalerror(2009112701);
+              end;
+            end;
+          else
+            cgsize2subreg:=R_SUBWHOLE;
+        end;
       end;
 
 
@@ -404,6 +428,18 @@ unit cpubase;
             reg_cgsize:=OS_32;
           R_FPUREGISTER :
             reg_cgsize:=OS_F80;
+          R_MMREGISTER :
+            begin
+              case getsubreg(reg) of
+                R_SUBFD,
+                R_SUBWHOLE:
+                  result:=OS_F64;
+                R_SUBFS:
+                  result:=OS_F32;
+                else
+                  internalerror(2009112903);
+              end;
+            end;
           else
             internalerror(200303181);
           end;
@@ -503,16 +539,31 @@ unit cpubase;
       var
          i : longint;
       begin
-         for i:=0 to 15 do
-           begin
-              if (dword(d) and not(rotl($ff,i*2)))=0 then
-                begin
-                   imm_shift:=i*2;
-                   result:=true;
-                   exit;
-                end;
-           end;
-         result:=false;
+        if current_settings.cputype in cpu_thumb2 then
+          begin
+            for i:=0 to 24 do
+              begin
+                 if (dword(d) and not($ff shl i))=0 then
+                   begin
+                     imm_shift:=i;
+                     result:=true;
+                     exit;
+                   end;
+              end;
+          end
+        else
+          begin
+            for i:=0 to 15 do
+              begin
+                 if (dword(d) and not(rotl($ff,i*2)))=0 then
+                   begin
+                      imm_shift:=i*2;
+                      result:=true;
+                      exit;
+                   end;
+              end;
+          end;
+        result:=false;
       end;
 
 

compiler/arm/cpuinfo.pas

@@ -34,9 +34,18 @@ Type
       (cpu_none,
        cpu_armv3,
        cpu_armv4,
-       cpu_armv5
+       cpu_armv5,
+       cpu_armv6,
+       cpu_armv7m,
+       cpu_cortexm3
       );
 
+Const
+   cpu_arm = [cpu_none,cpu_armv3,cpu_armv4,cpu_armv5];
+   cpu_thumb = [];
+   cpu_thumb2 = [cpu_armv7m,cpu_cortexm3];
+
+Type
    tfputype =
      (fpu_none,
       fpu_soft,
@@ -44,7 +53,26 @@ Type
       fpu_fpa,
       fpu_fpa10,
       fpu_fpa11,
-      fpu_vfp
+      fpu_vfpv2,
+      fpu_vfpv3
+     );
+
+   tcontrollertype =
+     (ct_none,
+
+      { Phillips }
+      ct_lpc2114,
+      ct_lpc2124,
+      ct_lpc2194,
+
+      { ATMEL }
+      ct_at91sam7s256,
+      ct_at91sam7se256,
+      ct_at91sam7x256,
+      ct_at91sam7xc256,
+		
+      { STMicroelectronics }
+      ct_stm32f103re
      );
 
 Const
@@ -65,13 +93,19 @@ Const
      { same as stdcall only different name mangling }
      pocall_cppdecl,
      { same as stdcall but floating point numbers are handled like equal sized integers }
-     pocall_softfloat
+     pocall_softfloat,
+     { same as stdcall (requires that all const records are passed by
+       reference, but that's already done for stdcall) }
+     pocall_mwpascal
    ];
 
-   cputypestr : array[tcputype] of string[5] = ('',
+   cputypestr : array[tcputype] of string[8] = ('',
      'ARMV3',
      'ARMV4',
-     'ARMV5'
+     'ARMV5',
+     'ARMV6',
+     'ARMV7M',
+     'CORTEXM3'
    );
 
    fputypestr : array[tfputype] of string[6] = ('',
@@ -80,19 +114,48 @@ Const
      'FPA',
      'FPA10',
      'FPA11',
-     'VFP'
+     'VFPV2',
+     'VFPV3'
    );
 
+   controllertypestr : array[tcontrollertype] of string[20] =
+     ('',
+      'LPC2114',
+      'LPC2124',
+      'LPC2194',
+      'AT91SAM7S256',
+      'AT91SAM7SE256',
+      'AT91SAM7X256',
+      'AT91SAM7XC256',
+      'STM32F103RE'
+     );
+
+   controllerunitstr : array[tcontrollertype] of string[20] =
+     ('',
+      'LPC21x4',
+      'LPC21x4',
+      'LPC21x4',
+      'AT91SAM7x256',
+      'AT91SAM7x256',
+      'AT91SAM7x256',
+      'AT91SAM7x256',
+      'STM32F103'
+     );
+
+   vfp_scalar = [fpu_vfpv2,fpu_vfpv3];
+
    { Supported optimizations, only used for information }
    supported_optimizerswitches = genericlevel1optimizerswitches+
                                  genericlevel2optimizerswitches+
                                  genericlevel3optimizerswitches-
                                  { no need to write info about those }
                                  [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
-                                 [cs_opt_regvar,cs_opt_loopunroll,cs_opt_tailrecursion,cs_opt_stackframe];
+                                 [cs_opt_regvar,cs_opt_loopunroll,cs_opt_tailrecursion,
+								  cs_opt_stackframe,cs_opt_nodecse];
 
    level1optimizerswitches = genericlevel1optimizerswitches;
-   level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + [cs_opt_regvar,cs_opt_stackframe,cs_opt_tailrecursion];
+   level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + 
+     [cs_opt_regvar,cs_opt_stackframe,cs_opt_tailrecursion,cs_opt_nodecse];
    level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}];
 
 Implementation

compiler/arm/cpunode.pas

@@ -29,7 +29,7 @@ unit cpunode;
 
     uses
        { generic nodes }
-       ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgopt,ncgmat,
+       ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgopt,ncgmat,ncgobjc,
        { to be able to only parts of the generic code,
          the processor specific nodes must be included
          after the generic one (FK)

compiler/arm/cpupara.pas

@@ -29,36 +29,41 @@ unit cpupara;
     uses
        globtype,globals,
        aasmtai,aasmdata,
-       cpuinfo,cpubase,cgbase,
+       cpuinfo,cpubase,cgbase,cgutils,
        symconst,symbase,symtype,symdef,parabase,paramgr;
 
     type
        tarmparamanager = class(tparamanager)
           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;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
           function ret_in_param(def : tdef;calloption : tproccalloption) : boolean;override;
           procedure getintparaloc(calloption : tproccalloption; 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; def: tdef): tcgpara;override;
          private
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
           function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
             var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
+          procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
        end;
 
   implementation
 
     uses
-       verbose,systems,
+       verbose,systems,cutils,
        rgobj,
-       defutil,symsym,
-       cgutils;
+       defutil,symsym;
 
 
     function tarmparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
       begin
-        result:=VOLATILE_INTREGISTERS;
+        if (target_info.system<>system_arm_darwin) then
+          result:=VOLATILE_INTREGISTERS
+        else
+          result:=VOLATILE_INTREGISTERS_DARWIN;
       end;
 
 
@@ -68,6 +73,12 @@ unit cpupara;
       end;
 
 
+    function tarmparamanager.get_volatile_registers_mm(calloption: tproccalloption): tcpuregisterset;
+      begin
+        result:=VOLATILE_MMREGISTERS;
+      end;
+
+
     procedure tarmparamanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);
       var
         paraloc : pcgparalocation;
@@ -108,7 +119,11 @@ unit cpupara;
             orddef:
               getparaloc:=LOC_REGISTER;
             floatdef:
-              if (calloption in [pocall_cdecl,pocall_cppdecl,pocall_softfloat]) or (cs_fp_emulation in current_settings.moduleswitches) then
+              if (calloption in [pocall_cdecl,pocall_cppdecl,pocall_softfloat]) or
+                 (cs_fp_emulation in current_settings.moduleswitches) or
+                 (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3]) then
+                { the ARM eabi also allows passing VFP values via VFP registers,
+                  but at least neither Mac OS X nor Linux seems to do that }
                 getparaloc:=LOC_REGISTER
               else
                 getparaloc:=LOC_FPUREGISTER;
@@ -163,6 +178,8 @@ unit cpupara;
           objectdef:
             result:=is_object(def) and ((varspez=vs_const) or (def.size=0));
           recorddef:
+            { note: should this ever be changed, make sure that const records
+                are always passed by reference for calloption=pocall_mwpascal }
             result:=(varspez=vs_const) or (def.size=0);
           variantdef,
           formaldef:
@@ -184,16 +201,12 @@ unit cpupara;
       begin
         case def.typ of
           recorddef:
-            { this is how gcc 4.0.4 on linux seems to do it, it doesn't look like being
-              ARM ABI standard compliant
-            }
-            result:=not((trecorddef(def).symtable.SymList.count=1) and
-              not(ret_in_param(tabstractvarsym(trecorddef(def).symtable.SymList[0]).vardef,calloption)));
-          {
-          objectdef
-          arraydef:
-            result:=not(def.size in [1,2,4]);
-          }
+            result:=def.size>4;
+          procvardef:
+            if not tprocvardef(def).is_addressonly then
+              result:=true
+            else
+              result:=false
           else
             result:=inherited ret_in_param(def,calloption);
         end;
@@ -222,10 +235,15 @@ unit cpupara;
         paracgsize   : tcgsize;
         paralen : longint;
         i : integer;
+        firstparaloc: boolean;
 
       procedure assignintreg;
         begin
-           if nextintreg<=RS_R3 then
+          { In case of po_delphi_nested_cc, the parent frame pointer
+            is always passed on the stack. }
+           if (nextintreg<=RS_R3) and
+              (not(vo_is_parentfp in hp.varoptions) or
+               not(po_delphi_nested_cc in p.procoptions)) then
              begin
                paraloc^.loc:=LOC_REGISTER;
                paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
@@ -304,6 +322,7 @@ unit cpupara;
              hp.paraloc[side].size:=paracgsize;
              hp.paraloc[side].Alignment:=std_param_align;
              hp.paraloc[side].intsize:=paralen;
+             firstparaloc:=true;
 
 {$ifdef EXTDEBUG}
              if paralen=0 then
@@ -331,11 +350,14 @@ unit cpupara;
                       begin
                         { align registers for eabi }
                         if (target_info.abi=abi_eabi) and
-                          (paracgsize in [OS_F64,OS_64,OS_S64]) and
-                          (nextintreg in [RS_R1,RS_R3]) and
-                          { first location? }
-                          (paralen=8) then
-                          inc(nextintreg);
+                           firstparaloc and
+                           (paradef.alignment=8) then
+                          begin
+                            if (nextintreg in [RS_R1,RS_R3]) then
+                              inc(nextintreg)
+                            else if nextintreg>RS_R3 then
+                              stack_offset:=align(stack_offset,8);
+                          end;
                         { this is not abi compliant
                           why? (FK) }
                         if nextintreg<=RS_R3 then
@@ -346,7 +368,7 @@ unit cpupara;
                           end
                         else
                           begin
-                            { LOC_REFERENCE covers always the overleft }
+                            { LOC_REFERENCE always contains everything that's left }
                             paraloc^.loc:=LOC_REFERENCE;
                             paraloc^.size:=int_cgsize(paralen);
                             if (side=callerside) then
@@ -385,25 +407,25 @@ unit cpupara;
                       end;
                     LOC_REFERENCE:
                       begin
-                        { align stack for eabi }
-                        if (target_info.abi=abi_eabi) and
-                          (paracgsize in [OS_F64,OS_64,OS_S64]) and
-                          (stack_offset mod 8<>0) and
-                          { first location? }
-                          (paralen=8) then
-                          inc(stack_offset,8-(stack_offset mod 8));
-
-                        paraloc^.size:=OS_ADDR;
-                        if push_addr_param(hp.varspez,paradef,p.proccalloption) or
-                          is_open_array(paradef) or
-                          is_array_of_const(paradef) then
-                          assignintreg
+                        if push_addr_param(hp.varspez,paradef,p.proccalloption) then
+                          begin
+                            paraloc^.size:=OS_ADDR;
+                            assignintreg
+                          end
                         else
                           begin
+                            { align stack for eabi }
+                            if (target_info.abi=abi_eabi) and
+                               firstparaloc and
+                               (paradef.alignment=8) then
+                              stack_offset:=align(stack_offset,8);
+
+                             paraloc^.size:=paracgsize;
                              paraloc^.loc:=LOC_REFERENCE;
                              paraloc^.reference.index:=NR_STACK_POINTER_REG;
                              paraloc^.reference.offset:=stack_offset;
-                             inc(stack_offset,hp.vardef.size);
+                             inc(stack_offset,align(paralen,4));
+                             paralen:=0
                           end;
                       end;
                     else
@@ -418,6 +440,7 @@ unit cpupara;
                        end;
                    end;
                  dec(paralen,tcgsize2size[paraloc^.size]);
+                 firstparaloc:=false
                end;
           end;
         curintreg:=nextintreg;
@@ -428,59 +451,76 @@ unit cpupara;
       end;
 
 
-    function tarmparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
-      var
-        cur_stack_offset: aword;
-        curintreg, curfloatreg, curmmreg: tsuperregister;
-        retcgsize  : tcgsize;
+    procedure tarmparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
       begin
-        init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
+        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
+      end;
 
-        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
 
+    function  tarmparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;
+      var
+        paraloc : pcgparalocation;
+        retcgsize  : tcgsize;
+      begin
+        result.init;
+        result.alignment:=get_para_align(p.proccalloption);
+        { void has no location }
+        if is_void(def) then
+          begin
+            paraloc:=result.add_location;
+            result.size:=OS_NO;
+            result.intsize:=0;
+            paraloc^.size:=OS_NO;
+            paraloc^.loc:=LOC_VOID;
+            exit;
+          end;
         { Constructors return self instead of a boolean }
         if (p.proctypeoption=potype_constructor) then
-          retcgsize:=OS_ADDR
+          begin
+            retcgsize:=OS_ADDR;
+            result.intsize:=sizeof(pint);
+          end
         else
-          retcgsize:=def_cgsize(p.returndef);
-
-        location_reset(p.funcretloc[side],LOC_INVALID,OS_NO);
-        p.funcretloc[side].size:=retcgsize;
-
-        { void has no location }
-        if is_void(p.returndef) then
           begin
-            location_reset(p.funcretloc[side],LOC_VOID,OS_NO);
-            exit;
+            retcgsize:=def_cgsize(def);
+            result.intsize:=def.size;
           end;
+        result.size:=retcgsize;
         { Return is passed as var parameter }
-        if ret_in_param(p.returndef,p.proccalloption) then
+        if ret_in_param(def,p.proccalloption) then
           begin
-            p.funcretloc[side].loc:=LOC_REFERENCE;
-            p.funcretloc[side].size:=retcgsize;
+            paraloc:=result.add_location;
+            paraloc^.loc:=LOC_REFERENCE;
+            paraloc^.size:=retcgsize;
             exit;
           end;
+
+        paraloc:=result.add_location;
         { Return in FPU register? }
-        if p.returndef.typ=floatdef then
+        if def.typ=floatdef then
           begin
-            if (p.proccalloption in [pocall_softfloat]) or (cs_fp_emulation in current_settings.moduleswitches) then
+            if (p.proccalloption in [pocall_softfloat]) or
+               (cs_fp_emulation in current_settings.moduleswitches) or
+               (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3]) then
               begin
                 case retcgsize of
                   OS_64,
                   OS_F64:
                     begin
-                      { low }
-                      p.funcretloc[side].loc:=LOC_REGISTER;
-                      p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG;
-                      p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG;
-                      p.funcretloc[side].size:=OS_64;
+                      paraloc^.loc:=LOC_REGISTER;
+                      paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG;
+                      paraloc^.size:=OS_32;
+                      paraloc:=result.add_location;
+                      paraloc^.loc:=LOC_REGISTER;
+                      paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG;
+                      paraloc^.size:=OS_32;
                     end;
                   OS_32,
                   OS_F32:
                     begin
-                      p.funcretloc[side].loc:=LOC_REGISTER;
-                      p.funcretloc[side].register:=NR_FUNCTION_RETURN_REG;
-                      p.funcretloc[side].size:=OS_32;
+                      paraloc^.loc:=LOC_REGISTER;
+                      paraloc^.register:=NR_FUNCTION_RETURN_REG;
+                      paraloc^.size:=OS_32;
                     end;
                   else
                     internalerror(2005082603);
@@ -488,8 +528,9 @@ unit cpupara;
               end
             else
               begin
-                p.funcretloc[side].loc:=LOC_FPUREGISTER;
-                p.funcretloc[side].register:=NR_FPU_RESULT_REG;
+                paraloc^.loc:=LOC_FPUREGISTER;
+                paraloc^.register:=NR_FPU_RESULT_REG;
+                paraloc^.size:=retcgsize;
               end;
           end
           { Return in register }
@@ -497,18 +538,37 @@ unit cpupara;
           begin
             if retcgsize in [OS_64,OS_S64] then
               begin
-                { low }
-                p.funcretloc[side].loc:=LOC_REGISTER;
-                p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG;
-                p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG;
+                paraloc^.loc:=LOC_REGISTER;
+                paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG;
+                paraloc^.size:=OS_32;
+                paraloc:=result.add_location;
+                paraloc^.loc:=LOC_REGISTER;
+                paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG;
+                paraloc^.size:=OS_32;
               end
             else
               begin
-                p.funcretloc[side].loc:=LOC_REGISTER;
-                p.funcretloc[side].register:=NR_FUNCTION_RETURN_REG;
+                paraloc^.loc:=LOC_REGISTER;
+                paraloc^.register:=NR_FUNCTION_RETURN_REG;
+                if (result.intsize<>3) then
+                  paraloc^.size:=retcgsize
+                else
+                  paraloc^.size:=OS_32;
               end;
-
           end;
+      end;
+
+
+    function tarmparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
+      var
+        cur_stack_offset: aword;
+        curintreg, curfloatreg, curmmreg: tsuperregister;
+      begin
+        init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
+
+        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
+
+        create_funcretloc_info(p,side);
      end;
 
 

compiler/arm/cpupi.pas

@@ -63,7 +63,16 @@ unit cpupi;
           this extra memory should hurt less than generating all local contants with offsets
           >256 as non shifter constants }
         if tg.direction = -1 then
-          tg.setfirsttemp(-12-28)
+          begin
+            if (target_info.system<>system_arm_darwin) then
+              { Non-Darwin, worst case: r4-r10,r11,r13,r14,r15 is saved -> -28-16, but we
+                always adjust the frame pointer to point to the first stored
+                register (= last register in list above) -> + 4 }
+              tg.setfirsttemp(-28-16+4)
+            else
+              { on Darwin r9 is not usable -> one less register to save }
+              tg.setfirsttemp(-24-16+4)
+          end
         else
           tg.setfirsttemp(maxpushedparasize);
       end;
@@ -74,21 +83,38 @@ unit cpupi;
          firstfloatreg,lastfloatreg,
          r : byte;
          floatsavesize : aword;
+         regs: tcpuregisterset;
       begin
         maxpushedparasize:=align(maxpushedparasize,max(current_settings.alignment.localalignmin,4));
-        firstfloatreg:=RS_NO;
-        { save floating point registers? }
-        for r:=RS_F0 to RS_F7 do
-          if r in cg.rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall) then
+        floatsavesize:=0;
+        case current_settings.fputype of
+          fpu_fpa,
+          fpu_fpa10,
+          fpu_fpa11:
             begin
-              if firstfloatreg=RS_NO then
-                firstfloatreg:=r;
-              lastfloatreg:=r;
+              { save floating point registers? }
+              firstfloatreg:=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
+                  begin
+                    if firstfloatreg=RS_NO then
+                      firstfloatreg:=r;
+                    lastfloatreg:=r;
+                  end;
+              if firstfloatreg<>RS_NO then
+                floatsavesize:=(lastfloatreg-firstfloatreg+1)*12;
             end;
-        if firstfloatreg<>RS_NO then
-          floatsavesize:=(lastfloatreg-firstfloatreg+1)*12
-        else
-          floatsavesize:=0;
+          fpu_vfpv2,
+          fpu_vfpv3:
+            begin
+              floatsavesize:=0;
+              regs:=cg.rg[R_MMREGISTER].used_in_proc-paramanager.get_volatile_registers_mm(pocall_stdcall);
+              for r:=RS_D0 to RS_D31 do
+                if r in regs then
+                  inc(floatsavesize,8);
+            end;
+        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;

compiler/arm/narmadd.pas

@@ -32,8 +32,9 @@ interface
        tarmaddnode = class(tcgaddnode)
        private
           function  GetResFlags(unsigned:Boolean):TResFlags;
-       protected
+       public
           function pass_1 : tnode;override;
+       protected
           procedure second_addfloat;override;
           procedure second_cmpfloat;override;
           procedure second_cmpordinal;override;
@@ -123,15 +124,27 @@ interface
     procedure tarmaddnode.second_addfloat;
       var
         op : TAsmOp;
+        singleprec: boolean;
       begin
+        pass_left_right;
+        if (nf_swapped in flags) then
+          swapleftright;
+
         case current_settings.fputype of
           fpu_fpa,
           fpu_fpa10,
           fpu_fpa11:
             begin
-              pass_left_right;
-              if (nf_swapped in flags) then
-                swapleftright;
+              { force fpureg as location, left right doesn't matter
+                as both will be in a fpureg }
+              location_force_fpureg(current_asmdata.CurrAsmList,left.location,true);
+              location_force_fpureg(current_asmdata.CurrAsmList,right.location,(left.location.loc<>LOC_CFPUREGISTER));
+
+              location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
+              if left.location.loc<>LOC_CFPUREGISTER then
+                location.register:=left.location.register
+              else
+                location.register:=right.location.register;
 
               case nodetype of
                 addn :
@@ -146,22 +159,54 @@ interface
                   internalerror(200308313);
               end;
 
-              { force fpureg as location, left right doesn't matter
+              current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(op,
+                 location.register,left.location.register,right.location.register),
+                 cgsize2fpuoppostfix[def_cgsize(resultdef)]));
+            end;
+          fpu_vfpv2,
+          fpu_vfpv3:
+            begin
+              { force mmreg 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,(left.location.loc<>LOC_CFPUREGISTER));
+              location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,true);
+              location_force_mmregscalar(current_asmdata.CurrAsmList,right.location,true);
 
-              location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
-              if left.location.loc<>LOC_CFPUREGISTER then
+              location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef));
+              if left.location.loc<>LOC_CMMREGISTER then
                 location.register:=left.location.register
+              else if right.location.loc<>LOC_CMMREGISTER then
+                location.register:=right.location.register
               else
-                location.register:=right.location.register;
+                location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
 
-              current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(op,
-                 location.register,left.location.register,right.location.register),
-                 cgsize2fpuoppostfix[def_cgsize(resultdef)]));
+              singleprec:=tfloatdef(left.resultdef).floattype=s32real;
+              case nodetype of
+                addn :
+                  if singleprec then
+                    op:=A_FADDS
+                  else
+                    op:=A_FADDD;
+                muln :
+                  if singleprec then
+                    op:=A_FMULS
+                  else
+                    op:=A_FMULD;
+                subn :
+                  if singleprec then
+                    op:=A_FSUBS
+                  else
+                    op:=A_FSUBD;
+                slashn :
+                  if singleprec then
+                    op:=A_FDIVS
+                  else
+                    op:=A_FDIVD;
+                else
+                  internalerror(2009111401);
+              end;
 
-              location.loc:=LOC_FPUREGISTER;
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,
+                 location.register,left.location.register,right.location.register));
             end;
           fpu_soft:
             { this case should be handled already by pass1 }
@@ -173,27 +218,58 @@ interface
 
 
     procedure tarmaddnode.second_cmpfloat;
+      var
+        op: TAsmOp;
       begin
         pass_left_right;
         if (nf_swapped in flags) then
           swapleftright;
 
-        { force fpureg as location, left right doesn't matter
-          as both will be in a fpureg }
-        location_force_fpureg(current_asmdata.CurrAsmList,left.location,true);
-        location_force_fpureg(current_asmdata.CurrAsmList,right.location,true);
-
         location_reset(location,LOC_FLAGS,OS_NO);
         location.resflags:=getresflags(true);
 
-        if nodetype in [equaln,unequaln] then
-          current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMF,
-             left.location.register,right.location.register),
-             cgsize2fpuoppostfix[def_cgsize(resultdef)]))
-        else
-          current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMFE,
-             left.location.register,right.location.register),
-             cgsize2fpuoppostfix[def_cgsize(resultdef)]));
+        case current_settings.fputype of
+          fpu_fpa,
+          fpu_fpa10,
+          fpu_fpa11:
+            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);
+
+              if nodetype in [equaln,unequaln] then
+                current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMF,
+                   left.location.register,right.location.register),
+                   cgsize2fpuoppostfix[def_cgsize(resultdef)]))
+              else
+                current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMFE,
+                   left.location.register,right.location.register),
+                   cgsize2fpuoppostfix[def_cgsize(resultdef)]));
+            end;
+          fpu_vfpv2,
+          fpu_vfpv3:
+            begin
+              location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,true);
+              location_force_mmregscalar(current_asmdata.CurrAsmList,right.location,true);
+
+              if (tfloatdef(left.resultdef).floattype=s32real) then
+                if nodetype in [equaln,unequaln] then
+                  op:=A_FCMPS
+                 else
+                   op:=A_FCMPES
+              else if nodetype in [equaln,unequaln] then
+                op:=A_FCMPD
+              else
+                op:=A_FCMPED;
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,
+                left.location.register,right.location.register));
+              current_asmdata.CurrAsmList.concat(taicpu.op_none(A_FMSTAT));
+            end;
+          fpu_soft:
+            { this case should be handled already by pass1 }
+            internalerror(2009112404);
+        end;
 
         location_reset(location,LOC_FLAGS,OS_NO);
         location.resflags:=getresflags(false);
@@ -257,6 +333,8 @@ interface
             location_reset(location,LOC_FLAGS,OS_NO);
             location.resflags:=getresflags(unsigned);
             current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi));
+            if current_settings.cputype in cpu_thumb2 then
+              current_asmdata.CurrAsmList.concat(taicpu.op_cond(A_IT, C_EQ));
             current_asmdata.CurrAsmList.concat(setcondition(taicpu.op_reg_reg(A_CMP,left.location.register64.reglo,right.location.register64.reglo),C_EQ));
           end
         else

compiler/arm/narmcal.pas

@@ -4,7 +4,7 @@
     Implements the ARM specific part of call nodes
 
     This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published bymethodpointer
+    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.
 
@@ -30,20 +30,44 @@ interface
 
     type
        tarmcallnode = class(tcgcallnode)
-          // procedure push_framepointer;override;
+         procedure set_result_location(realresdef: tstoreddef);override;
        end;
 
 implementation
 
   uses
+    verbose,globtype,globals,aasmdata,
+    symconst,
+    cgbase,
+    cpubase,cpuinfo,
+    ncgutil,
     paramgr;
 
-(*
-  procedure tarmcallnode.push_framepointer;
+  procedure tarmcallnode.set_result_location(realresdef: tstoreddef);
     begin
-      framepointer_paraloc:=paramanager.getintparaloc(procdefinition.proccalloption,1);
+      if (realresdef.typ=floatdef) and
+         ((cs_fp_emulation in current_settings.moduleswitches) or
+          (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3])) then
+        begin
+          { keep the fpu values in integer registers for now, the code
+            generator will move them to memory or an mmregister when necessary
+            (avoids double moves in case a function result is assigned to
+             another function result, or passed as a parameter) }
+          case retloc.size of
+            OS_32,
+            OS_F32:
+              location_allocate_register(current_asmdata.CurrAsmList,location,s32inttype,false);
+            OS_64,
+            OS_F64:
+              location_allocate_register(current_asmdata.CurrAsmList,location,s64inttype,false);
+            else
+              internalerror(2010053008);
+          end
+        end
+      else
+        inherited;
     end;
-*)
+
 
 begin
    ccallnode:=tarmcallnode;

compiler/arm/narmcnv.pas

@@ -64,7 +64,7 @@ implementation
       pass_1,pass_2,procinfo,
       ncon,ncal,
       ncgutil,
-      cpubase,aasmcpu,
+      cpubase,cpuinfo,aasmcpu,
       rgobj,tgobj,cgobj,cgcpu;
 
 
@@ -95,6 +95,8 @@ implementation
                 result := ccallnode.createintern(fname,ccallparanode.create(
                   left,nil));
                 left:=nil;
+                if (tfloatdef(resultdef).floattype=s32real) then
+                  inserttypeconv(result,s32floattype);
                 firstpass(result);
                 exit;
               end
@@ -108,68 +110,104 @@ implementation
                 firstpass(left);
               end;
             result := nil;
-            expectloc:=LOC_FPUREGISTER;
+            case current_settings.fputype of
+              fpu_fpa,
+              fpu_fpa10,
+              fpu_fpa11:
+                expectloc:=LOC_FPUREGISTER;
+              fpu_vfpv2,
+              fpu_vfpv3:
+                expectloc:=LOC_MMREGISTER;
+              else
+                internalerror(2009112702);
+            end;
           end;
       end;
 
 
     procedure tarmtypeconvnode.second_int_to_real;
+      const
+        signedprec2vfpop: array[boolean,OS_F32..OS_F64] of tasmop =
+          ((A_FUITOS,A_FUITOD),
+           (A_FSITOS,A_FSITOD));
       var
         instr : taicpu;
         href : treference;
         l1,l2 : tasmlabel;
         hregister : tregister;
+        signed : boolean;
       begin
-
-        { convert first to double to avoid precision loss }
-        location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
-        location_force_reg(current_asmdata.CurrAsmList,left.location,OS_32,true);
-        location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
-        instr:=taicpu.op_reg_reg(A_FLT,location.register,left.location.register);
-        if is_signed(left.resultdef) then
-          begin
-            instr.oppostfix:=cgsize2fpuoppostfix[def_cgsize(resultdef)];
-            current_asmdata.CurrAsmList.concat(instr);
-          end
-        else
-          begin
-            { flt does a signed load, fix this }
-            case tfloatdef(resultdef).floattype of
-              s32real,
-              s64real:
+        case current_settings.fputype of
+          fpu_fpa,
+          fpu_fpa10,
+          fpu_fpa11:
+            begin
+              { convert first to double to avoid precision loss }
+              location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
+              location_force_reg(current_asmdata.CurrAsmList,left.location,OS_32,true);
+              location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
+              instr:=taicpu.op_reg_reg(A_FLT,location.register,left.location.register);
+              if is_signed(left.resultdef) then
                 begin
-                  { converting dword to s64real first and cut off at the end avoids precision loss }
-                  instr.oppostfix:=PF_D;
+                  instr.oppostfix:=cgsize2fpuoppostfix[def_cgsize(resultdef)];
                   current_asmdata.CurrAsmList.concat(instr);
+                end
+              else
+                begin
+                  { flt does a signed load, fix this }
+                  case tfloatdef(resultdef).floattype of
+                    s32real,
+                    s64real:
+                      begin
+                        { converting dword to s64real first and cut off at the end avoids precision loss }
+                        instr.oppostfix:=PF_D;
+                        current_asmdata.CurrAsmList.concat(instr);
 
-                  current_asmdata.getdatalabel(l1);
-                  current_asmdata.getjumplabel(l2);
-                  reference_reset_symbol(href,l1,0);
+                        current_asmdata.getdatalabel(l1);
+                        current_asmdata.getjumplabel(l2);
+                        reference_reset_symbol(href,l1,0,const_align(8));
 
-                  current_asmdata.CurrAsmList.concat(Taicpu.op_reg_const(A_CMP,left.location.register,0));
-                  cg.a_jmp_flags(current_asmdata.CurrAsmList,F_GE,l2);
+                        current_asmdata.CurrAsmList.concat(Taicpu.op_reg_const(A_CMP,left.location.register,0));
+                        cg.a_jmp_flags(current_asmdata.CurrAsmList,F_GE,l2);
 
-                  hregister:=cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64);
-                  current_asmdata.asmlists[al_typedconsts].concat(tai_align.create(const_align(8)));
-                  current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l1));
-                  { I got this constant from a test program (FK) }
-                  current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit($41f00000));
-                  current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit(0));
+                        hregister:=cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64);
+                        current_asmdata.asmlists[al_typedconsts].concat(tai_align.create(const_align(8)));
+                        current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l1));
+                        { I got this constant from a test program (FK) }
+                        current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit($41f00000));
+                        current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit(0));
 
-                  cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,OS_F64,OS_F64,href,hregister);
-                  current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADF,location.register,hregister,location.register),PF_D));
-                  cg.a_label(current_asmdata.CurrAsmList,l2);
+                        cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,OS_F64,OS_F64,href,hregister);
+                        current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADF,location.register,hregister,location.register),PF_D));
+                        cg.a_label(current_asmdata.CurrAsmList,l2);
 
-                  { cut off if we should convert to single }
-                  if tfloatdef(resultdef).floattype=s32real then
-                    begin
-                      hregister:=location.register;
-                      location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
-                      current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_MVF,location.register,hregister),PF_S));
-                    end;
-                end;
+                        { cut off if we should convert to single }
+                        if tfloatdef(resultdef).floattype=s32real then
+                          begin
+                            hregister:=location.register;
+                            location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
+                            current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_MVF,location.register,hregister),PF_S));
+                          end;
+                      end;
+                    else
+                      internalerror(200410031);
+                  end;
+              end;
+            end;
+          fpu_vfpv2,
+          fpu_vfpv3:
+            begin
+              location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef));
+              signed:=left.location.size=OS_S32;
+              location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false);
+              if (left.location.size<>OS_F32) then
+                internalerror(2009112703);
+              if left.location.size<>location.size then
+                location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size)
               else
-                internalerror(200410031);
+                location.register:=left.location.register;
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(
+                signedprec2vfpop[signed,location.size],location.register,left.location.register));
             end;
         end;
       end;

compiler/arm/narmcon.pas

@@ -55,14 +55,14 @@ interface
       { constants are actually supported by the target processor? (JM) }
       const
         floattype2ait:array[tfloattype] of taitype=
-          (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit,ait_real_128bit);
+          (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit,ait_real_128bit);
       var
          lastlabel : tasmlabel;
          realait : taitype;
          hiloswapped : boolean;
 
       begin
-        location_reset(location,LOC_CREFERENCE,def_cgsize(resultdef));
+        location_reset_ref(location,LOC_CREFERENCE,def_cgsize(resultdef),4);
         lastlabel:=nil;
         realait:=floattype2ait[tfloatdef(resultdef).floattype];
         hiloswapped:=is_double_hilo_swapped;
@@ -80,7 +80,7 @@ interface
                   { range checking? }
                   if ((cs_check_range in current_settings.localswitches) or
                     (cs_check_overflow in current_settings.localswitches)) and
-                    (tai_real_32bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
+                    (tai_real_32bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) then
                     Message(parser_e_range_check_error);
                 end;
 
@@ -94,18 +94,18 @@ interface
                   { range checking? }
                   if ((cs_check_range in current_settings.localswitches) or
                     (cs_check_overflow in current_settings.localswitches)) and
-                    (tai_real_64bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
+                    (tai_real_64bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) then
                     Message(parser_e_range_check_error);
                end;
 
               ait_real_80bit :
                 begin
-                  current_procinfo.aktlocaldata.concat(Tai_real_80bit.Create(value_real));
+                  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
-                    (tai_real_80bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
+                    (tai_real_80bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) then
                     Message(parser_e_range_check_error);
                 end;
 {$ifdef cpufloat128}
@@ -116,7 +116,7 @@ interface
                   { range checking? }
                   if ((cs_check_range in current_settings.localswitches) or
                     (cs_check_overflow in current_settings.localswitches)) and
-                    (tai_real_128bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
+                    (tai_real_128bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) then
                     Message(parser_e_range_check_error);
                 end;
 {$endif cpufloat128}

compiler/arm/narminl.pas

@@ -50,7 +50,7 @@ interface
         }
         procedure second_prefetch; override;
       private
-        procedure load_fpu_location;
+        procedure load_fpu_location(out singleprec: boolean);
       end;
 
 
@@ -72,26 +72,57 @@ implementation
                               tarminlinenode
 *****************************************************************************}
 
-    procedure tarminlinenode.load_fpu_location;
+    procedure tarminlinenode.load_fpu_location(out singleprec: boolean);
       begin
         secondpass(left);
-        location_force_fpureg(current_asmdata.CurrAsmList,left.location,true);
-        location_copy(location,left.location);
-        if left.location.loc=LOC_CFPUREGISTER then
-          begin
-           location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
-           location.loc := LOC_FPUREGISTER;
-         end;
+        case current_settings.fputype of
+          fpu_fpa,
+          fpu_fpa10,
+          fpu_fpa11:
+            begin
+              location_force_fpureg(current_asmdata.CurrAsmList,left.location,true);
+              location_copy(location,left.location);
+              if left.location.loc=LOC_CFPUREGISTER then
+                begin
+                 location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
+                 location.loc := LOC_FPUREGISTER;
+               end;
+            end;
+          fpu_vfpv2,
+          fpu_vfpv3:
+            begin
+              location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,true);
+              location_copy(location,left.location);
+              if left.location.loc=LOC_CMMREGISTER then
+                begin
+                 location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
+                 location.loc := LOC_MMREGISTER;
+               end;
+            end;
+          else
+            internalerror(2009111801);
+        end;
+        singleprec:=tfloatdef(left.resultdef).floattype=s32real;
       end;
 
 
     function tarminlinenode.first_abs_real : tnode;
       begin
-        if cs_fp_emulation in current_settings.moduleswitches then
+        if (cs_fp_emulation in current_settings.moduleswitches) then
           result:=inherited first_abs_real
         else
           begin
-            expectloc:=LOC_FPUREGISTER;
+            case current_settings.fputype of
+              fpu_fpa,
+              fpu_fpa10,
+              fpu_fpa11:
+                expectloc:=LOC_FPUREGISTER;
+              fpu_vfpv2,
+              fpu_vfpv3:
+                expectloc:=LOC_MMREGISTER;
+              else
+                internalerror(2009112401);
+            end;
             first_abs_real:=nil;
           end;
       end;
@@ -99,11 +130,21 @@ implementation
 
     function tarminlinenode.first_sqr_real : tnode;
       begin
-        if cs_fp_emulation in current_settings.moduleswitches then
+        if (cs_fp_emulation in current_settings.moduleswitches) then
           result:=inherited first_sqr_real
         else
           begin
-            expectloc:=LOC_FPUREGISTER;
+            case current_settings.fputype of
+              fpu_fpa,
+              fpu_fpa10,
+              fpu_fpa11:
+                expectloc:=LOC_FPUREGISTER;
+              fpu_vfpv2,
+              fpu_vfpv3:
+                expectloc:=LOC_MMREGISTER;
+              else
+                internalerror(2009112402);
+            end;
             first_sqr_real:=nil;
           end;
       end;
@@ -115,7 +156,17 @@ implementation
           result:=inherited first_sqrt_real
         else
           begin
-            expectloc:=LOC_FPUREGISTER;
+            case current_settings.fputype of
+              fpu_fpa,
+              fpu_fpa10,
+              fpu_fpa11:
+                expectloc:=LOC_FPUREGISTER;
+              fpu_vfpv2,
+              fpu_vfpv3:
+                expectloc:=LOC_MMREGISTER;
+              else
+                internalerror(2009112403);
+            end;
             first_sqrt_real := nil;
           end;
       end;
@@ -151,23 +202,80 @@ implementation
 
 
     procedure tarminlinenode.second_abs_real;
+      var
+        singleprec: boolean;
+        op: TAsmOp;
       begin
-        load_fpu_location;
-        current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_ABS,location.register,left.location.register),get_fpu_postfix(resultdef)));
+        load_fpu_location(singleprec);
+        case current_settings.fputype of
+          fpu_fpa,
+          fpu_fpa10,
+          fpu_fpa11:
+            current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_ABS,location.register,left.location.register),get_fpu_postfix(resultdef)));
+          fpu_vfpv2,
+          fpu_vfpv3:
+            begin
+              if singleprec then
+                op:=A_FABSS
+              else
+                op:=A_FABSD;
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,location.register,left.location.register));
+            end;
+        else
+          internalerror(2009111402);
+        end;
       end;
 
 
     procedure tarminlinenode.second_sqr_real;
+      var
+        singleprec: boolean;
+        op: TAsmOp;
       begin
-        load_fpu_location;
-        current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_MUF,location.register,left.location.register,left.location.register),get_fpu_postfix(resultdef)));
+        load_fpu_location(singleprec);
+        case current_settings.fputype of
+          fpu_fpa,
+          fpu_fpa10,
+          fpu_fpa11:
+            current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_MUF,location.register,left.location.register,left.location.register),get_fpu_postfix(resultdef)));
+          fpu_vfpv2,
+          fpu_vfpv3:
+            begin
+              if singleprec then
+                op:=A_FMULS
+              else
+                op:=A_FMULD;
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,location.register,left.location.register,left.location.register));
+            end;
+        else
+          internalerror(2009111403);
+        end;
       end;
 
 
     procedure tarminlinenode.second_sqrt_real;
+      var
+        singleprec: boolean;
+        op: TAsmOp;
       begin
-        load_fpu_location;
-        current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_SQT,location.register,left.location.register),get_fpu_postfix(resultdef)));
+        load_fpu_location(singleprec);
+        case current_settings.fputype of
+          fpu_fpa,
+          fpu_fpa10,
+          fpu_fpa11:
+            current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_SQT,location.register,left.location.register),get_fpu_postfix(resultdef)));
+          fpu_vfpv2,
+          fpu_vfpv3:
+            begin
+              if singleprec then
+                op:=A_FSQRTS
+              else
+                op:=A_FSQRTD;
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,location.register,left.location.register));
+            end;
+        else
+          internalerror(2009111402);
+        end;
       end;
 
 
@@ -213,7 +321,7 @@ implementation
                 begin
                   r:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
                   cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,r);
-                  reference_reset_base(ref,r,0);
+                  reference_reset_base(ref,r,0,left.location.reference.alignment);
                   { since the address might be nil we can't use ldr for older cpus }
                   current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_PLD,ref));
                 end;

compiler/arm/narmmat.pas

@@ -53,7 +53,7 @@ implementation
       cgbase,cgobj,cgutils,
       pass_2,procinfo,
       ncon,
-      cpubase,
+      cpubase,cpuinfo,
       ncgutil,cgcpu;
 
 {*****************************************************************************
@@ -257,14 +257,38 @@ implementation
 *****************************************************************************}
 
     procedure tarmunaryminusnode.second_float;
+      var
+        op: tasmop;
       begin
         secondpass(left);
-        location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
-        location_force_fpureg(current_asmdata.CurrAsmList,left.location,false);
-        location:=left.location;
-        current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_const(A_RSF,
-          location.register,left.location.register,0),
-          cgsize2fpuoppostfix[def_cgsize(resultdef)]));
+        case current_settings.fputype of
+          fpu_fpa,
+          fpu_fpa10,
+          fpu_fpa11:
+            begin
+              location_force_fpureg(current_asmdata.CurrAsmList,left.location,false);
+              location:=left.location;
+              current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_const(A_RSF,
+                location.register,left.location.register,0),
+                cgsize2fpuoppostfix[def_cgsize(resultdef)]));
+            end;
+          fpu_vfpv2,
+          fpu_vfpv3:
+            begin
+              location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,true);
+              location:=left.location;
+              if (left.location.loc=LOC_CMMREGISTER) then
+                location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
+              if (location.size=OS_F32) then
+                op:=A_FNEGS
+              else
+                op:=A_FNEGD;
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,
+                location.register,left.location.register));
+            end;
+          else
+            internalerror(2009112602);
+        end;
       end;
 
 

compiler/arm/narmset.pas

@@ -103,7 +103,7 @@ implementation
         cg.a_load_reg_reg(current_asmdata.CurrAsmList,opsize,OS_INT,hregister,indexreg);
         cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_ADDR,min_+1,indexreg,indexreg);
         { create reference }
-        reference_reset(href);
+        reference_reset(href,4);
         href.base:=NR_PC;
         href.index:=indexreg;
         href.shiftmode:=SM_LSL;

compiler/arm/raarmgas.pas

@@ -645,9 +645,37 @@ Unit raarmgas;
           end;
 
 
+        function is_ConditionCode(hs: string): boolean;
+          var icond: tasmcond;
+          begin
+            is_ConditionCode := false;
+            
+            if actopcode in [A_IT,A_ITE,A_ITT,
+                             A_ITEE,A_ITTE,A_ITET,A_ITTT,
+                             A_ITEEE,A_ITTEE,A_ITETE,A_ITTTE,A_ITEET,A_ITTET,A_ITETT,A_ITTTT] then
+              begin
+                { search for condition, conditions are always 2 chars }
+                if length(hs)>1 then
+                  begin
+                    for icond:=low(tasmcond) to high(tasmcond) do
+                      begin
+                        if copy(hs,1,2)=uppercond2str[icond] then
+                          begin
+                            //actcondition:=icond;
+                            oper.opr.typ := OPR_COND;
+                            oper.opr.cc := icond;
+                            exit(true);
+                          end;
+                      end;
+                  end;
+              end;
+          end;
+
       var
         tempreg : tregister;
         ireg : tsuperregister;
+        regtype: tregistertype;
+        subreg: tsubregister;
         hl : tasmlabel;
         {ofs : longint;}
         registerset : tcpuregisterset;
@@ -687,6 +715,12 @@ Unit raarmgas;
           *)
           AS_ID: { A constant expression, or a Variable ref.  }
             Begin
+              { Condition code? }
+              if is_conditioncode(actasmpattern) then
+              begin
+                consume(AS_ID);
+              end
+              else
               { Local Label ? }
               if is_locallabel(actasmpattern) then
                begin
@@ -790,7 +824,7 @@ Unit raarmgas;
                   oper.opr.typ:=OPR_REGISTER;
                   oper.opr.reg:=tempreg;
                 end
-              else if (actasmtoken=AS_NOT) and (actopcode in [A_LDM,A_STM]) then
+              else if (actasmtoken=AS_NOT) and (actopcode in [A_LDM,A_STM,A_FLDM,A_FSTM]) then
                 begin
                   consume(AS_NOT);
                   oper.opr.typ:=OPR_REFERENCE;
@@ -806,11 +840,24 @@ Unit raarmgas;
             begin
               consume(AS_LSBRACKET);
               registerset:=[];
+              regtype:=R_INVALIDREGISTER;
+              subreg:=R_SUBNONE;
               while true do
                 begin
                   if actasmtoken=AS_REGISTER then
                     begin
                       include(registerset,getsupreg(actasmregister));
+                      if regtype<>R_INVALIDREGISTER then
+                        begin
+                          if (getregtype(actasmregister)<>regtype) or
+                             (getsubreg(actasmregister)<>subreg) then
+                            Message(asmr_e_mixing_regtypes);
+                        end
+                      else
+                        begin
+                          regtype:=getregtype(actasmregister);
+                          subreg:=getsubreg(actasmregister);
+                        end;
                       tempreg:=actasmregister;
                       consume(AS_REGISTER);
                       if actasmtoken=AS_MINUS then
@@ -830,7 +877,11 @@ Unit raarmgas;
                 end;
               consume(AS_RSBRACKET);
               oper.opr.typ:=OPR_REGSET;
+              oper.opr.regtype:=regtype;
+              oper.opr.subreg:=subreg;
               oper.opr.regset:=registerset;
+              if (registerset=[]) then
+                Message(asmr_e_empty_regset);
             end;
           AS_end,
           AS_SEPARATOR,
@@ -915,12 +966,18 @@ Unit raarmgas;
 
       const
         { sorted by length so longer postfixes will match first }
-        postfix2strsorted : array[1..19] of string[2] = (
+        postfix2strsorted : array[1..31] of string[3] = (
+          'IAD','DBD','FDD','EAD',
+          'IAS','DBS','FDS','EAS',
+          'IAX','DBX','FDX','EAX',
           'EP','SB','BT','SH',
           'IA','IB','DA','DB','FD','FA','ED','EA',
           'B','D','E','P','T','H','S');
 
-        postfixsorted : array[1..19] of TOpPostfix = (
+        postfixsorted : array[1..31] of TOpPostfix = (
+          PF_IAD,PF_DBD,PF_FDD,PF_EAD,
+          PF_IAS,PF_DBS,PF_FDS,PF_EAS,
+          PF_IAX,PF_DBX,PF_FDX,PF_EAX,
           PF_EP,PF_SB,PF_BT,PF_SH,
           PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA,
           PF_B,PF_D,PF_E,PF_P,PF_T,PF_H,PF_S);
@@ -970,6 +1027,7 @@ Unit raarmgas;
           end;
         if actopcode=A_NONE then
           exit;
+			 
         { search for condition, conditions are always 2 chars }
         if length(hs)>1 then
           begin

compiler/arm/rarmcon.inc

@@ -24,51 +24,69 @@ NR_F4 = tregister($02000004);
 NR_F5 = tregister($02000005);
 NR_F6 = tregister($02000006);
 NR_F7 = tregister($02000007);
-NR_S0 = tregister($03000000);
-NR_S1 = tregister($03000000);
-NR_D0 = tregister($03000000);
-NR_S2 = tregister($03000000);
-NR_S3 = tregister($03000000);
-NR_D1 = tregister($03000000);
-NR_S4 = tregister($03000000);
-NR_S5 = tregister($03000000);
-NR_D2 = tregister($03000000);
-NR_S6 = tregister($03000000);
-NR_S7 = tregister($03000000);
-NR_D3 = tregister($03000000);
-NR_S8 = tregister($03000000);
-NR_S9 = tregister($03000000);
-NR_D4 = tregister($03000000);
-NR_S10 = tregister($03000000);
-NR_S11 = tregister($03000000);
-NR_D5 = tregister($03000000);
-NR_S12 = tregister($03000000);
-NR_S13 = tregister($03000000);
-NR_D6 = tregister($03000000);
-NR_S14 = tregister($03000000);
-NR_S15 = tregister($03000000);
-NR_D7 = tregister($03000000);
-NR_S16 = tregister($03000000);
-NR_S17 = tregister($03000000);
-NR_D8 = tregister($03000000);
-NR_S18 = tregister($03000000);
-NR_S19 = tregister($03000000);
-NR_D9 = tregister($03000000);
-NR_S20 = tregister($03000000);
-NR_S21 = tregister($03000000);
-NR_D10 = tregister($03000000);
-NR_S22 = tregister($03000000);
-NR_S23 = tregister($03000000);
-NR_D11 = tregister($03000000);
-NR_S24 = tregister($03000000);
-NR_S25 = tregister($03000000);
-NR_D12 = tregister($03000000);
-NR_S26 = tregister($03000000);
-NR_S27 = tregister($03000000);
-NR_D13 = tregister($03000000);
-NR_S28 = tregister($03000000);
-NR_S29 = tregister($03000000);
-NR_D14 = tregister($03000000);
-NR_S30 = tregister($03000000);
-NR_S31 = tregister($03000000);
-NR_D15 = tregister($03000000);
+NR_S0 = tregister($04060000);
+NR_S1 = tregister($04060000);
+NR_D0 = tregister($04070000);
+NR_S2 = tregister($04060001);
+NR_S3 = tregister($04060001);
+NR_D1 = tregister($04070001);
+NR_S4 = tregister($04060002);
+NR_S5 = tregister($04060002);
+NR_D2 = tregister($04070002);
+NR_S6 = tregister($04060003);
+NR_S7 = tregister($04060003);
+NR_D3 = tregister($04070003);
+NR_S8 = tregister($04060004);
+NR_S9 = tregister($04060004);
+NR_D4 = tregister($04070004);
+NR_S10 = tregister($04060005);
+NR_S11 = tregister($04060005);
+NR_D5 = tregister($04070005);
+NR_S12 = tregister($04060006);
+NR_S13 = tregister($04060006);
+NR_D6 = tregister($04070006);
+NR_S14 = tregister($04060007);
+NR_S15 = tregister($04060007);
+NR_D7 = tregister($04070007);
+NR_S16 = tregister($04060008);
+NR_S17 = tregister($04060008);
+NR_D8 = tregister($04070008);
+NR_S18 = tregister($04060009);
+NR_S19 = tregister($04060009);
+NR_D9 = tregister($04070009);
+NR_S20 = tregister($0406000A);
+NR_S21 = tregister($0406000A);
+NR_D10 = tregister($0407000A);
+NR_S22 = tregister($0406000B);
+NR_S23 = tregister($0406000B);
+NR_D11 = tregister($0407000B);
+NR_S24 = tregister($0406000C);
+NR_S25 = tregister($0406000C);
+NR_D12 = tregister($0407000C);
+NR_S26 = tregister($0406000D);
+NR_S27 = tregister($0406000D);
+NR_D13 = tregister($0407000D);
+NR_S28 = tregister($0406000E);
+NR_S29 = tregister($0406000E);
+NR_D14 = tregister($0407000E);
+NR_S30 = tregister($0406000F);
+NR_S31 = tregister($0406000F);
+NR_D15 = tregister($0407000F);
+NR_D16 = tregister($04070010);
+NR_D17 = tregister($04070011);
+NR_D18 = tregister($04070012);
+NR_D19 = tregister($04070013);
+NR_D20 = tregister($04070014);
+NR_D21 = tregister($04070015);
+NR_D22 = tregister($04070016);
+NR_D23 = tregister($04070017);
+NR_D24 = tregister($04070018);
+NR_D25 = tregister($04070019);
+NR_D26 = tregister($0407001A);
+NR_D27 = tregister($0407001B);
+NR_D28 = tregister($0407001C);
+NR_D29 = tregister($0407001D);
+NR_D30 = tregister($0407001E);
+NR_D31 = tregister($0407001F);
+NR_CPSR_C = tregister($05000000);
+NR_FPSCR = tregister($05000001);

compiler/arm/rarmdwa.inc

@@ -71,4 +71,22 @@
 0,
 0,
 0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
 0

compiler/arm/rarmnor.inc

@@ -1,2 +1,2 @@
 { don't edit, this file is generated from armreg.dat }
-73
+91

compiler/arm/rarmnum.inc

@@ -24,51 +24,69 @@ tregister($02000004),
 tregister($02000005),
 tregister($02000006),
 tregister($02000007),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000)
+tregister($04060000),
+tregister($04060000),
+tregister($04070000),
+tregister($04060001),
+tregister($04060001),
+tregister($04070001),
+tregister($04060002),
+tregister($04060002),
+tregister($04070002),
+tregister($04060003),
+tregister($04060003),
+tregister($04070003),
+tregister($04060004),
+tregister($04060004),
+tregister($04070004),
+tregister($04060005),
+tregister($04060005),
+tregister($04070005),
+tregister($04060006),
+tregister($04060006),
+tregister($04070006),
+tregister($04060007),
+tregister($04060007),
+tregister($04070007),
+tregister($04060008),
+tregister($04060008),
+tregister($04070008),
+tregister($04060009),
+tregister($04060009),
+tregister($04070009),
+tregister($0406000A),
+tregister($0406000A),
+tregister($0407000A),
+tregister($0406000B),
+tregister($0406000B),
+tregister($0407000B),
+tregister($0406000C),
+tregister($0406000C),
+tregister($0407000C),
+tregister($0406000D),
+tregister($0406000D),
+tregister($0407000D),
+tregister($0406000E),
+tregister($0406000E),
+tregister($0407000E),
+tregister($0406000F),
+tregister($0406000F),
+tregister($0407000F),
+tregister($04070010),
+tregister($04070011),
+tregister($04070012),
+tregister($04070013),
+tregister($04070014),
+tregister($04070015),
+tregister($04070016),
+tregister($04070017),
+tregister($04070018),
+tregister($04070019),
+tregister($0407001A),
+tregister($0407001B),
+tregister($0407001C),
+tregister($0407001D),
+tregister($0407001E),
+tregister($0407001F),
+tregister($05000000),
+tregister($05000001)

compiler/arm/rarmrni.inc

@@ -26,49 +26,67 @@
 24,
 25,
 26,
-27,
-28,
 29,
-30,
+28,
 31,
 32,
-33,
-34,
 35,
-36,
+34,
 37,
 38,
-39,
-40,
 41,
-42,
+40,
 43,
 44,
-45,
-46,
 47,
-48,
+46,
 49,
 50,
-51,
-52,
 53,
-54,
+52,
 55,
 56,
-57,
-58,
 59,
-60,
+58,
 61,
 62,
-63,
-64,
 65,
-66,
+64,
 67,
 68,
-69,
-70,
 71,
-72
+70,
+27,
+30,
+33,
+36,
+39,
+42,
+45,
+48,
+51,
+54,
+57,
+60,
+63,
+66,
+69,
+72,
+73,
+74,
+75,
+76,
+77,
+78,
+79,
+80,
+81,
+82,
+83,
+84,
+85,
+86,
+87,
+88,
+89,
+90

compiler/arm/rarmsri.inc

@@ -1,5 +1,6 @@
 { don't edit, this file is generated from armreg.dat }
 0,
+89,
 27,
 30,
 57,
@@ -8,8 +9,24 @@
 66,
 69,
 72,
+73,
+74,
+75,
+76,
 33,
+77,
+78,
+79,
+80,
+81,
+82,
+83,
+84,
+85,
+86,
 36,
+87,
+88,
 39,
 42,
 45,
@@ -24,6 +41,7 @@
 22,
 23,
 24,
+90,
 1,
 2,
 11,

compiler/arm/rarmsta.inc

@@ -71,4 +71,22 @@
 0,
 0,
 0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
 0

compiler/arm/rarmstd.inc

@@ -71,4 +71,22 @@
 'd14',
 's20',
 's21',
-'d15'
+'d15',
+'d16',
+'d17',
+'d18',
+'d19',
+'d20',
+'d21',
+'d22',
+'d23',
+'d24',
+'d25',
+'d26',
+'d27',
+'d28',
+'d29',
+'d30',
+'d31',
+'cpsr_c',
+'fpscr'

compiler/arm/rarmsup.inc

@@ -27,48 +27,66 @@ RS_F7 = $07;
 RS_S0 = $00;
 RS_S1 = $00;
 RS_D0 = $00;
-RS_S2 = $00;
-RS_S3 = $00;
-RS_D1 = $00;
-RS_S4 = $00;
-RS_S5 = $00;
-RS_D2 = $00;
-RS_S6 = $00;
-RS_S7 = $00;
-RS_D3 = $00;
-RS_S8 = $00;
-RS_S9 = $00;
-RS_D4 = $00;
-RS_S10 = $00;
-RS_S11 = $00;
-RS_D5 = $00;
-RS_S12 = $00;
-RS_S13 = $00;
-RS_D6 = $00;
-RS_S14 = $00;
-RS_S15 = $00;
-RS_D7 = $00;
-RS_S16 = $00;
-RS_S17 = $00;
-RS_D8 = $00;
-RS_S18 = $00;
-RS_S19 = $00;
-RS_D9 = $00;
-RS_S20 = $00;
-RS_S21 = $00;
-RS_D10 = $00;
-RS_S22 = $00;
-RS_S23 = $00;
-RS_D11 = $00;
-RS_S24 = $00;
-RS_S25 = $00;
-RS_D12 = $00;
-RS_S26 = $00;
-RS_S27 = $00;
-RS_D13 = $00;
-RS_S28 = $00;
-RS_S29 = $00;
-RS_D14 = $00;
-RS_S30 = $00;
-RS_S31 = $00;
-RS_D15 = $00;
+RS_S2 = $01;
+RS_S3 = $01;
+RS_D1 = $01;
+RS_S4 = $02;
+RS_S5 = $02;
+RS_D2 = $02;
+RS_S6 = $03;
+RS_S7 = $03;
+RS_D3 = $03;
+RS_S8 = $04;
+RS_S9 = $04;
+RS_D4 = $04;
+RS_S10 = $05;
+RS_S11 = $05;
+RS_D5 = $05;
+RS_S12 = $06;
+RS_S13 = $06;
+RS_D6 = $06;
+RS_S14 = $07;
+RS_S15 = $07;
+RS_D7 = $07;
+RS_S16 = $08;
+RS_S17 = $08;
+RS_D8 = $08;
+RS_S18 = $09;
+RS_S19 = $09;
+RS_D9 = $09;
+RS_S20 = $0A;
+RS_S21 = $0A;
+RS_D10 = $0A;
+RS_S22 = $0B;
+RS_S23 = $0B;
+RS_D11 = $0B;
+RS_S24 = $0C;
+RS_S25 = $0C;
+RS_D12 = $0C;
+RS_S26 = $0D;
+RS_S27 = $0D;
+RS_D13 = $0D;
+RS_S28 = $0E;
+RS_S29 = $0E;
+RS_D14 = $0E;
+RS_S30 = $0F;
+RS_S31 = $0F;
+RS_D15 = $0F;
+RS_D16 = $10;
+RS_D17 = $11;
+RS_D18 = $12;
+RS_D19 = $13;
+RS_D20 = $14;
+RS_D21 = $15;
+RS_D22 = $16;
+RS_D23 = $17;
+RS_D24 = $18;
+RS_D25 = $19;
+RS_D26 = $1A;
+RS_D27 = $1B;
+RS_D28 = $1C;
+RS_D29 = $1D;
+RS_D30 = $1E;
+RS_D31 = $1F;
+RS_CPSR_C = $00;
+RS_FPSCR = $01;

compiler/arm/rgcpu.pas

@@ -37,6 +37,13 @@ unit rgcpu;
        trgcpu = class(trgobj)
          procedure do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
          procedure do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
+         procedure add_constraints(reg:tregister);override;
+         function  get_spill_subreg(r:tregister) : tsubregister;override;
+       end;
+
+       trgcputhumb2 = class(trgobj)
+         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;
        end;
 
        trgintcpu = class(trgcpu)
@@ -46,7 +53,7 @@ unit rgcpu;
   implementation
 
     uses
-      verbose, cutils,
+      verbose, cutils,globtype,
       cgobj,
       procinfo;
 
@@ -75,7 +82,7 @@ unit rgcpu;
         if abs(spilltemp.offset)>4095 then
           begin
             helplist:=TAsmList.create;
-            reference_reset(tmpref);
+            reference_reset(tmpref,sizeof(aint));
             { create consts entry }
             current_asmdata.getjumplabel(l);
             cg.a_label(current_procinfo.aktlocaldata,l);
@@ -93,7 +100,7 @@ unit rgcpu;
             tmpref.base:=NR_R15;
             helplist.concat(taicpu.op_reg_ref(A_LDR,hreg,tmpref));
 
-            reference_reset_base(tmpref,current_procinfo.framepointer,0);
+            reference_reset_base(tmpref,current_procinfo.framepointer,0,sizeof(aint));
             tmpref.index:=hreg;
 
             if spilltemp.index<>NR_NO then
@@ -121,7 +128,139 @@ unit rgcpu;
         if abs(spilltemp.offset)>4095 then
           begin
             helplist:=TAsmList.create;
-            reference_reset(tmpref);
+            reference_reset(tmpref,sizeof(aint));
+            { create consts entry }
+            current_asmdata.getjumplabel(l);
+            cg.a_label(current_procinfo.aktlocaldata,l);
+            tmpref.symboldata:=current_procinfo.aktlocaldata.last;
+
+            current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(spilltemp.offset));
+
+            { load consts entry }
+            if getregtype(tempreg)=R_INTREGISTER then
+              hreg:=getregisterinline(helplist,R_SUBWHOLE)
+            else
+              hreg:=cg.getintregister(helplist,OS_ADDR);
+            tmpref.symbol:=l;
+            tmpref.base:=NR_R15;
+            helplist.concat(taicpu.op_reg_ref(A_LDR,hreg,tmpref));
+
+            if spilltemp.index<>NR_NO then
+              internalerror(200401263);
+
+            reference_reset_base(tmpref,current_procinfo.framepointer,0,sizeof(pint));
+            tmpref.index:=hreg;
+
+            helplist.concat(spilling_create_store(tempreg,tmpref));
+
+            if getregtype(tempreg)=R_INTREGISTER then
+              ungetregisterinline(helplist,hreg);
+
+            list.insertlistafter(pos,helplist);
+            helplist.free;
+          end
+        else
+          inherited do_spill_written(list,pos,spilltemp,tempreg);
+      end;
+
+
+    procedure trgcpu.add_constraints(reg:tregister);
+      var
+        supreg,i : Tsuperregister;
+      begin
+        case getsubreg(reg) of
+          { Let 32bit floats conflict with all double precision regs > 15
+            (since these don't have 32 bit equivalents) }
+          R_SUBFS:
+            begin
+              supreg:=getsupreg(reg);
+              for i:=RS_D16 to RS_D31 do
+                add_edge(supreg,i);
+            end;
+        end;
+      end;
+
+
+    function  trgcpu.get_spill_subreg(r:tregister) : tsubregister;
+      begin
+        if (getregtype(r)<>R_MMREGISTER) then
+          result:=defaultsub
+        else
+          result:=getsubreg(r);
+      end;
+
+
+    procedure trgcputhumb2.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
+      var
+        tmpref : treference;
+        helplist : TAsmList;
+        l : tasmlabel;
+        hreg : tregister;
+      begin
+        { don't load spilled register between
+          mov lr,pc
+          mov pc,r4
+          but befure the mov lr,pc
+        }
+        if assigned(pos.previous) and
+          (pos.typ=ait_instruction) and
+          (taicpu(pos).opcode=A_MOV) and
+          (taicpu(pos).oper[0]^.typ=top_reg) and
+          (taicpu(pos).oper[0]^.reg=NR_R14) and
+          (taicpu(pos).oper[1]^.typ=top_reg) and
+          (taicpu(pos).oper[1]^.reg=NR_PC) then
+          pos:=tai(pos.previous);
+
+        if (spilltemp.offset>4095) or (spilltemp.offset<-255) then
+          begin
+            helplist:=TAsmList.create;
+            reference_reset(tmpref,sizeof(aint));
+            { create consts entry }
+            current_asmdata.getjumplabel(l);
+            cg.a_label(current_procinfo.aktlocaldata,l);
+            tmpref.symboldata:=current_procinfo.aktlocaldata.last;
+
+            current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(spilltemp.offset));
+
+            { load consts entry }
+            if getregtype(tempreg)=R_INTREGISTER then
+              hreg:=getregisterinline(helplist,R_SUBWHOLE)
+            else
+              hreg:=cg.getintregister(helplist,OS_ADDR);
+
+            tmpref.symbol:=l;
+            tmpref.base:=NR_R15;
+            helplist.concat(taicpu.op_reg_ref(A_LDR,hreg,tmpref));
+
+            reference_reset_base(tmpref,current_procinfo.framepointer,0,sizeof(aint));
+            tmpref.index:=hreg;
+
+            if spilltemp.index<>NR_NO then
+              internalerror(200401263);
+
+            helplist.concat(spilling_create_load(tmpref,tempreg));
+            if getregtype(tempreg)=R_INTREGISTER then
+              ungetregisterinline(helplist,hreg);
+
+            list.insertlistafter(pos,helplist);
+            helplist.free;
+          end
+        else
+          inherited do_spill_read(list,pos,spilltemp,tempreg);
+      end;
+
+
+    procedure trgcputhumb2.do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
+      var
+        tmpref : treference;
+        helplist : TAsmList;
+        l : tasmlabel;
+        hreg : tregister;
+      begin
+        if (spilltemp.offset>4095) or (spilltemp.offset<-255) then
+          begin
+            helplist:=TAsmList.create;
+            reference_reset(tmpref,sizeof(aint));
             { create consts entry }
             current_asmdata.getjumplabel(l);
             cg.a_label(current_procinfo.aktlocaldata,l);
@@ -141,7 +280,7 @@ unit rgcpu;
             if spilltemp.index<>NR_NO then
               internalerror(200401263);
 
-            reference_reset_base(tmpref,current_procinfo.framepointer,0);
+            reference_reset_base(tmpref,current_procinfo.framepointer,0,sizeof(pint));
             tmpref.index:=hreg;
 
             helplist.concat(spilling_create_store(tempreg,tmpref));

compiler/asmutils.pas

@@ -0,0 +1,118 @@
+{
+    Copyright (c) 1998-2006 by Florian Klaempfl
+
+    This unit contains utility functions for assembler output
+
+    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 asmutils;
+
+interface
+
+{$i fpcdefs.inc}
+
+uses
+  aasmbase,
+  aasmdata;
+
+
+    function emit_ansistring_const(list:TAsmList;data:PChar;len:LongInt;NewSection:Boolean=True):TAsmLabel;
+    function emit_unicodestring_const(list:TAsmList;data:Pointer;Winlike:Boolean):TAsmLabel;
+
+
+implementation
+
+uses
+  globals,
+  globtype,
+  systems,
+  verbose,
+  aasmtai,
+  widestr,
+  symdef;
+
+    function emit_ansistring_const(list:TAsmList;data:PChar;len:LongInt;NewSection:Boolean): TAsmLabel;
+      var
+        referencelab: TAsmLabel;
+        s: PChar;
+      begin
+        current_asmdata.getdatalabel(result);
+        if NewSection then
+          new_section(list,sec_rodata,result.name,const_align(sizeof(pint)));
+        referencelab := nil;
+        if target_info.system in systems_darwin then
+          begin
+            current_asmdata.getdatalabel(referencelab);
+            list.concat(tai_label.create(referencelab));
+          end;
+        list.concat(tai_const.create_pint(-1));
+        list.concat(tai_const.create_pint(len));
+        { make sure the string doesn't get dead stripped if the header is referenced }
+        if target_info.system in systems_darwin then
+          list.concat(tai_directive.create(asd_reference,result.name));
+        list.concat(tai_label.create(result));
+        { and vice versa }
+        if target_info.system in systems_darwin then
+          list.concat(tai_directive.create(asd_reference,referencelab.name));
+
+        getmem(s,len+1);
+        move(data^,s^,len);
+        s[len]:=#0;
+        list.concat(tai_string.create_pchar(s,len+1)); { terminating zero included }
+      end;
+
+    function emit_unicodestring_const(list:TAsmList;data:Pointer;Winlike:Boolean):TAsmLabel;
+      var
+        referencelab: TAsmLabel;
+        i, strlength: SizeInt;
+      begin
+        current_asmdata.getdatalabel(result);
+        new_section(list,sec_rodata,result.name,const_align(sizeof(pint)));
+        referencelab := nil;
+        if target_info.system in systems_darwin then
+          begin
+            current_asmdata.getdatalabel(referencelab);
+            list.concat(tai_label.create(referencelab));
+          end;
+        strlength := getlengthwidestring(pcompilerwidestring(data));
+        if Winlike then
+           list.concat(Tai_const.Create_32bit(strlength*cwidechartype.size))
+        else
+          begin
+            list.concat(Tai_const.Create_pint(-1));
+            list.concat(Tai_const.Create_pint(strlength*cwidechartype.size));
+          end;
+        { make sure the string doesn't get dead stripped if the header is referenced }
+        if (target_info.system in systems_darwin) then
+          list.concat(tai_directive.create(asd_reference,result.name));
+        list.concat(Tai_label.Create(result));
+        { ... and vice versa }
+        if (target_info.system in systems_darwin) then
+          list.concat(tai_directive.create(asd_reference,referencelab.name));
+        if cwidechartype.size = 2 then
+          begin
+            for i:=0 to strlength-1 do
+              list.concat(Tai_const.Create_16bit(pcompilerwidestring(data)^.data[i]));
+            { ending #0 }
+            list.concat(Tai_const.Create_16bit(0));
+          end
+        else
+          InternalError(200904271); { codegeneration for other sizes must be written }
+      end;
+
+
+end.

compiler/assemble.pas

@@ -131,6 +131,8 @@ interface
         procedure MakeObject;override;
       end;
 
+      { TInternalAssembler }
+
       TInternalAssembler=class(TAssembler)
       private
         FCObjOutput : TObjOutputclass;
@@ -142,6 +144,7 @@ interface
         currlist     : TAsmList;
         procedure WriteStab(p:pchar);
         function  MaybeNextList(var hp:Tai):boolean;
+        function  SetIndirectToSymbol(hp: Tai; const indirectname: string): Boolean;
         function  TreePass0(hp:Tai):Tai;
         function  TreePass1(hp:Tai):Tai;
         function  TreePass2(hp:Tai):Tai;
@@ -509,7 +512,10 @@ Implementation
         else
           result:='-m68000 '+result;
 {$endif}
-
+{$ifdef arm}
+        if (target_info.system=system_arm_darwin) then
+          Replace(result,'$ARCH',lower(cputypestr[current_settings.cputype]));
+{$endif arm}
         if (cs_link_on_target in current_settings.globalswitches) then
          begin
            Replace(result,'$ASM',maybequoted(ScriptFixFileName(AsmFileName)));
@@ -922,6 +928,33 @@ Implementation
       end;
 
 
+    function TInternalAssembler.SetIndirectToSymbol(hp: Tai; const indirectname: string): Boolean;
+      var
+        objsym  : TObjSymbol;
+        indsym  : TObjSymbol;
+      begin
+        Result:=
+          Assigned(hp) and
+          (hp.typ=ait_symbol);
+        if not Result then
+          Exit;
+        objsym:=Objdata.SymbolRef(tai_symbol(hp).sym);
+        objsym.size:=0;
+
+        indsym := TObjSymbol(ObjData.ObjSymbolList.Find(indirectname));
+        if not Assigned(indsym) then
+          begin
+            { it's possible that indirect symbol is not present in the list,
+              so we must create it as undefined }
+            indsym:=TObjSymbol.Create(ObjData.ObjSymbolList, indirectname);
+            indsym.typ:=AT_NONE;
+            indsym.bind:=AB_NONE;
+          end;
+        objsym.indsymbol:=indsym;
+        Result:=true;
+      end;
+
+
     function TInternalAssembler.TreePass0(hp:Tai):Tai;
       var
         objsym,
@@ -957,7 +990,7 @@ Implementation
                    end;
                end;
              ait_real_80bit :
-               ObjData.alloc(10);
+               ObjData.alloc(tai_real_80bit(hp).savesize);
              ait_real_64bit :
                ObjData.alloc(8);
              ait_real_32bit :
@@ -971,23 +1004,54 @@ Implementation
                  if assigned(tai_const(hp).sym) then
                    begin
                      objsym:=Objdata.SymbolRef(tai_const(hp).sym);
-                     if assigned(tai_const(hp).endsym) then
+                     { objsym already defined and there is endsym? }
+                     if assigned(objsym.objsection) and assigned(tai_const(hp).endsym) then
                        begin
                          objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
-                         if objsymend.objsection<>objsym.objsection then
-                           internalerror(200404124);
-                         Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
+                         { objsymend already defined? }
+                         if assigned(objsymend.objsection) then
+                           begin
+                             if objsymend.objsection<>objsym.objsection then
+                               internalerror(200404124);
+                             Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
+                           end;
                        end;
                    end;
                  ObjData.alloc(tai_const(hp).size);
                end;
+             ait_directive:
+               begin
+                 case tai_directive(hp).directive of
+                   asd_indirect_symbol:
+                     { handled in TreePass1 }
+                     ;
+                   asd_lazy_reference:
+                     begin
+                       if tai_directive(hp).name = nil then
+                         Internalerror(2009112101);
+                       objsym:=ObjData.symbolref(tai_directive(hp).name^);
+                       objsym.bind:=AB_LAZY;
+                     end;
+                   asd_reference:
+                     { ignore for now, but should be added}
+                     ;
+                   else
+                     internalerror(2010011101);
+                 end;
+               end;
              ait_section:
                begin
                  ObjData.CreateSection(Tai_section(hp).sectype,Tai_section(hp).name^,Tai_section(hp).secorder);
                  Tai_section(hp).sec:=ObjData.CurrObjSec;
                end;
              ait_symbol :
-               ObjData.SymbolDefine(Tai_symbol(hp).sym);
+               begin
+                 { needs extra support in the internal assembler }
+                 { the value is just ignored }
+                 {if tai_symbol(hp).has_value then
+                      internalerror(2009090804); ;}
+                 ObjData.SymbolDefine(Tai_symbol(hp).sym);
+               end;
              ait_label :
                ObjData.SymbolDefine(Tai_label(hp).labsym);
              ait_string :
@@ -1049,7 +1113,7 @@ Implementation
                    end;
                end;
              ait_real_80bit :
-               ObjData.alloc(10);
+               ObjData.alloc(tai_real_80bit(hp).savesize);
              ait_real_64bit :
                ObjData.alloc(8);
              ait_real_32bit :
@@ -1058,12 +1122,14 @@ Implementation
                ObjData.alloc(8);
              ait_const:
                begin
-                 { Recalculate relative symbols, all checks are done in treepass0 }
+                 { Recalculate relative symbols }
                  if assigned(tai_const(hp).sym) and
                     assigned(tai_const(hp).endsym) then
                    begin
                      objsym:=Objdata.SymbolRef(tai_const(hp).sym);
                      objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
+                     if objsymend.objsection<>objsym.objsection then
+                       internalerror(200905042);
                      Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
                    end;
                  ObjData.alloc(tai_const(hp).size);
@@ -1094,6 +1160,24 @@ Implementation
              ait_cutobject :
                if SmartAsm then
                 break;
+             ait_directive :
+               begin
+                 case tai_directive(hp).directive of
+                   asd_indirect_symbol:
+                     if tai_directive(hp).name = nil then
+                       Internalerror(2009101103)
+                     else if not SetIndirectToSymbol(Tai(hp.Previous), tai_directive(hp).name^) then
+                       Internalerror(2009101102);
+                   asd_lazy_reference:
+                     { handled in TreePass0 }
+                     ;
+                   asd_reference:
+                     { ignore for now, but should be added}
+                     ;
+                   else
+                     internalerror(2010011102);
+                 end;
+               end;
            end;
            hp:=Tai(hp.next);
          end;
@@ -1111,15 +1195,18 @@ Implementation
         lebbuf : array[0..63] of byte;
         objsym,
         objsymend : TObjSymbol;
+        zerobuf : array[0..63] of byte;
       begin
+        fillchar(zerobuf,sizeof(zerobuf),0);
         { main loop }
         while assigned(hp) do
          begin
            case hp.typ of
              ait_align :
                begin
-                 if (oso_data in ObjData.CurrObjSec.secoptions) then
-                   ObjData.writebytes(Tai_align_abstract(hp).calculatefillbuf(fillbuffer)^,Tai_align_abstract(hp).fillsize)
+                 if oso_data in ObjData.CurrObjSec.secoptions then
+                   ObjData.writebytes(Tai_align_abstract(hp).calculatefillbuf(fillbuffer,oso_executable in ObjData.CurrObjSec.secoptions)^,
+                     Tai_align_abstract(hp).fillsize)
                  else
                    ObjData.alloc(Tai_align_abstract(hp).fillsize);
                end;
@@ -1145,7 +1232,10 @@ Implementation
                    end;
                end;
              ait_real_80bit :
-               ObjData.writebytes(Tai_real_80bit(hp).value,10);
+               begin
+                 ObjData.writebytes(Tai_real_80bit(hp).value,10);
+                 ObjData.writebytes(zerobuf,Tai_real_80bit(hp).savesize-10);
+               end;
              ait_real_64bit :
                ObjData.writebytes(Tai_real_64bit(hp).value,8);
              ait_real_32bit :
@@ -1206,6 +1296,9 @@ Implementation
                          internalerror(200709271);
                        ObjData.writebytes(lebbuf,leblen);
                      end;
+                   aitconst_darwin_dwarf_delta32,
+                   aitconst_darwin_dwarf_delta64:
+                     ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
                    else
                      internalerror(200603254);
                  end;

compiler/avr/agavrgas.pas

@@ -168,7 +168,7 @@ unit agavrgas;
             idtxt  : 'AS';
             asmbin : 'as';
             asmcmd : '-o $OBJ $ASM';
-            supported_target : system_any;
+            supported_targets : [system_avr_embedded];
             flags : [af_allowdirect,af_needar,af_smartlink_sections];
             labelprefix : '.L';
             comment : '# ';

compiler/avr/cgcpu.pas

@@ -42,9 +42,9 @@ unit cgcpu;
         procedure init_register_allocators;override;
         procedure done_register_allocators;override;
 
-        procedure a_param_const(list : TAsmList;size : tcgsize;a : aint;const paraloc : TCGPara);override;
-        procedure a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);override;
-        procedure a_paramaddr_ref(list : TAsmList;const r : treference;const paraloc : TCGPara);override;
+        procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : aint;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_call_name(list : TAsmList;const s : string; weak: boolean);override;
         procedure a_call_reg(list : TAsmList;reg: tregister);override;
@@ -110,6 +110,8 @@ unit cgcpu;
         procedure a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
         procedure a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
       end;
+      
+    procedure create_codegen;
 
     const
       OpCmp2AsmCond : Array[topcmp] of TAsmCond = (C_NONE,C_EQ,C_GT,
@@ -144,17 +146,18 @@ unit cgcpu;
       end;
 
 
-    procedure tcgavr.a_param_const(list : TAsmList;size : tcgsize;a : aint;const paraloc : TCGPara);
+    procedure tcgavr.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : aint;const paraloc : TCGPara);
       var
         ref: treference;
       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);
+               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);
@@ -165,7 +168,7 @@ unit cgcpu;
       end;
 
 
-    procedure tcgavr.a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);
+    procedure tcgavr.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);
       var
         tmpref, ref: treference;
         location: pcgparalocation;
@@ -176,12 +179,13 @@ unit cgcpu;
         sizeleft := paraloc.intsize;
         while assigned(location) do
           begin
+            paramanager.allocparaloc(list,location);
             case location^.loc of
               LOC_REGISTER,LOC_CREGISTER:
                 a_load_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
               LOC_REFERENCE:
                 begin
-                  reference_reset_base(ref,location^.reference.index,location^.reference.offset);
+                  reference_reset_base(ref,location^.reference.index,location^.reference.offset,paraloc.alignment);
                   { doubles in softemu mode have a strange order of registers and references }
                   if location^.size=OS_32 then
                     g_concatcopy(list,tmpref,ref,4)
@@ -206,18 +210,19 @@ unit cgcpu;
       end;
 
 
-    procedure tcgavr.a_paramaddr_ref(list : TAsmList;const r : treference;const paraloc : TCGPara);
+    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);
+              reference_reset(ref,paraloc.alignment);
               ref.base := paraloc.location^.reference.index;
               ref.offset := paraloc.location^.reference.offset;
               tmpreg := getintregister(list,OS_ADDR);
@@ -368,8 +373,45 @@ unit cgcpu;
        end;
 
 
+     procedure tcgarm.a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);
+       var
+         oppostfix:toppostfix;
+         usedtmpref: treference;
+         tmpreg,tmpreg2 : tregister;
+         so : tshifterop;
+         dir : integer;
+       begin
+         if (TCGSize2Size[FromSize] >= TCGSize2Size[ToSize]) then
+           FromSize := ToSize;
+         case FromSize of
+           { signed integer registers }
+           OS_8:
+             oppostfix:=PF_B;
+           OS_S8:
+             oppostfix:=PF_SB;
+           OS_16:
+             oppostfix:=PF_H;
+           OS_S16:
+             oppostfix:=PF_SH;
+           OS_32,
+           OS_S32:
+             oppostfix:=PF_None;
+           else
+             InternalError(200308297);
+         end;
+         handle_load_store(list,A_LDR,oppostfix,reg,ref);
+
+         if (fromsize=OS_S8) and (tosize = OS_16) then
+           a_load_reg_reg(list,OS_16,OS_32,reg,reg);
+       end;
+
+
      procedure tcgavr.a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);
+       var
+         href : treference;
        begin
+         if (ref.base=R_NO) and (ref.index=R_NO) then
+
        end;
 
 
@@ -675,15 +717,12 @@ unit cgcpu;
         paramanager.getintparaloc(pocall_default,1,paraloc1);
         paramanager.getintparaloc(pocall_default,2,paraloc2);
         paramanager.getintparaloc(pocall_default,3,paraloc3);
-        paramanager.allocparaloc(list,paraloc3);
-        a_param_const(list,OS_INT,len,paraloc3);
-        paramanager.allocparaloc(list,paraloc2);
-        a_paramaddr_ref(list,dest,paraloc2);
-        paramanager.allocparaloc(list,paraloc2);
-        a_paramaddr_ref(list,source,paraloc1);
-        paramanager.freeparaloc(list,paraloc3);
-        paramanager.freeparaloc(list,paraloc2);
-        paramanager.freeparaloc(list,paraloc1);
+        a_load_const_cgpara(list,OS_INT,len,paraloc3);
+        a_loadaddr_ref_cgpara(list,dest,paraloc2);
+        a_loadaddr_ref_cgpara(list,source,paraloc1);
+        paramanager.freecgpara(list,paraloc3);
+        paramanager.freecgpara(list,paraloc2);
+        paramanager.freecgpara(list,paraloc1);
         alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
         a_call_name_static(list,'FPC_MOVE');
         dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
@@ -792,7 +831,10 @@ unit cgcpu;
       end;
 
 
-begin
-  cg:=tcgavr.create;
-  cg64:=tcg64favr.create;
+    procedure create_codegen;
+      begin
+        cg:=tcgavr.create;
+        cg64:=tcg64favr.create;
+      end;
+      
 end.

compiler/avr/cpubase.pas

@@ -332,7 +332,7 @@ unit cpubase;
 
     { Returns the tcgsize corresponding with the size of reg.}
     function reg_cgsize(const reg: tregister) : tcgsize;
-    function cgsize2subreg(s:Tcgsize):Tsubregister;
+    function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister;
     procedure inverse_flags(var f: TResFlags);
     function flags_to_cond(const f: TResFlags) : TAsmCond;
     function findreg_by_number(r:Tregister):tregisterindex;
@@ -367,7 +367,7 @@ unit cpubase;
       );
 
 
-    function cgsize2subreg(s:Tcgsize):Tsubregister;
+    function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister;
       begin
         cgsize2subreg:=R_SUBWHOLE;
       end;

compiler/avr/cpuinfo.pas

@@ -40,6 +40,16 @@ Type
       fp_libgcc
      );
 
+   tcontrollertype =
+     (ct_none,
+
+      ct_atmega16,
+      ct_atmega32,
+      ct_atmega48,
+      ct_atmega64,
+      ct_atmega128
+     );
+
 Const
    {# Size of native extended floating point type }
    extended_size = 12;
@@ -71,16 +81,35 @@ Const
      'LIBGCC'
    );
 
+   controllertypestr : array[tcontrollertype] of string[20] =
+     ('',
+      'ATMEGA16',
+      'ATMEGA32',
+      'ATMEGA48',
+      'ATMEGA64',
+      'ATMEGA128'
+     );
+
+   controllerunitstr : array[tcontrollertype] of string[20] =
+     ('',
+      'ATMEGA16',
+      'ATMEGA32',
+      'ATMEGA48',
+      'ATMEGA64',
+      'ATMEGA128'
+     );
    { Supported optimizations, only used for information }
    supported_optimizerswitches = genericlevel1optimizerswitches+
                                  genericlevel2optimizerswitches+
                                  genericlevel3optimizerswitches-
                                  { no need to write info about those }
                                  [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
-                                 [cs_opt_regvar,cs_opt_loopunroll,cs_opt_tailrecursion,cs_opt_stackframe];
+                                 [cs_opt_regvar,cs_opt_loopunroll,cs_opt_tailrecursion,
+								  cs_opt_stackframe,cs_opt_nodecse];
 
    level1optimizerswitches = genericlevel1optimizerswitches;
-   level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + [cs_opt_regvar,cs_opt_stackframe,cs_opt_tailrecursion];
+   level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + 
+     [cs_opt_regvar,cs_opt_stackframe,cs_opt_tailrecursion];
    level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}];
 
 Implementation

compiler/avr/cpunode.pas

@@ -36,6 +36,7 @@ unit cpunode;
        }
        ,navradd
        ,navrmat
+       ,navrcnv
        ;
 
 

compiler/avr/cpupara.pas

@@ -29,7 +29,7 @@ unit cpupara;
     uses
        globtype,globals,
        aasmtai,aasmdata,
-       cpuinfo,cpubase,cgbase,
+       cpuinfo,cpubase,cgbase,cgutils,
        symconst,symbase,symtype,symdef,parabase,paramgr;
 
     type
@@ -41,10 +41,12 @@ unit cpupara;
           procedure getintparaloc(calloption : tproccalloption; 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; def: tdef): tcgpara;override;
          private
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
           function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
             var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
+          procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
        end;
 
   implementation
@@ -52,8 +54,7 @@ unit cpupara;
     uses
        verbose,systems,
        rgobj,
-       defutil,symsym,
-       cgutils;
+       defutil,symsym;
 
 
     function tavrparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
@@ -225,7 +226,11 @@ unit cpupara;
 
       procedure assignintreg;
         begin
-           if nextintreg<=RS_R3 then
+          { In case of po_delphi_nested_cc, the parent frame pointer
+            is always passed on the stack. }
+           if (nextintreg<=RS_R3) and
+              (not(vo_is_parentfp in hp.varoptions) or
+               not(po_delphi_nested_cc in p.procoptions)) then
              begin
                paraloc^.loc:=LOC_REGISTER;
                paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
@@ -396,30 +401,57 @@ unit cpupara;
 
         result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
 
-        { Constructors return self instead of a boolean }
-        if (p.proctypeoption=potype_constructor) then
-          retcgsize:=OS_ADDR
-        else
-          retcgsize:=def_cgsize(p.returndef);
+        create_funcretloc_info(p,side);
+     end;
 
-        location_reset(p.funcretloc[side],LOC_INVALID,OS_NO);
-        p.funcretloc[side].size:=retcgsize;
 
+    procedure tavrparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
+      begin
+        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
+      end;
+
+
+    function  tavrparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;
+      var
+        retcgsize : tcgsize;
+        paraloc : pcgparalocation;
+      begin
+        result.init;
+        result.alignment:=get_para_align(p.proccalloption);
         { void has no location }
-        if is_void(p.returndef) then
+        if is_void(def) then
           begin
-            location_reset(p.funcretloc[side],LOC_VOID,OS_NO);
+            paraloc:=result.add_location;
+            result.size:=OS_NO;
+            result.intsize:=0;
+            paraloc^.size:=OS_NO;
+            paraloc^.loc:=LOC_VOID;
             exit;
           end;
+        { Constructors return self instead of a boolean }
+        if (p.proctypeoption=potype_constructor) then
+          begin
+            retcgsize:=OS_ADDR;
+            result.intsize:=sizeof(pint);
+          end
+        else
+          begin
+            retcgsize:=def_cgsize(def);
+            result.intsize:=def.size;
+          end;
+        result.size:=retcgsize;
         { Return is passed as var parameter }
-        if ret_in_param(p.returndef,p.proccalloption) then
+        if ret_in_param(def,p.proccalloption) then
           begin
-            p.funcretloc[side].loc:=LOC_REFERENCE;
-            p.funcretloc[side].size:=retcgsize;
+            paraloc:=result.add_location;
+            paraloc^.loc:=LOC_REFERENCE;
+            paraloc^.size:=retcgsize;
             exit;
           end;
+
+        paraloc:=result.add_location;
         { Return in FPU register? }
-        if p.returndef.typ=floatdef then
+        if def.typ=floatdef then
           begin
             if (p.proccalloption in [pocall_softfloat]) or (cs_fp_emulation in current_settings.moduleswitches) then
               begin
@@ -427,18 +459,20 @@ unit cpupara;
                   OS_64,
                   OS_F64:
                     begin
-                      { low }
-                      p.funcretloc[side].loc:=LOC_REGISTER;
-                      p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG;
-                      p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG;
-                      p.funcretloc[side].size:=OS_64;
+                      paraloc^.loc:=LOC_REGISTER;
+                      paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG;
+                      paraloc^.size:=OS_32;
+                      paraloc:=result.add_location;
+                      paraloc^.loc:=LOC_REGISTER;
+                      paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG;
+                      paraloc^.size:=OS_32;
                     end;
                   OS_32,
                   OS_F32:
                     begin
-                      p.funcretloc[side].loc:=LOC_REGISTER;
-                      p.funcretloc[side].register:=NR_FUNCTION_RETURN_REG;
-                      p.funcretloc[side].size:=OS_32;
+                      paraloc^.loc:=LOC_REGISTER;
+                      paraloc^.register:=NR_FUNCTION_RETURN_REG;
+                      paraloc^.size:=OS_32;
                     end;
                   else
                     internalerror(2005082603);
@@ -446,8 +480,9 @@ unit cpupara;
               end
             else
               begin
-                p.funcretloc[side].loc:=LOC_FPUREGISTER;
-                p.funcretloc[side].register:=NR_FPU_RESULT_REG;
+                paraloc^.loc:=LOC_FPUREGISTER;
+                paraloc^.register:=NR_FPU_RESULT_REG;
+                paraloc^.size:=retcgsize;
               end;
           end
           { Return in register }
@@ -455,19 +490,22 @@ unit cpupara;
           begin
             if retcgsize in [OS_64,OS_S64] then
               begin
-                { low }
-                p.funcretloc[side].loc:=LOC_REGISTER;
-                p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG;
-                p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG;
+                paraloc^.loc:=LOC_REGISTER;
+                paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG;
+                paraloc^.size:=OS_32;
+                paraloc:=result.add_location;
+                paraloc^.loc:=LOC_REGISTER;
+                paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG;
+                paraloc^.size:=OS_32;
               end
             else
               begin
-                p.funcretloc[side].loc:=LOC_REGISTER;
-                p.funcretloc[side].register:=NR_FUNCTION_RETURN_REG;
+                paraloc^.loc:=LOC_REGISTER;
+                paraloc^.register:=NR_FUNCTION_RETURN_REG;
+                paraloc^.size:=OS_32;
               end;
-
           end;
-     end;
+      end;
 
 
     function tavrparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;

compiler/avr/navradd.pas

@@ -196,7 +196,18 @@ interface
     function tavraddnode.pass_1 : tnode;
       begin
         result:=inherited pass_1;
-
+{
+        if not(assigned(result)) then
+          begin
+            unsigned:=not(is_signed(left.resultdef)) or
+              not(is_signed(right.resultdef));
+
+            if is_64bit(left.resultdef) and
+              ((nodetype in [equaln,unequaln]) or
+               (unsigned and (nodetype in [ltn,lten,gtn,gten]))
+              ) then
+              expectloc:=LOC_FLAGS;
+          end;
         { handling boolean expressions }
         if not(assigned(result)) and
            (
@@ -205,6 +216,7 @@ interface
              is_dynamic_array(left.resultdef)
            ) then
           expectloc:=LOC_FLAGS;
+}
       end;
 
 

compiler/avr/navrcnv.pas

@@ -0,0 +1,180 @@
+{
+    Copyright (c) 1998-2009 by Florian Klaempfl
+
+    Generate AVR assembler for type converting nodes
+
+    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 navrcnv;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      node,ncnv,ncgcnv,defcmp;
+
+    type
+       tarmtypeconvnode = class(tcgtypeconvnode)
+         protected
+         { procedure second_int_to_int;override; }
+         { procedure second_string_to_string;override; }
+         { procedure second_cstring_to_pchar;override; }
+         { procedure second_string_to_chararray;override; }
+         { procedure second_array_to_pointer;override; }
+         { procedure second_pointer_to_array;override; }
+         { procedure second_chararray_to_string;override; }
+         { procedure second_char_to_string;override; }
+         { procedure second_int_to_real;override; }
+         { procedure second_real_to_real;override; }
+         { procedure second_cord_to_pointer;override; }
+         { procedure second_proc_to_procvar;override; }
+         { procedure second_bool_to_int;override; }
+           procedure second_int_to_bool;override;
+         { procedure second_load_smallset;override;  }
+         { procedure second_ansistring_to_pchar;override; }
+         { procedure second_pchar_to_string;override; }
+         { procedure second_class_to_intf;override; }
+         { procedure second_char_to_char;override; }
+       end;
+
+implementation
+
+   uses
+      verbose,globtype,globals,systems,
+      symconst,symdef,aasmbase,aasmtai,aasmdata,
+      defutil,
+      cgbase,cgutils,
+      pass_1,pass_2,procinfo,
+      ncon,ncal,
+      ncgutil,
+      cpubase,aasmcpu,
+      rgobj,tgobj,cgobj,cgcpu;
+
+
+    procedure tarmtypeconvnode.second_int_to_bool;
+      var
+        hregister : tregister;
+        href      : treference;
+        resflags  : tresflags;
+        hlabel,oldTrueLabel,oldFalseLabel : tasmlabel;
+        newsize   : tcgsize;
+      begin
+        {
+        oldTrueLabel:=current_procinfo.CurrTrueLabel;
+        oldFalseLabel:=current_procinfo.CurrFalseLabel;
+        current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
+        current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
+        secondpass(left);
+        if codegenerror then
+         exit;
+
+        { Explicit typecasts from any ordinal type to a boolean type }
+        { must not change the ordinal value                          }
+        if (nf_explicit in flags) and
+           not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
+          begin
+             location_copy(location,left.location);
+             newsize:=def_cgsize(resultdef);
+             { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }
+             if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or
+                ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
+               location_force_reg(current_asmdata.CurrAsmList,location,newsize,true)
+             else
+               location.size:=newsize;
+             current_procinfo.CurrTrueLabel:=oldTrueLabel;
+             current_procinfo.CurrFalseLabel:=oldFalseLabel;
+             exit;
+          end;
+
+        { Load left node into flag F_NE/F_E }
+        resflags:=F_NE;
+        case left.location.loc of
+          LOC_CREFERENCE,
+          LOC_REFERENCE :
+            begin
+              if left.location.size in [OS_64,OS_S64] then
+               begin
+                 hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+                 cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.reference,hregister);
+                 href:=left.location.reference;
+                 inc(href.offset,4);
+                 tcgarm(cg).cgsetflags:=true;
+                 cg.a_op_ref_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,href,hregister);
+                 tcgarm(cg).cgsetflags:=false;
+               end
+              else
+               begin
+                 location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,true);
+                 tcgarm(cg).cgsetflags:=true;
+                 cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register);
+                 tcgarm(cg).cgsetflags:=false;
+               end;
+            end;
+          LOC_FLAGS :
+            begin
+              resflags:=left.location.resflags;
+            end;
+          LOC_REGISTER,LOC_CREGISTER :
+            begin
+              if left.location.size in [OS_64,OS_S64] then
+               begin
+                 hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+                 cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.register64.reglo,hregister);
+                 tcgarm(cg).cgsetflags:=true;
+                 cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reghi,hregister);
+                 tcgarm(cg).cgsetflags:=false;
+               end
+              else
+               begin
+                 tcgarm(cg).cgsetflags:=true;
+                 cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register);
+                 tcgarm(cg).cgsetflags:=false;
+               end;
+            end;
+          LOC_JUMP :
+            begin
+              hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+              current_asmdata.getjumplabel(hlabel);
+              cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
+              cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hregister);
+              cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel);
+              cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
+              cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hregister);
+              cg.a_label(current_asmdata.CurrAsmList,hlabel);
+              tcgarm(cg).cgsetflags:=true;
+              cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT,hregister,hregister);
+              tcgarm(cg).cgsetflags:=false;
+            end;
+          else
+            internalerror(200311301);
+        end;
+        { load flags to register }
+        location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
+        location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
+        cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,location.register);
+        if (is_cbool(resultdef)) then
+          cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,location.register,location.register);
+        current_procinfo.CurrTrueLabel:=oldTrueLabel;
+        current_procinfo.CurrFalseLabel:=oldFalseLabel;
+        }
+      end;
+
+
+begin
+  ctypeconvnode:=tarmtypeconvnode;
+end.

compiler/avr/navrmat.pas

@@ -81,9 +81,9 @@ implementation
         resultreg  : tregister;
         size       : Tcgsize;
         so : tshifterop;
-{
        procedure genOrdConstNodeDiv;
          begin
+{
            if tordconstnode(right).value=0 then
              internalerror(2005061701)
            else if tordconstnode(right).value=1 then
@@ -116,13 +116,15 @@ implementation
                else
                  cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,power,numerator,resultreg)
              end;
-         end;
 }
-{
+         end;
+
+
        procedure genOrdConstNodeMod;
          var
              modreg, maskreg, tempreg : tregister;
          begin
+{
              if (tordconstnode(right).value = 0) then begin
                  internalerror(2005061702);
              end
@@ -156,15 +158,15 @@ implementation
                  cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_MUL, OS_INT, tordconstnode(right).value.svalue, resultreg, resultreg);
                  cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, resultreg, numerator, resultreg);
              end;
-         end;
 }
+         end;
 
       begin
-{
         secondpass(left);
         secondpass(right);
         location_copy(location,left.location);
 
+{
         { put numerator in register }
         size:=def_cgsize(left.resultdef);
         location_force_reg(current_asmdata.CurrAsmList,left.location,
@@ -190,7 +192,7 @@ implementation
             if nodetype=divn then
               genOrdConstNodeDiv
             else
-//              genOrdConstNodeMod;
+              genOrdConstNodeMod;
           end;
 
         location.register:=resultreg;

compiler/browcol.pas

@@ -280,71 +280,81 @@ const
      ObjType: 3001;
      VmtLink: Ofs(TypeOf(TModuleNameCollection)^);
      Load:    @TModuleNameCollection.Load;
-     Store:   @TModuleNameCollection.Store
+     Store:   @TModuleNameCollection.Store;
+     Next: nil
   );
   RTypeNameCollection: TStreamRec = (
      ObjType: 3002;
      VmtLink: Ofs(TypeOf(TTypeNameCollection)^);
      Load:    @TTypeNameCollection.Load;
-     Store:   @TTypeNameCollection.Store
+     Store:   @TTypeNameCollection.Store;
+     Next: nil
   );
   RReference: TStreamRec = (
      ObjType: 3003;
      VmtLink: Ofs(TypeOf(TReference)^);
      Load:    @TReference.Load;
-     Store:   @TReference.Store
+     Store:   @TReference.Store;
+     Next: nil
   );
   RSymbol: TStreamRec = (
      ObjType: 3004;
      VmtLink: Ofs(TypeOf(TSymbol)^);
      Load:    @TSymbol.Load;
-     Store:   @TSymbol.Store
+     Store:   @TSymbol.Store;
+     Next: nil
   );
   RObjectSymbol: TStreamRec = (
      ObjType: 3005;
      VmtLink: Ofs(TypeOf(TObjectSymbol)^);
      Load:    @TObjectSymbol.Load;
-     Store:   @TObjectSymbol.Store
+     Store:   @TObjectSymbol.Store;
+     Next: nil
   );
   RSymbolCollection: TStreamRec = (
      ObjType: 3006;
      VmtLink: Ofs(TypeOf(TSymbolCollection)^);
      Load:    @TSymbolCollection.Load;
-     Store:   @TSymbolCollection.Store
+     Store:   @TSymbolCollection.Store;
+     Next: nil
   );
   RSortedSymbolCollection: TStreamRec = (
      ObjType: 3007;
      VmtLink: Ofs(TypeOf(TSortedSymbolCollection)^);
      Load:    @TSortedSymbolCollection.Load;
-     Store:   @TSortedSymbolCollection.Store
+     Store:   @TSortedSymbolCollection.Store;
+     Next: nil
   );
   RIDSortedSymbolCollection: TStreamRec = (
      ObjType: 3008;
      VmtLink: Ofs(TypeOf(TIDSortedSymbolCollection)^);
      Load:    @TIDSortedSymbolCollection.Load;
-     Store:   @TIDSortedSymbolCollection.Store
+     Store:   @TIDSortedSymbolCollection.Store;
+     Next: nil
   );
   RObjectSymbolCollection: TStreamRec = (
      ObjType: 3009;
      VmtLink: Ofs(TypeOf(TObjectSymbolCollection)^);
      Load:    @TObjectSymbolCollection.Load;
-     Store:   @TObjectSymbolCollection.Store
+     Store:   @TObjectSymbolCollection.Store;
+     Next: nil
   );
   RReferenceCollection: TStreamRec = (
      ObjType: 3010;
      VmtLink: Ofs(TypeOf(TReferenceCollection)^);
      Load:    @TReferenceCollection.Load;
-     Store:   @TReferenceCollection.Store
+     Store:   @TReferenceCollection.Store;
+     Next: nil
   );
   RModuleSymbol: TStreamRec = (
      ObjType: 3011;
      VmtLink: Ofs(TypeOf(TModuleSymbol)^);
      Load:    @TModuleSymbol.Load;
-     Store:   @TModuleSymbol.Store
+     Store:   @TModuleSymbol.Store;
+     Next: nil
   );
 
   SymbolCount : longint = 0;
-  Current_moduleIndex : longint = 0;
 
 {****************************************************************************
                                    Helpers
@@ -609,8 +619,8 @@ begin
   if S1<S2 then R:=-1 else
   if S1>S2 then R:=1 else
   { make sure that we distinguish between different objects with the same name }
-  if Ptrint(K1^.Symbol)<Ptrint(K2^.Symbol) then R:=-1 else
-  if Ptrint(K1^.Symbol)>Ptrint(K2^.Symbol) then R:= 1 else
+  if PtrUInt(K1^.Symbol)<PtrUInt(K2^.Symbol) then R:=-1 else
+  if PtrUInt(K1^.Symbol)>PtrUInt(K2^.Symbol) then R:= 1 else
   R:=0;
   Compare:=R;
 end;
@@ -1231,7 +1241,7 @@ end;
 
 
   procedure ProcessSymTable(OwnerSym: PSymbol; var Owner: PSymbolCollection; Table: TSymTable);
-  var I,J: longint;
+  var I: longint;
       Sym: TSym;
       pd : TProcDef;
       Symbol: PSymbol;
@@ -1249,19 +1259,17 @@ end;
   end;
   function GetDefinitionStr(def: tdef): string; forward;
   function GetEnumDefStr(def: tenumdef): string;
-  var Name: string;
-      esym: tenumsym;
-      Count: integer;
+  var
+    Name: string;
+    esym: tenumsym;
+    i: integer;
   begin
     Name:='(';
-    esym:=tenumsym(def.Firstenum); Count:=0;
-    while (esym<>nil) do
+    for i := 0 to def.symtable.SymList.Count - 1 do
       begin
-        if Count>0 then
+        if i>0 then
           Name:=Name+', ';
-        Name:=Name+esym.name;
-        esym:=esym.nextenum;
-        Inc(Count);
+        Name:=Name+tenumsym(def.symtable.SymList[i]).name;
       end;
     Name:=Name+')';
     GetEnumDefStr:=Name;
@@ -1757,7 +1765,6 @@ begin
   if (cs_browser in current_settings.moduleswitches) then
    while assigned(hp) do
     begin
-       current_moduleindex:=hp.unit_index;
        if hp.is_unit then
          t:=tsymtable(hp.globalsymtable)
        else
@@ -2108,8 +2115,8 @@ var K1: PPointerXRef absolute Key1;
     K2: PPointerXRef absolute Key2;
     R: integer;
 begin
-  if Ptrint(K1^.PtrValue)<Ptrint(K2^.PtrValue) then R:=-1 else
-  if Ptrint(K1^.PtrValue)>Ptrint(K2^.PtrValue) then R:= 1 else
+  if PtrUInt(K1^.PtrValue)<PtrUInt(K2^.PtrValue) then R:=-1 else
+  if PtrUInt(K1^.PtrValue)>PtrUInt(K2^.PtrValue) then R:= 1 else
   R:=0;
   Compare:=R;
 end;

compiler/catch.pas

@@ -30,13 +30,14 @@ Unit catch;
 
 interface
 uses
-{$ifdef unix}
+{ you cannot safely raise an exception inside a signal handler on any OS,
+  and on darwin this even often crashes
+}
+{$if defined(unix) and not defined(darwin) }
+ {$ifndef darwin}
   {$define has_signal}
-  {$ifdef havelinuxrtl10}
-    Linux,
-  {$else}
-    BaseUnix,Unix,
-  {$endif}
+  BaseUnix,Unix,
+ {$endif}
 {$endif}
 {$ifdef go32v2}
 {$define has_signal}
@@ -54,8 +55,6 @@ Var
   OldSigInt : SignalHandler;
 {$endif}
 
-Const in_const_evaluation : boolean = false;
-
 Implementation
 
 uses
@@ -82,7 +81,7 @@ begin
 {$ifndef nocatch}
   {$ifdef has_signal}
     NewSignal:=SignalHandler(@CatchSignal);
-    OldSigInt:={$ifdef havelinuxrtl10}Signal{$else}{$ifdef Unix}fpSignal{$else}Signal{$endif}{$endif}  (SIGINT,NewSignal);
+    OldSigInt:={$ifdef Unix}fpSignal{$else}Signal{$endif}(SIGINT,NewSignal);
   {$endif}
 {$endif nocatch}
 end.

compiler/cclasses.pas

@@ -24,8 +24,7 @@ unit cclasses;
 {$i fpcdefs.inc}
 
 {$ifndef VER2_0}
-  { Disabled for now, gives an IE 200311075 when compiling the IDE }
-  { $define CCLASSESINLINE}
+  {$define CCLASSESINLINE}
 {$endif}
 
 interface
@@ -64,6 +63,7 @@ interface
 const
    SListIndexError = 'List index exceeds bounds (%d)';
    SListCapacityError = 'The maximum list capacity is reached (%d)';
+   SListCapacityPower2Error = 'The capacity has to be a power of 2, but is set to %d';
    SListCountError = 'List count too large (%d)';
 type
    EListError = class(Exception);
@@ -83,9 +83,9 @@ type
     FCount: Integer;
     FCapacity: Integer;
   protected
-    function Get(Index: Integer): Pointer; {$ifdef CCLASSESINLINE}inline;{$endif}
-    procedure Put(Index: Integer; Item: Pointer); {$ifdef CCLASSESINLINE}inline;{$endif}
-    procedure SetCapacity(NewCapacity: Integer); {$ifdef CCLASSESINLINE}inline;{$endif}
+    function Get(Index: Integer): Pointer;
+    procedure Put(Index: Integer; Item: Pointer);
+    procedure SetCapacity(NewCapacity: Integer);
     procedure SetCount(NewCount: Integer);
     Procedure RaiseIndexError(Index : Integer);
   public
@@ -97,10 +97,10 @@ type
     procedure Exchange(Index1, Index2: Integer);
     function Expand: TFPList;
     function Extract(item: Pointer): Pointer;
-    function First: Pointer; {$ifdef CCLASSESINLINE}inline;{$endif}
+    function First: Pointer;
     function IndexOf(Item: Pointer): Integer;
     procedure Insert(Index: Integer; Item: Pointer);
-    function Last: Pointer; {$ifdef CCLASSESINLINE}inline;{$endif}
+    function Last: Pointer;
     procedure Move(CurIndex, NewIndex: Integer);
     procedure Assign(Obj:TFPList);
     function Remove(Item: Pointer): Integer;
@@ -127,10 +127,10 @@ type
     FFreeObjects : Boolean;
     FList: TFPList;
     function GetCount: integer; {$ifdef CCLASSESINLINE}inline;{$endif}
-    procedure SetCount(const AValue: integer); {$ifdef CCLASSESINLINE}inline;{$endif}
+    procedure SetCount(const AValue: integer);
   protected
     function GetItem(Index: Integer): TObject; {$ifdef CCLASSESINLINE}inline;{$endif}
-    procedure SetItem(Index: Integer; AObject: TObject); {$ifdef CCLASSESINLINE}inline;{$endif}
+    procedure SetItem(Index: Integer; AObject: TObject);
     procedure SetCapacity(NewCapacity: Integer); {$ifdef CCLASSESINLINE}inline;{$endif}
     function GetCapacity: integer; {$ifdef CCLASSESINLINE}inline;{$endif}
   public
@@ -139,7 +139,7 @@ type
     destructor Destroy; override;
     procedure Clear;
     function Add(AObject: TObject): Integer; {$ifdef CCLASSESINLINE}inline;{$endif}
-    procedure Delete(Index: Integer); {$ifdef CCLASSESINLINE}inline;{$endif}
+    procedure Delete(Index: Integer);
     procedure Exchange(Index1, Index2: Integer); {$ifdef CCLASSESINLINE}inline;{$endif}
     function Expand: TFPObjectList;{$ifdef CCLASSESINLINE}inline;{$endif}
     function Extract(Item: TObject): TObject; {$ifdef CCLASSESINLINE}inline;{$endif}
@@ -150,7 +150,7 @@ type
     function First: TObject; {$ifdef CCLASSESINLINE}inline;{$endif}
     function Last: TObject; {$ifdef CCLASSESINLINE}inline;{$endif}
     procedure Move(CurIndex, NewIndex: Integer); {$ifdef CCLASSESINLINE}inline;{$endif}
-    procedure Assign(Obj:TFPObjectList); {$ifdef CCLASSESINLINE}inline;{$endif}
+    procedure Assign(Obj:TFPObjectList);
     procedure Pack; {$ifdef CCLASSESINLINE}inline;{$endif}
     procedure Sort(Compare: TListSortCompare); {$ifdef CCLASSESINLINE}inline;{$endif}
     procedure ForEachCall(proc2call:TObjectListCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif}
@@ -189,6 +189,7 @@ type
     FHashList     : PHashItemList;
     FCount,
     FCapacity : Integer;
+    FCapacityMask: LongWord;
     { Hash }
     FHashTable    : PHashTable;
     FHashCapacity : Integer;
@@ -198,8 +199,8 @@ type
     FStrCapacity : Integer;
     function InternalFind(AHash:LongWord;const AName:shortstring;out PrevIndex:Integer):Integer;
   protected
-    function Get(Index: Integer): Pointer; {$ifdef CCLASSESINLINE}inline;{$endif}
-    procedure Put(Index: Integer; Item: Pointer); {$ifdef CCLASSESINLINE}inline;{$endif}
+    function Get(Index: Integer): Pointer;
+    procedure Put(Index: Integer; Item: Pointer);
     procedure SetCapacity(NewCapacity: Integer);
     procedure SetCount(NewCount: Integer);
     Procedure RaiseIndexError(Index : Integer);
@@ -214,8 +215,8 @@ type
     destructor Destroy; override;
     function Add(const AName:shortstring;Item: Pointer): Integer;
     procedure Clear;
-    function NameOfIndex(Index: Integer): ShortString; {$ifdef CCLASSESINLINE}inline;{$endif}
-    function HashOfIndex(Index: Integer): LongWord; {$ifdef CCLASSESINLINE}inline;{$endif}
+    function NameOfIndex(Index: Integer): ShortString;
+    function HashOfIndex(Index: Integer): LongWord;
     function GetNextCollision(Index: Integer): Integer;
     procedure Delete(Index: Integer);
     class procedure Error(const Msg: string; Data: PtrInt);
@@ -259,7 +260,7 @@ type
   public
     constructor CreateNotOwned;
     constructor Create(HashObjectList:TFPHashObjectList;const s:shortstring);
-    procedure ChangeOwner(HashObjectList:TFPHashObjectList); {$ifdef CCLASSESINLINE}inline;{$endif}
+    procedure ChangeOwner(HashObjectList:TFPHashObjectList);
     procedure ChangeOwnerAndName(HashObjectList:TFPHashObjectList;const s:shortstring); {$ifdef CCLASSESINLINE}inline;{$endif}
     procedure Rename(const ANewName:shortstring);
     property Name:shortstring read GetName;
@@ -271,10 +272,10 @@ type
     FFreeObjects : Boolean;
     FHashList: TFPHashList;
     function GetCount: integer; {$ifdef CCLASSESINLINE}inline;{$endif}
-    procedure SetCount(const AValue: integer); {$ifdef CCLASSESINLINE}inline;{$endif}
+    procedure SetCount(const AValue: integer);
   protected
     function GetItem(Index: Integer): TObject; {$ifdef CCLASSESINLINE}inline;{$endif}
-    procedure SetItem(Index: Integer; AObject: TObject); {$ifdef CCLASSESINLINE}inline;{$endif}
+    procedure SetItem(Index: Integer; AObject: TObject);
     procedure SetCapacity(NewCapacity: Integer); {$ifdef CCLASSESINLINE}inline;{$endif}
     function GetCapacity: integer; {$ifdef CCLASSESINLINE}inline;{$endif}
   public
@@ -504,6 +505,35 @@ type
       end;
 
 
+{******************************************************************
+                             tbitset
+*******************************************************************}
+
+       tbitset = class
+       private
+         fdata: pbyte;
+         fdatasize: longint;
+       public
+         constructor create(initsize: longint);
+         constructor create_bytesize(bytesize: longint);
+         destructor destroy; override;
+         procedure clear;
+         procedure grow(nsize: longint);
+         { sets a bit }
+         procedure include(index: longint);
+         { clears a bit }
+         procedure exclude(index: longint);
+         { finds an entry, creates one if not exists }
+         function isset(index: longint): boolean;
+
+         procedure addset(aset: tbitset);
+         procedure subset(aset: tbitset);
+
+         property data: pbyte read fdata;
+         property datasize: longint read fdatasize;
+      end;
+
+
     function FPHash(const s:shortstring):LongWord;
     function FPHash(P: PChar; Len: Integer): LongWord;
 
@@ -700,10 +730,10 @@ end;
 
 function TFPList.First: Pointer;
 begin
-  If FCount = 0 then
-    Result := Nil
+  If FCount<>0 then
+    Result := Items[0]
   else
-    Result := Items[0];
+    Result := Nil;
 end;
 
 function TFPList.IndexOf(Item: Pointer): Integer;
@@ -737,11 +767,10 @@ end;
 
 function TFPList.Last: Pointer;
 begin
-{ Wouldn't it be better to return nil if the count is zero ?}
-  If FCount = 0 then
-    Result := nil
+  If FCount<>0 then
+    Result := Items[FCount - 1]
   else
-    Result := Items[FCount - 1];
+    Result := nil
 end;
 
 procedure TFPList.Move(CurIndex, NewIndex: Integer);
@@ -1167,8 +1196,13 @@ end;
 
 
 procedure TFPHashList.SetCapacity(NewCapacity: Integer);
+var
+  power: longint;
 begin
-  If (NewCapacity < FCount) or (NewCapacity > MaxHashListSize) then
+  { use a power of two to be able to quickly calculate the hash table index }
+  if NewCapacity <> 0 then
+    NewCapacity := nextpowerof2((NewCapacity+(MaxItemsPerHash-1)) div MaxItemsPerHash, power) * MaxItemsPerHash;
+  if (NewCapacity < FCount) or (NewCapacity > MaxHashListSize) then
      Error (SListCapacityError, NewCapacity);
   if NewCapacity = FCapacity then
     exit;
@@ -1189,7 +1223,8 @@ begin
       If NewCount > FCapacity then
         SetCapacity(NewCount);
       If FCount < NewCount then
-        FillChar(FHashList^[FCount], (NewCount-FCount) div Sizeof(THashItem), 0);
+        { FCapacity is NewCount rounded up to the next power of 2 }
+        FillChar(FHashList^[FCount], (FCapacity-FCount) div Sizeof(THashItem), 0);
     end;
   FCount := Newcount;
 end;
@@ -1207,13 +1242,19 @@ end;
 
 
 procedure TFPHashList.SetHashCapacity(NewCapacity: Integer);
+var
+  power: longint;
 begin
   If (NewCapacity < 1) then
     Error (SListCapacityError, NewCapacity);
   if FHashCapacity=NewCapacity then
     exit;
+  if (NewCapacity<>0) and
+     not ispowerof2(NewCapacity,power) then
+    Error(SListCapacityPower2Error, NewCapacity);
   FHashCapacity:=NewCapacity;
   ReallocMem(FHashTable, FHashCapacity*sizeof(Integer));
+  FCapacityMask:=(1 shl power)-1;
   ReHash;
 end;
 
@@ -1264,7 +1305,7 @@ begin
     begin
       if not assigned(Data) then
         exit;
-      HashIndex:=HashValue mod LongWord(FHashCapacity);
+      HashIndex:=HashValue and FCapacityMask;
       NextIndex:=FHashTable^[HashIndex];
       FHashTable^[HashIndex]:=Index;
     end;
@@ -1341,12 +1382,6 @@ begin
   if FCount < FCapacity then
     exit;
   IncSize := sizeof(ptrint)*2;
-  if FCapacity > 127 then
-    Inc(IncSize, FCapacity shr 2)
-  else if FCapacity > sizeof(ptrint)*3 then
-    Inc(IncSize, FCapacity shr 1)
-  else if FCapacity >= sizeof(ptrint) then
-    inc(IncSize,sizeof(ptrint));
   SetCapacity(FCapacity + IncSize);
 end;
 
@@ -1383,13 +1418,9 @@ end;
 function TFPHashList.InternalFind(AHash:LongWord;const AName:shortstring;out PrevIndex:Integer):Integer;
 var
   HashIndex : Integer;
-  Len,
-  LastChar  : Char;
 begin
-  HashIndex:=AHash mod LongWord(FHashCapacity);
-  Result:=FHashTable^[HashIndex];
-  Len:=Char(Length(AName));
-  LastChar:=AName[Byte(Len)];
+  prefetch(AName);
+  Result:=FHashTable^[AHash and FCapacityMask];
   PrevIndex:=-1;
   while Result<>-1 do
     begin
@@ -1397,8 +1428,6 @@ begin
         begin
           if assigned(Data) and
              (HashValue=AHash) and
-             (Len=FStrs[StrIndex]) and
-             (LastChar=FStrs[StrIndex+Byte(Len)]) and
              (AName=PShortString(@FStrs[StrIndex])^) then
             exit;
           PrevIndex:=Result;
@@ -1457,7 +1486,7 @@ begin
   if PrevIndex<>-1 then
     FHashList^[PrevIndex].NextIndex:=FHashList^[Index].NextIndex
   else
-    FHashTable^[OldHash mod LongWord(FHashCapacity)]:=FHashList^[Index].NextIndex;
+    FHashTable^[OldHash and FCapacityMask]:=FHashList^[Index].NextIndex;
   { Set new name and hash }
   with FHashList^[Index] do
     begin
@@ -1985,6 +2014,7 @@ end;
         while assigned(NewNode) do
          begin
            Next:=NewNode.Next;
+           prefetch(next.next);
            NewNode.Free;
            NewNode:=Next;
           end;
@@ -2757,4 +2787,98 @@ end;
         Result := False;
       end;
 
+
+{****************************************************************************
+                                tbitset
+****************************************************************************}
+
+    constructor tbitset.create(initsize: longint);
+      begin
+        create_bytesize((initsize+7) div 8);
+      end;
+
+
+    constructor tbitset.create_bytesize(bytesize: longint);
+      begin
+        fdatasize:=bytesize;
+        getmem(fdata,fdataSize);
+        clear;
+      end;
+
+
+    destructor tbitset.destroy;
+      begin
+        freemem(fdata,fdatasize);
+        inherited destroy;
+      end;
+
+
+    procedure tbitset.clear;
+      begin
+        fillchar(fdata^,fdatasize,0);
+      end;
+
+
+    procedure tbitset.grow(nsize: longint);
+      begin
+        reallocmem(fdata,nsize);
+        fillchar(fdata[fdatasize],nsize-fdatasize,0);
+        fdatasize:=nsize;
+      end;
+
+
+    procedure tbitset.include(index: longint);
+      var
+        dataindex: longint;
+      begin
+        { don't use bitpacked array, not endian-safe }
+        dataindex:=index shr 3;
+        if (dataindex>=datasize) then
+          grow(dataindex+16);
+        fdata[dataindex]:=fdata[dataindex] or (1 shl (index and 7));
+      end;
+
+
+    procedure tbitset.exclude(index: longint);
+      var
+        dataindex: longint;
+      begin
+        dataindex:=index shr 3;
+        if (dataindex>=datasize) then
+          exit;
+        fdata[dataindex]:=fdata[dataindex] and not(1 shl (index and 7));
+      end;
+
+
+    function tbitset.isset(index: longint): boolean;
+      var
+        dataindex: longint;
+      begin
+        dataindex:=index shr 3;
+        result:=
+          (dataindex<datasize) and
+          (((fdata[dataindex] shr (index and 7)) and 1)<>0);
+      end;
+
+
+    procedure tbitset.addset(aset: tbitset);
+      var
+        i: longint;
+      begin
+        if (aset.datasize>datasize) then
+          grow(aset.datasize);
+        for i:=0 to aset.datasize-1 do
+          fdata[i]:=fdata[i] or aset.data[i];
+      end;
+
+
+    procedure tbitset.subset(aset: tbitset);
+      var
+        i: longint;
+      begin
+        for i:=0 to min(datasize,aset.datasize)-1 do
+          fdata[i]:=fdata[i] and not(aset.data[i]);
+      end;
+
+
 end.

compiler/cfileutl.pas

@@ -46,16 +46,11 @@ interface
       CUtils,CClasses,
       Systems;
 
-    const
-      { On case sensitive file systems, you have 9 lookups per used unit, }
-      { including the system unit, in the current directory               }
-      MinSearchesBeforeCache = 20;
-
     type
       TCachedDirectory = class(TFPHashObject)
       private
         FDirectoryEntries : TFPHashList;
-        FSearchCount: longint;
+        FCached : Boolean;
         procedure FreeDirectoryEntries;
         function GetItemAttr(const AName: TCmdStr): byte;
         function TryUseCache: boolean;
@@ -131,6 +126,19 @@ interface
     procedure DoneFileUtils;
 
 
+{ * 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)}
+{ * PATHCONV is implemented in the Amiga/MorphOS system unit * }
+{$WARNING TODO Amiga: implement PathConv() in System unit, which works with AnsiString}
+function Unix2AmigaPath(path: ShortString): ShortString; external name 'PATHCONV';
+{$ELSE}
+function Unix2AmigaPath(path: String): String;{$IFDEF USEINLINE}inline;{$ENDIF}
+{$ENDIF}
+
+
+
 implementation
 
     uses
@@ -164,6 +172,17 @@ implementation
       DirCache : TDirectoryCache;
 
 
+{$IF NOT (DEFINED(MORPHOS) OR DEFINED(AMIGA))}
+{ 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}
+begin
+  Unix2AmigaPath:=path;
+end;
+{$ENDIF}
+
+
+
 {****************************************************************************
                            TCachedDirectory
 ****************************************************************************}
@@ -172,6 +191,7 @@ implementation
       begin
         inherited create(AList,AName);
         FDirectoryEntries:=TFPHashList.Create;
+        FCached:=False;
       end;
 
 
@@ -185,25 +205,21 @@ implementation
 
     function TCachedDirectory.TryUseCache:boolean;
       begin
-        Result:=true;
-        if (FSearchCount > MinSearchesBeforeCache) then
+        Result:=True;
+        if FCached then
           exit;
-        if (FSearchCount = MinSearchesBeforeCache) then
-          begin
-            inc(FSearchCount);
-            Reload;
-            exit;
-          end;
-        inc(FSearchCount);
-        Result:=false;
+        if not current_settings.disabledircache then
+          ForceUseCache
+        else
+          Result:=False;
       end;
 
 
     procedure TCachedDirectory.ForceUseCache;
       begin
-        if (FSearchCount<=MinSearchesBeforeCache) then
+        if not FCached then
           begin
-            FSearchCount:=MinSearchesBeforeCache+1;
+            FCached:=True;
             Reload;
           end;
       end;
@@ -504,16 +520,36 @@ implementation
      begin
         result:=false;
 {$if defined(unix)}
-        if (length(s)>0) and (s[1]='/') then
+        if (length(s)>0) and (s[1] in AllowDirectorySeparators) then
           result:=true;
 {$elseif defined(amiga) or defined(morphos)}
-        if ((length(s)>0) and ((s[1]='\') or (s[1]='/'))) or (Pos(':',s) = length(s)) then
+        (* 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) *)
+        if (length(s)>0) and (Pos(':',s) <> 0) then
           result:=true;
 {$elseif defined(macos)}
         if IsMacFullPath(s) then
           result:=true;
-        if ((length(s)>0) and ((s[1]='\') or (s[1]='/'))) or
-           ((length(s)>2) and (s[2]=':') and ((s[3]='\') or (s[3]='/'))) then
+{$elseif defined(netware)}
+        if (Pos (DriveSeparator, S) <> 0) or
+                ((Length (S) > 0) and (S [1] in AllowDirectorySeparators)) then
+          result:=true;
+{$elseif defined(win32) or defined(win64) or defined(go32v2) or defined(os2) or defined(watcom)}
+        if ((length(s)>0) and (s[1] in AllowDirectorySeparators)) or
+(* The following check for non-empty AllowDriveSeparators assumes that all
+   other platforms supporting drives and not handled as exceptions above
+   should work with DOS-like paths, i.e. use absolute paths with one letter
+   for drive followed by path separator *)
+           ((length(s)>2) and (s[2] in AllowDriveSeparators) and (s[3] in AllowDirectorySeparators)) then
+          result:=true;
+{$else}
+        if ((length(s)>0) and (s[1] in AllowDirectorySeparators)) or
+(* The following check for non-empty AllowDriveSeparators assumes that all
+   other platforms supporting drives and not handled as exceptions above
+   should work with DOS-like paths, i.e. use absolute paths with one letter
+   for drive followed by path separator *)
+           ((AllowDriveSeparators <> []) and (length(s)>2) and (s[2] in AllowDriveSeparators) and (s[3] in AllowDirectorySeparators)) then
           result:=true;
 {$endif unix}
      end;
@@ -1008,7 +1044,7 @@ implementation
           begin
             j:=Pos(';',s);
             if j=0 then
-             j:=255;
+             j:=length(s)+1;
             currPath:= TrimSpace(Copy(s,1,j-1));
             System.Delete(s,1,j);
           end;
@@ -1024,9 +1060,9 @@ implementation
             if (CurrentDir<>'') and (Copy(currPath,1,length(CurrentDir))=CurrentDir) then
              begin
 {$if defined(amiga) and defined(morphos)}
-               currPath:= CurrentDir+Copy(currPath,length(CurrentDir)+1,255);
+               currPath:= CurrentDir+Copy(currPath,length(CurrentDir)+1,length(currPath));
 {$else}
-               currPath:= CurDirRelPath(source_info)+Copy(currPath,length(CurrentDir)+1,255);
+               currPath:= CurDirRelPath(source_info)+Copy(currPath,length(CurrentDir)+1,length(currPath));
 {$endif}
              end;
           end;

compiler/cg64f32.pas

@@ -76,11 +76,13 @@ unit cg64f32;
         procedure a_op64_loc_reg(list : TAsmList;op:TOpCG;size : tcgsize;const l : tlocation;reg : tregister64);override;
         procedure a_op64_const_ref(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const ref : treference);override;
 
-        procedure a_param64_reg(list : TAsmList;reg : tregister64;const paraloc : tcgpara);override;
-        procedure a_param64_const(list : TAsmList;value : int64;const paraloc : tcgpara);override;
-        procedure a_param64_ref(list : TAsmList;const r : treference;const paraloc : tcgpara);override;
-        procedure a_param64_loc(list : TAsmList;const l : tlocation;const paraloc : tcgpara);override;
+        procedure a_load64_reg_cgpara(list : TAsmList;reg : tregister64;const paraloc : tcgpara);override;
+        procedure a_load64_const_cgpara(list : TAsmList;value : int64;const paraloc : tcgpara);override;
+        procedure a_load64_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara);override;
+        procedure a_load64_loc_cgpara(list : TAsmList;const l : tlocation;const paraloc : tcgpara);override;
 
+        procedure a_loadmm_intreg64_reg(list: TAsmList; mmsize: tcgsize; intreg: tregister64; mmreg: tregister);override;
+        procedure a_loadmm_reg_intreg64(list: TAsmList; mmsize: tcgsize; mmreg: tregister; intreg: tregister64);override;
         {# This routine tries to optimize the a_op64_const_reg operation, by
            removing superfluous opcodes. Returns TRUE if normal processing
            must continue in op64_const_reg, otherwise, everything is processed
@@ -98,8 +100,9 @@ unit cg64f32;
 
     uses
        globtype,systems,constexp,
-       verbose,
-       symbase,symconst,symdef,symtable,defutil,paramgr;
+       verbose,cutils,
+       symbase,symconst,symdef,symtable,defutil,paramgr,
+       tgobj;
 
 {****************************************************************************
                                      Helpers
@@ -171,9 +174,15 @@ unit cg64f32;
             move(cgpara.location^,paralochi^,sizeof(paralochi^));
             { for big endian low is at +4, for little endian high }
             if target_info.endian = endian_big then
-              inc(cgparalo.location^.reference.offset,4)
+              begin
+                inc(cgparalo.location^.reference.offset,4);
+                cgparalo.alignment:=newalignment(cgparalo.alignment,4);
+              end
             else
-              inc(cgparahi.location^.reference.offset,4);
+              begin
+                inc(cgparahi.location^.reference.offset,4);
+                cgparahi.alignment:=newalignment(cgparahi.alignment,4);
+              end;
           end;
         { fix size }
         paraloclo^.size:=cgparalo.size;
@@ -454,6 +463,8 @@ unit cg64f32;
             a_load64_reg_reg(list,reg,l.register64);
           LOC_SUBSETREF, LOC_CSUBSETREF:
             a_load64_reg_subsetref(list,reg,l.sref);
+          LOC_MMREGISTER, LOC_CMMREGISTER:
+            a_loadmm_intreg64_reg(list,l.size,reg,l.register);
           else
             internalerror(200112293);
         end;
@@ -630,7 +641,7 @@ unit cg64f32;
       end;
 
 
-    procedure tcg64f32.a_param64_reg(list : TAsmList;reg : tregister64;const paraloc : tcgpara);
+    procedure tcg64f32.a_load64_reg_cgpara(list : TAsmList;reg : tregister64;const paraloc : tcgpara);
       var
         tmplochi,tmploclo: tcgpara;
       begin
@@ -639,14 +650,14 @@ unit cg64f32;
         splitparaloc64(paraloc,tmploclo,tmplochi);
         { Keep this order of first hi before lo to have
           the correct push order for i386 }
-        cg.a_param_reg(list,OS_32,reg.reghi,tmplochi);
-        cg.a_param_reg(list,OS_32,reg.reglo,tmploclo);
+        cg.a_load_reg_cgpara(list,OS_32,reg.reghi,tmplochi);
+        cg.a_load_reg_cgpara(list,OS_32,reg.reglo,tmploclo);
         tmploclo.done;
         tmplochi.done;
       end;
 
 
-    procedure tcg64f32.a_param64_const(list : TAsmList;value : int64;const paraloc : tcgpara);
+    procedure tcg64f32.a_load64_const_cgpara(list : TAsmList;value : int64;const paraloc : tcgpara);
       var
         tmplochi,tmploclo: tcgpara;
       begin
@@ -655,14 +666,14 @@ unit cg64f32;
         splitparaloc64(paraloc,tmploclo,tmplochi);
         { Keep this order of first hi before lo to have
           the correct push order for i386 }
-        cg.a_param_const(list,OS_32,aint(hi(value)),tmplochi);
-        cg.a_param_const(list,OS_32,aint(lo(value)),tmploclo);
+        cg.a_load_const_cgpara(list,OS_32,aint(hi(value)),tmplochi);
+        cg.a_load_const_cgpara(list,OS_32,aint(lo(value)),tmploclo);
         tmploclo.done;
         tmplochi.done;
       end;
 
 
-    procedure tcg64f32.a_param64_ref(list : TAsmList;const r : treference;const paraloc : tcgpara);
+    procedure tcg64f32.a_load64_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara);
       var
         tmprefhi,tmpreflo : treference;
         tmploclo,tmplochi : tcgpara;
@@ -678,30 +689,56 @@ unit cg64f32;
           inc(tmprefhi.offset,4);
         { Keep this order of first hi before lo to have
           the correct push order for i386 }
-        cg.a_param_ref(list,OS_32,tmprefhi,tmplochi);
-        cg.a_param_ref(list,OS_32,tmpreflo,tmploclo);
+        cg.a_load_ref_cgpara(list,OS_32,tmprefhi,tmplochi);
+        cg.a_load_ref_cgpara(list,OS_32,tmpreflo,tmploclo);
         tmploclo.done;
         tmplochi.done;
       end;
 
 
-    procedure tcg64f32.a_param64_loc(list : TAsmList;const l:tlocation;const paraloc : tcgpara);
+    procedure tcg64f32.a_load64_loc_cgpara(list : TAsmList;const l:tlocation;const paraloc : tcgpara);
       begin
         case l.loc of
           LOC_REGISTER,
           LOC_CREGISTER :
-            a_param64_reg(list,l.register64,paraloc);
+            a_load64_reg_cgpara(list,l.register64,paraloc);
           LOC_CONSTANT :
-            a_param64_const(list,l.value64,paraloc);
+            a_load64_const_cgpara(list,l.value64,paraloc);
           LOC_CREFERENCE,
           LOC_REFERENCE :
-            a_param64_ref(list,l.reference,paraloc);
+            a_load64_ref_cgpara(list,l.reference,paraloc);
           else
             internalerror(200203287);
         end;
       end;
 
 
+    procedure tcg64f32.a_loadmm_intreg64_reg(list: TAsmList; mmsize: tcgsize; intreg: tregister64; mmreg: tregister);
+      var
+        tmpref: treference;
+      begin
+        if (tcgsize2size[mmsize]<>8) then
+          internalerror(2009112501);
+        tg.gettemp(list,8,8,tt_normal,tmpref);
+        a_load64_reg_ref(list,intreg,tmpref);
+        cg.a_loadmm_ref_reg(list,mmsize,mmsize,tmpref,mmreg,mms_movescalar);
+        tg.ungettemp(list,tmpref);
+      end;
+
+
+    procedure tcg64f32.a_loadmm_reg_intreg64(list: TAsmList; mmsize: tcgsize; mmreg: tregister; intreg: tregister64);
+      var
+        tmpref: treference;
+      begin
+        if (tcgsize2size[mmsize]<>8) then
+          internalerror(2009112502);
+        tg.gettemp(list,8,8,tt_normal,tmpref);
+        cg.a_loadmm_reg_ref(list,mmsize,mmsize,mmreg,tmpref,mms_movescalar);
+        a_load64_ref_reg(list,tmpref,intreg);
+        tg.ungettemp(list,tmpref);
+      end;
+
+
     procedure tcg64f32.g_rangecheck64(list : TAsmList;const l:tlocation;fromdef,todef:tdef);
 
       var
@@ -754,7 +791,10 @@ unit cg64f32;
 
              if (temploc.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
                 (target_info.endian = endian_big) then
-               inc(temploc.reference.offset,4);
+               begin
+                 inc(temploc.reference.offset,4);
+                 temploc.reference.alignment:=newalignment(temploc.reference.alignment,4);
+               end;
 
              cg.g_rangecheck(list,temploc,hdef,todef);
              hdef.owner.deletedef(hdef);

compiler/cgbase.pas

@@ -38,8 +38,6 @@ interface
          LOC_CONSTANT,     { constant value }
          LOC_JUMP,         { boolean results only, jump to false or true label }
          LOC_FLAGS,        { boolean results only, flags are set }
-         LOC_CREFERENCE,   { in memory constant value reference (cannot change) }
-         LOC_REFERENCE,    { in memory value }
          LOC_REGISTER,     { in a processor register }
          LOC_CREGISTER,    { Constant register which shouldn't be modified }
          LOC_FPUREGISTER,  { FPU stack }
@@ -56,16 +54,23 @@ interface
          LOC_CSUBSETREG,
          { contiguous subset of bits in memory }
          LOC_SUBSETREF,
-         LOC_CSUBSETREF
+         LOC_CSUBSETREF,
+         { keep these last for range checking purposes }
+         LOC_CREFERENCE,   { in memory constant value reference (cannot change) }
+         LOC_REFERENCE     { in memory value }
        );
 
+       TCGNonRefLoc=low(TCGLoc)..pred(LOC_CREFERENCE);
+       TCGRefLoc=LOC_CREFERENCE..LOC_REFERENCE;
+
        { since we have only 16bit offsets, we need to be able to specify the high
          and lower 16 bits of the address of a symbol of up to 64 bit }
        trefaddr = (
          addr_no,
          addr_full,
-         addr_pic
-         {$IF defined(POWERPC) or defined(POWERPC64) or defined(SPARC)}
+         addr_pic,
+         addr_pic_no_got
+         {$IF defined(POWERPC) or defined(POWERPC64) or defined(SPARC) or defined(MIPS)}
          ,
          addr_low,         // bits 48-63
          addr_high,        // bits 32-47
@@ -263,7 +268,7 @@ interface
          1,2,4,8,16,1,2,4,8,16);
 
        tfloat2tcgsize: array[tfloattype] of tcgsize =
-         (OS_F32,OS_F64,OS_F80,OS_C64,OS_C64,OS_F128);
+         (OS_F32,OS_F64,OS_F80,OS_F80,OS_C64,OS_C64,OS_F128);
 
        tcgsize2tfloat: array[OS_F32..OS_C64] of tfloattype =
          (s32real,s64real,s80real,s64comp);
@@ -285,8 +290,6 @@ interface
             'LOC_CONST',
             'LOC_JUMP',
             'LOC_FLAGS',
-            'LOC_CREF',
-            'LOC_REF',
             'LOC_REG',
             'LOC_CREG',
             'LOC_FPUREG',
@@ -298,7 +301,10 @@ interface
             'LOC_SSETREG',
             'LOC_CSSETREG',
             'LOC_SSETREF',
-            'LOC_CSSETREF');
+            'LOC_CSSETREF',
+            'LOC_CREF',
+            'LOC_REF'
+            );
 
     var
        mms_movescalar : pmmshuffle;

compiler/cgutils.pas

@@ -39,7 +39,9 @@ unit cgutils;
          offset      : aint;
          symbol,
          relsymbol   : tasmsymbol;
+{$if defined(x86) or defined(m68k)}
          segment,
+{$endif defined(x86) or defined(m68k)}
          base,
          index       : tregister;
          refaddr     : trefaddr;
@@ -59,9 +61,7 @@ unit cgutils;
          { (An)+ and -(An)                      }
          direction : tdirection;
 {$endif m68k}
-{$ifdef SUPPORT_UNALIGNED}
          alignment : byte;
-{$endif SUPPORT_UNALIGNED}
       end;
 
       tsubsetregister = record
@@ -80,7 +80,9 @@ unit cgutils;
          loc  : TCGLoc;
          size : TCGSize;
          case TCGLoc of
+{$ifdef cpuflags}
             LOC_FLAGS : (resflags : tresflags);
+{$endif cpuflags}
             LOC_CONSTANT : (
               case longint of
 {$ifdef FPC_BIG_ENDIAN}
@@ -126,12 +128,12 @@ unit cgutils;
     { trerefence handling }
 
     {# Clear to zero a treference }
-    procedure reference_reset(var ref : treference);
+    procedure reference_reset(var ref : treference; alignment: longint);
     {# Clear to zero a treference, and set is base address
        to base register.
     }
-    procedure reference_reset_base(var ref : treference;base : tregister;offset : longint);
-    procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset : longint);
+    procedure reference_reset_base(var ref : treference;base : tregister;offset, alignment : longint);
+    procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset, alignment : longint);
     { This routine verifies if two references are the same, and
        if so, returns TRUE, otherwise returns false.
     }
@@ -139,7 +141,10 @@ unit cgutils;
 
     { tlocation handling }
 
-    procedure location_reset(var l : tlocation;lt:TCGLoc;lsize:TCGSize);
+    { cannot be used for loc_(c)reference, because that one requires an alignment }
+    procedure location_reset(var l : tlocation;lt:TCGNonRefLoc;lsize:TCGSize);
+    { for loc_(c)reference }
+    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);
 
@@ -154,32 +159,34 @@ unit cgutils;
 implementation
 
 uses
-  systems;
+  systems,
+  verbose;
 
 {****************************************************************************
                                   TReference
 ****************************************************************************}
 
-    procedure reference_reset(var ref : treference);
+    procedure reference_reset(var ref : treference; alignment: longint);
       begin
         FillChar(ref,sizeof(treference),0);
 {$ifdef arm}
         ref.signindex:=1;
 {$endif arm}
+        ref.alignment:=alignment;
       end;
 
 
-    procedure reference_reset_base(var ref : treference;base : tregister;offset : longint);
+    procedure reference_reset_base(var ref : treference;base : tregister;offset, alignment : longint);
       begin
-        reference_reset(ref);
+        reference_reset(ref,alignment);
         ref.base:=base;
         ref.offset:=offset;
       end;
 
 
-    procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset : longint);
+    procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset, alignment : longint);
       begin
-        reference_reset(ref);
+        reference_reset(ref,alignment);
         ref.symbol:=sym;
         ref.offset:=offset;
       end;
@@ -202,17 +209,28 @@ uses
                                   TLocation
 ****************************************************************************}
 
-    procedure location_reset(var l : tlocation;lt:TCGLoc;lsize:TCGSize);
+    procedure location_reset(var l : tlocation;lt:TCGNonRefLoc;lsize:TCGSize);
       begin
         FillChar(l,sizeof(tlocation),0);
         l.loc:=lt;
         l.size:=lsize;
-{$ifdef arm}
         if l.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
-          l.reference.signindex:=1;
-{$endif arm}
+          { call location_reset_ref instead }
+          internalerror(2009020705);
       end;
 
+    procedure location_reset_ref(var l: tlocation; lt: tcgrefloc; lsize: tcgsize;
+      alignment: longint);
+    begin
+      FillChar(l,sizeof(tlocation),0);
+      l.loc:=lt;
+      l.size:=lsize;
+{$ifdef arm}
+      l.reference.signindex:=1;
+{$endif arm}
+      l.reference.alignment:=alignment;
+    end;
+
 
     procedure location_copy(var destloc:tlocation; const sourceloc : tlocation);
       begin

compiler/cmsgs.pas

@@ -25,6 +25,9 @@ unit cmsgs;
 
 interface
 
+uses
+  globtype;
+
 const
   maxmsgidxparts = 20;
 
@@ -34,6 +37,9 @@ type
   TArrayOfPChar = array[0..1000] of pchar;
   PArrayOfPChar = ^TArrayOfPChar;
 
+  TArrayOfState = array[0..1000] of tmsgstate;
+  PArrayOfState = ^TArrayOfState;
+
   PMessage=^TMessage;
   TMessage=object
     msgfilename : string;
@@ -45,6 +51,7 @@ type
     msgtxt      : pchar;
     msgidx      : array[1..maxmsgidxparts] of PArrayOfPChar;
     msgidxmax   : array[1..maxmsgidxparts] of longint;
+    msgstates   : array[1..maxmsgidxparts] of PArrayOfState;
     constructor Init(n:longint;const idxmax:array of longint);
     destructor  Done;
     function  LoadIntern(p:pointer;n:longint):boolean;
@@ -109,8 +116,12 @@ begin
   for i:=1 to n do
    begin
      msgidxmax[i]:=idxmax[i-1];
+     { create array of msgidx }
      getmem(msgidx[i],msgidxmax[i]*sizeof(pointer));
      fillchar(msgidx[i]^,msgidxmax[i]*sizeof(pointer),0);
+     { create array of states }
+     getmem(msgstates[i],msgidxmax[i]*sizeof(tmsgstate));
+     fillchar(msgstates[i]^,msgidxmax[i]*sizeof(tmsgstate),0);
    end;
 end;
 
@@ -120,7 +131,10 @@ var
   i : longint;
 begin
   for i:=1 to msgparts do
+  begin
    freemem(msgidx[i],msgidxmax[i]*sizeof(pointer));
+   freemem(msgstates[i],msgidxmax[i]*sizeof(tmsgstate));
+  end;
   if msgallocsize>0 then
    begin
      freemem(msgtxt,msgsize);
@@ -377,29 +391,14 @@ end;
 
 function TMessage.ClearVerbosity(nr:longint):boolean;
 var
-  hp: pchar;
-  i, txtbegin: longint;
+  i: longint;
 begin
-   result:=false;
-  if ((nr div 1000) < low(msgidx)) or
-     ((nr div 1000) > msgparts) then
+  result:=false;
+  i:=nr div 1000;
+  if (i < low(msgstates)) or
+     (i > msgparts) then
     exit;
-  hp := GetPChar(nr);
-  if (hp=nil) then
-    exit;
-  txtbegin:=-1;
-  for i:=0 to 4 do
-    begin
-      if hp[i]=#0 then
-        exit;
-      if hp[i]='_' then
-        begin
-          txtbegin:=i;
-          break;
-        end;
-    end;
-  for i:=0 to txtbegin-1 do
-    hp[i]:='_';
+  msgstates[i]^[nr mod 1000]:=ms_off;
   result:=true;
 end;
 

compiler/comphook.pas

@@ -76,7 +76,7 @@ type
     currentsource : string;   { filename }
     currentline,
     currentcolumn : longint;  { current line and column }
-		currentmodulestate : string[20];
+    currentmodulestate : string[20];
   { Total Status }
     compiledlines : longint;  { the number of lines which are compiled }
     errorcount,

compiler/compiler.pas

@@ -40,7 +40,7 @@ uses
 {$ENDIF}
   verbose,comphook,systems,
   cutils,cfileutl,cclasses,globals,options,fmodule,parser,symtable,
-  assemble,link,dbgbase,import,export,tokens,pass_1
+  assemble,link,dbgbase,import,export,tokens,pass_1,wpobase,wpo
   { cpu parameter handling }
   ,cpupara
   { procinfo stuff }
@@ -110,6 +110,9 @@ uses
 {$ifdef symbian}
   ,i_symbian
 {$endif symbian}
+{$ifdef nativent}
+  ,i_nativent
+{$endif nativent}
   ,globtype;
 
 function Compile(const cmd:string):longint;
@@ -145,6 +148,7 @@ begin
      DoneExport;
      DoneLinker;
      DoneAsm;
+     DoneWpo;
    end;
 { Free memory for the others }
   CompilerInited:=false;
@@ -184,6 +188,8 @@ begin
   InitExport;
   InitLinker;
   InitAsm;
+  InitWpo;
+
   CompilerInitedAfterArgs:=true;
 end;
 

compiler/compinnr.inc

@@ -76,7 +76,11 @@ const
    in_ror_x_x           = 66;
    in_rol_x             = 67;
    in_rol_x_x           = 68;
-
+   in_objc_selector_x   = 69;
+   in_objc_protocol_x   = 70;
+   in_objc_encode_x     = 71;
+   in_sar_x_y           = 72;
+   in_sar_x             = 73;
 
 { Internal constant functions }
    in_const_sqr        = 100;

compiler/comprsrc.pas

@@ -238,13 +238,29 @@ var
   preprocessorbin,
   s : TCmdStr;
   arch : ansistring;
+
+  function WindresFileName(filename: TCmdStr): TCmdStr;
+  // to be on the safe side, for files that are passed to the preprocessor,
+  // only give short file names with forward slashes to windres
+  var
+    i: longint;
+  begin
+    Result := GetShortName(filename);
+    for I:=1 to Length(Result) do
+    if Result[I] in AllowDirectorySeparators then
+      Result[i]:='/';
+  end;
+
 begin
   srcfilepath:=ExtractFilePath(current_module.mainsource^);
   if output=roRES then
     begin
       s:=target_res.rccmd;
+      if target_res.rcbin = 'windres' then
+        Replace(s,'$RC',WindresFileName(fname))
+      else
+        Replace(s,'$RC',maybequoted(fname));
       Replace(s,'$RES',maybequoted(OutName));
-      Replace(s,'$RC',maybequoted(fname));
       ObjUsed:=False;
     end
   else
@@ -272,7 +288,7 @@ begin
       if fCollectCount=0 then
         s:=s+' '+maybequoted(fname)
       else
-        s:=s+' @'+fScriptName;
+        s:=s+' '+maybequoted('@'+fScriptName);
     end;
   { windres doesn't like empty include paths }
   if respath='' then
@@ -280,12 +296,12 @@ begin
   Replace(s,'$INC',maybequoted(respath));
   if (output=roRes) and (target_res.rcbin='windres') then
   begin
-    if (srcfilepath<>'') then
-      s:=s+' --include '+maybequoted(srcfilepath);
     { try to find a preprocessor }
     preprocessorbin := respath+'cpp'+source_info.exeext;
     if FileExists(preprocessorbin,true) then
-      s:=s+' --preprocessor='+preprocessorbin;
+      s:='--preprocessor='+preprocessorbin+' '+s;
+    if (srcfilepath<>'') then
+      s:='--include '+WindresFileName(srcfilepath)+' '+s;
   end;
   Result:=s;
 end;
@@ -304,7 +320,7 @@ const
   ResSignature : array [1..32] of byte =
   ($00,$00,$00,$00,$20,$00,$00,$00,$FF,$FF,$00,$00,$FF,$FF,$00,$00,
    $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00);
-  dfmexts : array[1..3] of string[4] = ('.lfm', '.dfm', '.xfm');
+  knownexts : array[1..4] of string[4] = ('.lfm', '.dfm', '.xfm', '.tlb');
 var
   f : file;
   oldfmode : byte;
@@ -315,9 +331,9 @@ begin
   ext:=lower(ExtractFileExt(fn));
   Result:=CompareText(ext, target_info.resext) = 0;
   if not Result then
-    for i:=1 to high(dfmexts) do
+    for i:=1 to high(knownexts) do
     begin
-      Result:=CompareText(ext, dfmexts[i]) = 0;
+      Result:=CompareText(ext, knownexts[i]) = 0;
       if Result then break;
     end;
 
@@ -397,7 +413,7 @@ begin
   if (target_info.res<>res_none) and (target_res.resourcefileclass=nil) then
     exit;
 
-  p:=ExtractFilePath(current_module.mainsource^);
+  p:=ExtractFilePath(ExpandFileName(current_module.mainsource^));
   res:=TCmdStrListItem(current_module.ResourceFiles.First);
   while res<>nil do
     begin
@@ -416,7 +432,7 @@ begin
       if resourcefile.IsCompiled(s) then
         begin
           resourcefile.free;
-          if AnsiCompareText(current_module.outputpath^, p) <> 0 then
+          if AnsiCompareFileName(IncludeTrailingPathDelimiter(ExpandFileName(current_module.outputpath^)), p) <> 0 then
             begin
               { Copy .res file to units output dir. Otherwise .res file will not be found
                 when only compiled units path is available }

compiler/constexp.pas

@@ -45,6 +45,8 @@ type  Tconstexprint=record
             (svalue:int64);
       end;
 
+      Tconststring = type pchar;
+
       errorproc=procedure (i:longint);
 
 {"Uses verbose" gives a dependency on cpuinfo through globals. This leads
@@ -378,7 +380,8 @@ end;
 
 operator mod (const a,b:Tconstexprint):Tconstexprint;
 
-var aa,bb:qword;
+var aa,bb,r:qword;
+    sa,sb:boolean;
 
 begin
   if a.overflow or b.overflow then
@@ -387,20 +390,32 @@ begin
       exit;
     end;
   result.overflow:=false;
-  if a.signed then
-    aa:=qword(a.svalue)
+  sa:=a.signed and (a.svalue<0);
+  if sa then
+    {$Q-}
+    aa:=qword(-a.svalue)
+    {$ifdef ena_q}{$Q+}{$endif}
   else
     aa:=a.uvalue;
-  if b.signed then
-    bb:=qword(b.svalue)
+  sb:=b.signed and (b.svalue<0);
+  if sb then
+    {$Q-}
+    bb:=qword(-b.svalue)
+    {$ifdef ena_q}{$Q+}{$endif}
   else
     bb:=b.uvalue;
   if bb=0 then
     result.overflow:=true
   else
     begin
-      result.signed:=false;
-      result.uvalue:=aa mod bb;
+      { the sign of a modulo operation only depends on the sign of the
+        dividend }
+      r:=aa mod bb;
+      result.signed:=sa;
+      if not sa then
+        result.uvalue:=r
+      else
+        result.svalue:=-int64(r);
     end;
 end;
 

compiler/crefs.pas

@@ -1,65 +1,65 @@
-{
-    Copyright (c) 2007 by Pierre Muller
-
-    Common reference types
-
-    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 crefs;
-
-{$i fpcdefs.inc}
-
-interface
-
-uses
-  globtype,
-  cclasses;
-
-  type
-
-   TrefItem = class (TLinkedListItem)
-     refinfo  : tfileposinfo;
-     constructor create(const ARefInfo : tfileposinfo);
-     Function GetCopy:TLinkedListItem;virtual;reintroduce;
-   end;
-
-   TRefLinkedList = class(TLinkedList)
-     procedure WriteToPPU;
-   end;
-
-implementation
-
-constructor TRefItem.Create(const ARefInfo : tfileposinfo);
-begin
-  Inherited Create;
-  RefInfo:=ARefInfo;
-end;
-
-Function TRefItem.GetCopy : TLinkedListItem;
-var
-  NR : TRefItem;
-begin
-  NR.Create(RefInfo);
-  GetCopy:=NR;
-end;
-
-procedure TRefLinkedList.WriteToPPU;
-begin
-end;
-
-begin
-end.
+{
+    Copyright (c) 2007 by Pierre Muller
+
+    Common reference types
+
+    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 crefs;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  globtype,
+  cclasses;
+
+  type
+
+   TrefItem = class (TLinkedListItem)
+     refinfo  : tfileposinfo;
+     constructor create(const ARefInfo : tfileposinfo);
+     Function GetCopy:TLinkedListItem;virtual;reintroduce;
+   end;
+
+   TRefLinkedList = class(TLinkedList)
+     procedure WriteToPPU;
+   end;
+
+implementation
+
+constructor TRefItem.Create(const ARefInfo : tfileposinfo);
+begin
+  Inherited Create;
+  RefInfo:=ARefInfo;
+end;
+
+Function TRefItem.GetCopy : TLinkedListItem;
+var
+  NR : TRefItem;
+begin
+  NR.Create(RefInfo);
+  GetCopy:=NR;
+end;
+
+procedure TRefLinkedList.WriteToPPU;
+begin
+end;
+
+begin
+end.

compiler/cresstr.pas

@@ -37,7 +37,7 @@ uses
    symconst,symtype,symdef,symsym,
    verbose,fmodule,ppu,
    aasmbase,aasmtai,aasmdata,
-   aasmcpu;
+   aasmcpu,asmutils;
 
     Type
       { These are used to form a singly-linked list, ordered by hash value }
@@ -127,48 +127,26 @@ uses
 
 
     procedure Tresourcestrings.CreateResourceStringData;
-
-        function WriteValueString(p:pchar;len:longint):TasmLabel;
-        var
-          s : pchar;
-          referencelab: TAsmLabel;
-        begin
-          if (target_info.system in systems_darwin) then
-            begin
-              current_asmdata.getdatalabel(referencelab);
-              current_asmdata.asmlists[al_const].concat(tai_label.create(referencelab));
-            end;
-          current_asmdata.getdatalabel(result);
-          current_asmdata.asmlists[al_const].concat(tai_align.create(const_align(sizeof(pint))));
-          current_asmdata.asmlists[al_const].concat(tai_const.create_pint(-1));
-          current_asmdata.asmlists[al_const].concat(tai_const.create_pint(len));
-          current_asmdata.asmlists[al_const].concat(tai_label.create(result));
-          if (target_info.system in systems_darwin) then
-             current_asmdata.asmlists[al_const].concat(tai_directive.create(asd_reference,referencelab.name));
-          getmem(s,len+1);
-          move(p^,s^,len);
-          s[len]:=#0;
-          current_asmdata.asmlists[al_const].concat(tai_string.create_pchar(s,len));
-          current_asmdata.asmlists[al_const].concat(tai_const.create_8bit(0));
-        end;
-
       Var
         namelab,
         valuelab : tasmlabel;
         resstrlab : tasmsymbol;
+        endsymlab : tasmsymbol;
         R : TResourceStringItem;
       begin
         { Put resourcestrings in a new objectfile. Putting it in multiple files
 	  makes the linking too dependent on the linker script requiring a SORT(*) for
 	  the data sections }
         maybe_new_object_file(current_asmdata.asmlists[al_const]);
+        new_section(current_asmdata.asmlists[al_const],sec_data,make_mangledname('RESSTRTABLE',current_module.localsymtable,''),sizeof(pint));
+
         maybe_new_object_file(current_asmdata.asmlists[al_resourcestrings]);
         new_section(current_asmdata.asmlists[al_resourcestrings],sec_data,make_mangledname('RESSTR',current_module.localsymtable,'1_START'),sizeof(pint));
         current_asmdata.AsmLists[al_resourcestrings].concat(tai_symbol.createname_global(
           make_mangledname('RESSTR',current_module.localsymtable,'START'),AT_DATA,0));
 
         { Write unitname entry }
-        namelab:=WriteValueString(@current_module.localsymtable.name^[1],length(current_module.localsymtable.name^));
+        namelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],@current_module.localsymtable.name^[1],length(current_module.localsymtable.name^),False);
         current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(namelab));
         current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(nil));
         current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(nil));
@@ -184,11 +162,12 @@ uses
             new_section(current_asmdata.asmlists[al_const],sec_rodata,make_mangledname('RESSTR',current_module.localsymtable,'d_'+r.name),sizeof(pint));
             { Write default value }
             if assigned(R.value) and (R.len<>0) then
-              valuelab:=WriteValueString(R.Value,R.Len)
+              valuelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],R.Value,R.Len,False)
             else
               valuelab:=nil;
             { Append the name as a ansistring. }
-            namelab:=WriteValueString(@R.Name[1],length(R.name));
+            current_asmdata.asmlists[al_const].concat(cai_align.Create(const_align(sizeof(pint))));
+            namelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],@R.Name[1],length(R.name),False);
 
             {
               Resourcestring index:
@@ -213,16 +192,19 @@ uses
             R:=TResourceStringItem(R.Next);
           end;
         new_section(current_asmdata.asmlists[al_resourcestrings],sec_data,make_mangledname('RESSTR',current_module.localsymtable,'3_END'),sizeof(pint));
-        current_asmdata.AsmLists[al_resourcestrings].concat(tai_symbol.createname_global(
-          make_mangledname('RESSTR',current_module.localsymtable,'END'),AT_DATA,0));
+        endsymlab:=current_asmdata.DefineAsmSymbol(make_mangledname('RESSTR',current_module.localsymtable,'END'),AB_GLOBAL,AT_DATA);
+        current_asmdata.AsmLists[al_resourcestrings].concat(tai_symbol.create_global(endsymlab,0));
         { The darwin/ppc64 assembler or linker seems to have trouble       }
         { if a section ends with a global label without any data after it. }
         { So for safety, just put a dummy value here.                      }
         { Further, the regular linker also kills this symbol when turning  }
         { on smart linking in case no value appears after it, so put the   }
         { dummy byte there always                                          }
+        { Update: the Mac OS X 10.6 linker orders data that needs to be    }
+        { relocated before all other data, so make this data relocatable,  }
+        { otherwise the end label won't be moved with the rest             }
         if (target_info.system in systems_darwin) then   
-          current_asmdata.asmlists[al_resourcestrings].concat(Tai_const.create_8bit(0));
+          current_asmdata.asmlists[al_resourcestrings].concat(Tai_const.create_sym(endsymlab));
       end;
 
 

compiler/cutils.pas

@@ -44,6 +44,11 @@ interface
     function max(a,b : int64) : int64;{$ifdef USEINLINE}inline;{$endif}
     {# Return value @var(i) aligned on @var(a) boundary }
     function align(i,a:longint):longint;{$ifdef USEINLINE}inline;{$endif}
+    { if you have an address aligned using "oldalignment" and add an
+      offset of (a multiple of) offset to it, this function calculates
+      the new minimally guaranteed alignment
+    }
+    function newalignment(oldalignment: longint; offset: int64): longint;
     {# Return @var(b) with the bit order reversed }
     function reverse_byte(b: byte): byte;
 
@@ -118,9 +123,12 @@ interface
     { the data in p is modified and p is returned     }
     function pchar2pshortstring(p : pchar) : pshortstring;
 
-    { ambivalent to pchar2pshortstring }
+    { inverse of pchar2pshortstring }
     function pshortstring2pchar(p : pshortstring) : pchar;
 
+    { allocate a new pchar with the contents of a}
+    function ansistring2pchar(const a: ansistring) : pchar;
+
     { Ansistring (pchar+length) support }
     procedure ansistringdispose(var p : pchar;length : longint);
     function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint;
@@ -200,6 +208,18 @@ implementation
            max:=b;
       end;
 
+
+    function newalignment(oldalignment: longint; offset: int64): longint;
+      var
+        localoffset: longint;
+      begin
+        localoffset:=longint(offset);
+        while (localoffset mod oldalignment)<>0 do
+          oldalignment:=oldalignment div 2;
+        newalignment:=oldalignment;
+      end;
+
+
     function reverse_byte(b: byte): byte;
       const
         reverse_nible:array[0..15] of 0..15 =
@@ -958,6 +978,18 @@ implementation
       end;
 
 
+    function ansistring2pchar(const a: ansistring) : pchar;
+      var
+        len: ptrint;
+      begin
+        len:=length(a);
+        getmem(result,len+1);
+        if (len<>0) then
+          move(a[1],result[0],len);
+        result[len]:=#0;
+      end;
+
+
     function lowercase(c : char) : char;
        begin
           case c of

compiler/dbgbase.pas

@@ -28,6 +28,7 @@ interface
     uses
       cclasses,
       systems,
+      parabase,
       symconst,symbase,symdef,symtype,symsym,symtable,
       fmodule,
       aasmtai,aasmdata;
@@ -36,6 +37,9 @@ interface
       TDebugInfo=class
       protected
         { definitions }
+        { collect all defs in one list so we can reset them easily }
+        defnumberlist      : TFPObjectList;
+        deftowritelist     : TFPObjectList;
         procedure appenddef(list:TAsmList;def:tdef);
         procedure beforeappenddef(list:TAsmList;def:tdef);virtual;
         procedure afterappenddef(list:TAsmList;def:tdef);virtual;
@@ -58,6 +62,7 @@ interface
 {$ifdef support_llvm}
         procedure appendprocdef_implicit(list:TAsmList;def:tprocdef);virtual;
 {$endif support_llvm}
+        procedure write_remaining_defs_to_write(list:TAsmList);
         { symbols }
         procedure appendsym(list:TAsmList;sym:tsym);
         procedure beforeappendsym(list:TAsmList;sym:tsym);virtual;
@@ -73,6 +78,7 @@ interface
         procedure appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);virtual;
         procedure appendsym_property(list:TAsmList;sym:tpropertysym);virtual;
         { symtable }
+        procedure write_symtable_parasyms(list:TAsmList;paras: tparalist);
         procedure write_symtable_syms(list:TAsmList;st:TSymtable);
         procedure write_symtable_defs(list:TAsmList;st:TSymtable);
         procedure write_symtable_procdefs(list:TAsmList;st:TSymtable);
@@ -295,6 +301,42 @@ implementation
       end;
 
 
+    procedure TDebugInfo.write_remaining_defs_to_write(list:TAsmList);
+      var
+        n       : integer;
+        looplist,
+        templist: TFPObjectList;
+        def     : tdef;
+      begin
+        templist := TFPObjectList.Create(False);
+        looplist := deftowritelist;
+        while looplist.count > 0 do
+          begin
+            deftowritelist := templist;
+            for n := 0 to looplist.count - 1 do
+              begin
+                def := tdef(looplist[n]);
+                case def.dbg_state of
+                  dbg_state_written:
+                    continue;
+                  dbg_state_writing:
+                    internalerror(200610052);
+                  dbg_state_unused:
+                    internalerror(200610053);
+                  dbg_state_used:
+                    appenddef(list,def);
+                else
+                  internalerror(200610054);
+                end;
+              end;
+            looplist.clear;
+            templist := looplist;
+            looplist := deftowritelist;
+          end;
+        templist.free;
+      end;
+
+
 {**************************************
           Symbols
 **************************************}
@@ -408,6 +450,7 @@ implementation
       var
         def : tdef;
         i   : longint;
+        nonewadded : boolean;
       begin
         case st.symtabletype of
           staticsymtable :
@@ -415,12 +458,18 @@ implementation
           globalsymtable :
             list.concat(tai_comment.Create(strpnew('Defs - Begin unit '+st.name^+' has index '+tostr(st.moduleid))));
         end;
-        for i:=0 to st.DefList.Count-1 do
-          begin
-            def:=tdef(st.DefList[i]);
-            if (def.dbg_state in [dbg_state_used,dbg_state_queued]) then
-              appenddef(list,def);
-          end;
+        repeat
+          nonewadded:=true;
+          for i:=0 to st.DefList.Count-1 do
+            begin
+              def:=tdef(st.DefList[i]);
+              if (def.dbg_state in [dbg_state_used,dbg_state_queued]) then
+                begin
+                  appenddef(list,def);
+                  nonewadded:=false;
+                end;
+            end;
+        until nonewadded;
         case st.symtabletype of
           staticsymtable :
             list.concat(tai_comment.Create(strpnew('Defs - End Staticsymtable')));
@@ -430,6 +479,26 @@ implementation
       end;
 
 
+    procedure TDebugInfo.write_symtable_parasyms(list:TAsmList;paras: tparalist);
+      var
+        i   : longint;
+        sym : tsym;
+      begin
+        for i:=0 to paras.Count-1 do
+          begin
+            sym:=tsym(paras[i]);
+            if (sym.visibility<>vis_hidden) then
+              begin
+                appendsym(list,sym);
+                { if we ever write this procdef again for some reason (this
+                  can happen with DWARF), then we want to write all the
+                  parasyms again as well. }
+                sym.isdbgwritten:=false;
+              end;
+          end;
+      end;
+
+
     procedure TDebugInfo.write_symtable_syms(list:TAsmList;st:TSymtable);
       var
         i   : longint;

compiler/dbgstabs.pas

@@ -27,7 +27,7 @@ interface
 
     uses
       cclasses,
-      dbgbase,
+      dbgbase,cgbase,
       symtype,symdef,symsym,symtable,symbase,
       aasmtai,aasmdata;
 
@@ -59,18 +59,11 @@ interface
       private
         writing_def_stabs  : boolean;
         global_stab_number : word;
-        defnumberlist      : TFPObjectList;
+        vardatadef: trecorddef;
         { 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;
         procedure write_sym_stabstr(list:TAsmList;sym:tsym;const ss:ansistring);
-        procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
-        procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
-        procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override;
-        procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override;
-        procedure appendsym_const(list:TAsmList;sym:tconstsym);override;
-        procedure appendsym_type(list:TAsmList;sym:ttypesym);override;
-        procedure appendsym_label(list:TAsmList;sym:tlabelsym);override;
         { tdef writing }
         function  def_stab_number(def:tdef):string;
         function  def_stab_classnumber(def:tobjectdef):string;
@@ -80,6 +73,16 @@ interface
         procedure field_add_stabstr(p:TObject;arg:pointer);
         procedure method_add_stabstr(p:TObject;arg:pointer);
         procedure field_write_defs(p:TObject;arg:pointer);
+        function  get_enum_defstr(def: tenumdef; lowerbound: longint): ansistring;
+        function  get_appendsym_paravar_reg(sym:tparavarsym;const typ,stabstr:string;reg: tregister): ansistring;
+      protected
+        procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
+        procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
+        procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override;
+        procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override;
+        procedure appendsym_const(list:TAsmList;sym:tconstsym);override;
+        procedure appendsym_type(list:TAsmList;sym:ttypesym);override;
+        procedure appendsym_label(list:TAsmList;sym:tlabelsym);override;
         procedure beforeappenddef(list:TAsmList;def:tdef);override;
         procedure appenddef_ord(list:TAsmList;def:torddef);override;
         procedure appenddef_float(list:TAsmList;def:tfloatdef);override;
@@ -110,7 +113,7 @@ implementation
       SysUtils,cutils,cfileutl,
       systems,globals,globtype,verbose,constexp,
       symconst,defutil,
-      cpuinfo,cpubase,cgbase,paramgr,
+      cpuinfo,cpubase,paramgr,
       aasmbase,procinfo,
       finput,fmodule,ppu;
 
@@ -135,6 +138,7 @@ implementation
 
       tagtypes = [
         recorddef,
+        variantdef,
         enumdef,
         stringdef,
         filedef,
@@ -290,7 +294,10 @@ implementation
           referenced by the symbols. Definitions will always include all
           required stabs }
         if def.dbg_state=dbg_state_unused then
-          def.dbg_state:=dbg_state_used;
+          begin
+            def.dbg_state:=dbg_state_used;
+            deftowritelist.Add(def);
+          end;
         { Need a new number? }
         if def.stab_number=0 then
           begin
@@ -560,25 +567,40 @@ implementation
       end;
 
 
-    procedure TDebugInfoStabs.appenddef_enum(list:TAsmList;def:tenumdef);
+    function TDebugInfoStabs.get_enum_defstr(def: tenumdef; lowerbound: longint): ansistring;
       var
-        st : ansistring;
-        p  : Tenumsym;
+        i: longint;
+        p: tenumsym;
       begin
         { we can specify the size with @s<size>; prefix PM }
         if def.size <> std_param_align then
-          st:='@s'+tostr(def.size*8)+';e'
+          result:='@s'+tostr(def.size*8)+';e'
         else
-          st:='e';
-        p := tenumsym(def.firstenum);
-        while assigned(p) do
+          result:='e';
+        { the if-test is required because pred(def.minval) might overflow;
+          the longint() typecast should be safe because stabs is not
+          supported for 64 bit targets }
+        if (def.minval<>lowerbound) then
+          for i:=lowerbound to pred(longint(def.minval)) do
+            result:=result+'<invalid>:'+tostr(i)+',';
+
+        for i := 0 to def.symtable.SymList.Count - 1 do
           begin
-            st:=st+GetSymName(p)+':'+tostr(p.value)+',';
-            p:=p.nextenum;
+            p := tenumsym(def.symtable.SymList[i]);
+            if p.value<def.minval then
+              continue
+            else
+            if p.value>def.maxval then
+              break;
+            result:=result+GetSymName(p)+':'+tostr(p.value)+',';
           end;
         { the final ',' is required to have a valid stabs }
-        st:=st+';';
-        write_def_stabstr(list,def,st);
+        result:=result+';';
+      end;
+
+    procedure TDebugInfoStabs.appenddef_enum(list:TAsmList;def:tenumdef);
+      begin
+        write_def_stabstr(list,def,get_enum_defstr(def,def.minval));
       end;
 
 
@@ -646,7 +668,8 @@ implementation
         case def.floattype of
           s32real,
           s64real,
-          s80real:
+          s80real,
+          sc80real:
             ss:=def_stabstr_evaluate(def,'r$1;${savesize};0;',[def_stab_number(s32inttype)]);
           s64currency,
           s64comp:
@@ -770,7 +793,9 @@ implementation
       var
         ss : ansistring;
       begin
-        ss:=def_stabstr_evaluate(def,'${numberstring};',[]);
+        ss:='s'+tostr(vardatadef.size);
+        vardatadef.symtable.SymList.ForEachCall(@field_add_stabstr,@ss);
+        ss[length(ss)]:=';';
         write_def_stabstr(list,def,ss);
       end;
 
@@ -786,9 +811,34 @@ implementation
 
     procedure TDebugInfoStabs.appenddef_set(list:TAsmList;def:tsetdef);
       var
+        st,
         ss : ansistring;
+        p: pchar;
+        elementdefstabnr: string;
       begin
-        ss:=def_stabstr_evaluate(def,'@s$1;S$2',[tostr(def.size*8),def_stab_number(tsetdef(def).elementdef)]);
+        { ugly hack: create a temporary subrange type if the lower bound of
+          the set's element type is not a multiple of 8 (because we store them
+          as if the lower bound is a multiple of 8) }
+        if (def.setbase<>get_min_value(def.elementdef)) then
+          begin
+            { allocate a def number }
+            inc(global_stab_number);
+            elementdefstabnr:=tostr(global_stab_number);
+            { anonymous subrange def }
+            st:='":t'+elementdefstabnr+'=';
+            if (def.elementdef.typ = enumdef) then
+              st:=st+get_enum_defstr(tenumdef(def.elementdef),def.setbase)
+            else
+              st:=st+def_stabstr_evaluate(def.elementdef,'r'+elementdefstabnr+';$1;$2;',[tostr(longint(def.setbase)),tostr(longint(get_max_value(def.elementdef).svalue))]);
+            st:=st+'",'+tostr(N_LSYM)+',0,0,0';
+            { add to list }
+            getmem(p,length(st)+1);
+            move(pchar(st)^,p^,length(st)+1);
+            list.concat(Tai_stab.create(stab_stabs,p));
+          end
+        else
+          elementdefstabnr:=def_stab_number(def.elementdef);
+        ss:=def_stabstr_evaluate(def,'@s$1;S$2',[tostr(def.size*8),elementdefstabnr]);
         write_def_stabstr(list,def,ss);
       end;
 
@@ -804,12 +854,17 @@ implementation
 
     procedure TDebugInfoStabs.appenddef_array(list:TAsmList;def:tarraydef);
       var
-        tempstr,
+        tempstr: shortstring;
         ss : ansistring;
       begin
         if not is_packed_array(def) then
-          ss:=def_stabstr_evaluate(def,'ar$1;$2;$3;$4',[def_stab_number(tarraydef(def).rangedef),
-                   tostr(tarraydef(def).lowrange),tostr(tarraydef(def).highrange),def_stab_number(tarraydef(def).elementdef)])
+          begin
+            tempstr:='ar$1;$2;$3;$4';
+            if is_dynamic_array(def) then
+              tempstr:='*'+tempstr;
+            ss:=def_stabstr_evaluate(def,tempstr,[def_stab_number(tarraydef(def).rangedef),
+                     tostr(tarraydef(def).lowrange),tostr(tarraydef(def).highrange),def_stab_number(tarraydef(def).elementdef)])
+          end
         else
           begin
             // the @P seems to be ignored by gdb
@@ -955,7 +1010,9 @@ implementation
         hs : string;
         ss : ansistring;
       begin
-        if not assigned(def.procstarttai) then
+        if not(def.in_currentunit) or
+           { happens for init procdef of units without init section }
+           not assigned(def.procstarttai) then
           exit;
 
         { mark as used so the local type defs also be written }
@@ -990,7 +1047,7 @@ implementation
         if target_info.cpu=cpu_powerpc64 then
           ss:=ss+'.';
         ss:=ss+def.mangledname;
-        if (tf_use_function_relative_addresses in target_info.flags) then
+        if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
           begin
             ss:=ss+'-';
             if target_info.cpu=cpu_powerpc64 then
@@ -1002,7 +1059,7 @@ implementation
         templist.concat(Tai_stab.Create(stab_stabn,p));
         // RBRAC
         ss:=tostr(N_RBRAC)+',0,0,'+stabsendlabel.name;
-        if (tf_use_function_relative_addresses in target_info.flags) then
+        if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
           begin
             ss:=ss+'-';
             if target_info.cpu=cpu_powerpc64 then
@@ -1233,12 +1290,30 @@ implementation
       end;
 
 
+    function TDebugInfoStabs.get_appendsym_paravar_reg(sym:tparavarsym;const typ,stabstr:string;reg: tregister): ansistring;
+      var
+        ltyp: string[1];
+        regidx : Tregisterindex;
+      begin
+        result:='';
+        if typ='p' then
+          ltyp:='R'
+        else
+          ltyp:='a';
+        regidx:=findreg_by_number(reg);
+        { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
+        { this is the register order for GDB}
+        if regidx<>0 then
+          result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_RSYM},0,${line},$2',[ltyp+stabstr,tostr(longint(regstabs_table[regidx]))]);
+      end;
+
+
     procedure TDebugInfoStabs.appendsym_paravar(list:TAsmList;sym:tparavarsym);
       var
         ss : ansistring;
+        c  : string[1];
         st : string;
         regidx : Tregisterindex;
-        c : char;
       begin
         ss:='';
         { set loc to LOC_REFERENCE to get somewhat usable debugging info for -Or }
@@ -1277,8 +1352,12 @@ implementation
                         [c+def_stab_number(tprocdef(sym.owner.defowner)._class),tostr(sym.localloc.reference.offset)])
                 else
                   begin
+                    if (c='p') then
+                      c:='R'
+                    else
+                      c:='a';
                     regidx:=findreg_by_number(sym.localloc.register);
-                    ss:=sym_stabstr_evaluate(sym,'"$$t:r$1",${N_RSYM},0,0,$2',
+                    ss:=sym_stabstr_evaluate(sym,'"$$t:$1",${N_RSYM},0,0,$2',
                         [c+def_stab_number(tprocdef(sym.owner.defowner)._class),tostr(regstabs_table[regidx])]);
                   end
               end;
@@ -1301,23 +1380,36 @@ implementation
               LOC_FPUREGISTER,
               LOC_CFPUREGISTER :
                 begin
-                  if c='p' then
-                    c:='R'
-                  else
-                    c:='a';
-                  st:=c+st;
-                  regidx:=findreg_by_number(sym.localloc.register);
-                  { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
-                  { this is the register order for GDB}
-                  if regidx<>0 then
-                    ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_RSYM},0,${line},$2',[st,tostr(longint(regstabs_table[regidx]))]);
+                  ss:=get_appendsym_paravar_reg(sym,c,st,sym.localloc.register);
                 end;
               LOC_REFERENCE :
                 begin
-                  st:=c+st;
+                  { When the *value* of a parameter (so not its address!) is
+                    copied into a local variable, you have to generate two
+                    stabs: one for the parmeter, and one for the local copy.
+                    Not doing this breaks debugging under e.g. SPARC. Doc:
+                    http://sourceware.org/gdb/current/onlinedocs/stabs_4.html#SEC26
+                  }
+                  if (c='p') and
+                     not is_open_string(sym.vardef) and
+                     ((sym.paraloc[calleeside].location^.loc<>sym.localloc.loc) or
+                      ((sym.localloc.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
+                       ((sym.paraloc[calleeside].location^.reference.index<>sym.localloc.reference.base) or
+                        (sym.paraloc[calleeside].location^.reference.offset<>sym.localloc.reference.offset))) or
+                      ((sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER,LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]) and
+                       (sym.localloc.register<>sym.paraloc[calleeside].location^.register))) then
+                    begin
+                      if not(sym.paraloc[calleeside].location^.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+                        ss:=get_appendsym_paravar_reg(sym,c,st,sym.paraloc[calleeside].location^.register)
+                      else
+                        ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[c+st,tostr(sym.paraloc[calleeside].location^.reference.offset)]);
+                      write_sym_stabstr(list,sym,ss);
+                      { second stab has no parameter specifier }
+                      c:='';
+                    end;
                   { offset to ebp => will not work if the framepointer is esp
                     so some optimizing will make things harder to debug }
-                  ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(sym.localloc.reference.offset)])
+                  ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[c+st,tostr(sym.localloc.reference.offset)])
                 end;
               else
                 internalerror(2003091814);
@@ -1409,12 +1501,15 @@ implementation
 
         global_stab_number:=0;
         defnumberlist:=TFPObjectlist.create(false);
+        deftowritelist:=TFPObjectlist.create(false);
         stabsvarlist:=TAsmList.create;
         stabstypelist:=TAsmList.create;
 
+        vardatadef:=trecorddef(search_system_type('TVARDATA').typedef);
+
         { include symbol that will be referenced from the main to be sure to
           include this debuginfo .o file }
-        current_module.flags:=current_module.flags or uf_has_debuginfo;
+        current_module.flags:=current_module.flags or uf_has_stabs_debuginfo;
         if not(target_info.system in systems_darwin) then
           begin
             new_section(current_asmdata.asmlists[al_stabs],sec_data,GetSymTableName(current_module.localsymtable),0);
@@ -1446,6 +1541,8 @@ implementation
         if assigned(current_module.localsymtable) then
           write_symtable_defs(stabstypelist,current_module.localsymtable);
 
+        write_remaining_defs_to_write(stabstypelist);
+
         current_asmdata.asmlists[al_stabs].concatlist(stabstypelist);
         current_asmdata.asmlists[al_stabs].concatlist(stabsvarlist);
 
@@ -1461,6 +1558,8 @@ implementation
 
         defnumberlist.free;
         defnumberlist:=nil;
+        deftowritelist.free;
+        deftowritelist:=nil;
 
         stabsvarlist.free;
         stabstypelist.free;
@@ -1507,11 +1606,13 @@ implementation
                       begin
                         current_asmdata.getlabel(hlabel,alt_dbgfile);
                         { emit stabs }
-                        if (infile.path^<>'') then
-                          list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+'",'+tostr(n_includefile)+
+                        if not(ds_stabs_abs_include_files in current_settings.debugswitches) or
+                           path_absolute(infile.path^) then
+                          list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+FixFileName(infile.name^)+'",'+tostr(n_includefile)+
+                                            ',0,0,'+hlabel.name),hp)
+                        else
+                          list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(getcurrentdir,false)+FixPath(infile.path^,false))+FixFileName(infile.name^)+'",'+tostr(n_includefile)+
                                             ',0,0,'+hlabel.name),hp);
-                        list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+FixFileName(infile.name^)+'",'+tostr(n_includefile)+
-                                          ',0,0,'+hlabel.name),hp);
                         list.insertbefore(tai_label.create(hlabel),hp);
                         { force new line info }
                         lastfileinfo.line:=-1;
@@ -1522,7 +1623,7 @@ implementation
                 if (currfileinfo.line>lastfileinfo.line) and (currfileinfo.line<>0) then
                   begin
                      if assigned(currfuncname) and
-                        (tf_use_function_relative_addresses in target_info.flags) then
+                        not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
                       begin
                         current_asmdata.getlabel(hlabel,alt_dbgline);
                         list.insertbefore(Tai_stab.Create_str(stab_stabn,tostr(n_textline)+',0,'+tostr(currfileinfo.line)+','+
@@ -1551,10 +1652,9 @@ implementation
         new_section(current_asmdata.asmlists[al_start],sec_code,make_mangledname('DEBUGSTART',current_module.localsymtable,''),0,secorder_begin);
         if not(target_info.system in systems_darwin) then
           current_asmdata.asmlists[al_start].concat(tai_symbol.Createname_global(make_mangledname('DEBUGSTART',current_module.localsymtable,''),AT_DATA,0));
-        if (infile.path^<>'') then
-          current_asmdata.asmlists[al_start].concat(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+'",'+tostr(n_sourcefile)+
+        current_asmdata.asmlists[al_start].concat(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(getcurrentdir,false))+'",'+tostr(n_sourcefile)+
                       ',0,0,'+hlabel.name));
-        current_asmdata.asmlists[al_start].concat(Tai_stab.Create_str(stab_stabs,'"'+FixFileName(infile.name^)+'",'+tostr(n_sourcefile)+
+        current_asmdata.asmlists[al_start].concat(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+FixFileName(infile.name^)+'",'+tostr(n_sourcefile)+
                     ',0,0,'+hlabel.name));
         current_asmdata.asmlists[al_start].concat(tai_label.create(hlabel));
         { for darwin, you need a "module marker" too to work around      }
@@ -1580,7 +1680,7 @@ implementation
         { Reference all DEBUGINFO sections from the main .fpc section }
         if (target_info.system in ([system_powerpc_macos]+systems_darwin)) then
           exit;
-        list.concat(Tai_section.create(sec_fpc,'links',0));
+        new_section(list,sec_fpc,'links',0);
         { make sure the debuginfo doesn't get stripped out }
         if (target_info.system in systems_darwin) then
           begin
@@ -1592,7 +1692,7 @@ implementation
         hp:=tmodule(loaded_units.first);
         while assigned(hp) do
           begin
-            If (hp.flags and uf_has_debuginfo)=uf_has_debuginfo then
+            If (hp.flags and uf_has_stabs_debuginfo)=uf_has_stabs_debuginfo then
               begin
                 list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.localsymtable,''),0));
                 list.concat(Tai_const.Createname(make_mangledname('DEBUGSTART',hp.localsymtable,''),0));

compiler/defcmp.pas

@@ -34,10 +34,21 @@ interface
      type
        { if acp is cp_all the var const or nothing are considered equal }
        tcompare_paras_type = ( cp_none, cp_value_equal_const, cp_all,cp_procvar);
-       tcompare_paras_option = (cpo_allowdefaults,cpo_ignorehidden,cpo_allowconvert,cpo_comparedefaultvalue,cpo_openequalisexact);
+       tcompare_paras_option = (
+          cpo_allowdefaults,
+          cpo_ignorehidden,           // ignore hidden parameters
+          cpo_allowconvert,
+          cpo_comparedefaultvalue,
+          cpo_openequalisexact,
+          cpo_ignoreuniv,
+          cpo_warn_incompatible_univ,
+          cpo_ignorevarspez,          // ignore parameter access type
+          cpo_ignoreframepointer      // ignore frame pointer parameter (for assignment-compatibility of global procedures to nested procvars)
+       );
+
        tcompare_paras_options = set of tcompare_paras_option;
 
-       tcompare_defs_option = (cdo_internal,cdo_explicit,cdo_check_operator,cdo_allow_variant,cdo_parameter);
+       tcompare_defs_option = (cdo_internal,cdo_explicit,cdo_check_operator,cdo_allow_variant,cdo_parameter,cdo_warn_incompatible_univ);
        tcompare_defs_options = set of tcompare_defs_option;
 
        tconverttype = (tc_none,
@@ -100,10 +111,13 @@ interface
     function is_subequal(def1, def2: tdef): boolean;
 
      {# true, if two parameter lists are equal
-      if acp is cp_none, all have to match exactly
+      if acp is cp_all, all have to match exactly
       if acp is cp_value_equal_const call by value
       and call by const parameter are assumed as
       equal
+      if acp is cp_procvar then the varspez have to match,
+      and all parameter types must be at least te_equal
+      if acp is cp_none, then we don't check the varspez at all
       allowdefaults indicates if default value parameters
       are allowed (in this case, the search order will first
       search for a routine with default parameters, before
@@ -114,7 +128,7 @@ interface
     { True if a function can be assigned to a procvar }
     { changed first argument type to pabstractprocdef so that it can also be }
     { used to test compatibility between two pprocvardefs (JM)               }
-    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef):tequaltype;
+    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef;checkincompatibleuniv: boolean):tequaltype;
 
     { Parentdef is the definition of a method defined in a parent class or interface }
     { Childdef is the definition of a method defined in a child class, interface or  }
@@ -198,16 +212,7 @@ implementation
             (def_to.typ=undefineddef) then
           begin
             doconv:=tc_equal;
-            compare_defs_ext:=te_equal;
-            exit;
-          end;
-
-         { undefined def? then mark it as equal }
-         if (def_from.typ=undefineddef) or
-            (def_to.typ=undefineddef) then
-          begin
-            doconv:=tc_equal;
-            compare_defs_ext:=te_equal;
+            compare_defs_ext:=te_exact;
             exit;
           end;
 
@@ -276,7 +281,9 @@ implementation
                    end;
                  objectdef:
                    begin
-                     if is_class_or_interface_or_dispinterface(def_from) and (cdo_explicit in cdoptions) then
+                     if (m_delphi in current_settings.modeswitches) and
+                        is_class_or_interface_or_dispinterface_or_objc(def_from) and
+                        (cdo_explicit in cdoptions) then
                       begin
                         eq:=te_convert_l1;
                         if (fromtreetype=niln) then
@@ -588,7 +595,7 @@ implementation
                           begin
                             { assignment of an enum symbol to an unique type? }
                             if (fromtreetype=ordconstn) and
-                              (tenumsym(tenumdef(hd1).firstenum)=tenumsym(tenumdef(hd2).firstenum)) then
+                              (tenumsym(tenumdef(hd1).getfirstsym)=tenumsym(tenumdef(hd2).getfirstsym)) then
                               begin
                                 { because of packenum they can have different sizes! (JM) }
                                 eq:=te_convert_l1;
@@ -614,8 +621,18 @@ implementation
                    begin
                      { ugly, but delphi allows it }
                      if (cdo_explicit in cdoptions) and
-                       (m_delphi in current_settings.modeswitches) and
-                       (eq=te_incompatible) then
+                       (m_delphi in current_settings.modeswitches) then
+                       begin
+                         doconv:=tc_int_2_int;
+                         eq:=te_convert_l1;
+                       end;
+                   end;
+                 objectdef:
+                   begin
+                     { ugly, but delphi allows it }
+                     if (m_delphi in current_settings.modeswitches) and
+                        is_class_or_interface_or_dispinterface(def_from) and
+                        (cdo_explicit in cdoptions) then
                        begin
                          doconv:=tc_int_2_int;
                          eq:=te_convert_l1;
@@ -962,8 +979,7 @@ implementation
                      { allow explicit typecasts from enums to pointer.
                        Support for delphi compatibility
                      }
-                     if (eq=te_incompatible) and
-                        (((cdo_explicit in cdoptions) and
+                     if (((cdo_explicit in cdoptions) and
                           (m_delphi in current_settings.modeswitches)
                           ) or
                          (cdo_internal in cdoptions)
@@ -1004,7 +1020,8 @@ implementation
                      else
                        { dynamic array to pointer, delphi only }
                        if (m_delphi in current_settings.modeswitches) and
-                          is_dynamic_array(def_from) then
+                          is_dynamic_array(def_from) and
+                          is_voidpointer(def_to) then
                         begin
                           eq:=te_equal;
                         end;
@@ -1069,12 +1086,22 @@ implementation
                            eq:=te_convert_l2
                          else
                            eq:=te_convert_l1;
+                       end
+                     { id = generic class instance. metaclasses are also
+                       class instances themselves.  }
+                     else if ((def_from=objc_idtype) and
+                              (def_to=objc_metaclasstype)) or
+                             ((def_to=objc_idtype) and
+                              (def_from=objc_metaclasstype)) then
+                       begin
+                         doconv:=tc_equal;
+                         eq:=te_convert_l2;
                        end;
                    end;
                  procvardef :
                    begin
                      { procedure variable can be assigned to an void pointer,
-                       this not allowed for methodpointers }
+                       this is not allowed for complex procvars }
                      if (is_void(tpointerdef(def_to).pointeddef) or
                          (m_mac_procvar in current_settings.modeswitches)) and
                         tprocvardef(def_from).is_addressonly then
@@ -1101,7 +1128,7 @@ implementation
                        can be assigned to void pointers, but it is less
                        preferred than assigning to a related objectdef }
                      if (
-                         is_class_or_interface_or_dispinterface(def_from) or
+                         is_class_or_interface_or_dispinterface_or_objc(def_from) or
                          (def_from.typ=classrefdef)
                         ) and
                         (tpointerdef(def_to).pointeddef.typ=orddef) and
@@ -1109,6 +1136,18 @@ implementation
                        begin
                          doconv:=tc_equal;
                          eq:=te_convert_l2;
+                       end
+                     else if (is_objc_class_or_protocol(def_from) and
+                              (def_to=objc_idtype)) or
+                             { classrefs are also instances in Objective-C,
+                               hence they're also assignment-cpmpatible with
+                               id }
+                             (is_objcclassref(def_from) and
+                              ((def_to=objc_metaclasstype) or
+                               (def_to=objc_idtype))) then
+                       begin
+                         doconv:=tc_equal;
+                         eq:=te_convert_l2;
                        end;
                    end;
                end;
@@ -1161,18 +1200,21 @@ implementation
                      if (m_tp_procvar in current_settings.modeswitches) or
                         (m_mac_procvar in current_settings.modeswitches) then
                       begin
-                        subeq:=proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to));
+                        subeq:=proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to),cdo_warn_incompatible_univ in cdoptions);
                         if subeq>te_incompatible then
                          begin
                            doconv:=tc_proc_2_procvar;
-                           eq:=te_convert_l1;
+                           if subeq>te_convert_l5 then
+                             eq:=pred(subeq)
+                           else
+                             eq:=subeq;
                          end;
                       end;
                    end;
                  procvardef :
                    begin
                      { procvar -> procvar }
-                     eq:=proc_to_procvar_equal(tprocvardef(def_from),tprocvardef(def_to));
+                     eq:=proc_to_procvar_equal(tprocvardef(def_from),tprocvardef(def_to),cdo_warn_incompatible_univ in cdoptions);
                    end;
                  pointerdef :
                    begin
@@ -1212,7 +1254,7 @@ implementation
                 end
                else
                { Class/interface specific }
-                if is_class_or_interface_or_dispinterface(def_to) then
+                if is_class_or_interface_or_dispinterface_or_objc(def_to) then
                  begin
                    { void pointer also for delphi mode }
                    if (m_delphi in current_settings.modeswitches) and
@@ -1229,9 +1271,19 @@ implementation
                        doconv:=tc_equal;
                        eq:=te_convert_l1;
                      end
-                   { classes can be assigned to interfaces }
-                   else if is_interface(def_to) and
-                           is_class(def_from) and
+                   { All Objective-C classes are compatible with ID }
+                   else if is_objc_class_or_protocol(def_to) and
+                           (def_from=objc_idtype) then
+                      begin
+                       doconv:=tc_equal;
+                       eq:=te_convert_l2;
+                     end
+                   { classes can be assigned to interfaces
+                     (same with objcclass and objcprotocol) }
+                   else if ((is_interface(def_to) and
+                             is_class(def_from)) or
+                            (is_objcprotocol(def_to) and
+                             is_objcclass(def_from))) and
                            assigned(tobjectdef(def_from).ImplementedInterfaces) then
                      begin
                         { we've to search in parent classes as well }
@@ -1240,7 +1292,11 @@ implementation
                           begin
                              if hobjdef.find_implemented_interface(tobjectdef(def_to))<>nil then
                                begin
-                                  doconv:=tc_class_2_intf;
+                                  if is_interface(def_to) then
+                                    doconv:=tc_class_2_intf
+                                  else
+                                    { for Objective-C, we don't have to do anything special }
+                                    doconv:=tc_equal;
                                   { don't prefer this over objectdef->objectdef }
                                   eq:=te_convert_l2;
                                   break;
@@ -1263,8 +1319,7 @@ implementation
                        eq:=te_convert_l2;
                      end
                    { ugly, but delphi allows it }
-                   else if (eq=te_incompatible) and
-                     (def_from.typ in [orddef,enumdef]) and
+                   else if (def_from.typ in [orddef,enumdef]) and
                      (m_delphi in current_settings.modeswitches) and
                      (cdo_explicit in cdoptions) then
                      begin
@@ -1314,7 +1369,14 @@ implementation
                  begin
                    doconv:=tc_equal;
                    eq:=te_convert_l1;
-                 end;
+                 end
+               else
+                 { id is compatible with all classref types }
+                 if (def_from=objc_idtype) then
+                   begin
+                     doconv:=tc_equal;
+                     eq:=te_convert_l1;
+                   end;
              end;
 
            filedef :
@@ -1488,6 +1550,39 @@ implementation
       end;
 
 
+    function potentially_incompatible_univ_paras(def1, def2: tdef): boolean;
+      begin
+        result :=
+          { not entirely safe: different records can be passed differently
+            depending on the types of their fields, but they're hard to compare
+            (variant records, bitpacked vs non-bitpacked) }
+          ((def1.typ in [floatdef,recorddef,arraydef,filedef,variantdef]) and
+           (def1.typ<>def2.typ)) or
+          { pointers, ordinals and small sets are all passed the same}
+          (((def1.typ in [orddef,enumdef,pointerdef,procvardef,classrefdef]) or
+            (is_class_or_interface_or_objc(def1)) or
+            is_dynamic_array(def1) or
+            is_smallset(def1) or
+            is_ansistring(def1) or
+            is_unicodestring(def1)) <>
+           (def2.typ in [orddef,enumdef,pointerdef,procvardef,classrefdef]) or
+            (is_class_or_interface_or_objc(def2)) or
+            is_dynamic_array(def2) or
+             is_smallset(def2) or
+            is_ansistring(def2) or
+            is_unicodestring(def2)) or
+           { shortstrings }
+           (is_shortstring(def1)<>
+            is_shortstring(def2)) or
+           { winlike widestrings }
+           (is_widestring(def1)<>
+            is_widestring(def2)) or
+           { TP-style objects }
+           (is_object(def1) <>
+            is_object(def2));
+      end;
+
+
     function compare_paras(para1,para2 : TFPObjectList; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
       var
         currpara1,
@@ -1514,6 +1609,15 @@ implementation
                    (vo_is_hidden_para in tparavarsym(para2[i2]).varoptions) do
                inc(i2);
            end;
+         if cpo_ignoreframepointer in cpoptions then
+           begin
+             if (i1<para1.count) and
+                (vo_is_parentfp in tparavarsym(para1[i1]).varoptions) then
+               inc(i1);
+             if (i2<para2.count) and
+                (vo_is_parentfp in tparavarsym(para2[i2]).varoptions) then
+               inc(i2);
+           end;
          while (i1<para1.count) and (i2<para2.count) do
            begin
              eq:=te_incompatible;
@@ -1538,7 +1642,8 @@ implementation
                 if not(vo_is_self in currpara1.varoptions) and
                    not(vo_is_self in currpara2.varoptions) then
                  begin
-                   if (currpara1.varspez<>currpara2.varspez) then
+                   if not(cpo_ignorevarspez in cpoptions) and
+                      (currpara1.varspez<>currpara2.varspez) then
                     exit;
                    eq:=compare_defs_ext(currpara1.vardef,currpara2.vardef,nothingn,
                                         convtype,hpd,cdoptions);
@@ -1549,7 +1654,12 @@ implementation
                 case acp of
                   cp_value_equal_const :
                     begin
+                       { this one is used for matching parameters from a call
+                         statement to a procdef -> univ state can't be equal
+                         in any case since the call statement does not contain
+                         any information about that }
                        if (
+                           not(cpo_ignorevarspez in cpoptions) and
                            (currpara1.varspez<>currpara2.varspez) and
                            ((currpara1.varspez in [vs_var,vs_out]) or
                             (currpara2.varspez in [vs_var,vs_out]))
@@ -1560,15 +1670,24 @@ implementation
                     end;
                   cp_all :
                     begin
-                       if (currpara1.varspez<>currpara2.varspez) then
+                       { used to resolve forward definitions -> headers must
+                         match exactly, including the "univ" specifier }
+                       if (not(cpo_ignorevarspez in cpoptions) and
+                           (currpara1.varspez<>currpara2.varspez)) or
+                          (currpara1.univpara<>currpara2.univpara) then
                          exit;
                        eq:=compare_defs_ext(currpara1.vardef,currpara2.vardef,nothingn,
                                             convtype,hpd,cdoptions);
                     end;
                   cp_procvar :
                     begin
-                       if (currpara1.varspez<>currpara2.varspez) then
+                       if not(cpo_ignorevarspez in cpoptions) and
+                          (currpara1.varspez<>currpara2.varspez) then
                          exit;
+                       { "univ" state doesn't matter here: from univ to non-univ
+                          matches if the types are compatible (i.e., as usual),
+                          from from non-univ to univ also matches if the types
+                          have the same size (checked below) }
                        eq:=compare_defs_ext(currpara1.vardef,currpara2.vardef,nothingn,
                                             convtype,hpd,cdoptions);
                        { Parameters must be at least equal otherwise the are incompatible }
@@ -1582,7 +1701,30 @@ implementation
                end;
               { check type }
               if eq=te_incompatible then
-                exit;
+                begin
+                  { special case: "univ" parameters match if their size is equal }
+                  if not(cpo_ignoreuniv in cpoptions) and
+                     currpara2.univpara and
+                     is_valid_univ_para_type(currpara1.vardef) and
+                     (currpara1.vardef.size=currpara2.vardef.size) then
+                    begin
+                      { only pick as last choice }
+                      eq:=te_convert_l5;
+                      if (acp=cp_procvar) and
+                         (cpo_warn_incompatible_univ in cpoptions) then
+                        begin
+                          { if the types may be passed in different ways by the
+                            calling convention then this can lead to crashes
+                            (note: not an exhaustive check, and failing this
+                             this check does not mean things will crash on all
+                             platforms) }
+                          if potentially_incompatible_univ_paras(currpara1.vardef,currpara2.vardef) then
+                            Message2(type_w_procvar_univ_conflicting_para,currpara1.vardef.typename,currpara2.vardef.typename)
+                        end;
+                    end
+                  else
+                    exit;
+                end;
               { open strings can never match exactly, since you cannot define }
               { a separate "open string" type -> we have to be able to        }
               { consider those as exact when resolving forward definitions.   }
@@ -1619,6 +1761,15 @@ implementation
                         (vo_is_hidden_para in tparavarsym(para2[i2]).varoptions) do
                     inc(i2);
                 end;
+              if cpo_ignoreframepointer in cpoptions then
+                begin
+                  if (i1<para1.count) and
+                     (vo_is_parentfp in tparavarsym(para1[i1]).varoptions) then
+                    inc(i1);
+                  if (i2<para2.count) and
+                     (vo_is_parentfp in tparavarsym(para2[i2]).varoptions) then
+                    inc(i2);
+                end;
            end;
          { when both lists are empty then the parameters are equal. Also
            when one list is empty and the other has a parameter with default
@@ -1631,18 +1782,42 @@ implementation
       end;
 
 
-    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef):tequaltype;
+    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef;checkincompatibleuniv: boolean):tequaltype;
       var
         eq : tequaltype;
         po_comp : tprocoptions;
+        pa_comp: tcompare_paras_options;
       begin
          proc_to_procvar_equal:=te_incompatible;
          if not(assigned(def1)) or not(assigned(def2)) then
            exit;
-         { check for method pointer }
-         if (def1.is_methodpointer xor def2.is_methodpointer) or
-            (def1.is_addressonly xor def2.is_addressonly) then
+         { check for method pointer and local procedure pointer:
+             a) if one is a procedure of object, the other also has to be one
+             b) if one is a pure address, the other also has to be one
+                except if def1 is a global proc and def2 is a nested procdef
+                (global procedures can be converted into nested procvars)
+             c) if def1 is a nested procedure, then def2 has to be a nested
+                procvar and def1 has to have the po_delphi_nested_cc option
+             d) if def1 is a procvar, def1 and def2 both have to be nested or
+                non-nested (we don't allow assignments from non-nested to
+                nested procvars to make sure that we can still implement
+                nested procvars using trampolines -- e.g., this would be
+                necessary for LLVM or CIL as long as they do not have support
+                for Delphi-style frame pointer parameter passing) }
+         if (def1.is_methodpointer<>def2.is_methodpointer) or  { a) }
+            ((def1.is_addressonly<>def2.is_addressonly) and    { b) }
+             (is_nested_pd(def1) or
+              not is_nested_pd(def2))) or
+            ((def1.typ=procdef) and                            { c) }
+             is_nested_pd(def1) and
+             (not(po_delphi_nested_cc in def1.procoptions) or
+              not is_nested_pd(def2))) or
+            ((def1.typ=procvardef) and                         { d) }
+             (is_nested_pd(def1)<>is_nested_pd(def2))) then
            exit;
+         pa_comp:=[cpo_ignoreframepointer];
+         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];
@@ -1655,9 +1830,15 @@ implementation
             { return equal type based on the parameters, but a proc->procvar
               is never exact, so map an exact match of the parameters to
               te_equal }
-            eq:=compare_paras(def1.paras,def2.paras,cp_procvar,[]);
+            eq:=compare_paras(def1.paras,def2.paras,cp_procvar,pa_comp);
             if eq=te_exact then
              eq:=te_equal;
+            if (eq=te_equal) then
+              begin
+                { prefer non-nested to non-nested over non-nested to nested }
+                if (is_nested_pd(def1)<>is_nested_pd(def2)) then
+                  eq:=te_convert_l1;
+              end;
             proc_to_procvar_equal:=eq;
           end;
       end;
@@ -1669,8 +1850,8 @@ implementation
           (equal_defs(parentretdef,childretdef)) or
           ((parentretdef.typ=objectdef) and
            (childretdef.typ=objectdef) and
-           is_class_or_interface(parentretdef) and
-           is_class_or_interface(childretdef) and
+           is_class_or_interface_or_objc(parentretdef) and
+           is_class_or_interface_or_objc(childretdef) and
            (tobjectdef(childretdef).is_related(tobjectdef(parentretdef))))
       end;
 

compiler/defutil.pas

@@ -27,7 +27,7 @@ interface
 
     uses
        cclasses,
-       globtype,globals,constexp,
+       globtype,globals,constexp,node,
        symconst,symbase,symtype,symdef,
        cgbase,cpubase;
 
@@ -43,6 +43,9 @@ interface
     {# Returns true, if definition defines an ordinal type }
     function is_ordinal(def : tdef) : boolean;
 
+    {# Returns true, if definition defines a string type }
+    function is_string(def : tdef): boolean;
+
     {# Returns the minimal integer value of the type }
     function get_min_value(def : tdef) : TConstExprInt;
 
@@ -77,6 +80,9 @@ interface
     {# Returns true if definition is a widechar }
     function is_widechar(def : tdef) : boolean;
 
+    {# Returns true if definition is either an AnsiChar or a WideChar }
+    function is_anychar(def : tdef) : boolean;
+
     {# Returns true if definition is a void}
     function is_void(def : tdef) : boolean;
 
@@ -88,10 +94,14 @@ interface
     }
     function is_signed(def : tdef) : boolean;
 
-    {# Returns true whether def_from's range is comprised in def_to's if both are
+    {# Returns whether def_from's range is comprised in def_to's if both are
       orddefs, false otherwise                                              }
     function is_in_limit(def_from,def_to : tdef) : boolean;
 
+    {# Returns whether def is reference counted }
+    function is_managed_type(def: tdef) : boolean;{$ifdef USEINLINE}inline;{$endif}
+
+
 {    function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;}
 
 {*****************************************************************************
@@ -246,6 +256,19 @@ interface
     { # returns true if the procdef has no parameters and no specified return type }
     function is_bareprocdef(pd : tprocdef): boolean;
 
+    { # returns the smallest base integer type whose range encompasses that of
+        both ld and rd; if keep_sign_if_equal, then if ld and rd have the same
+        signdness, the result will also get that signdness }
+    function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
+
+    { # returns whether the type is potentially a valid type of/for an "univ" parameter
+        (basically: it must have a compile-time size) }
+    function is_valid_univ_para_type(def: tdef): boolean;
+
+    { # returns whether the procdef/procvardef represents a nested procedure
+        or not }
+    function is_nested_pd(def: tabstractprocdef): boolean;{$ifdef USEINLINE}inline;{$endif}
+
 implementation
 
     uses
@@ -293,7 +316,7 @@ implementation
     function is_extended(def : tdef) : boolean;
       begin
         result:=(def.typ=floatdef) and
-          (tfloatdef(def).floattype=s80real);
+          (tfloatdef(def).floattype in [s80real,sc80real]);
       end;
 
 
@@ -374,6 +397,12 @@ implementation
          end;
       end;
 
+    { true if p is a string }
+    function is_string(def : tdef) : boolean;
+      begin
+        is_string := (assigned(def) and (def.typ = stringdef));
+      end;
+
 
     { returns the min. value of the type }
     function get_min_value(def : tdef) : TConstExprInt;
@@ -458,6 +487,14 @@ implementation
       end;
 
 
+    { true if p is a char or wchar }
+    function is_anychar(def : tdef) : boolean;
+      begin
+        result:=(def.typ=orddef) and
+                 (torddef(def).ordtype in [uchar,uwidechar])
+      end;
+
+
     { true if p is signed (integer) }
     function is_signed(def : tdef) : boolean;
       begin
@@ -496,6 +533,13 @@ implementation
          end;
       end;
 
+
+    function is_managed_type(def: tdef): boolean;{$ifdef USEINLINE}inline;{$endif}
+      begin
+        result:=def.needs_inittable;
+      end;
+
+
     { true, if p points to an open array def }
     function is_open_string(p : tdef) : boolean;
       begin
@@ -940,8 +984,7 @@ implementation
             result := OS_ADDR;
           procvardef:
             begin
-              if tprocvardef(def).is_methodpointer and
-                 (not tprocvardef(def).is_addressonly) then
+              if not tprocvardef(def).is_addressonly then
                 {$if sizeof(pint) = 4}
                   result:=OS_64
                 {$else} {$if sizeof(pint) = 8}
@@ -961,7 +1004,7 @@ implementation
             end;
           objectdef :
             begin
-              if is_class_or_interface(def) then
+              if is_class_or_interface_or_dispinterface_or_objc(def) then
                 result := OS_ADDR
               else
                 result:=int_cgsize(def.size);
@@ -1060,4 +1103,76 @@ implementation
                  (pd.proctypeoption = potype_constructor));
       end;
 
+
+    function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
+      var
+        llow, lhigh: tconstexprint;
+      begin
+        llow:=rd.low;
+        if llow<ld.low then
+          llow:=ld.low;
+        lhigh:=rd.high;
+        if lhigh<ld.high then
+          lhigh:=ld.high;
+        case range_to_basetype(llow,lhigh) of
+          s8bit:
+            result:=torddef(s8inttype);
+          u8bit:
+            result:=torddef(u8inttype);
+          s16bit:
+            result:=torddef(s16inttype);
+          u16bit:
+            result:=torddef(u16inttype);
+          s32bit:
+            result:=torddef(s32inttype);
+          u32bit:
+            result:=torddef(u32inttype);
+          s64bit:
+            result:=torddef(s64inttype);
+          u64bit:
+            result:=torddef(u64inttype);
+          else
+            begin
+              { avoid warning }
+              result:=nil;
+              internalerror(200802291);
+            end;
+        end;
+        if keep_sign_if_equal and
+           (is_signed(ld)=is_signed(rd)) and
+           (is_signed(result)<>is_signed(ld)) then
+          case result.ordtype of
+            s8bit:
+              result:=torddef(u8inttype);
+            u8bit:
+              result:=torddef(s16inttype);
+            s16bit:
+              result:=torddef(u16inttype);
+            u16bit:
+              result:=torddef(s32inttype);
+            s32bit:
+              result:=torddef(u32inttype);
+            u32bit:
+              result:=torddef(s64inttype);
+            s64bit:
+              result:=torddef(u64inttype);
+          end;
+      end;
+
+
+    function is_valid_univ_para_type(def: tdef): boolean;
+      begin
+        result:=
+          not is_open_array(def) and
+          not is_void(def) and
+          (def.typ<>formaldef);
+      end;
+
+
+    function is_nested_pd(def: tabstractprocdef): boolean;{$ifdef USEINLINE}inline;{$endif}
+      begin
+        result:=def.parast.symtablelevel>normal_function_level;
+      end;
+
+
 end.

compiler/export.pas

@@ -73,6 +73,9 @@ type
 
   procedure exportprocsym(sym: tsym; const s : string; index: longint; options: word);
   procedure exportvarsym(sym: tsym; const s : string; index: longint; options: word);
+  { to export symbols not directly related to a tsym (e.g., the Objective-C
+    rtti) }
+  procedure exportname(const s : string; options: word);
 
   procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: word);
   procedure exportallprocsymnames(ps: tprocsym; options: word);
@@ -122,6 +125,12 @@ procedure exportvarsym(sym: tsym; const s : string; index: longint; options: wor
   end;
 
 
+procedure exportname(const s : string; options: word);
+  begin
+    exportvarsym(nil,s,0,options);
+  end;
+
+
   procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: word);
     var
       item: TCmdStrListItem;

compiler/expunix.pas

@@ -59,6 +59,7 @@ uses
   aasmdata,aasmtai,aasmcpu,
   fmodule,
   cgbase,cgutils,cpubase,cgobj,
+  cgcpu,
   ncgutil,
   verbose;
 
@@ -135,6 +136,7 @@ var
   r : treference;
 {$endif x86}
 begin
+  create_codegen;
   new_section(current_asmdata.asmlists[al_procedures],sec_code,'',0);
   hp2:=texported_item(current_module._exports.first);
   while assigned(hp2) do
@@ -152,11 +154,11 @@ begin
            current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0));
            if (cs_create_pic in current_settings.moduleswitches) and
              { other targets need to be checked how it works }
-             (target_info.system in [system_i386_freebsd,system_x86_64_freebsd,system_x86_64_linux,system_i386_linux]) then
+             (target_info.system in [system_i386_freebsd,system_x86_64_freebsd,system_x86_64_linux,system_i386_linux,system_x86_64_solaris,system_i386_solaris]) then
              begin
 {$ifdef x86}
                sym:=current_asmdata.RefAsmSymbol(pd.mangledname);
-               reference_reset_symbol(r,sym,0);
+               reference_reset_symbol(r,sym,0,sizeof(pint));
                if cs_create_pic in current_settings.moduleswitches then
                  r.refaddr:=addr_pic
                else
@@ -172,13 +174,15 @@ begin
       end
      else
        begin
-         if (hp2.name^<>hp2.sym.mangledname) then
+         if assigned(hp2.sym) and
+            (hp2.name^<>hp2.sym.mangledname) then
            Message2(parser_e_cant_export_var_different_name,hp2.sym.realname,hp2.sym.mangledname)
          else
            exportedsymnames.insert(hp2.name^);
        end;
      hp2:=texported_item(hp2.next);
    end;
+   destroy_codegen;
 end;
 
 

compiler/finput.pas

@@ -29,7 +29,7 @@ interface
       cutils,cclasses;
 
     const
-       InputFileBufSize=32*1024;
+       InputFileBufSize=32*1024+1;
        linebufincrease=512;
 
     type
@@ -268,6 +268,7 @@ uses
         endoffile:=false;
         closed:=false;
         Getmem(buf,MaxBufsize);
+        buf[0]:=#0;
         bufstart:=0;
         bufsize:=0;
         open:=true;
@@ -640,7 +641,7 @@ uses
          asmfilename:=stringdup(p+n+target_info.asmext);
          objfilename:=stringdup(p+n+target_info.objext);
          ppufilename:=stringdup(p+n+target_info.unitext);
-         importlibfilename:=stringdup(p+target_info.staticClibprefix+'imp'+n+target_info.staticlibext);
+         importlibfilename:=stringdup(p+target_info.importlibprefix+n+target_info.importlibext);
          staticlibfilename:=stringdup(p+target_info.staticlibprefix+n+target_info.staticlibext);
 
          { output dir of exe can be specified separatly }

compiler/fmodule.pas

@@ -44,7 +44,9 @@ interface
     uses
        cutils,cclasses,cfileutl,
        globtype,finput,ogbase,
-       symbase,symsym,aasmbase,aasmtai,aasmdata;
+       symbase,symsym,
+       wpobase,
+       aasmbase,aasmtai,aasmdata;
 
 
     const
@@ -55,6 +57,17 @@ interface
         rr_noppu,rr_sourcenewer,rr_build,rr_crcchanged
       );
 
+      { unit options }
+      tmoduleoption = (mo_none,
+        mo_hint_deprecated,
+        mo_hint_platform,
+        mo_hint_library,
+        mo_hint_unimplemented,
+        mo_hint_experimental,
+        mo_has_deprecated_msg
+      );
+      tmoduleoptions = set of tmoduleoption;
+
       tlinkcontaineritem=class(tlinkedlistitem)
       public
          data : pshortstring;
@@ -89,6 +102,8 @@ interface
       end;
       pderefmap = ^tderefmaprec;
 
+      { tmodule }
+
       tmodule = class(tmodulebase)
       private
         FImportLibraryList : TFPHashObjectList;
@@ -98,7 +113,6 @@ interface
         sources_avail,            { if all sources are reachable }
         interface_compiled,       { if the interface section has been parsed/compiled/loaded }
         is_dbginfo_written,
-        is_reset,
         is_unit,
         in_interface,             { processing the implementation part? }
         { allow global settings }
@@ -113,7 +127,8 @@ interface
         mainfilepos   : tfileposinfo;
         recompile_reason : trecompile_reason;  { the reason why the unit should be recompiled }
         crc,
-        interface_crc : cardinal;
+        interface_crc,
+        indirect_crc  : cardinal;
         flags         : cardinal;  { the PPU flags }
         islibrary     : boolean;  { if it is a library (win32 dll) }
         IsPackage     : boolean;
@@ -128,6 +143,7 @@ interface
         checkforwarddefs,
         deflist,
         symlist       : TFPObjectList;
+        wpoinfo       : tunitwpoinfobase; { whole program optimization-related information that is generated during the current run for this unit }
         globalsymtable,           { pointer to the global symtable of this unit }
         localsymtable : TSymtable;{ pointer to the local symtable of this unit }
         globalmacrosymtable,           { pointer to the global macro symtable of this unit }
@@ -159,6 +175,9 @@ interface
         locallibrarysearchpath,
         localframeworksearchpath : TSearchPathList;
 
+        moduleoptions: tmoduleoptions;
+        deprecatedmsg: pshortstring;
+
         {create creates a new module which name is stored in 's'. LoadedFrom
         points to the module calling it. It is nil for the first compiled
         module. This allow inheritence of all path lists. MUST pay attention
@@ -170,6 +189,7 @@ 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;
@@ -180,7 +200,8 @@ interface
 
        tused_unit = class(tlinkedlistitem)
           checksum,
-          interface_checksum : cardinal;
+          interface_checksum,
+          indirect_checksum: cardinal;
           in_uses,
           in_interface    : boolean;
           u               : tmodule;
@@ -417,11 +438,13 @@ implementation
          begin
            checksum:=u.crc;
            interface_checksum:=u.interface_crc;
+           indirect_checksum:=u.indirect_crc;
          end
         else
          begin
            checksum:=0;
            interface_checksum:=0;
+           indirect_checksum:=0;
          end;
       end;
 
@@ -477,6 +500,7 @@ implementation
         FImportLibraryList:=TFPHashObjectList.Create(true);
         crc:=0;
         interface_crc:=0;
+        indirect_crc:=0;
         flags:=0;
         scanner:=nil;
         unitmap:=nil;
@@ -488,6 +512,7 @@ implementation
         derefdataintflen:=0;
         deflist:=TFPObjectList.Create(false);
         symlist:=TFPObjectList.Create(false);
+        wpoinfo:=nil;
         checkforwarddefs:=TFPObjectList.Create(false);
         globalsymtable:=nil;
         localsymtable:=nil;
@@ -507,8 +532,9 @@ implementation
         islibrary:=false;
         ispackage:=false;
         is_dbginfo_written:=false;
-        is_reset:=false;
         mode_switch_allowed:= true;
+        moduleoptions:=[];
+        deprecatedmsg:=nil;
         _exports:=TLinkedList.Create;
         dllscannerinputlist:=TFPHashList.Create;
         asmdata:=TAsmData.create(realmodulename^);
@@ -587,6 +613,7 @@ implementation
         stringdispose(realmodulename);
         stringdispose(mainsource);
         stringdispose(asmprefix);
+        stringdispose(deprecatedmsg);
         localunitsearchpath.Free;
         localobjectsearchpath.free;
         localincludesearchpath.free;
@@ -598,15 +625,12 @@ implementation
         derefdata.free;
         deflist.free;
         symlist.free;
+        wpoinfo.free;
         checkforwarddefs.free;
-        if assigned(globalsymtable) then
-          globalsymtable.free;
-        if assigned(localsymtable) then
-          localsymtable.free;
-        if assigned(globalmacrosymtable) then
-          globalmacrosymtable.free;
-        if assigned(localmacrosymtable) then
-          localmacrosymtable.free;
+        globalsymtable.free;
+        localsymtable.free;
+        globalmacrosymtable.free;
+        localmacrosymtable.free;
 {$ifdef MEMDEBUG}
         memsymtable.stop;
 {$endif}
@@ -652,30 +676,20 @@ implementation
             asmdata:=nil;
           end;
         DoneDebugInfo(self);
-        if assigned(globalsymtable) then
-          begin
-            globalsymtable.free;
-            globalsymtable:=nil;
-          end;
-        if assigned(localsymtable) then
-          begin
-            localsymtable.free;
-            localsymtable:=nil;
-          end;
-        if assigned(globalmacrosymtable) then
-          begin
-            globalmacrosymtable.free;
-            globalmacrosymtable:=nil;
-          end;
-        if assigned(localmacrosymtable) then
-          begin
-            localmacrosymtable.free;
-            localmacrosymtable:=nil;
-          end;
+        globalsymtable.free;
+        globalsymtable:=nil;
+        localsymtable.free;
+        localsymtable:=nil;
+        globalmacrosymtable.free;
+        globalmacrosymtable:=nil;
+        localmacrosymtable.free;
+        localmacrosymtable:=nil;
         deflist.free;
         deflist:=TFPObjectList.Create(false);
         symlist.free;
         symlist:=TFPObjectList.Create(false);
+        wpoinfo.free;
+        wpoinfo:=nil;
         checkforwarddefs.free;
         checkforwarddefs:=TFPObjectList.Create(false);
         derefdata.free;
@@ -733,10 +747,12 @@ implementation
         in_interface:=true;
         in_global:=true;
         mode_switch_allowed:=true;
+        stringdispose(deprecatedmsg);
+        moduleoptions:=[];
         is_dbginfo_written:=false;
-        is_reset:=false;
         crc:=0;
         interface_crc:=0;
+        indirect_crc:=0;
         flags:=0;
         mainfilepos.line:=0;
         mainfilepos.column:=0;
@@ -842,6 +858,23 @@ 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;
       begin

compiler/fpcdefs.inc

@@ -3,21 +3,7 @@
 {$H-}
 {$goto on}
 {$inline on}
-
-{$ifdef win32}
-  { 256 MB stack }
-  { under windows the stack can't grow }
-  {$MEMORY 256000000}
-{$else win32}
-  {$ifdef win64}
-    { 512 MB stack }
-    { under windows the stack can't grow }
-    {$MEMORY 512000000}
-  {$else win64}
-    { 1 MB stack }
-    {$MEMORY 1000000}
-  {$endif win64}
-{$endif win32}
+{$interfaces corba}
 
 { This reduces the memory requirements a lot }
 {$PACKENUM 1}
@@ -108,9 +94,13 @@
   {$define cpuneedsdiv32helper}
   {$define cputargethasfixedstack}
   { inherit FPC_ARMEL? }
-  {$if defined(CPUARMEL) and not(defined(FPC_OARM))}
+  {$if defined(CPUARMEL) and not(defined(FPC_OARM)) and not(defined(FPC_ARMEB))}
     {$define FPC_ARMEL}
   {$endif}
+  { inherit FPC_ARMEB? }
+  {$if defined(CPUARMEB) and not(defined(FPC_OARM)) and not(defined(FPC_ARMEL))}
+    {$define FPC_ARMEB}
+  {$endif}
 {$endif arm}
 
 {$ifdef m68k}
@@ -130,12 +120,23 @@
   {$define cpunodefaultint}
 {$endif avr}
 
+{$ifdef mipsel}
+  {$define mips}
+{$endif mipsel}
+
+{$ifdef mips}
+  {$define cpu32bitalu}
+  {$define cpu32bitaddr}
+  { $define cpuflags}
+  {$define cputargethasfixedstack}
+  {$define cpurequiresproperalignment}
+  {$define cpumm}
+{$endif mips}
+
 {$IFDEF MACOS}
 {$DEFINE USE_FAKE_SYSUTILS}
 {$ENDIF MACOS}
 
-{$define SUPPORT_UNALIGNED}
-
-{$if not defined(cpui386) and defined(i386)}
-{$error Cross-compiling from non-i386 to i386 is not yet supported at this time }
+{$if not defined(FPC_HAS_TYPE_EXTENDED) and defined(i386)}
+{$error Cross-compiling from systems without support for an 80 bit extended floating point type to i386 is not yet supported at this time }
 {$endif}

compiler/fppu.pas

@@ -40,6 +40,9 @@ interface
        symbase,ppu,symtype;
 
     type
+
+       { tppumodule }
+
        tppumodule = class(tmodule)
           ppufile    : tcompilerppufile; { the PPU file }
           sourcefn   : pshortstring; { Source specified with "uses .. in '..'" }
@@ -58,7 +61,16 @@ interface
           procedure writeppu;
           procedure loadppu;
           function  needrecompile:boolean;
+          procedure setdefgeneration;
+          procedure reload_flagged_units;
        private
+         { Each time a unit's defs are (re)created, its defsgeneration is
+           set to the value of a global counter, and the global counter is
+           increased. We only reresolve its dependent units' defs in case
+           they have been resolved only for an older generation, in order to
+           avoid endless resolving loops in case of cyclic dependencies. }
+          defsgeneration : longint;
+
           function  search_unit(onlysource,shortname:boolean):boolean;
           procedure load_interface;
           procedure load_implementation;
@@ -79,6 +91,7 @@ interface
           procedure readderefdata;
           procedure readImportSymbols;
           procedure readResources;
+          procedure readwpofile;
 {$IFDEF MACRO_DIFF_HINT}
           procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
           procedure writeusedmacros;
@@ -86,7 +99,6 @@ interface
 {$ENDIF}
        end;
 
-    procedure reload_flagged_units;
     function registerunit(callermodule:tmodule;const s : TIDString;const fn:string) : tppumodule;
 
 
@@ -97,29 +109,15 @@ uses
   cfileutl,
   verbose,systems,version,
   symtable, symsym,
+  wpoinfo,
   scanner,
   aasmbase,ogbase,
   parser,
   comphook;
 
-{****************************************************************************
-                                 Helpers
- ****************************************************************************}
-
-    procedure reload_flagged_units;
-      var
-        hp : tmodule;
-      begin
-        { now reload all dependent units }
-        hp:=tmodule(loaded_units.first);
-        while assigned(hp) do
-         begin
-           if hp.do_reload then
-             tppumodule(hp).loadppu;
-           hp:=tmodule(hp.next);
-         end;
-      end;
 
+var
+  currentdefgeneration: longint;
 
 {****************************************************************************
                                 TPPUMODULE
@@ -147,6 +145,7 @@ uses
 
     procedure tppumodule.reset;
       begin
+        inc(currentdefgeneration);
         if assigned(ppufile) then
          begin
            ppufile.free;
@@ -246,11 +245,13 @@ uses
         flags:=ppufile.header.flags;
         crc:=ppufile.header.checksum;
         interface_crc:=ppufile.header.interface_checksum;
+        indirect_crc:=ppufile.header.indirect_checksum;
       { Show Debug info }
         Message1(unit_u_ppu_time,filetimestring(ppufiletime));
         Message1(unit_u_ppu_flags,tostr(flags));
         Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8));
         Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
+        Message1(unit_u_ppu_crc,hexstr(ppufile.header.indirect_checksum,8)+' (indc)');
         Comment(V_used,'Number of definitions: '+tostr(ppufile.header.deflistsize));
         Comment(V_used,'Number of symbols: '+tostr(ppufile.header.symlistsize));
         do_compile:=false;
@@ -510,7 +511,11 @@ uses
                ppufile.do_crc:=false;
                ppufile.putlongint(longint(hp.checksum));
                ppufile.putlongint(longint(hp.interface_checksum));
+               ppufile.putlongint(longint(hp.indirect_checksum));
                ppufile.do_crc:=oldcrc;
+               { combine all indirect checksums from units used by this unit }
+               if intf then
+                 ppufile.indirect_crc:=ppufile.indirect_crc xor hp.indirect_checksum;
              end;
            hp:=tused_unit(hp.next);
          end;
@@ -805,6 +810,7 @@ uses
         hs : string;
         pu : tused_unit;
         hp : tppumodule;
+        indchecksum,
         intfchecksum,
         checksum : cardinal;
       begin
@@ -813,12 +819,14 @@ uses
            hs:=ppufile.getstring;
            checksum:=cardinal(ppufile.getlongint);
            intfchecksum:=cardinal(ppufile.getlongint);
+           indchecksum:=cardinal(ppufile.getlongint);
            { set the state of this unit before registering, this is
              needed for a correct circular dependency check }
            hp:=registerunit(self,hs,'');
            pu:=addusedunit(hp,false,nil);
            pu.checksum:=checksum;
            pu.interface_checksum:=intfchecksum;
+           pu.indirect_checksum:=indchecksum;
          end;
         in_interface:=false;
       end;
@@ -902,6 +910,25 @@ uses
       end;
 
 
+    procedure tppumodule.readwpofile;
+      var
+        orgwpofilename: string;
+        orgwpofiletime: longint;
+      begin
+        { check whether we are using the same wpo feedback input file as when
+          this unit was compiled (same file name and file date)
+        }
+        orgwpofilename:=ppufile.getstring;
+        orgwpofiletime:=ppufile.getlongint;
+        if (extractfilename(orgwpofilename)<>extractfilename(wpofeedbackinput)) or
+           (orgwpofiletime<>GetNamedFileTime(orgwpofilename)) then
+          { make sure we don't throw away a precompiled unit if the user simply
+            forgot to specify the right wpo feedback file
+          }
+          message3(unit_e_different_wpo_file,ppufilename^,orgwpofilename,filetimestring(orgwpofiletime));
+      end;
+
+
     procedure tppumodule.load_interface;
       var
         b : byte;
@@ -922,6 +949,15 @@ uses
                  modulename:=stringdup(upper(newmodulename));
                  realmodulename:=stringdup(newmodulename);
                end;
+             ibmoduleoptions:
+               begin
+                 ppufile.getsmallset(moduleoptions);
+                 if mo_has_deprecated_msg in moduleoptions then
+                   begin
+                     stringdispose(deprecatedmsg);
+                     deprecatedmsg:=stringdup(ppufile.getstring);
+                   end;
+               end;
              ibsourcefiles :
                readsourcefiles;
 {$IFDEF MACRO_DIFF_HINT}
@@ -959,6 +995,8 @@ uses
                readderefdata;
              ibresources:
                readResources;
+             ibwpofile:
+               readwpofile;
              ibendinterface :
                break;
            else
@@ -1020,6 +1058,11 @@ uses
          ppufile.putstring(realmodulename^);
          ppufile.writeentry(ibmodulename);
 
+         ppufile.putsmallset(moduleoptions);
+         if mo_has_deprecated_msg in moduleoptions then
+           ppufile.putstring(deprecatedmsg^);
+         ppufile.writeentry(ibmoduleoptions);
+
          { write the alternate main procedure name if any }
          if assigned(mainname) then
            begin
@@ -1037,9 +1080,20 @@ uses
 
          { write the objectfiles and libraries that come for this unit,
            preserve the containers becuase they are still needed to load
-           the link.res. All doesn't depend on the crc! It doesn't matter
+           the link.res.
+            All doesn't depend on the crc! It doesn't matter
            if a unit is in a .o or .a file }
          ppufile.do_crc:=false;
+         { write after source files, so that we know whether or not the compiler
+           will recompile the unit when checking whether the correct wpo file is
+           used (if it will recompile the unit anyway, it doesn't matter)
+         }
+         if (wpofeedbackinput<>'') then
+           begin
+             ppufile.putstring(wpofeedbackinput);
+             ppufile.putlongint(getnamedfiletime(wpofeedbackinput));
+             ppufile.writeentry(ibwpofile);
+           end;
          writelinkcontainer(linkunitofiles,iblinkunitofiles,true);
          writelinkcontainer(linkunitstaticlibs,iblinkunitstaticlibs,true);
          writelinkcontainer(linkunitsharedlibs,iblinkunitsharedlibs,true);
@@ -1057,13 +1111,19 @@ uses
            begin
              tstoredsymtable(globalsymtable).buildderef;
              derefdataintflen:=derefdata.size;
-           end;
+           end
+         else
+           { the unit may have been re-resolved, in which case the current
+             position in derefdata is not necessarily at the end }
+            derefdata.seek(derefdata.size);
          tstoredsymtable(globalsymtable).buildderefimpl;
          if (flags and uf_local_symtable)<>0 then
            begin
              tstoredsymtable(localsymtable).buildderef;
              tstoredsymtable(localsymtable).buildderefimpl;
            end;
+         tunitwpoinfo(wpoinfo).buildderef;
+         tunitwpoinfo(wpoinfo).buildderefimpl;
          writederefmap;
          writederefdata;
 
@@ -1098,6 +1158,9 @@ uses
          if (flags and uf_local_symtable)<>0 then
            tstoredsymtable(localsymtable).ppuwrite(ppufile);
 
+         { write whole program optimisation-related information }
+         tunitwpoinfo(wpoinfo).ppuwrite(ppufile);
+
          { the last entry ibend is written automaticly }
 
          { flush to be sure }
@@ -1106,6 +1169,7 @@ uses
          ppufile.header.size:=ppufile.size;
          ppufile.header.checksum:=ppufile.crc;
          ppufile.header.interface_checksum:=ppufile.interface_crc;
+         ppufile.header.indirect_checksum:=ppufile.indirect_crc;
          ppufile.header.compiler:=wordversion;
          ppufile.header.cpu:=word(target_cpu);
          ppufile.header.target:=word(target_info.system);
@@ -1117,6 +1181,7 @@ uses
          { save crc in current module also }
          crc:=ppufile.crc;
          interface_crc:=ppufile.interface_crc;
+         indirect_crc:=ppufile.indirect_crc;
 
 {$ifdef Test_Double_checksum_write}
          close(CRCFile);
@@ -1145,6 +1210,11 @@ uses
          ppufile.putstring(realmodulename^);
          ppufile.writeentry(ibmodulename);
 
+         ppufile.putsmallset(moduleoptions);
+         if mo_has_deprecated_msg in moduleoptions then
+           ppufile.putstring(deprecatedmsg^);
+         ppufile.writeentry(ibmoduleoptions);
+
          { the interface units affect the crc }
          writeusedunit(true);
 
@@ -1175,6 +1245,7 @@ uses
          { save crc  }
          crc:=ppufile.crc;
          interface_crc:=ppufile.interface_crc;
+         indirect_crc:=ppufile.indirect_crc;
 
          { end of implementation, to generate a correct ppufile
            for ppudump when using INTFPPU define }
@@ -1198,6 +1269,7 @@ uses
          ppufile.header.size:=ppufile.size;
          ppufile.header.checksum:=ppufile.crc;
          ppufile.header.interface_checksum:=ppufile.interface_crc;
+         ppufile.header.indirect_checksum:=ppufile.indirect_crc;
          ppufile.header.compiler:=wordversion;
          ppufile.header.cpu:=word(target_cpu);
          ppufile.header.target:=word(target_info.system);
@@ -1234,12 +1306,21 @@ uses
                 crc. And when not compiled with -Ur then check the complete
                 crc }
               if (pu.u.interface_crc<>pu.interface_checksum) or
+                 (pu.u.indirect_crc<>pu.indirect_checksum) or
                  (
                   ((ppufile.header.flags and uf_release)=0) and
                   (pu.u.crc<>pu.checksum)
                  ) then
                begin
                  Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^,@queuecomment);
+{$ifdef DEBUG_UNIT_CRC_CHANGES}
+                 if (pu.u.interface_crc<>pu.interface_checksum) then
+                   writeln('  intfcrc change: ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8))
+                 else if (pu.u.indirect_crc<>pu.indirect_checksum) then
+                   writeln('  indcrc change: ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8))
+                 else
+                   writeln('  implcrc change: ',hexstr(pu.u.crc,8),' <> ',hexstr(pu.checksum,8));
+{$endif DEBUG_UNIT_CRC_CHANGES}
                  recompile_reason:=rr_crcchanged;
                  do_compile:=true;
                  exit;
@@ -1284,9 +1365,16 @@ uses
               { add this unit to the dependencies }
               pu.u.adddependency(self);
               { need to recompile the current unit ? }
-              if (pu.u.interface_crc<>pu.interface_checksum) then
+              if (pu.u.interface_crc<>pu.interface_checksum) or
+                 (pu.u.indirect_crc<>pu.indirect_checksum) then
                 begin
                   Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^+' {impl}',@queuecomment);
+{$ifdef DEBUG_UNIT_CRC_CHANGES}
+                  if (pu.u.interface_crc<>pu.interface_checksum) then
+                    writeln('  intfcrc change (2): ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8))
+                  else if (pu.u.indirect_crc<>pu.indirect_checksum) then
+                    writeln('  indcrc change (2): ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8));
+{$endif DEBUG_UNIT_CRC_CHANGES}
                   recompile_reason:=rr_crcchanged;
                   do_compile:=true;
                   exit;
@@ -1301,11 +1389,16 @@ uses
             localsymtable:=tstaticsymtable.create(modulename^,moduleid);
             tstaticsymtable(localsymtable).ppuload(ppufile);
           end;
-
+          
         { we can now derefence all pointers to the implementation parts }
         tstoredsymtable(globalsymtable).derefimpl;
         if assigned(localsymtable) then
           tstoredsymtable(localsymtable).derefimpl;
+
+         { read whole program optimisation-related information }
+         wpoinfo:=tunitwpoinfo.ppuload(ppufile);
+         tunitwpoinfo(wpoinfo).deref;
+         tunitwpoinfo(wpoinfo).derefimpl;
       end;
 
 
@@ -1321,11 +1414,20 @@ uses
              crc. And when not compiled with -Ur then check the complete
              crc }
            if (pu.u.interface_crc<>pu.interface_checksum) or
+              (pu.u.indirect_crc<>pu.indirect_checksum) or
               (
                (pu.in_interface) and
                (pu.u.crc<>pu.checksum)
               ) then
              begin
+{$ifdef DEBUG_UNIT_CRC_CHANGES}
+               if (pu.u.interface_crc<>pu.interface_checksum) then
+                 writeln('  intfcrc change (3): ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8))
+               else if (pu.u.indirect_crc<>pu.indirect_checksum) then
+                 writeln('  indcrc change (3): ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8))
+               else
+                 writeln('  implcrc change (3): ',hexstr(pu.u.crc,8),' <> ',hexstr(pu.checksum,8));
+{$endif DEBUG_UNIT_CRC_CHANGES}
                result:=true;
                exit;
              end;
@@ -1334,12 +1436,40 @@ uses
       end;
 
 
+    procedure tppumodule.setdefgeneration;
+      begin
+        defsgeneration:=currentdefgeneration;
+        inc(currentdefgeneration);
+      end;
+
+
+    procedure tppumodule.reload_flagged_units;
+      var
+        hp : tppumodule;
+      begin
+        { now reload all dependent units with outdated defs }
+        hp:=tppumodule(loaded_units.first);
+        while assigned(hp) do
+         begin
+           if hp.do_reload and
+              (hp.defsgeneration<defsgeneration) then
+             begin
+               hp.defsgeneration:=defsgeneration;
+               hp.loadppu
+             end
+           else
+             hp.do_reload:=false;
+           hp:=tppumodule(hp.next);
+         end;
+      end;
+
+
     procedure tppumodule.loadppu;
       const
         ImplIntf : array[boolean] of string[15]=('implementation','interface');
       var
         do_load,
-        second_time : boolean;
+        second_time        : boolean;
         old_current_module : tmodule;
       begin
         old_current_module:=current_module;
@@ -1383,6 +1513,23 @@ uses
                       tstoredsymtable(localsymtable).deref;
                       tstoredsymtable(localsymtable).derefimpl;
                     end;
+                   if assigned(wpoinfo) then
+                     begin
+                       tunitwpoinfo(wpoinfo).deref;
+                       tunitwpoinfo(wpoinfo).derefimpl;
+                     end;
+
+                   { We have to flag the units that depend on this unit even
+                     though it didn't change, because they might also
+                     indirectly depend on the unit that did change (e.g.,
+                     in case rgobj, rgx86 and rgcpu have been compiled
+                     already, and then rgobj is recompiled for some reason
+                     -> rgx86 is re-reresolved, but the vmtentries of trgcpu
+                     must also be re-resolved, because they will also contain
+                     pointers to procdefs in the old trgobj (in case of a
+                     recompile, all old defs are freed) }
+                   flagdependent(old_current_module);
+                   reload_flagged_units;
                  end
                else
                  Message1(unit_u_skipping_reresolving_unit,modulename^);
@@ -1432,6 +1579,7 @@ uses
               if not do_compile then
                begin
                  load_interface;
+                 setdefgeneration;
                  if not do_compile then
                   begin
                     load_usedunits;
@@ -1480,6 +1628,7 @@ uses
               if not(state in [ms_compile,ms_second_compile]) then
                 state:=ms_compile;
               compile(mainsource^);
+              setdefgeneration;
             end
            else
             state:=ms_compiled;

compiler/gendef.pas

@@ -111,7 +111,6 @@ begin
   {$I-}
   if ioresult<>0 then
    exit;
-{$ifdef i386}
   case target_info.system of
     system_i386_Os2, system_i386_emx:
       begin
@@ -125,15 +124,19 @@ begin
         writeln(t,'STACKSIZE'#9+tostr(stacksize));
         writeln(t,'HEAPSIZE'#9+tostr(heapsize));
       end;
-  system_i386_win32, system_i386_wdosx :
-    begin
-      if description<>'' then
-        writeln(t,'DESCRIPTION '+''''+description+'''');
-      if dllversion<>'' then
-        writeln(t,'VERSION '+dllversion);
-    end;
+    system_i386_win32,
+    system_x86_64_win64,
+    system_ia64_win64,
+    system_arm_wince,
+    system_i386_wince,
+    system_i386_wdosx :
+      begin
+        if description<>'' then
+          writeln(t,'DESCRIPTION '+''''+description+'''');
+        if dllversion<>'' then
+          writeln(t,'VERSION '+dllversion);
+      end;
   end;
-{$endif}
 
 {write imports}
   if not importlist.empty then

compiler/globals.pas

@@ -68,7 +68,9 @@ interface
          [m_gpc,m_all,m_tp_procvar];
 {$endif}
        macmodeswitches =
-         [m_mac,m_all,m_result,m_cvar_support,m_mac_procvar];
+         [m_mac,m_all,m_result,m_cvar_support,m_mac_procvar,m_nested_procvars];
+       isomodeswitches =
+         [m_iso,m_all,m_tp_procvar,m_duplicate_names,m_nested_procvars];
 
        { maximum nesting of routines }
        maxnesting = 32;
@@ -104,18 +106,27 @@ interface
     type
        tcodepagestring = string[20];
 
-       tsettings = record
+       { this is written to ppus during token recording for generics so it must be packed }
+       tsettings = packed record
+         alignment       : talignmentinfo;
          globalswitches  : tglobalswitches;
          moduleswitches  : tmoduleswitches;
          localswitches   : tlocalswitches;
          modeswitches    : tmodeswitches;
          optimizerswitches : toptimizerswitches;
+         { generate information necessary to perform these wpo's during a subsequent compilation }
+         genwpoptimizerswitches: twpoptimizerswitches;
+         { perform these wpo's using information generated during a previous compilation }
+         dowpoptimizerswitches: twpoptimizerswitches;
          debugswitches   : tdebugswitches;
          { 0: old behaviour for sets <=256 elements
            >0: round to this size }
          setalloc,
          packenum        : shortint;
-         alignment       : talignmentinfo;
+
+         packrecords     : shortint;
+         maxfpuregisters : shortint;
+
          cputype,
          optimizecputype : tcputype;
          fputype         : tfputype;
@@ -124,10 +135,14 @@ interface
          defproccall     : tproccalloption;
          sourcecodepage  : tcodepagestring;
 
-         packrecords     : shortint;
-         maxfpuregisters : shortint;
-
          minfpconstprec  : tfloattype;
+
+         disabledircache : boolean;
+
+        { CPU targets with microcontroller support can add a controller specific unit }
+{$if defined(ARM) or defined(AVR)}
+        controllertype   : tcontrollertype;
+{$endif defined(ARM) or defined(AVR)}
        end;
 
     const
@@ -162,9 +177,10 @@ interface
       end;
 
       tpendingstate = record
-        nextverbositystr : string;
+        nextverbositystr : shortstring;
         nextlocalswitches : tlocalswitches;
         nextverbosityfullswitch: longint;
+        nextcallingstr : shortstring;
         verbosityfullswitched,
         localswitcheschanged : boolean;
       end;
@@ -181,6 +197,9 @@ interface
        { specified with -FE or -FU }
        outputexedir      : TPathStr;
        outputunitdir     : TPathStr;
+       { specified with -FW and -Fw }
+       wpofeedbackinput,
+       wpofeedbackoutput : TPathStr;
 
        { things specified with parameters }
        paratarget        : tsystem;
@@ -232,7 +251,7 @@ interface
        peflags : longint;
        minstacksize,
        maxstacksize,
-       imagebase : aword;
+       imagebase     : puint;
        UseDeffileForExports    : boolean;
        UseDeffileForExportsSetExplicitly : boolean;
        GenerateImportSection,
@@ -279,7 +298,6 @@ interface
 
     const
        DLLsource : boolean = false;
-       DLLImageBase : pshortstring = nil;
 
        { used to set all registers used for each global function
          this should dramatically decrease the number of
@@ -316,14 +334,6 @@ interface
 
     const
       default_settings : TSettings = (
-        globalswitches : [cs_check_unit_name,cs_link_static];
-        moduleswitches : [cs_extsyntax,cs_implicit_exceptions];
-        localswitches : [cs_check_io,cs_typed_const_writable];
-        modeswitches : fpcmodeswitches;
-        optimizerswitches : [];
-        debugswitches : [];
-        setalloc : 0;
-        packenum : 4;
         alignment : (
           procalign : 0;
           loopalign : 0;
@@ -338,6 +348,21 @@ interface
           recordalignmax : 0;
           maxCrecordalign : 0;
         );
+        globalswitches : [cs_check_unit_name,cs_link_static];
+        moduleswitches : [cs_extsyntax,cs_implicit_exceptions];
+        localswitches : [cs_check_io,cs_typed_const_writable];
+        modeswitches : fpcmodeswitches;
+        optimizerswitches : [];
+        genwpoptimizerswitches : [];
+        dowpoptimizerswitches : [];
+        debugswitches : [];
+
+        setalloc : 0;
+        packenum : 4;
+
+        packrecords     : 0;
+        maxfpuregisters : 0;
+
 {$ifdef i386}
         cputype : cpu_Pentium;
         optimizecputype : cpu_Pentium3;
@@ -378,13 +403,21 @@ interface
         optimizecputype : cpuinfo.cpu_avr;
         fputype : fpu_none;
 {$endif avr}
+{$ifdef mips}
+        cputype : cpu_mips32;
+        optimizecputype : cpu_mips32;
+        fputype : fpu_mips2;
+{$endif mips}
         asmmode : asmmode_standard;
         interfacetype : it_interfacecom;
         defproccall : pocall_default;
         sourcecodepage : '8859-1';
-        packrecords     : 0;
-        maxfpuregisters : 0;
         minfpconstprec : s32real;
+
+        disabledircache : false;
+{$if defined(ARM)}
+        controllertype : ct_none;
+{$endif defined(ARM)}
       );
 
     var
@@ -415,18 +448,24 @@ interface
     function Setabitype(const s:string;var a:tabi):boolean;
     function Setcputype(const s:string;var a:tcputype):boolean;
     function SetFpuType(const s:string;var a:tfputype):boolean;
+{$if defined(arm) or defined(avr)}
+    function SetControllerType(const s:string;var a:tcontrollertype):boolean;
+{$endif defined(arm) or defined(avr)}
     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 IncludeFeature(const s : string) : boolean;
     function SetMinFPConstPrec(const s: string; var a: tfloattype) : boolean;
 
     {# Routine to get the required alignment for size of data, which will
        be placed in bss segment, according to the current alignment requirements }
-    function var_align(siz: longint): shortint;
+    function var_align(want_align: longint): shortint;
+    function var_align_size(siz: longint): shortint;
     {# Routine to get the required alignment for size of data, which will
        be placed in data/const segment, according to the current alignment requirements }
-    function const_align(siz: longint): shortint;
+    function const_align(want_align: longint): shortint;
+    function const_align_size(siz: longint): shortint;
 {$ifdef ARM}
     function is_double_hilo_swapped: boolean;{$ifdef USEINLINE}inline;{$endif}
 {$endif ARM}
@@ -989,6 +1028,25 @@ implementation
       end;
 
 
+{$if defined(arm) or defined(avr)}
+    function SetControllerType(const s:string;var a:tcontrollertype):boolean;
+      var
+        t  : tcontrollertype;
+        hs : string;
+      begin
+        result:=false;
+        hs:=Upper(s);
+        for t:=low(tcontrollertype) to high(tcontrollertype) do
+          if controllertypestr[t]=hs then
+            begin
+              a:=t;
+              result:=true;
+              break;
+            end;
+      end;
+{$endif defined(arm) or defined(avr)}
+
+
     function UpdateAlignmentStr(s:string;var a:talignmentinfo):boolean;
       var
         tok  : string;
@@ -1013,19 +1071,35 @@ implementation
           else if tok='LOOP' then
            b.loopalign:=l
           else if tok='CONSTMIN' then
-           b.constalignmin:=l
+           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
-           b.varalignmin:=l
+           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
-           b.localalignmin:=l
+           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
-           b.recordalignmin:=l
+           begin
+             b.recordalignmin:=l;
+             if l>b.recordalignmax then
+               b.recordalignmax:=l;
+           end
           else if tok='RECORDMAX' then
            b.recordalignmax:=l
           else { Error }
@@ -1077,6 +1151,59 @@ implementation
       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;
@@ -1160,19 +1287,32 @@ implementation
       end;
 
 
-    function var_align(siz: longint): shortint;
+    function var_align(want_align: longint): shortint;
+      begin
+        var_align := used_align(want_align,current_settings.alignment.varalignmin,current_settings.alignment.varalignmax);
+      end;
+
+
+    function var_align_size(siz: longint): shortint;
       begin
         siz := size_2_align(siz);
-        var_align := used_align(siz,current_settings.alignment.varalignmin,current_settings.alignment.varalignmax);
+        var_align_size := var_align(siz);
       end;
 
 
-    function const_align(siz: longint): shortint;
+    function const_align(want_align: longint): shortint;
+      begin
+        const_align := used_align(want_align,current_settings.alignment.constalignmin,current_settings.alignment.constalignmax);
+      end;
+
+
+    function const_align_size(siz: longint): shortint;
       begin
         siz := size_2_align(siz);
-        const_align := used_align(siz,current_settings.alignment.constalignmin,current_settings.alignment.constalignmax);
+        const_align_size := const_align(siz);
       end;
 
+
 {$ifdef ARM}
     function is_double_hilo_swapped: boolean;{$ifdef USEINLINE}inline;{$endif}
       begin
@@ -1241,8 +1381,6 @@ implementation
 
    procedure DoneGlobals;
      begin
-       if assigned(DLLImageBase) then
-         StringDispose(DLLImageBase);
        librarysearchpath.Free;
        unitsearchpath.Free;
        objectsearchpath.Free;
@@ -1261,6 +1399,7 @@ implementation
         do_release:=false;
         do_make:=true;
         compile_level:=0;
+        codegenerror:=false;
         DLLsource:=false;
         paratarget:=system_none;
         paratargetasm:=as_none;

compiler/globtype.pas

@@ -110,6 +110,7 @@ interface
          cs_mmx,cs_mmx_saturation,
          { parser }
          cs_typed_addresses,cs_strict_var_strings,cs_ansistrings,cs_bitpacking,
+         cs_varpropsetter,cs_scopedenums,
          { macpas specific}
          cs_external_var, cs_externally_visible
        );
@@ -121,14 +122,16 @@ interface
          cs_fp_emulation,cs_extsyntax,cs_openstring,
          { support }
          cs_support_goto,cs_support_macro,
-         cs_support_c_operators,cs_static_keyword,
+         cs_support_c_operators,
          { generation }
          cs_profile,cs_debuginfo,cs_compilesystem,
          cs_lineinfo,cs_implicit_exceptions,
          { linking }
          cs_create_smart,cs_create_dynamic,cs_create_pic,
          { browser switches are back }
-         cs_browser,cs_local_browser
+         cs_browser,cs_local_browser,
+         { target specific }
+         cs_executable_stack
        );
        tmoduleswitches = set of tmoduleswitch;
 
@@ -137,6 +140,7 @@ interface
        tglobalswitch = (cs_globalnone,
          { parameter switches }
          cs_check_unit_name,cs_constructor_name,cs_support_exceptions,
+         cs_support_c_objectivepas,
          { units }
          cs_load_objpas_unit,
          cs_load_gpc_unit,
@@ -152,7 +156,8 @@ interface
          cs_link_nolink,cs_link_static,cs_link_smart,cs_link_shared,cs_link_deffile,
          cs_link_strip,cs_link_staticflag,cs_link_on_target,cs_link_extern,cs_link_opt_vtable,
          cs_link_opt_used_sections,cs_link_separate_dbg_file,
-         cs_link_map,cs_link_pthread,cs_link_no_default_lib_order
+         cs_link_map,cs_link_pthread,cs_link_no_default_lib_order,
+	 cs_link_native
        );
        tglobalswitches = set of tglobalswitch;
 
@@ -161,7 +166,18 @@ interface
           { enable set support in dwarf debug info, breaks gdb versions }
           { without support for that tag (they refuse to parse the rest }
           { of the debug information)                                   }
-          ds_dwarf_sets
+          ds_dwarf_sets,
+          { use absolute paths for include files in stabs. Pro: gdb     }
+          { always knows full path to file. Con: doesn't work anymore   }
+          { if the include file is moved (otherwise, things still work  }
+          { if your source hierarchy is the same, but has a different   }
+          { base path)                                                  }
+          ds_stabs_abs_include_files,
+          { prefix method names by "classname__" in DWARF (like is done }
+          { for Stabs); not enabled by default, because otherwise once  }
+          { support for calling methods has been added to gdb, you'd    }
+          { always have to type classinstance.classname__methodname()   }
+          ds_dwarf_method_class_prefix
        );
        tdebugswitches = set of tdebugswitch;
 
@@ -173,7 +189,7 @@ 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_processes,f_stackcheck,f_dynlibs,f_softfpu,f_objectivec1,f_resources
        );
        tfeatures = set of tfeature;
 
@@ -187,33 +203,49 @@ interface
        );
        toptimizerswitches = set of toptimizerswitch;
 
+       { whole program optimizer }
+       twpoptimizerswitch = (
+         cs_wpo_devirtualize_calls,cs_wpo_optimize_vmts,
+         cs_wpo_symbol_liveness
+       );
+       twpoptimizerswitches = set of twpoptimizerswitch;
+
+
     const
        OptimizerSwitchStr : array[toptimizerswitch] of string[10] = ('',
          'LEVEL1','LEVEL2','LEVEL3',
          'REGVAR','UNCERTAIN','SIZE','STACKFRAME',
          'PEEPHOLE','ASMCSE','LOOPUNROLL','TAILREC','CSE','DFA','STRENGTH'
        );
+       WPOptimizerSwitchStr : array [twpoptimizerswitch] of string[14] = (
+         'DEVIRTCALLS','OPTVMTS','SYMBOLLIVENESS'
+       );
 
-       DebugSwitchStr : array[tdebugswitch] of string[9] = ('',
-         'DWARFSETS');
+       DebugSwitchStr : array[tdebugswitch] of string[22] = ('',
+         'DWARFSETS','STABSABSINCLUDES','DWARFMETHODCLASSPREFIX');
 
        { switches being applied to all CPUs at the given level }
        genericlevel1optimizerswitches = [cs_opt_level1];
        genericlevel2optimizerswitches = [cs_opt_level2];
        genericlevel3optimizerswitches = [cs_opt_level3];
 
+       { whole program optimizations whose information generation requires
+         information from all loaded units
+       }
+       WPOptimizationsNeedingAllUnitInfo = [cs_wpo_devirtualize_calls];
+
        featurestr : array[tfeature] of string[12] = (
          'HEAP','INITFINAL','RTTI','CLASSES','EXCEPTIONS','EXITCODE',
          'ANSISTRINGS','WIDESTRINGS','TEXTIO','CONSOLEIO','FILEIO',
          'RANDOM','VARIANTS','OBJECTS','DYNARRAYS','THREADING','COMMANDARGS',
-         'PROCESSES','STACKCHECK','DYNLIBS'
+         'PROCESSES','STACKCHECK','DYNLIBS','SOFTFPU','OBJECTIVEC1','RESOURCES'
        );
 
     type
        { Switches which can be changed by a mode (fpc,tp7,delphi) }
        tmodeswitch = (m_none,m_all, { needed for keyword }
          { generic }
-         m_fpc,m_objfpc,m_delphi,m_tp7,m_mac,
+         m_fpc,m_objfpc,m_delphi,m_tp7,m_mac,m_iso,
          {$ifdef fpc_mode}m_gpc,{$endif}
          { more specific }
          m_class,               { delphi class model }
@@ -237,7 +269,10 @@ interface
          m_duplicate_names,     { allow locals/paras to have duplicate names of globals }
          m_property,            { allow properties }
          m_default_inline,      { allow inline proc directive }
-         m_except               { allow exception-related keywords }
+         m_except,              { allow exception-related keywords }
+         m_objectivec1,         { support interfacing with Objective-C (1.0) }
+         m_objectivec2,         { support interfacing with Objective-C (2.0) }
+         m_nested_procvars      { support nested procedural variables }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -330,7 +365,7 @@ interface
 {$endif}
 
        modeswitchstr : array[tmodeswitch] of string[18] = ('','',
-         '','','','','',
+         '','','','','','',
          {$ifdef fpc_mode}'',{$endif}
          { more specific }
          'CLASS',
@@ -353,7 +388,10 @@ interface
          'DUPLICATELOCALS',
          'PROPERTIES',
          'ALLOWINLINE',
-         'EXCEPTIONS');
+         'EXCEPTIONS',
+         'OBJECTIVEC1',
+         'OBJECTIVEC2',
+         'NESTEDPROCVARS');
 
 
      type
@@ -379,8 +417,8 @@ interface
          pi_uses_static_symtable,
          { set if the procedure has to push parameters onto the stack }
          pi_has_stackparameter,
-         { set if the procedure has at least one got }
-         pi_has_goto,
+         { set if the procedure has at least one label }
+         pi_has_label,
          { calls itself recursive }
          pi_is_recursive,
          { stack frame optimization not possible (only on x86 probably) }
@@ -388,14 +426,17 @@ interface
          { set if the procedure has at least one register saved on the stack }
          pi_has_saved_regs,
          { dfa was generated for this proc }
-         pi_dfaavailable
+         pi_dfaavailable,
+         { subroutine contains interprocedural used labels }
+         pi_has_interproclabel
        );
        tprocinfoflags=set of tprocinfoflag;
 
     type
-      { float types }
+      { float types -- warning, this enum/order is used internally by the RTL
+        as well in rtl/inc/real2str.inc }
       tfloattype = (
-        s32real,s64real,s80real,
+        s32real,s64real,s80real,sc80real { the C "long double" type on x86 },
         s64comp,s64currency,s128real
       );
 
@@ -444,6 +485,14 @@ interface
        link_smart   = $4;
        link_shared  = $8;
 
+    type
+      { a message state }
+      tmsgstate = (
+        ms_on,    // turn on output
+        ms_off,   // turn off output
+        ms_error  // cast to error
+      );
+
 implementation
 
 end.

compiler/htypechk.pas

@@ -67,11 +67,11 @@ interface
         FParaLength : smallint;
         FAllowVariant : boolean;
         procedure collect_overloads_in_class(ProcdefOverloadList:TFPObjectList);
-        procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList);
-        procedure create_candidate_list(ignorevisibility:boolean);
-        function  proc_add(ps:tprocsym;pd:tprocdef):pcandidate;
+        procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall: boolean);
+        procedure create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall:boolean);
+        function  proc_add(ps:tprocsym;pd:tprocdef;objcidcall: boolean):pcandidate;
       public
-        constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility:boolean);
+        constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall:boolean);
         constructor create_operator(op:ttoken;ppn:tnode);
         destructor destroy;override;
         procedure list(all:boolean);
@@ -108,9 +108,9 @@ interface
         (tok:_LTE     ;nod:lten;op_overloading_supported:true),      { binary overloading supported }
         (tok:_SYMDIF  ;nod:symdifn;op_overloading_supported:true),   { binary overloading supported }
         (tok:_STARSTAR;nod:starstarn;op_overloading_supported:true), { binary overloading supported }
-        (tok:_OP_AS     ;nod:asn;op_overloading_supported:false),     { binary overloading NOT supported }
-        (tok:_OP_IN     ;nod:inn;op_overloading_supported:false),     { binary overloading NOT supported }
-        (tok:_OP_IS     ;nod:isn;op_overloading_supported:false),     { binary overloading NOT supported }
+        (tok:_OP_AS     ;nod:asn;op_overloading_supported:false),    { binary overloading NOT supported }
+        (tok:_OP_IN     ;nod:inn;op_overloading_supported:false),    { binary overloading NOT supported }
+        (tok:_OP_IS     ;nod:isn;op_overloading_supported:false),    { binary overloading NOT supported }
         (tok:_OP_OR     ;nod:orn;op_overloading_supported:true),     { binary overloading supported }
         (tok:_OP_AND    ;nod:andn;op_overloading_supported:true),    { binary overloading supported }
         (tok:_OP_DIV    ;nod:divn;op_overloading_supported:true),    { binary overloading supported }
@@ -120,9 +120,10 @@ interface
         (tok:_OP_SHR    ;nod:shrn;op_overloading_supported:true),    { binary overloading supported }
         (tok:_OP_XOR    ;nod:xorn;op_overloading_supported:true),    { binary overloading supported }
         (tok:_ASSIGNMENT;nod:assignn;op_overloading_supported:true), { unary overloading supported }
-        (tok:_UNEQUAL ;nod:unequaln;op_overloading_supported:false)   { binary overloading NOT supported  overload = instead }
+        (tok:_UNEQUAL ;nod:unequaln;op_overloading_supported:false)  { binary overloading NOT supported  overload = instead }
       );
-    const
+
+      { true, if we are parsing stuff which allows array constructors }
       allow_array_constructor : boolean = false;
 
     function node2opstr(nt:tnodetype):string;
@@ -137,7 +138,7 @@ interface
     procedure make_not_regable(p : tnode; how: tregableinfoflags);
 
     { procvar handling }
-    function  is_procvar_load(p:tnode):boolean;
+    function  is_proc2procvar_load(p:tnode;out realprocdef:tprocdef):boolean;
     procedure test_local_to_procvar(from_def:tprocvardef;to_def:tdef);
 
     { sets varsym varstate field correctly }
@@ -159,7 +160,7 @@ interface
 
     function allowenumop(nt:tnodetype):boolean;
 
-    procedure check_hints(const srsym: tsym; const symoptions: tsymoptions);
+    procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring);
 
     procedure check_ranges(const location: tfileposinfo; source: tnode; destdef: tdef);
 
@@ -218,7 +219,7 @@ implementation
             pointerdef :
               begin
                 if ((rd.typ in [orddef,enumdef,pointerdef,classrefdef,procvardef]) or
-                    is_class_or_interface(rd)) then
+                    is_class_or_interface_or_dispinterface_or_objc(rd)) then
                  begin
                    allowed:=false;
                    exit;
@@ -280,7 +281,7 @@ implementation
               begin
                 { <> and = are defined for classes }
                 if (treetyp in [equaln,unequaln]) and
-                   is_class_or_interface(ld) then
+                   is_class_or_interface_or_dispinterface_or_objc(ld) then
                  begin
                    allowed:=false;
                    exit;
@@ -409,7 +410,23 @@ implementation
                 if optoken=_ASSIGNMENT then
                   begin
                     eq:=compare_defs_ext(ld,pf.returndef,nothingn,conv,pd,[cdo_explicit]);
-                    result:=(eq=te_incompatible);
+                    result:=
+                      (eq=te_incompatible) and
+                      { don't allow overloading assigning to custom shortstring
+                        types, because we also don't want to differentiate based
+                        on different shortstring types (e.g.,
+                        "operator :=(const v: variant) res: shorstring" also
+                        has to work for assigning a variant to a string[80])
+                      }
+                      (not is_shortstring(pf.returndef) or
+                       (tstringdef(pf.returndef).len=255));
+                  end
+                else
+                { enumerator is a special case too }
+                if optoken=_OP_ENUMERATOR then
+                  begin
+                    result:=
+                      is_class_or_interface_or_object(pf.returndef);
                   end
                 else
                   begin
@@ -480,7 +497,7 @@ implementation
         { stop when there are no operators found }
         if candidates.count=0 then
           begin
-            CGMessage(parser_e_operator_not_overloaded);
+            CGMessage2(parser_e_operator_not_overloaded_2,ld.gettypename,arraytokeninfo[optoken].str);
             candidates.free;
             ppn.free;
             t:=cnothingnode.create;
@@ -493,12 +510,12 @@ implementation
         { Display info when multiple candidates are found }
         candidates.dump_info(V_Debug);
 {$endif EXTDEBUG}
-        cand_cnt:=candidates.choose_best(operpd,false);
+        cand_cnt:=candidates.choose_best(tabstractprocdef(operpd),false);
 
         { exit when no overloads are found }
         if cand_cnt=0 then
           begin
-            CGMessage(parser_e_operator_not_overloaded);
+            CGMessage2(parser_e_operator_not_overloaded_2,ld.gettypename,arraytokeninfo[optoken].str);
             candidates.free;
             ppn.free;
             t:=cnothingnode.create;
@@ -639,12 +656,12 @@ implementation
         { Display info when multiple candidates are found }
         candidates.dump_info(V_Debug);
 {$endif EXTDEBUG}
-        cand_cnt:=candidates.choose_best(operpd,false);
+        cand_cnt:=candidates.choose_best(tabstractprocdef(operpd),false);
 
         { exit when no overloads are found }
         if cand_cnt=0 then
           begin
-            CGMessage(parser_e_operator_not_overloaded);
+            CGMessage3(parser_e_operator_not_overloaded_3,ld.gettypename,arraytokeninfo[optoken].str,rd.gettypename);
             candidates.free;
             ppn.free;
             t:=cnothingnode.create;
@@ -757,7 +774,7 @@ implementation
                           Subroutine Handling
 ****************************************************************************}
 
-    function is_procvar_load(p:tnode):boolean;
+    function is_proc2procvar_load(p:tnode;out realprocdef:tprocdef):boolean;
       begin
         result:=false;
         { remove voidpointer typecast for tp procvars }
@@ -768,13 +785,16 @@ implementation
           p:=tunarynode(p).left;
         result:=(p.nodetype=typeconvn) and
                 (ttypeconvnode(p).convtype=tc_proc_2_procvar);
+        if result then
+          realprocdef:=tprocdef(ttypeconvnode(p).left.resultdef);
       end;
 
 
     { local routines can't be assigned to procvars }
     procedure test_local_to_procvar(from_def:tprocvardef;to_def:tdef);
       begin
-         if (from_def.parast.symtablelevel>normal_function_level) and
+         if not(m_nested_procvars in current_settings.modeswitches) and
+            (from_def.parast.symtablelevel>normal_function_level) and
             (to_def.typ=procvardef) then
            CGMessage(type_e_cannot_local_proc_to_procvar);
       end;
@@ -833,7 +853,7 @@ implementation
                end;
              subscriptn :
                begin
-                 if is_class_or_interface(tunarynode(p).left.resultdef) then
+                 if is_class_or_interface_or_dispinterface_or_objc(tunarynode(p).left.resultdef) then
                    newstate := vs_read;
                  p:=tunarynode(p).left;
                end;
@@ -946,7 +966,8 @@ implementation
         gotvec,
         gotclass,
         gotdynarray,
-        gotderef : boolean;
+        gotderef,
+        gottypeconv : boolean;
         fromdef,
         todef    : tdef;
         errmsg,
@@ -967,6 +988,7 @@ implementation
         gotpointer:=false;
         gotdynarray:=false;
         gotstring:=false;
+        gottypeconv:=false;
         hp:=p;
         if not(valid_void in opts) and
            is_void(hp.resultdef) then
@@ -985,7 +1007,7 @@ implementation
                  pointerdef :
                    gotpointer:=true;
                  objectdef :
-                   gotclass:=is_class_or_interface(hp.resultdef);
+                   gotclass:=is_class_or_interface_or_dispinterface_or_objc(hp.resultdef);
                  recorddef :
                    gotrecord:=true;
                  classrefdef :
@@ -1004,6 +1026,17 @@ implementation
                       { same when we got a class and subscript (= deref) }
                       (gotclass and gotsubscript) or
                       (
+                       { allowing assignments to typecasted properties
+                           a) is Delphi-incompatible
+                           b) causes problems in case the getter is a function
+                              (because then the result of the getter is
+                               typecasted to this type, and then we "assign" to
+                               this typecasted function result) -> always
+                               disallow, since property accessors should be
+                               transparantly changeable to functions at all
+                               times
+                       }
+                       not(gottypeconv) and
                        not(gotsubscript and gotrecord) and
                        not(gotstring and gotvec)
                       ) then
@@ -1050,6 +1083,7 @@ implementation
                end;
              typeconvn :
                begin
+                 gottypeconv:=true;
                  { typecast sizes must match, exceptions:
                    - implicit typecast made by absolute
                    - from formaldef
@@ -1090,7 +1124,7 @@ implementation
                    pointerdef :
                      gotpointer:=true;
                    objectdef :
-                     gotclass:=is_class_or_interface(hp.resultdef);
+                     gotclass:=is_class_or_interface_or_dispinterface_or_objc(hp.resultdef);
                    classrefdef :
                      gotclass:=true;
                    arraydef :
@@ -1187,7 +1221,7 @@ implementation
                  { a class/interface access is an implicit }
                  { dereferencing                           }
                  hp:=tsubscriptnode(hp).left;
-                 if is_class_or_interface(hp.resultdef) then
+                 if is_class_or_interface_or_dispinterface_or_objc(hp.resultdef) then
                    gotderef:=true;
                end;
              muln,
@@ -1276,7 +1310,7 @@ implementation
                    pointerdef :
                      gotpointer:=true;
                    objectdef :
-                     gotclass:=is_class_or_interface(hp.resultdef);
+                     gotclass:=is_class_or_interface_or_dispinterface_or_objc(hp.resultdef);
                    recorddef, { handle record like class it needs a subscription }
                    classrefdef :
                      gotclass:=true;
@@ -1308,11 +1342,8 @@ implementation
              inlinen :
                begin
                  if ((valid_const in opts) and
-                    (tinlinenode(hp).inlinenumber in [in_typeof_x]))
-{$ifdef SUPPORT_UNALIGNED}
-                    or (tinlinenode(hp).inlinenumber in [in_unaligned_x])
-{$endif SUPPORT_UNALIGNED}
-                    then
+                     (tinlinenode(hp).inlinenumber in [in_typeof_x])) or
+                    (tinlinenode(hp).inlinenumber in [in_unaligned_x]) then
                    result:=true
                  else
                    if report_errors then
@@ -1495,11 +1526,8 @@ implementation
               { if they are objects              }
               if (def_from.typ=objectdef) and
                  (
-                  not(m_delphi in current_settings.modeswitches) or
-                  (
-                   (tobjectdef(def_from).objecttype=odt_object) and
-                   (tobjectdef(def_to).objecttype=odt_object)
-                  )
+                  (tobjectdef(def_from).objecttype=odt_object) and
+                  (tobjectdef(def_to).objecttype=odt_object)
                  ) and
                  (tobjectdef(def_from).is_related(tobjectdef(def_to))) then
                 eq:=te_convert_l1;
@@ -1518,6 +1546,10 @@ implementation
 
 
     procedure para_allowed(var eq:tequaltype;p:tcallparanode;def_to:tdef);
+      var
+        acn: tarrayconstructornode;
+        realprocdef: tprocdef;
+        tmpeq: tequaltype;
       begin
         { Note: eq must be already valid, it will only be updated! }
         case def_to.typ of
@@ -1558,16 +1590,46 @@ implementation
             end;
           procvardef :
             begin
-              { in tp7 mode proc -> procvar is allowed }
+              tmpeq:=te_incompatible;
+              { in tp/macpas mode proc -> procvar is allowed }
               if ((m_tp_procvar in current_settings.modeswitches) or
                   (m_mac_procvar in current_settings.modeswitches)) and
-                 (p.left.nodetype=calln) and
-                 (proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def_to))>=te_equal) then
-                eq:=te_equal
-              else
-                if (m_mac_procvar in current_settings.modeswitches) and
-                   is_procvar_load(p.left) then
-                  eq:=te_convert_l2;
+                 (p.left.nodetype=calln) then
+                tmpeq:=proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def_to),false);
+              if (tmpeq=te_incompatible) and
+                 (m_nested_procvars in current_settings.modeswitches) and
+                 is_proc2procvar_load(p.left,realprocdef) then
+                tmpeq:=proc_to_procvar_equal(realprocdef,tprocvardef(def_to),false);
+              if tmpeq<>te_incompatible then
+                eq:=tmpeq;
+            end;
+          arraydef :
+            begin
+              { an arrayconstructor of proccalls may have to be converted to
+                an array of procvars }
+              if ((m_tp_procvar in current_settings.modeswitches) or
+                  (m_mac_procvar in current_settings.modeswitches)) and
+                 (tarraydef(def_to).elementdef.typ=procvardef) and
+                 is_array_constructor(p.resultdef) and
+                 not is_variant_array(p.resultdef) then
+                begin
+                  acn:=tarrayconstructornode(p.left);
+                  if assigned(acn.left) then
+                    begin
+                      eq:=te_exact;
+                      while assigned(acn) and
+                            (eq<>te_incompatible) do
+                        begin
+                          if (acn.left.nodetype=calln) then
+                            tmpeq:=proc_to_procvar_equal(tprocdef(tcallnode(acn.left).procdefinition),tprocvardef(tarraydef(def_to).elementdef),false)
+                          else
+                            tmpeq:=compare_defs(acn.left.resultdef,tarraydef(def_to).elementdef,acn.left.nodetype);
+                          if tmpeq<eq then
+                            eq:=tmpeq;
+                          acn:=tarrayconstructornode(acn.right);
+                        end;
+                    end
+                end;
             end;
         end;
       end;
@@ -1585,7 +1647,7 @@ implementation
                            TCallCandidates
 ****************************************************************************}
 
-    constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility:boolean);
+    constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall:boolean);
       begin
         if not assigned(sym) then
           internalerror(200411015);
@@ -1593,7 +1655,7 @@ implementation
         FProcsym:=sym;
         FProcsymtable:=st;
         FParanode:=ppn;
-        create_candidate_list(ignorevisibility);
+        create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall);
       end;
 
 
@@ -1603,7 +1665,7 @@ implementation
         FProcsym:=nil;
         FProcsymtable:=nil;
         FParanode:=ppn;
-        create_candidate_list(false);
+        create_candidate_list(false,false,false);
       end;
 
 
@@ -1660,7 +1722,7 @@ implementation
       end;
 
 
-    procedure tcallcandidates.collect_overloads_in_units(ProcdefOverloadList:TFPObjectList);
+    procedure tcallcandidates.collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall: boolean);
       var
         j          : integer;
         pd         : tprocdef;
@@ -1673,10 +1735,15 @@ implementation
         { we search all overloaded operator definitions in the symtablestack. The found
           entries are only added to the procs list and not the procsym, because
           the list can change in every situation }
-        if FOperator<>NOTOKEN then
-          hashedid.id:=overloaded_names[FOperator]
+        if FOperator=NOTOKEN then
+          begin
+            if not objcidcall then
+              hashedid.id:=FProcsym.name
+            else
+              hashedid.id:=class_helper_prefix+FProcsym.name;
+          end
         else
-          hashedid.id:=FProcsym.name;
+          hashedid.id:=overloaded_names[FOperator];
 
         checkstack:=symtablestack.stack;
         if assigned(FProcsymtable) then
@@ -1706,8 +1773,10 @@ implementation
                           hasoverload:=true;
                         ProcdefOverloadList.Add(tprocsym(srsym).ProcdefList[j]);
                       end;
-                    { when there is no explicit overload we stop searching }
-                    if not hasoverload then
+                    { when there is no explicit overload we stop searching,
+                      except for Objective-C methods called via id }
+                    if not hasoverload and
+                       not objcidcall then
                       break;
                   end;
               end;
@@ -1716,7 +1785,7 @@ implementation
       end;
 
 
-    procedure tcallcandidates.create_candidate_list(ignorevisibility:boolean);
+    procedure tcallcandidates.create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall:boolean);
       var
         j     : integer;
         pd    : tprocdef;
@@ -1730,11 +1799,12 @@ implementation
 
         { Find all available overloads for this procsym }
         ProcdefOverloadList:=TFPObjectList.Create(false);
-        if (FOperator=NOTOKEN) and
+        if not objcidcall and
+           (FOperator=NOTOKEN) and
            (FProcsym.owner.symtabletype=objectsymtable) then
           collect_overloads_in_class(ProcdefOverloadList)
         else
-          collect_overloads_in_units(ProcdefOverloadList);
+          collect_overloads_in_units(ProcdefOverloadList,objcidcall);
 
         { determine length of parameter list.
           for operators also enable the variant-operators if
@@ -1775,8 +1845,17 @@ implementation
               it is visible }
             if (FParalength>=pd.minparacount) and
                (
-                (FParalength<=pd.maxparacount) or
-                (po_varargs in pd.procoptions)
+                (
+                 allowdefaultparas and
+                 (
+                  (FParalength<=pd.maxparacount) or
+                  (po_varargs in pd.procoptions)
+                 )
+                ) or
+                (
+                 not allowdefaultparas and
+                 (FParalength=pd.maxparacount)
+                )
                ) and
                (
                 ignorevisibility or
@@ -1789,7 +1868,9 @@ implementation
                 hp:=FCandidateProcs;
                 while assigned(hp) do
                   begin
-                    if compare_paras(hp^.data.paras,pd.paras,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then
+                    if (compare_paras(hp^.data.paras,pd.paras,cp_value_equal_const,[cpo_ignorehidden])>=te_equal) and
+                       (not(po_objc in pd.procoptions) or
+                        (pd.messageinf.str^=hp^.data.messageinf.str^)) then
                       begin
                         found:=true;
                         break;
@@ -1797,7 +1878,7 @@ implementation
                     hp:=hp^.next;
                   end;
                 if not found then
-                  proc_add(fprocsym,pd);
+                  proc_add(fprocsym,pd,objcidcall);
               end;
           end;
 
@@ -1805,9 +1886,10 @@ implementation
       end;
 
 
-    function tcallcandidates.proc_add(ps:tprocsym;pd:tprocdef):pcandidate;
+    function tcallcandidates.proc_add(ps:tprocsym;pd:tprocdef;objcidcall: boolean):pcandidate;
       var
         defaultparacnt : integer;
+        parentst        : tsymtable;
       begin
         { generate new candidate entry }
         new(result);
@@ -1834,7 +1916,15 @@ implementation
          end;
         { Give a small penalty for overloaded methods not in
           defined the current class/unit }
-        if ps.owner<>pd.owner then
+        parentst:=ps.owner;
+        {  when calling Objective-C methods via id.method, then the found
+           procsym will be inside an arbitrary ObjectSymtable, and we don't
+           want togive the methods of that particular objcclass precedence over
+           other methods, so instead check against the symtable in which this
+           objcclass is defined }
+        if objcidcall then
+          parentst:=parentst.defowner.owner;
+        if (parentst<>pd.owner) then
           result^.ordinal_distance:=result^.ordinal_distance+1.0;
       end;
 
@@ -2034,9 +2124,11 @@ implementation
                    { Give wrong sign a small penalty, this is need to get a diffrence
                      from word->[longword,longint] }
                    if is_signed(def_from)<>is_signed(def_to) then
-                   {$ifopt r+}{$define ena_rq}{$q-}{$r-}{$endif}
+{$push}
+{$r-}
+{$q-}
                      hp^.ordinal_distance:=nextafter(hp^.ordinal_distance,inf);
-                   {$ifdef ena_rq}{$r+}{$q+}{$endif}
+{$pop}
                  end
               else
               { for value and const parameters check precision of real, give
@@ -2120,7 +2212,16 @@ implementation
                   end;
                end;
 
-              { when a procvar was changed to a call an exact much is
+              { univ parameters match if the size matches (don't override the
+                comparison result if it was ok, since a match based on the
+                "univ" character is the lowest possible match) }
+                if (eq=te_incompatible) and
+                   currpara.univpara and
+                   is_valid_univ_para_type(def_from) and
+                   (def_from.size=def_to.size) then
+                  eq:=te_convert_l5;
+
+               { when a procvar was changed to a call an exact match is
                 downgraded to equal. This way an overload call with the
                 procvar is choosen. See tb0471 (PFV) }
               if (pt<>currpt) and (eq=te_exact) then
@@ -2202,7 +2303,7 @@ implementation
            tve_chari64,tve_chari64,tve_dblcurrency);
 { TODO: fixme for 128 bit floats }
         variantfloatdef_cl: array[tfloattype] of tvariantequaltype =
-          (tve_single,tve_dblcurrency,tve_extended,
+          (tve_single,tve_dblcurrency,tve_extended,tve_extended,
            tve_dblcurrency,tve_dblcurrency,tve_extended);
         variantstringdef_cl: array[tstringtype] of tvariantequaltype =
           (tve_sstring,tve_astring,tve_astring,tve_wstring,tve_ustring);
@@ -2578,16 +2679,21 @@ implementation
       end;
 
 
-    procedure check_hints(const srsym: tsym; const symoptions: tsymoptions);
+    procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring);
       begin
         if not assigned(srsym) then
           internalerror(200602051);
         if sp_hint_deprecated in symoptions then
-          Message1(sym_w_deprecated_symbol,srsym.realname);
+          if (sp_has_deprecated_msg in symoptions) and (deprecatedmsg <> nil) then
+            Message2(sym_w_deprecated_symbol_with_msg,srsym.realname,deprecatedmsg^)
+          else
+            Message1(sym_w_deprecated_symbol,srsym.realname);
         if sp_hint_experimental in symoptions then
           Message1(sym_w_experimental_symbol,srsym.realname);
         if sp_hint_platform in symoptions then
           Message1(sym_w_non_portable_symbol,srsym.realname);
+        if sp_hint_library in symoptions then
+          Message1(sym_w_library_symbol,srsym.realname);
         if sp_hint_unimplemented in symoptions then
           Message1(sym_w_non_implemented_symbol,srsym.realname);
       end;
@@ -2608,7 +2714,15 @@ implementation
           not is_boolean(source.resultdef) and
           not is_constrealnode(source) then
          begin
-           if (destdef.size < source.resultdef.size) then
+           if ((destdef.size < source.resultdef.size) and
+               { s80real and sc80real have a different size but the same precision }
+               not((destdef.typ=floatdef) and
+                   (source.resultdef.typ=floatdef) and
+                   (tfloatdef(source.resultdef).floattype in [s80real,sc80real]) and
+                   (tfloatdef(destdef).floattype in [s80real,sc80real]))) or
+              ((destdef.typ<>floatdef) and
+               (source.resultdef.typ<>floatdef) and
+               not is_in_limit(source.resultdef,destdef)) then
              begin
                if (cs_check_range in current_settings.localswitches) then
                  MessagePos(location,type_w_smaller_possible_range_check)

compiler/i386/ag386nsm.pas

@@ -438,15 +438,15 @@ interface
 
 
     const
-      ait_const2str : array[aitconst_128bit..aitconst_indirect_symbol] of string[20]=(
+      ait_const2str : array[aitconst_128bit..aitconst_secrel32_symbol] of string[20]=(
         #9'FIXME_128BIT'#9,#9'FIXME_64BIT'#9,#9'DD'#9,#9'DW'#9,#9'DB'#9,
         #9'FIXME_SLEB128BIT'#9,#9'FIXME_ULEB128BIT'#9,
-        #9'RVA'#9,#9'SECREL32'#9,#9'FIXMEINDIRECT'#9
+        #9'RVA'#9,#9'SECREL32'#9
       );
 
     procedure T386NasmAssembler.WriteSection(atype:TAsmSectiontype;const aname:string);
       const
-        secnames : array[TAsmSectiontype] of string[17] = ('',
+        secnames : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('',
           '.text',
           '.data',
           '.data',
@@ -454,7 +454,7 @@ interface
           '.bss',
           '.tbss',
           '.pdata',
-          '.text',
+          '.text','.data','.data','.data','.data',
           '.stab',
           '.stabstr',
           '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
@@ -463,7 +463,41 @@ interface
           '.fpc',
           '',
           '.init',
-          '.fini'
+          '.fini',
+          '.objc_class',
+          '.objc_meta_class',
+          '.objc_cat_cls_meth',
+          '.objc_cat_inst_meth',
+          '.objc_protocol',
+          '.objc_string_object',
+          '.objc_cls_meth',
+          '.objc_inst_meth',
+          '.objc_cls_refs',
+          '.objc_message_refs',
+          '.objc_symbols',
+          '.objc_category',
+          '.objc_class_vars',
+          '.objc_instance_vars',
+          '.objc_module_info',
+          '.objc_class_names',
+          '.objc_meth_var_types',
+          '.objc_meth_var_names',
+          '.objc_selector_strs',
+          '.objc_protocol_ext',
+          '.objc_class_ext',
+          '.objc_property',
+          '.objc_image_info',
+          '.objc_cstring_object',
+          '.objc_sel_fixup',
+          '__DATA,__objc_data',
+          '__DATA,__objc_const',
+          '.objc_superrefs',
+          '__DATA, __datacoal_nt,coalesced',
+          '.objc_classlist',
+          '.objc_nlclasslist',
+          '.objc_catlist',
+          '.obcj_nlcatlist',
+          '.objc_protolist'
         );
       begin
         AsmLn;
@@ -644,8 +678,7 @@ interface
                  aitconst_16bit,
                  aitconst_8bit,
                  aitconst_rva_symbol,
-                 aitconst_secrel32_symbol,
-                 aitconst_indirect_symbol :
+                 aitconst_secrel32_symbol :
                    begin
                      AsmWrite(ait_const2str[tai_const(hp).consttype]);
                      l:=0;
@@ -699,6 +732,8 @@ interface
                    AsmWrite(',');
                   AsmWrite(tostr(t80bitarray(e)[i]));
                 end;
+                for i:=11 to tai_real_80bit(hp).savesize do
+                  AsmWrite(',0');
                AsmLn;
              end;
 {$else cpuextended}
@@ -870,6 +905,8 @@ interface
 
            ait_symbol :
              begin
+               if tai_symbol(hp).has_value then
+                 internalerror(2009090803);
                if tai_symbol(hp).is_global then
                 begin
                   AsmWrite(#9'GLOBAL ');
@@ -975,9 +1012,9 @@ interface
              end;
 
            ait_marker :
-             if tai_marker(hp).kind=mark_InlineStart then
+             if tai_marker(hp).kind=mark_NoLineInfoStart then
                inc(InlineLevel)
-             else if tai_marker(hp).kind=mark_InlineEnd then
+             else if tai_marker(hp).kind=mark_NoLineInfoEnd then
                dec(InlineLevel);
 
            ait_directive :
@@ -1080,7 +1117,7 @@ interface
             idtxt  : 'NASMCOFF';
             asmbin : 'nasm';
             asmcmd : '-f coff -o $OBJ $ASM';
-            supported_target : system_i386_go32v2;
+            supported_targets : [system_i386_go32v2];
             flags : [af_allowdirect,af_needar,af_no_debug];
             labelprefix : '..@';
             comment : '; ';
@@ -1092,7 +1129,7 @@ interface
             idtxt  : 'NASMWIN32';
             asmbin : 'nasm';
             asmcmd : '-f win32 -o $OBJ $ASM';
-            supported_target : system_i386_win32;
+            supported_targets : [system_i386_win32];
             flags : [af_allowdirect,af_needar,af_no_debug];
             labelprefix : '..@';
             comment : '; ';
@@ -1104,7 +1141,7 @@ interface
             idtxt  : 'NASMOBJ';
             asmbin : 'nasm';
             asmcmd : '-f obj -o $OBJ $ASM';
-            supported_target : system_any; { what should I write here ?? }
+            supported_targets : [system_i386_embedded];
             flags : [af_allowdirect,af_needar,af_no_debug];
             labelprefix : '..@';
             comment : '; ';
@@ -1116,7 +1153,7 @@ interface
             idtxt  : 'NASMWDOSX';
             asmbin : 'nasm';
             asmcmd : '-f win32 -o $OBJ $ASM';
-            supported_target : system_i386_wdosx;
+            supported_targets : [system_i386_wdosx];
             flags : [af_allowdirect,af_needar,af_no_debug];
             labelprefix : '..@';
             comment : '; ';
@@ -1129,7 +1166,7 @@ interface
             idtxt  : 'NASMELF';
             asmbin : 'nasm';
             asmcmd : '-f elf -o $OBJ $ASM';
-            supported_target : system_i386_linux;
+            supported_targets : [system_i386_linux];
             flags : [af_allowdirect,af_needar,af_no_debug];
             labelprefix : '..@';
             comment : '; ';
@@ -1141,7 +1178,7 @@ interface
             idtxt  : 'NASMELF';
             asmbin : 'nasm';
             asmcmd : '-f elf -o $OBJ $ASM';
-            supported_target : system_i386_beos;
+            supported_targets : [system_i386_beos];
             flags : [af_allowdirect,af_needar,af_no_debug];
             labelprefix : '..@';
             comment : '; ';
@@ -1153,7 +1190,7 @@ interface
             idtxt  : 'NASMELF';
             asmbin : 'nasm';
             asmcmd : '-f elf -o $OBJ $ASM';
-            supported_target : system_i386_haiku;
+            supported_targets : [system_i386_haiku];
             flags : [af_allowdirect,af_needar,af_no_debug];
             labelprefix : '..@';
             comment : '; ';

compiler/i386/cgcpu.pas

@@ -39,10 +39,10 @@ unit cgcpu;
         procedure do_register_allocation(list:TAsmList;headertai:tai);override;
 
         { passing parameter using push instead of mov }
-        procedure a_param_reg(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);override;
-        procedure a_param_const(list : TAsmList;size : tcgsize;a : aint;const cgpara : tcgpara);override;
-        procedure a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);override;
-        procedure a_paramaddr_ref(list : TAsmList;const r : treference;const cgpara : tcgpara);override;
+        procedure a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);override;
+        procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : aint;const cgpara : tcgpara);override;
+        procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);override;
+        procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);override;
 
         procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override;
         procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:aint;destreg:tregister);override;
@@ -63,13 +63,15 @@ unit cgcpu;
       private
         procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
       end;
+      
+    procedure create_codegen;
 
   implementation
 
     uses
        globals,verbose,systems,cutils,
        paramgr,procinfo,fmodule,
-       rgcpu,rgx86;
+       rgcpu,rgx86,cpuinfo;
 
     function use_push(const cgpara:tcgpara):boolean;
       begin
@@ -99,14 +101,12 @@ unit cgcpu;
           begin
             if getsupreg(current_procinfo.got) < first_int_imreg then
               include(rg[R_INTREGISTER].used_in_proc,getsupreg(current_procinfo.got));
-            { ebx is currently always used (do to getiepasebx call) }
-            include(rg[R_INTREGISTER].used_in_proc,RS_EBX);
           end;
         inherited do_register_allocation(list,headertai);
       end;
 
 
-    procedure tcg386.a_param_reg(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);
+    procedure tcg386.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);
       var
         pushsize : tcgsize;
       begin
@@ -121,11 +121,11 @@ unit cgcpu;
             list.concat(taicpu.op_reg(A_PUSH,tcgsize2opsize[pushsize],makeregsize(list,r,pushsize)));
           end
         else
-          inherited a_param_reg(list,size,r,cgpara);
+          inherited a_load_reg_cgpara(list,size,r,cgpara);
       end;
 
 
-    procedure tcg386.a_param_const(list : TAsmList;size : tcgsize;a : aint;const cgpara : tcgpara);
+    procedure tcg386.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : aint;const cgpara : tcgpara);
       var
         pushsize : tcgsize;
       begin
@@ -139,11 +139,11 @@ unit cgcpu;
             list.concat(taicpu.op_const(A_PUSH,tcgsize2opsize[pushsize],a));
           end
         else
-          inherited a_param_const(list,size,a,cgpara);
+          inherited a_load_const_cgpara(list,size,a,cgpara);
       end;
 
 
-    procedure tcg386.a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);
+    procedure tcg386.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);
 
         procedure pushdata(paraloc:pcgparalocation;ofs:aint);
         var
@@ -177,7 +177,10 @@ unit cgcpu;
               list.concat(taicpu.op_reg(A_PUSH,TCgsize2opsize[pushsize],tmpreg));
             end
           else
-            list.concat(taicpu.op_ref(A_PUSH,TCgsize2opsize[pushsize],href));
+            begin
+              make_simple_ref(list,href);
+              list.concat(taicpu.op_ref(A_PUSH,TCgsize2opsize[pushsize],href));
+            end;
         end;
 
       var
@@ -193,7 +196,7 @@ unit cgcpu;
                 cgpara.check_simple_location;
                 len:=align(cgpara.intsize,cgpara.alignment);
                 g_stackpointer_alloc(list,len);
-                reference_reset_base(href,NR_STACK_POINTER_REG,0);
+                reference_reset_base(href,NR_STACK_POINTER_REG,0,4);
                 g_concatcopy(list,r,href,len);
               end
             else
@@ -206,11 +209,11 @@ unit cgcpu;
               end
           end
         else
-          inherited a_param_ref(list,size,r,cgpara);
+          inherited a_load_ref_cgpara(list,size,r,cgpara);
       end;
 
 
-    procedure tcg386.a_paramaddr_ref(list : TAsmList;const r : treference;const cgpara : tcgpara);
+    procedure tcg386.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);
       var
         tmpreg : tregister;
         opsize : topsize;
@@ -244,7 +247,7 @@ unit cgcpu;
                   end;
               end
             else
-              inherited a_paramaddr_ref(list,r,cgpara);
+              inherited a_loadaddr_ref_cgpara(list,r,cgpara);
           end;
       end;
 
@@ -284,17 +287,29 @@ unit cgcpu;
            { this messes up stack alignment }
            (target_info.system <> system_i386_darwin) then
           begin
-            if (current_procinfo.procdef.funcretloc[calleeside].loc<>LOC_VOID) and
-               (current_procinfo.procdef.funcretloc[calleeside].loc=LOC_REGISTER) then
-              list.concat(Taicpu.Op_const_reg(A_ADD,S_L,4,NR_ESP))
+            if assigned(current_procinfo.procdef.funcretloc[calleeside].location) and
+               (current_procinfo.procdef.funcretloc[calleeside].location^.loc=LOC_REGISTER) then
+              begin
+                if (getsupreg(current_procinfo.procdef.funcretloc[calleeside].location^.register)=RS_EAX) then
+                  list.concat(Taicpu.Op_const_reg(A_ADD,S_L,4,NR_ESP))
+                else
+                  internalerror(2010053001);
+              end
             else
               list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EAX));
             list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EBX));
             list.concat(Taicpu.Op_reg(A_POP,S_L,NR_ECX));
 
-            if (current_procinfo.procdef.funcretloc[calleeside].loc=LOC_REGISTER) and
-               (current_procinfo.procdef.funcretloc[calleeside].size in [OS_64,OS_S64]) then
-              list.concat(Taicpu.Op_const_reg(A_ADD,S_L,4,NR_ESP))
+            if (current_procinfo.procdef.funcretloc[calleeside].size in [OS_64,OS_S64]) and
+               assigned(current_procinfo.procdef.funcretloc[calleeside].location) and
+               assigned(current_procinfo.procdef.funcretloc[calleeside].location^.next) and
+               (current_procinfo.procdef.funcretloc[calleeside].location^.next^.loc=LOC_REGISTER) then
+              begin
+                if (getsupreg(current_procinfo.procdef.funcretloc[calleeside].location^.next^.register)=RS_EDX) then
+                  list.concat(Taicpu.Op_const_reg(A_ADD,S_L,4,NR_ESP))
+                else
+                  internalerror(2010053002);
+              end
             else
               list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EDX));
 
@@ -482,38 +497,52 @@ unit cgcpu;
     procedure tcg386.g_exception_reason_load(list : TAsmList; const href : treference);
       begin
         if not use_fixed_stack then
-          list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[OS_INT],NR_FUNCTION_RESULT_REG))
+          begin
+            cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
+            list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[OS_INT],NR_FUNCTION_RESULT_REG))
+          end
         else
           inherited g_exception_reason_load(list,href);
       end;
 
 
     procedure tcg386.g_maybe_got_init(list: TAsmList);
+      var
+        notdarwin: boolean;
       begin
         { allocate PIC register }
         if (cs_create_pic in current_settings.moduleswitches) and
            (tf_pic_uses_got in target_info.flags) and
            (pi_needs_got in current_procinfo.flags) then
           begin
-            if (target_info.system<>system_i386_darwin) then
+            notdarwin:=(target_info.system<>system_i386_darwin);
+            { on darwin, the got register is virtual (and allocated earlier
+              already) }
+            if notdarwin then
+              { ecx could be used in leaf procedures that don't use ecx to pass
+                aparameter }
+              current_procinfo.got:=NR_EBX;
+            if notdarwin { needs testing before it can be enabled for non-darwin platforms
+                and
+               (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');
-                list.concat(taicpu.op_sym_ofs_reg(A_ADD,S_L,current_asmdata.RefAsmSymbol('_GLOBAL_OFFSET_TABLE_'),0,NR_PIC_OFFSET_REG));
-                list.concat(tai_regalloc.alloc(NR_PIC_OFFSET_REG,nil));
-                { ecx could be used in leaf procedures }
-                current_procinfo.got:=NR_EBX;
               end
             else
               begin
-                { can't use ecx, since that one may overwrite a parameter }
-                current_module.requires_ebx_pic_helper:=true;
-                cg.a_call_name_static(list,'fpc_geteipasebx');
-                list.concat(tai_regalloc.alloc(NR_EBX,nil));
+                { call/pop is faster than call/ret/mov on Core Solo and later
+                  according to Apple's benchmarking -- and all Intel Macs
+                  have at least a Core Solo (furthermore, the i386 - Pentium 1
+                  don't have a return stack buffer) }
+                a_call_name_static(list,current_procinfo.CurrGOTLabel.name);
                 a_label(list,current_procinfo.CurrGotLabel);
-                { got is already set by ti386procinfo.allocate_got_register }
-                list.concat(tai_regalloc.dealloc(NR_EBX,nil));
-                a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_EBX,current_procinfo.got);
+                list.concat(taicpu.op_reg(A_POP,S_L,current_procinfo.got))
+              end;
+            if notdarwin then
+              begin
+                list.concat(taicpu.op_sym_ofs_reg(A_ADD,S_L,current_asmdata.RefAsmSymbol('_GLOBAL_OFFSET_TABLE_'),0,NR_PIC_OFFSET_REG));
+                list.concat(tai_regalloc.alloc(NR_PIC_OFFSET_REG,nil));
               end;
           end;
       end;
@@ -534,6 +563,11 @@ unit cgcpu;
            set self parameter to correct value
            call mangledname
            set self parameter to interface value
+           ret
+
+           This is different to case (0) because in theory, the caller
+           could reuse the data pushed on the stack so we've to return
+           it unmodified because self is const.
 
       (2): The wrapper code use %eax to reach the virtual method address
            set self to correct value
@@ -563,7 +597,7 @@ unit cgcpu;
 
       }
 
-        procedure getselftoeax(offs: longint);
+      procedure getselftoeax(offs: longint);
         var
           href : treference;
           selfoffsetfromsp : longint;
@@ -576,42 +610,44 @@ unit cgcpu;
                 selfoffsetfromsp:=2*sizeof(aint)
               else
                 selfoffsetfromsp:=sizeof(aint);
-              reference_reset_base(href,NR_ESP,selfoffsetfromsp+offs);
+              reference_reset_base(href,NR_ESP,selfoffsetfromsp+offs,4);
               cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
             end;
         end;
 
-        procedure loadvmttoeax;
+      procedure loadvmttoeax;
         var
           href : treference;
         begin
           { mov  0(%eax),%eax ; load vmt}
-          reference_reset_base(href,NR_EAX,0);
+          reference_reset_base(href,NR_EAX,0,4);
           cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
         end;
 
-        procedure op_oneaxmethodaddr(op: TAsmOp);
+      procedure op_oneaxmethodaddr(op: TAsmOp);
         var
           href : treference;
         begin
           if (procdef.extnumber=$ffff) then
             Internalerror(200006139);
           { call/jmp  vmtoffs(%eax) ; method offs }
-          reference_reset_base(href,NR_EAX,procdef._class.vmtmethodoffset(procdef.extnumber));
+          reference_reset_base(href,NR_EAX,procdef._class.vmtmethodoffset(procdef.extnumber),4);
           list.concat(taicpu.op_ref(op,S_L,href));
         end;
 
-        procedure loadmethodoffstoeax;
+
+      procedure loadmethodoffstoeax;
         var
           href : treference;
         begin
           if (procdef.extnumber=$ffff) then
             Internalerror(200006139);
           { mov vmtoffs(%eax),%eax ; method offs }
-          reference_reset_base(href,NR_EAX,procdef._class.vmtmethodoffset(procdef.extnumber));
+          reference_reset_base(href,NR_EAX,procdef._class.vmtmethodoffset(procdef.extnumber),4);
           cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
         end;
 
+
       var
         lab : tasmsymbol;
         make_global : boolean;
@@ -633,9 +669,9 @@ unit cgcpu;
           make_global:=true;
 
         if make_global then
-         List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
+          List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
         else
-        List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
+          List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
 
         { set param1 interface to self  }
         g_adjust_self_value(list,procdef,ioffset);
@@ -657,6 +693,7 @@ unit cgcpu;
               end;
             { restore param1 value self to interface }
             g_adjust_self_value(list,procdef,-ioffset);
+            list.concat(taicpu.op_none(A_RET,S_L));
           end
         else if po_virtualmethod in procdef.procoptions then
           begin
@@ -669,7 +706,7 @@ unit cgcpu;
                 loadvmttoeax;
                 loadmethodoffstoeax;
                 { mov %eax,4(%esp) }
-                reference_reset_base(href,NR_ESP,4);
+                reference_reset_base(href,NR_ESP,4,4);
                 list.concat(taicpu.op_reg_ref(A_MOV,S_L,NR_EAX,href));
                 { pop  %eax }
                 list.concat(taicpu.op_reg(A_POP,S_L,NR_EAX));
@@ -837,7 +874,10 @@ unit cgcpu;
         end;
       end;
 
-begin
-  cg := tcg386.create;
-  cg64 := tcg64f386.create;
+    procedure create_codegen;
+      begin
+        cg := tcg386.create;
+        cg64 := tcg64f386.create;
+      end;
+      
 end.

compiler/i386/cpuinfo.pas

@@ -75,7 +75,7 @@ Const
    ];
 
    cputypestr : array[tcputype] of string[10] = ('',
-     '386',
+     '80386',
      'PENTIUM',
      'PENTIUM2',
      'PENTIUM3',
@@ -101,10 +101,12 @@ Const
                                  { no need to write info about those }
                                  [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
                                  [cs_opt_peephole,cs_opt_regvar,cs_opt_stackframe,
-     cs_opt_asmcse,cs_opt_loopunroll,cs_opt_uncertain,cs_opt_tailrecursion];
+                                  cs_opt_asmcse,cs_opt_loopunroll,cs_opt_uncertain,
+								  cs_opt_tailrecursion,cs_opt_nodecse];
 
    level1optimizerswitches = genericlevel1optimizerswitches + [cs_opt_peephole];
-   level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + [cs_opt_regvar,cs_opt_stackframe,cs_opt_asmcse,cs_opt_tailrecursion];
+   level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches +
+     [cs_opt_regvar,cs_opt_stackframe,cs_opt_tailrecursion,cs_opt_nodecse];
    level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}];
 
 Implementation

compiler/i386/cpunode.pas

@@ -40,6 +40,7 @@ unit cpunode;
        ncgset,
        ncginl,
        ncgopt,
+       ncgobjc,
        { to be able to only parts of the generic code,
          the processor specific nodes must be included
          after the generic one (FK)

compiler/i386/cpupara.pas

@@ -4,7 +4,7 @@
     Generates the argument location information for i386
 
     This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published bymethodpointer
+    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.
 
@@ -27,7 +27,7 @@ unit cpupara;
 
     uses
        globtype,
-       aasmtai,aasmdata,cpubase,cgbase,
+       aasmtai,aasmdata,cpubase,cgbase,cgutils,
        symconst,symtype,symsym,symdef,
        parabase,paramgr;
 
@@ -49,6 +49,7 @@ unit cpupara;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);override;
+          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): TCGPara;override;
        private
           procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
           procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint);
@@ -61,8 +62,8 @@ unit cpupara;
     uses
        cutils,
        systems,verbose,
-       defutil,
-       cgutils;
+       symtable,
+       defutil;
 
       const
         parasupregs : array[0..2] of tsuperregister = (RS_EAX,RS_EDX,RS_ECX);
@@ -213,7 +214,7 @@ unit cpupara;
           stringdef :
             result:= (tstringdef(def).stringtype in [st_shortstring,st_longstring]);
           procvardef :
-            result:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (po_methodpointer in tprocvardef(def).procoptions);
+            result:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and not tprocvardef(def).is_addressonly;
           setdef :
             result:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (not is_smallset(def));
         end;
@@ -307,62 +308,96 @@ unit cpupara;
 
 
     procedure ti386paramanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
+      begin
+        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
+      end;
+
+
+    function  ti386paramanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): TCGPara;
       var
         retcgsize  : tcgsize;
+        paraloc : pcgparalocation;
+        sym: tfieldvarsym;
       begin
+        result.init;
+        result.alignment:=get_para_align(p.proccalloption);
+        { void has no location }
+        if is_void(def) then
+          begin
+            paraloc:=result.add_location;
+            result.size:=OS_NO;
+            result.intsize:=0;
+            paraloc^.size:=OS_NO;
+            paraloc^.loc:=LOC_VOID;
+            exit;
+          end;
+        { on darwin/i386, if a record has only one field and that field is a
+          single or double, it has to be returned like a single/double }
+        if (target_info.system=system_i386_darwin) and
+           ((def.typ=recorddef) or
+            is_object(def)) and
+           tabstractrecordsymtable(tabstractrecorddef(def).symtable).has_single_field(sym) and
+           (sym.vardef.typ=floatdef) and
+           (tfloatdef(sym.vardef).floattype in [s32real,s64real]) then
+          def:=sym.vardef;
         { Constructors return self instead of a boolean }
         if (p.proctypeoption=potype_constructor) then
-          retcgsize:=OS_ADDR
+          begin
+            retcgsize:=OS_ADDR;
+            result.intsize:=sizeof(pint);
+          end
         else
-          retcgsize:=def_cgsize(p.returndef);
-
-        location_reset(p.funcretloc[side],LOC_INVALID,OS_NO);
-        { void has no location }
-        if is_void(p.returndef) then
           begin
-            location_reset(p.funcretloc[side],LOC_VOID,OS_NO);
-            exit;
+            retcgsize:=def_cgsize(def);
+            result.intsize:=def.size;
           end;
+        result.size:=retcgsize;
         { Return is passed as var parameter }
-        if ret_in_param(p.returndef,p.proccalloption) then
+        if ret_in_param(def,p.proccalloption) then
           begin
-            p.funcretloc[side].loc:=LOC_REFERENCE;
-            p.funcretloc[side].size:=retcgsize;
+            paraloc:=result.add_location;
+            paraloc^.loc:=LOC_REFERENCE;
+            paraloc^.size:=retcgsize;
             exit;
           end;
         { Return in FPU register? }
-        if p.returndef.typ=floatdef then
+        if def.typ=floatdef then
           begin
-            p.funcretloc[side].loc:=LOC_FPUREGISTER;
-            p.funcretloc[side].register:=NR_FPU_RESULT_REG;
-            p.funcretloc[side].size:=retcgsize;
+            paraloc:=result.add_location;
+            paraloc^.loc:=LOC_FPUREGISTER;
+            paraloc^.register:=NR_FPU_RESULT_REG;
+            paraloc^.size:=retcgsize;
           end
         else
          { Return in register }
           begin
+            paraloc:=result.add_location;
+            paraloc^.loc:=LOC_REGISTER;
             if retcgsize in [OS_64,OS_S64] then
              begin
                { low 32bits }
-               p.funcretloc[side].loc:=LOC_REGISTER;
-               p.funcretloc[side].size:=OS_64;
                if side=callerside then
-                 p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG
+                 paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG
                else
-                 p.funcretloc[side].register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG;
+                 paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG;
+               paraloc^.size:=OS_32;
+
                { high 32bits }
+               paraloc:=result.add_location;
+               paraloc^.loc:=LOC_REGISTER;
                if side=callerside then
-                 p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG
+                 paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG
                else
-                 p.funcretloc[side].register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG;
+                 paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG;
+               paraloc^.size:=OS_32;
              end
             else
              begin
-               p.funcretloc[side].loc:=LOC_REGISTER;
-               p.funcretloc[side].size:=retcgsize;
+               paraloc^.size:=retcgsize;
                if side=callerside then
-                 p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(retcgsize))
+                 paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize))
                else
-                 p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(retcgsize));
+                 paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
              end;
           end;
       end;
@@ -563,20 +598,23 @@ unit cpupara;
 
                       64bit values,floats,arrays and records are always
                       on the stack.
+
+                      In case of po_delphi_nested_cc, the parent frame pointer
+                      is also always passed on the stack.
                     }
                     if (parareg<=high(parasupregs)) and
                        (paralen<=sizeof(aint)) and
-                       (
-                        not(hp.vardef.typ in [floatdef,recorddef,arraydef]) or
-                        pushaddr
-                       ) then
+                       (not(hp.vardef.typ in [floatdef,recorddef,arraydef]) or
+                        pushaddr) and
+                       (not(vo_is_parentfp in hp.varoptions) or
+                        not(po_delphi_nested_cc in p.procoptions)) then
                       begin
                         if pass=1 then
                           begin
                             paraloc:=hp.paraloc[side].add_location;
                             paraloc^.size:=paracgsize;
                             paraloc^.loc:=LOC_REGISTER;
-                            paraloc^.register:=newreg(R_INTREGISTER,parasupregs[parareg],cgsize2subreg(paracgsize));
+                            paraloc^.register:=newreg(R_INTREGISTER,parasupregs[parareg],cgsize2subreg(R_INTREGISTER,paracgsize));
                             inc(parareg);
                           end;
                       end

compiler/i386/cputarg.pas

@@ -77,6 +77,9 @@ implementation
     {$ifndef NOTARGETSYMBIAN}
       ,t_symbian
     {$endif}
+    {$ifndef NOTARGETNATIVENT}
+      ,t_nativent
+    {$endif}
 
 {**************************************
              Assemblers
@@ -94,6 +97,7 @@ implementation
 
       ,ogcoff
       ,ogelf
+      ,ogmacho
 
 {**************************************
         Assembler Readers