* merged trunk up to r20882

   o support for the new codepage-aware ansistrings in the jvm branch
   o empty ansistrings are now always represented by a nil pointer rather than
     by an empty string, because an empty string also has a code page which
     can confuse code (although this will make ansistrings harder to use
     in Java code)
   o more string helpers code shared between the general and jvm rtl
   o support for indexbyte/word in the jvm rtl (warning: first parameter
     is an open array rather than an untyped parameter there, so
     indexchar(pcharvar^,10,0) will be equivalent to
     indexchar[pcharvar^],10,0) there, which is different from what is
     intended; changing it to an untyped parameter wouldn't help though)
   o default() support is not yet complete
   o calling fpcres is currently broken due to limitations in
     sysutils.executeprocess() regarding handling unix quoting and
     the compiler using the same command lines for scripts and directly
     calling external programs
   o compiling the Java compiler currently requires adding ALLOW_WARNINGS=1
     to the make command line

git-svn-id: branches/jvmbackend@20887 -

.gitignore

@@ -1703,24 +1703,6 @@ packages/fpmkunit/src/build-stamp.*
 packages/fpmkunit/src/fpcmade.*
 packages/fpmkunit/src/units
 packages/fpmkunit/units
-packages/fpvectorial/*.bak
-packages/fpvectorial/*.exe
-packages/fpvectorial/*.o
-packages/fpvectorial/*.ppu
-packages/fpvectorial/*.s
-packages/fpvectorial/Package.fpc
-packages/fpvectorial/build-stamp.*
-packages/fpvectorial/fpcmade.*
-packages/fpvectorial/src/*.bak
-packages/fpvectorial/src/*.exe
-packages/fpvectorial/src/*.o
-packages/fpvectorial/src/*.ppu
-packages/fpvectorial/src/*.s
-packages/fpvectorial/src/Package.fpc
-packages/fpvectorial/src/build-stamp.*
-packages/fpvectorial/src/fpcmade.*
-packages/fpvectorial/src/units
-packages/fpvectorial/units
 packages/fuse/*.bak
 packages/fuse/*.exe
 packages/fuse/*.o

Makefile

@@ -1,10 +1,10 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2011/12/12]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2012/04/13]
 #
 default: help
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii 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 jvm-java jvm-android
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux jvm-java jvm-android
 BSDs = freebsd netbsd openbsd darwin
-UNIXs = linux $(BSDs) solaris qnx haiku
+UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
@@ -153,12 +153,6 @@ ifdef OS_TARGET_DEFAULT
 OS_TARGET=$(OS_TARGET_DEFAULT)
 endif
 endif
-ifneq ($(words $(FPC_COMPILERINFO)),5)
-FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
-FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
-FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
-FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
-endif
 ifndef CPU_SOURCE
 CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
 endif
@@ -184,6 +178,12 @@ else
 ARCH=$(CPU_TARGET)
 endif
 endif
+ifeq ($(FULL_TARGET),arm-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t or SUBARCH=armv7m) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 TARGETSUFFIX=$(OS_TARGET)
 SOURCESUFFIX=$(OS_SOURCE)
@@ -402,13 +402,19 @@ BUILDOPTS=FPC=$(PPNEW) RELEASE=1
 INSTALLOPTS=FPC=$(PPNEW) ZIPDESTDIR=$(BASEDIR) FPCMAKE=$(FPCMAKENEW)
 ifndef CROSSCOMPILE
 ifneq ($(wildcard ide),)
-IDETARGETS=go32v2 win32 win64 linux freebsd os2 emx beos haiku 
+IDETARGETS=go32v2 win32 win64 linux freebsd os2 emx beos haiku
 ifneq ($(findstring $(OS_TARGET),$(IDETARGETS)),)
 IDE=1
 endif
 endif
 endif
 BuildOnlyBaseCPUs=jvm
+ifneq ($(wildcard utils),)
+NOUTILSTARGETS=embedded gba $(BuildOnlyBaseCPUs)
+ifeq ($(findstring $(OS_TARGET),$(NOUTILSTARGETS)),)
+UTILS=1
+endif
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
@@ -523,6 +529,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc-wii)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
+ifeq ($(FULL_TARGET),powerpc-aix)
+override TARGET_DIRS+=compiler rtl utils packages ide installer
+endif
 ifeq ($(FULL_TARGET),sparc-linux)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
@@ -544,6 +553,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+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
@@ -586,6 +598,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
+ifeq ($(FULL_TARGET),powerpc64-aix)
+override TARGET_DIRS+=compiler rtl utils packages ide installer
+endif
 ifeq ($(FULL_TARGET),avr-embedded)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
@@ -595,6 +610,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
+ifeq ($(FULL_TARGET),mips-linux)
+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
@@ -815,7 +833,7 @@ SHAREDLIBPREFIX=libfp
 STATICLIBPREFIX=libp
 IMPORTLIBPREFIX=libimp
 RSTEXT=.rst
-ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+EXEDBGEXT=.dbg
 ifeq ($(OS_TARGET),go32v1)
 STATICLIBPREFIX=
 SHORTSUFFIX=v1
@@ -937,6 +955,7 @@ BATCHEXT=.sh
 EXEEXT=
 HASSHAREDLIB=1
 SHORTSUFFIX=dwn
+EXEDBGEXT=.dSYM
 endif
 ifeq ($(OS_TARGET),gba)
 EXEEXT=.gba
@@ -956,6 +975,11 @@ EXEEXT=.dol
 SHAREDLIBEXT=.so
 SHORTSUFFIX=wii
 endif
+ifeq ($(OS_TARGET),aix)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=aix
+endif
 ifeq ($(OS_TARGET),java)
 OEXT=.class
 ASMEXT=.j
@@ -968,161 +992,6 @@ ASMEXT=.j
 SHAREDLIBEXT=.jar
 SHORTSUFFIX=android
 endif
-else
-ifeq ($(OS_TARGET),go32v1)
-PPUEXT=.pp1
-OEXT=.o1
-ASMEXT=.s1
-SMARTEXT=.sl1
-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
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=lnx
-endif
-ifeq ($(OS_TARGET),freebsd)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=fbs
-endif
-ifeq ($(OS_TARGET),netbsd)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=nbs
-endif
-ifeq ($(OS_TARGET),openbsd)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=obs
-endif
-ifeq ($(OS_TARGET),win32)
-PPUEXT=.ppw
-OEXT=.ow
-ASMEXT=.sw
-SMARTEXT=.slw
-STATICLIBEXT=.aw
-SHAREDLIBEXT=.dll
-SHORTSUFFIX=w32
-endif
-ifeq ($(OS_TARGET),os2)
-BATCHEXT=.cmd
-PPUEXT=.ppo
-ASMEXT=.so2
-OEXT=.oo2
-AOUTEXT=.out
-SMARTEXT=.sl2
-STATICLIBPREFIX=
-STATICLIBEXT=.ao2
-SHAREDLIBEXT=.dll
-SHORTSUFFIX=os2
-ECHO=echo
-IMPORTLIBPREFIX=
-endif
-ifeq ($(OS_TARGET),amiga)
-EXEEXT=
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.library
-SHORTSUFFIX=amg
-endif
-ifeq ($(OS_TARGET),atari)
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=.ttp
-SHORTSUFFIX=ata
-endif
-ifeq ($(OS_TARGET),beos)
-BATCHEXT=.sh
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-SHORTSUFFIX=be
-endif
-ifeq ($(OS_TARGET),solaris)
-BATCHEXT=.sh
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-SHORTSUFFIX=sun
-endif
-ifeq ($(OS_TARGET),qnx)
-BATCHEXT=.sh
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-SHORTSUFFIX=qnx
-endif
-ifeq ($(OS_TARGET),netware)
-STATICLIBPREFIX=
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.nlm
-EXEEXT=.nlm
-SHORTSUFFIX=nw
-IMPORTLIBPREFIX=imp
-endif
-ifeq ($(OS_TARGET),netwlibc)
-STATICLIBPREFIX=
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.nlm
-EXEEXT=.nlm
-SHORTSUFFIX=nwl
-IMPORTLIBPREFIX=imp
-endif
-ifeq ($(OS_TARGET),macos)
-BATCHEXT=
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-DEBUGSYMEXT=.xcoff
-SHORTSUFFIX=mac
-IMPORTLIBPREFIX=imp
-endif
-endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -1312,15 +1181,6 @@ ASNAME=$(BINUTILSPREFIX)as
 LDNAME=$(BINUTILSPREFIX)ld
 ARNAME=$(BINUTILSPREFIX)ar
 RCNAME=$(BINUTILSPREFIX)rc
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-ifeq ($(OS_TARGET),win32)
-ifeq ($(CROSSBINDIR),)
-ASNAME=asw
-LDNAME=ldw
-ARNAME=arw
-endif
-endif
-endif
 ifndef ASPROG
 ifdef CROSSBINDIR
 ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
@@ -1364,25 +1224,6 @@ DATESTR:=$(shell $(DATE) +%Y%m%d)
 else
 DATESTR=
 endif
-ifndef UPXPROG
-ifeq ($(OS_TARGET),go32v2)
-UPXPROG:=1
-endif
-ifeq ($(OS_TARGET),win32)
-UPXPROG:=1
-endif
-ifdef UPXPROG
-UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(UPXPROG),)
-UPXPROG=
-else
-UPXPROG:=$(firstword $(UPXPROG))
-endif
-else
-UPXPROG=
-endif
-endif
-export UPXPROG
 ZIPOPT=-9
 ZIPEXT=.zip
 ifeq ($(USETAR),bz2)
@@ -1403,6 +1244,7 @@ override FPCOPT+=-P$(ARCH)
 endif
 ifeq ($(OS_SOURCE),openbsd)
 override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH)
 endif
 ifndef CROSSBOOTSTRAP
 ifneq ($(BINUTILSPREFIX),)
@@ -1412,6 +1254,11 @@ ifneq ($(BINUTILSPREFIX),)
 override FPCOPT+=-Xr$(RLINKPATH)
 endif
 endif
+ifndef CROSSCOMPILE
+ifneq ($(BINUTILSPREFIX),)
+override FPCMAKEOPT+=-XP$(BINUTILSPREFIX)
+endif
+endif
 ifdef UNITDIR
 override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
 endif
@@ -1503,7 +1350,7 @@ override FPCOPT+=-Aas
 endif
 endif
 ifeq ($(findstring 2.0.,$(FPC_VERSION)),)
-ifneq ($(findstring $(OS_TARGET),linux solaris),)
+ifneq ($(findstring $(OS_TARGET),freebsd openbsd netbsd linux solaris),)
 ifeq ($(CPU_TARGET),x86_64)
 override FPCOPT+=-Cg
 endif
@@ -1572,9 +1419,6 @@ endif
 fpc_install: all $(INSTALLTARGET)
 ifdef INSTALLEXEFILES
 	$(MKDIR) $(INSTALL_BINDIR)
-ifdef UPXPROG
-	-$(UPXPROG) $(INSTALLEXEFILES)
-endif
 	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
 endif
 ifdef INSTALL_CREATEPACKAGEFPC
@@ -1708,9 +1552,11 @@ fpc_zipdistinstall:
 .PHONY: fpc_clean fpc_cleanall fpc_distclean
 ifdef EXEFILES
 override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+override CLEANEXEDBGFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEDBGFILES))
 endif
 ifdef CLEAN_PROGRAMS
 override CLEANEXEFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEEXT), $(CLEAN_PROGRAMS)))
+override CLEANEXEDBGFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEDBGEXT), $(CLEAN_PROGRAMS)))
 endif
 ifdef CLEAN_UNITS
 override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
@@ -1727,6 +1573,9 @@ fpc_clean: $(CLEANTARGET)
 ifdef CLEANEXEFILES
 	-$(DEL) $(CLEANEXEFILES)
 endif
+ifdef CLEANEXEDBGFILES
+	-$(DELTREE) $(CLEANEXEDBGFILES)
+endif
 ifdef CLEANPPUFILES
 	-$(DEL) $(CLEANPPUFILES)
 endif
@@ -1828,7 +1677,6 @@ fpc_baseinfo:
 	@$(ECHO)  Date...... $(DATE)
 	@$(ECHO)  FPCMake... $(FPCMAKE)
 	@$(ECHO)  PPUMove... $(PPUMOVE)
-	@$(ECHO)  Upx....... $(UPXPROG)
 	@$(ECHO)  Zip....... $(ZIPPROG)
 	@$(ECHO)
 	@$(ECHO)  == Object info ==
@@ -2189,6 +2037,14 @@ TARGET_DIRS_PACKAGES=1
 TARGET_DIRS_IDE=1
 TARGET_DIRS_INSTALLER=1
 endif
+ifeq ($(FULL_TARGET),powerpc-aix)
+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),sparc-linux)
 TARGET_DIRS_COMPILER=1
 TARGET_DIRS_RTL=1
@@ -2245,6 +2101,14 @@ TARGET_DIRS_PACKAGES=1
 TARGET_DIRS_IDE=1
 TARGET_DIRS_INSTALLER=1
 endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+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
@@ -2357,6 +2221,14 @@ TARGET_DIRS_PACKAGES=1
 TARGET_DIRS_IDE=1
 TARGET_DIRS_INSTALLER=1
 endif
+ifeq ($(FULL_TARGET),powerpc64-aix)
+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),avr-embedded)
 TARGET_DIRS_COMPILER=1
 TARGET_DIRS_RTL=1
@@ -2381,6 +2253,14 @@ TARGET_DIRS_PACKAGES=1
 TARGET_DIRS_IDE=1
 TARGET_DIRS_INSTALLER=1
 endif
+ifeq ($(FULL_TARGET),mips-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
 ifeq ($(FULL_TARGET),mipsel-linux)
 TARGET_DIRS_COMPILER=1
 TARGET_DIRS_RTL=1
@@ -2713,7 +2593,7 @@ compiler_cycle:
 	$(MAKE) -C compiler cycle
 BUILDSTAMP=build-stamp.$(FULL_TARGET)
 .PHONY: all clean distclean build buildbase install installbase installother zipinstallbase zipinstallotherzipinstall singlezipinstall
-ifeq ( $findstring($CPU_TAGET,$BuildOnlyBaseCPUs),)
+ifeq ($(findstring $(CPU_TARGET),$(BuildOnlyBaseCPUs)),)
 all: build
 install: installall
 else
@@ -2729,14 +2609,18 @@ $(BUILDSTAMP):
 	$(MAKE) compiler_cycle RELEASE=1
 	$(MAKE) rtl_clean $(CLEANOPTS)
 	$(MAKE) packages_clean $(CLEANOPTS)
+ifdef UTILS
 	$(MAKE) utils_clean $(CLEANOPTS)
+endif
 ifdef IDE
 	$(MAKE) ide_clean $(CLEANOPTS)
 	$(MAKE) installer_clean $(CLEANOPTS)
 endif
 	$(MAKE) rtl_$(ALLTARGET) $(BUILDOPTS)
 	$(MAKE) packages_$(ALLTARGET) $(BUILDOPTS)
+ifdef UTILS
 	$(MAKE) utils_all $(BUILDOPTS)
+endif
 ifdef IDE
 	$(MAKE) ide_all $(BUILDOPTS)
 	$(MAKE) installer_all $(BUILDOPTS)
@@ -2755,7 +2639,9 @@ installbase: base.$(BUILDSTAMP)
 	$(MAKE) rtl_$(INSTALLTARGET) $(INSTALLOPTS)
 installother:
 	$(MAKE) packages_$(INSTALLTARGET) $(INSTALLOPTS)
+ifdef UTILS
 	$(MAKE) utils_$(INSTALLTARGET) $(INSTALLOPTS)
+endif
 ifdef IDE
 	$(MAKE) ide_$(INSTALLTARGET) $(BUILDOPTS)
 endif
@@ -2763,13 +2649,15 @@ zipinstallbase:
 	$(MAKE) fpc_zipinstall ZIPTARGET=installbase ZIPNAME=base $(INSTALLOPTS)
 zipinstallother:
 	$(MAKE) packages_zip$(INSTALLTARGET) $(INSTALLOPTS) ZIPPREFIX=$(PKGUNITSPRE)
+ifdef UTILS
 	$(MAKE) utils_zip$(INSTALLTARGET) $(INSTALLOPTS)
+endif
 ifdef IDE
 	$(MAKE) ide_zip$(INSTALLTARGET) $(INSTALLOPTS)
 endif
 installall: $(BUILDSTAMP)
 	$(MAKE) installbase $(INSTALLOPTS)
-ifeq ( $(findstring($CPU_TARGET, BuildOnlyBaseCPUs)),)
+ifeq ($(findstring $(CPU_TARGET), $(BuildOnlyBaseCPUs)),)
 	$(MAKE) installother $(INSTALLOPTS)
 endif
 singlezipinstall: zipinstall

Makefile.fpc

@@ -158,7 +158,7 @@ INSTALLOPTS=FPC=$(PPNEW) ZIPDESTDIR=$(BASEDIR) FPCMAKE=$(FPCMAKENEW)
 # Skipped by default for cross compiles, because it depends on libc
 ifndef CROSSCOMPILE
 ifneq ($(wildcard ide),)
-IDETARGETS=go32v2 win32 win64 linux freebsd os2 emx beos haiku 
+IDETARGETS=go32v2 win32 win64 linux freebsd os2 emx beos haiku
 ifneq ($(findstring $(OS_TARGET),$(IDETARGETS)),)
 IDE=1
 endif
@@ -168,6 +168,13 @@ endif
 # CPU targets for which we only build the compiler/rtl
 BuildOnlyBaseCPUs=jvm
 
+ifneq ($(wildcard utils),)
+NOUTILSTARGETS=embedded gba $(BuildOnlyBaseCPUs)
+ifeq ($(findstring $(OS_TARGET),$(NOUTILSTARGETS)),)
+UTILS=1
+endif
+endif
+
 [rules]
 .NOTPARALLEL:
 
@@ -218,7 +225,7 @@ BUILDSTAMP=build-stamp.$(FULL_TARGET)
 .PHONY: all clean distclean build buildbase install installbase installother zipinstallbase zipinstallotherzipinstall singlezipinstall
 
 
-ifeq ( $findstring($CPU_TAGET,$BuildOnlyBaseCPUs),)
+ifeq ($(findstring $(CPU_TARGET),$(BuildOnlyBaseCPUs)),)
 all: build
 install: installall
 else
@@ -239,7 +246,9 @@ $(BUILDSTAMP):
 # clean
         $(MAKE) rtl_clean $(CLEANOPTS)
         $(MAKE) packages_clean $(CLEANOPTS)
+ifdef UTILS
         $(MAKE) utils_clean $(CLEANOPTS)
+endif
 ifdef IDE
         $(MAKE) ide_clean $(CLEANOPTS)
         $(MAKE) installer_clean $(CLEANOPTS)
@@ -247,7 +256,9 @@ endif
 # build everything
         $(MAKE) rtl_$(ALLTARGET) $(BUILDOPTS)
         $(MAKE) packages_$(ALLTARGET) $(BUILDOPTS)
+ifdef UTILS
         $(MAKE) utils_all $(BUILDOPTS)
+endif
 ifdef IDE
         $(MAKE) ide_all $(BUILDOPTS)
         $(MAKE) installer_all $(BUILDOPTS)
@@ -274,7 +285,9 @@ installbase: base.$(BUILDSTAMP)
 
 installother:
         $(MAKE) packages_$(INSTALLTARGET) $(INSTALLOPTS)
+ifdef UTILS
         $(MAKE) utils_$(INSTALLTARGET) $(INSTALLOPTS)
+endif
 ifdef IDE
         $(MAKE) ide_$(INSTALLTARGET) $(BUILDOPTS)
 endif
@@ -284,7 +297,9 @@ zipinstallbase:
 
 zipinstallother:
         $(MAKE) packages_zip$(INSTALLTARGET) $(INSTALLOPTS) ZIPPREFIX=$(PKGUNITSPRE)
+ifdef UTILS
         $(MAKE) utils_zip$(INSTALLTARGET) $(INSTALLOPTS)
+endif
 ifdef IDE
         $(MAKE) ide_zip$(INSTALLTARGET) $(INSTALLOPTS)
 endif
@@ -292,7 +307,7 @@ endif
 
 installall: $(BUILDSTAMP)
         $(MAKE) installbase $(INSTALLOPTS)
-ifeq ( $(findstring($CPU_TARGET, BuildOnlyBaseCPUs)),)
+ifeq ($(findstring $(CPU_TARGET), $(BuildOnlyBaseCPUs)),)
         $(MAKE) installother $(INSTALLOPTS)
 endif
 

compiler/Makefile

@@ -1,10 +1,10 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2011/12/12]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2012/04/13]
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii 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 jvm-java jvm-android
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux jvm-java jvm-android
 BSDs = freebsd netbsd openbsd darwin
-UNIXs = linux $(BSDs) solaris qnx haiku
+UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
@@ -153,12 +153,6 @@ ifdef OS_TARGET_DEFAULT
 OS_TARGET=$(OS_TARGET_DEFAULT)
 endif
 endif
-ifneq ($(words $(FPC_COMPILERINFO)),5)
-FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
-FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
-FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
-FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
-endif
 ifndef CPU_SOURCE
 CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
 endif
@@ -184,6 +178,12 @@ else
 ARCH=$(CPU_TARGET)
 endif
 endif
+ifeq ($(FULL_TARGET),arm-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t or SUBARCH=armv7m) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 TARGETSUFFIX=$(OS_TARGET)
 SOURCESUFFIX=$(OS_SOURCE)
@@ -332,6 +332,9 @@ endif
 ifdef MIPSEL
 PPC_TARGET=mipsel
 endif
+ifdef AVR
+PPC_TARGET=avr
+endif
 ifdef JVM
 PPC_TARGET=jvm
 endif
@@ -391,6 +394,9 @@ endif
 ifeq ($(CPC_TARGET),mipsel)
 CPUSUF=mipsel
 endif
+ifeq ($(CPC_TARGET),avr)
+CPUSUF=avr
+endif
 ifeq ($(CPC_TARGET),jvm)
 CPUSUF=jvm
 endif
@@ -458,7 +464,10 @@ endif
 ifeq ($(CPU_TARGET),jvm)
 NoNativeBinaries=1
 endif
-ifneq ($(OS_TARGET),embedded)
+ifeq ($(OS_TARGET),embedded)
+NoNativeBinaries=1
+endif
+ifeq ($(OS_TARGET),gba)
 NoNativeBinaries=1
 endif
 ifeq ($(FULL_TARGET),i386-linux)
@@ -575,6 +584,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc-wii)
 override TARGET_DIRS+=utils
 endif
+ifeq ($(FULL_TARGET),powerpc-aix)
+override TARGET_DIRS+=utils
+endif
 ifeq ($(FULL_TARGET),sparc-linux)
 override TARGET_DIRS+=utils
 endif
@@ -596,6 +608,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
 override TARGET_DIRS+=utils
 endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+override TARGET_DIRS+=utils
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override TARGET_DIRS+=utils
 endif
@@ -638,6 +653,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
 override TARGET_DIRS+=utils
 endif
+ifeq ($(FULL_TARGET),powerpc64-aix)
+override TARGET_DIRS+=utils
+endif
 ifeq ($(FULL_TARGET),avr-embedded)
 override TARGET_DIRS+=utils
 endif
@@ -647,6 +665,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override TARGET_DIRS+=utils
 endif
+ifeq ($(FULL_TARGET),mips-linux)
+override TARGET_DIRS+=utils
+endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 override TARGET_DIRS+=utils
 endif
@@ -770,6 +791,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc-wii)
 override TARGET_PROGRAMS+=pp
 endif
+ifeq ($(FULL_TARGET),powerpc-aix)
+override TARGET_PROGRAMS+=pp
+endif
 ifeq ($(FULL_TARGET),sparc-linux)
 override TARGET_PROGRAMS+=pp
 endif
@@ -791,6 +815,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
 override TARGET_PROGRAMS+=pp
 endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+override TARGET_PROGRAMS+=pp
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override TARGET_PROGRAMS+=pp
 endif
@@ -833,6 +860,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
 override TARGET_PROGRAMS+=pp
 endif
+ifeq ($(FULL_TARGET),powerpc64-aix)
+override TARGET_PROGRAMS+=pp
+endif
 ifeq ($(FULL_TARGET),avr-embedded)
 override TARGET_PROGRAMS+=pp
 endif
@@ -842,6 +872,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override TARGET_PROGRAMS+=pp
 endif
+ifeq ($(FULL_TARGET),mips-linux)
+override TARGET_PROGRAMS+=pp
+endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 override TARGET_PROGRAMS+=pp
 endif
@@ -966,6 +999,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc-wii)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
+ifeq ($(FULL_TARGET),powerpc-aix)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
 ifeq ($(FULL_TARGET),sparc-linux)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
@@ -987,6 +1023,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
@@ -1029,6 +1068,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
+ifeq ($(FULL_TARGET),powerpc64-aix)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
 ifeq ($(FULL_TARGET),avr-embedded)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
@@ -1038,6 +1080,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
+ifeq ($(FULL_TARGET),mips-linux)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
@@ -1161,6 +1206,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc-wii)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
+ifeq ($(FULL_TARGET),powerpc-aix)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
 ifeq ($(FULL_TARGET),sparc-linux)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -1182,6 +1230,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -1224,6 +1275,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
+ifeq ($(FULL_TARGET),powerpc64-aix)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
 ifeq ($(FULL_TARGET),avr-embedded)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -1233,6 +1287,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
+ifeq ($(FULL_TARGET),mips-linux)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -1356,6 +1413,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc-wii)
 override COMPILER_TARGETDIR+=.
 endif
+ifeq ($(FULL_TARGET),powerpc-aix)
+override COMPILER_TARGETDIR+=.
+endif
 ifeq ($(FULL_TARGET),sparc-linux)
 override COMPILER_TARGETDIR+=.
 endif
@@ -1377,6 +1437,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
 override COMPILER_TARGETDIR+=.
 endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+override COMPILER_TARGETDIR+=.
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override COMPILER_TARGETDIR+=.
 endif
@@ -1419,6 +1482,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
 override COMPILER_TARGETDIR+=.
 endif
+ifeq ($(FULL_TARGET),powerpc64-aix)
+override COMPILER_TARGETDIR+=.
+endif
 ifeq ($(FULL_TARGET),avr-embedded)
 override COMPILER_TARGETDIR+=.
 endif
@@ -1428,6 +1494,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_TARGETDIR+=.
 endif
+ifeq ($(FULL_TARGET),mips-linux)
+override COMPILER_TARGETDIR+=.
+endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 override COMPILER_TARGETDIR+=.
 endif
@@ -1551,6 +1620,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc-wii)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),powerpc-aix)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
 ifeq ($(FULL_TARGET),sparc-linux)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -1572,6 +1644,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -1614,6 +1689,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),powerpc64-aix)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
 ifeq ($(FULL_TARGET),avr-embedded)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -1623,6 +1701,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),mips-linux)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -1842,7 +1923,7 @@ SHAREDLIBPREFIX=libfp
 STATICLIBPREFIX=libp
 IMPORTLIBPREFIX=libimp
 RSTEXT=.rst
-ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+EXEDBGEXT=.dbg
 ifeq ($(OS_TARGET),go32v1)
 STATICLIBPREFIX=
 SHORTSUFFIX=v1
@@ -1964,6 +2045,7 @@ BATCHEXT=.sh
 EXEEXT=
 HASSHAREDLIB=1
 SHORTSUFFIX=dwn
+EXEDBGEXT=.dSYM
 endif
 ifeq ($(OS_TARGET),gba)
 EXEEXT=.gba
@@ -1983,6 +2065,11 @@ EXEEXT=.dol
 SHAREDLIBEXT=.so
 SHORTSUFFIX=wii
 endif
+ifeq ($(OS_TARGET),aix)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=aix
+endif
 ifeq ($(OS_TARGET),java)
 OEXT=.class
 ASMEXT=.j
@@ -1995,161 +2082,6 @@ ASMEXT=.j
 SHAREDLIBEXT=.jar
 SHORTSUFFIX=android
 endif
-else
-ifeq ($(OS_TARGET),go32v1)
-PPUEXT=.pp1
-OEXT=.o1
-ASMEXT=.s1
-SMARTEXT=.sl1
-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
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=lnx
-endif
-ifeq ($(OS_TARGET),freebsd)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=fbs
-endif
-ifeq ($(OS_TARGET),netbsd)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=nbs
-endif
-ifeq ($(OS_TARGET),openbsd)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=obs
-endif
-ifeq ($(OS_TARGET),win32)
-PPUEXT=.ppw
-OEXT=.ow
-ASMEXT=.sw
-SMARTEXT=.slw
-STATICLIBEXT=.aw
-SHAREDLIBEXT=.dll
-SHORTSUFFIX=w32
-endif
-ifeq ($(OS_TARGET),os2)
-BATCHEXT=.cmd
-PPUEXT=.ppo
-ASMEXT=.so2
-OEXT=.oo2
-AOUTEXT=.out
-SMARTEXT=.sl2
-STATICLIBPREFIX=
-STATICLIBEXT=.ao2
-SHAREDLIBEXT=.dll
-SHORTSUFFIX=os2
-ECHO=echo
-IMPORTLIBPREFIX=
-endif
-ifeq ($(OS_TARGET),amiga)
-EXEEXT=
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.library
-SHORTSUFFIX=amg
-endif
-ifeq ($(OS_TARGET),atari)
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=.ttp
-SHORTSUFFIX=ata
-endif
-ifeq ($(OS_TARGET),beos)
-BATCHEXT=.sh
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-SHORTSUFFIX=be
-endif
-ifeq ($(OS_TARGET),solaris)
-BATCHEXT=.sh
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-SHORTSUFFIX=sun
-endif
-ifeq ($(OS_TARGET),qnx)
-BATCHEXT=.sh
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-SHORTSUFFIX=qnx
-endif
-ifeq ($(OS_TARGET),netware)
-STATICLIBPREFIX=
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.nlm
-EXEEXT=.nlm
-SHORTSUFFIX=nw
-IMPORTLIBPREFIX=imp
-endif
-ifeq ($(OS_TARGET),netwlibc)
-STATICLIBPREFIX=
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.nlm
-EXEEXT=.nlm
-SHORTSUFFIX=nwl
-IMPORTLIBPREFIX=imp
-endif
-ifeq ($(OS_TARGET),macos)
-BATCHEXT=
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-DEBUGSYMEXT=.xcoff
-SHORTSUFFIX=mac
-IMPORTLIBPREFIX=imp
-endif
-endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -2339,15 +2271,6 @@ ASNAME=$(BINUTILSPREFIX)as
 LDNAME=$(BINUTILSPREFIX)ld
 ARNAME=$(BINUTILSPREFIX)ar
 RCNAME=$(BINUTILSPREFIX)rc
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-ifeq ($(OS_TARGET),win32)
-ifeq ($(CROSSBINDIR),)
-ASNAME=asw
-LDNAME=ldw
-ARNAME=arw
-endif
-endif
-endif
 ifndef ASPROG
 ifdef CROSSBINDIR
 ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
@@ -2391,25 +2314,6 @@ DATESTR:=$(shell $(DATE) +%Y%m%d)
 else
 DATESTR=
 endif
-ifndef UPXPROG
-ifeq ($(OS_TARGET),go32v2)
-UPXPROG:=1
-endif
-ifeq ($(OS_TARGET),win32)
-UPXPROG:=1
-endif
-ifdef UPXPROG
-UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(UPXPROG),)
-UPXPROG=
-else
-UPXPROG:=$(firstword $(UPXPROG))
-endif
-else
-UPXPROG=
-endif
-endif
-export UPXPROG
 ZIPOPT=-9
 ZIPEXT=.zip
 ifeq ($(USETAR),bz2)
@@ -2534,6 +2438,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc-wii)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),powerpc-aix)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),sparc-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -2555,6 +2462,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -2597,6 +2507,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),powerpc64-aix)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),avr-embedded)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -2606,6 +2519,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),mips-linux)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -2664,6 +2580,7 @@ override FPCOPT+=-P$(ARCH)
 endif
 ifeq ($(OS_SOURCE),openbsd)
 override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH)
 endif
 ifndef CROSSBOOTSTRAP
 ifneq ($(BINUTILSPREFIX),)
@@ -2673,6 +2590,11 @@ ifneq ($(BINUTILSPREFIX),)
 override FPCOPT+=-Xr$(RLINKPATH)
 endif
 endif
+ifndef CROSSCOMPILE
+ifneq ($(BINUTILSPREFIX),)
+override FPCMAKEOPT+=-XP$(BINUTILSPREFIX)
+endif
+endif
 ifdef UNITDIR
 override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
 endif
@@ -2764,7 +2686,7 @@ override FPCOPT+=-Aas
 endif
 endif
 ifeq ($(findstring 2.0.,$(FPC_VERSION)),)
-ifneq ($(findstring $(OS_TARGET),linux solaris),)
+ifneq ($(findstring $(OS_TARGET),freebsd openbsd netbsd linux solaris),)
 ifeq ($(CPU_TARGET),x86_64)
 override FPCOPT+=-Cg
 endif
@@ -2811,9 +2733,11 @@ ifndef CROSSINSTALL
 ifneq ($(TARGET_PROGRAMS),)
 override EXEFILES=$(addsuffix $(EXEEXT),$(TARGET_PROGRAMS))
 override EXEOFILES:=$(addsuffix $(OEXT),$(TARGET_PROGRAMS)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS))) $(addprefix $(IMPORTLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS)))
+override EXEDBGFILES:=$(addsuffix $(EXEDBGEXT),$(TARGET_PROGRAMS))
 override ALLTARGET+=fpc_exes
 override INSTALLEXEFILES+=$(EXEFILES)
 override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)
+override CLEANEXEDBGFILES+=$(EXEDBGFILES)
 ifeq ($(OS_TARGET),os2)
 override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS))
 endif
@@ -2924,9 +2848,6 @@ endif
 fpc_install: all $(INSTALLTARGET)
 ifdef INSTALLEXEFILES
 	$(MKDIR) $(INSTALL_BINDIR)
-ifdef UPXPROG
-	-$(UPXPROG) $(INSTALLEXEFILES)
-endif
 	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
 endif
 ifdef INSTALL_CREATEPACKAGEFPC
@@ -3060,9 +2981,11 @@ fpc_zipdistinstall:
 .PHONY: fpc_clean fpc_cleanall fpc_distclean
 ifdef EXEFILES
 override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+override CLEANEXEDBGFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEDBGFILES))
 endif
 ifdef CLEAN_PROGRAMS
 override CLEANEXEFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEEXT), $(CLEAN_PROGRAMS)))
+override CLEANEXEDBGFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEDBGEXT), $(CLEAN_PROGRAMS)))
 endif
 ifdef CLEAN_UNITS
 override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
@@ -3079,6 +3002,9 @@ fpc_clean: $(CLEANTARGET)
 ifdef CLEANEXEFILES
 	-$(DEL) $(CLEANEXEFILES)
 endif
+ifdef CLEANEXEDBGFILES
+	-$(DELTREE) $(CLEANEXEDBGFILES)
+endif
 ifdef CLEANPPUFILES
 	-$(DEL) $(CLEANPPUFILES)
 endif
@@ -3180,7 +3106,6 @@ fpc_baseinfo:
 	@$(ECHO)  Date...... $(DATE)
 	@$(ECHO)  FPCMake... $(FPCMAKE)
 	@$(ECHO)  PPUMove... $(PPUMOVE)
-	@$(ECHO)  Upx....... $(UPXPROG)
 	@$(ECHO)  Zip....... $(ZIPPROG)
 	@$(ECHO)
 	@$(ECHO)  == Object info ==
@@ -3351,6 +3276,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc-wii)
 TARGET_DIRS_UTILS=1
 endif
+ifeq ($(FULL_TARGET),powerpc-aix)
+TARGET_DIRS_UTILS=1
+endif
 ifeq ($(FULL_TARGET),sparc-linux)
 TARGET_DIRS_UTILS=1
 endif
@@ -3372,6 +3300,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
 TARGET_DIRS_UTILS=1
 endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+TARGET_DIRS_UTILS=1
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 TARGET_DIRS_UTILS=1
 endif
@@ -3414,6 +3345,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
 TARGET_DIRS_UTILS=1
 endif
+ifeq ($(FULL_TARGET),powerpc64-aix)
+TARGET_DIRS_UTILS=1
+endif
 ifeq ($(FULL_TARGET),avr-embedded)
 TARGET_DIRS_UTILS=1
 endif
@@ -3423,6 +3357,9 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 TARGET_DIRS_UTILS=1
 endif
+ifeq ($(FULL_TARGET),mips-linux)
+TARGET_DIRS_UTILS=1
+endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 TARGET_DIRS_UTILS=1
 endif
@@ -3515,10 +3452,7 @@ makefiles: fpc_makefiles
 ifneq ($(wildcard fpcmake.loc),)
 include fpcmake.loc
 endif
-ifeq ($(OS_TARGET),win32)
-USE_CMP_FOR_DIFF=1
-endif
-ifeq ($(OS_TARGET),win64)
+ifneq ($(findstring $(OS_TARGET),win32 win64 aix),)
 USE_CMP_FOR_DIFF=1
 endif
 ifdef USE_CMP_FOR_DIFF
@@ -3526,6 +3460,11 @@ ifdef CMP
 override DIFF:=$(CMP) -i218
 endif
 endif
+ifeq ($(findstring 2.4.,$(FPC_VERSION)),)
+ifndef ALLOW_WARNINGS
+override LOCALOPT+=-Sew
+endif
+endif
 override COMPILER+=$(LOCALOPT)
 PASDOC:=$(strip $(wildcard $(addsuffix /pasdoc.exe,$(SEARCHPATH))))
 ifeq ($(PASDOC),)
@@ -3558,10 +3497,13 @@ INSTALLEXEFILE=$(PPCROSSNAME)
 else
 INSTALLEXEFILE=$(EXENAME)
 endif
-PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64 mips mipsel jvm
-.PHONY: $(PPC_TARGETS)
+PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64 mips mipsel avr jvm
+INSTALL_TARGETS=$(addsuffix _exe_install,$(sort $(CYCLETARGETS) $(PPC_TARGETS)))
+.PHONY: $(PPC_TARGETS) $(INSTALL_TARGETS)
 $(PPC_TARGETS):
 	$(MAKE) PPC_TARGET=$@ CPU_UNITDIR=$@ all
+$(INSTALL_TARGETS):
+	$(MAKE) all exeinstall PPC_TARGET=$(subst _exe_install,,$@) CPU_UNITDIR=$(subst _exe_install,,$@)
 alltargets: $(ALLTARGETS)
 .NOTPARALLEL:
 .PHONY: all compiler echotime ppuclean execlean clean distclean
@@ -3620,7 +3562,13 @@ insdatarm : arm/armins.dat
 insdat: insdatx86 insdatarm
 regdatarm : arm/armreg.dat
 	    $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkarmreg.pp
-	cd arm && ..$(PATHSEP)utils$PATHSEP)mkarmreg$(SRCEXEEXT)
+	cd arm && ..$(PATHSEP)utils$(PATHSEP)mkarmreg$(SRCEXEEXT)
+regdatia64 : ia64/ia64reg.dat
+	    $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkia64reg.pp
+	cd ia64 && ..$(PATHSEP)utils$(PATHSEP)mkia64reg$(SRCEXEEXT)
+regdatsp : sparc/spreg.dat
+	    $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkspreg.pp
+	cd sparc && ..$(PATHSEP)utils$(PATHSEP)mkspreg$(SRCEXEEXT)
 revision.inc :
 ifneq ($(REVSTR),)
 ifdef USEZIPWRAPPER
@@ -3729,10 +3677,12 @@ cycle:
 ifndef CROSSINSTALL
 	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' rtlclean rtl
 ifneq ($(OS_TARGET),embedded)
+ifneq ($(OS_TARGET),gba)
 	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' cycleclean compiler
 endif
 endif
 endif
+endif
 else
 cycle: override FPC=
 cycle:
@@ -3741,9 +3691,9 @@ cycle:
 	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 rtlclean rtl
 	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) PPC_TARGET=$(CPU_TARGET) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
 ifndef CROSSINSTALL
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(OPT) $(CROSSOPT)' rtlclean rtl
+	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(RTLOPT) $(CROSSOPT)' rtlclean rtl
 ifndef NoNativeBinaries
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(OPT) $(CROSSOPT)' cycleclean compiler
+	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(LOCALOPT) $(CROSSOPT)' cycleclean compiler
 endif
 endif
 endif
@@ -3760,7 +3710,7 @@ fullcycle:
 	$(MAKE) $(filter-out $(PPC_TARGET),$(CYCLETARGETS)) 'FPC=$(BASEDIR)/$(EXENAME)'
 htmldocs:
 	$(PASDOC) -p -h -o html$(PATHSEP)$(PPC_TARGET) -d fpc -d gdb -d $(PPC_TARGET) -u $(PPC_TARGET) $(PPC_TARGET)$(PATHSEP)*.pas systems$(PATHSEP)*.pas *.pas
-.PHONY: quickinstall install installsym
+.PHONY: quickinstall exeinstall install installsym
 MSGINSTALLDIR=$(INSTALL_BASEDIR)/msg
 override PPEXEFILE:=$(wildcard $(EXENAME))
 ifdef UNIXHier
@@ -3771,10 +3721,10 @@ endif
 ifndef NoNativeBinaries
 quickinstall: quickinstall_withutils
 else
-quickinstall: quickinstall_base
+quickinstall: exeinstall
 endif
-quickinstall_withutils: $(addsuffix _install,$(TARGET_DIRS)) quickinstall_base
-quickinstall_base:
+quickinstall_withutils: $(addsuffix _install,$(TARGET_DIRS)) exeinstall
+exeinstall:
 ifneq ($(INSTALLEXEFILE),)
 ifdef UPXPROG
 	-$(UPXPROG) $(INSTALLEXEFILE)
@@ -3782,6 +3732,8 @@ endif
 	$(MKDIR) $(PPCCPULOCATION)
 	$(INSTALLEXE) $(INSTALLEXEFILE) $(PPCCPULOCATION)/$(INSTALLEXEFILE)
 endif
+fullinstall:
+	$(MAKE) $(addsuffix _exe_install,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))
 install: quickinstall
 ifndef CROSSINSTALL
 ifdef UNIXHier

compiler/Makefile.fpc

@@ -71,6 +71,9 @@ endif
 ifdef MIPSEL
 PPC_TARGET=mipsel
 endif
+ifdef AVR
+PPC_TARGET=avr
+endif
 ifdef JVM
 PPC_TARGET=jvm
 endif
@@ -157,6 +160,9 @@ endif
 ifeq ($(CPC_TARGET),mipsel)
 CPUSUF=mipsel
 endif
+ifeq ($(CPC_TARGET),avr)
+CPUSUF=avr
+endif
 ifeq ($(CPC_TARGET),jvm)
 CPUSUF=jvm
 endif
@@ -264,7 +270,10 @@ endif
 ifeq ($(CPU_TARGET),jvm)
 NoNativeBinaries=1
 endif
-ifneq ($(OS_TARGET),embedded)
+ifeq ($(OS_TARGET),embedded)
+NoNativeBinaries=1
+endif
+ifeq ($(OS_TARGET),gba)
 NoNativeBinaries=1
 endif
 
@@ -273,10 +282,7 @@ endif
 # Setup Targets
 #####################################################################
 
-ifeq ($(OS_TARGET),win32)
-USE_CMP_FOR_DIFF=1
-endif
-ifeq ($(OS_TARGET),win64)
+ifneq ($(findstring $(OS_TARGET),win32 win64 aix),)
 USE_CMP_FOR_DIFF=1
 endif
 
@@ -286,6 +292,14 @@ override DIFF:=$(CMP) -i218
 endif
 endif
 
+# Use -Sew option by default
+# Allow disabling by setting ALLOW_WARNINGS=1
+ifeq ($(findstring 2.4.,$(FPC_VERSION)),)
+ifndef ALLOW_WARNINGS
+override LOCALOPT+=-Sew
+endif
+endif
+
 # Add Local options
 override COMPILER+=$(LOCALOPT)
 
@@ -336,13 +350,17 @@ endif
 # CPU targets
 #####################################################################
 
-PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64 mips mipsel jvm
+PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64 mips mipsel avr jvm
+INSTALL_TARGETS=$(addsuffix _exe_install,$(sort $(CYCLETARGETS) $(PPC_TARGETS)))
 
-.PHONY: $(PPC_TARGETS)
+.PHONY: $(PPC_TARGETS) $(INSTALL_TARGETS)
 
 $(PPC_TARGETS):
         $(MAKE) PPC_TARGET=$@ CPU_UNITDIR=$@ all
 
+$(INSTALL_TARGETS):
+        $(MAKE) all exeinstall PPC_TARGET=$(subst _exe_install,,$@) CPU_UNITDIR=$(subst _exe_install,,$@)
+
 alltargets: $(ALLTARGETS)
 
 
@@ -435,7 +453,15 @@ insdat: insdatx86 insdatarm
 
 regdatarm : arm/armreg.dat
 	    $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkarmreg.pp
-        cd arm && ..$(PATHSEP)utils$PATHSEP)mkarmreg$(SRCEXEEXT)
+        cd arm && ..$(PATHSEP)utils$(PATHSEP)mkarmreg$(SRCEXEEXT)
+
+regdatia64 : ia64/ia64reg.dat
+            $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkia64reg.pp
+        cd ia64 && ..$(PATHSEP)utils$(PATHSEP)mkia64reg$(SRCEXEEXT)
+
+regdatsp : sparc/spreg.dat
+            $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkspreg.pp
+        cd sparc && ..$(PATHSEP)utils$(PATHSEP)mkspreg$(SRCEXEEXT)
 
 # revision.inc rule
 revision.inc :
@@ -596,9 +622,12 @@ ifndef CROSSINSTALL
         $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' rtlclean rtl
 # building a native compiler for embedded targets is not possible
 ifneq ($(OS_TARGET),embedded)
+# building a native compiler for the arm-gba target is not possible
+ifneq ($(OS_TARGET),gba)
         $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' cycleclean compiler
 endif
 endif
+endif
 
 endif
 
@@ -623,10 +652,10 @@ cycle:
         $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) PPC_TARGET=$(CPU_TARGET) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
 # ppc<ARCH> (target native)
 ifndef CROSSINSTALL
-        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(OPT) $(CROSSOPT)' rtlclean rtl
+        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(RTLOPT) $(CROSSOPT)' rtlclean rtl
 # building a native compiler for JVM and embedded targets is not possible
 ifndef NoNativeBinaries
-        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(OPT) $(CROSSOPT)' cycleclean compiler
+        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(LOCALOPT) $(CROSSOPT)' cycleclean compiler
 endif
 endif
 
@@ -669,7 +698,7 @@ htmldocs:
 # Installation
 #####################################################################
 
-.PHONY: quickinstall install installsym
+.PHONY: quickinstall exeinstall install installsym
 
 MSGINSTALLDIR=$(INSTALL_BASEDIR)/msg
 override PPEXEFILE:=$(wildcard $(EXENAME))
@@ -683,16 +712,16 @@ endif
 ifndef NoNativeBinaries
 quickinstall: quickinstall_withutils
 else
-quickinstall: quickinstall_base
+quickinstall: exeinstall
 endif
 
 # This will only install the ppcXXX executable, not the message files etc.
-quickinstall_withutils: $(addsuffix _install,$(TARGET_DIRS)) quickinstall_base
+quickinstall_withutils: $(addsuffix _install,$(TARGET_DIRS)) exeinstall
 
-quickinstall_base:
 # Install ppcXXX executable, for a cross installation we install
 # the ppcrossXXX as ppcXXX. The target native build ppcXXX is not used
 # for this installation type
+exeinstall:
 ifneq ($(INSTALLEXEFILE),)
 ifdef UPXPROG
         -$(UPXPROG) $(INSTALLEXEFILE)
@@ -701,6 +730,9 @@ endif
         $(INSTALLEXE) $(INSTALLEXEFILE) $(PPCCPULOCATION)/$(INSTALLEXEFILE)
 endif
 
+fullinstall:
+        $(MAKE) $(addsuffix _exe_install,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))
+
 install: quickinstall
 ifndef CROSSINSTALL
 ifdef UNIXHier

compiler/aasmbase.pas

@@ -147,6 +147,11 @@ interface
            TAsmList with loadsym/loadref/const_symbol (PFV) }
          refs       : longint;
        public
+         { on avr the compiler needs to replace cond. jumps with too large offsets
+           so we have to store an offset somewhere to calculate jump distances }
+{$ifdef AVR}
+         offset     : longint;
+{$endif AVR}
          bind       : TAsmsymbind;
          typ        : TAsmsymtype;
          { Alternate symbol which can be used for 'renaming' needed for
@@ -184,6 +189,8 @@ interface
     function EncodeUleb128(a: qword;out buf) : byte;
     function EncodeSleb128(a: int64;out buf) : byte;
 
+    function ReplaceForbiddenAsmSymbolChars(const s: string): string;
+
 
 implementation
 
@@ -323,6 +330,19 @@ implementation
       end;
 
 
+    function ReplaceForbiddenAsmSymbolChars(const s: string): string;
+      var
+        i : longint;
+        rchar: char;
+      begin
+        Result:=s;
+        rchar:=target_asm.dollarsign;
+        for i:=1 to Length(Result) do
+          if Result[i]='$' then
+            Result[i]:=rchar;
+      end;
+
+
 {*****************************************************************************
                                  TAsmSymbol
 *****************************************************************************}

compiler/aasmdata.pas

@@ -138,6 +138,8 @@ interface
       end;
       TAsmCFIClass=class of TAsmCFI;
 
+      { TAsmData }
+
       TAsmData = class
       private
         { Symbols }
@@ -147,6 +149,8 @@ interface
         FNextLabelNr   : array[TAsmLabeltype] of longint;
         { Call Frame Information for stack unwinding}
         FAsmCFI        : TAsmCFI;
+        FConstPools    : array[TConstPoolType] of THashSet;
+        function GetConstPools(APoolType: TConstPoolType): THashSet;
       public
         name,
         realname      : string[80];
@@ -155,8 +159,7 @@ interface
         AsmLists      : array[TAsmListType] of TAsmList;
         CurrAsmList   : TAsmList;
         WideInits     : TLinkedList;
-        { hash tables for reusing constant storage }
-        ConstPools    : array[TConstPoolType] of THashSet;
+        ResStrInits   : TLinkedList;
         constructor create(const n:string);
         destructor  destroy;override;
         { asmsymbol }
@@ -175,13 +178,15 @@ interface
         procedure ResetAltSymbols;
         property AsmSymbolDict:TFPHashObjectList read FAsmSymbolDict;
         property AsmCFI:TAsmCFI read FAsmCFI;
+        { hash tables for reusing constant storage }
+        property ConstPools[APoolType:TConstPoolType]: THashSet read GetConstPools;
       end;
 
       TTCInitItem = class(TLinkedListItem)
         sym: tsym;
         offset: aint;
-        datalabel: TAsmLabel;
-        constructor Create(asym: tsym; aoffset: aint; alabel: TAsmLabel);
+        datalabel: TAsmSymbol;
+        constructor Create(asym: tsym; aoffset: aint; alabel: TAsmSymbol);
       end;
 
     var
@@ -256,7 +261,7 @@ implementation
 *****************************************************************************}
 
 
-    constructor TTCInitItem.Create(asym: tsym; aoffset: aint; alabel: TAsmLabel);
+    constructor TTCInitItem.Create(asym: tsym; aoffset: aint; alabel: TAsmSymbol);
       begin
         inherited Create;
         sym:=asym;
@@ -314,6 +319,17 @@ implementation
                                 TAsmData
 ****************************************************************************}
 
+    function TAsmData.GetConstPools(APoolType: TConstPoolType): THashSet;
+      begin
+        if FConstPools[APoolType] = nil then
+          case APoolType of
+            sp_ansistr: FConstPools[APoolType] := TTagHashSet.Create(64, True, False);
+          else
+            FConstPools[APoolType] := THashSet.Create(64, True, False);
+          end;
+        Result := FConstPools[APoolType];
+      end;
+
     constructor TAsmData.create(const n:string);
       var
         alt : TAsmLabelType;
@@ -334,6 +350,7 @@ implementation
         for hal:=low(TAsmListType) to high(TAsmListType) do
           AsmLists[hal]:=TAsmList.create;
         WideInits :=TLinkedList.create;
+        ResStrInits:=TLinkedList.create;
         { CFI }
         FAsmCFI:=CAsmCFI.Create;
       end;
@@ -365,6 +382,7 @@ implementation
 {$ifdef MEMDEBUG}
          memasmlists.start;
 {$endif}
+        ResStrInits.free;
         WideInits.free;
          for hal:=low(TAsmListType) to high(TAsmListType) do
            AsmLists[hal].free;
@@ -373,7 +391,7 @@ implementation
          memasmlists.stop;
 {$endif}
          for hp := low(TConstPoolType) to high(TConstPoolType) do
-           ConstPools[hp].Free;
+           FConstPools[hp].Free;
       end;
 
 
@@ -386,7 +404,7 @@ implementation
          begin
            { Redefine is allowed, but the types must be the same. The redefine
              is needed for Darwin where the labels are first allocated }
-           if (hp.bind<>AB_EXTERNAL) then
+           if not(hp.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) then
              begin
                if (hp.bind<>_bind) and
                   (hp.typ<>_typ) then
@@ -451,8 +469,8 @@ implementation
 
     procedure TAsmData.getlabel(out l : TAsmLabel;alt:TAsmLabeltype);
       begin
-        if (target_info.system in systems_linux) and
-           (cs_link_smart in current_settings.globalswitches) and
+        if (target_info.system in (systems_linux + systems_bsd)) and
+           (cs_create_smart in current_settings.moduleswitches) and
            (alt = alt_dbgline) then
           l:=TAsmLabel.createglobal(AsmSymbolDict,name,FNextLabelNr[alt],alt)
         else

compiler/aasmtai.pas

@@ -89,6 +89,10 @@ interface
           ait_tempalloc,
           { used to mark assembler blocks and inlined functions }
           ait_marker,
+          { used to describe a new location of a variable }
+          ait_varloc,
+          { SEH directives used in ARM,MIPS and x86_64 COFF targets }
+          ait_seh_directive,
           { JVM only }
           ait_jvar,    { debug information for a local variable }
           ait_jcatch   { exception catch clause }
@@ -178,6 +182,8 @@ interface
           'regalloc',
           'tempalloc',
           'marker',
+          'varloc',
+          'seh_directive',
           'jvar',
           'jcatch'
           );
@@ -226,7 +232,7 @@ interface
           top_none   : ();
           top_reg    : (reg:tregister);
           top_ref    : (ref:preference);
-          top_const  : (val:aint);
+          top_const  : (val:tcgint);
           top_bool   : (b:boolean);
           { local varsym that will be inserted in pass_generate_code }
           top_local  : (localoper:plocaloper);
@@ -256,6 +262,7 @@ interface
       SkipInstr = [ait_comment, ait_symbol,ait_section
                    ,ait_stab, ait_function_name, ait_force_line
                    ,ait_regalloc, ait_tempalloc, ait_symbol_end, ait_directive
+                   ,ait_varloc,ait_seh_directive
                    ,ait_jvar, ait_jcatch];
 
       { ait_* types which do not have line information (and hence which are of type
@@ -263,13 +270,14 @@ interface
       SkipLineInfo =[ait_label,
                      ait_regalloc,ait_tempalloc,
                      ait_stab,ait_function_name,
-                     ait_cutobject,ait_marker,ait_align,ait_section,ait_comment,
+                     ait_cutobject,ait_marker,ait_varloc,ait_align,ait_section,ait_comment,
                      ait_const,ait_directive,
 {$ifdef arm}
                      ait_thumb_func,
 {$endif arm}
                      ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_real_128bit,
                      ait_symbol,
+                     ait_seh_directive,
                      ait_jvar,ait_jcatch
                     ];
 
@@ -287,7 +295,17 @@ interface
 
       TRegAllocType = (ra_alloc,ra_dealloc,ra_sync,ra_resize);
 
-      TStabType = (stab_stabs,stab_stabn,stab_stabd);
+      TStabType = (stab_stabs,stab_stabn,stab_stabd,
+                   { AIX/XCOFF stab types }
+                   stab_stabx,
+                   { begin/end include file }
+                   stabx_bi,stabx_ei,
+                   { begin/end function }
+                   stabx_bf, stabx_ef,
+                   { begin/end static data block }
+                   stabx_bs, stabx_es,
+                   { line spec, function start/end label }
+                   stabx_line, stabx_function);
 
       TAsmDirective=(
         asd_indirect_symbol,
@@ -298,10 +316,25 @@ interface
         asd_jclass,asd_jinterface,asd_jsuper,asd_jfield,asd_jlimit,asd_jline
       );
 
+      TAsmSehDirective=(
+          ash_proc,ash_endproc,
+          ash_endprologue,ash_handler,ash_handlerdata,
+          ash_eh,ash_32,ash_no32,
+          ash_setframe,ash_stackalloc,ash_pushreg,
+          ash_savereg,ash_savexmm,ash_pushframe
+        );
+
+
     const
       regallocstr : array[tregalloctype] of string[10]=('allocated','released','sync','resized');
       tempallocstr : array[boolean] of string[10]=('released','allocated');
-      stabtypestr : array[TStabType] of string[5]=('stabs','stabn','stabd');
+      stabtypestr : array[TStabType] of string[8]=(
+        'stabs','stabn','stabd',
+        'stabx',
+        'bi','ei',
+        'bf','ef',
+        'bs','es',
+        'line','function');
       directivestr : array[TAsmDirective] of string[23]=(
         'indirect_symbol',
         'extern','nasm_import', 'tc', 'reference',
@@ -309,6 +342,13 @@ interface
         { for Jasmin }
         'class','interface','super','field','limit','line'
       );
+      sehdirectivestr : array[TAsmSehDirective] of string[16]=(
+        '.seh_proc','.seh_endproc',
+        '.seh_endprologue','.seh_handler','.seh_handlerdata',
+        '.seh_eh','.seh_32','seh_no32',
+        '.seh_setframe','.seh_stackalloc','.seh_pushreg',
+        '.seh_savereg','.seh_savexmm','.seh_pushframe'
+      );
 
     type
        { abstract assembler item }
@@ -381,10 +421,9 @@ interface
        end;
 
        tai_directive = class(tailineinfo)
-          name : pshortstring;
+          name : ansistring;
           directive : TAsmDirective;
-          constructor Create(_directive:TAsmDirective;const _name:string);
-          destructor Destroy;override;
+          constructor Create(_directive:TAsmDirective;const _name:ansistring);
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
        end;
@@ -420,10 +459,12 @@ interface
           destructor Destroy;override;
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
+{$push}{$warnings off}
          private
           { this constructor is made private on purpose }
           { because sections should be created via new_section() }
-          constructor Create(Asectype:TAsmSectiontype;Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default);
+          constructor Create(Asectype:TAsmSectiontype;const Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default);
+{$pop}
        end;
 
 
@@ -673,6 +714,43 @@ interface
         end;
         tai_align_class = class of tai_align_abstract;
 
+        tai_varloc = class(tai)
+           newlocation,
+           newlocationhi : tregister;
+           varsym : tsym;
+           constructor create(sym : tsym;loc : tregister);
+           constructor create64(sym : tsym;loc,lochi : tregister);
+           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
+           procedure ppuwrite(ppufile:tcompilerppufile);override;
+           procedure buildderefimpl;override;
+           procedure derefimpl;override;
+        end;
+
+        TSehDirectiveDatatype=(sd_none,sd_string,sd_reg,sd_offset,sd_regoffset);
+
+        TSehDirectiveData=record
+        case typ: TSehDirectiveDatatype of
+          sd_none: ();
+          sd_string: (name:pshortstring;flags:byte);
+          sd_reg,sd_offset,sd_regoffset: (reg:TRegister;offset:dword);
+        end;
+
+        tai_seh_directive = class(tai)
+          kind: TAsmSehDirective;
+          data: TSehDirectiveData;
+          constructor create(_kind:TAsmSehDirective);
+          constructor create_name(_kind:TAsmSehDirective;const _name: string);
+          constructor create_reg(_kind:TAsmSehDirective;r:TRegister);
+          constructor create_offset(_kind:TAsmSehDirective;ofs:dword);
+          constructor create_reg_offset(_kind:TAsmSehDirective;r:TRegister;ofs:dword);
+          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
+          destructor destroy;override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure generate_code(objdata:TObjData);virtual;
+          property datatype: TSehDirectiveDatatype read data.typ;
+        end;
+        tai_seh_directive_class=class of tai_seh_directive;
+
         { JVM variable live range description }
         tai_jvar = class(tai)
           stackslot: longint;
@@ -705,12 +783,13 @@ interface
       { target specific tais, possibly overwritten in target specific aasmcpu }
       cai_align : tai_align_class = tai_align_abstract;
       cai_cpu   : tai_cpu_class = tai_cpu_abstract;
+      cai_seh_directive: tai_seh_directive_class = tai_seh_directive;
 
       { hook to notify uses of registers }
       add_reg_instruction_hook : tadd_reg_instruction_proc;
 
     procedure maybe_new_object_file(list:TAsmList);
-    procedure new_section(list:TAsmList;Asectype:TAsmSectiontype;Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default);
+    procedure new_section(list:TAsmList;Asectype:TAsmSectiontype;const Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default);
     procedure section_symbol_start(list:TAsmList;const Aname:string;Asymtyp:Tasmsymtype;
                                    Aglobal:boolean;Asectype:TAsmSectiontype;Aalign:byte);
     procedure section_symbol_end(list:TAsmList;const Aname:string);
@@ -742,7 +821,7 @@ implementation
       end;
 
 
-    procedure new_section(list:TAsmList;Asectype:TAsmSectiontype;Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default);
+    procedure new_section(list:TAsmList;Asectype:TAsmSectiontype;const Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default);
       begin
         list.concat(tai_section.create(Asectype,Aname,Aalign,Asecorder));
         list.concat(cai_align.create(Aalign));
@@ -810,6 +889,50 @@ implementation
       end;
 
 
+    constructor tai_varloc.create(sym: tsym; loc: tregister);
+      begin
+        inherited Create;
+        typ:=ait_varloc;
+        newlocation:=loc;
+        newlocationhi:=NR_NO;
+        varsym:=sym;
+      end;
+
+
+    constructor tai_varloc.create64(sym: tsym; loc: tregister;lochi : tregister);
+      begin
+        inherited Create;
+        typ:=ait_varloc;
+        newlocation:=loc;
+        newlocationhi:=lochi;
+        varsym:=sym;
+      end;
+
+
+    constructor tai_varloc.ppuload(t: taitype; ppufile: tcompilerppufile);
+      begin
+        inherited ppuload(t, ppufile);
+      end;
+
+
+    procedure tai_varloc.ppuwrite(ppufile: tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+      end;
+
+
+    procedure tai_varloc.buildderefimpl;
+      begin
+        inherited buildderefimpl;
+      end;
+
+
+    procedure tai_varloc.derefimpl;
+      begin
+        inherited derefimpl;
+      end;
+
+
 {****************************************************************************
                              TAI
  ****************************************************************************}
@@ -886,7 +1009,7 @@ implementation
                              TAI_SECTION
  ****************************************************************************}
 
-    constructor tai_section.Create(Asectype:TAsmSectiontype;Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default);
+    constructor tai_section.Create(Asectype:TAsmSectiontype;const Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default);
       begin
         inherited Create;
         typ:=ait_section;
@@ -1099,25 +1222,19 @@ implementation
                                TAI_SYMBOL_END
  ****************************************************************************}
 
-    constructor tai_directive.Create(_directive:TAsmDirective;const _name:string);
+    constructor tai_directive.Create(_directive:TAsmDirective;const _name:ansistring);
       begin
          inherited Create;
          typ:=ait_directive;
-         name:=stringdup(_name);
+         name:=_name;
          directive:=_directive;
       end;
 
 
-    destructor tai_directive.Destroy;
-      begin
-        stringdispose(name);
-      end;
-
-
     constructor tai_directive.ppuload(t:taitype;ppufile:tcompilerppufile);
       begin
         inherited ppuload(t,ppufile);
-        name:=stringdup(ppufile.getstring);
+        name:=ppufile.getansistring;
         directive:=TAsmDirective(ppufile.getbyte);
       end;
 
@@ -1125,7 +1242,7 @@ implementation
     procedure tai_directive.ppuwrite(ppufile:tcompilerppufile);
       begin
         inherited ppuwrite(ppufile);
-        ppufile.putstring(name^);
+        ppufile.putansistring(name);
         ppufile.putbyte(byte(directive));
       end;
 
@@ -2487,6 +2604,117 @@ implementation
       end;
 
 
+{****************************************************************************
+                              tai_seh_directive
+ ****************************************************************************}
+
+    const
+      datatypemap: array[TAsmSehDirective] of TSehDirectiveDatatype=(
+        sd_string,     { proc }
+        sd_none,       { endproc }
+        sd_none,       { endprologue }
+        sd_string,     { handler }
+        sd_none,       { handlerdata }
+        sd_none,sd_none,sd_none,  { eh, 32, no32 }
+        sd_regoffset,  { setframe }
+        sd_offset,     { stackalloc }
+        sd_reg,        { pushreg }
+        sd_regoffset,  { savereg }
+        sd_regoffset,  { savexmm }
+        sd_none        { pushframe }
+      );
+
+    constructor tai_seh_directive.create(_kind:TAsmSehDirective);
+      begin
+        inherited Create;
+        typ:=ait_seh_directive;
+        kind:=_kind;
+        data.typ:=datatypemap[_kind];
+      end;
+
+    constructor tai_seh_directive.create_name(_kind:TAsmSehDirective;const _name:string);
+      begin
+        create(_kind);
+        data.name:=stringdup(_name);
+      end;
+
+    constructor tai_seh_directive.create_reg(_kind:TAsmSehDirective;r:TRegister);
+      begin
+        create(_kind);
+        data.reg:=r;
+      end;
+
+    constructor tai_seh_directive.create_offset(_kind:TAsmSehDirective;ofs:dword);
+      begin
+        create(_kind);
+        data.offset:=ofs;
+      end;
+
+    constructor tai_seh_directive.create_reg_offset(_kind:TAsmSehDirective;
+      r:TRegister;ofs:dword);
+      begin
+        create(_kind);
+        data.offset:=ofs;
+        data.reg:=r;
+      end;
+
+    constructor tai_seh_directive.ppuload(t:taitype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t, ppufile);
+        kind:=TAsmSehDirective(ppufile.getbyte);
+        data.typ:=datatypemap[kind];
+        case data.typ of
+          sd_none: ;
+          sd_string:
+            begin
+              data.name:=stringdup(ppufile.getstring);
+              data.flags:=ppufile.getbyte;
+            end;
+
+          sd_reg,sd_offset,sd_regoffset:
+            begin
+              ppufile.getdata(data.reg,sizeof(TRegister));
+              data.offset:=ppufile.getdword;
+            end;
+        else
+          InternalError(2011091201);
+        end;
+      end;
+
+    destructor tai_seh_directive.destroy;
+      begin
+        if data.typ=sd_string then
+          stringdispose(data.name);
+        inherited destroy;
+      end;
+
+    procedure tai_seh_directive.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putbyte(ord(kind));
+        case data.typ of
+          sd_none: ;
+          sd_string:
+            begin
+              ppufile.putstring(data.name^);
+              ppufile.putbyte(data.flags);
+            end;
+
+          sd_reg,sd_offset,sd_regoffset:
+            begin
+              ppufile.putdata(data.reg,sizeof(TRegister));
+              ppufile.putdword(data.offset);
+            end;
+        else
+          InternalError(2011091202);
+        end;
+      end;
+
+    procedure tai_seh_directive.generate_code(objdata:TObjData);
+      begin
+      end;
+
+
 {****************************************************************************
                               tai_jvar
  ****************************************************************************}
@@ -2529,9 +2757,9 @@ implementation
       end;
 
 
-    {****************************************************************************
-                                  tai_jvar
-     ****************************************************************************}
+{****************************************************************************
+                              tai_jcatch
+ ****************************************************************************}
 
     constructor tai_jcatch.Create(const _name: shortstring; _startlab, _stoplab, _handlerlab: TAsmSymbol);
       begin
@@ -2576,4 +2804,11 @@ implementation
         ppufile.putasmsymbol(handlerlab);
       end;
 
+
+begin
+{$push}{$warnings off}
+  { taitype should fit into a 4 byte set for speed reasons }
+  if ord(high(taitype))>31 then
+    internalerror(201108181);
+{$pop}
 end.

compiler/aggas.pas

@@ -46,10 +46,15 @@ interface
       protected
         function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;virtual;
         function sectionattrs_coff(atype:TAsmSectiontype):string;virtual;
-        procedure WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder);
+        function sectionalignment_aix(atype:TAsmSectiontype;secalign: byte):string;
+        procedure WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder;secalign:byte);
         procedure WriteExtraHeader;virtual;
+        procedure WriteExtraFooter;virtual;
         procedure WriteInstruction(hp: tai);
         procedure WriteWeakSymbolDef(s: tasmsymbol); virtual;
+        procedure WriteAixStringConst(hp: tai_string);
+        procedure WriteAixIntConst(hp: tai_const);
+        procedure WriteDirectiveName(dir: TAsmDirective); virtual;
        public
         function MakeCmdLine: TCmdStr; override;
         procedure WriteTree(p:TAsmList);override;
@@ -94,9 +99,6 @@ interface
        end;
 
 
-     function ReplaceForbiddenChars(const s: string): string;
-
-
 implementation
 
     uses
@@ -201,17 +203,6 @@ implementation
         #9'.rva'#9,#9'.secrel32'#9,#9'.quad'#9,#9'.long'#9,#9'.short'#9
       );
 
-    function ReplaceForbiddenChars(const s: string): string;
-      var
-      i : longint;
-      begin
-        Result:=s;
-        for i:=1 to Length(Result) do
-          if Result[i]='$' then
-            Result[i]:='s';
-      end;
-
-
 {****************************************************************************}
 {                          GNU Assembler writer                              }
 {****************************************************************************}
@@ -404,7 +395,7 @@ implementation
           end;
 
         if (atype=sec_threadvar) and
-          (target_info.system=system_i386_win32) then
+          (target_info.system in (systems_windows+systems_wince)) then
           secname:='.tls';
 
         { go32v2 stub only loads .text and .data sections, and allocates space for .bss.
@@ -474,7 +465,23 @@ implementation
       end;
 
 
-    procedure TGNUAssembler.WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder);
+    function TGNUAssembler.sectionalignment_aix(atype:TAsmSectiontype;secalign: byte): string;
+      var
+        l: longint;
+      begin
+        if (secalign=0) or
+           not(atype in [sec_code,sec_bss,sec_rodata_norel]) then
+          begin
+            result:='';
+            exit;
+          end;
+        if not ispowerof2(secalign,l) then
+          internalerror(2012022201);
+        result:=tostr(l);
+      end;
+
+
+    procedure TGNUAssembler.WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder;secalign:byte);
       var
         s : string;
       begin
@@ -489,7 +496,9 @@ implementation
          system_i386_iphonesim,
          system_powerpc64_darwin,
          system_x86_64_darwin,
-         system_arm_darwin:
+         system_arm_darwin,
+         system_powerpc_aix,
+         system_powerpc64_aix:
            begin
              if (atype in [sec_stub,sec_objc_data,sec_objc_const,sec_data_coalesced]) then
                AsmWrite('.section ');
@@ -541,7 +550,13 @@ implementation
               s:=sectionattrs_coff(atype);
               if (s<>'') then
                 AsmWrite(',"'+s+'"');
-            end;
+            end
+         else if target_info.system in systems_aix then
+           begin
+             s:=sectionalignment_aix(atype,secalign);
+             if s<>'' then
+               AsmWrite(','+s);
+           end;
         end;
         AsmLn;
         LastSecType:=atype;
@@ -589,10 +604,10 @@ implementation
                   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;
@@ -600,7 +615,7 @@ implementation
           last_align:=alignment;
           if alignment>1 then
             begin
-              if not(target_info.system in systems_darwin) then
+              if not(target_info.system in (systems_darwin+systems_aix)) then
                 begin
                   AsmWrite(#9'.balign '+tostr(alignment));
                   if use_op then
@@ -613,7 +628,7 @@ implementation
                 end
               else
                 begin
-                  { darwin as only supports .align }
+                  { darwin and aix as only support .align }
                   if not ispowerof2(alignment,i) then
                     internalerror(2003010305);
                   AsmWrite(#9'.align '+tostr(i));
@@ -640,9 +655,11 @@ implementation
       do_line  : boolean;
 
       sepChar : char;
+      replaceforbidden: boolean;
     begin
       if not assigned(p) then
        exit;
+      replaceforbidden:=target_asm.dollarsign<>'$';
 
       last_align := 2;
       InlineLevel:=0;
@@ -704,7 +721,10 @@ implementation
            ait_section :
              begin
                if tai_section(hp).sectype<>sec_none then
-                 WriteSection(tai_section(hp).sectype,tai_section(hp).name^,tai_section(hp).secorder)
+                 if replaceforbidden then
+                   WriteSection(tai_section(hp).sectype,ReplaceForbiddenAsmSymbolChars(tai_section(hp).name^),tai_section(hp).secorder,tai_section(hp).secalign)
+                 else
+                   WriteSection(tai_section(hp).sectype,tai_section(hp).name^,tai_section(hp).secorder,tai_section(hp).secalign)
                else
                  begin
 {$ifdef EXTDEBUG}
@@ -733,7 +753,7 @@ implementation
                        asmwrite(tai_datablock(hp).sym.name);
                        asmwriteln(', '+tostr(tai_datablock(hp).size)+','+tostr(last_align));
                        if not(LastSecType in [sec_data,sec_none]) then
-                         writesection(LastSecType,'',secorder_default);
+                         writesection(LastSecType,'',secorder_default,last_align);
                      end
                    else
                      begin
@@ -744,6 +764,28 @@ implementation
                        asmln;
                      end;
                  end
+               else if target_info.system in systems_aix then
+                 begin
+                   if tai_datablock(hp).is_global then
+                     begin
+                       asmwrite(#9'.globl ');
+                       asmwriteln(ReplaceForbiddenAsmSymbolChars(tai_datablock(hp).sym.name));
+                       asmwrite(ReplaceForbiddenAsmSymbolChars(tai_datablock(hp).sym.name));
+                       asmwriteln(':');
+                       asmwrite(#9'.space ');
+                       asmwriteln(tostr(tai_datablock(hp).size));
+                       if not(LastSecType in [sec_data,sec_none]) then
+                         writesection(LastSecType,'',secorder_default,last_align);
+                     end
+                   else
+                     begin
+                       asmwrite(#9'.lcomm ');
+                       asmwrite(ReplaceForbiddenAsmSymbolChars(tai_datablock(hp).sym.name));
+                       asmwrite(',_data.bss_[RW],');
+                       asmwrite(tostr(tai_datablock(hp).size)+',');
+                       asmwriteln(tostr(last_align));
+                     end;
+                 end
                else
                  begin
 {$ifdef USE_COMM_IN_BSS}
@@ -756,7 +798,10 @@ implementation
                        if tai_datablock(hp).is_global then
                          begin
                            asmwrite(#9'.comm'#9);
-                           asmwrite(tai_datablock(hp).sym.name);
+                           if replaceforbidden then
+                             asmwrite(ReplaceForbiddenAsmSymbolChars(tai_datablock(hp).sym.name))
+                           else
+                             asmwrite(tai_datablock(hp).sym.name);
                            asmwrite(','+tostr(tai_datablock(hp).size));
                            asmwrite(','+tostr(last_align));
                            asmln;
@@ -764,7 +809,10 @@ implementation
                        else
                          begin
                            asmwrite(#9'.lcomm'#9);
-                           asmwrite(tai_datablock(hp).sym.name);
+                           if replaceforbidden then
+                             asmwrite(ReplaceForbiddenAsmSymbolChars(tai_datablock(hp).sym.name));
+                           else
+                             asmwrite(tai_datablock(hp).sym.name);
                            asmwrite(','+tostr(tai_datablock(hp).size));
                            asmwrite(','+tostr(last_align));
                            asmln;
@@ -776,17 +824,31 @@ implementation
                        if Tai_datablock(hp).is_global then
                          begin
                            asmwrite(#9'.globl ');
-                           asmwriteln(Tai_datablock(hp).sym.name);
+                           if replaceforbidden then
+                             asmwriteln(ReplaceForbiddenAsmSymbolChars(Tai_datablock(hp).sym.name))
+                           else
+                             asmwriteln(Tai_datablock(hp).sym.name);
                          end;
                        if (target_info.system <> system_arm_linux) then
                          sepChar := '@'
                        else
                          sepChar := '%';
-                       if (tf_needs_symbol_type in target_info.flags) then
-                         asmwriteln(#9'.type '+Tai_datablock(hp).sym.name+','+sepChar+'object');
-                       if (tf_needs_symbol_size in target_info.flags) and (tai_datablock(hp).size > 0) then
-                         asmwriteln(#9'.size '+Tai_datablock(hp).sym.name+','+tostr(Tai_datablock(hp).size));
-                       asmwrite(Tai_datablock(hp).sym.name);
+                       if replaceforbidden then
+                         begin
+                           if (tf_needs_symbol_type in target_info.flags) then
+                             asmwriteln(#9'.type '+ReplaceForbiddenAsmSymbolChars(Tai_datablock(hp).sym.name)+','+sepChar+'object');
+                           if (tf_needs_symbol_size in target_info.flags) and (tai_datablock(hp).size > 0) then
+                              asmwriteln(#9'.size '+ReplaceForbiddenAsmSymbolChars(Tai_datablock(hp).sym.name)+','+tostr(Tai_datablock(hp).size));
+                           asmwrite(ReplaceForbiddenAsmSymbolChars(Tai_datablock(hp).sym.name))
+                         end
+                       else
+                         begin
+                           if (tf_needs_symbol_type in target_info.flags) then
+                             asmwriteln(#9'.type '+Tai_datablock(hp).sym.name+','+sepChar+'object');
+                           if (tf_needs_symbol_size in target_info.flags) and (tai_datablock(hp).size > 0) then
+                             asmwriteln(#9'.size '+Tai_datablock(hp).sym.name+','+tostr(Tai_datablock(hp).size));
+                           asmwrite(Tai_datablock(hp).sym.name);
+                         end;
                        asmwriteln(':');
                        asmwriteln(#9'.zero '+tostr(Tai_datablock(hp).size));
                      end;
@@ -807,19 +869,24 @@ implementation
                     begin
                       if assigned(tai_const(hp).sym) then
                         internalerror(200404292);
-                      AsmWrite(ait_const2str[aitconst_32bit]);
-                      if target_info.endian = endian_little then
+                      if not(target_info.system in systems_aix) then
                         begin
-                          AsmWrite(tostr(longint(lo(tai_const(hp).value))));
-                          AsmWrite(',');
-                          AsmWrite(tostr(longint(hi(tai_const(hp).value))));
+                          AsmWrite(ait_const2str[aitconst_32bit]);
+                          if target_info.endian = endian_little then
+                            begin
+                              AsmWrite(tostr(longint(lo(tai_const(hp).value))));
+                              AsmWrite(',');
+                              AsmWrite(tostr(longint(hi(tai_const(hp).value))));
+                            end
+                          else
+                            begin
+                              AsmWrite(tostr(longint(hi(tai_const(hp).value))));
+                              AsmWrite(',');
+                              AsmWrite(tostr(longint(lo(tai_const(hp).value))));
+                            end;
                         end
                       else
-                        begin
-                          AsmWrite(tostr(longint(hi(tai_const(hp).value))));
-                          AsmWrite(',');
-                          AsmWrite(tostr(longint(lo(tai_const(hp).value))));
-                        end;
+                        WriteAixIntConst(tai_const(hp));
                       AsmLn;
                     end;
 {$endif cpu64bitaddr}
@@ -838,7 +905,19 @@ implementation
                  aitconst_darwin_dwarf_delta64,
                  aitconst_half16bit:
                    begin
-                     if (target_info.system in systems_darwin) and
+                     { the AIX assembler (and for compatibility, the GNU
+                       assembler when targeting AIX) automatically aligns
+                       .short/.long/.llong to a multiple of 2/4/8 bytes. We
+                       don't want that, since this may be data inside a packed
+                       record -> use .vbyte instead (byte stream of fixed
+                       length) }
+                     if (target_info.system in systems_aix) and
+                        (constdef in [aitconst_128bit,aitconst_64bit,aitconst_32bit,aitconst_16bit]) and
+                        not assigned(tai_const(hp).sym) then
+                       begin
+                         WriteAixIntConst(tai_const(hp));
+                       end
+                     else if (target_info.system in systems_darwin) and
                         (constdef in [aitconst_uleb128bit,aitconst_sleb128bit]) then
                        begin
                          AsmWrite(ait_const2str[aitconst_8bit]);
@@ -869,9 +948,8 @@ implementation
                                   end
                                else
                                  s:=tai_const(hp).sym.name;
-{$ifdef avr}
-                               s:=ReplaceForbiddenChars(s);
-{$endif avr}
+                               if replaceforbidden then
+                                 s:=ReplaceForbiddenAsmSymbolChars(s);
                                if tai_const(hp).value<>0 then
                                  s:=s+tostr_with_plus(tai_const(hp).value);
                              end
@@ -1013,31 +1091,36 @@ implementation
            ait_string :
              begin
                pos:=0;
-               for i:=1 to tai_string(hp).len do
-                begin
-                  if pos=0 then
-                   begin
-                     AsmWrite(#9'.ascii'#9'"');
-                     pos:=20;
-                   end;
-                  ch:=tai_string(hp).str[i-1];
-                  case ch of
-                     #0, {This can't be done by range, because a bug in FPC}
-                #1..#31,
-             #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
-                    '"' : s:='\"';
-                    '\' : s:='\\';
-                  else
-                   s:=ch;
-                  end;
-                  AsmWrite(s);
-                  inc(pos,length(s));
-                  if (pos>line_length) or (i=tai_string(hp).len) then
-                   begin
-                     AsmWriteLn('"');
-                     pos:=0;
-                   end;
-                end;
+               if not(target_info.system in systems_aix) then
+                 begin
+                   for i:=1 to tai_string(hp).len do
+                    begin
+                      if pos=0 then
+                       begin
+                         AsmWrite(#9'.ascii'#9'"');
+                         pos:=20;
+                       end;
+                      ch:=tai_string(hp).str[i-1];
+                      case ch of
+                                #0, {This can't be done by range, because a bug in FPC}
+                           #1..#31,
+                        #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
+                               '"' : s:='\"';
+                               '\' : s:='\\';
+                      else
+                        s:=ch;
+                      end;
+                      AsmWrite(s);
+                      inc(pos,length(s));
+                      if (pos>line_length) or (i=tai_string(hp).len) then
+                       begin
+                         AsmWriteLn('"');
+                         pos:=0;
+                       end;
+                    end;
+                 end
+               else
+                 WriteAixStringConst(tai_string(hp));
              end;
 
            ait_label :
@@ -1052,17 +1135,15 @@ implementation
                   if tai_label(hp).labsym.bind in [AB_GLOBAL,AB_PRIVATE_EXTERN] then
                    begin
                      AsmWrite('.globl'#9);
-{$ifdef avr}
-                     AsmWriteLn(ReplaceForbiddenChars(tai_label(hp).labsym.name));
-{$else avr}
-                     AsmWriteLn(tai_label(hp).labsym.name);
-{$endif avr}
+                     if replaceforbidden then
+                       AsmWriteLn(ReplaceForbiddenAsmSymbolChars(tai_label(hp).labsym.name))
+                     else
+                       AsmWriteLn(tai_label(hp).labsym.name);
                    end;
-{$ifdef avr}
-                  AsmWrite(ReplaceForbiddenChars(tai_label(hp).labsym.name));
-{$else avr}
-                  AsmWrite(tai_label(hp).labsym.name);
-{$endif avr}
+                  if replaceforbidden then
+                    AsmWrite(ReplaceForbiddenAsmSymbolChars(tai_label(hp).labsym.name))
+                  else
+                    AsmWrite(tai_label(hp).labsym.name);
                   AsmWriteLn(':');
                 end;
              end;
@@ -1072,11 +1153,10 @@ implementation
                if (tai_symbol(hp).sym.bind=AB_PRIVATE_EXTERN) then
                  begin
                    AsmWrite(#9'.private_extern ');
-{$ifdef avr}
-                   AsmWriteln(ReplaceForbiddenChars(tai_symbol(hp).sym.name));
-{$else avr}
-                   AsmWriteln(tai_symbol(hp).sym.name);
-{$endif avr}
+                   if replaceforbidden then
+                     AsmWriteln(ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name))
+                   else
+                     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
@@ -1085,11 +1165,10 @@ implementation
                if tai_symbol(hp).is_global then
                 begin
                   AsmWrite('.globl'#9);
-{$ifdef avr}
-                  AsmWriteln(ReplaceForbiddenChars(tai_symbol(hp).sym.name));
-{$else avr}
-                  AsmWriteln(tai_symbol(hp).sym.name);
-{$endif avr}
+                  if replaceforbidden then
+                    AsmWriteln(ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name))
+                  else
+                    AsmWriteln(tai_symbol(hp).sym.name);
                 end;
                if (target_info.system = system_powerpc64_linux) and
                  (tai_symbol(hp).sym.typ = AT_FUNCTION) then
@@ -1106,6 +1185,30 @@ implementation
                    { the dotted name is the name of the actual function entry }
                    AsmWrite('.');
                  end
+               else if (target_info.system in systems_aix) and
+                  (tai_symbol(hp).sym.typ = AT_FUNCTION) then
+                 begin
+                   if target_info.system=system_powerpc_aix then
+                     begin
+                       s:=#9'.long .';
+                       ch:='2';
+                     end
+                   else
+                     begin
+                       s:=#9'.llong .';
+                       ch:='3';
+                     end;
+                   AsmWriteLn(#9'.csect '+ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name)+'[DS],'+ch);
+                   AsmWriteLn(ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name)+':');
+                   AsmWriteln(s+ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name)+', TOC[tc0], 0');
+                   AsmWriteln(#9'.csect .text[PR]');
+                   if (tai_symbol(hp).is_global) then
+                     AsmWriteLn('.globl .'+ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name))
+                   else
+                     AsmWriteLn('.lglobl .'+ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name));
+                   { the dotted name is the name of the actual function entry }
+                   AsmWrite('.');
+                 end
                else
                  begin
                    if (target_info.system <> system_arm_linux) then
@@ -1121,17 +1224,15 @@ implementation
                          AsmWriteLn(',' + sepChar + 'function');
                      end;
                  end;
-{$ifdef avr}
-               if not(tai_symbol(hp).has_value) then
-                 AsmWriteLn(ReplaceForbiddenChars(tai_symbol(hp).sym.name + ':'))
-               else
-                 AsmWriteLn(ReplaceForbiddenChars(tai_symbol(hp).sym.name + '=' + tostr(tai_symbol(hp).value)));
-{$else avr}
-               if not(tai_symbol(hp).has_value) then
+               if replaceforbidden then
+                 if not(tai_symbol(hp).has_value) then
+                   AsmWriteLn(ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name + ':'))
+                 else
+                   AsmWriteLn(ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name + '=' + tostr(tai_symbol(hp).value)))
+               else 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));
-{$endif avr}
              end;
 {$ifdef arm}
            ait_thumb_func:
@@ -1150,19 +1251,17 @@ implementation
                   AsmWrite(#9'.size'#9);
                   if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
                     AsmWrite('.');
-{$ifdef avr}
-                  AsmWrite(ReplaceForbiddenChars(tai_symbol_end(hp).sym.name));
-{$else avr}
-                  AsmWrite(tai_symbol_end(hp).sym.name);
-{$endif avr}
+                  if replaceforbidden then
+                    AsmWrite(ReplaceForbiddenAsmSymbolChars(tai_symbol_end(hp).sym.name))
+                  else
+                    AsmWrite(tai_symbol_end(hp).sym.name);
                   AsmWrite(', '+s+' - ');
                   if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
                      AsmWrite('.');
-{$ifdef avr}
-                  AsmWriteLn(ReplaceForbiddenChars(tai_symbol_end(hp).sym.name));
-{$else avr}
-                  AsmWriteLn(tai_symbol_end(hp).sym.name);
-{$endif avr}
+                  if replaceforbidden then
+                    AsmWriteLn(ReplaceForbiddenAsmSymbolChars(tai_symbol_end(hp).sym.name))
+                  else
+                    AsmWriteLn(tai_symbol_end(hp).sym.name);
                 end;
              end;
 
@@ -1206,7 +1305,7 @@ implementation
                      hp:=tai(hp.next);
                    end;
                   if LastSecType<>sec_none then
-                    WriteSection(LastSecType,'',secorder_default);
+                    WriteSection(LastSecType,'',secorder_default,last_align);
                   AsmStartSize:=AsmSize;
                 end;
              end;
@@ -1219,12 +1318,47 @@ implementation
 
            ait_directive :
              begin
-               AsmWrite('.'+directivestr[tai_directive(hp).directive]+' ');
-               if assigned(tai_directive(hp).name) then
-                 AsmWrite(tai_directive(hp).name^);
+               WriteDirectiveName(tai_directive(hp).directive);
+               if tai_directive(hp).name <>'' then
+                 AsmWrite(tai_directive(hp).name);
                AsmLn;
              end;
 
+           ait_seh_directive :
+             begin
+{$ifdef TEST_WIN64_SEH}
+               AsmWrite(sehdirectivestr[tai_seh_directive(hp).kind]);
+               case tai_seh_directive(hp).datatype of
+                 sd_none:;
+                 sd_string:
+                   begin
+                     AsmWrite(' '+tai_seh_directive(hp).data.name^);
+                     if (tai_seh_directive(hp).data.flags and 1)<>0 then
+                       AsmWrite(',@except');
+                     if (tai_seh_directive(hp).data.flags and 2)<>0 then
+                       AsmWrite(',@unwind');
+                   end;
+                 sd_reg:
+                   AsmWrite(' '+gas_regname(tai_seh_directive(hp).data.reg));
+                 sd_offset:
+                   AsmWrite(' '+tostr(tai_seh_directive(hp).data.offset));
+                 sd_regoffset:
+                   AsmWrite(' '+gas_regname(tai_seh_directive(hp).data.reg)+', '+
+                     tostr(tai_seh_directive(hp).data.offset));
+               end;
+               AsmLn;
+{$endif TEST_WIN64_SEH}
+             end;
+           ait_varloc:
+             begin
+               if tai_varloc(hp).newlocationhi<>NR_NO then
+                 AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
+                   std_regname(tai_varloc(hp).newlocationhi)+':'+std_regname(tai_varloc(hp).newlocation)))
+               else
+                 AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
+                   std_regname(tai_varloc(hp).newlocation)));
+               AsmLn;
+             end;
            else
              internalerror(2006012201);
          end;
@@ -1238,6 +1372,11 @@ implementation
       end;
 
 
+    procedure TGNUAssembler.WriteExtraFooter;
+      begin
+      end;
+
+
     procedure TGNUAssembler.WriteInstruction(hp: tai);
       begin
         InstrWriter.WriteInstruction(hp);
@@ -1250,6 +1389,119 @@ implementation
       end;
 
 
+    procedure TGNUAssembler.WriteAixStringConst(hp: tai_string);
+      type
+        tterminationkind = (term_none,term_string,term_nostring);
+
+      var
+        i: longint;
+        pos: longint;
+        s: string;
+        ch: char;
+        instring: boolean;
+
+      procedure newstatement(terminationkind: tterminationkind);
+        begin
+          case terminationkind of
+            term_none: ;
+            term_string:
+              AsmWriteLn('"');
+            term_nostring:
+              AsmLn;
+          end;
+          AsmWrite(#9'.byte'#9);
+          pos:=20;
+          instring:=false;
+        end;
+
+      begin
+        pos:=0;
+        for i:=1 to hp.len do
+          begin
+            if pos=0 then
+              newstatement(term_none);
+            ch:=hp.str[i-1];
+            case ch of
+              #0..#31,
+              #127..#255 :
+                begin
+                  if instring then
+                    newstatement(term_string);
+                  if pos=20 then
+                    s:=tostr(ord(ch))
+                  else
+                    s:=', '+tostr(ord(ch))
+                end;
+              '"' :
+                if instring then
+                  s:='""'
+                else
+                  begin
+                    if pos<>20 then
+                      newstatement(term_nostring);
+                    s:='"""';
+                    instring:=true;
+                  end;
+              else
+                if not instring then
+                  begin
+                    if (pos<>20) then
+                      newstatement(term_nostring);
+                    s:='"'+ch;
+                    instring:=true;
+                  end
+                else
+                  s:=ch;
+            end;
+            AsmWrite(s);
+            inc(pos,length(s));
+            if (pos>line_length) or (i=tai_string(hp).len) then
+              begin
+                if instring then
+                  AsmWriteLn('"')
+                else
+                  AsmLn;
+                pos:=0;
+              end;
+         end;
+      end;
+
+
+    procedure TGNUAssembler.WriteAixIntConst(hp: tai_const);
+      var
+        pos, size: longint;
+      begin
+        { only big endian AIX supported for now }
+        if target_info.endian<>endian_big then
+          internalerror(2012010401);
+        { limitation: can only write 4 bytes at a time }
+        pos:=0;
+        size:=tai_const(hp).size;
+        while pos<(size-4) do
+          begin
+            AsmWrite(#9'.vbyte'#9'4, ');
+            AsmWriteln(tostr(longint(tai_const(hp).value shr ((size-pos-4)*8))));
+            inc(pos,4);
+         end;
+        AsmWrite(#9'.vbyte'#9);
+        AsmWrite(tostr(size-pos));
+        AsmWrite(', ');
+        case size-pos of
+          1: AsmWrite(tostr(byte(tai_const(hp).value)));
+          2: AsmWrite(tostr(word(tai_const(hp).value)));
+          4: AsmWrite(tostr(longint(tai_const(hp).value)));
+          else
+            internalerror(2012010402);
+        end;
+      end;
+
+
+    procedure TGNUAssembler.WriteDirectiveName(dir: TAsmDirective);
+    begin
+      AsmWrite('.'+directivestr[dir]+' ');
+    end;
+
+
     procedure TGNUAssembler.WriteAsmList;
     var
       n : string;
@@ -1266,7 +1518,7 @@ implementation
       else
         n:=InputFileName;
 
-      { gcc does not add it either for Darwin (and AIX). Grep for
+      { gcc does not add it either for Darwin. Grep for
         TARGET_ASM_FILE_START_FILE_DIRECTIVE in gcc/config/*.h
       }
       if not(target_info.system in systems_darwin) then

compiler/agjasmin.pas

@@ -482,8 +482,8 @@ implementation
              ait_directive :
                begin
                  AsmWrite('.'+directivestr[tai_directive(hp).directive]+' ');
-                 if assigned(tai_directive(hp).name) then
-                   AsmWrite(tai_directive(hp).name^);
+                 if tai_directive(hp).name<>'' then
+                   AsmWrite(tai_directive(hp).name);
                  AsmLn;
                end;
 

compiler/alpha/aoptcpub.pas

@@ -26,10 +26,7 @@ Unit aoptcpub; { Assembler OPTimizer CPU specific Base }
 { enable the following define if memory references can have both a base and }
 { index register in 1 operand                                               }
 
-{$define RefsHaveIndexReg}
-
 { enable the following define if memory references can have a scaled index }
-
 {$define RefsHaveScale}
 
 { enable the following define if memory references can have a segment }

compiler/alpha/cpuinfo.pas

@@ -56,7 +56,7 @@ Const
    { Size of native extended type }
    extended_size = 16;
    {# Size of a pointer                           }
-   sizeof(aint)  = 8;
+   aint_size  = 8;
    {# Size of a multimedia register               }
    mmreg_size = 8;
 

compiler/aopt.pas

@@ -51,8 +51,10 @@ Unit aopt;
 
     var
       casmoptimizer : TAsmOptimizerClass;
+      cpreregallocscheduler : TAsmOptimizerClass;
 
     procedure Optimize(AsmL:TAsmList);
+    procedure PreRegallocSchedule(AsmL:TAsmList);
 
   Implementation
 
@@ -274,4 +276,14 @@ Unit aopt;
       end;
 
 
+    procedure PreRegallocSchedule(AsmL:TAsmList);
+      var
+        p : TAsmOptimizer;
+      begin
+        p:=cpreregallocscheduler.Create(AsmL);
+        p.Optimize;
+        p.free
+      end;
+
+
 end.

compiler/aoptbase.pas

@@ -53,6 +53,8 @@ unit aoptbase;
         { returns true if register Reg is used in the reference Ref }
         Function RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
 
+        function RegModifiedByInstruction(Reg: TRegister; p1: tai): boolean;virtual;
+
         { returns true if the references are completely equal }
         {Function RefsEqual(Const R1, R2: TReference): Boolean;}
 
@@ -113,11 +115,11 @@ unit aoptbase;
     Begin
       TmpResult := False;
       Count := 0;
-      If (p1.typ = ait_instruction) Then
+      If (p1.typ = ait_instruction) and assigned(TInstr(p1).oper[0]) Then
         Repeat
-          TmpResult := RegInOp(Reg, PInstr(p1)^.oper[Count]^);
+          TmpResult := RegInOp(Reg, TInstr(p1).oper[Count]^);
           Inc(Count)
-        Until (Count = MaxOps) or TmpResult;
+        Until (TInstr(p1).oper[Count]=nil) or (Count = MaxOps) or TmpResult;
       RegInInstruction := TmpResult
     End;
 
@@ -136,9 +138,14 @@ unit aoptbase;
   Begin
     Reg := RegMaxSize(Reg);
     RegInRef := (Ref.Base = Reg)
-  {$ifdef RefsHaveIndexReg}
+  {$ifdef cpurefshaveindexreg}
     Or (Ref.Index = Reg)
-  {$endif RefsHaveIndexReg}
+  {$endif cpurefshaveindexreg}
+  End;
+
+  Function TAOptBase.RegModifiedByInstruction(Reg: TRegister; p1: tai): Boolean;
+  Begin
+    Result:=true;
   End;
 
   function labelCanBeSkipped(p: tai_label): boolean;

compiler/aoptcs.pas

@@ -126,10 +126,10 @@ Begin
       Begin
         If OldOp.ref^.base <> R_NO Then
           AddReg(OldOp.ref^.base, NewOp.ref^.base);
-{$ifdef RefsHaveIndexReg}
+{$ifdef cpurefshaveindexreg}
         If OldOp.ref^.index <> R_NO Then
           AddReg(OldOp.ref^.index, NewOp.ref^.index);
-{$endif RefsHaveIndexReg}
+{$endif cpurefshaveindexreg}
       End;
   End;
 End;
@@ -184,9 +184,9 @@ Begin
     RefsEquivalent := (OldRef.Offset+OldRef.OffsetFixup =
                          NewRef.Offset+NewRef.OffsetFixup) And
                       RegsEquivalent(OldRef.Base, NewRef.Base, OpAct)
-{$ifdef RefsHaveindexReg}
+{$ifdef cpurefshaveindexreg}
                       And RegsEquivalent(OldRef.Index, NewRef.Index, OpAct)
-{$endif RefsHaveIndexReg}
+{$endif cpurefshaveindexreg}
 {$ifdef RefsHaveScale}
                       And (OldRef.ScaleFactor = NewRef.ScaleFactor)
 {$endif RefsHaveScale}
@@ -252,10 +252,10 @@ Begin
                     If Not(Base in [ProcInfo.FramePointer, R_NO, STACK_POINTER_REG])
 { it won't do any harm if the register is already in RegsLoadedForRef }
                       Then RegsLoadedForRef := RegsLoadedForRef + [Base];
-{$ifdef RefsHaveIndexReg}
+{$ifdef cpurefshaveindexreg}
                     If Not(Index in [ProcInfo.FramePointer, R_NO, STACK_POINTER_REG])
                       Then RegsLoadedForRef := RegsLoadedForRef + [Index];
-{$endif RefsHaveIndexReg}
+{$endif cpurefshaveindexreg}
                   End;
 { add the registers from the reference (.oper[Src]) to the RegInfo, all }
 { registers from the reference are the same in the old and in the new   }
@@ -290,7 +290,7 @@ Begin
                       Writeln(std_reg2str[base], ' added');
 {$endif csdebug}
                     end;
-{$Ifdef RefsHaveIndexReg}
+{$Ifdef cpurefshaveindexreg}
                 If Not(Index in [ProcInfo.FramePointer,
                                  RegMaxSize(PInstr(NewP)^.oper[LoadDst].reg),
                                  R_NO,StackPtr])
@@ -301,7 +301,7 @@ Begin
                       Writeln(std_reg2str[index], ' added');
 {$endif csdebug}
                     end;
-{$endif RefsHaveIndexReg}
+{$endif cpurefshaveindexreg}
               End;
 
 { now, remove the destination register of the load from the                 }

compiler/aoptobj.pas

@@ -399,9 +399,9 @@ Unit AoptObj;
             If IsLoadMemReg(p) Then
               With PInstr(p)^.oper[LoadSrc]^.ref^ Do
                 If (Base = ProcInfo.FramePointer)
-      {$ifdef RefsHaveIndexReg}
+      {$ifdef cpurefshaveindexreg}
                    And (Index = R_NO)
-      {$endif RefsHaveIndexReg} Then
+      {$endif cpurefshaveindexreg} Then
                   Begin
                     RegsChecked := RegsChecked +
                       [RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg)];
@@ -413,12 +413,12 @@ Unit AoptObj;
                     If (Base = Reg) And
                        Not(Base In RegsChecked)
                       Then TmpResult := True;
-      {$ifdef RefsHaveIndexReg}
+      {$ifdef cpurefshaveindexreg}
                     If Not(TmpResult) And
                        (Index = Reg) And
                          Not(Index In RegsChecked)
                       Then TmpResult := True;
-      {$Endif RefsHaveIndexReg}
+      {$Endif cpurefshaveindexreg}
                   End
             Else TmpResult := RegInInstruction(Reg, p);
             Inc(Counter);
@@ -487,9 +487,9 @@ Unit AoptObj;
             Assigned(Ref.Symbol) Then
           Begin
             If
-      {$ifdef refsHaveIndexReg}
+      {$ifdef cpurefshaveindexreg}
                (Ref.Index = R_NO) And
-      {$endif refsHaveIndexReg}
+      {$endif cpurefshaveindexreg}
                (Not(Assigned(Ref.Symbol)) or
                 (Ref.base = R_NO)) Then
         { local variable which is not an array }
@@ -599,10 +599,10 @@ Unit AoptObj;
       (*!!!!!!
         If Ref^.Base <> R_NO Then
           ReadReg(Ref^.Base);
-      {$ifdef refsHaveIndexReg}
+      {$ifdef cpurefshaveindexreg}
         If Ref^.Index <> R_NO Then
           ReadReg(Ref^.Index);
-      {$endif}
+      {$endif cpurefshaveindexreg}
       *)
       End;
 
@@ -822,7 +822,9 @@ Unit AoptObj;
             Top_None :
               OpsEqual := True
             else OpsEqual := False
-          End;
+          End
+        else
+          OpsEqual := False;
       End;
 
       Function TAOptObj.FindRegAlloc(Reg: TRegister; StartPai: Tai): Boolean;
@@ -884,10 +886,8 @@ Unit AoptObj;
       end;
 
 
-{$ifopt r+}
-{$define rangewason}
+{$push}
 {$r-}
-{$endif}
     function tAOptObj.getlabelwithsym(sym: tasmlabel): tai;
       begin
         if (int64(sym.labelnr) >= int64(labelinfo^.lowlabel)) and
@@ -896,10 +896,7 @@ Unit AoptObj;
         else
           getlabelwithsym := nil;
       end;
-{$ifdef rangewason}
-{$r+}
-{$undef rangewason}
-{$endif}
+{$pop}
 
     function TAOptObj.GetFinalDestination(hp: taicpu; level: longint): boolean;
       {traces sucessive jumps to their final destination and sets it, e.g.

compiler/arm/agarmgas.pas

@@ -80,11 +80,17 @@ 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.fputype = fpu_vfpv2) then
+          result:='-mfpu=vfpv2 '+result;
+        if (current_settings.fputype = fpu_vfpv3) then
+          result:='-mfpu=vfpv3 '+result;
+        if (current_settings.fputype = fpu_vfpv3_d16) then
+          result:='-mfpu=vfpv3-d16 '+result;
         if current_settings.cputype = cpu_armv7m then
           result:='-march=armv7m -mthumb -mthumb-interwork '+result;
+        if target_info.abi = abi_eabihf then
+          { options based on what gcc uses on debian armhf }
+          result:='-mfloat-abi=hard -meabi=5 '+result;
       end;
 
     procedure TArmGNUAssembler.WriteExtraHeader;
@@ -307,6 +313,7 @@ unit agarmgas;
             flags : [af_allowdirect,af_needar,af_smartlink_sections];
             labelprefix : '.L';
             comment : '# ';
+            dollarsign: '$';
           );
 
        as_arm_gas_darwin_info : tasminfo =
@@ -319,6 +326,7 @@ unit agarmgas;
             flags : [af_allowdirect,af_needar,af_smartlink_sections,af_supports_dwarf,af_stabs_use_function_absolute_addresses];
             labelprefix : 'L';
             comment : '# ';
+            dollarsign: '$';
           );
 
 

compiler/arm/aoptcpu.pas

@@ -36,8 +36,11 @@ Type
     function PeepHoleOptPass1Cpu(var p: tai): boolean; override;
     procedure PeepHoleOptPass2;override;
   End;
-  
-  
+
+  TCpuPreRegallocScheduler = class(TAsmOptimizer)
+    function PeepHoleOptPass1Cpu(var p: tai): boolean;override;
+  end;
+
   TCpuThumb2AsmOptimizer = class(TCpuAsmOptimizer)
     { uses the same constructor as TAopObj }
     procedure PeepHoleOptPass2;override;
@@ -46,104 +49,227 @@ Type
 Implementation
 
   uses
+    cutils,
     verbose,
-    aasmbase,aasmcpu;
+    cgbase,cgutils,
+    aasmbase,aasmdata,aasmcpu;
 
   function CanBeCond(p : tai) : boolean;
     begin
-      result:=(p.typ=ait_instruction) and (taicpu(p).condition=C_None);
+      result:=
+        (p.typ=ait_instruction) and
+        (taicpu(p).condition=C_None) and
+        ((taicpu(p).opcode<>A_BLX) or
+         (taicpu(p).oper[0]^.typ=top_reg));
+    end;
+
+
+  function RefsEqual(const r1, r2: treference): boolean;
+    begin
+      refsequal :=
+        (r1.offset = r2.offset) and
+        (r1.base = r2.base) and
+        (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and
+        (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and
+        (r1.relsymbol = r2.relsymbol) and
+        (r1.signindex = r2.signindex) and
+        (r1.shiftimm = r2.shiftimm) and
+        (r1.addressmode = r2.addressmode) and
+        (r1.shiftmode = r2.shiftmode);
     end;
 
 
   function TCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean;
     var
       next1: tai;
-      hp1: tai;
+      hp1,hp2: tai;
     begin
       result := false;
       case p.typ of
         ait_instruction:
           begin
-            case taicpu(p).opcode of
-              A_MOV:
-                begin
-                  { fold
-                    mov reg1,reg0, shift imm1
-                    mov reg1,reg1, shift imm2
-                    to
-                    mov reg1,reg0, shift imm1+imm2
-                  }
-                  if (taicpu(p).ops=3) and
-                     (taicpu(p).oper[0]^.typ = top_reg) and
-                     (taicpu(p).oper[2]^.typ = top_shifterop) and
-                     (taicpu(p).oper[2]^.shifterop^.rs = NR_NO) and
-                     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
-                     (taicpu(next1).oper[1]^.typ = top_reg) and
-                     (taicpu(p).oper[0]^.reg=taicpu(next1).oper[1]^.reg) and
-                     (taicpu(next1).oper[2]^.typ = top_shifterop) and
-                     (taicpu(next1).oper[2]^.shifterop^.rs = NR_NO) and
-                     (taicpu(p).oper[2]^.shifterop^.shiftmode=taicpu(next1).oper[2]^.shifterop^.shiftmode) then
-                    begin
-                      inc(taicpu(p).oper[2]^.shifterop^.shiftimm,taicpu(next1).oper[2]^.shifterop^.shiftimm);
-                      { avoid overflows }
-                      if taicpu(p).oper[2]^.shifterop^.shiftimm>31 then
-                        case taicpu(p).oper[2]^.shifterop^.shiftmode of
-                          SM_ROR:
-                            taicpu(p).oper[2]^.shifterop^.shiftimm:=taicpu(p).oper[2]^.shifterop^.shiftimm and 31;
-                          SM_ASR:
-                            taicpu(p).oper[2]^.shifterop^.shiftimm:=31;
-                          SM_LSR,
-                          SM_LSL:
-                            begin
-                              hp1:=taicpu.op_reg_const(A_MOV,taicpu(p).oper[0]^.reg,0);
-                              InsertLLItem(p.previous, p.next, hp1);
-                              p.free;
-                              p:=hp1;
-                            end;
-                          else
-                            internalerror(2008072803);
-                        end;
-                      asml.remove(next1);
-                      next1.free;
-                      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;
+            (* optimization proved not to be safe, see tw4768.pp
+            {
+              change
+              <op> reg,x,y
+              cmp reg,#0
+              into
+              <op>s reg,x,y
+            }
+            { this optimization can applied only to the currently enabled operations because
+              the other operations do not update all flags and FPC does not track flag usage }
+            if (taicpu(p).opcode in [A_ADC,A_ADD,A_SUB {A_UDIV,A_SDIV,A_MUL,A_MVN,A_MOV,A_ORR,A_EOR,A_AND}]) and
+              (taicpu(p).oper[0]^.typ = top_reg) and
+              (taicpu(p).oppostfix = PF_None) and
+              (taicpu(p).condition = C_None) and
+              GetNextInstruction(p, hp1) and
+              (tai(hp1).typ = ait_instruction) and
+              (taicpu(hp1).opcode = A_CMP) and
+              (taicpu(hp1).oppostfix = PF_None) and
+              (taicpu(hp1).condition = C_None) and
+              (taicpu(hp1).oper[0]^.typ = top_reg) and
+              (taicpu(hp1).oper[1]^.typ = top_const) and
+              (taicpu(p).oper[0]^.reg = taicpu(hp1).oper[0]^.reg) and
+              (taicpu(hp1).oper[1]^.val = 0) { and
+              GetNextInstruction(hp1, hp2) and
+              (tai(hp2).typ = ait_instruction) and
+              // be careful here, following instructions could use other flags
+              // however after a jump fpc never depends on the value of flags
+              (taicpu(hp2).opcode = A_B) and
+              (taicpu(hp2).condition in [C_EQ,C_NE,C_MI,C_PL])} then
+             begin
+               taicpu(p).oppostfix:=PF_S;
+               asml.remove(hp1);
+               hp1.free;
+             end
+           else
+           *)
+              case taicpu(p).opcode of
+                A_STR:
+                  begin
+                    { change
+                      str reg1,ref
+                      ldr reg2,ref
+                      into
+                      str reg1,ref
+                      mov reg2,reg1
+                    }
+                    if (taicpu(p).oper[1]^.ref^.addressmode=AM_OFFSET) and
+                       GetNextInstruction(p,hp1) and
+                       (hp1.typ = ait_instruction) and
+                       (taicpu(hp1).opcode = A_LDR) and
+                       RefsEqual(taicpu(p).oper[1]^.ref^,taicpu(hp1).oper[1]^.ref^) and
+                       ((taicpu(p).condition = taicpu(hp1).condition) or
+                        (taicpu(p).condition = C_None)) and
+                       (taicpu(hp1).oper[1]^.ref^.addressmode=AM_OFFSET) then
+                      begin
+                        if taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg then
+                          begin
+                            asml.remove(hp1);
+                            hp1.free;
+                          end
+                        else
+                          begin
+                            taicpu(hp1).opcode:=A_MOV;
+                            taicpu(hp1).oppostfix:=PF_None;
+                            taicpu(hp1).loadreg(1,taicpu(p).oper[0]^.reg);
+                          end;
+                        result := true;
+                      end;
+                  end;
+                A_LDR:
+                  begin
+                    { change
+                      ldr reg1,ref
+                      ldr reg2,ref
+                      into
+                      ldr reg1,ref
+                      mov reg2,reg1
+                    }
+                    if (taicpu(p).oper[1]^.ref^.addressmode=AM_OFFSET) and
+                       GetNextInstruction(p,hp1) and
+                       (hp1.typ = ait_instruction) and
+                       (taicpu(hp1).opcode = A_LDR) and
+                       RefsEqual(taicpu(p).oper[1]^.ref^,taicpu(hp1).oper[1]^.ref^) and
+                       ((taicpu(p).condition = taicpu(hp1).condition) or
+                        (taicpu(p).condition = C_None)) and
+                       (taicpu(p).oper[0]^.reg<>taicpu(hp1).oper[1]^.ref^.index) and
+                       (taicpu(p).oper[0]^.reg<>taicpu(hp1).oper[1]^.ref^.base) and
+                       (taicpu(hp1).oper[1]^.ref^.addressmode=AM_OFFSET) then
+                      begin
+                        if taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg then
+                          begin
+                            asml.remove(hp1);
+                            hp1.free;
+                          end
+                        else
+                          begin
+                            taicpu(hp1).opcode:=A_MOV;
+                            taicpu(hp1).oppostfix:=PF_None;
+                            taicpu(hp1).loadreg(1,taicpu(p).oper[0]^.reg);
+                          end;
+                        result := true;
+                      end;
+                  end;
+                A_MOV:
+                  begin
+                    { fold
+                      mov reg1,reg0, shift imm1
+                      mov reg1,reg1, shift imm2
+                      to
+                      mov reg1,reg0, shift imm1+imm2
+                    }
+                    if (taicpu(p).ops=3) and
+                       (taicpu(p).oper[0]^.typ = top_reg) and
+                       (taicpu(p).oper[2]^.typ = top_shifterop) and
+                       (taicpu(p).oper[2]^.shifterop^.rs = NR_NO) and
+                       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
+                       (taicpu(next1).oper[1]^.typ = top_reg) and
+                       (taicpu(p).oper[0]^.reg=taicpu(next1).oper[1]^.reg) and
+                       (taicpu(next1).oper[2]^.typ = top_shifterop) and
+                       (taicpu(next1).oper[2]^.shifterop^.rs = NR_NO) and
+                       (taicpu(p).oper[2]^.shifterop^.shiftmode=taicpu(next1).oper[2]^.shifterop^.shiftmode) then
+                      begin
+                        inc(taicpu(p).oper[2]^.shifterop^.shiftimm,taicpu(next1).oper[2]^.shifterop^.shiftimm);
+                        { avoid overflows }
+                        if taicpu(p).oper[2]^.shifterop^.shiftimm>31 then
+                          case taicpu(p).oper[2]^.shifterop^.shiftmode of
+                            SM_ROR:
+                              taicpu(p).oper[2]^.shifterop^.shiftimm:=taicpu(p).oper[2]^.shifterop^.shiftimm and 31;
+                            SM_ASR:
+                              taicpu(p).oper[2]^.shifterop^.shiftimm:=31;
+                            SM_LSR,
+                            SM_LSL:
+                              begin
+                                hp1:=taicpu.op_reg_const(A_MOV,taicpu(p).oper[0]^.reg,0);
+                                InsertLLItem(p.previous, p.next, hp1);
+                                p.free;
+                                p:=hp1;
+                              end;
+                            else
+                              internalerror(2008072803);
+                          end;
+                        asml.remove(next1);
+                        next1.free;
+                        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;
     end;
@@ -328,6 +454,117 @@ Implementation
         end;
     end;
 
+  const
+    { set of opcode which might or do write to memory }
+    { TODO : extend armins.dat to contain r/w info }
+    opcode_could_mem_write = [A_B,A_BL,A_BLX,A_BKPT,A_BX,A_STR,A_STRB,A_STRBT,
+                              A_STRH,A_STRT,A_STF,A_SFM,A_STM,A_FSTS,A_FSTD];
+
+  function TCpuPreRegallocScheduler.PeepHoleOptPass1Cpu(var p: tai): boolean;
+  { TODO : schedule also forward }
+  { TODO : schedule distance > 1 }
+    var
+      hp1,hp2,hp3,hp4,hp5 : tai;
+      list : TAsmList;
+    begin
+      result:=true;
+      list:=TAsmList.Create;
+      p := BlockStart;
+      { UsedRegs := []; }
+      while (p <> BlockEnd) Do
+        begin
+          if (p.typ=ait_instruction) and
+            GetNextInstruction(p,hp1) and
+            (hp1.typ=ait_instruction) and
+            { for now we don't reschedule if the previous instruction changes potentially a memory location }
+            ( (not(taicpu(p).opcode in opcode_could_mem_write) and
+               not(RegModifiedByInstruction(NR_PC,p)) and
+               (taicpu(hp1).opcode in [A_LDR,A_LDRB,A_LDRH,A_LDRSB,A_LDRSH])
+              ) or
+              ((taicpu(p).opcode in [A_STM,A_STRB,A_STRH,A_STR]) and
+               (taicpu(hp1).opcode in [A_LDR,A_LDRB,A_LDRH,A_LDRSB,A_LDRSH]) and
+               ((taicpu(hp1).oper[1]^.ref^.base=NR_PC) or
+                (assigned(taicpu(hp1).oper[1]^.ref^.symboldata) and
+                (taicpu(hp1).oper[1]^.ref^.offset=0)
+                )
+               ) or
+               { try to prove that the memory accesses don't overlapp }
+               ((taicpu(p).opcode in [A_STRB,A_STRH,A_STR]) and
+                (taicpu(hp1).opcode in [A_LDR,A_LDRB,A_LDRH,A_LDRSB,A_LDRSH]) and
+                (taicpu(p).oper[1]^.ref^.base=taicpu(hp1).oper[1]^.ref^.base) and
+                (taicpu(p).oppostfix=PF_None) and
+                (taicpu(hp1).oppostfix=PF_None) and
+                (taicpu(p).oper[1]^.ref^.index=NR_NO) and
+                (taicpu(hp1).oper[1]^.ref^.index=NR_NO) and
+                { get operand sizes and check if the offset distance is large enough to ensure no overlapp }
+                (abs(taicpu(p).oper[1]^.ref^.offset-taicpu(hp1).oper[1]^.ref^.offset)>=max(tcgsize2size[reg_cgsize(taicpu(p).oper[0]^.reg)],tcgsize2size[reg_cgsize(taicpu(hp1).oper[0]^.reg)]))
+              )
+            )
+            ) and
+            GetNextInstruction(hp1,hp2) and
+            (hp2.typ=ait_instruction) and
+            { loaded register used by next instruction? }
+            (RegInInstruction(taicpu(hp1).oper[0]^.reg,hp2)) and
+            { loaded register not used by previous instruction? }
+            not(RegInInstruction(taicpu(hp1).oper[0]^.reg,p)) and
+            { same condition? }
+            (taicpu(p).condition=taicpu(hp1).condition) and
+            { first instruction might not change the register used as base }
+            ((taicpu(hp1).oper[1]^.ref^.base=NR_NO) or
+             not(RegModifiedByInstruction(taicpu(hp1).oper[1]^.ref^.base,p))
+            ) and
+            { first instruction might not change the register used as index }
+            ((taicpu(hp1).oper[1]^.ref^.index=NR_NO) or
+             not(RegModifiedByInstruction(taicpu(hp1).oper[1]^.ref^.index,p))
+            ) then
+            begin
+              hp3:=tai(p.Previous);
+              hp5:=tai(p.next);
+              asml.Remove(p);
+              { if there is a reg. dealloc instruction associated with p, move it together with p }
+
+              { before the instruction? }
+              while assigned(hp3) and (hp3.typ<>ait_instruction) do
+                begin
+                  if (hp3.typ=ait_regalloc) and (tai_regalloc(hp3).ratype in [ra_dealloc]) and
+                    RegInInstruction(tai_regalloc(hp3).reg,p) then
+                    begin
+                      hp4:=hp3;
+                      hp3:=tai(hp3.Previous);
+                      asml.Remove(hp4);
+                      list.Concat(hp4);
+                    end
+                  else
+                  hp3:=tai(hp3.Previous);
+                end;
+              list.Concat(p);
+              { after the instruction? }
+              while assigned(hp5) and (hp5.typ<>ait_instruction) do
+                begin
+                  if (hp5.typ=ait_regalloc) and (tai_regalloc(hp5).ratype in [ra_dealloc]) and
+                    RegInInstruction(tai_regalloc(hp5).reg,p) then
+                    begin
+                      hp4:=hp5;
+                      hp5:=tai(hp5.next);
+                      asml.Remove(hp4);
+                      list.Concat(hp4);
+                    end
+                  else
+                  hp5:=tai(hp5.Next);
+                end;
+
+              asml.Remove(hp1);
+{$ifdef DEBUG_PREREGSCHEDULER}
+              asml.InsertBefore(tai_comment.Create(strpnew('Rescheduled')),hp2);
+{$endif DEBUG_PREREGSCHEDULER}
+              asml.InsertBefore(hp1,hp2);
+              asml.InsertListBefore(hp2,list);
+            end;
+          p := tai(p.next)
+        end;
+      list.Free;
+    end;
+
 
   procedure TCpuThumb2AsmOptimizer.PeepHoleOptPass2;
     begin
@@ -336,4 +573,5 @@ Implementation
 
 begin
   casmoptimizer:=TCpuAsmOptimizer;
+  cpreregallocscheduler:=TCpuPreRegallocScheduler;
 End.

compiler/arm/aoptcpub.pas

@@ -28,10 +28,7 @@ Unit aoptcpub; { Assembler OPTimizer CPU specific Base }
 { enable the following define if memory references can have both a base and }
 { index register in 1 operand                                               }
 
-{$define RefsHaveIndexReg}
-
 { enable the following define if memory references can have a scaled index }
-
 { define RefsHaveScale}
 
 { enable the following define if memory references can have a segment }
@@ -42,6 +39,7 @@ Unit aoptcpub; { Assembler OPTimizer CPU specific Base }
 Interface
 
 Uses
+  cgbase,aasmtai,
   cpubase,aasmcpu,AOptBase;
 
 Type
@@ -64,6 +62,7 @@ Type
 { ************************************************************************* }
 
   TAoptBaseCpu = class(TAoptBase)
+    function RegModifiedByInstruction(Reg: TRegister; p1: tai): boolean; override;
   End;
 
 
@@ -109,12 +108,27 @@ Implementation
 { ************************************************************************* }
 { **************************** TCondRegs ********************************** }
 { ************************************************************************* }
-Constructor TCondRegs.init;
-Begin
-End;
-
-Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl}
-Begin
-End;
+  Constructor TCondRegs.init;
+    Begin
+    End;
+
+
+  Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl}
+    Begin
+    End;
+
+
+  function TAoptBaseCpu.RegModifiedByInstruction(Reg: TRegister; p1: tai): boolean;
+    var
+      i : Longint;
+    begin
+      result:=false;
+      for i:=0 to taicpu(p1).ops-1 do
+        if (taicpu(p1).oper[i]^.typ=top_reg) and (taicpu(p1).oper[i]^.reg=Reg) and (taicpu(p1).spilling_get_operation_type(i) in [operand_write,operand_readwrite]) then
+          begin
+            result:=true;
+            exit;
+          end;
+    end;
 
 End.

compiler/arm/armreg.dat

@@ -34,57 +34,60 @@ F6,$02,$00,$06,f6,32,22
 F7,$02,$00,$07,f7,32,23
 
 ; MM registers
-; 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...
+; odd numbered single registers must not be made available to the register
+; allocator because it 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...
+; Nevertheless the odd numbered single registers must have seperate register 
+; numbers to allow implementation of the "EABI VFP hardfloat" calling convention.
+
 S0,$04,$06,$00,s0,0,0
-S1,$04,$06,$00,s1,0,0
+S1,$04,$06,$20,s1,0,0
 D0,$04,$07,$00,d0,0,0
 S2,$04,$06,$01,s2,0,0
-S3,$04,$06,$01,s3,0,0
+S3,$04,$06,$21,s3,0,0
 D1,$04,$07,$01,d1,0,0
 S4,$04,$06,$02,s4,0,0
-S5,$04,$06,$02,s5,0,0
+S5,$04,$06,$22,s5,0,0
 D2,$04,$07,$02,d2,0,0
 S6,$04,$06,$03,s6,0,0
-S7,$04,$06,$03,s7,0,0
+S7,$04,$06,$23,s7,0,0
 D3,$04,$07,$03,d3,0,0
 S8,$04,$06,$04,s8,0,0
-S9,$04,$06,$04,s9,0,0
+S9,$04,$06,$24,s9,0,0
 D4,$04,$07,$04,d4,0,0
 S10,$04,$06,$05,s10,0,0
-S11,$04,$06,$05,s11,0,0
+S11,$04,$06,$25,s11,0,0
 D5,$04,$07,$05,d5,0,0
 S12,$04,$06,$06,s12,0,0
-S13,$04,$06,$06,s13,0,0
+S13,$04,$06,$26,s13,0,0
 D6,$04,$07,$06,d6,0,0
 S14,$04,$06,$07,s14,0,0
-S15,$04,$06,$07,s15,0,0
+S15,$04,$06,$27,s15,0,0
 D7,$04,$07,$07,d7,0,0
 S16,$04,$06,$08,s16,0,0
-S17,$04,$06,$08,s17,0,0
+S17,$04,$06,$28,s17,0,0
 D8,$04,$07,$08,d8,0,0
 S18,$04,$06,$09,s18,0,0
-S19,$04,$06,$09,s19,0,0
+S19,$04,$06,$29,s19,0,0
 D9,$04,$07,$09,d9,0,0
 S20,$04,$06,$0A,s20,0,0
-S21,$04,$06,$0A,s21,0,0
+S21,$04,$06,$2A,s21,0,0
 D10,$04,$07,$0A,d10,0,0
 S22,$04,$06,$0B,s22,0,0
-S23,$04,$06,$0B,s23,0,0
+S23,$04,$06,$2B,s23,0,0
 D11,$04,$07,$0B,d11,0,0
 S24,$04,$06,$0C,s24,0,0
-S25,$04,$06,$0C,s25,0,0
+S25,$04,$06,$2C,s25,0,0
 D12,$04,$07,$0C,d12,0,0
 S26,$04,$06,$0D,s26,0,0
-S27,$04,$06,$0D,s27,0,0
+S27,$04,$06,$2D,s27,0,0
 D13,$04,$07,$0D,d13,0,0
 S28,$04,$06,$0E,s28,0,0
-S29,$04,$06,$0E,s29,0,0
+S29,$04,$06,$2E,s29,0,0
 D14,$04,$07,$0E,d14,0,0
-S30,$04,$06,$0F,s20,0,0
-S31,$04,$06,$0F,s21,0,0
+S30,$04,$06,$0F,s30,0,0
+S31,$04,$06,$2F,s21,0,0
 D15,$04,$07,$0F,d15,0,0
 D16,$04,$07,$10,d16,0,0
 D17,$04,$07,$11,d17,0,0

compiler/arm/cgcpu.pas

@@ -112,6 +112,8 @@ unit cgcpu;
         procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize : tcgsize;mmreg, intreg: tregister; shuffle : pmmshuffle); override;
 
         procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size : tcgsize;src,dst: tregister;shuffle : pmmshuffle); override;
+        { Transform unsupported methods into Internal errors }
+        procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override;
       private
         { clear out potential overflow bits from 8 or 16 bit operations  }
         { the upper 24/16 bits of a register after an operation          }
@@ -207,17 +209,18 @@ unit cgcpu;
     procedure tarmcgarm.init_register_allocators;
       begin
         inherited init_register_allocators;
-        { currently, we save R14 always, so we can use it }
+        { currently, we always save R14, so we can use it }
         if (target_info.system<>system_arm_darwin) then
           rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE,
-              [RS_R0,RS_R1,RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,
-               RS_R9,RS_R10,RS_R12,RS_R14],first_int_imreg,[])
+              [RS_R0,RS_R1,RS_R2,RS_R3,RS_R12,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,
+               RS_R9,RS_R10,RS_R14],first_int_imreg,[])
         else
-          { r9 is not (always) available on Darwin according to the llvm code
-            generator. }
+          { r7 is not available on Darwin, it's used as frame pointer (always,
+            for backtrace support -- also in gcc/clang -> R11 can be used).
+            r9 is volatile }
           rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE,
-              [RS_R0,RS_R1,RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,
-               RS_R10,RS_R12,RS_R14],first_int_imreg,[]);
+              [RS_R0,RS_R1,RS_R2,RS_R3,RS_R9,RS_R12,RS_R4,RS_R5,RS_R6,RS_R8,
+               RS_R10,RS_R11,RS_R14],first_int_imreg,[]);
         rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
             [RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7],first_fpu_imreg,[]);
         { The register allocator currently cannot deal with multiple
@@ -283,6 +286,7 @@ unit cgcpu;
                current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(longint(a)));
 
                hr.symbol:=l;
+               hr.base:=NR_PC;
                list.concat(taicpu.op_reg_ref(A_LDR,reg,hr));
             end;
        end;
@@ -510,14 +514,22 @@ unit cgcpu;
 
 
     procedure tcgarm.a_call_name(list : TAsmList;const s : string; weak: boolean);
+      var
+        branchopcode: tasmop;
       begin
+        { check not really correct: should only be used for non-Thumb cpus }
+        if (current_settings.cputype<cpu_armv5) or
+           (current_settings.cputype in cpu_thumb2) then
+          branchopcode:=A_BL
+        else
+          branchopcode:=A_BLX;
         if target_info.system<>system_arm_darwin then
           if not weak then
-            list.concat(taicpu.op_sym(A_BL,current_asmdata.RefAsmSymbol(s)))
+            list.concat(taicpu.op_sym(branchopcode,current_asmdata.RefAsmSymbol(s)))
           else
-            list.concat(taicpu.op_sym(A_BL,current_asmdata.WeakRefAsmSymbol(s)))
+            list.concat(taicpu.op_sym(branchopcode,current_asmdata.WeakRefAsmSymbol(s)))
         else
-          list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s,weak)));
+          list.concat(taicpu.op_sym(branchopcode,get_darwin_call_stub(s,weak)));
 {
         the compiler does not properly set this flag anymore in pass 1, and
         for now we only need it after pass 2 (I hope) (JM)
@@ -633,8 +645,7 @@ unit cgcpu;
 
         if is_shifter_const(a,shift) and not(op in [OP_IMUL,OP_MUL]) then
           case op of
-            OP_NEG,OP_NOT,
-            OP_DIV,OP_IDIV:
+            OP_NEG,OP_NOT:
               internalerror(200308281);
             OP_SHL:
               begin
@@ -735,11 +746,11 @@ unit cgcpu;
         else
           begin
             { there could be added some more sophisticated optimizations }
-            if (op in [OP_MUL,OP_IMUL]) and (a=1) then
+            if (op in [OP_MUL,OP_IMUL,OP_DIV,OP_IDIV]) and (a=1) then
               a_load_reg_reg(list,size,size,src,dst)
             else if (op in [OP_MUL,OP_IMUL]) and (a=0) then
               a_load_const_reg(list,size,0,dst)
-            else if (op in [OP_IMUL]) and (a=-1) then
+            else if (op in [OP_IMUL,OP_IDIV]) and (a=-1) then
               a_op_reg_reg(list,OP_NEG,size,src,dst)
             { we do this here instead in the peephole optimizer because
               it saves us a register }
@@ -928,6 +939,7 @@ unit cgcpu;
            ((op in [A_LDF,A_STF,A_FLDS,A_FLDD,A_FSTS,A_FSTD]) and
             ((ref.offset<-1020) or
              (ref.offset>1020) or
+             ((abs(ref.offset) mod 4)<>0) or
              { the usual pc relative symbol handling assumes possible offsets of +/- 4095 }
              assigned(ref.symbol)
             )
@@ -1343,6 +1355,11 @@ unit cgcpu;
       end;
 
 
+    procedure tcgarm.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister);
+      begin
+        Comment(V_Error,'tcgarm.a_bit_scan_reg_reg method not implemented');
+      end;
+
     procedure tcgarm.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
       begin
         list.concat(taicpu.op_reg_reg(A_CMP,reg2,reg1));
@@ -1394,7 +1411,8 @@ unit cgcpu;
          firstfloatreg,lastfloatreg,
          r : byte;
          mmregs,
-         regs : tcpuregisterset;
+         regs, saveregs : tcpuregisterset;
+         r7offset,
          stackmisalignment : pint;
          postfix: toppostfix;
       begin
@@ -1422,48 +1440,99 @@ unit cgcpu;
                       end;
                 end;
               fpu_vfpv2,
-              fpu_vfpv3:
+              fpu_vfpv3,
+              fpu_vfpv3_d16:
                 begin;
                   mmregs:=rg[R_MMREGISTER].used_in_proc-paramanager.get_volatile_registers_mm(pocall_stdcall);
                 end;
             end;
             a_reg_alloc(list,NR_STACK_POINTER_REG);
             if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
-              begin
-                a_reg_alloc(list,NR_FRAME_POINTER_REG);
-                a_reg_alloc(list,NR_R12);
-
-                list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_STACK_POINTER_REG));
-              end;
+              a_reg_alloc(list,NR_FRAME_POINTER_REG);
             { save int registers }
             reference_reset(ref,4);
             ref.index:=NR_STACK_POINTER_REG;
             ref.addressmode:=AM_PREINDEXED;
             regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall);
-            { the (old) ARM APCS requires saving both the stack pointer (to
-              crawl the stack) and the PC (to identify the function this
-              stack frame belongs to) -> also save R12 (= copy of R13 on entry)
-              and R15 -- still needs updating for EABI and Darwin, they don't
-              need that }
-            if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
-              regs:=regs+[RS_FRAME_POINTER_REG,RS_R12,RS_R14,RS_R15]
-            else
-              if (regs<>[]) or (pi_do_call in current_procinfo.flags) then
-                include(regs,RS_R14);
-            if regs<>[] then
-               begin
-                 for r:=RS_R0 to RS_R15 do
-                   if (r in regs) then
-                     inc(stackmisalignment,4);
-                 list.concat(setoppostfix(taicpu.op_ref_regset(A_STM,ref,R_INTREGISTER,R_SUBWHOLE,regs),PF_FD));
-               end;
+            if not(target_info.system in systems_darwin) then
+              begin
+                a_reg_alloc(list,NR_STACK_POINTER_REG);
+                if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+                  begin
+                    a_reg_alloc(list,NR_R12);
+                    list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_STACK_POINTER_REG));
+                  end;
+                { the (old) ARM APCS requires saving both the stack pointer (to
+                  crawl the stack) and the PC (to identify the function this
+                  stack frame belongs to) -> also save R12 (= copy of R13 on entry)
+                  and R15 -- still needs updating for EABI and Darwin, they don't
+                  need that }
+                if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+                  regs:=regs+[RS_FRAME_POINTER_REG,RS_R12,RS_R14,RS_R15]
+                else
+                  if (regs<>[]) or (pi_do_call in current_procinfo.flags) then
+                    include(regs,RS_R14);
+                if regs<>[] then
+                   begin
+                     for r:=RS_R0 to RS_R15 do
+                       if r in regs then
+                         inc(stackmisalignment,4);
+                     list.concat(setoppostfix(taicpu.op_ref_regset(A_STM,ref,R_INTREGISTER,R_SUBWHOLE,regs),PF_FD));
+                   end;
 
-            if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+                if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+                  begin
+                    { the framepointer now points to the saved R15, so the saved
+                      framepointer is at R11-12 (for get_caller_frame) }
+                    list.concat(taicpu.op_reg_reg_const(A_SUB,NR_FRAME_POINTER_REG,NR_R12,4));
+                    a_reg_dealloc(list,NR_R12);
+                  end;
+              end
+            else
               begin
-                { the framepointer now points to the saved R15, so the saved
-                  framepointer is at R11-12 (for get_caller_frame) }
-                list.concat(taicpu.op_reg_reg_const(A_SUB,NR_FRAME_POINTER_REG,NR_R12,4));
-                a_reg_dealloc(list,NR_R12);
+                { always save r14 if we use r7 as the framepointer, because
+                  the parameter offsets are hardcoded in advance and always
+                  assume that r14 sits on the stack right behind the saved r7
+                }
+                if current_procinfo.framepointer=NR_FRAME_POINTER_REG then
+                  include(regs,RS_FRAME_POINTER_REG);
+                if (regs<>[]) or (pi_do_call in current_procinfo.flags) then
+                    include(regs,RS_R14);
+                if regs<>[] then
+                  begin
+                    { on Darwin, you first have to save [r4-r7,lr], and then
+                      [r8,r10,r11] and make r7 point to the previously saved
+                      r7 so that you can perform a stack crawl based on it
+                      ([r7] is previous stack frame, [r7+4] is return address
+                    }
+                    include(regs,RS_FRAME_POINTER_REG);
+                    saveregs:=regs-[RS_R8,RS_R10,RS_R11];
+                    r7offset:=0;
+                    for r:=RS_R0 to RS_R15 do
+                      if r in saveregs then
+                        begin
+                          inc(stackmisalignment,4);
+                          if r<RS_FRAME_POINTER_REG then
+                            inc(r7offset,4);
+                        end;
+                    { save the registers }
+                    list.concat(setoppostfix(taicpu.op_ref_regset(A_STM,ref,R_INTREGISTER,R_SUBWHOLE,saveregs),PF_FD));
+                    { make r7 point to the saved r7 (regardless of whether this
+                      frame uses the framepointer, for backtrace purposes) }
+                    if r7offset<>0 then
+                      list.concat(taicpu.op_reg_reg_const(A_ADD,NR_FRAME_POINTER_REG,NR_R13,r7offset))
+                    else
+                      list.concat(taicpu.op_reg_reg(A_MOV,NR_R7,NR_R13));
+                    { now save the rest (if any) }
+                    saveregs:=regs-saveregs;
+                    if saveregs<>[] then
+                      begin
+                        for r:=RS_R8 to RS_R11 do
+                          if r in saveregs then
+                            inc(stackmisalignment,4);
+                        list.concat(setoppostfix(taicpu.op_ref_regset(A_STM,ref,R_INTREGISTER,R_SUBWHOLE,saveregs),PF_FD));
+                      end;
+                  end;
               end;
 
             stackmisalignment:=stackmisalignment mod current_settings.alignment.localalignmax;
@@ -1493,7 +1562,7 @@ unit cgcpu;
              begin
                reference_reset(ref,4);
                if (tg.direction*tarmprocinfo(current_procinfo).floatregstart>=1023) or
-                  (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3]) then
+                  (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv3_d16]) then
                  begin
                    if not is_shifter_const(tarmprocinfo(current_procinfo).floatregstart,shift) then
                      begin
@@ -1521,7 +1590,8 @@ unit cgcpu;
                        lastfloatreg-firstfloatreg+1,ref));
                    end;
                  fpu_vfpv2,
-                 fpu_vfpv3:
+                 fpu_vfpv3,
+                 fpu_vfpv3_d16:
                    begin
                      ref.index:=ref.base;
                      ref.base:=NR_NO;
@@ -1546,6 +1616,7 @@ unit cgcpu;
          r,
          shift : byte;
          mmregs,
+         saveregs,
          regs : tcpuregisterset;
          stackmisalignment: pint;
          mmpostfix: toppostfix;
@@ -1575,7 +1646,8 @@ unit cgcpu;
                       end;
                 end;
               fpu_vfpv2,
-              fpu_vfpv3:
+              fpu_vfpv3,
+              fpu_vfpv3_d16:
                 begin;
                   { restore vfp registers? }
                   mmregs:=rg[R_MMREGISTER].used_in_proc-paramanager.get_volatile_registers_mm(pocall_stdcall);
@@ -1587,7 +1659,7 @@ unit cgcpu;
               begin
                 reference_reset(ref,4);
                 if (tg.direction*tarmprocinfo(current_procinfo).floatregstart>=1023) or
-                   (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3]) then
+                   (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv3_d16]) then
                   begin
                     if not is_shifter_const(tarmprocinfo(current_procinfo).floatregstart,shift) then
                       begin
@@ -1614,7 +1686,8 @@ unit cgcpu;
                         lastfloatreg-firstfloatreg+1,ref));
                     end;
                   fpu_vfpv2,
-                  fpu_vfpv3:
+                  fpu_vfpv3,
+                  fpu_vfpv3_d16:
                     begin
                       ref.index:=ref.base;
                       ref.base:=NR_NO;
@@ -1629,22 +1702,47 @@ unit cgcpu;
               end;
 
             regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall)        ;
-            if (pi_do_call in current_procinfo.flags) or (regs<>[]) then
+            if (pi_do_call in current_procinfo.flags) or
+               (regs<>[]) or
+               ((target_info.system in systems_darwin) and
+                (current_procinfo.framepointer<>NR_STACK_POINTER_REG)) then
               begin
                 exclude(regs,RS_R14);
                 include(regs,RS_R15);
+                if (target_info.system in systems_darwin) then
+                  include(regs,RS_FRAME_POINTER_REG);
               end;
-            { restore saved stack pointer to SP (R13) and saved lr to PC (R15).
-              The saved PC came after that but is discarded, since we restore
-              the stack pointer }
-            if (current_procinfo.framepointer<>NR_STACK_POINTER_REG) then
-              regs:=regs+[RS_FRAME_POINTER_REG,RS_R13,RS_R15];
 
+            if not(target_info.system in systems_darwin) then
+              begin
+                { restore saved stack pointer to SP (R13) and saved lr to PC (R15).
+                  The saved PC came after that but is discarded, since we restore
+                  the stack pointer }
+                if (current_procinfo.framepointer<>NR_STACK_POINTER_REG) then
+                  regs:=regs+[RS_FRAME_POINTER_REG,RS_R13,RS_R15];
+              end
+            else
+              begin
+                { restore R8-R11 already if necessary (they've been stored
+                  before the others) }
+                saveregs:=regs*[RS_R8,RS_R10,RS_R11];
+                if saveregs<>[] then
+                  begin
+                    reference_reset(ref,4);
+                    ref.index:=NR_STACK_POINTER_REG;
+                    ref.addressmode:=AM_PREINDEXED;
+                    for r:=RS_R8 to RS_R11 do
+                      if r in saveregs then
+                        inc(stackmisalignment,4);
+                    regs:=regs-saveregs;
+                  end;
+              end;
             for r:=RS_R0 to RS_R15 do
-              if (r in regs) then
+              if r in regs then
                 inc(stackmisalignment,4);
             stackmisalignment:=stackmisalignment mod current_settings.alignment.localalignmax;
-            if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
+            if (current_procinfo.framepointer=NR_STACK_POINTER_REG) or
+               (target_info.system in systems_darwin) then
               begin
                 LocalSize:=current_procinfo.calc_stackframe_size;
                 if (LocalSize<>0) or
@@ -1666,6 +1764,10 @@ unit cgcpu;
                       end;
                   end;
 
+                if (target_info.system in systems_darwin) and
+                   (saveregs<>[]) then
+                  list.concat(setoppostfix(taicpu.op_ref_regset(A_LDM,ref,R_INTREGISTER,R_SUBWHOLE,saveregs),PF_FD));
+
                 if regs=[] then
                   begin
                     if (current_settings.cputype<cpu_armv6) then
@@ -1927,9 +2029,16 @@ unit cgcpu;
         srcref:=source;
         if cs_opt_size in current_settings.optimizerswitches then
           helpsize:=8;
-        if (len<=helpsize) and aligned then
+        if aligned and (len=4) then
+          begin
+            tmpreg:=getintregister(list,OS_32);
+            a_load_ref_reg(list,OS_32,OS_32,source,tmpreg);
+            a_load_reg_ref(list,OS_32,OS_32,tmpreg,dest);
+          end
+        else if (len<=helpsize) and aligned then
           begin
             tmpregi:=0;
+
             srcreg:=getintregister(list,OS_ADDR);
 
             { explicit pc relative addressing, could be
@@ -3185,8 +3294,7 @@ unit cgcpu;
       begin
         ovloc.loc:=LOC_VOID;
         case op of
-           OP_NEG,OP_NOT,
-           OP_DIV,OP_IDIV:
+           OP_NEG,OP_NOT:
               internalerror(200308281);
            OP_ROL:
               begin

compiler/arm/cpubase.pas

@@ -87,7 +87,7 @@ unit cpubase;
 
       { MM Super register first and last }
       first_mm_supreg    = RS_S0;
-      first_mm_imreg     = $20;
+      first_mm_imreg     = $30;
 
 { TODO: Calculate bsstart}
       regnumber_count_bsstart = 64;
@@ -106,7 +106,7 @@ unit cpubase;
       { registers which may be destroyed by calls }
       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_MMREGISTERS =  [RS_D0..RS_D7,RS_D16..RS_D31,RS_S1..RS_S15];
 
       VOLATILE_INTREGISTERS_DARWIN = [RS_R0..RS_R3,RS_R9,RS_R12..RS_R14];
 
@@ -233,13 +233,6 @@ unit cpubase;
 *****************************************************************************}
 
     const
-      firstsaveintreg = RS_R4;
-      lastsaveintreg  = RS_R10;
-      firstsavefpureg = RS_F4;
-      lastsavefpureg  = RS_F7;
-      firstsavemmreg  = RS_D8;
-      lastsavemmreg   = RS_D15;
-
       maxvarregs = 7;
       varregs : Array [1..maxvarregs] of tsuperregister =
                 (RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,RS_R9,RS_R10);
@@ -269,9 +262,9 @@ unit cpubase;
       { Stack pointer register }
       NR_STACK_POINTER_REG = NR_R13;
       RS_STACK_POINTER_REG = RS_R13;
-      { Frame pointer register }
-      RS_FRAME_POINTER_REG = RS_R11;
-      NR_FRAME_POINTER_REG = NR_R11;
+      { Frame pointer register (initialized in tarmprocinfo.init_framepointer) }
+      RS_FRAME_POINTER_REG: tsuperregister = RS_NO;
+      NR_FRAME_POINTER_REG: tregister = NR_NO;
       { Register for addressing absolute data in a position independant way,
         such as in PIC code. The exact meaning is ABI specific. For
         further information look at GCC source : PIC_OFFSET_TABLE_REGNUM
@@ -286,7 +279,7 @@ unit cpubase;
 
       NR_FPU_RESULT_REG = NR_F0;
 
-      NR_MM_RESULT_REG  = NR_NO;
+      NR_MM_RESULT_REG  = NR_D0;
 
       NR_RETURN_ADDRESS_REG = NR_FUNCTION_RETURN_REG;
 

compiler/arm/cpupara.pas

@@ -44,9 +44,9 @@ unit cpupara;
           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);
+          procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword; var sparesinglereg: tregister);
           function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
-            var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
+            var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword; var sparesinglereg: tregister; isvariadic: boolean):longint;
           procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
        end;
 
@@ -55,7 +55,7 @@ unit cpupara;
     uses
        verbose,systems,cutils,
        rgobj,
-       defutil,symsym;
+       defutil,symsym,symtable;
 
 
     function tarmparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
@@ -110,7 +110,7 @@ unit cpupara;
       end;
 
 
-    function getparaloc(calloption : tproccalloption; p : tdef) : tcgloc;
+    function getparaloc(calloption : tproccalloption; p : tdef; isvariadic: boolean) : tcgloc;
       begin
          { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
            if push_addr_param for the def is true
@@ -119,11 +119,15 @@ unit cpupara;
             orddef:
               getparaloc:=LOC_REGISTER;
             floatdef:
-              if (calloption in [pocall_cdecl,pocall_cppdecl,pocall_softfloat]) or
+              if (target_info.abi = abi_eabihf) and
+                 (not isvariadic) then
+                getparaloc:=LOC_MMREGISTER
+              else 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
+                 (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv3_d16]) 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 }
+                  but Mac OS X doesn't seem to do that and linux only does it if
+                  built with the "-mfloat-abi=hard" option }
                 getparaloc:=LOC_REGISTER
               else
                 getparaloc:=LOC_FPUREGISTER;
@@ -198,10 +202,75 @@ unit cpupara;
 
 
     function tarmparamanager.ret_in_param(def : tdef;calloption : tproccalloption) : boolean;
+      var
+        i: longint;
+        sym: tsym;
+        fpufield: boolean;
       begin
         case def.typ of
           recorddef:
-            result:=def.size>4;
+            begin
+              result:=def.size>4;
+              if not result and
+                 (target_info.abi in [abi_default,abi_armeb]) then
+                begin
+                  { in case of the old ARM abi (APCS), a struct is returned in
+                    a register only if it is simple. And what is a (non-)simple
+                    struct:
+
+                    "A non-simple type is any non-floating-point type of size
+                     greater than one word (including structures containing only
+                     floating-point fields), and certain single-word structured
+                     types."
+                       (-- ARM APCS documentation)
+
+                    So only floating point types or more than one word ->
+                    definitely non-simple (more than one word is already
+                    checked above). This includes unions/variant records with
+                    overlaid floating point and integer fields.
+
+                    Smaller than one word struct types are simple if they are
+                    "integer-like", and:
+
+                    "A structure is termed integer-like if its size is less than
+                    or equal to one word, and the offset of each of its
+                    addressable subfields is zero."
+                      (-- ARM APCS documentation)
+
+                    An "addressable subfield" is a field of which you can take
+                    the address, which in practive means any non-bitfield.
+                    In Pascal, there is no way to express the difference that
+                    you can have in C between "char" and "int :8". In this
+                    context, we use the fake distinction that a type defined
+                    inside the record itself (such as "a: 0..255;") indicates
+                    a bitpacked field while a field using a different type
+                    (such as "a: byte;") is not.
+                  }
+                  for i:=0 to trecorddef(def).symtable.SymList.count-1 do
+                    begin
+                      sym:=tsym(trecorddef(def).symtable.SymList[i]);
+                      if sym.typ<>fieldvarsym then
+                        continue;
+                      { bitfield -> ignore }
+                      if (trecordsymtable(trecorddef(def).symtable).usefieldalignment=bit_alignment) and
+                         (tfieldvarsym(sym).vardef.typ in [orddef,enumdef]) and
+                         (tfieldvarsym(sym).vardef.owner.defowner=def) then
+                        continue;
+                      { all other fields must be at offset zero }
+                      if tfieldvarsym(sym).fieldoffset<>0 then
+                        begin
+                          result:=true;
+                          exit;
+                        end;
+                      { floating point field -> also by reference }
+                      if tfieldvarsym(sym).vardef.typ=floatdef then
+                        begin
+                          result:=true;
+                          exit;
+                        end;
+                    end;
+                end;
+            end;
           procvardef:
             if not tprocvardef(def).is_addressonly then
               result:=true
@@ -213,17 +282,18 @@ unit cpupara;
       end;
 
 
-    procedure tarmparamanager.init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
+    procedure tarmparamanager.init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword; var sparesinglereg: tregister);
       begin
         curintreg:=RS_R0;
         curfloatreg:=RS_F0;
         curmmreg:=RS_D0;
         cur_stack_offset:=0;
+        sparesinglereg := NR_NO;
       end;
 
 
     function tarmparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
-        var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
+        var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword; var sparesinglereg: tregister; isvariadic: boolean):longint;
 
       var
         nextintreg,nextfloatreg,nextmmreg : tsuperregister;
@@ -302,7 +372,7 @@ unit cpupara;
                   paralen := paradef.size
                 else
                   paralen := tcgsize2size[def_cgsize(paradef)];
-                loc := getparaloc(p.proccalloption,paradef);
+                loc := getparaloc(p.proccalloption,paradef,isvariadic);
                 if (paradef.typ in [objectdef,arraydef,recorddef]) and
                   not is_special_array(paradef) and
                   (hp.varspez in [vs_value,vs_const]) then
@@ -349,7 +419,7 @@ unit cpupara;
                     LOC_REGISTER:
                       begin
                         { align registers for eabi }
-                        if (target_info.abi=abi_eabi) and
+                        if (target_info.abi in [abi_eabi,abi_eabihf]) and
                            firstparaloc and
                            (paradef.alignment=8) then
                           begin
@@ -405,6 +475,52 @@ unit cpupara;
                             end;
                           end;
                       end;
+                    LOC_MMREGISTER:
+                      begin
+                        if (nextmmreg<=RS_D7) or
+                           ((paraloc^.size = OS_F32) and
+                            (sparesinglereg<>NR_NO)) then
+                          begin
+                            paraloc^.loc:=LOC_MMREGISTER;
+                            case paraloc^.size of
+                              OS_F32:
+                                if sparesinglereg = NR_NO then 
+                                  begin     
+                                    paraloc^.register:=newreg(R_MMREGISTER,nextmmreg,R_SUBFS);
+                                    sparesinglereg:=newreg(R_MMREGISTER,nextmmreg-RS_S0+RS_S1,R_SUBFS);
+                                    inc(nextmmreg);
+                                  end
+                                else
+                                  begin
+                                    paraloc^.register:=sparesinglereg;
+                                    sparesinglereg := NR_NO;
+                                  end;
+                              OS_F64:
+                                begin
+                                  paraloc^.register:=newreg(R_MMREGISTER,nextmmreg,R_SUBFD);
+                                  inc(nextmmreg);
+                                end;
+                              else
+                                internalerror(2012031601);
+                            end;
+                          end
+                        else
+                          begin
+                            { once a floating point parameters has been placed
+                            on the stack we must not pass any more in vfp regs
+                            even if there is a single precision register still
+                            free}
+                            sparesinglereg := NR_NO;
+                            { LOC_REFERENCE always contains everything that's left }
+                            paraloc^.loc:=LOC_REFERENCE;
+                            paraloc^.size:=int_cgsize(paralen);
+                            if (side=callerside) then
+                              paraloc^.reference.index:=NR_STACK_POINTER_REG;
+                            paraloc^.reference.offset:=stack_offset;
+                            inc(stack_offset,align(paralen,4));
+                            paralen:=0;
+                         end;
+                      end;
                     LOC_REFERENCE:
                       begin
                         if push_addr_param(hp.varspez,paradef,p.proccalloption) then
@@ -415,7 +531,7 @@ unit cpupara;
                         else
                           begin
                             { align stack for eabi }
-                            if (target_info.abi=abi_eabi) and
+                            if (target_info.abi in [abi_eabi,abi_eabihf]) and
                                firstparaloc and
                                (paradef.alignment=8) then
                               stack_offset:=align(stack_offset,8);
@@ -436,7 +552,16 @@ unit cpupara;
                      if paraloc^.loc=LOC_REFERENCE then
                        begin
                          paraloc^.reference.index:=NR_FRAME_POINTER_REG;
-                         inc(paraloc^.reference.offset,4);
+                         { on non-Darwin, the framepointer contains the value
+                           of the stack pointer on entry. On Darwin, the
+                           framepointer points to the previously saved
+                           framepointer (which is followed only by the saved
+                           return address -> framepointer + 4 = stack pointer
+                           on entry }
+                         if not(target_info.system in systems_darwin) then
+                           inc(paraloc^.reference.offset,4)
+                         else
+                           inc(paraloc^.reference.offset,8);
                        end;
                    end;
                  dec(paralen,tcgsize2size[paraloc^.size]);
@@ -499,9 +624,28 @@ unit cpupara;
         { Return in FPU register? }
         if def.typ=floatdef then
           begin
-            if (p.proccalloption in [pocall_softfloat]) or
+            if target_info.abi = abi_eabihf then 
+              begin
+                paraloc^.loc:=LOC_MMREGISTER;
+                case retcgsize of
+                  OS_64,
+                  OS_F64:
+                    begin
+                      paraloc^.register:=NR_MM_RESULT_REG;
+                    end;
+                  OS_32,
+                  OS_F32:
+                    begin
+                      paraloc^.register:=NR_S0;
+                    end;
+                  else
+                    internalerror(2012032501);
+                end;
+                paraloc^.size:=retcgsize;
+              end
+            else if (p.proccalloption in [pocall_softfloat]) or
                (cs_fp_emulation in current_settings.moduleswitches) or
-               (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3]) then
+               (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv3_d16]) then
               begin
                 case retcgsize of
                   OS_64,
@@ -563,10 +707,11 @@ unit cpupara;
       var
         cur_stack_offset: aword;
         curintreg, curfloatreg, curmmreg: tsuperregister;
+        sparesinglereg:tregister;
       begin
-        init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
+        init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg);
 
-        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
+        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,false);
 
         create_funcretloc_info(p,side);
      end;
@@ -576,13 +721,14 @@ unit cpupara;
       var
         cur_stack_offset: aword;
         curintreg, curfloatreg, curmmreg: tsuperregister;
+        sparesinglereg:tregister;
       begin
-        init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
+        init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg);
 
-        result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
+        result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,true);
         if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
           { just continue loading the parameters in the registers }
-          result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset)
+          result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,true)
         else
           internalerror(200410231);
       end;

compiler/arm/cpupi.pas

@@ -38,6 +38,7 @@ unit cpupi;
           // procedure after_pass1;override;
           procedure set_first_temp_offset;override;
           function calc_stackframe_size:longint;override;
+          procedure init_framepointer; override;
        end;
 
 
@@ -70,8 +71,10 @@ unit cpupi;
                 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)
+              { on Darwin first r4-r7,r14 are saved, then r7 is adjusted to
+                point to the saved r7, and next r8,r10,r11 gets saved -> -24
+                (r4-r6 and r8,r10,r11) }
+              tg.setfirsttemp(-24)
           end
         else
           tg.setfirsttemp(maxpushedparasize);
@@ -106,7 +109,8 @@ unit cpupi;
                 floatsavesize:=(lastfloatreg-firstfloatreg+1)*12;
             end;
           fpu_vfpv2,
-          fpu_vfpv3:
+          fpu_vfpv3,
+          fpu_vfpv3_d16:
             begin
               floatsavesize:=0;
               regs:=cg.rg[R_MMREGISTER].used_in_proc-paramanager.get_volatile_registers_mm(pocall_stdcall);
@@ -123,6 +127,21 @@ unit cpupi;
       end;
 
 
+    procedure tarmprocinfo.init_framepointer;
+      begin
+        if not(target_info.system in systems_darwin) then
+          begin
+            RS_FRAME_POINTER_REG:=RS_R11;
+            NR_FRAME_POINTER_REG:=NR_R11;
+          end
+        else
+          begin
+            RS_FRAME_POINTER_REG:=RS_R7;
+            NR_FRAME_POINTER_REG:=NR_R7;
+          end;
+      end;
+
+
 begin
    cprocinfo:=tarmprocinfo;
 end.

compiler/arm/narmadd.pas

@@ -164,7 +164,8 @@ interface
                  cgsize2fpuoppostfix[def_cgsize(resultdef)]));
             end;
           fpu_vfpv2,
-          fpu_vfpv3:
+          fpu_vfpv3,
+          fpu_vfpv3_d16:
             begin
               { force mmreg as location, left right doesn't matter
                 as both will be in a fpureg }
@@ -248,7 +249,8 @@ interface
                    cgsize2fpuoppostfix[def_cgsize(resultdef)]));
             end;
           fpu_vfpv2,
-          fpu_vfpv3:
+          fpu_vfpv3,
+          fpu_vfpv3_d16:
             begin
               location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,true);
               location_force_mmregscalar(current_asmdata.CurrAsmList,right.location,true);

compiler/arm/narmcal.pas

@@ -41,13 +41,15 @@ implementation
     cgbase,
     cpubase,cpuinfo,
     ncgutil,
-    paramgr;
+    paramgr,
+    systems;
 
   procedure tarmcallnode.set_result_location(realresdef: tstoreddef);
     begin
-      if (realresdef.typ=floatdef) and
+      if (realresdef.typ=floatdef) and 
+         (target_info.abi <> abi_eabihf) and
          ((cs_fp_emulation in current_settings.moduleswitches) or
-          (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3])) then
+          (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv3_d16])) then
         begin
           { keep the fpu values in integer registers for now, the code
             generator will move them to memory or an mmregister when necessary

compiler/arm/narmcnv.pas

@@ -116,7 +116,8 @@ implementation
               fpu_fpa11:
                 expectloc:=LOC_FPUREGISTER;
               fpu_vfpv2,
-              fpu_vfpv3:
+              fpu_vfpv3,
+              fpu_vfpv3_d16:
                 expectloc:=LOC_MMREGISTER;
               else
                 internalerror(2009112702);
@@ -195,7 +196,8 @@ implementation
               end;
             end;
           fpu_vfpv2,
-          fpu_vfpv3:
+          fpu_vfpv3,
+          fpu_vfpv3_d16:
             begin
               location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef));
               signed:=left.location.size=OS_S32;
@@ -215,6 +217,7 @@ implementation
 
     procedure tarmtypeconvnode.second_int_to_bool;
       var
+        hreg1,
         hregister : tregister;
         href      : treference;
         resflags  : tresflags;
@@ -311,10 +314,27 @@ implementation
          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);
+         hreg1:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
+         cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,hreg1);
          if (is_cbool(resultdef)) then
-           cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,location.register,location.register);
+           cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,hreg1,hreg1);
+
+{$ifndef cpu64bitalu}
+         if (location.size in [OS_64,OS_S64]) then
+           begin
+             location.register64.reglo:=hreg1;
+             location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+             if (is_cbool(resultdef)) then
+               { reglo is either 0 or -1 -> reghi has to become the same }
+               cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,location.register64.reglo,location.register64.reghi)
+             else
+               { unsigned }
+               cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reghi);
+           end
+         else
+{$endif cpu64bitalu}
+           location.register:=hreg1;
+
          current_procinfo.CurrTrueLabel:=oldTrueLabel;
          current_procinfo.CurrFalseLabel:=oldFalseLabel;
       end;

compiler/arm/narminl.pas

@@ -89,7 +89,8 @@ implementation
                end;
             end;
           fpu_vfpv2,
-          fpu_vfpv3:
+          fpu_vfpv3,
+          fpu_vfpv3_d16:
             begin
               location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,true);
               location_copy(location,left.location);
@@ -118,7 +119,8 @@ implementation
               fpu_fpa11:
                 expectloc:=LOC_FPUREGISTER;
               fpu_vfpv2,
-              fpu_vfpv3:
+              fpu_vfpv3,
+              fpu_vfpv3_d16:
                 expectloc:=LOC_MMREGISTER;
               else
                 internalerror(2009112401);
@@ -140,7 +142,8 @@ implementation
               fpu_fpa11:
                 expectloc:=LOC_FPUREGISTER;
               fpu_vfpv2,
-              fpu_vfpv3:
+              fpu_vfpv3,
+              fpu_vfpv3_d16:
                 expectloc:=LOC_MMREGISTER;
               else
                 internalerror(2009112402);
@@ -162,7 +165,8 @@ implementation
               fpu_fpa11:
                 expectloc:=LOC_FPUREGISTER;
               fpu_vfpv2,
-              fpu_vfpv3:
+              fpu_vfpv3,
+              fpu_vfpv3_d16:
                 expectloc:=LOC_MMREGISTER;
               else
                 internalerror(2009112403);
@@ -213,7 +217,8 @@ implementation
           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:
+          fpu_vfpv3,
+          fpu_vfpv3_d16:
             begin
               if singleprec then
                 op:=A_FABSS
@@ -239,7 +244,8 @@ implementation
           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:
+          fpu_vfpv3,
+          fpu_vfpv3_d16:
             begin
               if singleprec then
                 op:=A_FMULS
@@ -265,7 +271,8 @@ implementation
           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:
+          fpu_vfpv3,
+          fpu_vfpv3_d16:
             begin
               if singleprec then
                 op:=A_FSQRTS

compiler/arm/narmmat.pas

@@ -54,7 +54,8 @@ implementation
       pass_2,procinfo,
       ncon,
       cpubase,cpuinfo,
-      ncgutil,cgcpu;
+      ncgutil,cgcpu,
+      nadd,pass_1,symdef;
 
 {*****************************************************************************
                              TARMMODDIVNODE
@@ -72,6 +73,26 @@ implementation
           ) and
           not(is_64bitint(resultdef)) then
           result:=nil
+        else if (current_settings.cputype in [cpu_armv7m]) and
+          (nodetype=divn) and
+          not(is_64bitint(resultdef)) then
+          result:=nil
+        else if (current_settings.cputype in [cpu_armv7m]) and
+          (nodetype=modn) and
+          not(is_64bitint(resultdef)) then
+          begin
+            if (right.nodetype=ordconstn) and
+              ispowerof2(tordconstnode(right).value,power) and
+              (tordconstnode(right).value<=256) and
+              (tordconstnode(right).value>0) then
+              result:=caddnode.create(andn,left,cordconstnode.create(tordconstnode(right).value-1,sinttype,false))
+            else
+              begin
+                result:=caddnode.create(subn,left,caddnode.create(muln,right.getcopy, cmoddivnode.Create(divn,left.getcopy,right.getcopy)));
+                right:=nil;
+              end;
+            left:=nil;
+          end
         else
           result:=inherited first_moddivint;
       end;
@@ -167,38 +188,75 @@ implementation
       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,
-          size,true);
-        location_copy(location,left.location);
-        numerator:=location.register;
-        resultreg:=location.register;
-        if location.loc=LOC_CREGISTER then
+
+        if (current_settings.cputype in [cpu_armv7m]) and
+           (nodetype=divn) and
+           not(is_64bitint(resultdef)) then
           begin
+            size:=def_cgsize(left.resultdef);
+            location_force_reg(current_asmdata.CurrAsmList,left.location,size,true);
+
+            location_copy(location,left.location);
             location.loc := LOC_REGISTER;
             location.register := cg.getintregister(current_asmdata.CurrAsmList,size);
             resultreg:=location.register;
-          end
-        else if (nodetype=modn) or (right.nodetype=ordconstn) then
-          begin
-            // for a modulus op, and for const nodes we need the result register
-            // to be an extra register
-            resultreg:=cg.getintregister(current_asmdata.CurrAsmList,size);
-          end;
 
-        if right.nodetype=ordconstn then
-          begin
-            if nodetype=divn then
-              genOrdConstNodeDiv
+            if (right.nodetype=ordconstn) and
+               ((tordconstnode(right).value=1) or
+                (tordconstnode(right).value=int64(-1)) or
+                (tordconstnode(right).value=0) or
+                ispowerof2(tordconstnode(right).value,power)) then
+              begin
+                numerator:=left.location.register;
+
+                genOrdConstNodeDiv;
+              end
             else
-//              genOrdConstNodeMod;
+              begin
+                location_force_reg(current_asmdata.CurrAsmList,right.location,size,true);
+
+                if is_signed(left.resultdef) or
+                   is_signed(right.resultdef) then
+                  cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_IDIV,OS_INT,right.location.register,left.location.register,location.register)
+                else
+                  cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_DIV,OS_INT,right.location.register,left.location.register,location.register);
+              end;
+          end
+        else
+          begin
+            location_copy(location,left.location);
+
+            { put numerator in register }
+            size:=def_cgsize(left.resultdef);
+            location_force_reg(current_asmdata.CurrAsmList,left.location,
+              size,true);
+            location_copy(location,left.location);
+            numerator:=location.register;
+            resultreg:=location.register;
+            if location.loc=LOC_CREGISTER then
+              begin
+                location.loc := LOC_REGISTER;
+                location.register := cg.getintregister(current_asmdata.CurrAsmList,size);
+                resultreg:=location.register;
+              end
+            else if (nodetype=modn) or (right.nodetype=ordconstn) then
+              begin
+                // for a modulus op, and for const nodes we need the result register
+                // to be an extra register
+                resultreg:=cg.getintregister(current_asmdata.CurrAsmList,size);
+              end;
+
+            if right.nodetype=ordconstn then
+              begin
+                if nodetype=divn then
+                  genOrdConstNodeDiv
+                else
+    //              genOrdConstNodeMod;
+              end;
+
+            location.register:=resultreg;
           end;
 
-        location.register:=resultreg;
-
         { unsigned division/module can only overflow in case of division by zero }
         { (but checking this overflow flag is more convoluted than performing a  }
         {  simple comparison with 0)                                             }
@@ -273,7 +331,8 @@ implementation
                 cgsize2fpuoppostfix[def_cgsize(resultdef)]));
             end;
           fpu_vfpv2,
-          fpu_vfpv3:
+          fpu_vfpv3,
+          fpu_vfpv3_d16:
             begin
               location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,true);
               location:=left.location;

compiler/arm/raarmgas.pas

@@ -163,22 +163,22 @@ Unit raarmgas;
       procedure test_end(require_rbracket : boolean);
         begin
           if require_rbracket then begin
-            if not(actasmtoken=AS_RBRACKET) then 
-              begin 
-                do_error; 
-                exit; 
+            if not(actasmtoken=AS_RBRACKET) then
+              begin
+                do_error;
+                exit;
               end
-            else 
+            else
               Consume(AS_RBRACKET);
-            if (actasmtoken=AS_NOT) then 
+            if (actasmtoken=AS_NOT) then
               begin
                 oper.opr.ref.addressmode:=AM_PREINDEXED;
                 Consume(AS_NOT);
               end;
           end;
-          if not(actasmtoken in [AS_SEPARATOR,AS_end]) then 
+          if not(actasmtoken in [AS_SEPARATOR,AS_end]) then
             do_error
-          else 
+          else
             begin
 {$IFDEF debugasmreader}
               writeln('TEST_end_FINAL_OK. Created the following ref:');
@@ -197,64 +197,67 @@ Unit raarmgas;
       function is_shifter_ref_operation(var a : tshiftmode) : boolean;
         begin
           a := SM_NONE;
-          if      (actasmpattern='LSL') then 
+          if      (actasmpattern='LSL') then
             a := SM_LSL
-          else if (actasmpattern='LSR') then 
+          else if (actasmpattern='LSR') then
             a := SM_LSR
-          else if (actasmpattern='ASR') then 
+          else if (actasmpattern='ASR') then
             a := SM_ASR
-          else if (actasmpattern='ROR') then 
+          else if (actasmpattern='ROR') then
             a := SM_ROR
-          else if (actasmpattern='RRX') then 
+          else if (actasmpattern='RRX') then
             a := SM_RRX;
           is_shifter_ref_operation := not(a=SM_NONE);
         end;
 
 
       procedure read_index_shift(require_rbracket : boolean);
+        var
+          shift : aint;
         begin
           case actasmtoken of
-            AS_COMMA : 
+            AS_COMMA :
               begin
                 Consume(AS_COMMA);
-                if not(actasmtoken=AS_ID) then 
+                if not(actasmtoken=AS_ID) then
                   do_error;
-                if is_shifter_ref_operation(oper.opr.ref.shiftmode) then 
+                if is_shifter_ref_operation(oper.opr.ref.shiftmode) then
                   begin
                     Consume(AS_ID);
-                    if not(oper.opr.ref.shiftmode=SM_RRX) then 
+                    if not(oper.opr.ref.shiftmode=SM_RRX) then
                       begin
-                        if not(actasmtoken=AS_HASH) then 
+                        if not(actasmtoken=AS_HASH) then
                           do_error;
                         Consume(AS_HASH);
-                        oper.opr.ref.shiftimm := BuildConstExpression(false,true);
-                        if (oper.opr.ref.shiftimm<0) or (oper.opr.ref.shiftimm>32) then 
+                        shift := BuildConstExpression(false,true);
+                        if (shift<0) or (shift>32) then
                           do_error;
+                        oper.opr.ref.shiftimm := shift;
                         test_end(require_rbracket);
                       end;
-                   end 
-                 else 
-                   begin 
-                     do_error; 
-                     exit; 
+                   end
+                 else
+                   begin
+                     do_error;
+                     exit;
                    end;
               end;
-            AS_RBRACKET : 
-              if require_rbracket then 
+            AS_RBRACKET :
+              if require_rbracket then
                 test_end(require_rbracket)
-              else 
-                begin 
-                  do_error; 
-                  exit; 
+              else
+                begin
+                  do_error;
+                  exit;
                 end;
-            AS_SEPARATOR,AS_END : 
-              if not require_rbracket then 
+            AS_SEPARATOR,AS_END :
+              if not require_rbracket then
                 test_end(false)
-               else 
-                 do_error; 
-            else 
+               else
+                 do_error;
+            else
               begin
-                do_error; 
+                do_error;
                 exit;
               end;
           end;
@@ -262,39 +265,39 @@ Unit raarmgas;
 
 
       procedure read_index(require_rbracket : boolean);
-        var 
+        var
           recname : string;
           o_int,s_int : aint;
         begin
           case actasmtoken of
-            AS_REGISTER : 
+            AS_REGISTER :
               begin
-                oper.opr.ref.index:=actasmregister;  
+                oper.opr.ref.index:=actasmregister;
                 Consume(AS_REGISTER);
                 read_index_shift(require_rbracket);
                 exit;
               end;
-            AS_PLUS,AS_MINUS : 
+            AS_PLUS,AS_MINUS :
               begin
-                if actasmtoken=AS_PLUS then 
+                if actasmtoken=AS_PLUS then
                   begin
                     Consume(AS_PLUS);
-                  end 
-                else 
+                  end
+                else
                   begin
                     oper.opr.ref.signindex := -1;
                     Consume(AS_MINUS);
                   end;
-                if actasmtoken=AS_REGISTER then 
+                if actasmtoken=AS_REGISTER then
                   begin
-                    oper.opr.ref.index:=actasmregister;   
+                    oper.opr.ref.index:=actasmregister;
                     Consume(AS_REGISTER);
                     read_index_shift(require_rbracket);
                     exit;
-                  end 
-                else 
+                  end
+                else
                   begin
-                    do_error; 
+                    do_error;
                     exit;
                   end;
                 test_end(require_rbracket);
@@ -304,13 +307,13 @@ Unit raarmgas;
               begin
                 Consume(AS_HASH);
                 o_int := BuildConstExpression(false,true);
-                if (o_int>4095) or (o_int<-4095) then 
+                if (o_int>4095) or (o_int<-4095) then
                   begin
                     Message(asmr_e_constant_out_of_bounds);
                     RecoverConsume(false);
                     exit;
-                  end 
-                else 
+                  end
+                else
                   begin
                     inc(oper.opr.ref.offset,o_int);
                     test_end(require_rbracket);
@@ -322,20 +325,20 @@ Unit raarmgas;
                 recname := actasmpattern;
                 Consume(AS_ID);
                 BuildRecordOffsetSize(recname,o_int,s_int,recname,false);
-                if (o_int>4095)or(o_int<-4095) then 
+                if (o_int>4095)or(o_int<-4095) then
                   begin
                     Message(asmr_e_constant_out_of_bounds);
                     RecoverConsume(false);
                     exit;
-                  end 
-                else 
+                  end
+                else
                   begin
                     inc(oper.opr.ref.offset,o_int);
                     test_end(require_rbracket);
                     exit;
                   end;
               end;
-            AS_AT: 
+            AS_AT:
               begin
                 do_error;
                 exit;
@@ -348,34 +351,34 @@ Unit raarmgas;
               end;
             AS_RBRACKET :
               begin
-                if require_rbracket then 
+                if require_rbracket then
                   begin
                     test_end(require_rbracket);
                     exit;
-                  end 
-                else 
+                  end
+                else
                   begin
                     do_error; // unexpected rbracket
                     exit;
                   end;
               end;
-            AS_SEPARATOR,AS_end : 
+            AS_SEPARATOR,AS_end :
               begin
-                if not require_rbracket then 
+                if not require_rbracket then
                   begin
                     test_end(false);
                     exit;
-                  end 
-                else 
+                  end
+                else
                   begin
-                    do_error; 
+                    do_error;
                     exit;
                   end;
               end;
-            else 
+            else
               begin
                 // unexpected token
-                do_error; 
+                do_error;
                 exit;
               end;
           end; // case
@@ -386,31 +389,31 @@ Unit raarmgas;
         begin
           Consume(AS_RBRACKET);
           case actasmtoken of
-            AS_COMMA : 
+            AS_COMMA :
               begin // post-indexed
                 Consume(AS_COMMA);
                 oper.opr.ref.addressmode:=AM_POSTINDEXED;
                 read_index(false);
                 exit;
               end;
-            AS_NOT : 
+            AS_NOT :
               begin   // pre-indexed
                 Consume(AS_NOT);
                 oper.opr.ref.addressmode:=AM_PREINDEXED;
                 test_end(false);
                 exit;
               end;
-            else 
+            else
               begin
                 test_end(false);
                 exit;
               end;
           end; // case
         end;
- 
-      var 
+
+      var
         lab : TASMLABEL;
-      begin 
+      begin
         Consume(AS_LBRACKET);
         oper.opr.ref.addressmode:=AM_OFFSET; // assume "neither PRE nor POST inc"
         if actasmtoken=AS_REGISTER then
@@ -418,25 +421,25 @@ Unit raarmgas;
             oper.opr.ref.base:=actasmregister;
             Consume(AS_REGISTER);
             case actasmtoken of
-              AS_RBRACKET : 
-                begin 
-                  try_prepostindexed; 
-                  exit; 
+              AS_RBRACKET :
+                begin
+                  try_prepostindexed;
+                  exit;
                 end;
-              AS_COMMA : 
-                begin 
-                  Consume(AS_COMMA); 
-                  read_index(true); 
-                  exit; 
+              AS_COMMA :
+                begin
+                  Consume(AS_COMMA);
+                  read_index(true);
+                  exit;
                 end;
-              else 
+              else
                 begin
                   Message(asmr_e_invalid_reference_syntax);
                   RecoverConsume(false);
                 end;
             end;
           end
-        else 
+        else
 {
   if base isn't a register, r15=PC is implied base, so it must be a local label.
   pascal constants don't make sense, because implied r15
@@ -448,25 +451,26 @@ Unit raarmgas;
 
           Begin
             case actasmtoken of
-              AS_ID : 
+              AS_ID :
                 begin
-                  if is_locallabel(actasmpattern) then 
+                  if is_locallabel(actasmpattern) then
                     begin
                       CreateLocalLabel(actasmpattern,lab,false);
                       oper.opr.ref.symbol := lab;
+                      oper.opr.ref.base := NR_PC;
                       Consume(AS_ID);
                       test_end(true);
                       exit;
-                    end 
-                  else 
+                    end
+                  else
                     begin
-                      // TODO: Stackpointer implied, 
+                      // TODO: Stackpointer implied,
                       Message(asmr_e_invalid_reference_syntax);
                       RecoverConsume(false);
                       exit;
                     end;
                 end;
-              else 
+              else
                 begin // elsecase
                   Message(asmr_e_invalid_reference_syntax);
                   RecoverConsume(false);
@@ -544,6 +548,7 @@ Unit raarmgas;
              begin
                oper.InitRef;
                oper.opr.ref.symbol:=hl;
+               oper.opr.ref.base:=NR_PC;
              end;
           end;
 
@@ -650,7 +655,7 @@ Unit raarmgas;
           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
@@ -1066,7 +1071,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

@@ -25,52 +25,52 @@ NR_F5 = tregister($02000005);
 NR_F6 = tregister($02000006);
 NR_F7 = tregister($02000007);
 NR_S0 = tregister($04060000);
-NR_S1 = tregister($04060000);
+NR_S1 = tregister($04060020);
 NR_D0 = tregister($04070000);
 NR_S2 = tregister($04060001);
-NR_S3 = tregister($04060001);
+NR_S3 = tregister($04060021);
 NR_D1 = tregister($04070001);
 NR_S4 = tregister($04060002);
-NR_S5 = tregister($04060002);
+NR_S5 = tregister($04060022);
 NR_D2 = tregister($04070002);
 NR_S6 = tregister($04060003);
-NR_S7 = tregister($04060003);
+NR_S7 = tregister($04060023);
 NR_D3 = tregister($04070003);
 NR_S8 = tregister($04060004);
-NR_S9 = tregister($04060004);
+NR_S9 = tregister($04060024);
 NR_D4 = tregister($04070004);
 NR_S10 = tregister($04060005);
-NR_S11 = tregister($04060005);
+NR_S11 = tregister($04060025);
 NR_D5 = tregister($04070005);
 NR_S12 = tregister($04060006);
-NR_S13 = tregister($04060006);
+NR_S13 = tregister($04060026);
 NR_D6 = tregister($04070006);
 NR_S14 = tregister($04060007);
-NR_S15 = tregister($04060007);
+NR_S15 = tregister($04060027);
 NR_D7 = tregister($04070007);
 NR_S16 = tregister($04060008);
-NR_S17 = tregister($04060008);
+NR_S17 = tregister($04060028);
 NR_D8 = tregister($04070008);
 NR_S18 = tregister($04060009);
-NR_S19 = tregister($04060009);
+NR_S19 = tregister($04060029);
 NR_D9 = tregister($04070009);
 NR_S20 = tregister($0406000A);
-NR_S21 = tregister($0406000A);
+NR_S21 = tregister($0406002A);
 NR_D10 = tregister($0407000A);
 NR_S22 = tregister($0406000B);
-NR_S23 = tregister($0406000B);
+NR_S23 = tregister($0406002B);
 NR_D11 = tregister($0407000B);
 NR_S24 = tregister($0406000C);
-NR_S25 = tregister($0406000C);
+NR_S25 = tregister($0406002C);
 NR_D12 = tregister($0407000C);
 NR_S26 = tregister($0406000D);
-NR_S27 = tregister($0406000D);
+NR_S27 = tregister($0406002D);
 NR_D13 = tregister($0407000D);
 NR_S28 = tregister($0406000E);
-NR_S29 = tregister($0406000E);
+NR_S29 = tregister($0406002E);
 NR_D14 = tregister($0407000E);
 NR_S30 = tregister($0406000F);
-NR_S31 = tregister($0406000F);
+NR_S31 = tregister($0406002F);
 NR_D15 = tregister($0407000F);
 NR_D16 = tregister($04070010);
 NR_D17 = tregister($04070011);

compiler/arm/rarmnum.inc

@@ -25,52 +25,52 @@ tregister($02000005),
 tregister($02000006),
 tregister($02000007),
 tregister($04060000),
-tregister($04060000),
+tregister($04060020),
 tregister($04070000),
 tregister($04060001),
-tregister($04060001),
+tregister($04060021),
 tregister($04070001),
 tregister($04060002),
-tregister($04060002),
+tregister($04060022),
 tregister($04070002),
 tregister($04060003),
-tregister($04060003),
+tregister($04060023),
 tregister($04070003),
 tregister($04060004),
-tregister($04060004),
+tregister($04060024),
 tregister($04070004),
 tregister($04060005),
-tregister($04060005),
+tregister($04060025),
 tregister($04070005),
 tregister($04060006),
-tregister($04060006),
+tregister($04060026),
 tregister($04070006),
 tregister($04060007),
-tregister($04060007),
+tregister($04060027),
 tregister($04070007),
 tregister($04060008),
-tregister($04060008),
+tregister($04060028),
 tregister($04070008),
 tregister($04060009),
-tregister($04060009),
+tregister($04060029),
 tregister($04070009),
 tregister($0406000A),
-tregister($0406000A),
+tregister($0406002A),
 tregister($0407000A),
 tregister($0406000B),
-tregister($0406000B),
+tregister($0406002B),
 tregister($0407000B),
 tregister($0406000C),
-tregister($0406000C),
+tregister($0406002C),
 tregister($0407000C),
 tregister($0406000D),
-tregister($0406000D),
+tregister($0406002D),
 tregister($0407000D),
 tregister($0406000E),
-tregister($0406000E),
+tregister($0406002E),
 tregister($0407000E),
 tregister($0406000F),
-tregister($0406000F),
+tregister($0406002F),
 tregister($0407000F),
 tregister($04070010),
 tregister($04070011),

compiler/arm/rarmrni.inc

@@ -25,37 +25,37 @@
 23,
 24,
 25,
-26,
-29,
 28,
 31,
-32,
-35,
 34,
 37,
-38,
-41,
 40,
 43,
-44,
-47,
 46,
 49,
-50,
-53,
 52,
 55,
-56,
-59,
 58,
 61,
-62,
-65,
 64,
 67,
+70,
+26,
+29,
+32,
+35,
+38,
+41,
+44,
+47,
+50,
+53,
+56,
+59,
+62,
+65,
 68,
 71,
-70,
 27,
 30,
 33,

compiler/arm/rarmsri.inc

@@ -72,7 +72,6 @@
 53,
 28,
 55,
-70,
 71,
 56,
 58,
@@ -84,6 +83,7 @@
 67,
 68,
 29,
+70,
 31,
 32,
 34,

compiler/arm/rarmstd.inc

@@ -69,7 +69,7 @@
 's28',
 's29',
 'd14',
-'s20',
+'s30',
 's21',
 'd15',
 'd16',

compiler/arm/rarmsup.inc

@@ -25,52 +25,52 @@ RS_F5 = $05;
 RS_F6 = $06;
 RS_F7 = $07;
 RS_S0 = $00;
-RS_S1 = $00;
+RS_S1 = $20;
 RS_D0 = $00;
 RS_S2 = $01;
-RS_S3 = $01;
+RS_S3 = $21;
 RS_D1 = $01;
 RS_S4 = $02;
-RS_S5 = $02;
+RS_S5 = $22;
 RS_D2 = $02;
 RS_S6 = $03;
-RS_S7 = $03;
+RS_S7 = $23;
 RS_D3 = $03;
 RS_S8 = $04;
-RS_S9 = $04;
+RS_S9 = $24;
 RS_D4 = $04;
 RS_S10 = $05;
-RS_S11 = $05;
+RS_S11 = $25;
 RS_D5 = $05;
 RS_S12 = $06;
-RS_S13 = $06;
+RS_S13 = $26;
 RS_D6 = $06;
 RS_S14 = $07;
-RS_S15 = $07;
+RS_S15 = $27;
 RS_D7 = $07;
 RS_S16 = $08;
-RS_S17 = $08;
+RS_S17 = $28;
 RS_D8 = $08;
 RS_S18 = $09;
-RS_S19 = $09;
+RS_S19 = $29;
 RS_D9 = $09;
 RS_S20 = $0A;
-RS_S21 = $0A;
+RS_S21 = $2A;
 RS_D10 = $0A;
 RS_S22 = $0B;
-RS_S23 = $0B;
+RS_S23 = $2B;
 RS_D11 = $0B;
 RS_S24 = $0C;
-RS_S25 = $0C;
+RS_S25 = $2C;
 RS_D12 = $0C;
 RS_S26 = $0D;
-RS_S27 = $0D;
+RS_S27 = $2D;
 RS_D13 = $0D;
 RS_S28 = $0E;
-RS_S29 = $0E;
+RS_S29 = $2E;
 RS_D14 = $0E;
 RS_S30 = $0F;
-RS_S31 = $0F;
+RS_S31 = $2F;
 RS_D15 = $0F;
 RS_D16 = $10;
 RS_D17 = $11;

compiler/asmutils.pas

@@ -26,26 +26,26 @@ interface
 {$i fpcdefs.inc}
 
 uses
+  globtype,
   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;
+    function emit_ansistring_const(list:TAsmList;data:PChar;len:LongInt;encoding:tstringencoding;NewSection:Boolean=True):TAsmLabel;
+    function emit_unicodestring_const(list:TAsmList;data:Pointer;encoding:tstringencoding;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;
+    function emit_ansistring_const(list:TAsmList;data:PChar;len:LongInt;encoding:tstringencoding;NewSection:Boolean): TAsmLabel;
       var
         referencelab: TAsmLabel;
         s: PChar;
@@ -59,6 +59,12 @@ uses
             current_asmdata.getdatalabel(referencelab);
             list.concat(tai_label.create(referencelab));
           end;
+        list.concat(tai_const.create_16bit(encoding));
+        list.concat(tai_const.create_16bit(1));
+{$ifdef cpu64bitaddr}
+        { dummy for alignment }
+        list.concat(tai_const.create_32bit(0));
+{$endif cpu64bitaddr}
         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 }
@@ -75,7 +81,8 @@ uses
         list.concat(tai_string.create_pchar(s,len+1)); { terminating zero included }
       end;
 
-    function emit_unicodestring_const(list:TAsmList;data:Pointer;Winlike:Boolean):TAsmLabel;
+
+    function emit_unicodestring_const(list:TAsmList;data:Pointer;encoding:tstringencoding;Winlike:Boolean):TAsmLabel;
       var
         referencelab: TAsmLabel;
         i, strlength: SizeInt;
@@ -90,11 +97,17 @@ uses
           end;
         strlength := getlengthwidestring(pcompilerwidestring(data));
         if Winlike then
-           list.concat(Tai_const.Create_32bit(strlength*cwidechartype.size))
+          list.concat(Tai_const.Create_32bit(strlength*cwidechartype.size))
         else
           begin
+            list.concat(tai_const.create_16bit(encoding));
+            list.concat(tai_const.create_16bit(2));
+    {$ifdef cpu64bitaddr}
+            { dummy for alignment }
+            list.concat(Tai_const.Create_32bit(0));
+    {$endif cpu64bitaddr}
             list.concat(Tai_const.Create_pint(-1));
-            list.concat(Tai_const.Create_pint(strlength*cwidechartype.size));
+            list.concat(Tai_const.Create_pint(strlength));
           end;
         { make sure the string doesn't get dead stripped if the header is referenced }
         if (target_info.system in systems_darwin) then

compiler/assemble.pas

@@ -320,9 +320,9 @@ Implementation
            hs:=s;
            if hs[length(hs)] in ['/','\'] then
             delete(hs,length(hs),1);
-           {$I-}
+           {$push} {$I-}
             mkdir(hs);
-           {$I+}
+           {$pop}
            if ioresult<>0 then;
          end;
       end;
@@ -405,9 +405,9 @@ Implementation
         else
          begin
            assign(g,AsmFileName);
-           {$I-}
+           {$push} {$I-}
             erase(g);
-           {$I+}
+           {$pop}
            if ioresult<>0 then;
          end;
       end;
@@ -444,9 +444,9 @@ Implementation
         if outcnt>0 then
          begin
            { suppress i/o error }
-           {$i-}
+           {$push} {$I-}
            BlockWrite(outfile,outbuf,outcnt);
-           {$i+}
+           {$pop}
            ioerror:=ioerror or (ioresult<>0);
            outcnt:=0;
          end;
@@ -627,9 +627,9 @@ Implementation
 {$endif}
          begin
            Assign(outfile,AsmFileName);
-           {$I-}
+           {$push} {$I-}
            Rewrite(outfile,1);
-           {$I+}
+           {$pop}
            if ioresult<>0 then
              begin
                ioerror:=true;
@@ -661,9 +661,9 @@ Implementation
            if ppufilename<>'' then
             begin
               Assign(f,ppufilename);
-              {$I-}
+              {$push} {$I-}
               reset(f,1);
-              {$I+}
+              {$pop}
               if ioresult=0 then
                begin
                  FileAge := FileGetDate(GetFileHandle(f));
@@ -1155,9 +1155,9 @@ Implementation
                      ;
                    asd_lazy_reference:
                      begin
-                       if tai_directive(hp).name = nil then
+                       if tai_directive(hp).name='' then
                          Internalerror(2009112101);
-                       objsym:=ObjData.symbolref(tai_directive(hp).name^);
+                       objsym:=ObjData.symbolref(tai_directive(hp).name);
                        objsym.bind:=AB_LAZY;
                      end;
                    asd_reference:
@@ -1292,9 +1292,9 @@ Implementation
                begin
                  case tai_directive(hp).directive of
                    asd_indirect_symbol:
-                     if tai_directive(hp).name = nil then
+                     if tai_directive(hp).name='' then
                        Internalerror(2009101103)
-                     else if not SetIndirectToSymbol(Tai(hp.Previous), tai_directive(hp).name^) then
+                     else if not SetIndirectToSymbol(Tai(hp.Previous), tai_directive(hp).name) then
                        Internalerror(2009101102);
                    asd_lazy_reference:
                      { handled in TreePass0 }
@@ -1347,6 +1347,13 @@ Implementation
                begin
                  ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_symbol(hp).sym));
                end;
+            ait_symbol_end :
+               begin
+                 { recalculate size, as some preceding instructions
+                   could have been changed to smaller size }
+                 objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym);
+                 objsym.size:=ObjData.CurrObjSec.Size-objsym.offset;
+               end;
              ait_datablock :
                begin
                  ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_datablock(hp).sym));
@@ -1446,6 +1453,10 @@ Implementation
              ait_cutobject :
                if SmartAsm then
                 break;
+{$ifdef TEST_WIN64_SEH}
+             ait_seh_directive :
+               tai_seh_directive(hp).generate_code(objdata);
+{$endif TEST_WIN64_SEH}
            end;
            hp:=Tai(hp.next);
          end;

compiler/avr/aasmcpu.pas

@@ -29,7 +29,8 @@ uses
   cclasses,
   globtype,globals,verbose,
   aasmbase,aasmtai,aasmdata,aasmsym,
-  cgbase,cgutils,cpubase,cpuinfo;
+  cgbase,cgutils,cpubase,cpuinfo,
+  ogbase;
 
     const
       { "mov reg,reg" source operand number }
@@ -37,7 +38,19 @@ uses
       { "mov reg,reg" source operand number }
       O_MOV_DEST = 0;
 
+      maxinfolen = 5;
+
     type
+      tinsentry = record
+        opcode  : tasmop;
+        ops     : byte;
+        optypes : array[0..3] of longint;
+        code    : array[0..maxinfolen] of char;
+        flags   : longint;
+      end;
+
+      pinsentry=^tinsentry;
+
       taicpu = class(tai_cpu_abstract_sym)
          constructor op_none(op : tasmop);
 
@@ -61,6 +74,24 @@ uses
 
          { register spilling code }
          function spilling_get_operation_type(opnr: longint): topertype;override;
+
+         { assembler }
+      public
+         { the next will reset all instructions that can change in pass 2 }
+         procedure ResetPass1;override;
+         procedure ResetPass2;override;
+{         function  CheckIfValid:boolean;
+         function GetString:string; }
+         function  Pass1(objdata:TObjData):longint;override;
+//         procedure Pass2(objdata:TObjData);override;
+         function calcsize(p:PInsEntry):shortint;
+      private
+         { next fields are filled in pass1, so pass2 is faster }
+         inssize   : shortint;
+         insoffset : longint;
+         insentry  : PInsEntry;
+         LastInsOffset : longint; { need to be public to be reset }
+         function  FindInsentry(objdata:TObjData):boolean;
       end;
 
       tai_align = class(tai_align_abstract)
@@ -75,6 +106,10 @@ uses
 
     function setcondition(i : taicpu;c : tasmcond) : taicpu;
 
+    { replaces cond. branches by rjmp/jmp and the inverse cond. branch if needed
+      and transforms special instructions to valid instruction encodings }
+    procedure finalizeavrcode(list : TAsmList);
+
 implementation
 
 {*****************************************************************************
@@ -222,6 +257,85 @@ implementation
       end;
 
 
+    function  taicpu.calcsize(p:PInsEntry):shortint;
+      begin
+        case opcode of
+          A_CALL,
+          A_JMP:
+            result:=4;
+          A_LDS:
+            if (getsupreg(oper[0]^.reg)>=RS_R16) and (getsupreg(oper[0]^.reg)<=RS_R31) and
+              (oper[1]^.val>=0) and (oper[1]^.val<=127) then
+              result:=2
+            else
+              result:=4;
+          A_STS:
+            if (getsupreg(oper[1]^.reg)>=RS_R16) and (getsupreg(oper[1]^.reg)<=RS_R31) and
+              (oper[0]^.val>=0) and (oper[0]^.val<=127) then
+              result:=2
+            else
+              result:=4;
+        else
+          result:=2;
+        end;
+      end;
+
+
+    procedure taicpu.ResetPass1;
+      begin
+        { we need to reset everything here, because the choosen insentry
+          can be invalid for a new situation where the previously optimized
+          insentry is not correct }
+        InsEntry:=nil;
+        InsSize:=0;
+        LastInsOffset:=-1;
+      end;
+
+
+    procedure taicpu.ResetPass2;
+      begin
+        { we are here in a second pass, check if the instruction can be optimized }
+{
+        if assigned(InsEntry) and
+           ((InsEntry^.flags and IF_PASS2)<>0) then
+         begin
+           InsEntry:=nil;
+           InsSize:=0;
+         end;
+}
+        LastInsOffset:=-1;
+      end;
+
+
+    function taicpu.FindInsentry(objdata:TObjData):boolean;
+      begin
+        result:=false;
+      end;
+
+
+    function taicpu.Pass1(objdata:TObjData):longint;
+      begin
+        Pass1:=0;
+        { Save the old offset and set the new offset }
+        InsOffset:=ObjData.CurrObjSec.Size;
+        InsSize:=calcsize(InsEntry);
+        { Error? }
+        if (Insentry=nil) and (InsSize=-1) then
+          exit;
+        { set the file postion }
+        current_filepos:=fileinfo;
+
+        { Get InsEntry }
+        if FindInsEntry(objdata) then
+         begin
+           LastInsOffset:=InsOffset;
+           Pass1:=InsSize;
+           exit;
+         end;
+        LastInsOffset:=-1;
+      end;
+
+
     function spilling_create_load(const ref:treference;r:tregister):Taicpu;
       begin
         case getregtype(r) of
@@ -277,6 +391,65 @@ implementation
       end;
 
 
+    procedure finalizeavrcode(list : TAsmList);
+      var
+        CurrOffset : longint;
+        curtai : tai;
+        again : boolean;
+        l : tasmlabel;
+      begin
+        again:=true;
+        while again do
+          begin
+            again:=false;
+            CurrOffset:=0;
+            curtai:=tai(list.first);
+            while assigned(curtai) do
+              begin
+                { instruction? }
+                if not(curtai.typ in SkipInstr) then
+                  case curtai.typ of
+                    ait_instruction:
+                      begin
+                        taicpu(curtai).InsOffset:=CurrOffset;
+                        inc(CurrOffset,taicpu(curtai).calcsize(nil));
+                      end;
+                    ait_align:
+                      inc(CurrOffset,tai_align(curtai).aligntype);
+                    ait_marker:
+                      ;
+                    ait_label:
+                      begin
+                        tai_label(curtai).labsym.offset:=CurrOffset;
+                      end;
+                    else
+                      internalerror(2011082401);
+                  end;
+                curtai:=tai(curtai.next);
+              end;
+
+            curtai:=tai(list.first);
+            while assigned(curtai) do
+              begin
+                if (curtai.typ=ait_instruction) and
+                  (taicpu(curtai).opcode in [A_BRxx]) and
+                  ((taicpu(curtai).InsOffset-taicpu(curtai).oper[0]^.ref^.symbol.offset>64) or
+                   (taicpu(curtai).InsOffset-taicpu(curtai).oper[0]^.ref^.symbol.offset<-63)
+                  ) then
+                  begin
+                    current_asmdata.getjumplabel(l);
+                    list.insertafter(tai_label.create(l),curtai);
+                    list.insertafter(taicpu.op_sym(A_JMP,taicpu(curtai).oper[0]^.ref^.symbol),curtai);
+                    taicpu(curtai).oper[0]^.ref^.symbol:=l;
+                    taicpu(curtai).condition:=inverse_cond(taicpu(curtai).condition);
+                    again:=true;
+                  end;
+                curtai:=tai(curtai.next);
+              end;
+          end;
+      end;
+
+
 begin
   cai_cpu:=taicpu;
   cai_align:=tai_align;

compiler/avr/agavrgas.pas

@@ -208,6 +208,7 @@ unit agavrgas;
             flags : [af_allowdirect,af_needar,af_smartlink_sections];
             labelprefix : '.L';
             comment : '# ';
+            dollarsign: 's';
           );
 
 

compiler/avr/aoptcpub.pas

@@ -25,13 +25,7 @@ Unit aoptcpub; { Assembler OPTimizer CPU specific Base }
 
 {$i fpcdefs.inc}
 
-{ enable the following define if memory references can have both a base and }
-{ index register in 1 operand                                               }
-
-{$define RefsHaveIndexReg}
-
 { enable the following define if memory references can have a scaled index }
-
 { define RefsHaveScale}
 
 { enable the following define if memory references can have a segment }

compiler/avr/cgcpu.pas

@@ -64,6 +64,11 @@ unit cgcpu;
         procedure a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override;
         procedure a_load_reg_reg(list : TAsmList; fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
 
+        { fpu move instructions }
+        procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override;
+        procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override;
+        procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override;
+
         {  comparison operations }
         procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister;
           l : tasmlabel);override;
@@ -94,11 +99,14 @@ unit cgcpu;
           tmpreg : tregister) : treference;
 
         procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
+        procedure g_stackpointer_alloc(list : TAsmList;size : longint);override;
         procedure emit_mov(list: TAsmList;reg2: tregister; reg1: tregister);
 
         procedure a_adjust_sp(list: TAsmList; value: longint);
         function GetLoad(const ref : treference) : tasmop;
         function GetStore(const ref: treference): tasmop;
+
+        procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override;
       end;
 
       tcg64favr = class(tcg64f32)
@@ -1076,6 +1084,24 @@ unit cgcpu;
        end;
 
 
+     procedure tcgavr.a_loadfpu_reg_reg(list: TAsmList; fromsize,tosize: tcgsize; reg1, reg2: tregister);
+       begin
+         internalerror(2012010702);
+       end;
+
+
+     procedure tcgavr.a_loadfpu_ref_reg(list: TAsmList; fromsize,tosize: tcgsize; const ref: treference; reg: tregister);
+       begin
+         internalerror(2012010703);
+       end;
+
+
+     procedure tcgavr.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference);
+       begin
+         internalerror(2012010704);
+       end;
+
+
     {  comparison operations }
     procedure tcgavr.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;
       cmp_op : topcmp;a : tcgint;reg : tregister;l : tasmlabel);
@@ -1180,6 +1206,12 @@ unit cgcpu;
       end;
 
 
+    procedure tcgavr.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister);
+      begin
+        Comment(V_Error,'tcgarm.a_bit_scan_reg_reg method not implemented');
+      end;
+
+
     procedure tcgavr.a_jmp_name(list : TAsmList;const s : string);
       var
         ai : taicpu;
@@ -1605,27 +1637,79 @@ unit cgcpu;
 
     procedure tcgavr.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
       var
-        ai : taicpu;
+        ai1,ai2 : taicpu;
+        hl : TAsmLabel;
       begin
-        { TODO : fix a_jmp_cond }
-      {
-        ai:=Taicpu.Op_sym(A_BRxx,l);
+        ai1:=Taicpu.Op_sym(A_BRxx,l);
+        ai1.is_jmp:=true;
+        hl:=nil;
         case cond of
           OC_EQ:
-            ai.SetCondition(C_EQ);
-          OC_GT
-          OC_LT
-          OC_GTE
-          OC_LTE
-          OC_NE
-          OC_BE
-          OC_B
-          OC_AE
+            ai1.SetCondition(C_EQ);
+          OC_GT:
+            begin
+              { emulate GT }
+              current_asmdata.getjumplabel(hl);
+              ai2:=Taicpu.Op_Sym(A_BRxx,hl);
+              ai2.SetCondition(C_EQ);
+              ai2.is_jmp:=true;
+              list.concat(ai2);
+
+              ai1.SetCondition(C_GE);
+            end;
+          OC_LT:
+            ai1.SetCondition(C_LT);
+          OC_GTE:
+            ai1.SetCondition(C_GE);
+          OC_LTE:
+            begin
+              { emulate LTE }
+              ai2:=Taicpu.Op_Sym(A_BRxx,l);
+              ai2.SetCondition(C_EQ);
+              ai2.is_jmp:=true;
+              list.concat(ai2);
+
+              ai1.SetCondition(C_LT);
+            end;
+          OC_NE:
+            ai1.SetCondition(C_NE);
+          OC_BE:
+            begin
+              { emulate BE }
+              ai2:=Taicpu.Op_Sym(A_BRxx,l);
+              ai2.SetCondition(C_EQ);
+              ai2.is_jmp:=true;
+              list.concat(ai2);
+
+              ai1.SetCondition(C_LO);
+            end;
+          OC_B:
+            ai1.SetCondition(C_LO);
+          OC_AE:
+            ai1.SetCondition(C_SH);
           OC_A:
+            begin
+              { emulate A (unsigned GT) }
+              current_asmdata.getjumplabel(hl);
+              ai2:=Taicpu.Op_Sym(A_BRxx,hl);
+              ai2.SetCondition(C_EQ);
+              ai2.is_jmp:=true;
+              list.concat(ai2);
+
+              ai1.SetCondition(C_SH);
+            end;
+          else
+            internalerror(2011082501);
+        end;
+        list.concat(ai1);
+        if assigned(hl) then
+          a_label(list,hl);
+      end;
 
-        ai.is_jmp:=true;
-        list.concat(ai);
-        }
+
+    procedure tcgavr.g_stackpointer_alloc(list: TAsmList; size: longint);
+      begin
+        internalerror(201201071);
       end;
 
 

compiler/avr/cpubase.pas

@@ -458,4 +458,5 @@ unit cpubase;
         result:=TRegister(longint(r)+ofs);
       end;
 
+
 end.

compiler/avr/cpuinfo.pas

@@ -112,23 +112,75 @@ Const
      'LIBGCC'
    );
 
-   controllertypestr : array[tcontrollertype] of string[20] =
-     ('',
-      'ATMEGA16',
-      'ATMEGA32',
-      'ATMEGA48',
-      'ATMEGA64',
-      'ATMEGA128'
-     );
+   embedded_controllers : array [tcontrollertype] of tcontrollerdatatype =
+   ((
+   	controllertypestr:'';
+        controllerunitstr:'';
+        interruptvectors:0;
+        flashbase:0;
+        flashsize:0;
+        srambase:0;
+        sramsize:0;
+        eeprombase:0;
+        eepromsize:0
+   	),
+        (
+   	controllertypestr:'ATMEGA16';
+        controllerunitstr:'ATMEGA16';
+        interruptvectors:0;
+        flashbase:0;
+        flashsize:$4000;
+        srambase:0;
+        sramsize:1024;
+        eeprombase:0;
+        eepromsize:512
+        ),
+        (
+   	controllertypestr:'ATMEGA32';
+        controllerunitstr:'ATMEGA32';
+        interruptvectors:0;
+        flashbase:0;
+        flashsize:$8000;
+        srambase:0;
+        sramsize:1024;
+        eeprombase:0;
+        eepromsize:512
+        ),
+   	(
+        controllertypestr:'ATMEGA48';
+        controllerunitstr:'ATMEGA48';
+        interruptvectors:0;
+        flashbase:0;
+        flashsize:$1000;
+        srambase:0;
+        sramsize:512;
+        eeprombase:0;
+        eepromsize:256;
+        ),
+   	(
+        controllertypestr:'ATMEGA64';
+        controllerunitstr:'ATMEGA64';
+        interruptvectors:0;
+        flashbase:0;
+        flashsize:$10000;
+        srambase:0;
+        sramsize:4096;
+        eeprombase:0;
+        eepromsize:2048;
+        ),
+   	(
+        controllertypestr:'ATMEGA128';
+        controllerunitstr:'ATMEGA128';
+        interruptvectors:0;
+        flashbase:0;
+        flashsize:$20000;
+        srambase:0;
+        sramsize:4096;
+        eeprombase:0;
+        eepromsize:4096;
+        )
+   );
 
-   controllerunitstr : array[tcontrollertype] of string[20] =
-     ('',
-      'ATMEGA16',
-      'ATMEGA32',
-      'ATMEGA48',
-      'ATMEGA64',
-      'ATMEGA128'
-     );
    { Supported optimizations, only used for information }
    supported_optimizerswitches = genericlevel1optimizerswitches+
                                  genericlevel2optimizerswitches+

compiler/avr/cpupi.pas

@@ -63,6 +63,7 @@ unit cpupi;
     function tavrprocinfo.calc_stackframe_size:longint;
       begin
         maxpushedparasize:=align(maxpushedparasize,max(current_settings.alignment.localalignmin,4));
+        result:=0;
       end;
 
 

compiler/ccharset.pas

@@ -13,9 +13,6 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-
-{ this unit is included temporarily for 2.2 bootstrapping and can be
-  removed after the next release after 2.2.2 }
 {$mode objfpc}
 unit ccharset;
 
@@ -42,6 +39,7 @@ unit ccharset;
        punicodemap = ^tunicodemap;
        tunicodemap = record
           cpname : string[20];
+          cp : word;
           map : punicodecharmapping;
           lastchar : longint;
           next : punicodemap;
@@ -51,10 +49,15 @@ unit ccharset;
        tcp2unicode = class(tcsconvert)
        end;
 
-    function loadunicodemapping(const cpname,f : string) : punicodemap;
+    const
+       DefaultSystemCodePage = 437;
+
+    function loadunicodemapping(const cpname,f : string; cp :word) : punicodemap;
     procedure registermapping(p : punicodemap);
     function getmap(const s : string) : punicodemap;
+    function getmap(cp : word) : punicodemap;
     function mappingavailable(const s : string) : boolean;
+    function mappingavailable(cp :word) : boolean;
     function getunicode(c : char;p : punicodemap) : tunicodechar;
     function getascii(c : tunicodechar;p : punicodemap) : string;
 
@@ -63,7 +66,7 @@ unit ccharset;
     var
        mappings : punicodemap;
 
-    function loadunicodemapping(const cpname,f : string) : punicodemap;
+    function loadunicodemapping(const cpname,f : string; cp :word) : punicodemap;
 
       var
          data : punicodecharmapping;
@@ -158,6 +161,7 @@ unit ccharset;
          new(p);
          p^.lastchar:=lastchar;
          p^.cpname:=cpname;
+         p^.cp:=cp;
          p^.internalmap:=false;
          p^.next:=nil;
          p^.map:=data;
@@ -199,6 +203,36 @@ unit ccharset;
               hp:=hp^.next;
            end;
          getmap:=nil;
+      end;////////
+
+    function getmap(cp : word) : punicodemap;
+
+      var
+         hp : punicodemap;
+
+      const
+         mapcache : word = 0;
+         mapcachep : punicodemap = nil;
+
+      begin
+         if (mapcache=cp) and assigned(mapcachep) and (mapcachep^.cp=cp) then
+           begin
+              getmap:=mapcachep;
+              exit;
+           end;
+         hp:=mappings;
+         while assigned(hp) do
+           begin
+              if hp^.cp=cp then
+                begin
+                   getmap:=hp;
+                   mapcache:=cp;
+                   mapcachep:=hp;
+                   exit;
+                end;
+              hp:=hp^.next;
+           end;
+         getmap:=nil;
       end;
 
     function mappingavailable(const s : string) : boolean;
@@ -207,6 +241,12 @@ unit ccharset;
          mappingavailable:=getmap(s)<>nil;
       end;
 
+    function mappingavailable(cp : word) : boolean;
+
+      begin
+         mappingavailable:=getmap(cp)<>nil;
+      end;
+
     function getunicode(c : char;p : punicodemap) : tunicodechar;
 
       begin
@@ -222,8 +262,8 @@ unit ccharset;
          i : longint;
 
       begin
-         { at least map to space }
-         getascii:=#32;
+         { at least map to '?' }
+         getascii:=#63;
          for i:=0 to p^.lastchar do
            if p^.map[i].unicode=c then
              begin

compiler/cclasses.pas

@@ -46,7 +46,7 @@ interface
        tmemdebug = class
        private
           totalmem,
-          startmem : integer;
+          startmem : int64;
           infostr  : string[40];
        public
           constructor Create(const s:string);
@@ -440,6 +440,7 @@ type
 
      const
        dynamicblockbasesize = sizeof(tdynamicblock)-sizeof(tdynamicblockdata);
+       mindynamicblocksize = 8*sizeof(pointer);
 
      type
        tdynamicarray = class
@@ -486,13 +487,16 @@ type
        THashSet = class(TObject)
        private
          FCount: LongWord;
-         FBucketCount: LongWord;
-         FBucket: PPHashSetItem;
          FOwnsObjects: Boolean;
          FOwnsKeys: Boolean;
          function Lookup(Key: Pointer; KeyLen: Integer; var Found: Boolean;
            CanCreate: Boolean): PHashSetItem;
          procedure Resize(NewCapacity: LongWord);
+       protected
+         FBucket: PPHashSetItem;
+         FBucketCount: LongWord;
+         class procedure FreeItem(item:PHashSetItem); virtual;
+         class function SizeOfItem: Integer; virtual;
        public
          constructor Create(InitSize: Integer; OwnKeys, OwnObjects: Boolean);
          destructor Destroy; override;
@@ -509,7 +513,40 @@ type
          { removes an entry, returns False if entry wasn't there }
          function Remove(Entry: PHashSetItem): Boolean;
          property Count: LongWord read FCount;
-      end;
+       end;
+
+{******************************************************************
+                             TTagHasSet
+*******************************************************************}
+       PPTagHashSetItem = ^PTagHashSetItem;
+       PTagHashSetItem = ^TTagHashSetItem;
+       TTagHashSetItem = record
+         Next: PTagHashSetItem;
+         Key: Pointer;
+         KeyLength: Integer;
+         HashValue: LongWord;
+         Data: TObject;
+         Tag: LongWord;
+       end;
+
+       TTagHashSet = class(THashSet)
+       private
+         function Lookup(Key: Pointer; KeyLen: Integer; Tag: LongWord; var Found: Boolean;
+           CanCreate: Boolean): PTagHashSetItem;
+       protected
+         class procedure FreeItem(item:PHashSetItem); override;
+         class function SizeOfItem: Integer; override;
+       public
+         { finds an entry by key }
+         function Find(Key: Pointer; KeyLen: Integer; Tag: LongWord): PTagHashSetItem; reintroduce;
+         { finds an entry, creates one if not exists }
+         function FindOrAdd(Key: Pointer; KeyLen: Integer; Tag: LongWord;
+           var Found: Boolean): PTagHashSetItem; reintroduce;
+         { finds an entry, creates one if not exists }
+         function FindOrAdd(Key: Pointer; KeyLen: Integer; Tag: LongWord): PTagHashSetItem; reintroduce;
+         { returns Data by given Key }
+         function Get(Key: Pointer; KeyLen: Integer; Tag: LongWord): TObject; reintroduce;
+       end;
 
 
 {******************************************************************
@@ -543,6 +580,7 @@ type
 
     function FPHash(const s:shortstring):LongWord;
     function FPHash(P: PChar; Len: Integer): LongWord;
+    function FPHash(P: PChar; Len: Integer; Tag: LongWord): LongWord;
     function FPHash(const a:ansistring):LongWord;
 
 
@@ -1126,6 +1164,21 @@ end;
 {$pop}
       end;
 
+    function FPHash(P: PChar; Len: Integer; Tag: LongWord): LongWord;
+      Var
+        pmax : pchar;
+      begin
+{$push}
+{$q-,r-}
+        result:=Tag;
+        pmax:=p+len;
+        while (p<pmax) do
+          begin
+            result:=LongWord(LongInt(result shl 5) - LongInt(result)) xor LongWord(P^);
+            inc(p);
+          end;
+{$pop}
+      end;
 
     function FPHash(const a: ansistring): LongWord;
       begin
@@ -1240,8 +1293,10 @@ var
   i: longint;
 {$endif symansistr}
 begin
+{$push}{$warnings off}
   If (NewCapacity < FStrCount) or (NewCapacity > MaxHashStrSize) then
      Error (SListCapacityError, NewCapacity);
+{$pop}
   if NewCapacity = FStrCapacity then
     exit;
 {$ifdef symansistr}
@@ -2381,6 +2436,12 @@ end;
         FFirstblock:=nil;
         FLastblock:=nil;
         FCurrBlockSize:=0;
+        { Every block needs at least a header and alignment slack,
+          therefore its size cannot be arbitrarily small. However,
+          the blocksize argument is often confused with data size.
+          See e.g. Mantis #20929. }
+        if Ablocksize<mindynamicblocksize then
+          Ablocksize:=mindynamicblocksize;
         FMaxBlockSize:=Ablocksize;
         grow;
       end;
@@ -2434,7 +2495,7 @@ end;
       begin
         if CurrBlockSize<FMaxBlocksize then
           begin
-            IncSize := sizeof(ptrint)*8;
+            IncSize := mindynamicblocksize;
             if FCurrBlockSize > 255 then
               Inc(IncSize, FCurrBlockSize shr 2);
             inc(FCurrBlockSize,IncSize);
@@ -2675,7 +2736,7 @@ end;
               item^.Data.Free;
             if FOwnsKeys then
               FreeMem(item^.Key);
-            Dispose(item);
+            FreeItem(item);
             item := next;
           end;
         end;
@@ -2769,7 +2830,7 @@ end;
         i: Integer;
         e, n: PHashSetItem;
       begin
-        p := AllocMem(NewCapacity * sizeof(PHashSetItem));
+        p := AllocMem(NewCapacity * SizeOfItem);
         for i := 0 to FBucketCount-1 do
           begin
             e := FBucket[i];
@@ -2787,6 +2848,15 @@ end;
         FBucket := p;
       end;
 
+    class procedure THashSet.FreeItem(item: PHashSetItem);
+      begin
+        Dispose(item);
+      end;
+
+    class function THashSet.SizeOfItem: Integer;
+      begin
+        Result := SizeOf(THashSetItem);
+      end;
 
     function THashSet.Remove(Entry: PHashSetItem): Boolean;
       var
@@ -2802,7 +2872,7 @@ end;
                   Entry^.Data.Free;
                 if FOwnsKeys then
                   FreeMem(Entry^.Key);
-                Dispose(Entry);
+                FreeItem(Entry);
                 Dec(FCount);
                 Result := True;
                 Exit;
@@ -2813,6 +2883,96 @@ end;
       end;
 
 
+{****************************************************************************
+                                ttaghashset
+****************************************************************************}
+
+    function TTagHashSet.Lookup(Key: Pointer; KeyLen: Integer;
+      Tag: LongWord; var Found: Boolean; CanCreate: Boolean): PTagHashSetItem;
+      var
+        Entry: PPTagHashSetItem;
+        h: LongWord;
+      begin
+        h := FPHash(Key, KeyLen, Tag);
+        Entry := @PPTagHashSetItem(FBucket)[h mod FBucketCount];
+        while Assigned(Entry^) and
+          not ((Entry^^.HashValue = h) and (Entry^^.KeyLength = KeyLen) and
+            (Entry^^.Tag = Tag) and (CompareByte(Entry^^.Key^, Key^, KeyLen) = 0)) do
+              Entry := @Entry^^.Next;
+        Found := Assigned(Entry^);
+        if Found or (not CanCreate) then
+          begin
+            Result := Entry^;
+            Exit;
+          end;
+        if FCount > FBucketCount then  { arbitrary limit, probably too high }
+          begin
+            { rehash and repeat search }
+            Resize(FBucketCount * 2);
+            Result := Lookup(Key, KeyLen, Tag, Found, CanCreate);
+          end
+        else
+          begin
+            New(Result);
+            if FOwnsKeys then
+            begin
+              GetMem(Result^.Key, KeyLen);
+              Move(Key^, Result^.Key^, KeyLen);
+            end
+            else
+              Result^.Key := Key;
+            Result^.KeyLength := KeyLen;
+            Result^.HashValue := h;
+            Result^.Tag := Tag;
+            Result^.Data := nil;
+            Result^.Next := nil;
+            Inc(FCount);
+            Entry^ := Result;
+          end;
+      end;
+
+    class procedure TTagHashSet.FreeItem(item: PHashSetItem);
+      begin
+        Dispose(PTagHashSetItem(item));
+      end;
+
+    class function TTagHashSet.SizeOfItem: Integer;
+      begin
+        Result := SizeOf(TTagHashSetItem);
+      end;
+
+    function TTagHashSet.Find(Key: Pointer; KeyLen: Integer; Tag: LongWord): PTagHashSetItem;
+      var
+        Dummy: Boolean;
+      begin
+        Result := Lookup(Key, KeyLen, Tag, Dummy, False);
+      end;
+
+    function TTagHashSet.FindOrAdd(Key: Pointer; KeyLen: Integer; Tag: LongWord;
+      var Found: Boolean): PTagHashSetItem;
+      begin
+        Result := Lookup(Key, KeyLen, Tag, Found, True);
+      end;
+
+    function TTagHashSet.FindOrAdd(Key: Pointer; KeyLen: Integer; Tag: LongWord): PTagHashSetItem;
+      var
+        Dummy: Boolean;
+      begin
+        Result := Lookup(Key, KeyLen, Tag, Dummy, True);
+      end;
+
+    function TTagHashSet.Get(Key: Pointer; KeyLen: Integer; Tag: LongWord): TObject;
+      var
+        e: PTagHashSetItem;
+        Dummy: Boolean;
+      begin
+        e := Lookup(Key, KeyLen, Tag, Dummy, False);
+        if Assigned(e) then
+          Result := e^.Data
+        else
+          Result := nil;
+      end;
+
 {****************************************************************************
                                 tbitset
 ****************************************************************************}

compiler/cfileutl.pas

@@ -685,9 +685,9 @@ end;
       begin
         if d[length(d)]=source_info.DirSep then
          Delete(d,length(d),1);
-        {$I-}
+        {$push}{$I-}
          rmdir(d);
-        {$I+}
+        {$pop}
         RemoveDir:=(ioresult=0);
       end;
 

compiler/cgbase.pas

@@ -132,6 +132,10 @@ interface
           OC_A             { greater than (unsigned)          }
         );
 
+       { indirect symbol flags }
+       tindsymflag = (is_data,is_weak);
+       tindsymflags = set of tindsymflag;
+
        { OS_NO is also used memory references with large data that can
          not be loaded in a register directly }
        TCgSize = (OS_NO,

compiler/cgobj.pas

@@ -223,14 +223,10 @@ unit cgobj;
 
           {# Emits instruction to call the method specified by symbol name.
              This routine must be overridden for each new target cpu.
-
-             There is no a_call_ref because loading the reference will use
-             a temp register on most cpu's resulting in conflicts with the
-             registers used for the parameters (PFV)
           }
           procedure a_call_name(list : TAsmList;const s : string; weak: boolean);virtual; abstract;
           procedure a_call_reg(list : TAsmList;reg : tregister);virtual; abstract;
-          procedure a_call_ref(list : TAsmList;ref : treference);virtual; abstract;
+          procedure a_call_ref(list : TAsmList;ref : treference);virtual;
           { same as a_call_name, might be overridden on certain architectures to emit
             static calls without usage of a got trampoline }
           procedure a_call_name_static(list : TAsmList;const s : string);virtual;
@@ -450,7 +446,6 @@ unit cgobj;
           procedure g_copyvariant(list : TAsmList;const source,dest : treference);
 
           procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);
-          procedure g_decrrefcount(list : TAsmList;t: tdef; const ref: treference);
           procedure g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation;
             const name: string);
           procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);
@@ -520,7 +515,7 @@ unit cgobj;
           procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);virtual;abstract;
           procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);virtual;
 
-          function g_indirect_sym_load(list:TAsmList;const symname: string; weak: boolean): tregister;virtual;
+          function g_indirect_sym_load(list:TAsmList;const symname: string; const flags: tindsymflags): tregister;virtual;
           { generate a stub which only purpose is to pass control the given external method,
           setting up any additional environment before doing so (if required).
 
@@ -529,6 +524,11 @@ unit cgobj;
 
           { initialize the pic/got register }
           procedure g_maybe_got_init(list: TAsmList); virtual;
+          { allocallcpuregisters, a_call_name, deallocallcpuregisters sequence }
+          procedure g_call(list: TAsmList; const s: string);
+          { Generate code to exit an unwind-protected region. The default implementation
+            produces a simple jump to destination label. }
+          procedure g_local_unwind(list: TAsmList; l: TAsmLabel);virtual;
         protected
           procedure get_subsetref_load_info(const sref: tsubsetreference; out loadsize: tcgsize; out extra_load: boolean);
           procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); virtual;
@@ -628,6 +628,8 @@ unit cgobj;
        cg64 : tcg64;
 {$endif cpu64bitalu}
 
+    function asmsym2indsymflags(sym: TAsmSymbol): tindsymflags;
+
     procedure destroy_codegen;
 
 implementation
@@ -897,6 +899,8 @@ implementation
       begin
          cgpara.check_simple_location;
          paramanager.alloccgpara(list,cgpara);
+         if cgpara.location^.shiftval<0 then
+           a_op_const_reg(list,OP_SHL,cgpara.location^.size,-cgpara.location^.shiftval,r);
          case cgpara.location^.loc of
             LOC_REGISTER,LOC_CREGISTER:
               a_load_reg_reg(list,size,cgpara.location^.size,r,cgpara.location^.register);
@@ -972,6 +976,8 @@ implementation
                      begin
                        cgpara.check_simple_location;
                        a_load_ref_reg(list,size,location^.size,tmpref,location^.register);
+                       if location^.shiftval<0 then
+                         a_op_const_reg(list,OP_SHL,location^.size,-location^.shiftval,location^.register);
                      end
                    { there's a lot more data left, and the current paraloc's
                      register is entirely filled with part of that data }
@@ -985,6 +991,8 @@ implementation
                    else if (sizeleft in [1,2{$ifndef cpu16bitalu},4{$endif}{$ifdef cpu64bitalu},8{$endif}]) then
                      begin
                        a_load_ref_reg(list,int_cgsize(sizeleft),location^.size,tmpref,location^.register);
+                       if location^.shiftval<0 then
+                         a_op_const_reg(list,OP_SHL,location^.size,-location^.shiftval,location^.register);
                      end
                    { we're at the end of the data, and we need multiple loads
                      to get it in the register because it's an irregular size }
@@ -1045,6 +1053,8 @@ implementation
                              a_load_reg_reg(list,location^.size,location^.size,tmpreg,location^.register);
                            inc(tmpref.offset);
                          end;
+                       if location^.shiftval<0 then
+                         a_op_const_reg(list,OP_SHL,location^.size,-location^.shiftval,location^.register);
                        { the loop will already adjust the offset and sizeleft }
                        dec(tmpref.offset,orgsizeleft);
                        sizeleft:=orgsizeleft;
@@ -1126,15 +1136,28 @@ implementation
     procedure tcg.a_load_cgparaloc_ref(list : TAsmList;const paraloc : TCGParaLocation;const ref : treference;sizeleft : tcgint;align : longint);
       var
         href : treference;
+        hreg : tregister;
+        cgsize: tcgsize;
       begin
          case paraloc.loc of
            LOC_REGISTER :
              begin
-{$IFDEF POWERPC64}
-               if (paraloc.shiftval <> 0) then
-                 a_op_const_reg_reg(list, OP_SHL, OS_INT, paraloc.shiftval, paraloc.register, paraloc.register);
-{$ENDIF POWERPC64}
-               a_load_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref);
+               hreg:=paraloc.register;
+               cgsize:=paraloc.size;
+               if paraloc.shiftval>0 then
+                 a_op_const_reg_reg(list,OP_SHL,OS_INT,paraloc.shiftval,paraloc.register,paraloc.register)
+               else if (paraloc.shiftval<0) and
+                       (sizeleft in [1,2,4]) then
+                 begin
+                   a_op_const_reg_reg(list,OP_SHR,OS_INT,-paraloc.shiftval,paraloc.register,paraloc.register);
+                   { convert to a register of 1/2/4 bytes in size, since the
+                     original register had to be made larger to be able to hold
+                     the shifted value }
+                   cgsize:=int_cgsize(tcgsize2size[OS_INT]-(-paraloc.shiftval div 8));
+                   hreg:=getintregister(list,cgsize);
+                   a_load_reg_reg(list,OS_INT,cgsize,paraloc.register,hreg);
+                 end;
+               a_load_reg_ref(list,paraloc.size,cgsize,hreg,ref);
              end;
            LOC_MMREGISTER :
              begin
@@ -1173,6 +1196,8 @@ implementation
          case paraloc.loc of
            LOC_REGISTER :
              begin
+               if paraloc.shiftval<0 then
+                 a_op_const_reg_reg(list,OP_SHR,OS_INT,-paraloc.shiftval,paraloc.register,paraloc.register);
                case getregtype(reg) of
                  R_INTREGISTER:
                    a_load_reg_reg(list,paraloc.size,regsize,paraloc.register,reg);
@@ -1234,15 +1259,9 @@ implementation
                        some generic implementations
 ****************************************************************************}
 
-{$ifopt r+}
-{$define rangeon}
+{$push}
 {$r-}
-{$endif}
-
-{$ifopt q+}
-{$define overflowon}
 {$q-}
-{$endif}
 
    procedure tcg.a_load_subsetreg_reg(list : TAsmList; subsetsize, tosize: tcgsize; const sreg: tsubsetregister; destreg: tregister);
      var
@@ -2119,15 +2138,7 @@ implementation
       end;
 
 
-{$ifdef rangeon}
-{$r+}
-{$undef rangeon}
-{$endif}
-
-{$ifdef overflowon}
-{$q+}
-{$undef overflowon}
-{$endif}
+{$pop}
 
     { generic bit address calculation routines }
 
@@ -3209,6 +3220,8 @@ implementation
 
 
     procedure tcg.a_loadmm_loc_reg(list: TAsmList; size: tcgsize; const loc: tlocation; const reg: tregister;shuffle : pmmshuffle);
+      var
+        tmpreg: tregister;
       begin
         case loc.loc of
           LOC_MMREGISTER,LOC_CMMREGISTER:
@@ -3217,6 +3230,13 @@ implementation
             a_loadmm_ref_reg(list,loc.size,size,loc.reference,reg,shuffle);
           LOC_REGISTER,LOC_CREGISTER:
             a_loadmm_intreg_reg(list,loc.size,size,loc.register,reg,shuffle);
+          LOC_SUBSETREF,LOC_CSUBSETREF,
+          LOC_SUBSETREG,LOC_CSUBSETREG:
+            begin
+              tmpreg:=getintregister(list,loc.size);
+              a_load_loc_reg(list,loc.size,loc,tmpreg);
+              a_loadmm_intreg_reg(list,loc.size,size,tmpreg,reg,shuffle);
+            end
           else
             internalerror(200310121);
         end;
@@ -3529,72 +3549,6 @@ implementation
       end;
 
 
-    procedure tcg.g_decrrefcount(list : TAsmList;t: tdef; const ref: treference);
-      var
-        href : treference;
-        decrfunc : string;
-        needrtti : boolean;
-        cgpara1,cgpara2 : TCGPara;
-        tempreg1,tempreg2 : TRegister;
-      begin
-        cgpara1.init;
-        cgpara2.init;
-        paramanager.getintparaloc(pocall_default,1,cgpara1);
-        paramanager.getintparaloc(pocall_default,2,cgpara2);
-        needrtti:=false;
-        if is_interfacecom_or_dispinterface(t) then
-          decrfunc:='FPC_INTF_DECR_REF'
-        else if is_ansistring(t) then
-          decrfunc:='FPC_ANSISTR_DECR_REF'
-         else if is_widestring(t) then
-          decrfunc:='FPC_WIDESTR_DECR_REF'
-         else if is_unicodestring(t) then
-          decrfunc:='FPC_UNICODESTR_DECR_REF'
-         else if is_dynamic_array(t) then
-          begin
-            decrfunc:='FPC_DYNARRAY_DECR_REF';
-            needrtti:=true;
-          end
-         else
-          decrfunc:='';
-         { call the special decr function or the generic decref }
-         if decrfunc<>'' then
-          begin
-            if needrtti then
-             begin
-               reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
-               tempreg2:=getaddressregister(list);
-               a_loadaddr_ref_reg(list,href,tempreg2);
-             end;
-            tempreg1:=getaddressregister(list);
-            a_loadaddr_ref_reg(list,ref,tempreg1);
-            if needrtti then
-              a_load_reg_cgpara(list,OS_ADDR,tempreg2,cgpara2);
-            a_load_reg_cgpara(list,OS_ADDR,tempreg1,cgpara1);
-            paramanager.freecgpara(list,cgpara1);
-            if needrtti then
-              paramanager.freecgpara(list,cgpara2);
-            allocallcpuregisters(list);
-            a_call_name(list,decrfunc,false);
-            deallocallcpuregisters(list);
-          end
-         else
-          begin
-            if is_open_array(t) then
-              InternalError(201103053);
-            reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
-            a_loadaddr_ref_cgpara(list,href,cgpara2);
-            a_loadaddr_ref_cgpara(list,ref,cgpara1);
-            paramanager.freecgpara(list,cgpara1);
-            paramanager.freecgpara(list,cgpara2);
-            allocallcpuregisters(list);
-            a_call_name(list,'FPC_DECREF',false);
-            deallocallcpuregisters(list);
-         end;
-        cgpara2.done;
-        cgpara1.done;
-      end;
-
     procedure tcg.g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation; const name: string);
       var
         cgpara1,cgpara2,cgpara3: TCGPara;
@@ -3647,18 +3601,27 @@ implementation
       begin
         cgpara1.init;
         cgpara2.init;
-        paramanager.getintparaloc(pocall_default,1,cgpara1);
-        paramanager.getintparaloc(pocall_default,2,cgpara2);
          if is_ansistring(t) or
             is_widestring(t) or
             is_unicodestring(t) or
             is_interfacecom_or_dispinterface(t) or
             is_dynamic_array(t) then
            a_load_const_ref(list,OS_ADDR,0,ref)
+         else if t.typ=variantdef then
+           begin
+             paramanager.getintparaloc(pocall_default,1,cgpara1);
+             a_loadaddr_ref_cgpara(list,ref,cgpara1);
+             paramanager.freecgpara(list,cgpara1);
+             allocallcpuregisters(list);
+             a_call_name(list,'FPC_VARIANT_INIT',false);
+             deallocallcpuregisters(list);
+           end
          else
            begin
               if is_open_array(t) then
                 InternalError(201103052);
+              paramanager.getintparaloc(pocall_default,1,cgpara1);
+              paramanager.getintparaloc(pocall_default,2,cgpara2);
               reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
               a_loadaddr_ref_cgpara(list,href,cgpara2);
               a_loadaddr_ref_cgpara(list,ref,cgpara1);
@@ -3677,34 +3640,45 @@ implementation
       var
          href : treference;
          cgpara1,cgpara2 : TCGPara;
+         decrfunc : string;
       begin
+        if is_interfacecom_or_dispinterface(t) then
+          decrfunc:='FPC_INTF_DECR_REF'
+        else if is_ansistring(t) then
+          decrfunc:='FPC_ANSISTR_DECR_REF'
+        else if is_widestring(t) then
+          decrfunc:='FPC_WIDESTR_DECR_REF'
+        else if is_unicodestring(t) then
+          decrfunc:='FPC_UNICODESTR_DECR_REF'
+        else if t.typ=variantdef then
+          decrfunc:='FPC_VARIANT_CLEAR'
+        else
+          begin
+            cgpara1.init;
+            cgpara2.init;
+            if is_open_array(t) then
+              InternalError(201103051);
+            paramanager.getintparaloc(pocall_default,1,cgpara1);
+            paramanager.getintparaloc(pocall_default,2,cgpara2);
+            reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
+            a_loadaddr_ref_cgpara(list,href,cgpara2);
+            a_loadaddr_ref_cgpara(list,ref,cgpara1);
+            paramanager.freecgpara(list,cgpara1);
+            paramanager.freecgpara(list,cgpara2);
+            if is_dynamic_array(t) then
+              g_call(list,'FPC_DYNARRAY_CLEAR')
+            else
+              g_call(list,'FPC_FINALIZE');
+            cgpara1.done;
+            cgpara2.done;
+            exit;
+          end;
         cgpara1.init;
-        cgpara2.init;
         paramanager.getintparaloc(pocall_default,1,cgpara1);
-        paramanager.getintparaloc(pocall_default,2,cgpara2);
-         if is_ansistring(t) or
-            is_widestring(t) or
-            is_unicodestring(t) or
-            is_interfacecom_or_dispinterface(t) then
-            begin
-              g_decrrefcount(list,t,ref);
-              a_load_const_ref(list,OS_ADDR,0,ref);
-            end
-         else
-           begin
-              if is_open_array(t) then
-                InternalError(201103051);
-              reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
-              a_loadaddr_ref_cgpara(list,href,cgpara2);
-              a_loadaddr_ref_cgpara(list,ref,cgpara1);
-              paramanager.freecgpara(list,cgpara1);
-              paramanager.freecgpara(list,cgpara2);
-              allocallcpuregisters(list);
-              a_call_name(list,'FPC_FINALIZE',false);
-              deallocallcpuregisters(list);
-           end;
+        a_loadaddr_ref_cgpara(list,ref,cgpara1);
+        paramanager.freecgpara(list,cgpara1);
+        g_call(list,decrfunc);
         cgpara1.done;
-        cgpara2.done;
       end;
 
 
@@ -3796,14 +3770,9 @@ implementation
               { only optimize away if all bit patterns which fit in fromsize }
               { are valid for the todef                                      }
               begin
-{$ifopt Q+}
-{$define overflowon}
+{$push}
 {$Q-}
-{$endif}
-{$ifopt R+}
-{$define rangeon}
 {$R-}
-{$endif}
                 if to_signed then
                   begin
                     { calculation of the low/high ranges must not overflow 64 bit
@@ -3822,14 +3791,7 @@ implementation
                        (qword(hto) = (qword(-1) >> (64-(tosize * 8))) ) then
                       exit
                   end;
-{$ifdef overflowon}
-{$Q+}
-{$undef overflowon}
-{$endif}
-{$ifdef rangeon}
-{$R+}
-{$undef rangeon}
-{$endif}
+{$pop}
               end
           end;
 
@@ -4222,13 +4184,24 @@ implementation
         a_jmp_name(list,externalname);
       end;
 
+
     procedure tcg.a_call_name_static(list : TAsmList;const s : string);
       begin
         a_call_name(list,s,false);
       end;
 
 
-   function tcg.g_indirect_sym_load(list:TAsmList;const symname: string; weak: boolean): tregister;
+    procedure tcg.a_call_ref(list : TAsmList;ref: treference);
+      var
+        tempreg : TRegister;
+      begin
+        tempreg := getintregister(list, OS_ADDR);
+        a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,tempreg);
+        a_call_reg(list,tempreg);
+      end;
+
+
+   function tcg.g_indirect_sym_load(list:TAsmList;const symname: string; const flags: tindsymflags): tregister;
       var
         l: tasmsymbol;
         ref: treference;
@@ -4249,7 +4222,7 @@ implementation
                   new_section(current_asmdata.asmlists[al_picdata],sec_data_nonlazy,'',sizeof(pint));
                   l:=current_asmdata.DefineAsmSymbol(nlsymname,AB_LOCAL,AT_DATA);
                   current_asmdata.asmlists[al_picdata].concat(tai_symbol.create(l,0));
-                  if not(weak) then
+                  if not(is_weak in flags) then
                     current_asmdata.asmlists[al_picdata].concat(tai_directive.Create(asd_indirect_symbol,current_asmdata.RefAsmSymbol(symname).Name))
                   else
                     current_asmdata.asmlists[al_picdata].concat(tai_directive.Create(asd_indirect_symbol,current_asmdata.WeakRefAsmSymbol(symname).Name));
@@ -4264,14 +4237,25 @@ implementation
               { a_load_ref_reg will turn this into a pic-load if needed }
               a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,result);
             end;
-          end;
         end;
+      end;
 
 
     procedure tcg.g_maybe_got_init(list: TAsmList);
       begin
       end;
 
+    procedure tcg.g_call(list: TAsmList;const s: string);
+      begin
+        allocallcpuregisters(list);
+        a_call_name(list,s,false);
+        deallocallcpuregisters(list);
+      end;
+
+    procedure tcg.g_local_unwind(list: TAsmList; l: TAsmLabel);
+      begin
+        a_jmp_always(list,l);
+      end;
 
     procedure tcg.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister; shuffle: pmmshuffle);
       begin
@@ -4433,6 +4417,14 @@ implementation
       end;
 {$endif cpu64bitalu}
 
+    function asmsym2indsymflags(sym: TAsmSymbol): tindsymflags;
+      begin
+        result:=[];
+        if sym.typ<>AT_FUNCTION then
+          include(result,is_data);
+        if sym.bind=AB_WEAK_EXTERNAL then
+          include(result,is_weak);
+      end;
 
     procedure destroy_codegen;
       begin

compiler/cmsgs.pas

@@ -188,9 +188,9 @@ begin
   getmem(buf,bufsize);
   { Read the message file }
   assign(f,fn);
-  {$I-}
+  {$push}{$I-}
    reset(f);
-  {$I+}
+  {$pop}
   if ioresult<>0 then
    begin
      WriteLn('*** PPC, can not open message file ',fn);
@@ -361,6 +361,12 @@ begin
       begin
         { skip _ }
         inc(hp1);
+        { set default verbosity to off is '-' is found just after the '_' }
+        if hp1^='-' then
+         begin
+           msgstates[numpart]^[numidx]:=ms_off_global;
+           inc(hp1);
+         end;
         { put the address in the idx, the numbers are already checked }
         msgidx[numpart]^[numidx]:=hp1;
       end;

compiler/comphook.pas

@@ -84,7 +84,7 @@ type
     countNotes,
     countHints    : longint;  { number of found errors/warnings/notes/hints }
     codesize,
-    datasize      : aword;
+    datasize      : qword;
   { program info }
     isexe,
     ispackage,
@@ -335,7 +335,7 @@ begin
   if (status.verbosity and V_TimeStamps)<>0 then
     begin
       system.str(getrealtime-starttime:0:3,hs2);
-      hs:='['+hs2+'] '+s;
+      hs:='['+hs2+'] '+hs;
     end;
 
   { Display line }

compiler/compiler.pas

@@ -116,6 +116,9 @@ uses
 {$ifdef nativent}
   ,i_nativent
 {$endif nativent}
+{$ifdef aix}
+  ,i_aix
+{$endif aix}
   ,globtype;
 
 function Compile(const cmd:TCmdStr):longint;

compiler/compinnr.inc

@@ -83,8 +83,9 @@ const
    in_sar_x             = 73;
    in_bsf_x             = 74;
    in_bsr_x             = 75;
-   in_box_x             = 76; { managed platforms: wrap in class instance }
-   in_unbox_x_y         = 77; { manage platforms: extract from class instance }
+   in_default_x         = 76;
+   in_box_x             = 77; { managed platforms: wrap in class instance }
+   in_unbox_x_y         = 78; { manage platforms: extract from class instance }
 
 { Internal constant functions }
    in_const_sqr        = 100;

compiler/constexp.pas

@@ -32,9 +32,6 @@ interface
   {$R-}
 {$endif}
 
-{$ifopt q+}
-  {$define ena_q}
-{$endif}
 
 type  Tconstexprint=record
         overflow:boolean;
@@ -165,9 +162,9 @@ begin
 
   {Try if the result fits in an int64.}
   if (a.signed) and (a.svalue<0) then
-    {$Q-}
+    {$push}{$Q-}
     sspace:=qword(high(int64))+qword(-a.svalue)
-    {$ifdef ena_q}{$Q+}{$endif}
+    {$pop}
   else if not a.signed and (a.uvalue>qword(high(int64))) then
     goto try_qword
   else
@@ -176,9 +173,9 @@ begin
   if sspace>=b then
     begin
       result.signed:=true;
-      {$Q-}
+      {$push} {$Q-}
       result.svalue:=a.svalue+int64(b);
-      {$ifdef ena_q}{$Q+}{$endif}
+      {$pop}
       exit;
     end;
 
@@ -193,9 +190,9 @@ try_qword:
   if uspace>=b then
     begin
       result.signed:=false;
-      {$Q-}
+      {$push} {$Q-}
       result.uvalue:=a.uvalue+b;
-      {$ifdef ena_q}{$Q+}{$endif}
+      {$pop}
       exit;
     end;
   result.overflow:=true;
@@ -214,9 +211,9 @@ begin
 
   {Try if the result fits in an int64.}
   if (a.signed) and (a.svalue<0) then
-    {$Q-}
+    {$push} {$Q-}
     sspace:=qword(a.svalue)+abs_low_int64
-    {$ifdef ena_q}{$Q+}{$endif}
+    {$pop}
   else if not a.signed and (a.uvalue>qword(high(int64))) then
     goto try_qword
   else
@@ -224,9 +221,9 @@ begin
   if sspace>=b then
     begin
       result.signed:=true;
-      {$Q-}
+      {$push} {$Q-}
       result.svalue:=a.svalue-int64(b);
-      {$ifdef ena_q}{$Q+}{$endif}
+      {$pop}
       exit;
     end;
 
@@ -235,9 +232,9 @@ try_qword:
   if not(a.signed and (a.svalue<0)) and (a.uvalue>=b) then
     begin
       result.signed:=false;
-      {$Q-}
+      {$push} {$Q-}
       result.uvalue:=a.uvalue-b;
-      {$ifdef ena_q}{$Q+}{$endif}
+      {$pop}
       exit;
     end;
 ov:
@@ -253,9 +250,9 @@ begin
       exit;
     end;
   if b.signed and (b.svalue<0) then
-    {$Q-}
+    {$push} {$Q-}
     result:=sub_from(a,qword(-b.svalue))
-    {$ifdef ena_q}{$Q+}{$endif}
+    {$pop}
   else
     result:=add_to(a,b.uvalue);
 end;
@@ -269,9 +266,9 @@ begin
       exit;
     end;
   if b.signed and (b.svalue<0) then
-    {$Q-}
+    {$push} {$Q-}
     result:=add_to(a,qword(-b.svalue))
-    {$ifdef ena_q}{$Q+}{$endif}
+    {$pop}
   else
     result:=sub_from(a,b.uvalue);
 end;
@@ -348,16 +345,16 @@ begin
   result.overflow:=false;
   sa:=a.signed and (a.svalue<0);
   if sa then
-    {$Q-}
+    {$push} {$Q-}
     aa:=qword(-a.svalue)
-    {$ifdef ena_q}{$Q+}{$endif}
+    {$pop}
   else
     aa:=a.uvalue;
   sb:=b.signed and (b.svalue<0);
   if sb then
-    {$Q-}
+    {$push} {$Q-}
     bb:=qword(-b.svalue)
-    {$ifdef ena_q}{$Q+}{$endif}
+    {$pop}
   else
     bb:=b.uvalue;
 
@@ -396,16 +393,16 @@ begin
   result.overflow:=false;
   sa:=a.signed and (a.svalue<0);
   if sa then
-    {$Q-}
+    {$push} {$Q-}
     aa:=qword(-a.svalue)
-    {$ifdef ena_q}{$Q+}{$endif}
+    {$pop}
   else
     aa:=a.uvalue;
   sb:=b.signed and (b.svalue<0);
   if sb then
-    {$Q-}
+    {$push} {$Q-}
     bb:=qword(-b.svalue)
-    {$ifdef ena_q}{$Q+}{$endif}
+    {$pop}
   else
     bb:=b.uvalue;
   if bb=0 then

compiler/cp1251.pas

@@ -6,7 +6,7 @@ unit cp1251;
   implementation
 
   uses
-     {$ifdef VER2_2}ccharset{$else VER2_2}charset{$endif VER2_2};
+     {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif};
 
   const
      map : array[0..255] of tunicodecharmapping = (
@@ -270,6 +270,7 @@ unit cp1251;
 
      unicodemap : tunicodemap = (
        cpname : 'cp1251';
+       cp : 1251;
        map : @map;
        lastchar : 255;
        next : nil;

compiler/cp1252.pp

@@ -0,0 +1,282 @@
+{ This is an automatically created file, so don't edit it }
+unit CP1252;
+
+  interface
+
+  implementation
+
+  uses
+     {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif};
+
+  const
+     map : array[0..255] of tunicodecharmapping = (
+       (unicode : 0; flag : umf_noinfo; reserved: 0),
+       (unicode : 1; flag : umf_noinfo; reserved: 0),
+       (unicode : 2; flag : umf_noinfo; reserved: 0),
+       (unicode : 3; flag : umf_noinfo; reserved: 0),
+       (unicode : 4; flag : umf_noinfo; reserved: 0),
+       (unicode : 5; flag : umf_noinfo; reserved: 0),
+       (unicode : 6; flag : umf_noinfo; reserved: 0),
+       (unicode : 7; flag : umf_noinfo; reserved: 0),
+       (unicode : 8; flag : umf_noinfo; reserved: 0),
+       (unicode : 9; flag : umf_noinfo; reserved: 0),
+       (unicode : 10; flag : umf_noinfo; reserved: 0),
+       (unicode : 11; flag : umf_noinfo; reserved: 0),
+       (unicode : 12; flag : umf_noinfo; reserved: 0),
+       (unicode : 13; flag : umf_noinfo; reserved: 0),
+       (unicode : 14; flag : umf_noinfo; reserved: 0),
+       (unicode : 15; flag : umf_noinfo; reserved: 0),
+       (unicode : 16; flag : umf_noinfo; reserved: 0),
+       (unicode : 17; flag : umf_noinfo; reserved: 0),
+       (unicode : 18; flag : umf_noinfo; reserved: 0),
+       (unicode : 19; flag : umf_noinfo; reserved: 0),
+       (unicode : 20; flag : umf_noinfo; reserved: 0),
+       (unicode : 21; flag : umf_noinfo; reserved: 0),
+       (unicode : 22; flag : umf_noinfo; reserved: 0),
+       (unicode : 23; flag : umf_noinfo; reserved: 0),
+       (unicode : 24; flag : umf_noinfo; reserved: 0),
+       (unicode : 25; flag : umf_noinfo; reserved: 0),
+       (unicode : 26; flag : umf_noinfo; reserved: 0),
+       (unicode : 27; flag : umf_noinfo; reserved: 0),
+       (unicode : 28; flag : umf_noinfo; reserved: 0),
+       (unicode : 29; flag : umf_noinfo; reserved: 0),
+       (unicode : 30; flag : umf_noinfo; reserved: 0),
+       (unicode : 31; flag : umf_noinfo; reserved: 0),
+       (unicode : 32; flag : umf_noinfo; reserved: 0),
+       (unicode : 33; flag : umf_noinfo; reserved: 0),
+       (unicode : 34; flag : umf_noinfo; reserved: 0),
+       (unicode : 35; flag : umf_noinfo; reserved: 0),
+       (unicode : 36; flag : umf_noinfo; reserved: 0),
+       (unicode : 37; flag : umf_noinfo; reserved: 0),
+       (unicode : 38; flag : umf_noinfo; reserved: 0),
+       (unicode : 39; flag : umf_noinfo; reserved: 0),
+       (unicode : 40; flag : umf_noinfo; reserved: 0),
+       (unicode : 41; flag : umf_noinfo; reserved: 0),
+       (unicode : 42; flag : umf_noinfo; reserved: 0),
+       (unicode : 43; flag : umf_noinfo; reserved: 0),
+       (unicode : 44; flag : umf_noinfo; reserved: 0),
+       (unicode : 45; flag : umf_noinfo; reserved: 0),
+       (unicode : 46; flag : umf_noinfo; reserved: 0),
+       (unicode : 47; flag : umf_noinfo; reserved: 0),
+       (unicode : 48; flag : umf_noinfo; reserved: 0),
+       (unicode : 49; flag : umf_noinfo; reserved: 0),
+       (unicode : 50; flag : umf_noinfo; reserved: 0),
+       (unicode : 51; flag : umf_noinfo; reserved: 0),
+       (unicode : 52; flag : umf_noinfo; reserved: 0),
+       (unicode : 53; flag : umf_noinfo; reserved: 0),
+       (unicode : 54; flag : umf_noinfo; reserved: 0),
+       (unicode : 55; flag : umf_noinfo; reserved: 0),
+       (unicode : 56; flag : umf_noinfo; reserved: 0),
+       (unicode : 57; flag : umf_noinfo; reserved: 0),
+       (unicode : 58; flag : umf_noinfo; reserved: 0),
+       (unicode : 59; flag : umf_noinfo; reserved: 0),
+       (unicode : 60; flag : umf_noinfo; reserved: 0),
+       (unicode : 61; flag : umf_noinfo; reserved: 0),
+       (unicode : 62; flag : umf_noinfo; reserved: 0),
+       (unicode : 63; flag : umf_noinfo; reserved: 0),
+       (unicode : 64; flag : umf_noinfo; reserved: 0),
+       (unicode : 65; flag : umf_noinfo; reserved: 0),
+       (unicode : 66; flag : umf_noinfo; reserved: 0),
+       (unicode : 67; flag : umf_noinfo; reserved: 0),
+       (unicode : 68; flag : umf_noinfo; reserved: 0),
+       (unicode : 69; flag : umf_noinfo; reserved: 0),
+       (unicode : 70; flag : umf_noinfo; reserved: 0),
+       (unicode : 71; flag : umf_noinfo; reserved: 0),
+       (unicode : 72; flag : umf_noinfo; reserved: 0),
+       (unicode : 73; flag : umf_noinfo; reserved: 0),
+       (unicode : 74; flag : umf_noinfo; reserved: 0),
+       (unicode : 75; flag : umf_noinfo; reserved: 0),
+       (unicode : 76; flag : umf_noinfo; reserved: 0),
+       (unicode : 77; flag : umf_noinfo; reserved: 0),
+       (unicode : 78; flag : umf_noinfo; reserved: 0),
+       (unicode : 79; flag : umf_noinfo; reserved: 0),
+       (unicode : 80; flag : umf_noinfo; reserved: 0),
+       (unicode : 81; flag : umf_noinfo; reserved: 0),
+       (unicode : 82; flag : umf_noinfo; reserved: 0),
+       (unicode : 83; flag : umf_noinfo; reserved: 0),
+       (unicode : 84; flag : umf_noinfo; reserved: 0),
+       (unicode : 85; flag : umf_noinfo; reserved: 0),
+       (unicode : 86; flag : umf_noinfo; reserved: 0),
+       (unicode : 87; flag : umf_noinfo; reserved: 0),
+       (unicode : 88; flag : umf_noinfo; reserved: 0),
+       (unicode : 89; flag : umf_noinfo; reserved: 0),
+       (unicode : 90; flag : umf_noinfo; reserved: 0),
+       (unicode : 91; flag : umf_noinfo; reserved: 0),
+       (unicode : 92; flag : umf_noinfo; reserved: 0),
+       (unicode : 93; flag : umf_noinfo; reserved: 0),
+       (unicode : 94; flag : umf_noinfo; reserved: 0),
+       (unicode : 95; flag : umf_noinfo; reserved: 0),
+       (unicode : 96; flag : umf_noinfo; reserved: 0),
+       (unicode : 97; flag : umf_noinfo; reserved: 0),
+       (unicode : 98; flag : umf_noinfo; reserved: 0),
+       (unicode : 99; flag : umf_noinfo; reserved: 0),
+       (unicode : 100; flag : umf_noinfo; reserved: 0),
+       (unicode : 101; flag : umf_noinfo; reserved: 0),
+       (unicode : 102; flag : umf_noinfo; reserved: 0),
+       (unicode : 103; flag : umf_noinfo; reserved: 0),
+       (unicode : 104; flag : umf_noinfo; reserved: 0),
+       (unicode : 105; flag : umf_noinfo; reserved: 0),
+       (unicode : 106; flag : umf_noinfo; reserved: 0),
+       (unicode : 107; flag : umf_noinfo; reserved: 0),
+       (unicode : 108; flag : umf_noinfo; reserved: 0),
+       (unicode : 109; flag : umf_noinfo; reserved: 0),
+       (unicode : 110; flag : umf_noinfo; reserved: 0),
+       (unicode : 111; flag : umf_noinfo; reserved: 0),
+       (unicode : 112; flag : umf_noinfo; reserved: 0),
+       (unicode : 113; flag : umf_noinfo; reserved: 0),
+       (unicode : 114; flag : umf_noinfo; reserved: 0),
+       (unicode : 115; flag : umf_noinfo; reserved: 0),
+       (unicode : 116; flag : umf_noinfo; reserved: 0),
+       (unicode : 117; flag : umf_noinfo; reserved: 0),
+       (unicode : 118; flag : umf_noinfo; reserved: 0),
+       (unicode : 119; flag : umf_noinfo; reserved: 0),
+       (unicode : 120; flag : umf_noinfo; reserved: 0),
+       (unicode : 121; flag : umf_noinfo; reserved: 0),
+       (unicode : 122; flag : umf_noinfo; reserved: 0),
+       (unicode : 123; flag : umf_noinfo; reserved: 0),
+       (unicode : 124; flag : umf_noinfo; reserved: 0),
+       (unicode : 125; flag : umf_noinfo; reserved: 0),
+       (unicode : 126; flag : umf_noinfo; reserved: 0),
+       (unicode : 127; flag : umf_noinfo; reserved: 0),
+       (unicode : 8364; flag : umf_noinfo; reserved: 0),
+       (unicode : 65535; flag : umf_unused; reserved: 0),
+       (unicode : 8218; flag : umf_noinfo; reserved: 0),
+       (unicode : 402; flag : umf_noinfo; reserved: 0),
+       (unicode : 8222; flag : umf_noinfo; reserved: 0),
+       (unicode : 8230; flag : umf_noinfo; reserved: 0),
+       (unicode : 8224; flag : umf_noinfo; reserved: 0),
+       (unicode : 8225; flag : umf_noinfo; reserved: 0),
+       (unicode : 710; flag : umf_noinfo; reserved: 0),
+       (unicode : 8240; flag : umf_noinfo; reserved: 0),
+       (unicode : 352; flag : umf_noinfo; reserved: 0),
+       (unicode : 8249; flag : umf_noinfo; reserved: 0),
+       (unicode : 338; flag : umf_noinfo; reserved: 0),
+       (unicode : 65535; flag : umf_unused; reserved: 0),
+       (unicode : 381; flag : umf_noinfo; reserved: 0),
+       (unicode : 65535; flag : umf_unused; reserved: 0),
+       (unicode : 65535; flag : umf_unused; reserved: 0),
+       (unicode : 8216; flag : umf_noinfo; reserved: 0),
+       (unicode : 8217; flag : umf_noinfo; reserved: 0),
+       (unicode : 8220; flag : umf_noinfo; reserved: 0),
+       (unicode : 8221; flag : umf_noinfo; reserved: 0),
+       (unicode : 8226; flag : umf_noinfo; reserved: 0),
+       (unicode : 8211; flag : umf_noinfo; reserved: 0),
+       (unicode : 8212; flag : umf_noinfo; reserved: 0),
+       (unicode : 732; flag : umf_noinfo; reserved: 0),
+       (unicode : 8482; flag : umf_noinfo; reserved: 0),
+       (unicode : 353; flag : umf_noinfo; reserved: 0),
+       (unicode : 8250; flag : umf_noinfo; reserved: 0),
+       (unicode : 339; flag : umf_noinfo; reserved: 0),
+       (unicode : 65535; flag : umf_unused; reserved: 0),
+       (unicode : 382; flag : umf_noinfo; reserved: 0),
+       (unicode : 376; flag : umf_noinfo; reserved: 0),
+       (unicode : 160; flag : umf_noinfo; reserved: 0),
+       (unicode : 161; flag : umf_noinfo; reserved: 0),
+       (unicode : 162; flag : umf_noinfo; reserved: 0),
+       (unicode : 163; flag : umf_noinfo; reserved: 0),
+       (unicode : 164; flag : umf_noinfo; reserved: 0),
+       (unicode : 165; flag : umf_noinfo; reserved: 0),
+       (unicode : 166; flag : umf_noinfo; reserved: 0),
+       (unicode : 167; flag : umf_noinfo; reserved: 0),
+       (unicode : 168; flag : umf_noinfo; reserved: 0),
+       (unicode : 169; flag : umf_noinfo; reserved: 0),
+       (unicode : 170; flag : umf_noinfo; reserved: 0),
+       (unicode : 171; flag : umf_noinfo; reserved: 0),
+       (unicode : 172; flag : umf_noinfo; reserved: 0),
+       (unicode : 173; flag : umf_noinfo; reserved: 0),
+       (unicode : 174; flag : umf_noinfo; reserved: 0),
+       (unicode : 175; flag : umf_noinfo; reserved: 0),
+       (unicode : 176; flag : umf_noinfo; reserved: 0),
+       (unicode : 177; flag : umf_noinfo; reserved: 0),
+       (unicode : 178; flag : umf_noinfo; reserved: 0),
+       (unicode : 179; flag : umf_noinfo; reserved: 0),
+       (unicode : 180; flag : umf_noinfo; reserved: 0),
+       (unicode : 181; flag : umf_noinfo; reserved: 0),
+       (unicode : 182; flag : umf_noinfo; reserved: 0),
+       (unicode : 183; flag : umf_noinfo; reserved: 0),
+       (unicode : 184; flag : umf_noinfo; reserved: 0),
+       (unicode : 185; flag : umf_noinfo; reserved: 0),
+       (unicode : 186; flag : umf_noinfo; reserved: 0),
+       (unicode : 187; flag : umf_noinfo; reserved: 0),
+       (unicode : 188; flag : umf_noinfo; reserved: 0),
+       (unicode : 189; flag : umf_noinfo; reserved: 0),
+       (unicode : 190; flag : umf_noinfo; reserved: 0),
+       (unicode : 191; flag : umf_noinfo; reserved: 0),
+       (unicode : 192; flag : umf_noinfo; reserved: 0),
+       (unicode : 193; flag : umf_noinfo; reserved: 0),
+       (unicode : 194; flag : umf_noinfo; reserved: 0),
+       (unicode : 195; flag : umf_noinfo; reserved: 0),
+       (unicode : 196; flag : umf_noinfo; reserved: 0),
+       (unicode : 197; flag : umf_noinfo; reserved: 0),
+       (unicode : 198; flag : umf_noinfo; reserved: 0),
+       (unicode : 199; flag : umf_noinfo; reserved: 0),
+       (unicode : 200; flag : umf_noinfo; reserved: 0),
+       (unicode : 201; flag : umf_noinfo; reserved: 0),
+       (unicode : 202; flag : umf_noinfo; reserved: 0),
+       (unicode : 203; flag : umf_noinfo; reserved: 0),
+       (unicode : 204; flag : umf_noinfo; reserved: 0),
+       (unicode : 205; flag : umf_noinfo; reserved: 0),
+       (unicode : 206; flag : umf_noinfo; reserved: 0),
+       (unicode : 207; flag : umf_noinfo; reserved: 0),
+       (unicode : 208; flag : umf_noinfo; reserved: 0),
+       (unicode : 209; flag : umf_noinfo; reserved: 0),
+       (unicode : 210; flag : umf_noinfo; reserved: 0),
+       (unicode : 211; flag : umf_noinfo; reserved: 0),
+       (unicode : 212; flag : umf_noinfo; reserved: 0),
+       (unicode : 213; flag : umf_noinfo; reserved: 0),
+       (unicode : 214; flag : umf_noinfo; reserved: 0),
+       (unicode : 215; flag : umf_noinfo; reserved: 0),
+       (unicode : 216; flag : umf_noinfo; reserved: 0),
+       (unicode : 217; flag : umf_noinfo; reserved: 0),
+       (unicode : 218; flag : umf_noinfo; reserved: 0),
+       (unicode : 219; flag : umf_noinfo; reserved: 0),
+       (unicode : 220; flag : umf_noinfo; reserved: 0),
+       (unicode : 221; flag : umf_noinfo; reserved: 0),
+       (unicode : 222; flag : umf_noinfo; reserved: 0),
+       (unicode : 223; flag : umf_noinfo; reserved: 0),
+       (unicode : 224; flag : umf_noinfo; reserved: 0),
+       (unicode : 225; flag : umf_noinfo; reserved: 0),
+       (unicode : 226; flag : umf_noinfo; reserved: 0),
+       (unicode : 227; flag : umf_noinfo; reserved: 0),
+       (unicode : 228; flag : umf_noinfo; reserved: 0),
+       (unicode : 229; flag : umf_noinfo; reserved: 0),
+       (unicode : 230; flag : umf_noinfo; reserved: 0),
+       (unicode : 231; flag : umf_noinfo; reserved: 0),
+       (unicode : 232; flag : umf_noinfo; reserved: 0),
+       (unicode : 233; flag : umf_noinfo; reserved: 0),
+       (unicode : 234; flag : umf_noinfo; reserved: 0),
+       (unicode : 235; flag : umf_noinfo; reserved: 0),
+       (unicode : 236; flag : umf_noinfo; reserved: 0),
+       (unicode : 237; flag : umf_noinfo; reserved: 0),
+       (unicode : 238; flag : umf_noinfo; reserved: 0),
+       (unicode : 239; flag : umf_noinfo; reserved: 0),
+       (unicode : 240; flag : umf_noinfo; reserved: 0),
+       (unicode : 241; flag : umf_noinfo; reserved: 0),
+       (unicode : 242; flag : umf_noinfo; reserved: 0),
+       (unicode : 243; flag : umf_noinfo; reserved: 0),
+       (unicode : 244; flag : umf_noinfo; reserved: 0),
+       (unicode : 245; flag : umf_noinfo; reserved: 0),
+       (unicode : 246; flag : umf_noinfo; reserved: 0),
+       (unicode : 247; flag : umf_noinfo; reserved: 0),
+       (unicode : 248; flag : umf_noinfo; reserved: 0),
+       (unicode : 249; flag : umf_noinfo; reserved: 0),
+       (unicode : 250; flag : umf_noinfo; reserved: 0),
+       (unicode : 251; flag : umf_noinfo; reserved: 0),
+       (unicode : 252; flag : umf_noinfo; reserved: 0),
+       (unicode : 253; flag : umf_noinfo; reserved: 0),
+       (unicode : 254; flag : umf_noinfo; reserved: 0),
+       (unicode : 255; flag : umf_noinfo; reserved: 0)
+     );
+
+     unicodemap : tunicodemap = (
+       cpname : 'CP1252';
+       cp : 1252;
+       map : @map;
+       lastchar : 255;
+       next : nil;
+       internalmap : true
+     );
+
+  begin
+     registermapping(@unicodemap)
+  end.

compiler/cp437.pas

@@ -6,7 +6,7 @@ unit cp437;
   implementation
 
   uses
-     {$ifdef VER2_2}ccharset{$else VER2_2}charset{$endif VER2_2};
+     {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif};
 
   const
      map : array[0..255] of tunicodecharmapping = (
@@ -270,6 +270,7 @@ unit cp437;
 
      unicodemap : tunicodemap = (
        cpname : 'cp437';
+       cp : 437;
        map : @map[0];
        lastchar : 255;
        next : nil;

compiler/cp850.pas

@@ -6,7 +6,7 @@ unit cp850;
   implementation
 
   uses
-     {$ifdef VER2_2}ccharset{$else VER2_2}charset{$endif VER2_2};
+     {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif};
 
   const
      map : array[0..255] of tunicodecharmapping = (
@@ -270,6 +270,7 @@ unit cp850;
 
      unicodemap : tunicodemap = (
        cpname : 'cp850';
+       cp : 850;
        map : @map[0];
        lastchar : 255;
        next : nil;

compiler/cp866.pas

@@ -6,7 +6,7 @@ unit cp866;
   implementation
 
   uses
-     {$ifdef VER2_2}ccharset{$else VER2_2}charset{$endif VER2_2};
+     {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif};
 
   const
      map : array[0..255] of tunicodecharmapping = (
@@ -270,6 +270,7 @@ unit cp866;
 
      unicodemap : tunicodemap = (
        cpname : 'cp866';
+       cp : 866;
        map : @map;
        lastchar : 255;
        next : nil;

compiler/cp8859_1.pas

@@ -6,7 +6,7 @@ unit cp8859_1;
   implementation
 
   uses
-     {$ifdef VER2_2}ccharset{$else VER2_2}charset{$endif VER2_2};
+    {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif};
 
   const
      map : array[0..255] of tunicodecharmapping = (
@@ -270,6 +270,7 @@ unit cp8859_1;
 
      unicodemap : tunicodemap = (
        cpname : '8859-1';
+       cp : 28591;
        map : @map[0];
        lastchar : 255;
        next : nil;

compiler/cp8859_5.pas

@@ -6,7 +6,7 @@ unit cp8859_5;
   implementation
 
   uses
-     {$ifdef VER2_2}ccharset{$else VER2_2}charset{$endif VER2_2};
+     {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif};
 
   const
      map : array[0..255] of tunicodecharmapping = (
@@ -270,6 +270,7 @@ unit cp8859_5;
 
      unicodemap : tunicodemap = (
        cpname : '8859-5';
+       cp : 28595;
        map : @map;
        lastchar : 255;
        next : nil;

compiler/cpid.pas

@@ -0,0 +1,191 @@
+{
+    Copyright (c) 2008 by Florian Klaempfl
+
+    Basic stuff for encoding sensitive strings
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+unit cpid;
+
+
+{$i fpcdefs.inc}
+
+  interface
+
+    type
+      TEncodingEntry = record
+        id : TStringEncoding;
+        name : Ansistring;
+      end;
+
+    const Encodings : array[0..150] of TEncodingEntry = (
+      id : 037; name : 'IBM037';
+      id : 437; name : 'IBM437';
+      id : 500; name : 'IBM500';
+      id : 708; name : 'ASMO-708';
+      id : 709; name : 'ASMO-449+';
+      id : 710; name : 'Arabic';
+      id : 720; name : 'DOS-720';
+      id : 737; name : 'ibm737';
+      id : 775; name : 'ibm775';
+      id : 850; name : 'ibm850';
+      id : 852; name : 'ibm852';
+      id : 855; name : 'IBM855';
+      id : 857; name : 'ibm857';
+      id : 858; name : 'IBM00858';
+      id : 860; name : 'IBM860';
+      id : 861; name : 'ibm861';
+      id : 862; name : 'DOS-862';
+      id : 863; name : 'IBM863';
+      id : 864; name : 'IBM864';
+      id : 865; name : 'IBM865';
+      id : 866; name : 'cp866'';;
+      id : 869; name : 'ibm869';
+      id : 870; name : 'IBM870';
+      id : 874; name : 'windows-874';
+      id : 875; name : 'cp875';
+      id : 932; name : 'shift_jis';
+      id : 936; name : 'gb2312';
+      id : 949; name : 'ks_c_5601-1987';
+      id : 950; name : 'big5';
+      id : 1026; name : 'IBM1026';
+      id : 1047; name : 'IBM01047';
+      id : 1140; name : 'IBM01140';
+      id : 1141; name : 'IBM01141';
+      id : 1142; name : 'IBM01142';
+      id : 1143; name : 'IBM01143';
+      id : 1144; name : 'IBM01144';
+      id : 1145; name : 'IBM01145';
+      id : 1146; name : 'IBM01146';
+      id : 1147; name : 'IBM01147';
+      id : 1148; name : 'IBM01148';
+      id : 1149; name : 'IBM01149';
+      id : 1200; name : 'utf-16';
+      id : 1201; name : 'unicodeFFFE';
+      id : 1250; name : 'windows-1250';
+      id : 1251; name : 'windows-1251';
+      id : 1252; name : 'windows-1252';
+      id : 1253; name : 'windows-1253';
+      id : 1254; name : 'windows-1254';
+      id : 1255; name : 'windows-1255';
+      id : 1256; name : 'windows-1256';
+      id : 1257; name : 'windows-1257';
+      id : 1258; name : 'windows-1258';
+      id : 1361; name : 'Johab';
+      id : 10000; name : 'macintosh';
+      id : 10001; name : 'x-mac-japanese';
+      id : 10002; name : 'x-mac-chinesetrad';
+      id : 10003; name : 'x-mac-korean';
+      id : 10004; name : 'x-mac-arabic';
+      id : 10005; name : 'x-mac-hebrew';
+      id : 10006; name : 'x-mac-greek';
+      id : 10007; name : 'x-mac-cyrillic';
+      id : 10008; name : 'x-mac-chinesesimp';
+      id : 10010; name : 'x-mac-romanian';
+      id : 10017; name : 'x-mac-ukrainian';
+      id : 10021; name : 'x-mac-thai';
+      id : 10029; name : 'x-mac-ce';
+      id : 10079; name : 'x-mac-icelandic';
+      id : 10081; name : 'x-mac-turkish';
+      id : 10082; name : 'x-mac-croatian';
+      id : 12000; name : 'utf-32';
+      id : 12001; name : 'utf-32BE';
+      id : 20000; name : 'x-Chinese_CNS';
+      id : 20001; name : 'x-cp20001';
+      id : 20002; name : 'x_Chinese-Eten';
+      id : 20003; name : 'x-cp20003';
+      id : 20004; name : 'x-cp20004';
+      id : 20005; name : 'x-cp20005';
+      id : 20105; name : 'x-IA5';
+      id : 20106; name : 'x-IA5-German';
+      id : 20107; name : 'x-IA5-Swedish';
+      id : 20108; name : 'x-IA5-Norwegian';
+      id : 20127; name : 'us-ascii';
+      id : 20261; name : 'x-cp20261';
+      id : 20269; name : 'x-cp20269';
+      id : 20273; name : 'IBM273';
+      id : 20277; name : 'IBM277';
+      id : 20278; name : 'IBM278';
+      id : 20280; name : 'IBM280';
+      id : 20284; name : 'IBM284';
+      id : 20285; name : 'IBM285';
+      id : 20290; name : 'IBM290';
+      id : 20297; name : 'IBM297';
+      id : 20420; name : 'IBM420';
+      id : 20423; name : 'IBM423';
+      id : 20424; name : 'IBM424';
+      id : 20833; name : 'x-EBCDIC-KoreanExtended';
+      id : 20838; name : 'IBM-Thai';
+      id : 20866; name : 'koi8-r';
+      id : 20871; name : 'IBM871';
+      id : 20880; name : 'IBM880';
+      id : 20905; name : 'IBM905';
+      id : 20924; name : 'IBM00924';
+      id : 20932; name : 'EUC-JP';
+      id : 20936; name : 'x-cp20936';
+      id : 20949; name : 'x-cp20949';
+      id : 21025; name : 'cp1025';
+      id : 21866; name : 'koi8-u';
+      id : 28591; name : 'iso-8859-1';
+      id : 28592; name : 'iso-8859-2';
+      id : 28593; name : 'iso-8859-3';
+      id : 28594; name : 'iso-8859-4';
+      id : 28595; name : 'iso-8859-5';
+      id : 28596; name : 'iso-8859-6';
+      id : 28597; name : 'iso-8859-7';
+      id : 28598; name : 'iso-8859-8';
+      id : 28599; name : 'iso-8859-9';
+      id : 28603; name : 'iso-8859-13';
+      id : 28605; name : 'iso-8859-15';
+      id : 29001; name : 'x-Europa';
+      id : 38598; name : 'iso-8859-8-i';
+      id : 50220; name : 'iso-2022-jp';
+      id : 50221; name : 'csISO2022JP';
+      id : 50222; name : 'iso-2022-jp';
+      id : 50225; name : 'iso-2022-kr';
+      id : 50227; name : 'x-cp50227';
+      id : 50229; name : 'ISO 2022';
+      { not unique
+      id : 50930; name : 'EBCDIC
+      id : 50931; name : 'EBCDIC
+      id : 50933; name : 'EBCDIC
+      id : 50935; name : 'EBCDIC
+      id : 50936; name : 'EBCDIC
+      id : 50937; name : 'EBCDIC
+      id : 50939; name : 'EBCDIC
+      }
+      id : 51932; name : 'euc-jp';
+      id : 51936; name : 'EUC-CN';
+      id : 51949; name : 'euc-kr';
+      id : 51950; name : 'EUC';
+      id : 52936; name : 'hz-gb-2312';
+      id : 54936; name : 'GB18030';
+      id : 57002; name : 'x-iscii-de';
+      id : 57003; name : 'x-iscii-be';
+      id : 57004; name : 'x-iscii-ta';
+      id : 57005; name : 'x-iscii-te';
+      id : 57006; name : 'x-iscii-as';
+      id : 57007; name : 'x-iscii-or';
+      id : 57008; name : 'x-iscii-ka';
+      id : 57009; name : 'x-iscii-ma';
+      id : 57010; name : 'x-iscii-gu';
+      id : 57011; name : 'x-iscii-pa';
+      id : 65000; name : 'utf-7';
+      id : 65001; name : 'utf-8');
+
+  implementation
+
+end.

compiler/cresstr.pas

@@ -37,7 +37,11 @@ uses
    symconst,symtype,symdef,symsym,
    verbose,fmodule,ppu,
    aasmbase,aasmtai,aasmdata,
-   aasmcpu,asmutils;
+   aasmcpu,
+{$if FPC_FULLVERSION<20700}
+   ccharset,
+{$endif}
+   asmutils;
 
     Type
       { These are used to form a singly-linked list, ordered by hash value }
@@ -146,7 +150,7 @@ uses
           make_mangledname('RESSTR',current_module.localsymtable,'START'),AT_DATA,0));
 
         { Write unitname entry }
-        namelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],@current_module.localsymtable.name^[1],length(current_module.localsymtable.name^),False);
+        namelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],@current_module.localsymtable.name^[1],length(current_module.localsymtable.name^),getansistringcodepage,False);
         current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(namelab));
         current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(nil));
         current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(nil));
@@ -162,12 +166,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:=emit_ansistring_const(current_asmdata.asmlists[al_const],R.Value,R.Len,False)
+              valuelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],R.Value,R.Len,getansistringcodepage,False)
             else
               valuelab:=nil;
             { Append the name as a ansistring. }
             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);
+            namelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],@R.Name[1],length(R.name),getansistringcodepage,False);
 
             {
               Resourcestring index:
@@ -203,7 +207,7 @@ uses
         { 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   
+        if (target_info.system in (systems_darwin+systems_aix)) then
           current_asmdata.asmlists[al_resourcestrings].concat(Tai_const.create_sym(endsymlab));
       end;
 
@@ -229,9 +233,9 @@ uses
         ResFileName:=ChangeFileExt(current_module.ppufilename^,'.rst');
         message1 (general_i_writingresourcefile,ExtractFileName(ResFileName));
         Assign(F,ResFileName);
-        {$i-}
+        {$push}{$i-}
         Rewrite(f);
-        {$i+}
+        {$pop}
         If IOresult<>0 then
           begin
             message1(general_e_errorwritingresourcefile,ResFileName);

compiler/cstreams.pas

@@ -203,7 +203,7 @@ implementation
 
     begin
     // We do nothing. Pipe streams don't support this
-    // As wel as possible read-ony streams !!
+    // As well as possible read-ony streams !!
     end;
 
   procedure TCStream.ReadBuffer(var Buffer; Count: Longint);
@@ -371,9 +371,9 @@ begin
   If Mode=fmcreate then
     begin
       system.assign(FHandle,AFileName);
-      {$I-}
+      {$push} {$I-}
        system.rewrite(FHandle,1);
-      {$I+}
+      {$pop}
       CStreamError:=IOResult;
     end
   else
@@ -381,9 +381,9 @@ begin
       oldfilemode:=filemode;
       filemode:=$40 or Mode;
       system.assign(FHandle,AFileName);
-      {$I-}
+      {$push} {$I-}
        system.reset(FHandle,1);
-      {$I+}
+      {$pop}
       CStreamError:=IOResult;
       filemode:=oldfilemode;
     end;
@@ -392,9 +392,9 @@ end;
 
 destructor TCFileStream.Destroy;
 begin
-  {$I-}
+  {$push} {$I-}
    System.Close(FHandle);
-  {$I+}
+  {$pop}
   CStreamError:=IOResult;
 end;
 
@@ -417,10 +417,10 @@ end;
 
 Procedure TCFileStream.SetSize(NewSize: Longint);
 begin
-  {$I-}
+  {$push} {$I-}
    System.Seek(FHandle,NewSize);
    System.Truncate(FHandle);
-  {$I+}
+  {$pop}
   CStreamError:=IOResult;
 end;
 
@@ -429,7 +429,7 @@ function TCFileStream.Seek(Offset: Longint; Origin: Word): Longint;
 var
   l : longint;
 begin
-  {$I-}
+  {$push} {$I-}
    case Origin of
      soFromBeginning :
        begin
@@ -451,7 +451,7 @@ begin
          System.Seek(FHandle,l);
        end;
    end;
-  {$I+}
+  {$pop}
   CStreamError:=IOResult;
   Result:=l;
 end;

compiler/cutils.pas

@@ -103,6 +103,7 @@ interface
     function DePascalQuote(var s: ansistring): Boolean;
     function CompareStr(const S1, S2: string): Integer;
     function CompareText(S1, S2: string): integer;
+    function CompareVersionStrings(s1,s2: string): longint;
 
     { releases the string p and assignes nil to p }
     { if p=nil then freemem isn't called          }
@@ -118,6 +119,7 @@ interface
        to that mem
     }
     function  strpnew(const s : string) : pchar;
+    function  strpnew(const s : ansistring) : pchar;
 
     {# makes the character @var(c) lowercase, with spanish, french and german
        character set
@@ -145,17 +147,6 @@ interface
 
     Function nextafter(x,y:double):double;
 
-{$ifdef ver2_0}
-{ RTL routines not available yet in 2.0.x }
-function SwapEndian(const AValue: SmallInt): SmallInt;
-function SwapEndian(const AValue: Word): Word;
-function SwapEndian(const AValue: LongInt): LongInt;
-function SwapEndian(const AValue: DWord): DWord;
-function SwapEndian(const AValue: Int64): Int64;
-function SwapEndian(const AValue: QWord): QWord;
-{$endif ver2_0}
-
-
 implementation
 
     uses
@@ -890,6 +881,7 @@ implementation
         end;
     end;
 
+
     function octal_quote(const s:string;const qchars:Tcharset):string;
 
     var i:byte;
@@ -1111,6 +1103,15 @@ implementation
          result:=p;
       end;
 
+    function strpnew(const s: ansistring): pchar;
+      var
+         p : pchar;
+      begin
+        getmem(p,length(s)+1);
+        move(s[1],p^,length(s)+1);
+        result:=p;
+      end;
+
 
     procedure stringdispose(var p : pshortstring);{$ifdef USEINLINE}inline;{$endif}
       begin
@@ -1154,6 +1155,71 @@ implementation
       end;
 
 
+    function CompareVersionStrings(s1,s2: string): longint;
+      var
+        start1, start2,
+        i1, i2,
+        num1,num2,
+        res,
+        err        : longint;
+      begin
+        i1:=1;
+        i2:=1;
+        repeat
+          start1:=i1;
+          start2:=i2;
+          while (i1<=length(s1)) and
+                (s1[i1] in ['0'..'9']) do
+             inc(i1);
+          while (i2<=length(s2)) and
+                (s2[i2] in ['0'..'9']) do
+             inc(i2);
+          { one of the strings misses digits -> other is the largest version }
+          if i1=start1 then
+            if i2=start2 then
+              exit(0)
+            else
+              exit(-1)
+          else if i2=start2 then
+            exit(1);
+          { get version number part }
+          val(copy(s1,start1,i1-start1),num1,err);
+          val(copy(s2,start2,i2-start2),num2,err);
+          { different -> done }
+          res:=num1-num2;
+          if res<>0 then
+            exit(res);
+          { if one of the two is at the end while the other isn't, add a '.0' }
+          if (i1>length(s1)) and
+             (i2<=length(s1)) then
+            s1:=s1+'.0'
+          else if i2>length(s2) then
+            s2:=s2+'.0';
+          { compare non-numerical characters normally }
+          while (i1<=length(s1)) and
+                not(s1[i1] in ['0'..'9']) and
+                (i2<=length(s2)) and
+                not(s2[i2] in ['0'..'9']) do
+            begin
+              res:=ord(s1[i1])-ord(s2[i2]);
+              if res<>0 then
+                exit(res);
+              inc(i1);
+              inc(i2);
+            end;
+          { both should be digits again now, otherwise pick the one with the
+            digits as the largest (it more likely means that the input was
+            ill-formatted though) }
+          if (i1<=length(s1)) and
+             not(s1[i1] in ['0'..'9']) then
+            exit(-1);
+          if (i2<=length(s2)) and
+             not(s2[i2] in ['0'..'9']) then
+            exit(1);
+        until false;
+      end;
+
+
 {*****************************************************************************
                                Ansistring (PChar+Length)
 *****************************************************************************}
@@ -1460,67 +1526,6 @@ implementation
     end;
 
 
-{$ifdef ver2_0}
-function SwapEndian(const AValue: SmallInt): SmallInt;
-  begin
-    { the extra Word type cast is necessary because the "AValue shr 8" }
-    { is turned into "longint(AValue) shr 8", so if AValue < 0 then    }
-    { the sign bits from the upper 16 bits are shifted in rather than  }
-    { zeroes.                                                          }
-    Result := SmallInt((Word(AValue) shr 8) or (Word(AValue) shl 8));
-  end;
-
-
-function SwapEndian(const AValue: Word): Word;
-  begin
-    Result := (AValue shr 8) or (AValue shl 8);
-  end;
-
-
-function SwapEndian(const AValue: LongInt): LongInt;
-  begin
-    Result := (AValue shl 24)
-           or ((AValue and $0000FF00) shl 8)
-           or ((AValue and $00FF0000) shr 8)
-           or (AValue shr 24);
-  end;
-
-
-function SwapEndian(const AValue: DWord): DWord;
-  begin
-    Result := (AValue shl 24)
-           or ((AValue and $0000FF00) shl 8)
-           or ((AValue and $00FF0000) shr 8)
-           or (AValue shr 24);
-  end;
-
-
-function SwapEndian(const AValue: Int64): Int64;
-  begin
-    Result := (AValue shl 56)
-           or ((AValue and $000000000000FF00) shl 40)
-           or ((AValue and $0000000000FF0000) shl 24)
-           or ((AValue and $00000000FF000000) shl 8)
-           or ((AValue and $000000FF00000000) shr 8)
-           or ((AValue and $0000FF0000000000) shr 24)
-           or ((AValue and $00FF000000000000) shr 40)
-           or (AValue shr 56);
-  end;
-
-
-function SwapEndian(const AValue: QWord): QWord;
-  begin
-    Result := (AValue shl 56)
-           or ((AValue and $000000000000FF00) shl 40)
-           or ((AValue and $0000000000FF0000) shl 24)
-           or ((AValue and $00000000FF000000) shl 8)
-           or ((AValue and $000000FF00000000) shr 8)
-           or ((AValue and $0000FF0000000000) shr 24)
-           or ((AValue and $00FF000000000000) shr 40)
-           or (AValue shr 56);
-  end;
-{$endif ver2_0}
-
 initialization
   internalerrorproc:=@defaulterror;
   initupperlower;

compiler/dbgbase.pas

@@ -94,8 +94,8 @@ interface
       CDebugInfo : array[tdbg] of TDebugInfoClass;
       current_debuginfo : tdebuginfo;
 
-    procedure InitDebugInfo(hp:tmodule);
-    procedure DoneDebugInfo(hp:tmodule);
+    procedure InitDebugInfo(hp:tmodule; restore_current_debuginfo : boolean);
+    procedure DoneDebugInfo(hp:tmodule;var current_debuginfo_reset : boolean);
     procedure RegisterDebugInfo(const r:tdbginfo;c:TDebugInfoClass);
 
 
@@ -420,6 +420,9 @@ implementation
             appendsym_absolute(list,tabsolutevarsym(sym));
           propertysym :
             appendsym_property(list,tpropertysym(sym));
+          namespacesym :
+            { ignore namespace syms, they are only of internal use }
+            ;
           else
             internalerror(200601242);
         end;
@@ -576,7 +579,7 @@ implementation
                            Init / Done
 ****************************************************************************}
 
-    procedure InitDebugInfo(hp:tmodule);
+    procedure InitDebugInfo(hp:tmodule; restore_current_debuginfo : boolean);
       begin
         if not assigned(CDebugInfo[target_dbg.id]) then
           begin
@@ -584,13 +587,26 @@ implementation
             exit;
           end;
         hp.DebugInfo:=CDebugInfo[target_dbg.id].Create;
+        if restore_current_debuginfo then
+          begin
+            if current_debuginfo=nil then
+              current_debuginfo:=tdebuginfo(hp.DebugInfo)
+            else
+              internalerror(2012032101);
+          end;
       end;
 
 
-    procedure DoneDebugInfo(hp:tmodule);
+    procedure DoneDebugInfo(hp:tmodule;var current_debuginfo_reset : boolean);
       begin
+        current_debuginfo_reset:=false;
         if assigned(hp.DebugInfo) then
           begin
+            if hp.DebugInfo=current_debuginfo then
+              begin
+                current_debuginfo:=nil;
+                current_debuginfo_reset:=true;
+              end;
             hp.DebugInfo.Free;
             hp.DebugInfo:=nil;
           end;

compiler/dbgdwarf.pas

@@ -364,6 +364,7 @@ interface
         procedure appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);override;
         procedure appendsym_property(list:TAsmList;sym:tpropertysym);override;
 
+        function symdebugname(sym:tsym): String; virtual;
         function symname(sym:tsym): String; virtual;
         procedure append_visibility(vis: tvisibility);
 
@@ -415,7 +416,7 @@ interface
         procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override;
         procedure appenddef_variant(list:TAsmList;def:tvariantdef); override;
 
-        function symname(sym:tsym): String; override;
+        function symdebugname(sym:tsym): String; override;
       public
         function  dwarf_version: Word; override;
       end;
@@ -2044,7 +2045,7 @@ implementation
         procentry      : string;
         cc             : Tdwarf_calling_convention;
         st             : tsymtable;
-        vmtindexnr     : pint;
+        vmtoffset      : pint;
         in_currentunit : boolean;
       begin
         { only write debug info for procedures defined in the current module,
@@ -2128,10 +2129,12 @@ implementation
             { Element number in the vmt (needs to skip stuff coming before the
               actual method addresses in the vmt, so we use vmtmethodoffset()
               and then divide by sizeof(pint)).  }
-            vmtindexnr:=tobjectdef(def.owner.defowner).vmtmethodoffset(def.extnumber) div sizeof(pint);
-            append_attribute(DW_AT_vtable_elem_location,DW_FORM_block1,[1+LengthUleb128(vmtindexnr)]);
+            vmtoffset:=tobjectdef(def.owner.defowner).vmtmethodoffset(def.extnumber);
+            append_attribute(DW_AT_vtable_elem_location,DW_FORM_block1,[3+LengthUleb128(vmtoffset)]);
+            current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
             current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_constu)));
-            current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_uleb128bit(vmtindexnr));
+            current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_uleb128bit(vmtoffset));
+            current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus)));
           end;
 
         { accessibility: public/private/protected }
@@ -2761,6 +2764,12 @@ implementation
       end;
 
 
+    function TDebugInfoDwarf.symdebugname(sym: tsym): String;
+    begin
+      result := sym.name;
+    end;
+
+
     procedure TDebugInfoDwarf.appendsym_type(list:TAsmList;sym: ttypesym);
       begin
         { just queue the def if needed, beforeappenddef will
@@ -3209,9 +3218,9 @@ implementation
         else if (ds_dwarf_method_class_prefix in current_settings.debugswitches) and
                 (sym.typ=procsym) and
                 (tprocsym(sym).owner.symtabletype in [objectsymtable,recordsymtable]) then
-          result:=tprocsym(sym).owner.name^+'__'+sym.name
+          result:=tprocsym(sym).owner.name^+'__'+symdebugname(sym)
         else
-          result:=sym.name;
+          result:=symdebugname(sym);
       end;
 
 
@@ -3469,12 +3478,12 @@ implementation
               current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(def_dwarf_class_struct_lab(def),0));
           end;
         if assigned(objectname) then
-          append_entry(DW_TAG_structure_type,true,[
+          append_entry(DW_TAG_class_type,true,[
             DW_AT_name,DW_FORM_string,objectname^+#0,
             DW_AT_byte_size,DW_FORM_udata,tobjectsymtable(def.symtable).datasize
             ])
         else
-          append_entry(DW_TAG_structure_type,true,[
+          append_entry(DW_TAG_class_type,true,[
             DW_AT_byte_size,DW_FORM_udata,tobjectsymtable(def.symtable).datasize
             ]);
         { Apple-specific tag that identifies it as an Objective-C class }
@@ -4086,7 +4095,7 @@ implementation
         Result:=3;
       end;
 
-    function TDebugInfoDwarf3.symname(sym: tsym): String;
+    function TDebugInfoDwarf3.symdebugname(sym: tsym): String;
       begin
         Result:=sym.realname;
       end;

compiler/dbgstabs.pas

@@ -27,54 +27,76 @@ interface
 
     uses
       cclasses,
-      dbgbase,cgbase,
-      symtype,symdef,symsym,symtable,symbase,
+      systems,dbgbase,cgbase,
+      symconst,symtype,symdef,symsym,symtable,symbase,
       aasmtai,aasmdata;
 
     const
       { stab types }
-      N_GSYM = $20;
-      N_STSYM = 38;     { initialized const }
-      N_LCSYM = 40;     { non initialized variable}
-      N_Function = $24; { function or const }
-      N_TextLine = $44;
-      N_DataLine = $46;
-      N_BssLine = $48;
-      N_RSYM = $40;     { register variable }
-      N_LSYM = $80;
-      N_tsym = 160;
-      N_SourceFile = $64;
+      STABS_N_GSYM = $20;
+      STABS_N_STSYM = 38;     { initialized const }
+      STABS_N_LCSYM = 40;     { non initialized variable}
+      STABS_N_Function = $24; { function or const }
+      STABS_N_TextLine = $44;
+      STABS_N_DataLine = $46;
+      STABS_N_BssLine = $48;
+      STABS_N_RSYM = $40;     { register variable }
+      STABS_N_LSYM = $80;
+      STABS_N_DECL = $8c;
+      STABS_N_RPSYM = $8e;
+      STABS_N_tsym = 160;
+      STABS_N_SourceFile = $64;
 { APPLE LOCAL N_OSO: This is the stab that associated the .o file with the
    N_SO stab, in the case where debug info is mostly stored in the .o file.  }
-      N_OSO        = $66;
-      N_IncludeFile = $84;
-      N_BINCL = $82;
-      N_EINCL = $A2;
-      N_LBRAC = $C0;
-      N_EXCL  = $C2;
-      N_RBRAC = $E0;
+      STABS_N_OSO        = $66;
+      STABS_N_IncludeFile = $84;
+      STABS_N_BINCL = $82;
+      STABS_N_EINCL = $A2;
+      STABS_N_LBRAC = $C0;
+      STABS_N_EXCL  = $C2;
+      STABS_N_RBRAC = $E0;
 
     type
       TDebugInfoStabs=class(TDebugInfo)
-      private
+      protected
+        dbgtype: tdbg;
+        stabsdir: TStabType;
+        def_stab,
+        regvar_stab,
+        procdef_stab,
+        constsym_stab,
+        typesym_stab,
+        globalvarsym_uninited_stab,
+        globalvarsym_inited_stab,
+        staticvarsym_uninited_stab,
+        staticvarsym_inited_stab,
+        localvarsymref_stab,
+        paravarsymref_stab: byte;
         writing_def_stabs  : boolean;
         global_stab_number : word;
         vardatadef: trecorddef;
+        tagtypeprefix: ansistring;
         { 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);
+        function  staticvarsym_mangled_name(sym: tstaticvarsym):string;virtual;
+        procedure maybe_add_vmt_sym(list:TAsmList;def: tobjectdef);virtual;
         { tdef writing }
         function  def_stab_number(def:tdef):string;
         function  def_stab_classnumber(def:tabstractrecorddef):string;
         function  def_var_value(const s:string;arg:pointer):string;
         function  def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):ansistring;
-        procedure write_def_stabstr(list:TAsmList;def:tdef;const ss:ansistring);
+        procedure write_def_stabstr(list:TAsmList;def:tdef;const ss:ansistring);virtual;
         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;
+        function  base_stabs_str(typ: longint; const other, desc, value: ansistring): ansistring;overload;
+        function  base_stabs_str(const typ, other, desc, value: ansistring): ansistring;overload;virtual;
+        function  gen_procdef_startsym_stabs(def: tprocdef): TAsmList;virtual;
+        function  gen_procdef_endsym_stabs(def: tprocdef): TAsmList;virtual;
       protected
         procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
         procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
@@ -109,12 +131,25 @@ interface
       end;
 
 
+    function GetSymTableName(SymTable : TSymTable) : string;
+
+    const
+      tagtypes = [
+        recorddef,
+        variantdef,
+        enumdef,
+        stringdef,
+        filedef,
+        objectdef
+      ];
+
+
 implementation
 
     uses
       SysUtils,cutils,cfileutl,
-      systems,globals,globtype,verbose,constexp,
-      symconst,defutil,
+      globals,globtype,verbose,constexp,
+      defutil,
       cpuinfo,cpubase,paramgr,
       aasmbase,procinfo,
       finput,fmodule,ppu;
@@ -125,6 +160,8 @@ implementation
         result := Sym.Name
       else
         result := Sym.RealName;
+      if target_asm.dollarsign<>'$' then
+        result:=ReplaceForbiddenAsmSymbolChars(result);
     end;
 
     function GetSymTableName(SymTable : TSymTable) : string;
@@ -133,20 +170,13 @@ implementation
         result := SymTable.Name^
       else
         result := SymTable.RealName^;
+      if target_asm.dollarsign<>'$' then
+        result:=ReplaceForbiddenAsmSymbolChars(result);
     end;
 
     const
       memsizeinc = 512;
 
-      tagtypes = [
-        recorddef,
-        variantdef,
-        enumdef,
-        stringdef,
-        filedef,
-        objectdef
-      ];
-
     type
        get_var_value_proc=function(const s:string;arg:pointer):string of object;
 
@@ -340,8 +370,6 @@ implementation
             if assigned(def.typesym) then
                result:=GetSymName(Ttypesym(def.typesym));
           end
-        else if s='N_LSYM' then
-          result:=tostr(N_LSYM)
         else if s='savesize' then
           result:=tostr(def.size);
       end;
@@ -502,7 +530,7 @@ implementation
       begin
         { type prefix }
         if def.typ in tagtypes then
-          stabchar := 'Tt'
+          stabchar := tagtypeprefix
         else
           stabchar := 't';
         { in case of writing the class record structure, we always have to
@@ -525,9 +553,9 @@ implementation
         st:=st+ss;
         { line info is set to 0 for all defs, because the def can be in another
           unit and then the linenumber is invalid in the current sourcefile }
-        st:=st+def_stabstr_evaluate(def,'",${N_LSYM},0,0,0',[]);
+        st:=st+def_stabstr_evaluate(def,'",'+base_stabs_str(def_stab,'0','0','0'),[]);
         { add to list }
-        list.concat(Tai_stab.create_ansistr(stab_stabs,st));
+        list.concat(Tai_stab.create_ansistr(stabsdir,st));
       end;
 
 
@@ -794,11 +822,7 @@ implementation
         else
           do_write_object(list,def);
         { VMT symbol }
-        if (oo_has_vmt in def.objectoptions) and
-           assigned(def.owner) and
-           assigned(def.owner.name) then
-          list.concat(Tai_stab.create_ansistr(stab_stabs,ansistring('"vmt_')+GetSymTableName(def.owner)+tobjectdef(def).objname^+':S'+
-                 def_stab_number(vmttype)+'",'+tostr(N_STSYM)+',0,0,'+ansistring(tobjectdef(def).vmt_mangledname)));
+        maybe_add_vmt_sym(list,def);
       end;
 
 
@@ -845,9 +869,9 @@ implementation
               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';
+            st:=st+'",'+base_stabs_str(def_stab,'0','0','0');
             { add to list }
-            list.concat(Tai_stab.create_ansistr(stab_stabs,st));
+            list.concat(Tai_stab.create_ansistr(stabsdir,st));
           end
         else
           elementdefstabnr:=def_stab_number(def.elementdef);
@@ -1015,12 +1039,8 @@ implementation
 
     procedure TDebugInfoStabs.appendprocdef(list:TAsmList;def:tprocdef);
       var
+        hs : ansistring;
         templist : TAsmList;
-        stabsendlabel : tasmlabel;
-        RType : Char;
-        Obj,Info : String;
-        hs : string;
-        ss : ansistring;
       begin
         if not(def.in_currentunit) or
            { happens for init procdef of units without init section }
@@ -1030,10 +1050,22 @@ implementation
         { mark as used so the local type defs also be written }
         def.dbg_state:=dbg_state_used;
 
-        templist:=TAsmList.create;
+        templist:=gen_procdef_endsym_stabs(def);
+        current_asmdata.asmlists[al_procedures].insertlistafter(def.procendtai,templist);
 
-        { end of procedure }
-        current_asmdata.getlabel(stabsendlabel,alt_dbgtype);
+        { FUNC stabs }
+        templist.free;
+        templist:=gen_procdef_startsym_stabs(def);
+        current_asmdata.asmlists[al_procedures].insertlistbefore(def.procstarttai,templist);
+
+        { para types }
+        if assigned(def.parast) then
+          write_symtable_syms(templist,def.parast);
+        { local type defs and vars should not be written
+          inside the main proc stab }
+        if assigned(def.localst) and
+           (def.localst.symtabletype=localsymtable) then
+          write_symtable_syms(templist,def.localst);
 
         if assigned(def.funcretsym) and
            (tabstractnormalvarsym(def.funcretsym).refs>0) then
@@ -1045,95 +1077,16 @@ implementation
                   hs:='X*'
                 else
                   hs:='X';
-                templist.concat(Tai_stab.create(stab_stabs,strpnew(
+                templist.concat(Tai_stab.create(stabsdir,strpnew(
                    '"'+GetSymName(def.procsym)+':'+hs+def_stab_number(def.returndef)+'",'+
-                   tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(def.funcretsym).localloc.reference.offset))));
+                   base_stabs_str(localvarsymref_stab,'0','0',tostr(tabstractnormalvarsym(def.funcretsym).localloc.reference.offset)))));
                 if (m_result in current_settings.modeswitches) then
-                  templist.concat(Tai_stab.create(stab_stabs,strpnew(
+                  templist.concat(Tai_stab.create(stabsdir,strpnew(
                      '"RESULT:'+hs+def_stab_number(def.returndef)+'",'+
-                     tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(def.funcretsym).localloc.reference.offset))));
+                     base_stabs_str(localvarsymref_stab,'0','0',tostr(tabstractnormalvarsym(def.funcretsym).localloc.reference.offset)))));
               end;
           end;
-        // LBRAC
-        ss:=tostr(N_LBRAC)+',0,0,';
-        if target_info.cpu=cpu_powerpc64 then
-          ss:=ss+'.';
-        ss:=ss+def.mangledname;
-        if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
-          begin
-            ss:=ss+'-';
-            if target_info.cpu=cpu_powerpc64 then
-              ss:=ss+'.';
-            ss:=ss+def.mangledname;
-          end;
-        templist.concat(Tai_stab.Create_ansistr(stab_stabn,ss));
-        // RBRAC
-        ss:=tostr(N_RBRAC)+',0,0,'+stabsendlabel.name;
-        if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
-          begin
-            ss:=ss+'-';
-            if target_info.cpu=cpu_powerpc64 then
-              ss:=ss+'.';
-            ss:=ss+def.mangledname;
-          end;
-        templist.concat(Tai_stab.Create_ansistr(stab_stabn,ss));
-
-        { the stabsendlabel must come after all other stabs for this }
-        { function                                                   }
-        templist.concat(tai_label.create(stabsendlabel));
-
-        { Add a "size" stab as described in the last paragraph of 2.5 at  }
-        { http://sourceware.org/gdb/current/onlinedocs/stabs_2.html#SEC12 }
-        { This works at least on Darwin (and is needed on Darwin to get   }
-        { correct smartlinking of stabs), but I don't know which binutils }
-        { version is required on other platforms                          }
-        { This stab must come after all other stabs for the procedure,    }
-        { including the LBRAC/RBRAC ones                                  }
-        if (target_info.system in systems_darwin) then
-          templist.concat(Tai_stab.create(stab_stabs,
-            strpnew('"",'+tostr(N_FUNCTION)+',0,0,'+stabsendlabel.name+'-'+def.mangledname)));
 
-        current_asmdata.asmlists[al_procedures].insertlistafter(def.procendtai,templist);
-
-        { "The stab representing a procedure is located immediately
-          following the code of the procedure. This stab is in turn
-          directly followed by a group of other stabs describing
-          elements of the procedure. These other stabs describe the
-          procedure's parameters, its block local variables, and its
-          block structure." (stab docs)                               }
-        { this is however incorrect in case "include source" statements }
-        { appear in the block, in that case the procedure stab must     }
-        { appear before this include stabs (and we generate such an     }
-        { stabs for all functions) (JM)                                 }
-
-        { FUNC stabs }
-        obj := GetSymName(def.procsym);
-        info := '';
-        if (po_global in def.procoptions) then
-          RType := 'F'
-        else
-          RType := 'f';
-        if assigned(def.owner) then
-          begin
-            if (def.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
-              obj := GetSymTableName(def.owner)+'__'+GetSymName(def.procsym);
-            if not(cs_gdb_valgrind in current_settings.globalswitches) and
-               (def.owner.symtabletype=localsymtable) and
-               assigned(def.owner.defowner) and
-               assigned(tprocdef(def.owner.defowner).procsym) then
-              info := ','+GetSymName(def.procsym)+','+GetSymName(tprocdef(def.owner.defowner).procsym);
-          end;
-        templist.concat(Tai_stab.Create_ansistr(stab_stabs,'"'+ansistring(obj)+':'+RType+def_stab_number(def.returndef)+info+'",'+tostr(n_function)+',0,'+tostr(def.fileinfo.line)+','+ansistring(def.mangledname)));
-        current_asmdata.asmlists[al_procedures].insertlistbefore(def.procstarttai,templist);
-
-        { para types }
-        if assigned(def.parast) then
-          write_symtable_syms(templist,def.parast);
-        { local type defs and vars should not be written
-          inside the main proc stab }
-        if assigned(def.localst) and
-           (def.localst.symtabletype=localsymtable) then
-          write_symtable_syms(templist,def.localst);
 
         current_asmdata.asmlists[al_procedures].insertlistbefore(def.procstarttai,templist);
 
@@ -1153,23 +1106,11 @@ implementation
         if s='name' then
           result:=GetSymName(sym)
         else if s='mangledname' then
-          result:=sym.mangledname
+          result:=ReplaceForbiddenAsmSymbolChars(sym.mangledname)
         else if s='ownername' then
           result:=GetSymTableName(sym.owner)
         else if s='line' then
           result:=tostr(sym.fileinfo.line)
-        else if s='N_LSYM' then
-          result:=tostr(N_LSYM)
-        else if s='N_LCSYM' then
-          result:=tostr(N_LCSYM)
-        else if s='N_RSYM' then
-          result:=tostr(N_RSYM)
-        else if s='N_TSYM' then
-          result:=tostr(N_TSYM)
-        else if s='N_STSYM' then
-          result:=tostr(N_STSYM)
-        else if s='N_FUNCTION' then
-          result:=tostr(N_FUNCTION)
         else
           internalerror(200401152);
       end;
@@ -1186,7 +1127,24 @@ implementation
         if ss='' then
           exit;
         { add to list }
-        list.concat(Tai_stab.create_ansistr(stab_stabs,ss));
+        list.concat(Tai_stab.create_ansistr(stabsdir,ss));
+      end;
+
+
+    function TDebugInfoStabs.staticvarsym_mangled_name(sym: tstaticvarsym): string;
+      begin
+        result:=ReplaceForbiddenAsmSymbolChars(sym.mangledname);
+      end;
+
+
+    procedure TDebugInfoStabs.maybe_add_vmt_sym(list: TAsmList; def: tobjectdef);
+      begin
+        if (oo_has_vmt in def.objectoptions) and
+           assigned(def.owner) and
+           assigned(def.owner.name) then
+          list.concat(Tai_stab.create_ansistr(stabsdir,ansistring('"vmt_')+GetSymTableName(def.owner)+tobjectdef(def).objname^+':S'+
+                 def_stab_number(vmttype)+'",'+
+                 base_stabs_str(globalvarsym_inited_stab,'0','0',ReplaceForbiddenAsmSymbolChars(tobjectdef(def).vmt_mangledname))));
       end;
 
 
@@ -1197,7 +1155,7 @@ implementation
         ss:='';
         if (sym.owner.symtabletype in [ObjectSymtable,recordsymtable]) and
            (sp_static in sym.symoptions) then
-          ss:=sym_stabstr_evaluate(sym,'"${ownername}__${name}:S$1",${N_LCSYM},0,${line},${mangledname}',
+          ss:=sym_stabstr_evaluate(sym,'"${ownername}__${name}:S$1",'+base_stabs_str(globalvarsym_uninited_stab,'0','${line}','${mangledname}'),
               [def_stab_number(sym.vardef)]);
         write_sym_stabstr(list,sym,ss);
       end;
@@ -1209,7 +1167,7 @@ implementation
         st : string;
         threadvaroffset : string;
         regidx : Tregisterindex;
-        nsym : string[7];
+        nsym : byte;
       begin
         { external symbols can't be resolved at link time, so we
           can't generate stabs for them }
@@ -1229,7 +1187,7 @@ implementation
               { "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}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
+                ss:=sym_stabstr_evaluate(sym,'"${name}:r$1",'+base_stabs_str(regvar_stab,'0','${line}','$2'),[st,tostr(regstabs_table[regidx])]);
             end;
           else
             begin
@@ -1238,15 +1196,20 @@ implementation
               else
                 threadvaroffset:='';
               if (vo_is_typed_const in sym.varoptions) then
-                nsym:='N_STSYM'
+                if vo_is_public in sym.varoptions then
+                  nsym:=globalvarsym_inited_stab
+                else
+                  nsym:=staticvarsym_inited_stab
+              else if vo_is_public in sym.varoptions then
+                nsym:=globalvarsym_uninited_stab
               else
-                nsym:='N_LCSYM';
+                nsym:=staticvarsym_uninited_stab;
               { Here we used S instead of
                 because with G GDB doesn't look at the address field
                 but searches the same name or with a leading underscore
                 but these names don't exist in pascal !}
               st:='S'+st;
-              ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${'+nsym+'},0,${line},${mangledname}$2',[st,threadvaroffset]);
+              ss:=sym_stabstr_evaluate(sym,'"${name}:$1",'+base_stabs_str(nsym,'0','${line}','$2$3'),[st,staticvarsym_mangled_name(sym),threadvaroffset]);
             end;
         end;
         write_sym_stabstr(list,sym,ss);
@@ -1277,12 +1240,12 @@ implementation
               { "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}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
+                ss:=sym_stabstr_evaluate(sym,'"${name}:r$1",'+base_stabs_str(regvar_stab,'0','${line}','$2'),[st,tostr(regstabs_table[regidx])]);
             end;
           LOC_REFERENCE :
             { 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",'+base_stabs_str(localvarsymref_stab,'0','${line}','$2'),[st,tostr(sym.localloc.reference.offset)])
           else
             internalerror(2003091814);
         end;
@@ -1304,7 +1267,111 @@ implementation
         { "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]))]);
+          result:=sym_stabstr_evaluate(sym,'"${name}:$1",'+base_stabs_str(regvar_stab,'0','${line}','$2'),[ltyp+stabstr,tostr(longint(regstabs_table[regidx]))]);
+      end;
+
+
+    function TDebugInfoStabs.base_stabs_str(typ: longint; const other, desc, value: ansistring): ansistring;
+      begin
+        result:=base_stabs_str(tostr(typ),other,desc,value);
+      end;
+
+
+    function TDebugInfoStabs.base_stabs_str(const typ, other, desc, value: ansistring): ansistring;
+      begin
+        result:=typ+','+other+','+desc+','+value
+      end;
+
+
+    function TDebugInfoStabs.gen_procdef_startsym_stabs(def: tprocdef): TAsmList;
+      var
+        RType : Char;
+        Obj,Info,
+        mangledname: ansistring;
+      begin
+        result:=TAsmList.create;
+        { "The stab representing a procedure is located immediately
+          following the code of the procedure. This stab is in turn
+          directly followed by a group of other stabs describing
+          elements of the procedure. These other stabs describe the
+          procedure's parameters, its block local variables, and its
+          block structure." (stab docs)                               }
+        { this is however incorrect in case "include source" statements }
+        { appear in the block, in that case the procedure stab must     }
+        { appear before this include stabs (and we generate such an     }
+        { stabs for all functions) (JM)                                 }
+
+        obj := GetSymName(def.procsym);
+        info := '';
+        if (po_global in def.procoptions) then
+          RType := 'F'
+        else
+          RType := 'f';
+        if assigned(def.owner) then
+          begin
+            if (def.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
+              obj := GetSymTableName(def.owner)+'__'+GetSymName(def.procsym);
+            if not(cs_gdb_valgrind in current_settings.globalswitches) and
+               (def.owner.symtabletype=localsymtable) and
+               assigned(def.owner.defowner) and
+               assigned(tprocdef(def.owner.defowner).procsym) then
+              info := ','+GetSymName(def.procsym)+','+GetSymName(tprocdef(def.owner.defowner).procsym);
+          end;
+        mangledname:=ReplaceForbiddenAsmSymbolChars(def.mangledname);
+        if target_info.system in systems_dotted_function_names then
+          mangledname:='.'+mangledname;
+        result.concat(Tai_stab.Create_ansistr(stabsdir,'"'+obj+':'+RType+def_stab_number(def.returndef)+info+'",'+
+          base_stabs_str(procdef_stab,'0',tostr(def.fileinfo.line),mangledname)));
+      end;
+
+
+    function TDebugInfoStabs.gen_procdef_endsym_stabs(def: tprocdef): TAsmList;
+      var
+        ss, mangledname: ansistring;
+        stabsendlabel: tasmlabel;
+      begin
+        result:=TAsmList.create;
+
+        { end of procedure }
+        current_asmdata.getlabel(stabsendlabel,alt_dbgtype);
+
+        if dbgtype<>dbg_stabx then
+          begin
+            mangledname:=def.mangledname;
+            if target_info.system in systems_dotted_function_names then
+              mangledname:='.'+mangledname;
+            // LBRAC
+            ss:=tostr(STABS_N_LBRAC)+',0,0,'+mangledname;
+            if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
+              begin
+                ss:=ss+'-';
+                ss:=ss+mangledname;
+              end;
+            result.concat(Tai_stab.Create_ansistr(stab_stabn,ss));
+            // RBRAC
+            ss:=tostr(STABS_N_RBRAC)+',0,0,'+stabsendlabel.name;
+            if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
+              begin
+                ss:=ss+'-';
+                ss:=ss+mangledname;
+              end;
+            result.concat(Tai_stab.Create_ansistr(stab_stabn,ss));
+
+            { the stabsendlabel must come after all other stabs for this }
+            { function                                                   }
+            result.concat(tai_label.create(stabsendlabel));
+
+            { Add a "size" stab as described in the last paragraph of 2.5 at  }
+            { http://sourceware.org/gdb/current/onlinedocs/stabs_2.html#SEC12 }
+            { This works at least on Darwin (and is needed on Darwin to get   }
+            { correct smartlinking of stabs), but I don't know which binutils }
+            { version is required on other platforms                          }
+            { This stab must come after all other stabs for the procedure,    }
+            { including the LBRAC/RBRAC ones                                  }
+            if (target_info.system in systems_darwin) then
+              result.concat(Tai_stab.create(stabsdir,
+                strpnew('"",'+base_stabs_str(procdef_stab,'0','0',stabsendlabel.name+'-'+mangledname))));
+          end;
       end;
 
 
@@ -1332,12 +1399,12 @@ implementation
                (po_staticmethod in tabstractprocdef(sym.owner.defowner).procoptions) then
               begin
                 if (sym.localloc.loc=LOC_REFERENCE) then
-                  ss:=sym_stabstr_evaluate(sym,'"pvmt:p$1",${N_TSYM},0,0,$2',
+                  ss:=sym_stabstr_evaluate(sym,'"pvmt:p$1",'+base_stabs_str(localvarsymref_stab,'0','0','$2'),
                     [def_stab_number(pvmttype),tostr(sym.localloc.reference.offset)])
                 else
                   begin
                     regidx:=findreg_by_number(sym.localloc.register);
-                    ss:=sym_stabstr_evaluate(sym,'"pvmt:r$1",${N_RSYM},0,0,$2',
+                    ss:=sym_stabstr_evaluate(sym,'"pvmt:r$1",'+base_stabs_str(regvar_stab,'0','0','$2'),
                       [def_stab_number(pvmttype),tostr(regstabs_table[regidx])]);
                   end
                 end
@@ -1348,7 +1415,7 @@ implementation
                 else
                   c:='p';
                 if (sym.localloc.loc=LOC_REFERENCE) then
-                  ss:=sym_stabstr_evaluate(sym,'"$$t:$1",${N_TSYM},0,0,$2',
+                  ss:=sym_stabstr_evaluate(sym,'"$$t:$1",'+base_stabs_str(localvarsymref_stab,'0','0','$2'),
                         [c+def_stab_number(tprocdef(sym.owner.defowner).struct),tostr(sym.localloc.reference.offset)])
                 else
                   begin
@@ -1357,7 +1424,7 @@ implementation
                     else
                       c:='a';
                     regidx:=findreg_by_number(sym.localloc.register);
-                    ss:=sym_stabstr_evaluate(sym,'"$$t:$1",${N_RSYM},0,0,$2',
+                    ss:=sym_stabstr_evaluate(sym,'"$$t:$1",'+base_stabs_str(regvar_stab,'0','0','$2'),
                         [c+def_stab_number(tprocdef(sym.owner.defowner).struct),tostr(regstabs_table[regidx])]);
                   end
               end;
@@ -1390,7 +1457,8 @@ implementation
                     Not doing this breaks debugging under e.g. SPARC. Doc:
                     http://sourceware.org/gdb/current/onlinedocs/stabs_4.html#SEC26
                   }
-                  if (c='p') and
+                  if (target_dbg.id<>dbg_stabx) and
+                     (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
@@ -1402,14 +1470,14 @@ implementation
                       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)]);
+                        ss:=sym_stabstr_evaluate(sym,'"${name}:$1",'+base_stabs_str(localvarsymref_stab,'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',[c+st,tostr(sym.localloc.reference.offset)])
+                  ss:=sym_stabstr_evaluate(sym,'"${name}:$1",'+base_stabs_str(paravarsymref_stab,'0','${line}','$2'),[c+st,tostr(sym.localloc.reference.offset)])
                 end;
               else
                 internalerror(2003091814);
@@ -1419,6 +1487,28 @@ implementation
       end;
 
 
+    function stabx_quote_const(const s: string): string;
+      var
+        i:byte;
+      begin
+        stabx_quote_const:='';
+        for i:=1 to length(s) do
+          begin
+            case s[i] of
+              #10:
+                stabx_quote_const:=stabx_quote_const+'\n';
+              #13:
+                stabx_quote_const:=stabx_quote_const+'\r';
+              { stabx strings cannot deal with embedded quotes }
+              '"':
+                stabx_quote_const:=stabx_quote_const+' ';
+              else
+                stabx_quote_const:=stabx_quote_const+s[i];
+            end;
+          end;
+      end;
+
+
     procedure TDebugInfoStabs.appendsym_const(list:TAsmList;sym:tconstsym);
       var
         st : string;
@@ -1435,7 +1525,10 @@ implementation
           conststring:
             begin
               if sym.value.len<200 then
-                st:='s'''+backspace_quote(octal_quote(strpas(pchar(sym.value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']),['"','\',#10,#13])+''''
+                if target_dbg.id=dbg_stabs then
+                  st:='s'''+backspace_quote(octal_quote(strpas(pchar(sym.value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']),['"','\',#10,#13])+''''
+                else
+                  st:='s'''+stabx_quote_const(octal_quote(strpas(pchar(sym.value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']))
               else
                 st:='<constant string too long>';
             end;
@@ -1454,7 +1547,7 @@ implementation
               st:='i0';
             end;
         end;
-        ss:=sym_stabstr_evaluate(sym,'"${name}:c=$1;",${N_FUNCTION},0,${line},0',[st]);
+        ss:=sym_stabstr_evaluate(sym,'"${name}:c=$1;",'+base_stabs_str(constsym_stab,'0','${line}','0'),[st]);
         write_sym_stabstr(list,sym,ss);
       end;
 
@@ -1468,10 +1561,10 @@ implementation
         if not assigned(sym.typedef) then
           internalerror(200509262);
         if sym.typedef.typ in tagtypes then
-          stabchar:='Tt'
+          stabchar:=tagtypeprefix
         else
           stabchar:='t';
-        ss:=sym_stabstr_evaluate(sym,'"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,def_stab_number(sym.typedef)]);
+        ss:=sym_stabstr_evaluate(sym,'"${name}:$1$2",'+base_stabs_str(typesym_stab,'0','${line}','0'),[stabchar,def_stab_number(sym.typedef)]);
         write_sym_stabstr(list,sym,ss);
       end;
 
@@ -1480,7 +1573,7 @@ implementation
       var
         ss : ansistring;
       begin
-        ss:=sym_stabstr_evaluate(sym,'"${name}",${N_LSYM},0,${line},0',[]);
+        ss:=sym_stabstr_evaluate(sym,'"${name}",'+base_stabs_str(localvarsymref_stab,'0','${line}','0'),[]);
         write_sym_stabstr(list,sym,ss);
       end;
 
@@ -1489,7 +1582,7 @@ implementation
                              Proc/Module support
 ****************************************************************************}
 
-    procedure tdebuginfostabs.inserttypeinfo;
+    procedure TDebugInfoStabs.inserttypeinfo;
       var
         stabsvarlist,
         stabstypelist : TAsmList;
@@ -1570,7 +1663,7 @@ implementation
       end;
 
 
-    procedure tdebuginfostabs.insertlineinfo(list:TAsmList);
+    procedure TDebugInfoStabs.insertlineinfo(list: TAsmList);
       var
         currfileinfo,
         lastfileinfo : tfileposinfo;
@@ -1611,10 +1704,10 @@ implementation
                         { emit stabs }
                         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)+
+                          list.insertbefore(Tai_stab.Create_str(stabsdir,'"'+BsToSlash(FixPath(infile.path^,false))+FixFileName(infile.name^)+'",'+tostr(stabs_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)+
+                          list.insertbefore(Tai_stab.Create_str(stabsdir,'"'+BsToSlash(FixPath(getcurrentdir,false)+FixPath(infile.path^,false))+FixFileName(infile.name^)+'",'+tostr(stabs_n_includefile)+
                                             ',0,0,'+hlabel.name),hp);
                         list.insertbefore(tai_label.create(hlabel),hp);
                         { force new line info }
@@ -1629,12 +1722,12 @@ implementation
                         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)+','+
+                        list.insertbefore(Tai_stab.Create_str(stab_stabn,tostr(stabs_n_textline)+',0,'+tostr(currfileinfo.line)+','+
                                           hlabel.name+' - '+{$IFDEF POWERPC64}'.'+{$ENDIF POWERPC64}currfuncname^),hp);
                         list.insertbefore(tai_label.create(hlabel),hp);
                       end
                      else
-                      list.insertbefore(Tai_stab.Create_str(stab_stabd,tostr(n_textline)+',0,'+tostr(currfileinfo.line)),hp);
+                      list.insertbefore(Tai_stab.Create_str(stab_stabd,tostr(stabs_n_textline)+',0,'+tostr(currfileinfo.line)),hp);
                   end;
                 lastfileinfo:=currfileinfo;
               end;
@@ -1644,7 +1737,7 @@ implementation
       end;
 
 
-    procedure tdebuginfostabs.insertmoduleinfo;
+    procedure TDebugInfoStabs.insertmoduleinfo;
       var
         hlabel : tasmlabel;
         infile : tinputfile;
@@ -1655,27 +1748,27 @@ 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));
-        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,'"'+BsToSlash(FixPath(infile.path^,false))+FixFileName(infile.name^)+'",'+tostr(n_sourcefile)+
-                    ',0,0,'+hlabel.name));
+        current_asmdata.asmlists[al_start].concat(Tai_stab.Create_str(stabsdir,'"'+BsToSlash(FixPath(getcurrentdir,false))+'",'+
+          base_stabs_str(stabs_n_sourcefile,'0','0',hlabel.name)));
+        current_asmdata.asmlists[al_start].concat(Tai_stab.Create_str(stabsdir,'"'+BsToSlash(FixPath(infile.path^,false))+FixFileName(infile.name^)+'",'+
+          base_stabs_str(stabs_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      }
         { either some assembler or gdb bug (radar 4386531 according to a }
         { comment in dbxout.c of Apple's gcc)                            }
         if (target_info.system in systems_darwin) then
-          current_asmdata.asmlists[al_end].concat(Tai_stab.Create_str(stab_stabs,'"",'+tostr(N_OSO)+',0,0,0'));
+          current_asmdata.asmlists[al_end].concat(Tai_stab.Create_str(stabsdir,'"",'+base_stabs_str(STABS_N_OSO,'0','0','0')));
         { emit empty n_sourcefile for end of module }
         current_asmdata.getlabel(hlabel,alt_dbgfile);
         new_section(current_asmdata.asmlists[al_end],sec_code,make_mangledname('DEBUGEND',current_module.localsymtable,''),0,secorder_end);
         if not(target_info.system in systems_darwin) then
           current_asmdata.asmlists[al_end].concat(tai_symbol.Createname_global(make_mangledname('DEBUGEND',current_module.localsymtable,''),AT_DATA,0));
-        current_asmdata.asmlists[al_end].concat(Tai_stab.Create_str(stab_stabs,'"",'+tostr(n_sourcefile)+',0,0,'+hlabel.name));
+        current_asmdata.asmlists[al_end].concat(Tai_stab.Create_str(stabsdir,'"",'+base_stabs_str(stabs_n_sourcefile,'0','0',hlabel.name)));
         current_asmdata.asmlists[al_end].concat(tai_label.create(hlabel));
       end;
 
 
-    procedure tdebuginfostabs.referencesections(list:TAsmList);
+        procedure TDebugInfoStabs.referencesections(list: TAsmList);
       var
         hp : tmodule;
         dbgtable : tai_symbol;
@@ -1708,6 +1801,22 @@ implementation
     constructor TDebugInfoStabs.Create;
       begin
         inherited Create;
+        dbgtype:=dbg_stabs;
+        stabsdir:=stab_stabs;
+
+        def_stab:=STABS_N_LSYM;
+        regvar_stab:=STABS_N_RSYM;
+        procdef_stab:=STABS_N_Function;
+        constsym_stab:=STABS_N_Function;
+        typesym_stab:=STABS_N_LSYM;
+        globalvarsym_uninited_stab:=STABS_N_STSYM;
+        globalvarsym_inited_stab:=STABS_N_LCSYM;
+        staticvarsym_uninited_stab:=STABS_N_STSYM;
+        staticvarsym_inited_stab:=STABS_N_LCSYM;
+        localvarsymref_stab:=STABS_N_TSYM;
+        paravarsymref_stab:=STABS_N_TSYM;
+        tagtypeprefix:='Tt';
+
         vardatadef:=nil;
       end;
 

compiler/dbgstabx.pas

@@ -0,0 +1,472 @@
+{
+    Copyright (c) 2012 by Jonas Maebe
+
+    This units contains support for STABX debug info generation
+
+    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 dbgstabx;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    cclasses,globtype,
+    dbgbase,dbgstabs,cgbase,
+    symtype,symdef,symsym,symtable,symbase,
+    aasmtai,aasmdata;
+
+  type
+    TDebugInfoStabx = class(TDebugInfoStabs)
+     protected
+      function staticvarsym_mangled_name(sym: tstaticvarsym): string; override;
+      procedure maybe_add_vmt_sym(list: TAsmList; def: tobjectdef); override;
+      procedure write_def_stabstr(list:TAsmList;def:tdef;const ss:ansistring);override;
+      function  base_stabs_str(const typ, other, desc, value: ansistring): ansistring;overload;override;
+      function  gen_procdef_startsym_stabs(def: tprocdef): TAsmList; override;
+      function  gen_procdef_endsym_stabs(def: tprocdef): TAsmList; override;
+      procedure appendsym_label(list: TAsmList; sym: tlabelsym); override;
+      procedure appendsym_staticvar(list: TAsmList; sym: tstaticvarsym); override;
+     public
+      procedure insertlineinfo(list:TAsmList);override;
+      procedure insertmoduleinfo; override;
+      procedure referencesections(list: TAsmList); override;
+
+      constructor create;override;
+    end;
+
+implementation
+
+  uses
+    globals,cutils,cfileutl,verbose,
+    systems,finput,fmodule,
+    aasmbase,
+    symconst;
+
+  const
+    STABX_N_GSYM = $80;
+    STABX_N_LSYM = $81;
+    STABX_N_PSYM = $82;
+    STABX_N_RSYM = $83;
+    STABX_N_RPSYM = $84;
+    STABX_N_STSYM = $85;
+    STABX_N_LCSYM = 255;
+    STABX_N_Function = $8e;
+    STABX_N_TextLine = 255;
+    STABX_N_DataLine = 255;
+    STABX_N_BssLine = 255;
+    STABX_N_DECL = $8c;
+    STABX_N_tsym = $86;
+    STABX_N_SourceFile = 255;
+    STABX_N_OSO = 255;
+    STABX_N_IncludeFile = 255;
+    STABX_N_BINCL = 255;
+    STABX_N_EINCL = 255;
+    STABX_N_LBRAC = 255;
+    STABX_N_EXCL = 255;
+    STABX_N_RBRAC = 255;
+
+
+{ TDebugInfoStabx }
+
+  function TDebugInfoStabx.base_stabs_str(const typ, other, desc, value: ansistring): ansistring;
+    begin
+      { no other/desc }
+      result:=value+','+typ+',0';
+    end;
+
+
+  function TDebugInfoStabx.staticvarsym_mangled_name(sym: tstaticvarsym): string;
+    begin
+      { create reference to the local symbol at the same address as the global
+        symbol (with same name as unmangled symbol, so GDB can find it) }
+      Result:=ReplaceForbiddenAsmSymbolChars(sym.name);
+    end;
+
+
+  procedure TDebugInfoStabx.maybe_add_vmt_sym(list: TAsmList; def: tobjectdef);
+    begin
+(*
+      if assigned(def.owner) and
+         def.owner.iscurrentunit then
+        begin
+          if (oo_has_vmt in def.objectoptions) and
+             assigned(def.owner.name) then
+            list.concat(Tai_stab.create_ansistr(stabsdir,ansistring('"vmt_')+GetSymTableName(def.owner)+tobjectdef(def).objname^+':S'+
+                   def_stab_number(vmttype)+'",'+
+                   base_stabs_str(globalvarsym_inited_stab,'0','0',ReplaceForbiddenAsmSymbolChars(tobjectdef(def).vmt_mangledname)+'.')));
+        end;
+*)
+      { do nothing, because creating debug information for a global symbol
+        defined in another unit is not possible for stabx given the FPC
+        constraints (namely that the name of the global symbol does not match
+        the name of the variable). If it's in the same unit, we have to add an
+        extra symbol for the vmt with the same variable name as what we have
+        here (ansistring('"vmt_')+GetSymTableName(def.owner)+tobjectdef(def).objname^).
+        We'd have to do that when that symbol is created, in generic code,
+        which is not very clean, and moreover these symbols are not really
+        used for anything currently, afaik }
+    end;
+
+
+  procedure TDebugInfoStabx.write_def_stabstr(list:TAsmList;def:tdef;const ss:ansistring);
+    var
+      stabchar,
+      symname,
+      declstabnr,
+      st    : ansistring;
+    begin
+      { type prefix }
+      if def.typ in tagtypes then
+        stabchar := tagtypeprefix
+      else
+        stabchar := 't';
+      { in case of writing the class record structure, we always have to
+        use the class name (so it refers both to the struct and the
+        pointer to the struct), otherwise gdb crashes (see tests/webtbs/tw9766.pp) }
+
+      if is_class(def) and
+         tobjectdef(def).writing_class_record_dbginfo then
+        begin
+          declstabnr:=def_stab_classnumber(tobjectdef(def));
+          symname:='${sym_name}'
+        end
+      else
+        begin
+          { Type names for types defined in the current unit are already written in
+            the typesym }
+          if (def.owner.symtabletype=globalsymtable) and
+             not(def.owner.iscurrentunit) then
+            symname:='${sym_name}'
+          else
+            symname:='';
+          declstabnr:=def_stab_number(def)
+        end;
+      if (symname='') or
+         not(def.typ in tagtypes) then
+        begin
+          st:=def_stabstr_evaluate(def,':$1$2=',[stabchar,declstabnr]);
+          st:='"'+def_stabstr_evaluate(def,symname,[])+st+ss;
+          { line info is set to 0 for all defs, because the def can be in another
+            unit and then the linenumber is invalid in the current sourcefile }
+          st:=st+'",'+base_stabs_str(def_stab,'0','0','0');
+          { add to list }
+          list.concat(Tai_stab.create_ansistr(stabsdir,st));
+        end
+      else
+        begin
+          { first tag, then type decl }
+          inc(global_stab_number);
+          st:=def_stabstr_evaluate(def,':$1$2=',[stabchar,tostr(global_stab_number)]);
+          st:='"'+st+ss;
+          st:=st+'",'+base_stabs_str(def_stab,'0','0','0');
+          list.concat(Tai_stab.create_ansistr(stabsdir,st));
+          st:='"'+def_stabstr_evaluate(def,symname+':t$1=$2',[declstabnr,tostr(global_stab_number)]);
+          st:=st+'",'+base_stabs_str(def_stab,'0','0','0');
+          list.concat(Tai_stab.create_ansistr(stabsdir,st));
+        end;
+    end;
+
+
+  function TDebugInfoStabx.gen_procdef_startsym_stabs(def: tprocdef): TAsmList;
+    var
+      mangledname: ansistring;
+      hp, hpp, inclstart: tai;
+    begin
+      result:=inherited;
+      { can happen for procdefs defined in other units, this code is only for
+        the place where it is defined }
+      if not assigned(def.procstarttai) then
+        exit;
+      mangledname:=ReplaceForbiddenAsmSymbolChars(def.mangledname);
+      if target_info.system in systems_dotted_function_names then
+        mangledname:='.'+mangledname;
+      result.concat(tai_stab.create(stabx_function,
+        strpnew(mangledname+','+mangledname+',16,044,LT.'+mangledname+'-'+mangledname)));
+      { hoist the already generated ".bf" up right after the function
+        definition so that all parameter and local variable definitions come
+        after it -- we have to generate it during lineinfo generation and not
+        here to make sure it takes into account include files opened right after
+        the function definition but before the code starts
+        -- also move include file start if any}
+      hp:=def.procstarttai;
+      inclstart:=nil;
+      while (hp.typ<>ait_symbol_end) and
+            ((hp.typ<>ait_stab) or
+             (tai_stab(hp).stabtype<>stabx_bf)) do
+        begin
+          if (hp.typ=ait_stab) and
+             (tai_stab(hp).stabtype=stabx_bi) then
+            inclstart:=hp;
+          hp:=tai(hp.next);
+        end;
+      { happens for implicit unit init routines and the like, they don't get
+        line info }
+      if hp.typ=ait_symbol_end then
+        exit;
+      if assigned(inclstart) then
+        begin
+          current_asmdata.asmlists[al_procedures].Remove(inclstart);
+          result.concat(inclstart);
+        end;
+      current_asmdata.asmlists[al_procedures].Remove(hp);
+      result.concat(hp);
+      { also hoist up the function start symbol(s) }
+      hp:=def.procstarttai;
+      while assigned(hp) and
+            (hp.typ<>ait_symbol_end) do
+        begin
+          if (hp.typ=ait_symbol) and
+             (tai_symbol(hp).sym.typ=AT_FUNCTION) then
+            begin
+              hpp:=tai(hp.next);
+              if hp=def.procstarttai then
+                def.procstarttai:=hpp;
+              current_asmdata.asmlists[al_procedures].Remove(hp);
+              result.insert(hp);
+              hp:=hpp;
+            end
+          else
+            hp:=tai(hp.next);
+        end;
+    end;
+
+
+  function TDebugInfoStabx.gen_procdef_endsym_stabs(def: tprocdef): TAsmList;
+    var
+      procendsymbol: tasmsymbol;
+    begin
+      result:=inherited gen_procdef_endsym_stabs(def);
+      if not assigned(def.procstarttai) then
+        exit;
+      procendsymbol:=current_asmdata.DefineAsmSymbol('LT..'+ReplaceForbiddenAsmSymbolChars(def.mangledname),AB_LOCAL,AT_ADDR);
+      current_asmdata.asmlists[al_procedures].insertbefore(tai_symbol.create(procendsymbol,0),def.procendtai);
+    end;
+
+
+  procedure TDebugInfoStabx.appendsym_label(list: TAsmList; sym: tlabelsym);
+    begin
+      // ignore, not sure what kind of debug information we could generate for
+      // this
+    end;
+
+
+  procedure TDebugInfoStabx.appendsym_staticvar(list: TAsmList; sym: tstaticvarsym);
+    var
+      ismem,
+      isglobal: boolean;
+    begin
+      if vo_is_external in sym.varoptions then
+        exit;
+      ismem:=not(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER,LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]);
+      if ismem then
+        isglobal:=current_asmdata.RefAsmSymbol(sym.mangledname).bind=AB_GLOBAL;
+
+      { put extra ss/es markers in place }
+      if ismem then
+        if isglobal then
+          list.concat(tai_stab.Create_ansistr(stabx_bs,'.data[RW]'))
+        else
+          list.concat(tai_stab.Create_ansistr(stabx_bs,'_data.bss_[RW]'));
+      inherited;
+      if ismem then
+        list.concat(tai_stab.Create_ansistr(stabx_es,''));
+    end;
+
+
+  procedure TDebugInfoStabx.insertlineinfo(list: TAsmList);
+    var
+      currfileinfo,
+      lastfileinfo,
+      curincludefileinfo,
+      curfunstartfileinfo: tfileposinfo;
+      currsectype  : TAsmSectiontype;
+      hp, inclinsertpos, last : tai;
+      infile : tinputfile;
+      i,
+      linenr,
+      nolineinfolevel: longint;
+      nextlineisfunstart: boolean;
+    begin
+      FillChar(currfileinfo,sizeof(currfileinfo),0);
+      FillChar(lastfileinfo,sizeof(lastfileinfo),0);
+      FillChar(curincludefileinfo,sizeof(curincludefileinfo),0);
+      FillChar(curfunstartfileinfo,sizeof(curfunstartfileinfo),0);
+      currsectype:=sec_code;
+      hp:=Tai(list.first);
+      nextlineisfunstart:=false;
+      nolineinfolevel:=0;
+      last:=nil;
+      while assigned(hp) do
+        begin
+          case hp.typ of
+            ait_section :
+              currsectype:=tai_section(hp).sectype;
+            ait_force_line :
+              lastfileinfo.line:=-1;
+            ait_symbol:
+              if tai_symbol(hp).sym.typ = AT_FUNCTION then
+                nextlineisfunstart:=true;
+            ait_symbol_end:
+              if tai_symbol_end(hp).sym.typ = AT_FUNCTION then
+                begin
+                  { end of function }
+                  list.insertbefore(Tai_stab.Create_str(stabx_ef,tostr(currfileinfo.line)),hp);
+                end;
+            ait_marker :
+              begin
+                case tai_marker(hp).kind of
+                  mark_NoLineInfoStart:
+                    inc(nolineinfolevel);
+                  mark_NoLineInfoEnd:
+                    dec(nolineinfolevel);
+                end;
+              end;
+          end;
+
+          if (currsectype=sec_code) and
+             (hp.typ=ait_instruction) then
+            begin
+              currfileinfo:=tailineinfo(hp).fileinfo;
+
+              inclinsertpos:=hp;
+              while assigned(inclinsertpos.previous) and
+                    (tai(inclinsertpos.previous).typ in (SkipInstr+[ait_marker])) do
+                inclinsertpos:=tai(inclinsertpos.previous);
+
+              { file changed ? (must be before line info) }
+              if (currfileinfo.fileindex<>0) and
+                 ((lastfileinfo.fileindex<>currfileinfo.fileindex) or
+                  (lastfileinfo.moduleindex<>currfileinfo.moduleindex)) then
+                begin
+                  if curincludefileinfo.fileindex<>0 then
+                    begin
+                      infile:=get_module(curincludefileinfo.moduleindex).sourcefiles.get_file(curincludefileinfo.fileindex);
+                      list.insertbefore(Tai_stab.Create_str(stabx_ei,'"'+FixFileName(infile.name^)+'"'),inclinsertpos);
+                      curincludefileinfo.fileindex:=0;
+                    end;
+                  if currfileinfo.fileindex<>1 then
+                    begin
+                      infile:=get_module(currfileinfo.moduleindex).sourcefiles.get_file(currfileinfo.fileindex);
+                      if assigned(infile) then
+                        begin
+                          list.insertbefore(Tai_stab.Create_str(stabx_bi,'"'+FixFileName(infile.name^)+'"'),inclinsertpos);
+                          curincludefileinfo:=currfileinfo;
+                          { force new line info }
+                          lastfileinfo.line:=-1;
+                        end;
+                    end
+                  else
+                    lastfileinfo.line:=-1;
+                  if nextlineisfunstart then
+                    begin
+                      curfunstartfileinfo:=currfileinfo;
+                      { insert here rather than via procdef, because the procdef
+                        may have been created in another file in case the body
+                        is completely declared in an include file }
+                      list.insertbefore(Tai_stab.Create_str(stabx_bf,tostr(currfileinfo.line)),hp);
+                      { -1 to avoid outputting a relative line 0 in the
+                        function, because that means something different }
+                      dec(curfunstartfileinfo.line);
+                      nextlineisfunstart:=false;
+                    end;
+
+                end;
+
+              if nolineinfolevel=0 then
+                begin
+                  { line changed ? }
+                  if (currfileinfo.line>lastfileinfo.line) and
+                     (currfileinfo.line<>0) then
+                    begin
+                      linenr:=currfileinfo.line;
+                      { line numbers in AIX are relative to the function start line
+                        (except if they are in a different file then where the
+                         function started!) }
+                      if (currfileinfo.fileindex=curfunstartfileinfo.fileindex) and
+                         (currfileinfo.moduleindex=curfunstartfileinfo.moduleindex) then
+                        dec(linenr,curfunstartfileinfo.line);
+                      { can be < 0 in case of bugs in the compiler }
+                      if (linenr > 0)
+{$ifndef cpu64bitaddr}
+                         { line numbers are unsigned short in 32 bit xcoff }
+                         and (linenr<=high(word))
+{$endif}
+                        then
+                         list.insertbefore(Tai_stab.Create_str(stabx_line,tostr(linenr)),hp);
+                    end;
+                  lastfileinfo:=currfileinfo;
+                end;
+            end;
+
+          last:=hp;
+          hp:=tai(hp.next);
+        end;
+      { close include file if still open }
+      if curincludefileinfo.fileindex<>0 then
+        begin
+          infile:=get_module(curincludefileinfo.moduleindex).sourcefiles.get_file(curincludefileinfo.fileindex);
+          list.insertbefore(Tai_stab.Create_str(stabx_ei,'"'+FixFileName(infile.name^)+'"'),last);
+          curincludefileinfo.fileindex:=0;
+        end;
+    end;
+
+
+  procedure TDebugInfoStabx.insertmoduleinfo;
+    begin
+      // do nothing
+    end;
+
+
+  procedure TDebugInfoStabx.referencesections(list: TAsmList);
+    begin
+      // do nothing
+    end;
+
+
+  constructor TDebugInfoStabx.create;
+    begin
+      inherited create;
+      dbgtype:=dbg_stabx;
+      stabsdir:=stab_stabx;
+
+      def_stab:=STABX_N_DECL;
+      regvar_stab:=STABX_N_RPSYM;
+      procdef_stab:=STABX_N_Function;
+      constsym_stab:=STABX_N_GSYM;
+      typesym_stab:=STABX_N_DECL;
+      globalvarsym_uninited_stab:=STABX_N_STSYM;
+      globalvarsym_inited_stab:=STABX_N_STSYM;
+      staticvarsym_uninited_stab:=STABX_N_STSYM;
+      staticvarsym_inited_stab:=STABX_N_STSYM;
+      localvarsymref_stab:=STABX_N_LSYM;
+      paravarsymref_stab:=STABX_N_PSYM;
+
+      tagtypeprefix:='T';
+    end;
+
+  const
+    dbg_stabx_info : tdbginfo =
+       (
+         id     : dbg_stabx;
+         idtxt  : 'STABX';
+       );
+
+initialization
+  RegisterDebugInfo(dbg_stabx_info,TDebugInfoStabx);
+end.

compiler/defcmp.pas

@@ -43,12 +43,22 @@ interface
           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)
+          cpo_ignoreframepointer,     // ignore frame pointer parameter (for assignment-compatibility of global procedures to nested procvars)
+          cpo_compilerproc,
+          cpo_rtlproc
        );
 
        tcompare_paras_options = set of tcompare_paras_option;
 
-       tcompare_defs_option = (cdo_internal,cdo_explicit,cdo_check_operator,cdo_allow_variant,cdo_parameter,cdo_warn_incompatible_univ);
+       tcompare_defs_option = (
+          cdo_internal,
+          cdo_explicit,
+          cdo_check_operator,
+          cdo_allow_variant,
+          cdo_parameter,
+          cdo_warn_incompatible_univ,
+          cdo_strict_undefined_check  // undefined defs are incompatible to everything except other undefined defs
+       );
        tcompare_defs_options = set of tcompare_defs_option;
 
        tconverttype = (tc_none,
@@ -215,14 +225,38 @@ implementation
             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_exact;
-            exit;
-          end;
+         if cdo_strict_undefined_check in cdoptions then
+           begin
+             { undefined defs are considered equal if both are undefined defs }
+             if (def_from.typ=undefineddef) and
+                (def_to.typ=undefineddef) then
+              begin
+                doconv:=tc_equal;
+                compare_defs_ext:=te_exact;
+                exit;
+              end;
+
+             { if only one def is a undefined def then they are not considered as
+               equal}
+             if (def_from.typ=undefineddef) or
+                (def_to.typ=undefineddef) then
+              begin
+                doconv:=tc_not_possible;
+                compare_defs_ext:=te_incompatible;
+                exit;
+              end;
+           end
+         else
+           begin
+             { undefined defs are considered equal }
+             if (def_from.typ=undefineddef) or
+                (def_to.typ=undefineddef) then
+              begin
+                doconv:=tc_equal;
+                compare_defs_ext:=te_exact;
+                exit;
+              end;
+           end;
 
          { we walk the wanted (def_to) types and check then the def_from
            types if there is a conversion possible }
@@ -340,27 +374,68 @@ implementation
                      { Constant string }
                      if (fromtreetype=stringconstn) then
                       begin
-                        if (tstringdef(def_from).stringtype=tstringdef(def_to).stringtype) then
+                        if (tstringdef(def_from).stringtype=tstringdef(def_to).stringtype) and
+                           ((tstringdef(def_from).stringtype<>st_ansistring) or
+                            (tstringdef(def_from).encoding=tstringdef(def_to).encoding)
+                           ) then
                           eq:=te_equal
                         else
                          begin
                            doconv:=tc_string_2_string;
-                           { Don't prefer conversions from widestring to a
-                             normal string as we can lose information }
-                           if (tstringdef(def_from).stringtype in [st_widestring,st_unicodestring]) and
-                             not (tstringdef(def_to).stringtype in [st_widestring,st_unicodestring]) then
-                             eq:=te_convert_l3
-                           else if tstringdef(def_to).stringtype in [st_widestring,st_unicodestring] then
-                             eq:=te_convert_l2
+                           if (tstringdef(def_from).stringtype = st_ansistring) and
+                              (tstringdef(def_to).stringtype = st_ansistring) then
+                             if (tstringdef(def_to).encoding=globals.CP_UTF8) then
+                               eq:=te_convert_l1
+                             else
+                               eq:=te_convert_l2
                            else
-                             eq:=te_equal;
+                            begin
+                              { Don't prefer conversions from widestring to a
+                                normal string as we can lose information }
+                              if (tstringdef(def_from).stringtype in [st_widestring,st_unicodestring]) and
+                                not (tstringdef(def_to).stringtype in [st_widestring,st_unicodestring]) then
+                                eq:=te_convert_l3
+                              else if tstringdef(def_to).stringtype in [st_widestring,st_unicodestring] then
+                                eq:=te_convert_l2
+                              else
+                                eq:=te_convert_l1;
+                            end;
                          end;
                       end
+                     else if (tstringdef(def_to).stringtype=st_ansistring) and
+                             (tstringdef(def_from).stringtype=st_ansistring) then 
+                      begin
+                        { don't convert ansistrings if any condition is true:
+                          1) same encoding
+                          2) from explicit codepage ansistring to ansistring and vice versa
+                          3) from any ansistring to rawbytestring 
+                          4) from rawbytestring to any ansistring }
+                        if (tstringdef(def_from).encoding=tstringdef(def_to).encoding) or
+                           ((tstringdef(def_to).encoding=0) and (tstringdef(def_from).encoding=getansistringcodepage)) or
+                           ((tstringdef(def_to).encoding=getansistringcodepage) and (tstringdef(def_from).encoding=0)) or
+                           (tstringdef(def_to).encoding=globals.CP_NONE) or
+                           (tstringdef(def_from).encoding=globals.CP_NONE) then
+                         begin
+                           eq:=te_equal;
+                         end
+                        else
+                         begin        
+                           doconv := tc_string_2_string;
+                           if (tstringdef(def_to).encoding=globals.CP_UTF8) then 
+                             eq:=te_convert_l1
+                           else
+                             eq:=te_convert_l2;
+                         end 
+                      end          
                      else
-                     { Same string type, for shortstrings also the length must match }
+                     { same string type ? }
                       if (tstringdef(def_from).stringtype=tstringdef(def_to).stringtype) and
+                        { for shortstrings also the length must match }
                          ((tstringdef(def_from).stringtype<>st_shortstring) or
-                          (tstringdef(def_from).len=tstringdef(def_to).len)) then
+                          (tstringdef(def_from).len=tstringdef(def_to).len)) and
+                         { for ansi- and unicodestrings also the encoding must match }
+                         (not(tstringdef(def_from).stringtype in [st_ansistring,st_unicodestring]) or
+                          (tstringdef(def_from).encoding=tstringdef(def_to).encoding)) then
                         eq:=te_equal
                      else
                        begin
@@ -413,11 +488,30 @@ implementation
                  orddef :
                    begin
                    { char to string}
-                     if is_char(def_from) or
-                        is_widechar(def_from) then
+                     if is_char(def_from) then
+                       begin
+                         doconv:=tc_char_2_string;
+                         case tstringdef(def_to).stringtype of
+                           st_shortstring: eq:=te_convert_l1;
+                           st_ansistring: eq:=te_convert_l2;
+                           st_unicodestring: eq:=te_convert_l3;
+                           st_widestring: eq:=te_convert_l4;
+                         else
+                           eq:=te_convert_l5;
+                         end;
+                       end
+                     else
+                     if is_widechar(def_from) then
                       begin
                         doconv:=tc_char_2_string;
-                        eq:=te_convert_l1;
+                        case tstringdef(def_to).stringtype of
+                          st_unicodestring: eq:=te_convert_l1;
+                          st_widestring: eq:=te_convert_l2;
+                          st_ansistring: eq:=te_convert_l3;
+                          st_shortstring: eq:=te_convert_l4;
+                        else
+                          eq:=te_convert_l5;
+                        end;
                       end;
                    end;
                  arraydef :
@@ -1712,7 +1806,7 @@ implementation
         i1,i2     : byte;
       begin
          compare_paras:=te_incompatible;
-         cdoptions:=[cdo_parameter,cdo_check_operator,cdo_allow_variant];
+         cdoptions:=[cdo_parameter,cdo_check_operator,cdo_allow_variant,cdo_strict_undefined_check];
          { we need to parse the list from left-right so the
            not-default parameters are checked first }
          lowesteq:=high(tequaltype);
@@ -1868,6 +1962,17 @@ implementation
                  if not equal_constsym(tconstsym(currpara1.defaultconstsym),tconstsym(currpara2.defaultconstsym)) then
                    exit;
                end;
+              if not(cpo_compilerproc in cpoptions) and
+                 not(cpo_rtlproc in cpoptions) and
+                 is_ansistring(currpara1.vardef) and
+                 is_ansistring(currpara2.vardef) and
+                 (tstringdef(currpara1.vardef).encoding<>tstringdef(currpara2.vardef).encoding) and
+                 ((tstringdef(currpara1.vardef).encoding=globals.CP_NONE) or
+                  (tstringdef(currpara2.vardef).encoding=globals.CP_NONE)
+                 ) then
+                eq:=te_convert_l1;
+              if eq<lowesteq then
+                lowesteq:=eq;
               inc(i1);
               inc(i2);
               if cpo_ignorehidden in cpoptions then

compiler/defutil.pas

@@ -168,6 +168,9 @@ interface
     {# Returns true if p is an ansi string type }
     function is_ansistring(p : tdef) : boolean;
 
+    {# Returns true if p is an ansi string type with codepage 0 }
+    function is_rawbytestring(p : tdef) : boolean;
+
     {# Returns true if p is a long string type }
     function is_longstring(p : tdef) : boolean;
 
@@ -616,6 +619,14 @@ implementation
                         (tstringdef(p).stringtype=st_ansistring);
       end;
 
+    { true if p is an ansi string def with codepage CP_NONE }
+    function is_rawbytestring(p : tdef) : boolean;
+      begin
+        is_rawbytestring:=(p.typ=stringdef) and
+                       (tstringdef(p).stringtype=st_ansistring) and
+                       (tstringdef(p).encoding=globals.CP_NONE);
+      end;
+
     { true if p is an long string def }
     function is_longstring(p : tdef) : boolean;
       begin
@@ -750,7 +761,7 @@ implementation
     { true, if def is a 64 bit type }
     function is_64bit(def : tdef) : boolean;
       begin
-         is_64bit:=(def.typ=orddef) and (torddef(def).ordtype in [u64bit,s64bit,scurrency])
+         is_64bit:=(def.typ=orddef) and (torddef(def).ordtype in [u64bit,s64bit,scurrency,pasbool64,bool64bit])
       end;
 
 
@@ -773,9 +784,9 @@ implementation
                      not(m_delphi in current_settings.modeswitches)) or
                     (cs_check_range in current_settings.localswitches) or
                     forcerangecheck then
-                   Message(parser_e_range_check_error)
+                   Message3(type_e_range_check_error_bounds,tostr(l),tostr(lv),tostr(hv))
                  else
-                   Message(parser_w_range_check_error);
+                   Message3(type_w_range_check_error_bounds,tostr(l),tostr(lv),tostr(hv));
                end;
              { Fix the value to fit in the allocated space for this type of variable }
              case longint(todef.size) of
@@ -1046,7 +1057,7 @@ implementation
         case p.typ of
           orddef:
             result:=torddef(p).ordtype in [u8bit,s8bit,u16bit,s16bit,u32bit,s32bit,
-              u64bit,s64bit,bool16bit];
+              u64bit,s64bit,bool16bit,scurrency];
           floatdef:
             result:=tfloatdef(p).floattype in [s64currency,s64real,s32real];
           stringdef:

compiler/expunix.pas

@@ -167,7 +167,7 @@ begin
 {$endif x86}
              end
            else
-             cg.a_jmp_name(current_asmdata.asmlists[al_procedures],pd.mangledname);
+             cg.g_external_wrapper(current_asmdata.asmlists[al_procedures],pd,pd.mangledname);
            current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^));
          end;
         exportedsymnames.insert(hp2.name^);

compiler/finput.pas

@@ -656,6 +656,7 @@ uses
            begin
              exefilename:=stringdup(p+OutputFileName);
              sharedlibfilename:=stringdup(p+OutputFileName);
+             n:=ChangeFileExt(OutputFileName,''); { for mapfilename and dbgfilename } 
            end
          else
            begin

compiler/fmodule.pas

@@ -145,6 +145,7 @@ interface
         symlist       : TFPObjectList;
         ptrdefs       : THashSet; { list of pointerdefs created in this module so we can reuse them (not saved/restored) }
         arraydefs     : THashSet; { list of single-element-arraydefs created in this module so we can reuse them (not saved/restored) }
+        ansistrdef    : tobject; { an ansistring def redefined for the current module }
         wpoinfo       : tunitwpoinfobase; { whole program optimization-related information that is generated during the current run for this unit }
         globalsymtable,           { pointer to the global symtable of this unit }
         localsymtable : TSymtable;{ pointer to the local symtable of this unit }
@@ -198,7 +199,7 @@ interface
         points to the module calling it. It is nil for the first compiled
         module. This allow inheritence of all path lists. MUST pay attention
         to that when creating link.res!!!!(mazen)}
-        constructor create(LoadedFrom:TModule;const s:string;_is_unit:boolean);
+        constructor create(LoadedFrom:TModule;const amodulename,afilename:string;_is_unit:boolean);
         destructor destroy;override;
         procedure reset;virtual;
         procedure adddependency(callermodule:tmodule);
@@ -478,24 +479,31 @@ implementation
                                   TMODULE
  ****************************************************************************}
 
-    constructor tmodule.create(LoadedFrom:TModule;const s:string;_is_unit:boolean);
+    constructor tmodule.create(LoadedFrom:TModule;const amodulename,afilename:string;_is_unit:boolean);
       var
-        n : string;
+        n,fn:string;
       begin
-        n:=ChangeFileExt(ExtractFileName(s),'');
+        if amodulename='' then
+          n:=ChangeFileExt(ExtractFileName(afilename),'')
+        else
+          n:=amodulename;
+        if afilename='' then
+          fn:=amodulename
+        else
+          fn:=afilename;
         { Programs have the name 'Program' to don't conflict with dup id's }
         if _is_unit then
-         inherited create(n)
+         inherited create(amodulename)
         else
          inherited create('Program');
-        mainsource:=stringdup(s);
+        mainsource:=stringdup(fn);
         { Dos has the famous 8.3 limit :( }
 {$ifdef shortasmprefix}
         asmprefix:=stringdup(FixFileName('as'));
 {$else}
         asmprefix:=stringdup(FixFileName(n));
 {$endif}
-        setfilename(s,true);
+        setfilename(fn,true);
         localunitsearchpath:=TSearchPathList.Create;
         localobjectsearchpath:=TSearchPathList.Create;
         localincludesearchpath:=TSearchPathList.Create;
@@ -529,6 +537,7 @@ implementation
         symlist:=TFPObjectList.Create(false);
         ptrdefs:=THashSet.Create(64,true,false);
         arraydefs:=THashSet.Create(64,true,false);
+        ansistrdef:=nil;
         wpoinfo:=nil;
         checkforwarddefs:=TFPObjectList.Create(false);
         extendeddefs := TFPHashObjectList.Create(true);
@@ -558,13 +567,14 @@ implementation
         _exports:=TLinkedList.Create;
         dllscannerinputlist:=TFPHashList.Create;
         asmdata:=TAsmData.create(realmodulename^);
-        InitDebugInfo(self);
+        InitDebugInfo(self,false);
       end;
 
 
     destructor tmodule.Destroy;
       var
         i : longint;
+        current_debuginfo_reset : boolean;
       begin
         if assigned(unitmap) then
           freemem(unitmap);
@@ -604,7 +614,7 @@ implementation
             { release procinfo tree }
             tprocinfo(procinfo).destroy_tree;
           end;
-        DoneDebugInfo(self);
+        DoneDebugInfo(self,current_debuginfo_reset);
         used_units.free;
         dependent_units.free;
         resourcefiles.Free;
@@ -646,6 +656,7 @@ implementation
         symlist.free;
         ptrdefs.free;
         arraydefs.free;
+        ansistrdef:=nil;
         wpoinfo.free;
         checkforwarddefs.free;
         globalsymtable.free;
@@ -663,6 +674,7 @@ implementation
     procedure tmodule.reset;
       var
         i   : longint;
+        current_debuginfo_reset : boolean;
       begin
         if assigned(scanner) then
           begin
@@ -692,7 +704,7 @@ implementation
             asmdata.free;
             asmdata:=nil;
           end;
-        DoneDebugInfo(self);
+        DoneDebugInfo(self,current_debuginfo_reset);
         globalsymtable.free;
         globalsymtable:=nil;
         localsymtable.free;
@@ -734,7 +746,7 @@ implementation
         sourcefiles.free;
         sourcefiles:=tinputfilemanager.create;
         asmdata:=TAsmData.create(realmodulename^);
-        InitDebugInfo(self);
+        InitDebugInfo(self,current_debuginfo_reset);
         _exports.free;
         _exports:=tlinkedlist.create;
         dllscannerinputlist.free;

compiler/fpcdefs.inc

@@ -59,6 +59,7 @@
   {$define SUPPORT_MMX}
   {$define cpumm}
   {$define fewintregisters}
+  {$define cpurox}
 {$endif i386}
 
 {$ifdef x86_64}
@@ -70,11 +71,22 @@
   {$define cpufloat128}
   {$define cputargethasfixedstack}
   {$define cpumm}
+  {$define cpurox}
+  {$define cpurefshaveindexreg}
 {$endif x86_64}
 
+{$ifdef ia64}
+  {$define cpuflags}
+  {$define cpu64bitalu}
+  {$define cpu64bitaddr}
+  {$define cpuextended}
+  {$define cpufloat128}
+{$endif ia64}
+
 {$ifdef alpha}
   {$define cpu64bitalu}
   {$define cpu64bitaddr}
+  {$define cpurefshaveindexreg}
 {$endif alpha}
 
 {$ifdef sparc}
@@ -83,6 +95,7 @@
   {$define cpu32bitalu}
   {$define cpuflags}
   {$define cputargethasfixedstack}
+  {$define cpurefshaveindexreg}
 {$endif sparc}
 
 {$ifdef powerpc}
@@ -92,6 +105,8 @@
   {$define cpuflags}
   {$define cputargethasfixedstack}
   {$define cpumm}
+  {$define cpurox}
+  {$define cpurefshaveindexreg}
 {$endif powerpc}
 
 {$ifdef powerpc64}
@@ -100,6 +115,8 @@
   {$define cpuflags}
   {$define cputargethasfixedstack}
   {$define cpumm}
+  {$define cpurox}
+  {$define cpurefshaveindexreg}
 {$endif powerpc64}
 
 {$ifdef arm}
@@ -109,15 +126,25 @@
   {$define cpuflags}
   {$define cpufpemu}
   {$define cpuneedsdiv32helper}
+  {$define cpurox}
   {$define cputargethasfixedstack}
+  {$define cpurefshaveindexreg}
+  { default to armel }
+  {$if not(defined(CPUARM)) and not(defined(CPUARMEB)) and not(defined(FPC_OARM)) and not(defined(FPC_ARMEB)) and not(defined(FPC_ARMHF))}
+    {$define FPC_ARMEL}
+  {$endif}
   { inherit FPC_ARMEL? }
-  {$if defined(CPUARMEL) and not(defined(FPC_OARM)) and not(defined(FPC_ARMEB))}
+  {$if defined(CPUARMEL) and not(defined(FPC_OARM)) and not(defined(FPC_ARMEB)) and not(defined(FPC_ARMHF))}
     {$define FPC_ARMEL}
   {$endif}
   { inherit FPC_ARMEB? }
-  {$if defined(CPUARMEB) and not(defined(FPC_OARM)) and not(defined(FPC_ARMEL))}
+  {$if defined(CPUARMEB) and not(defined(FPC_OARM)) and not(defined(FPC_ARMEL)) and not(defined(FPC_ARMHF))}
     {$define FPC_ARMEB}
   {$endif}
+  { inherit FPC_ARMHF? }
+  {$if defined(CPUARMHF) and not(defined(FPC_OARM)) and not(defined(FPC_ARMEL)) and not(defined(FPC_ARMEB))}
+    {$define FPC_ARMHF}
+  {$endif}
 {$endif arm}
 
 {$ifdef m68k}
@@ -126,6 +153,7 @@
   {$define cpu32bitalu}
   {$define cpuflags}
   {$define cpufpemu}
+  {$define cpurefshaveindexreg}
 {$endif m68k}
 
 {$ifdef avr}
@@ -137,6 +165,7 @@
   {$define cpunodefaultint}
   {$define cpuneedsdiv32helper}
   {$define cpuneedsmulhelper}
+  {$define cpurefshaveindexreg}
 {$endif avr}
 
 {$ifdef mipsel}
@@ -144,12 +173,14 @@
 {$endif mipsel}
 
 {$ifdef mips}
+  {$define cpu32bit}
   {$define cpu32bitalu}
   {$define cpu32bitaddr}
   { $define cpuflags}
   {$define cputargethasfixedstack}
   {$define cpurequiresproperalignment}
-  {$define cpumm}
+  { define cpumm}
+  {$define cpurefshaveindexreg}
 {$endif mips}
 
 {$ifdef jvm}

compiler/fppu.pas

@@ -54,7 +54,7 @@ interface
           crc_array2 : pointer;
           crc_size2  : longint;
 {$endif def Test_Double_checksum}
-          constructor create(LoadedFrom:TModule;const s:string;const fn:string;_is_unit:boolean);
+          constructor create(LoadedFrom:TModule;const amodulename,afilename:string;_is_unit:boolean);
           destructor destroy;override;
           procedure reset;override;
           function  openppu:boolean;
@@ -125,11 +125,11 @@ var
                                 TPPUMODULE
  ****************************************************************************}
 
-    constructor tppumodule.create(LoadedFrom:TModule;const s:string;const fn:string;_is_unit:boolean);
+    constructor tppumodule.create(LoadedFrom:TModule;const amodulename,afilename:string;_is_unit:boolean);
       begin
-        inherited create(LoadedFrom,s,_is_unit);
+        inherited create(LoadedFrom,amodulename,afilename,_is_unit);
         ppufile:=nil;
-        sourcefn:=stringdup(fn);
+        sourcefn:=stringdup(afilename);
       end;
 
 
@@ -1501,6 +1501,7 @@ var
         do_load,
         second_time        : boolean;
         old_current_module : tmodule;
+        pu : tused_unit;
       begin
         old_current_module:=current_module;
         Message3(unit_u_load_unit,old_current_module.modulename^,
@@ -1637,7 +1638,19 @@ var
                   begin
                     printcomments;
                     if recompile_reason=rr_noppu then
-                      Message2(unit_f_cant_find_ppu,realmodulename^,loaded_from.realmodulename^)
+                      begin
+                        pu:=tused_unit(loaded_from.used_units.first);
+                        while assigned(pu) do
+                          begin
+                            if pu.u=self then
+                              break;
+                            pu:=tused_unit(pu.next);
+                          end;
+                        if assigned(pu) and assigned(pu.unitsym) then
+                          MessagePos2(pu.unitsym.fileinfo,unit_f_cant_find_ppu,realmodulename^,loaded_from.realmodulename^)
+                        else
+                          Message2(unit_f_cant_find_ppu,realmodulename^,loaded_from.realmodulename^);
+                      end
                     else
                       Message1(unit_f_cant_compile_unit,realmodulename^);
                   end;

compiler/gendef.pas

@@ -106,9 +106,9 @@ begin
     Exit;
 { open file }
   assign(t,fname);
-  {$I+}
+  {$push}{$I-}
    rewrite(t);
-  {$I-}
+  {$pop}
   if ioresult<>0 then
    exit;
   case target_info.system of

compiler/globals.pas

@@ -53,6 +53,7 @@ interface
           m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal,m_default_ansistring,
           m_out,m_default_para,m_duplicate_names,m_hintdirective,
           m_property,m_default_inline,m_except,m_advanced_records];
+       delphiunicodemodeswitches = delphimodeswitches + [m_systemcodepage];
        fpcmodeswitches =
          [m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward,
           m_cvar_support,m_initfinal,m_hintdirective,
@@ -102,10 +103,12 @@ interface
        MathPiExtended : textendedrec = (bytes : (64,0,201,15,218,162,33,104,194,53));
 {$endif FPC_LITTLE_ENDIAN}
 {$endif}
+       CP_UTF8 = 65001;
+       CP_UTF16 = 1200;
+       CP_NONE  = 65535;
 
-    type
-       tcodepagestring = string[20];
 
+    type
        { this is written to ppus during token recording for generics so it must be packed }
        tsettings = packed record
          alignment       : talignmentinfo;
@@ -122,7 +125,6 @@ interface
          debugswitches   : tdebugswitches;
          { 0: old behaviour for sets <=256 elements
            >0: round to this size }
-         pmessage : pmessagestaterecord;
          setalloc,
          packenum        : shortint;
 
@@ -135,7 +137,7 @@ interface
          asmmode         : tasmmode;
          interfacetype   : tinterfacetypes;
          defproccall     : tproccalloption;
-         sourcecodepage  : tcodepagestring;
+         sourcecodepage  : tstringencoding;
 
          minfpconstprec  : tfloattype;
 
@@ -145,6 +147,8 @@ interface
 {$if defined(ARM) or defined(AVR)}
         controllertype   : tcontrollertype;
 {$endif defined(ARM) or defined(AVR)}
+         { WARNING: this pointer cannot be written as such in record token }
+         pmessage : pmessagestaterecord;
        end;
 
     const
@@ -263,6 +267,8 @@ interface
        GenerateImportSection,
        GenerateImportSectionSetExplicitly,
        RelocSection : boolean;
+       MacOSXVersionMin,
+       iPhoneOSVersionMin: string[15];
        RelocSectionSetExplicitly : boolean;
        LinkTypeSetExplicitly : boolean;
 
@@ -363,7 +369,6 @@ interface
         genwpoptimizerswitches : [];
         dowpoptimizerswitches : [];
         debugswitches : [];
-        pmessage : nil;
 
         setalloc : 0;
         packenum : 4;
@@ -414,6 +419,11 @@ interface
         optimizecputype : cpu_athlon64;
         fputype : fpu_sse64;
   {$endif x86_64}
+  {$ifdef ia64}
+        cputype : cpu_itanium;
+        optimizecputype : cpu_itanium;
+        fputype : fpu_itanium;
+  {$endif ia64}
   {$ifdef avr}
         cputype : cpuinfo.cpu_avr5;
         optimizecputype : cpuinfo.cpu_avr5;
@@ -437,13 +447,14 @@ interface
         interfacetype : it_interfacejava;
 {$endif jvm}
         defproccall : pocall_default;
-        sourcecodepage : '8859-1';
+        sourcecodepage : 28591;
         minfpconstprec : s32real;
 
         disabledircache : false;
 {$if defined(ARM) or defined(AVR)}
         controllertype : ct_none;
 {$endif defined(ARM) or defined(AVR)}
+        pmessage : nil;
       );
 
     var
@@ -1120,7 +1131,7 @@ implementation
         result:=false;
         hs:=Upper(s);
         for t:=low(tcontrollertype) to high(tcontrollertype) do
-          if controllertypestr[t]=hs then
+          if embedded_controllers[t].controllertypestr=hs then
             begin
               a:=t;
               result:=true;
@@ -1572,6 +1583,8 @@ implementation
         RelocSection:=false;
         RelocSectionSetExplicitly:=false;
         LinkTypeSetExplicitly:=false;
+        MacOSXVersionMin:='';
+        iPhoneOSVersionMin:='';
         { memory sizes, will be overridden by parameter or default for target
           in options or init_parser }
         stacksize:=0;

compiler/globtype.pas

@@ -127,6 +127,7 @@ interface
          cs_generate_stackframes,cs_do_assertion,cs_generate_rtti,
          cs_full_boolean_eval,cs_typed_const_writable,cs_allow_enum_calc,
          cs_do_inline,cs_fpu_fwait,cs_ieee_errors,
+         cs_check_low_addr_load,
          { mmx }
          cs_mmx,cs_mmx_saturation,
          { parser }
@@ -148,7 +149,7 @@ interface
          cs_support_c_operators,
          { generation }
          cs_profile,cs_debuginfo,cs_compilesystem,
-         cs_lineinfo,cs_implicit_exceptions,
+         cs_lineinfo,cs_implicit_exceptions,cs_explicit_codepage,
          { linking }
          cs_create_smart,cs_create_dynamic,cs_create_pic,
          { browser switches are back }
@@ -231,7 +232,7 @@ interface
          cs_opt_level1,cs_opt_level2,cs_opt_level3,
          cs_opt_regvar,cs_opt_uncertain,cs_opt_size,cs_opt_stackframe,
          cs_opt_peephole,cs_opt_asmcse,cs_opt_loopunroll,cs_opt_tailrecursion,cs_opt_nodecse,
-         cs_opt_nodedfa,cs_opt_loopstrength
+         cs_opt_nodedfa,cs_opt_loopstrength,cs_opt_scheduler
        );
        toptimizerswitches = set of toptimizerswitch;
 
@@ -242,12 +243,20 @@ interface
        );
        twpoptimizerswitches = set of twpoptimizerswitch;
 
+    type
+       { Used by ARM / AVR to differentiate between specific microcontrollers }
+       tcontrollerdatatype = record
+          controllertypestr, controllerunitstr: string[20];
+          interruptvectors:integer;
+          flashbase, flashsize, srambase, sramsize, eeprombase, eepromsize: dword;
+       end;
 
     const
        OptimizerSwitchStr : array[toptimizerswitch] of string[10] = ('',
          'LEVEL1','LEVEL2','LEVEL3',
          'REGVAR','UNCERTAIN','SIZE','STACKFRAME',
-         'PEEPHOLE','ASMCSE','LOOPUNROLL','TAILREC','CSE','DFA','STRENGTH'
+         'PEEPHOLE','ASMCSE','LOOPUNROLL','TAILREC','CSE',
+         'DFA','STRENGTH','SCHEDULE'
        );
        WPOptimizerSwitchStr : array [twpoptimizerswitch] of string[14] = (
          'DEVIRTCALLS','OPTVMTS','SYMBOLLIVENESS'
@@ -310,12 +319,12 @@ interface
          m_non_local_goto,      { support non local gotos (like iso pascal) }
          m_advanced_records,    { advanced record syntax with visibility sections, methods and properties }
          m_isolike_unary_minus, { unary minus like in iso pascal: same precedence level as binary minus/plus }
+         m_systemcodepage,      { use system codepage as compiler codepage by default, emit ansistrings with system codepage }
          m_final_fields,        { allows declaring fields as "final", which means they must be initialised
                                   in the (class) constructor and are constant from then on (same as final
                                   fields in Java) }
-         m_default_unicodestring { makes the default string type in {$h+} mode unicodestring rather than
+         m_default_unicodestring { makes the default string type in $h+ mode unicodestring rather than
                                    ansistring; similarly, char becomes unicodechar rather than ansichar }
-
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -468,6 +477,7 @@ interface
          'NONLOCALGOTO',
          'ADVANCEDRECORDS',
          'ISOUNARYMINUS',
+         'SYSTEMCODEPAGE',
          'FINALFIELDS',
          'UNICODESTRINGS');
 
@@ -506,7 +516,9 @@ interface
          { dfa was generated for this proc }
          pi_dfaavailable,
          { subroutine contains interprocedural used labels }
-         pi_has_interproclabel
+         pi_has_interproclabel,
+         { subroutine has unwind info (win64) }
+         pi_has_unwind_info
        );
        tprocinfoflags=set of tprocinfoflag;
 
@@ -523,26 +535,26 @@ interface
       TRADirection = (rad_forward, rad_backwards, rad_backwards_reinit);
 
     type
-       TIDString = string[maxidlen];
-
-       tnormalset = set of byte; { 256 elements set }
-       pnormalset = ^tnormalset;
-
-       pboolean   = ^boolean;
-       pdouble    = ^double;
-       pbyte      = ^byte;
-       pword      = ^word;
-       plongint   = ^longint;
-       plongintarray = plongint;
-
-       pfileposinfo = ^tfileposinfo;
-       tfileposinfo = record
-         { if types of column or fileindex are changed, modify tcompilerppufile.putposinfo }
-         line      : longint;
-         column    : word;
-         fileindex : word;
-         moduleindex : word;
-       end;
+      TIDString = string[maxidlen];
+
+      tnormalset = set of byte; { 256 elements set }
+      pnormalset = ^tnormalset;
+
+      pboolean   = ^boolean;
+      pdouble    = ^double;
+      pbyte      = ^byte;
+      pword      = ^word;
+      plongint   = ^longint;
+      plongintarray = plongint;
+
+      pfileposinfo = ^tfileposinfo;
+      tfileposinfo = record
+        { if types of column or fileindex are changed, modify tcompilerppufile.putposinfo }
+        line      : longint;
+        column    : word;
+        fileindex : word;
+        moduleindex : word;
+      end;
 
   {$ifndef xFPC}
     type
@@ -555,6 +567,9 @@ interface
       end;
   {$endif}
 
+       tstringencoding = Word;
+       tcodepagestring = string[20];
+
     const
        { link options }
        link_none    = $0;

compiler/hlcg2ll.pas

@@ -332,7 +332,6 @@ unit hlcg2ll;
           procedure g_copyvariant(list : TAsmList;const source,dest : treference;vardef:tvariantdef);override;
 
           procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);override;
-          procedure g_decrrefcount(list : TAsmList;t: tdef; const ref: treference);override;
           procedure g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation;
             const name: string);override;
           procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);override;
@@ -381,13 +380,17 @@ unit hlcg2ll;
           procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
           procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: aint);override;
 
-          function g_indirect_sym_load(list:TAsmList;const symname: string; weak: boolean): tregister;override;
+          function g_indirect_sym_load(list:TAsmList;const symname: string; const flags: tindsymflags): tregister;override;
           { generate a stub which only purpose is to pass control the given external method,
           setting up any additional environment before doing so (if required).
 
           The default implementation issues a jump instruction to the external name. }
 //          procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); override;
 
+          { Generate code to exit an unwind-protected region. The default implementation
+            produces a simple jump to destination label. }
+          procedure g_local_unwind(list: TAsmList; l: TAsmLabel);override;
+
           procedure location_force_reg(list:TAsmList;var l:tlocation;src_size,dst_size:tdef;maybeconst:boolean);override;
           procedure location_force_fpureg(list:TAsmList;var l: tlocation;size: tdef;maybeconst:boolean);override;
           procedure location_force_mem(list:TAsmList;var l:tlocation;size:tdef);override;
@@ -1091,11 +1094,6 @@ procedure thlcg2ll.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; co
       cg.g_incrrefcount(list,t,ref);
     end;
 
-  procedure thlcg2ll.g_decrrefcount(list: TAsmList; t: tdef; const ref: treference);
-    begin
-      cg.g_decrrefcount(list,t,ref);
-    end;
-
   procedure thlcg2ll.g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation; const name: string);
     begin
       cg.g_array_rtti_helper(list, t, ref, highloc, name);
@@ -1166,9 +1164,14 @@ procedure thlcg2ll.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; co
       cg.g_adjust_self_value(list,procdef,ioffset);
     end;
 
-  function thlcg2ll.g_indirect_sym_load(list: TAsmList; const symname: string; weak: boolean): tregister;
+  function thlcg2ll.g_indirect_sym_load(list: TAsmList; const symname: string; const flags: tindsymflags): tregister;
+    begin
+      result:=cg.g_indirect_sym_load(list,symname,flags);
+    end;
+
+  procedure thlcg2ll.g_local_unwind(list: TAsmList; l: TAsmLabel);
     begin
-      result:=cg.g_indirect_sym_load(list,symname,weak);
+      cg.g_local_unwind(list, l);
     end;
 
   procedure thlcg2ll.location_force_reg(list: TAsmList; var l: tlocation; src_size, dst_size: tdef; maybeconst: boolean);

compiler/hlcgobj.pas

@@ -364,7 +364,6 @@ unit hlcgobj;
           procedure g_copyvariant(list : TAsmList;const source,dest : treference;vardef:tvariantdef);virtual;abstract;
 
           procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);virtual;abstract;
-          procedure g_decrrefcount(list : TAsmList;t: tdef; const ref: treference);virtual;abstract;
           procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);virtual;abstract;
           procedure g_finalize(list : TAsmList;t : tdef;const ref : treference);virtual;abstract;
           procedure g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation;
@@ -413,7 +412,7 @@ unit hlcgobj;
           procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);virtual; abstract;
           procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: aint);virtual; abstract;
 
-          function g_indirect_sym_load(list:TAsmList;const symname: string; weak: boolean): tregister;virtual; abstract;
+          function g_indirect_sym_load(list:TAsmList;const symname: string; const flags: tindsymflags): tregister;virtual; abstract;
           { generate a stub which only purpose is to pass control the given external method,
           setting up any additional environment before doing so (if required).
 
@@ -421,7 +420,7 @@ unit hlcgobj;
 //          procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); virtual;
 
          protected
-            procedure g_allocload_reg_reg(list: TAsmList; regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
+          procedure g_allocload_reg_reg(list: TAsmList; regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
          public
           { create "safe copy" of a tlocation that can be used later: all
             registers used in the tlocation are copied to new ones, so that
@@ -501,6 +500,10 @@ unit hlcgobj;
 
           { generate a call to a routine in the system unit }
           procedure g_call_system_proc(list: TAsmList; const procname: string);
+
+          { Generate code to exit an unwind-protected region. The default implementation
+            produces a simple jump to destination label. }
+          procedure g_local_unwind(list: TAsmList; l: TAsmLabel);virtual;abstract;
        end;
 
     var
@@ -1668,7 +1671,11 @@ implementation
 
   procedure thlcgobj.g_rangecheck(list: TAsmList; const l: tlocation; fromdef, todef: tdef);
     var
+{$if defined(cpu64bitalu) or defined(cpu32bitalu)}
       aintmax: aint;
+{$else}
+      aintmax: longint;
+{$endif}
       neglabel : tasmlabel;
       hreg : tregister;
       lto,hto,
@@ -1877,6 +1884,19 @@ implementation
 
   procedure thlcgobj.g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation);
 
+    procedure handle_reg_move(regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
+      begin
+        case regtyp of
+          R_INTREGISTER:
+            toreg:=getintregister(list,regsize);
+          R_ADDRESSREGISTER:
+            toreg:=getaddressregister(list,regsize);
+          R_FPUREGISTER:
+            toreg:=getfpuregister(list,regsize);
+        end;
+        a_load_reg_reg(list,regsize,regsize,fromreg,toreg);
+      end;
+
     begin
       toloc:=fromloc;
       case fromloc.loc of
@@ -1888,9 +1908,9 @@ implementation
           { finished }
           ;
         LOC_CREGISTER:
-          g_allocload_reg_reg(list,def,fromloc.reference.index,toloc.reference.index,R_INTREGISTER);
+          handle_reg_move(def,fromloc.reference.index,toloc.reference.index,R_INTREGISTER);
         LOC_CFPUREGISTER:
-          g_allocload_reg_reg(list,def,fromloc.reference.index,toloc.reference.index,R_FPUREGISTER);
+          handle_reg_move(def,fromloc.reference.index,toloc.reference.index,R_FPUREGISTER);
         { although LOC_CREFERENCE cannot be an lvalue, we may want to take a
           reference to such a location for multiple reading }
         LOC_CREFERENCE,
@@ -1899,11 +1919,11 @@ implementation
             if (fromloc.reference.base<>NR_NO) and
                (fromloc.reference.base<>current_procinfo.framepointer) and
                (fromloc.reference.base<>NR_STACK_POINTER_REG) then
-              g_allocload_reg_reg(list,voidpointertype,fromloc.reference.base,toloc.reference.base,getregtype(fromloc.reference.base));
+              handle_reg_move(voidpointertype,fromloc.reference.base,toloc.reference.base,getregtype(fromloc.reference.base));
             if (fromloc.reference.index<>NR_NO) and
                (fromloc.reference.index<>current_procinfo.framepointer) and
                (fromloc.reference.index<>NR_STACK_POINTER_REG) then
-              g_allocload_reg_reg(list,voidpointertype,fromloc.reference.index,toloc.reference.index,getregtype(fromloc.reference.index));
+              handle_reg_move(voidpointertype,fromloc.reference.index,toloc.reference.index,getregtype(fromloc.reference.index));
           end;
         else
           internalerror(2012012701);
@@ -2218,8 +2238,9 @@ implementation
            current_procinfo.procdef.localst.SymList.ForEachCall(@initialize_data,list);
       end;
 
-      { initialisizes temp. ansi/wide string data }
-      inittempvariables(list);
+      { initialises temp. ansi/wide string data }
+      if (current_procinfo.procdef.proctypeoption<>potype_exceptfilter) then
+        inittempvariables(list);
 
 {$ifdef OLDREGVARS}
       load_regvars(list,nil);
@@ -2227,7 +2248,17 @@ implementation
     end;
 
   procedure thlcgobj.gen_finalize_code(list: TAsmList);
+    var
+      old_current_procinfo: tprocinfo;
     begin
+      old_current_procinfo:=current_procinfo;
+      if (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
+        begin
+          if (current_procinfo.parent.finalize_procinfo<>current_procinfo) then
+            exit;
+          current_procinfo:=current_procinfo.parent;
+        end;
+
 {$ifdef OLDREGVARS}
       cleanup_regvars(list);
 {$endif OLDREGVARS}
@@ -2257,6 +2288,7 @@ implementation
       if assigned(current_procinfo.procdef.parast) and
          not(po_assembler in current_procinfo.procdef.procoptions) then
         current_procinfo.procdef.parast.SymList.ForEachCall(@final_paras,list);
+      current_procinfo:=old_current_procinfo;
     end;
 
   procedure thlcgobj.gen_entry_code(list: TAsmList);
@@ -2341,6 +2373,7 @@ implementation
          ) and
          not(vo_is_typed_const in tabstractvarsym(p).varoptions) and
          not(vo_is_external in tabstractvarsym(p).varoptions) and
+         not(vo_is_default_var in tabstractvarsym(p).varoptions) and
          (is_managed_type(tabstractvarsym(p).vardef) or
           ((m_iso in current_settings.modeswitches) and (tabstractvarsym(p).vardef.typ=filedef))
          ) then
@@ -2428,7 +2461,7 @@ implementation
       current_asmdata.CurrAsmList:=asmlist;
       hp:=cloadnode.create(sym,sym.owner);
       if (sym.typ=staticvarsym) and (vo_force_finalize in tstaticvarsym(sym).varoptions) then
-        include(hp.flags,nf_isinternal_ignoreconst);
+        include(tloadnode(hp).loadnodeflags,loadnf_isinternal_ignoreconst);
       hp:=cnodeutils.finalize_data_node(hp);
       firstpass(hp);
       secondpass(hp);
@@ -2442,6 +2475,7 @@ implementation
          (tlocalvarsym(p).refs>0) and
          not(vo_is_external in tlocalvarsym(p).varoptions) and
          not(vo_is_funcret in tlocalvarsym(p).varoptions) and
+         not(vo_is_default_var in tabstractvarsym(p).varoptions) and
          is_managed_type(tlocalvarsym(p).vardef) then
         finalize_sym(TAsmList(arg),tsym(p));
     end;
@@ -2506,7 +2540,7 @@ implementation
               begin
                 if paramanager.push_high_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption) then
                   begin
-                    hsym:=tparavarsym(tsym(p).owner.Find('high'+tsym(p).name));
+                    hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
                     if not assigned(hsym) then
                       internalerror(201003032);
                     highloc:=hsym.initialloc
@@ -2514,10 +2548,10 @@ implementation
                 else
                   highloc.loc:=LOC_INVALID;
                 eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
-                g_array_rtti_helper(list,eldef,href,highloc,'FPC_DECREF_ARRAY');
+                g_array_rtti_helper(list,eldef,href,highloc,'FPC_FINALIZE_ARRAY');
               end
             else
-              g_decrrefcount(list,tparavarsym(p).vardef,href);
+              g_finalize(list,tparavarsym(p).vardef,href);
           end;
        end;
       { open arrays can contain elements requiring init/final code, so the else has been removed here }
@@ -2574,7 +2608,7 @@ implementation
                        begin
                          if paramanager.push_high_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption) then
                            begin
-                             hsym:=tparavarsym(tsym(p).owner.Find('high'+tsym(p).name));
+                             hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
                              if not assigned(hsym) then
                                internalerror(201003032);
                              highloc:=hsym.initialloc
@@ -2617,7 +2651,7 @@ implementation
                          begin
                            if paramanager.push_high_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption) then
                              begin
-                               hsym:=tparavarsym(tsym(p).owner.Find('high'+tsym(p).name));
+                               hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
                                if not assigned(hsym) then
                                  internalerror(201003032);
                                highloc:=hsym.initialloc
@@ -2661,7 +2695,10 @@ implementation
       i: longint;
       currpara: tparavarsym;
     begin
-      if (po_assembler in current_procinfo.procdef.procoptions) then
+      if (po_assembler in current_procinfo.procdef.procoptions) or
+      { exceptfilters have a single hidden 'parentfp' parameter, which
+        is handled by tcg.g_proc_entry. }
+         (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
         exit;
 
       { Copy parameters to local references/registers }
@@ -2721,7 +2758,7 @@ implementation
                 begin
                   if paramanager.push_high_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption) then
                     begin
-                      hsym:=tparavarsym(tsym(p).owner.Find('high'+tsym(p).name));
+                      hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
                       if not assigned(hsym) then
                         internalerror(2011020506);
                       highloc:=hsym.initialloc

compiler/htypechk.pas

@@ -173,6 +173,10 @@ interface
 
     procedure check_ranges(const location: tfileposinfo; source: tnode; destdef: tdef);
 
+    { returns whether the def may be used in the Default() intrinsic; static
+      arrays, records and objects are checked recursively }
+    function is_valid_for_default(def:tdef):boolean;
+
 implementation
 
     uses
@@ -992,34 +996,38 @@ implementation
                        begin
                          { Give warning/note for uninitialized locals }
                          if assigned(hsym.owner) and
-                           not(cs_opt_nodedfa in current_settings.optimizerswitches) and
                             not(vo_is_external in hsym.varoptions) and
                             (hsym.owner.symtabletype in [parasymtable,localsymtable,staticsymtable]) and
                             ((hsym.owner=current_procinfo.procdef.localst) or
                              (hsym.owner=current_procinfo.procdef.parast)) then
                            begin
-                             if (vo_is_funcret in hsym.varoptions) then
-                               begin
-                                 if (vsf_use_hints in varstateflags) then
-                                   CGMessagePos(p.fileinfo,sym_h_function_result_uninitialized)
-                                 else
-                                   CGMessagePos(p.fileinfo,sym_w_function_result_uninitialized)
-                               end
-                             else
+                             if vsf_use_hints in varstateflags then
+                               include(tloadnode(p).loadnodeflags,loadnf_only_uninitialized_hint);
+                             if not(cs_opt_nodedfa in current_settings.optimizerswitches) then
                                begin
-                                 if tloadnode(p).symtable.symtabletype=localsymtable then
+                                 if (vo_is_funcret in hsym.varoptions) then
                                    begin
                                      if (vsf_use_hints in varstateflags) then
-                                       CGMessagePos1(p.fileinfo,sym_h_uninitialized_local_variable,hsym.realname)
+                                       CGMessagePos(p.fileinfo,sym_h_function_result_uninitialized)
                                      else
-                                       CGMessagePos1(p.fileinfo,sym_w_uninitialized_local_variable,hsym.realname);
+                                       CGMessagePos(p.fileinfo,sym_w_function_result_uninitialized)
                                    end
                                  else
                                    begin
-                                     if (vsf_use_hints in varstateflags) then
-                                       CGMessagePos1(p.fileinfo,sym_h_uninitialized_variable,hsym.realname)
+                                     if tloadnode(p).symtable.symtabletype=localsymtable then
+                                       begin
+                                         if (vsf_use_hints in varstateflags) then
+                                           CGMessagePos1(p.fileinfo,sym_h_uninitialized_local_variable,hsym.realname)
+                                         else
+                                           CGMessagePos1(p.fileinfo,sym_w_uninitialized_local_variable,hsym.realname);
+                                       end
                                      else
-                                       CGMessagePos1(p.fileinfo,sym_w_uninitialized_variable,hsym.realname);
+                                       begin
+                                         if (vsf_use_hints in varstateflags) then
+                                           CGMessagePos1(p.fileinfo,sym_h_uninitialized_variable,hsym.realname)
+                                         else
+                                           CGMessagePos1(p.fileinfo,sym_w_uninitialized_variable,hsym.realname);
+                                       end;
                                    end;
                                end;
                            end
@@ -1091,7 +1099,8 @@ implementation
             result:=false;
             { allow p^:= constructions with p is const parameter }
             if gotderef or gotdynarray or (Valid_Const in opts) or
-              (nf_isinternal_ignoreconst in hp.flags) then
+              ((hp.nodetype=loadn) and
+               (loadnf_isinternal_ignoreconst in tloadnode(hp).loadnodeflags)) then
               result:=true
             { final (class) fields can only be initialised in the (class) constructors of
               class in which they have been declared (not in descendent constructors) }
@@ -1181,6 +1190,8 @@ implementation
                       (gotderef) or
                       { same when we got a class and subscript (= deref) }
                       (gotclass and gotsubscript) or
+                      { indexing a dynamic array = dereference }
+                      (gotdynarray and gotvec) or
                       (
                        { allowing assignments to typecasted properties
                            a) is Delphi-incompatible
@@ -1194,7 +1205,8 @@ implementation
                        }
                        not(gottypeconv) and
                        not(gotsubscript and gotrecord) and
-                       not(gotstring and gotvec)
+                       not(gotstring and gotvec) and
+                       not(nf_no_lvalue in hp.flags)
                       ) then
                      result:=true
                    else
@@ -1204,14 +1216,11 @@ implementation
                else
                  begin
                    { 1. if it returns a pointer and we've found a deref,
-                     2. if it returns a class or record and a subscription or with is found
+                     2. if it returns a class and a subscription or with is found
                      3. if the address is needed of a field (subscriptn, vecn) }
                    if (gotpointer and gotderef) or
                       (gotstring and gotvec) or
-                      (
-                       (gotclass or gotrecord) and
-                       (gotsubscript)
-                      ) or
+                      (gotclass and gotsubscript) or
                       (
                         (gotvec and gotdynarray)
                       ) or
@@ -1339,8 +1348,12 @@ implementation
                      exit;
                    end;
                  gotvec:=true;
-                 { accesses to dyn. arrays override read only access in delphi }
-                 if (m_delphi in current_settings.modeswitches) and is_dynamic_array(tunarynode(hp).left.resultdef) then
+                 { accesses to dyn. arrays override read only access in delphi
+                   -- now also in FPC, because the elements of a dynamic array
+                      returned by a function can also be changed, or you can
+                      assign the dynamic array to a variable and then change
+                      its elements anyway }
+                 if is_dynamic_array(tunarynode(hp).left.resultdef) then
                    gotdynarray:=true;
                  hp:=tunarynode(hp).left;
                end;
@@ -1770,19 +1783,6 @@ implementation
               if (p.resultdef.typ=stringdef) and
                  (tstringdef(def_to).stringtype=tstringdef(p.resultdef).stringtype) then
                 eq:=te_equal
-              else
-              { Passing a constant char to ansistring or shortstring or
-                a widechar to widestring then handle it as equal. }
-               if (p.left.nodetype=ordconstn) and
-                  (
-                   is_char(p.resultdef) and
-                   (is_shortstring(def_to) or is_ansistring(def_to))
-                  ) or
-                  (
-                   is_widechar(p.resultdef) and
-                   (is_widestring(def_to) or is_unicodestring(def_to))
-                  ) then
-                eq:=te_equal
             end;
           setdef :
             begin
@@ -1995,12 +1995,11 @@ implementation
                   not hasoverload then
                  break;
              end;
-           if is_objectpascal_helper(structdef) then
+           if is_objectpascal_helper(structdef) and
+              (tobjectdef(structdef).typ in [recorddef,objectdef]) then
              begin
-               if not assigned(tobjectdef(structdef).extendeddef) then
-                 Internalerror(2011062601);
                { search methods in the extended type as well }
-               srsym:=tprocsym(tobjectdef(structdef).extendeddef.symtable.FindWithHash(hashedid));
+               srsym:=tprocsym(tabstractrecorddef(tobjectdef(structdef).extendeddef).symtable.FindWithHash(hashedid));
                if assigned(srsym) and
                   { Delphi allows hiding a property by a procedure with the same name }
                   (srsym.typ=procsym) then
@@ -2107,6 +2106,7 @@ implementation
         st    : TSymtable;
         contextstructdef : tabstractrecorddef;
         ProcdefOverloadList : TFPObjectList;
+        cpoptions : tcompare_paras_options;
       begin
         FCandidateProcs:=nil;
 
@@ -2157,7 +2157,7 @@ implementation
             ((FProcSymtable.symtabletype=withsymtable) and
              (FProcSymtable.defowner.typ in [objectdef,recorddef]))
            ) and
-           (FProcSymtable.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
+           (FProcSymtable.defowner.owner.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]) and
            FProcSymtable.defowner.owner.iscurrentunit then
           contextstructdef:=tabstractrecorddef(FProcSymtable.defowner)
         else
@@ -2196,11 +2196,16 @@ implementation
                ) then
               begin
                 { don't add duplicates, only compare visible parameters for the user }
+                cpoptions:=[cpo_ignorehidden];
+                if (po_compilerproc in pd.procoptions) then
+                  cpoptions:=cpoptions+[cpo_compilerproc];
+                if (po_rtlproc in pd.procoptions) then
+                  cpoptions:=cpoptions+[cpo_rtlproc];
                 found:=false;
                 hp:=FCandidateProcs;
                 while assigned(hp) do
                   begin
-                    if (compare_paras(hp^.data.paras,pd.paras,cp_value_equal_const,[cpo_ignorehidden])>=te_equal) and
+                    if (compare_paras(hp^.data.paras,pd.paras,cp_value_equal_const,cpoptions)>=te_equal) and
                        (not(po_objc in pd.procoptions) or
                         (pd.messageinf.str^=hp^.data.messageinf.str^)) then
                       begin
@@ -2348,13 +2353,12 @@ implementation
         cdoptions : tcompare_defs_options;
         n : tnode;
 
-    {$ifopt r+}{$define ena_r}{$r-}{$endif}
-    {$ifopt q+}{$define ena_q}{$q-}{$endif}
+    {$push}
+    {$r-}
+    {$q-}
       const
         inf=1.0/0.0;
-    {$ifdef ena_r}{$r+}{$endif}
-    {$ifdef ena_q}{$q+}{$endif}
-
+    {$pop}
       begin
         cdoptions:=[cdo_check_operator];
         if FAllowVariant then
@@ -2522,7 +2526,17 @@ implementation
               else
               { generic type comparision }
                begin
-                 eq:=compare_defs_ext(def_from,def_to,currpt.left.nodetype,convtype,pdoper,cdoptions);
+                 if not(po_compilerproc in hp^.data.procoptions) and
+                    not(po_rtlproc in hp^.data.procoptions) and
+                    is_ansistring(currpara.vardef) and
+                    is_ansistring(currpt.left.resultdef) and
+                    (tstringdef(currpara.vardef).encoding<>tstringdef(currpt.left.resultdef).encoding) and
+                    ((tstringdef(currpara.vardef).encoding=globals.CP_NONE) or
+                     (tstringdef(currpt.left.resultdef).encoding=globals.CP_NONE)
+                    ) then
+                   eq:=te_convert_l1
+                 else
+                   eq:=compare_defs_ext(def_from,def_to,currpt.left.nodetype,convtype,pdoper,cdoptions);
 
                  { when the types are not equal we need to check
                    some special case for parameter passing }
@@ -3070,5 +3084,52 @@ implementation
          end;
       end;
 
+    function is_valid_for_default(def:tdef):boolean;
+
+      function is_valid_record_or_object(def:tabstractrecorddef):boolean;
+        var
+          sym : tsym;
+          i : longint;
+        begin
+          for i:=0 to def.symtable.symlist.count-1 do
+            begin
+              sym:=tsym(def.symtable.symlist[i]);
+              if sym.typ<>fieldvarsym then
+                continue;
+              if not is_valid_for_default(tfieldvarsym(sym).vardef) then
+                begin
+                  result:=false;
+                  exit;
+                end;
+            end;
+          result:=true;
+        end;
+
+      begin
+        case def.typ of
+          recorddef:
+            result:=is_valid_record_or_object(tabstractrecorddef(def));
+          objectdef:
+            if is_implicit_pointer_object_type(def) then
+              result:=true
+            else
+              if is_object(def) then
+                result:=is_valid_record_or_object(tabstractrecorddef(def))
+              else
+                result:=false;
+          arraydef:
+            if not (ado_isdynamicarray in tarraydef(def).arrayoptions) then
+              result:=is_valid_for_default(tarraydef(def).elementdef)
+            else
+              result:=true;
+          formaldef,
+          abstractdef,
+          filedef:
+            result:=false;
+          else
+            result:=true;
+        end;
+      end;
+
 
 end.

compiler/i386/cpupara.pas

@@ -284,7 +284,7 @@ unit cpupara;
            size:=OS_INT;
            if calloption=pocall_register then
              begin
-               if (nr<=high(parasupregs)+1) then
+               if (nr<=length(parasupregs)) then
                  begin
                    if nr=0 then
                      internalerror(200309271);
@@ -295,7 +295,8 @@ unit cpupara;
                  begin
                    loc:=LOC_REFERENCE;
                    reference.index:=NR_STACK_POINTER_REG;
-                   reference.offset:=sizeof(aint)*nr;
+                   { the previous parameters didn't take up room in memory }
+                   reference.offset:=sizeof(aint)*(nr-length(parasupregs)-1)
                  end;
              end
            else

compiler/i386/daopt386.pas

@@ -689,10 +689,8 @@ begin
 end;
 
 
-{$ifdef q+}
+{$push}
 {$q-}
-{$define overflowon}
-{$endif q+}
 
 // checks whether a write to r2 of size "size" contains address r1
 function refsoverlapping(const r1, r2: treference; size1, size2: tcgsize): boolean;
@@ -710,18 +708,17 @@ begin
     (r1.relsymbol = r2.relsymbol);
 end;
 
-{$ifdef overflowon}
-{$q+}
-{$undef overflowon}
-{$endif overflowon}
+{$pop}
 
 
 function isgp32reg(supreg: tsuperregister): boolean;
 {Checks if the register is a 32 bit general purpose register}
 begin
   isgp32reg := false;
+{$push}{$warnings off}
   if (supreg >= RS_EAX) and (supreg <= RS_EBX) then
     isgp32reg := true
+{$pop}
 end;
 
 
@@ -1380,10 +1377,12 @@ procedure DestroyReg(p1: ptaiprop; supreg: tsuperregister; doincState:Boolean);
  action (e.g. this register holds the contents of a variable and the value
  of the variable in memory is changed) }
 begin
+{$push}{$warnings off}
   { the following happens for fpu registers }
   if (supreg < low(NrOfInstrSinceLastMod)) or
      (supreg > high(NrOfInstrSinceLastMod)) then
     exit;
+{$pop}
   NrOfInstrSinceLastMod[supreg] := 0;
   with p1^.regs[supreg] do
     begin
@@ -1723,10 +1722,8 @@ begin
   RefInSequence := TmpResult
 end;
 
-{$ifdef q+}
+{$push}
 {$q-}
-{$define overflowon}
-{$endif q+}
 // checks whether a write to r2 of size "size" contains address r1
 function arrayrefsoverlapping(const r1, r2: treference; size1, size2: tcgsize): Boolean;
 var
@@ -1741,10 +1738,7 @@ begin
     (r1.symbol=r2.symbol) and
     (r1.base = r2.base)
 end;
-{$ifdef overflowon}
-{$q+}
-{$undef overflowon}
-{$endif overflowon}
+{$pop}
 
 function isSimpleRef(const ref: treference): boolean;
 { returns true if ref is reference to a local or global variable, to a  }
@@ -2791,10 +2785,8 @@ begin
     pass_generate_code := false;
 end;
 
-{$ifopt r+}
-{$define rangewason}
+{$push}
 {$r-}
-{$endif}
 function tdfaobj.getlabelwithsym(sym: tasmlabel): tai;
 begin
   if (sym.labelnr >= lolab) and
@@ -2803,10 +2795,7 @@ begin
   else
     getlabelwithsym := nil;
 end;
-{$ifdef rangewason}
-{$r+}
-{$undef rangewason}
-{$endif}
+{$pop}
 
 
 procedure tdfaobj.clear;

compiler/i386/i386att.inc

@@ -161,6 +161,7 @@
 'iret',
 'iret',
 'iretw',
+'iretq',
 'jcxz',
 'jecxz',
 'jrcxz',

compiler/i386/i386atts.inc

@@ -164,6 +164,7 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufNONE,
 attsufINT,
 attsufNONE,
 attsufINT,

compiler/i386/i386int.inc

@@ -161,6 +161,7 @@
 'iret',
 'iretd',
 'iretw',
+'iretq',
 'jcxz',
 'jecxz',
 'jrcxz',

compiler/i386/i386nop.inc

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

compiler/i386/i386op.inc

@@ -161,6 +161,7 @@ A_INVLPG,
 A_IRET,
 A_IRETD,
 A_IRETW,
+A_IRETQ,
 A_JCXZ,
 A_JECXZ,
 A_JRCXZ,

compiler/i386/i386prop.inc

@@ -161,6 +161,7 @@
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_RECX, Ch_None, Ch_None)),
 (Ch: (Ch_RECX, Ch_None, Ch_None)),
 (Ch: (Ch_RECX, Ch_None, Ch_None)),
@@ -413,7 +414,7 @@
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_Rop1, Ch_Rop2, Ch_WFlags)),
 (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
@@ -439,19 +440,19 @@
 (Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Mop3, Ch_Rop2, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_Rop1, Ch_Rop2, Ch_WFlags)),
 (Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
@@ -522,7 +523,7 @@
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_Rop1, Ch_Rop2, Ch_WFlags)),
 (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
@@ -553,21 +554,21 @@
 (Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
-(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Mop3, Ch_Rop2, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_Rop1, Ch_Rop2, Ch_WFlags)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
-(Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
+(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),

compiler/i386/i386tab.inc

@@ -381,15 +381,22 @@
   (
     opcode  : A_CALL;
     ops     : 1;
-    optypes : (ot_immediate,ot_none,ot_none,ot_none);
-    code    : #208#1#232#52;
+    optypes : (ot_rm_gpr or ot_bits32,ot_none,ot_none,ot_none);
+    code    : #213#1#255#130;
+    flags   : if_386 or if_nox86_64
+  ),
+  (
+    opcode  : A_CALL;
+    ops     : 1;
+    optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none);
+    code    : #212#1#255#130;
     flags   : if_8086
   ),
   (
     opcode  : A_CALL;
     ops     : 1;
-    optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none);
-    code    : #208#1#255#130;
+    optypes : (ot_immediate,ot_none,ot_none,ot_none);
+    code    : #208#1#232#52;
     flags   : if_8086
   ),
   (
@@ -2537,8 +2544,15 @@
   (
     opcode  : A_JMP;
     ops     : 1;
-    optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none);
-    code    : #208#1#255#132;
+    optypes : (ot_rm_gpr or ot_bits32,ot_none,ot_none,ot_none);
+    code    : #213#1#255#132;
+    flags   : if_386 or if_nox86_64
+  ),
+  (
+    opcode  : A_JMP;
+    ops     : 1;
+    optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none);
+    code    : #212#1#255#132;
     flags   : if_8086
   ),
   (
@@ -2614,22 +2628,15 @@
   (
     opcode  : A_LCALL;
     ops     : 1;
-    optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none);
-    code    : #208#1#255#130;
-    flags   : if_8086
-  ),
-  (
-    opcode  : A_LCALL;
-    ops     : 1;
-    optypes : (ot_memory or ot_near,ot_none,ot_none,ot_none);
-    code    : #208#1#255#130;
-    flags   : if_8086
+    optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none);
+    code    : #213#1#255#131;
+    flags   : if_386 or if_nox86_64
   ),
   (
     opcode  : A_LCALL;
     ops     : 1;
-    optypes : (ot_memory or ot_far,ot_none,ot_none,ot_none);
-    code    : #208#1#255#131;
+    optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none);
+    code    : #212#1#255#131;
     flags   : if_8086
   ),
   (
@@ -2698,22 +2705,15 @@
   (
     opcode  : A_LJMP;
     ops     : 1;
-    optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none);
-    code    : #208#1#255#133;
-    flags   : if_8086
-  ),
-  (
-    opcode  : A_LJMP;
-    ops     : 1;
-    optypes : (ot_memory or ot_far,ot_none,ot_none,ot_none);
-    code    : #208#1#255#133;
-    flags   : if_8086
+    optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none);
+    code    : #213#1#255#133;
+    flags   : if_386 or if_nox86_64
   ),
   (
     opcode  : A_LJMP;
     ops     : 1;
-    optypes : (ot_memory or ot_near,ot_none,ot_none,ot_none);
-    code    : #208#1#255#132;
+    optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none);
+    code    : #212#1#255#133;
     flags   : if_8086
   ),
   (
@@ -5705,6 +5705,27 @@
     code    : #2#15#192#65;
     flags   : if_486
   ),
+  (
+    opcode  : A_XADD;
+    ops     : 2;
+    optypes : (ot_reg8,ot_reg8,ot_none,ot_none);
+    code    : #2#15#192#65;
+    flags   : if_486
+  ),
+  (
+    opcode  : A_XADD;
+    ops     : 2;
+    optypes : (ot_reg16,ot_reg16,ot_none,ot_none);
+    code    : #208#2#15#193#65;
+    flags   : if_486
+  ),
+  (
+    opcode  : A_XADD;
+    ops     : 2;
+    optypes : (ot_reg32,ot_reg32,ot_none,ot_none);
+    code    : #209#2#15#193#65;
+    flags   : if_486
+  ),
   (
     opcode  : A_XBTS;
     ops     : 2;

compiler/i386/n386mem.pas

@@ -28,7 +28,7 @@ interface
     uses
       globtype,
       cgbase,cpuinfo,cpubase,
-      node,nmem,ncgmem;
+      node,nmem,ncgmem,nx86mem;
 
     type
        ti386addrnode = class(tcgaddrnode)
@@ -39,8 +39,7 @@ interface
           procedure pass_generate_code;override;
        end;
 
-       ti386vecnode = class(tcgvecnode)
-          procedure update_reference_reg_mul(maybe_const_reg:tregister;l:aint);override;
+       ti386vecnode = class(tx86vecnode)
           procedure pass_generate_code;override;
        end;
 
@@ -84,65 +83,6 @@ implementation
                              TI386VECNODE
 *****************************************************************************}
 
-     { this routine must, like any other routine, not change the contents }
-     { of base/index registers of references, as these may be regvars.    }
-     { The register allocator can coalesce one LOC_REGISTER being moved   }
-     { into another (as their live ranges won't overlap), but not a       }
-     { LOC_CREGISTER moved into a LOC_(C)REGISTER most of the time (as    }
-     { the live range of the LOC_CREGISTER will most likely overlap the   }
-     { the live range of the target LOC_(C)REGISTER)                      }
-     { The passed register may be a LOC_CREGISTER as well.                }
-     procedure ti386vecnode.update_reference_reg_mul(maybe_const_reg:tregister;l:aint);
-       var
-         l2 : integer;
-         hreg : tregister;
-       begin
-         { Optimized for x86 to use the index register and scalefactor }
-         if location.reference.index=NR_NO then
-          begin
-            { no preparations needed }
-          end
-         else if location.reference.base=NR_NO then
-          begin
-            if (location.reference.scalefactor > 1) then
-              hreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
-            case location.reference.scalefactor of
-             0,1 : hreg:=location.reference.index;
-             2 : cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_ADDR,1,location.reference.index,hreg);
-             4 : cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_ADDR,2,location.reference.index,hreg);
-             8 : cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_ADDR,3,location.reference.index,hreg);
-             else
-               internalerror(2008091401);
-            end;
-            location.reference.base:=hreg;
-          end
-         else
-          begin
-            hreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
-            cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,location.reference,hreg);
-            reference_reset_base(location.reference,hreg,0,location.reference.alignment);
-          end;
-         { insert the new index register and scalefactor or
-           do the multiplication manual }
-         case l of
-          1,2,4,8 :
-            begin
-              location.reference.scalefactor:=l;
-              hreg:=maybe_const_reg;
-            end;
-         else
-           begin
-              hreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
-              if ispowerof2(l,l2) then
-                cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_ADDR,l2,maybe_const_reg,hreg)
-              else
-                cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_IMUL,OS_ADDR,l,maybe_const_reg,hreg);
-           end;
-         end;
-         location.reference.index:=hreg;
-       end;
-
-
     procedure ti386vecnode.pass_generate_code;
       begin
         inherited pass_generate_code;

compiler/i386/n386set.pas

@@ -32,7 +32,6 @@ interface
     type
       ti386casenode = class(tx86casenode)
          procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override;
-         procedure genlinearlist(hp : pcaselabel);override;
       end;
 
 
@@ -68,96 +67,6 @@ implementation
       end;
 
 
-    procedure ti386casenode.genlinearlist(hp : pcaselabel);
-      var
-        first : boolean;
-        lastrange : boolean;
-        last : TConstExprInt;
-        cond_lt,cond_le : tresflags;
-        opcgsize: tcgsize;
-
-        procedure genitem(t : pcaselabel);
-          begin
-             opcgsize:=def_cgsize(opsize);
-             if assigned(t^.less) then
-               genitem(t^.less);
-             { need we to test the first value }
-             if first and (t^._low>get_min_value(left.resultdef)) then
-               begin
-                 cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opcgsize,jmp_lt,aint(t^._low.svalue),hregister,elselabel);
-               end;
-             if t^._low=t^._high then
-               begin
-                  if t^._low-last=0 then
-                    cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opcgsize, OC_EQ,0,hregister,blocklabel(t^.blockid))
-                  else
-                    begin
-                      cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opcgsize, aint(t^._low.svalue-last.svalue), hregister);
-                      cg.a_jmp_flags(current_asmdata.CurrAsmList,F_E,blocklabel(t^.blockid));
-                    end;
-                  last:=t^._low;
-                  lastrange:=false;
-               end
-             else
-               begin
-                  { it begins with the smallest label, if the value }
-                  { is even smaller then jump immediately to the    }
-                  { ELSE-label                                }
-                  if first then
-                    begin
-                       { have we to ajust the first value ? }
-                       if (t^._low>get_min_value(left.resultdef)) or (get_min_value(left.resultdef)<>0) then
-                         cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opcgsize, aint(t^._low.svalue), hregister);
-                    end
-                  else
-                    begin
-                      { if there is no unused label between the last and the }
-                      { present label then the lower limit can be checked    }
-                      { immediately. else check the range in between:       }
-
-                      cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opcgsize, aint(t^._low.svalue-last.svalue), hregister);
-                      { no jump necessary here if the new range starts at }
-                      { at the value following the previous one           }
-                      if ((t^._low-last) <> 1) or
-                         (not lastrange) then
-                        cg.a_jmp_flags(current_asmdata.CurrAsmList,cond_lt,elselabel);
-                    end;
-                  {we need to use A_SUB, because A_DEC does not set the correct flags, therefor
-                   using a_op_const_reg(OP_SUB) is not possible }
-                  emit_const_reg(A_SUB,TCGSize2OpSize[opcgsize],aint(t^._high.svalue-t^._low.svalue),hregister);
-                  cg.a_jmp_flags(current_asmdata.CurrAsmList,cond_le,blocklabel(t^.blockid));
-                  last:=t^._high;
-                  lastrange:=true;
-               end;
-             first:=false;
-             if assigned(t^.greater) then
-               genitem(t^.greater);
-          end;
-
-        begin
-           if with_sign then
-             begin
-                cond_lt:=F_L;
-                cond_le:=F_LE;
-             end
-           else
-              begin
-                cond_lt:=F_B;
-                cond_le:=F_BE;
-             end;
-           { do we need to generate cmps? }
-           if (with_sign and (min_label<0)) then
-             genlinearcmplist(hp)
-           else
-             begin
-                last:=0;
-                lastrange:=false;
-                first:=true;
-                genitem(hp);
-                cg.a_jmp_always(current_asmdata.CurrAsmList,elselabel);
-             end;
-        end;
-
 begin
    ccasenode:=ti386casenode;
 end.

compiler/ia64/aasmcpu.pas

@@ -68,7 +68,7 @@ type
      { A8: integer compare - imm.,register }
      constructor op_preg_preg_const_reg(_qp : tqp;op : tasmop;
        cond : tasmcond;p1,p2 : tqp;i : longint;const r3 : tregister);
-{!!!!!!!
+(*!!!!!!!
      { multimedia shift and multiply }
      constructor op_reg_reg_reg_const(_qp : tqp;
      { multimedia mux }
@@ -93,7 +93,7 @@ type
      constructor op_preg_preg_reg(_qp : tqp;
 
      { -------- here are some missed ----------- }
-}
+ *)
 
      { M1: integer load }
      { M4: integer store }

compiler/ia64/ia64reg.dat

@@ -5,9 +5,9 @@
 ; editing by hand
 ;
 ; layout
-; <name>,<type>,<value>,<stdname>,<gasname>,<stabidx>
+; <name>,<type>,<value>,<stdname>,<gasname>
 ;
-NO,$00,$00,INVALID,INVALID,INVALID,INVALID,-1,-1
+NO,$00,$00,INVALID,INVALID
 
 R0,$01,0,r0,r0
 R1,$01,1,r1,r1

compiler/impdef.pas

@@ -161,9 +161,9 @@ procedure CreateTempDir(const s:string);
    end
  else
   begin
-    {$I-}
+    {$push} {$I-}
      mkdir(s);
-    {$I+}
+    {$pop}
     if ioresult<>0 then;
   end;
  end;
@@ -189,9 +189,9 @@ procedure call_ar;
   ExecuteProcess(ar_name,'rs '+impname+' '+path+dirsep+'*.swo');
   cleardir(path,'*.sw');
   cleardir(path,'*.swo');
-  {$i-}
+  {$push} {$I-}
   RmDir(path);
-  {$i+}
+  {$pop}
   if ioresult<>0 then;
  end;
 procedure makeasm(index:cardinal;name:pchar;isData:longbool);
@@ -446,11 +446,11 @@ begin
   impname:=libname;
   lname:=binname;
   OldFileMode:=filemode;
-  {$I-}
+  {$push} {$I-}
    filemode:=0;
    reset(f,1);
    filemode:=OldFileMode;
-  {$I+}
+  {$pop}
   if IOResult<>0 then
    begin
      makedef:=false;

compiler/jvm/hlcgcpu.pas

@@ -92,7 +92,6 @@ uses
       procedure record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList); override;
 
       procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);override;
-      procedure g_decrrefcount(list : TAsmList;t: tdef; const ref: treference);override;
       procedure g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation; const name: string); override;
       procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);override;
       procedure g_finalize(list : TAsmList;t : tdef;const ref : treference);override;
@@ -1515,11 +1514,6 @@ implementation
       // do nothing
     end;
 
-  procedure thlcgjvm.g_decrrefcount(list: TAsmList; t: tdef; const ref: treference);
-    begin
-      // do nothing
-    end;
-
   procedure thlcgjvm.g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation; const name: string);
     var
       normaldim: longint;