Merge remote-tracking branch 'origin/main' into unicodekvm

.gitlab-ci.yml

@@ -3,7 +3,10 @@
 # the FPC specific parts are partly from:
 # https://gitlab.com/alb42/testconversion2/-/blob/main/.gitlab-ci.yml
 
-image: registry.gitlab.com/freepascal.org/fpc/source:buster_fpcbuild
+.linux_runners:
+  image: registry.gitlab.com/freepascal.org/fpc/source/debian-buster-x86_64
+  tags:
+    - linux
 
 stages:
   - compilercycle
@@ -11,12 +14,16 @@ stages:
 
 compiler-fullcycle-job:
   stage: compilercycle
+  extends:
+    - .linux_runners
   script:
     - cd compiler
     - make fullcycle -j 4 "OPT=-Oodfa"
 
-build-and-test-job:
+build-and-test-job-linux:
   stage: buildandtest
+  extends:
+    - .linux_runners
   script:
     - make -j 4 all OS_TARGET=linux CPU_TARGET=x86_64 FPMAKEOPT="-T 4" "OPT=-Oodfa"
     - FPC_SRC=$(pwd)

Makefile

@@ -2,7 +2,7 @@
 # Don't edit, this file is generated by FPCMake Version 2.0.0
 #
 default: help
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macosclassic m68k-embedded m68k-sinclairql powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macosclassic 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-haiku x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros arm-freertos arm-ios powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android mips64el-linux jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-freebsd aarch64-darwin aarch64-win64 aarch64-android aarch64-ios wasm32-embedded wasm32-wasi sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded xtensa-linux xtensa-embedded xtensa-freertos z80-embedded z80-zxspectrum z80-msxdos z80-amstradcpc
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macosclassic m68k-embedded m68k-sinclairql powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macosclassic 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-haiku x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros arm-freertos arm-ios powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android mips64el-linux jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-freebsd aarch64-darwin aarch64-win64 aarch64-embedded aarch64-android aarch64-ios wasm32-embedded wasm32-wasi sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded xtensa-linux xtensa-embedded xtensa-freertos z80-embedded z80-zxspectrum z80-msxdos z80-amstradcpc
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari
@@ -178,6 +178,8 @@ else
 ARCH=$(CPU_TARGET)
 endif
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+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)
@@ -788,6 +790,9 @@ endif
 ifeq ($(FULL_TARGET),aarch64-win64)
 override TARGET_DIRS+=compiler rtl utils packages installer
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+override TARGET_DIRS+=compiler rtl utils packages installer
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 override TARGET_DIRS+=compiler rtl utils packages installer
 endif
@@ -2767,6 +2772,13 @@ TARGET_DIRS_UTILS=1
 TARGET_DIRS_PACKAGES=1
 TARGET_DIRS_INSTALLER=1
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+TARGET_DIRS_COMPILER=1
+TARGET_DIRS_RTL=1
+TARGET_DIRS_UTILS=1
+TARGET_DIRS_PACKAGES=1
+TARGET_DIRS_INSTALLER=1
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 TARGET_DIRS_COMPILER=1
 TARGET_DIRS_RTL=1

compiler/Makefile

@@ -2,7 +2,7 @@
 # Don't edit, this file is generated by FPCMake Version 2.0.0
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macosclassic m68k-embedded m68k-sinclairql powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macosclassic 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-haiku x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros arm-freertos arm-ios powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android mips64el-linux jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-freebsd aarch64-darwin aarch64-win64 aarch64-android aarch64-ios wasm32-embedded wasm32-wasi sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded xtensa-linux xtensa-embedded xtensa-freertos z80-embedded z80-zxspectrum z80-msxdos z80-amstradcpc
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macosclassic m68k-embedded m68k-sinclairql powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macosclassic 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-haiku x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros arm-freertos arm-ios powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android mips64el-linux jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-freebsd aarch64-darwin aarch64-win64 aarch64-embedded aarch64-android aarch64-ios wasm32-embedded wasm32-wasi sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded xtensa-linux xtensa-embedded xtensa-freertos z80-embedded z80-zxspectrum z80-msxdos z80-amstradcpc
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari
@@ -178,6 +178,8 @@ else
 ARCH=$(CPU_TARGET)
 endif
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+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)
@@ -403,6 +405,12 @@ endif
 ifdef MIPSEL
 PPC_TARGET=mipsel
 endif
+ifdef MIPS64
+PPC_TARGET=mips64
+endif
+ifdef MIPS64EL
+PPC_TARGET=mips64el
+endif
 ifdef AVR
 PPC_TARGET=avr
 endif
@@ -533,6 +541,12 @@ endif
 ifeq ($(CPC_TARGET),mipsel)
 CPUSUF=mipsel
 endif
+ifeq ($(CPC_TARGET),mips64)
+CPUSUF=mips64
+endif
+ifeq ($(CPC_TARGET),mips64el)
+CPUSUF=mips64el
+endif
 ifeq ($(CPC_TARGET),avr)
 CPUSUF=avr
 ALLOW_WARNINGS=1
@@ -638,9 +652,18 @@ endif
 ifeq ($(PPC_TARGET),armeb)
 override LOCALOPT+=-Fuarmgen
 endif
+ifeq ($(PPC_TARGET),mips)
+override LOCALOPT+=-Fumips
+endif
 ifeq ($(PPC_TARGET),mipsel)
 override LOCALOPT+=-Fumips
 endif
+ifeq ($(PPC_TARGET),mips64)
+override LOCALOPT+=-Fumips
+endif
+ifeq ($(PPC_TARGET),mips64el)
+override LOCALOPT+=-Fumips
+endif
 ifeq ($(PPC_TARGET),jvm)
 override LOCALOPT+=-Fujvm
 endif
@@ -939,6 +962,9 @@ endif
 ifeq ($(FULL_TARGET),aarch64-win64)
 override TARGET_DIRS+=utils
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+override TARGET_DIRS+=utils
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 override TARGET_DIRS+=utils
 endif
@@ -1257,6 +1283,9 @@ endif
 ifeq ($(FULL_TARGET),aarch64-win64)
 override TARGET_PROGRAMS+=pp
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+override TARGET_PROGRAMS+=pp
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 override TARGET_PROGRAMS+=pp
 endif
@@ -1576,6 +1605,9 @@ endif
 ifeq ($(FULL_TARGET),aarch64-win64)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
@@ -1894,6 +1926,9 @@ endif
 ifeq ($(FULL_TARGET),aarch64-win64)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -2212,6 +2247,9 @@ endif
 ifeq ($(FULL_TARGET),aarch64-win64)
 override COMPILER_TARGETDIR+=$(CPU_UNITDIR)/bin/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+override COMPILER_TARGETDIR+=$(CPU_UNITDIR)/bin/$(FULL_TARGET)
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 override COMPILER_TARGETDIR+=$(CPU_UNITDIR)/bin/$(FULL_TARGET)
 endif
@@ -2530,6 +2568,9 @@ endif
 ifeq ($(FULL_TARGET),aarch64-win64)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -3613,6 +3654,9 @@ endif
 ifeq ($(FULL_TARGET),aarch64-win64)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -4599,6 +4643,9 @@ endif
 ifeq ($(FULL_TARGET),aarch64-win64)
 TARGET_DIRS_UTILS=1
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+TARGET_DIRS_UTILS=1
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 TARGET_DIRS_UTILS=1
 endif
@@ -4860,8 +4907,8 @@ endif
 ifdef TEMPWPONAME2PREFIX
 	$(MAKE) g$(TEMPWPONAME2) COMPILERTEMPNAME=$(TEMPWPONAME2)
 endif
-PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 mips mipsel avr jvm i8086 aarch64 sparc64 riscv32 riscv64 xtensa z80 wasm32
-PPC_SUFFIXES=386 68k ppc sparc arm armeb x64 ppc64 mips mipsel avr jvm 8086 a64 sparc64 rv32 rv64 xtensa z80 wasm32
+PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 mips mipsel mips64 mips64el avr jvm i8086 aarch64 sparc64 riscv32 riscv64 xtensa z80 wasm32
+PPC_SUFFIXES=386 68k ppc sparc arm armeb x64 ppc64 mips mipsel mips64 mips64el avr jvm 8086 a64 sparc64 rv32 rv64 xtensa z80 wasm32
 INSTALL_TARGETS=$(addsuffix _exe_install,$(sort $(CYCLETARGETS) $(PPC_TARGETS)))
 SYMLINKINSTALL_TARGETS=$(addsuffix _symlink_install,$(sort $(CYCLETARGETS) $(PPC_TARGETS)))
 .PHONY: $(PPC_TARGETS) $(INSTALL_TARGETS)$(SYMLINKINSTALL_TARGETS)
@@ -5158,7 +5205,7 @@ ifeq ($(findstring -dFPC_SOFT_FPUX80,$(LOCALOPT)),)
 ifeq ($(OS_SOURCE),win64)
   EXCLUDE_80BIT_TARGETS=1
 endif
-ifneq ($(findstring $(CPU_SOURCE),aarch64 arm avr jvm m68k mips mipsel powerpc powerpc64 sparc sparc64 riscv32 riscv64 xtensa),)
+ifneq ($(findstring $(CPU_SOURCE),aarch64 arm avr jvm m68k mips mipsel mips64 mips64el powerpc powerpc64 sparc sparc64 riscv32 riscv64 xtensa),)
   EXCLUDE_80BIT_TARGETS=1
 endif
 endif
@@ -5204,7 +5251,7 @@ endif
 	$(INSTALLEXE) $(INSTALLEXEFILE) $(PPCCPULOCATION)/$(INSTALLEXEFILE)
 endif
 fullinstall:
-	$(MAKE) $(addsuffix _exe_install,$($(FULL_TARGETS)))
+	$(MAKE) $(addsuffix _exe_install,$(FULL_TARGETS))
 	$(MAKE) $(addsuffix _all,$(TARGET_DIRS))
 	$(MAKE) $(addsuffix _install,$(TARGET_DIRS))
 auxfilesinstall:

compiler/Makefile.fpc

@@ -98,6 +98,12 @@ endif
 ifdef MIPSEL
 PPC_TARGET=mipsel
 endif
+ifdef MIPS64
+PPC_TARGET=mips64
+endif
+ifdef MIPS64EL
+PPC_TARGET=mips64el
+endif
 ifdef AVR
 PPC_TARGET=avr
 endif
@@ -262,6 +268,12 @@ endif
 ifeq ($(CPC_TARGET),mipsel)
 CPUSUF=mipsel
 endif
+ifeq ($(CPC_TARGET),mips64)
+CPUSUF=mips64
+endif
+ifeq ($(CPC_TARGET),mips64el)
+CPUSUF=mips64el
+endif
 ifeq ($(CPC_TARGET),avr)
 CPUSUF=avr
 ALLOW_WARNINGS=1
@@ -406,11 +418,26 @@ ifeq ($(PPC_TARGET),armeb)
 override LOCALOPT+=-Fuarmgen
 endif
 
+# mips specific
+ifeq ($(PPC_TARGET),mips)
+override LOCALOPT+=-Fumips
+endif
+
 # mipsel specific
 ifeq ($(PPC_TARGET),mipsel)
 override LOCALOPT+=-Fumips
 endif
 
+# mips64 specific
+ifeq ($(PPC_TARGET),mips64)
+override LOCALOPT+=-Fumips
+endif
+
+# mips64el specific
+ifeq ($(PPC_TARGET),mips64el)
+override LOCALOPT+=-Fumips
+endif
+
 # jvm specific
 ifeq ($(PPC_TARGET),jvm)
 override LOCALOPT+=-Fujvm
@@ -644,8 +671,8 @@ endif
 # cpu targets
 #####################################################################
 
-PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 mips mipsel avr jvm i8086 aarch64 sparc64 riscv32 riscv64 xtensa z80 wasm32
-PPC_SUFFIXES=386 68k ppc sparc arm armeb x64 ppc64 mips mipsel avr jvm 8086 a64 sparc64 rv32 rv64 xtensa z80 wasm32
+PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 mips mipsel mips64 mips64el avr jvm i8086 aarch64 sparc64 riscv32 riscv64 xtensa z80 wasm32
+PPC_SUFFIXES=386 68k ppc sparc arm armeb x64 ppc64 mips mipsel mips64 mips64el avr jvm 8086 a64 sparc64 rv32 rv64 xtensa z80 wasm32
 INSTALL_TARGETS=$(addsuffix _exe_install,$(sort $(CYCLETARGETS) $(PPC_TARGETS)))
 SYMLINKINSTALL_TARGETS=$(addsuffix _symlink_install,$(sort $(CYCLETARGETS) $(PPC_TARGETS)))
 
@@ -1084,7 +1111,7 @@ ifeq ($(OS_SOURCE),win64)
   EXCLUDE_80BIT_TARGETS=1
 endif
 
-ifneq ($(findstring $(CPU_SOURCE),aarch64 arm avr jvm m68k mips mipsel powerpc powerpc64 sparc sparc64 riscv32 riscv64 xtensa),)
+ifneq ($(findstring $(CPU_SOURCE),aarch64 arm avr jvm m68k mips mipsel mips64 mips64el powerpc powerpc64 sparc sparc64 riscv32 riscv64 xtensa),)
   EXCLUDE_80BIT_TARGETS=1
 endif
 endif
@@ -1154,7 +1181,7 @@ endif
 endif
 
 fullinstall:
-	$(MAKE) $(addsuffix _exe_install,$($(FULL_TARGETS)))
+	$(MAKE) $(addsuffix _exe_install,$(FULL_TARGETS))
 	$(MAKE) $(addsuffix _all,$(TARGET_DIRS))
 	$(MAKE) $(addsuffix _install,$(TARGET_DIRS))
 

compiler/aarch64/a64reg.dat

@@ -80,6 +80,7 @@ NZCV,$05,$00,$00,nzcv,0,0
 FPCR,$05,$00,$01,fpcr,0,0
 FPSR,$05,$00,$02,fpsr,0,0
 TPIDR_EL0,$05,$00,$03,tpidr_el0,0,0
+MPIDR_EL1,$05,$00,$04,mpidr_el1,0,0
 
 ; vfp registers
 ; generated by fpc/compiler/utils/gena64vfp.pp to avoid tedious typing

compiler/aarch64/agcpugas.pas

@@ -846,7 +846,7 @@ unit agcpugas;
             idtxt  : 'AS';
             asmbin : 'as';
             asmcmd : '-o $OBJ $MARCHOPT $EXTRAOPT $ASM';
-            supported_targets : [system_aarch64_freebsd,system_aarch64_linux,system_aarch64_android];
+            supported_targets : [system_aarch64_freebsd,system_aarch64_linux,system_aarch64_android,system_aarch64_embedded];
             flags : [af_needar,af_smartlink_sections];
             labelprefix : '.L';
             labelmaxlen : -1;

compiler/aarch64/aoptcpu.pas

@@ -114,7 +114,7 @@ Implementation
 
       case p.oper[0]^.typ of
         top_reg:
-          Result := (p.oper[0]^.reg = reg);
+          Result := SuperRegistersEqual(p.oper[0]^.reg,reg);
         top_ref:
           Result :=
             (taicpu(p).oper[0]^.ref^.addressmode in [AM_PREINDEXED,AM_POSTINDEXED]) and

compiler/aarch64/cpuinfo.pas

@@ -52,7 +52,11 @@ Type
      );
 
    tcontrollertype =
-     (ct_none
+     (ct_none,
+
+      { Raspberry Pi 3/4 }
+      ct_raspi3,
+      ct_raspi4
      );
 
    tcontrollerdatatype = record
@@ -69,7 +73,7 @@ Const
 
    { Is there support for dealing with multiple microcontrollers available }
    { for this platform? }
-   ControllerSupport = false; (* Not yet at least ;-) *)
+   ControllerSupport = true; (* Not yet at least ;-) *)
    {# Size of native extended floating point type }
    extended_size = 8;
    { target cpu string (used by compiler options) }
@@ -81,7 +85,13 @@ Const
     {$WARN 3177 OFF}
    embedded_controllers : array [tcontrollertype] of tcontrollerdatatype =
    (
-      (controllertypestr:''; controllerunitstr:''; cputype:cpu_none; fputype:fpu_none; flashbase:0; flashsize:0; srambase:0; sramsize:0));
+      (controllertypestr:''; controllerunitstr:''; cputype:cpu_none; fputype:fpu_none; flashbase:0; flashsize:0; srambase:0; sramsize:0),
+
+      { Raspberry Pi 3/4 }
+      (controllertypestr:'RASPI3'; controllerunitstr:'RASPI3'; cputype:cpu_armv8a; fputype:fpu_vfp; flashbase:$00000000; flashsize:$00000000; srambase:$00080000; sramsize:$10000000),
+      (controllertypestr:'RASPI4'; controllerunitstr:'RASPI4'; cputype:cpu_armv8a; fputype:fpu_vfp; flashbase:$00000000; flashsize:$00000000; srambase:$00080000; sramsize:$10000000)
+
+      );
    {$POP}
 
    { calling conventions supported by the code generator }

compiler/aarch64/cpunode.pas

@@ -35,7 +35,7 @@ implementation
     symcpu,
     aasmdef,
 {$ifndef llvm}
-    ncpuadd,ncpumat,ncpumem,ncpuinl,ncpucnv,ncpuset,ncpucon,ncpuflw
+    ncpuadd,ncpumat,ncpumem,ncpuinl,ncpucnv,ncpuset,ncpucon,ncpuflw,naarch64util
 {$else llvm}
     llvmnode
 {$endif llvm}

compiler/aarch64/cputarg.pas

@@ -50,6 +50,9 @@ implementation
     {$ifndef NOTARGETWIN64}
       ,t_win
     {$endif}
+    {$ifndef NOTARGETEMBEDDED}
+      ,t_embed
+    {$endif}
 
 {**************************************
              Assemblers

compiler/aarch64/naarch64util.pas

@@ -0,0 +1,164 @@
+{
+    Copyright (c) 1998-2022 by the Free Pascal development team
+
+    AArch64 version of some node tree helper routines
+
+    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 naarch64util;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+    cclasses, ngenutil;
+
+type
+    TAArch64NodeUtils = class(TNodeUtils)
+        class procedure InsertObjectInfo; override;
+        class procedure Insert_Init_Final_Table(Entries: TFPList); override;
+    end;
+
+implementation
+
+uses
+    verbose,
+    systems,
+    globals,
+    cpuinfo,cpubase,
+    cgbase,cgutils,
+    aasmbase,aasmdata,aasmtai,aasmcpu,
+    symdef;
+
+class procedure TAArch64NodeUtils.InsertObjectInfo;
+begin
+    inherited InsertObjectInfo;
+end;
+
+{
+    TODO: This is a simple skeleton, not nearly as complex as the
+    ARM (32-bit) version in compiler/arm/narmutil.pas
+}
+class procedure TAArch64NodeUtils.Insert_Init_Final_Table(Entries: TFPList);
+
+    procedure GenEntry(List: TAsmList);
+    var
+        Ref: TReference;
+        pairreg: TRegister;
+        rt: TRegisterType;
+        sub: TSubRegister;
+        sr: TSuperRegister;
+    begin
+        { generate `stp x29, x30, [sp, #-16]!` }
+        reference_reset_base(ref, NR_SP, -16, ctempposinvalid, 16, []);
+        ref.addressmode := AM_PREINDEXED;
+
+        rt := R_INTREGISTER;
+        sub := R_SUBWHOLE;
+
+        sr := RS_X29;
+        pairreg := newreg(rt, sr, sub);
+
+        sr := RS_X30;
+        List.Concat(taicpu.op_reg_reg_ref(A_STP, pairreg, newreg(rt, sr, sub), ref));
+
+        { TODO: generate `mov x29, sp` maybe? }
+    end;
+
+    procedure GenExit(List: TAsmList);
+    var
+        Ref: TReference;
+        pairreg: TRegister;
+        rt: TRegisterType;
+        sub: TSubRegister;
+        sr: TSuperRegister;
+    begin
+        { generate `ldp x29, x30, [sp], #16` }
+        reference_reset_base(ref, NR_SP, 16, ctempposinvalid, 16, []);
+        ref.addressmode := AM_POSTINDEXED;
+
+        rt := R_INTREGISTER;
+        sub := R_SUBWHOLE;
+
+        { these are backwards compared to GenEntry intentionally }
+        sr := RS_X30;
+        pairreg := newreg(rt, sr, sub);
+
+        sr := RS_X29;
+        List.Concat(taicpu.op_reg_reg_ref(A_LDP, newreg(rt, sr, sub), pairreg, ref));
+
+        { generate `ret` }
+        List.Concat(taicpu.op_none(A_RET));
+    end;
+
+var
+    InitList, FinalList, Header: TAsmList;
+    Entry : PInitFinalEntry;
+    i : longint;
+begin
+    if not(tf_init_final_units_by_calls in target_info.flags) then
+    begin
+        inherited insert_init_final_table(Entries);
+        exit;
+    end;
+
+    InitList := TAsmList.Create;
+    FinalList := TAsmList.Create;
+
+    GenEntry(finalList);
+    GenEntry(initList);
+
+    for i := 0 to Entries.Count - 1 do
+    begin
+        Entry := PInitFinalEntry(Entries[i]);
+        if Entry^.finifunc <> '' then
+            finalList.Concat(taicpu.op_sym(A_BL, current_asmdata.RefAsmSymbol(entry^.finifunc, AT_FUNCTION)));
+        if Entry^.initfunc <> '' then
+            initList.Concat(taicpu.op_sym(A_BL, current_asmdata.RefAsmSymbol(entry^.initfunc, AT_FUNCTION)));
+    end;
+
+    GenExit(finalList);
+    GenExit(initList);
+
+    Header := TAsmList.Create;
+    New_Section(Header, Sec_Code, 'FPC_INIT_FUNC_TABLE', 1);
+    Header.Concat(TAI_Symbol.CreateName_Global('FPC_INIT_FUNC_TABLE', AT_FUNCTION, 0, VoidCodePointerType));
+
+    InitList.InsertList(Header);
+    Header.Free;
+
+    current_asmdata.AsmLists[al_procedures].concatList(initList);
+
+    Header := TAsmList.Create;
+    New_Section(Header, Sec_Code, 'FPC_FINALIZE_FUNC_TABLE', 1);
+    Header.Concat(TAI_Symbol.CreateName_Global('FPC_FINALIZE_FUNC_TABLE', AT_FUNCTION, 0, VoidCodePointerType));
+
+    FinalList.InsertList(Header);
+    Header.Free;
+
+    current_asmdata.AsmLists[al_procedures].concatList(finalList);
+
+    InitList.Free;
+    FinalList.Free;
+
+    inherited Insert_Init_Final_Table(entries);
+end;
+
+begin
+    cnodeutils := TAArch64NodeUtils;
+end.

compiler/aarch64/ra64con.inc

@@ -70,6 +70,7 @@ NR_NZCV = tregister($05000000);
 NR_FPCR = tregister($05000001);
 NR_FPSR = tregister($05000002);
 NR_TPIDR_EL0 = tregister($05000003);
+NR_MPIDR_EL1 = tregister($05000004);
 NR_B0 = tregister($04010000);
 NR_H0 = tregister($04030000);
 NR_S0 = tregister($04090000);

compiler/aarch64/ra64dwa.inc

@@ -70,6 +70,7 @@
 0,
 0,
 0,
+0,
 64,
 64,
 64,

compiler/aarch64/ra64nor.inc

@@ -1,2 +1,2 @@
 { don't edit, this file is generated from a64reg.dat }
-647
+648

compiler/aarch64/ra64num.inc

@@ -70,6 +70,7 @@ tregister($05000000),
 tregister($05000001),
 tregister($05000002),
 tregister($05000003),
+tregister($05000004),
 tregister($04010000),
 tregister($04030000),
 tregister($04090000),

compiler/aarch64/ra64rni.inc

@@ -66,70 +66,38 @@
 62,
 64,
 66,
-76,
-94,
-112,
-130,
-148,
-166,
-184,
-202,
-220,
-238,
-256,
-274,
-292,
-310,
-328,
-346,
-364,
-382,
-400,
-418,
-436,
-454,
-472,
-490,
-508,
-526,
-544,
-562,
-580,
-598,
-616,
-634,
-71,
-89,
-107,
-125,
-143,
-161,
-179,
-197,
-215,
-233,
-251,
-269,
-287,
-305,
-323,
-341,
-359,
-377,
-395,
-413,
-431,
-449,
-467,
-485,
-503,
-521,
-539,
-557,
-575,
-593,
-611,
-629,
+77,
+95,
+113,
+131,
+149,
+167,
+185,
+203,
+221,
+239,
+257,
+275,
+293,
+311,
+329,
+347,
+365,
+383,
+401,
+419,
+437,
+455,
+473,
+491,
+509,
+527,
+545,
+563,
+581,
+599,
+617,
+635,
 72,
 90,
 108,
@@ -258,38 +226,38 @@
 597,
 615,
 633,
-81,
-99,
-117,
-135,
-153,
-171,
-189,
-207,
-225,
-243,
-261,
-279,
-297,
-315,
-333,
-351,
-369,
-387,
-405,
-423,
-441,
-459,
-477,
-495,
-513,
-531,
-549,
-567,
-585,
-603,
-621,
-639,
+76,
+94,
+112,
+130,
+148,
+166,
+184,
+202,
+220,
+238,
+256,
+274,
+292,
+310,
+328,
+346,
+364,
+382,
+400,
+418,
+436,
+454,
+472,
+490,
+508,
+526,
+544,
+562,
+580,
+598,
+616,
+634,
 82,
 100,
 118,
@@ -514,38 +482,38 @@
 610,
 628,
 646,
-77,
-95,
-113,
-131,
-149,
-167,
-185,
-203,
-221,
-239,
-257,
-275,
-293,
-311,
-329,
-347,
-365,
-383,
-401,
-419,
-437,
-455,
-473,
-491,
-509,
-527,
-545,
-563,
-581,
-599,
-617,
-635,
+89,
+107,
+125,
+143,
+161,
+179,
+197,
+215,
+233,
+251,
+269,
+287,
+305,
+323,
+341,
+359,
+377,
+395,
+413,
+431,
+449,
+467,
+485,
+503,
+521,
+539,
+557,
+575,
+593,
+611,
+629,
+647,
 78,
 96,
 114,
@@ -642,7 +610,40 @@
 602,
 620,
 638,
+81,
+99,
+117,
+135,
+153,
+171,
+189,
+207,
+225,
+243,
+261,
+279,
+297,
+315,
+333,
+351,
+369,
+387,
+405,
+423,
+441,
+459,
+477,
+495,
+513,
+531,
+549,
+567,
+585,
+603,
+621,
+639,
 67,
 68,
 69,
-70
+70,
+71

compiler/aarch64/ra64sri.inc

@@ -1,71 +1,5 @@
 { don't edit, this file is generated from a64reg.dat }
 0,
-71,
-89,
-251,
-269,
-287,
-305,
-323,
-341,
-359,
-377,
-395,
-413,
-107,
-431,
-449,
-467,
-485,
-503,
-521,
-539,
-557,
-575,
-593,
-125,
-611,
-629,
-143,
-161,
-179,
-197,
-215,
-233,
-74,
-92,
-254,
-272,
-290,
-308,
-326,
-344,
-362,
-380,
-398,
-416,
-110,
-434,
-452,
-470,
-488,
-506,
-524,
-542,
-560,
-578,
-596,
-128,
-614,
-632,
-146,
-164,
-182,
-200,
-218,
-236,
-68,
-69,
 72,
 90,
 252,
@@ -98,7 +32,6 @@
 198,
 216,
 234,
-67,
 75,
 93,
 255,
@@ -131,6 +64,8 @@
 201,
 219,
 237,
+68,
+69,
 73,
 91,
 253,
@@ -163,424 +98,490 @@
 199,
 217,
 235,
+71,
+67,
+76,
+94,
+256,
+274,
+292,
+310,
+328,
+346,
+364,
+382,
+400,
+418,
+112,
+436,
+454,
+472,
+490,
+508,
+526,
+544,
+562,
+580,
+598,
+130,
+616,
+634,
+148,
+166,
+184,
+202,
+220,
+238,
+74,
+92,
+254,
+272,
+290,
+308,
+326,
+344,
+362,
+380,
+398,
+416,
+110,
+434,
+452,
+470,
+488,
+506,
+524,
+542,
+560,
+578,
+596,
+128,
+614,
+632,
+146,
+164,
+182,
+200,
+218,
+236,
 66,
 70,
-76,
-82,
-87,
-88,
-85,
+77,
 83,
+88,
+89,
 86,
-81,
 84,
-77,
-80,
+87,
+82,
+85,
 78,
+81,
 79,
-94,
-100,
-105,
-106,
-103,
+80,
+95,
 101,
+106,
+107,
 104,
-99,
 102,
-95,
-98,
+105,
+100,
+103,
 96,
+99,
 97,
-256,
-262,
-267,
-268,
-265,
+98,
+257,
 263,
+268,
+269,
 266,
-261,
 264,
-257,
-260,
+267,
+262,
+265,
 258,
+261,
 259,
-274,
-280,
-285,
-286,
-283,
+260,
+275,
 281,
+286,
+287,
 284,
-279,
 282,
-275,
-278,
+285,
+280,
+283,
 276,
+279,
 277,
-292,
-298,
-303,
-304,
-301,
+278,
+293,
 299,
+304,
+305,
 302,
-297,
 300,
-293,
-296,
+303,
+298,
+301,
 294,
+297,
 295,
-310,
-316,
-321,
-322,
-319,
+296,
+311,
 317,
+322,
+323,
 320,
-315,
 318,
-311,
-314,
+321,
+316,
+319,
 312,
+315,
 313,
-328,
-334,
-339,
-340,
-337,
+314,
+329,
 335,
+340,
+341,
 338,
-333,
 336,
-329,
-332,
+339,
+334,
+337,
 330,
+333,
 331,
-346,
-352,
-357,
-358,
-355,
+332,
+347,
 353,
+358,
+359,
 356,
-351,
 354,
-347,
-350,
+357,
+352,
+355,
 348,
+351,
 349,
-364,
-370,
-375,
-376,
-373,
+350,
+365,
 371,
+376,
+377,
 374,
-369,
 372,
-365,
-368,
+375,
+370,
+373,
 366,
+369,
 367,
-382,
-388,
-393,
-394,
-391,
+368,
+383,
 389,
+394,
+395,
 392,
-387,
 390,
-383,
-386,
+393,
+388,
+391,
 384,
+387,
 385,
-400,
-406,
-411,
-412,
-409,
+386,
+401,
 407,
+412,
+413,
 410,
-405,
 408,
-401,
-404,
+411,
+406,
+409,
 402,
+405,
 403,
-418,
-424,
-429,
-430,
-427,
+404,
+419,
 425,
+430,
+431,
 428,
-423,
 426,
-419,
-422,
+429,
+424,
+427,
 420,
+423,
 421,
-112,
-118,
-123,
-124,
-121,
+422,
+113,
 119,
+124,
+125,
 122,
-117,
 120,
-113,
-116,
+123,
+118,
+121,
 114,
+117,
 115,
-436,
-442,
-447,
-448,
-445,
+116,
+437,
 443,
+448,
+449,
 446,
-441,
 444,
-437,
-440,
+447,
+442,
+445,
 438,
+441,
 439,
-454,
-460,
-465,
-466,
-463,
+440,
+455,
 461,
+466,
+467,
 464,
-459,
 462,
-455,
-458,
+465,
+460,
+463,
 456,
+459,
 457,
-472,
-478,
-483,
-484,
-481,
+458,
+473,
 479,
+484,
+485,
 482,
-477,
 480,
-473,
-476,
+483,
+478,
+481,
 474,
+477,
 475,
-490,
-496,
-501,
-502,
-499,
+476,
+491,
 497,
+502,
+503,
 500,
-495,
 498,
-491,
-494,
+501,
+496,
+499,
 492,
+495,
 493,
-508,
-514,
-519,
-520,
-517,
+494,
+509,
 515,
+520,
+521,
 518,
-513,
 516,
-509,
-512,
+519,
+514,
+517,
 510,
+513,
 511,
-526,
-532,
-537,
-538,
-535,
+512,
+527,
 533,
+538,
+539,
 536,
-531,
 534,
-527,
-530,
+537,
+532,
+535,
 528,
+531,
 529,
-544,
-550,
-555,
-556,
-553,
+530,
+545,
 551,
+556,
+557,
 554,
-549,
 552,
-545,
-548,
+555,
+550,
+553,
 546,
+549,
 547,
-562,
-568,
-573,
-574,
-571,
+548,
+563,
 569,
+574,
+575,
 572,
-567,
 570,
-563,
-566,
+573,
+568,
+571,
 564,
+567,
 565,
-580,
-586,
-591,
-592,
-589,
+566,
+581,
 587,
+592,
+593,
 590,
-585,
 588,
-581,
-584,
+591,
+586,
+589,
 582,
+585,
 583,
-598,
-604,
-609,
-610,
-607,
+584,
+599,
 605,
+610,
+611,
 608,
-603,
 606,
-599,
-602,
+609,
+604,
+607,
 600,
+603,
 601,
-130,
-136,
-141,
-142,
-139,
+602,
+131,
 137,
+142,
+143,
 140,
-135,
 138,
-131,
-134,
+141,
+136,
+139,
 132,
+135,
 133,
-616,
-622,
-627,
-628,
-625,
+134,
+617,
 623,
+628,
+629,
 626,
-621,
 624,
-617,
-620,
+627,
+622,
+625,
 618,
+621,
 619,
-634,
-640,
-645,
-646,
-643,
+620,
+635,
 641,
+646,
+647,
 644,
-639,
 642,
-635,
-638,
+645,
+640,
+643,
 636,
+639,
 637,
-148,
-154,
-159,
-160,
-157,
+638,
+149,
 155,
+160,
+161,
 158,
-153,
 156,
-149,
-152,
+159,
+154,
+157,
 150,
+153,
 151,
-166,
-172,
-177,
-178,
-175,
+152,
+167,
 173,
+178,
+179,
 176,
-171,
 174,
-167,
-170,
+177,
+172,
+175,
 168,
+171,
 169,
-184,
-190,
-195,
-196,
-193,
+170,
+185,
 191,
+196,
+197,
 194,
-189,
 192,
-185,
-188,
+195,
+190,
+193,
 186,
+189,
 187,
-202,
-208,
-213,
-214,
-211,
+188,
+203,
 209,
+214,
+215,
 212,
-207,
 210,
-203,
-206,
+213,
+208,
+211,
 204,
+207,
 205,
-220,
-226,
-231,
-232,
-229,
+206,
+221,
 227,
+232,
+233,
 230,
-225,
 228,
-221,
-224,
+231,
+226,
+229,
 222,
+225,
 223,
-238,
-244,
-249,
-250,
-247,
+224,
+239,
 245,
+250,
+251,
 248,
-243,
 246,
-239,
-242,
+249,
+244,
+247,
 240,
+243,
 241,
+242,
 1,
 3,
 21,

compiler/aarch64/ra64sta.inc

@@ -70,6 +70,7 @@
 0,
 0,
 0,
+0,
 64,
 64,
 64,

compiler/aarch64/ra64std.inc

@@ -70,6 +70,7 @@
 'fpcr',
 'fpsr',
 'tpidr_el0',
+'mpidr_el1',
 'b0',
 'h0',
 's0',

compiler/aarch64/ra64sup.inc

@@ -70,6 +70,7 @@ RS_NZCV = $00;
 RS_FPCR = $01;
 RS_FPSR = $02;
 RS_TPIDR_EL0 = $03;
+RS_MPIDR_EL1 = $04;
 RS_B0 = $00;
 RS_H0 = $00;
 RS_S0 = $00;

compiler/aggas.pas

@@ -221,11 +221,11 @@ implementation
 { vtable for a class called Window:                                       }
 { .section .data.rel.ro._ZTV6Window,"awG",@progbits,_ZTV6Window,comdat    }
 { TODO: .data.ro not yet working}
-{$if defined(arm) or defined(riscv64) or defined(powerpc) or defined(x86_64)}
+{$if defined(arm) or defined(aarch64) or defined(riscv64) or defined(powerpc) or defined(x86_64)}
           '.rodata',
-{$else defined(arm) or defined(riscv64) or defined(powerpc) or defined(x86_64)}
+{$else defined(arm) or defined(aarch64) or defined(riscv64) or defined(powerpc) or defined(x86_64)}
           '.data',
-{$endif defined(arm) or defined(riscv64) or defined(powerpc) or defined(x86_64)}
+{$endif defined(arm) or defined(aarch64) or defined(riscv64) or defined(powerpc) or defined(x86_64)}
           '.rodata',
           '.bss',
           '.threadvar',

compiler/aoptobj.pas

@@ -1369,24 +1369,29 @@ Unit AoptObj;
            (ptaiprop(p1.optinfo)^.usedregs <> initialusedregs) then
          internalerror(2004101010); }
 {$endif EXTDEBUG}
+        if not Assigned(p2) then
+          { We need a valid final instruction }
+          InternalError(2022010401);
+
         start := p1;
-       if (reg = NR_STACK_POINTER_REG) or
+        if (reg = NR_STACK_POINTER_REG) or
           (reg = current_procinfo.framepointer) or
            not(assigned(p1)) then
           { this happens with registers which are loaded implicitely, outside the }
           { current block (e.g. esi with self)                                    }
           exit;
+
+{$ifdef allocregdebug}
+        insertllitem(p1.previous,p1,tai_comment.Create(strpnew('allocating '+std_regname(reg)+' from here...')));
+        insertllitem(p2,p2.next,tai_comment.Create(strpnew('allocated '+std_regname(reg)+' till here...')));
+{$endif allocregdebug}
+
         { make sure we allocate it for this instruction }
         getnextinstruction(p2,p2);
         lastRemovedWasDealloc := false;
         removedSomething := false;
         firstRemovedWasAlloc := false;
-{$ifdef allocregdebug}
-        hp := tai_comment.Create(strpnew('allocating '+std_regname(reg)+' from here...'));
-        insertllitem(p1.previous,p1,hp);
-        hp := tai_comment.Create(strpnew('allocated '+std_regname(reg)+' till here...'));
-        insertllitem(p2,p2.next,hp);
-{$endif allocregdebug}
+
         { do it the safe way: always allocate the full super register,
           as we do no register re-allocation in the peephole optimizer,
           this does not hurt

compiler/arm/armreg.dat

@@ -38,7 +38,7 @@ F7,$02,$00,$07,f7,32,23
 ; 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 
+; Nevertheless the odd numbered single registers must have separate register
 ; numbers to allow implementation of the "EABI VFP hardfloat" calling convention.
 
 S0,$04,$06,$00,s0,0,0

compiler/arm/cgcpu.pas

@@ -3301,7 +3301,7 @@ unit cgcpu;
           end
         else
           handle_load_store(list,A_VSTR,PF_None,tmpmmreg,ref);
-        { VSTR cannot generate an FPU exception, VCVT is handled seperately, so we do not need a check here }
+        { VSTR cannot generate an FPU exception, VCVT is handled separately, so we do not need a check here }
       end;
 
 

compiler/armgen/aoptarm.pas

@@ -1004,6 +1004,36 @@ Implementation
           p:=hp1;
           result:=true;
         end
+{$ifdef AARCH64}
+      {
+        change
+        sxth reg2,reg1
+        sxtw reg3,reg2
+        dealloc reg2
+        to
+        sxth reg3,reg1
+      }
+      else if MatchInstruction(p, A_SXTH, [C_None], [PF_None]) and
+        (taicpu(p).ops=2) and
+        GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_SXTW, [C_None], [PF_None]) and
+        (taicpu(hp1).ops=2) and
+        MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
+        RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
+        { reg1 might not be modified inbetween }
+        not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+        begin
+          DebugMsg('Peephole SxthSxtw2Sxth done', p);
+          AllocRegBetween(taicpu(p).oper[1]^.reg,p,hp1,UsedRegs);
+          taicpu(hp1).opcode:=A_SXTH;
+          taicpu(hp1).loadReg(1,taicpu(p).oper[1]^.reg);
+          GetNextInstruction(p, hp1);
+          asml.remove(p);
+          p.free;
+          p:=hp1;
+          result:=true;
+        end
+ {$endif AARCH64}
       {
         change
         sxth reg2,reg1

compiler/cclasses.pas

@@ -86,14 +86,14 @@ type
     procedure Put(Index: Integer; Item: Pointer);
     procedure SetCapacity(NewCapacity: Integer);
     procedure SetCount(NewCount: Integer);
-    Procedure RaiseIndexError(Index : Integer);noreturn;
+    Procedure RaiseIndexError(Index : Integer);
     property List: PPointerList read FList;
   public
     destructor Destroy; override;
     function Add(Item: Pointer): Integer;
     procedure Clear;
     procedure Delete(Index: Integer);
-    class procedure Error(const Msg: string; Data: PtrInt);noreturn;
+    class procedure Error(const Msg: string; Data: PtrInt);
     procedure Exchange(Index1, Index2: Integer);
     function Expand: TFPList;
     function Extract(item: Pointer): Pointer;
@@ -225,7 +225,7 @@ type
     function HashOfIndex(Index: Integer): LongWord;
     function GetNextCollision(Index: Integer): Integer;
     procedure Delete(Index: Integer);
-    class procedure Error(const Msg: string; Data: PtrInt);noreturn;
+    class procedure Error(const Msg: string; Data: PtrInt);
     function Expand: TFPHashList;
     function Extract(item: Pointer): Pointer;
     function IndexOf(Item: Pointer): Integer;
@@ -488,7 +488,7 @@ type
        PHashSetItem = ^THashSetItem;
        THashSetItem = record
          Next: PHashSetItem;
-         Key: Pointer;
+         Key: Pointer; { With FOwnKeys, item and its key are allocated at once, and Key points inside. }
          KeyLength: Integer;
          HashValue: LongWord;
          Data: TObject;
@@ -507,6 +507,7 @@ type
          FBucketCount: LongWord;
          class procedure FreeItem(item:PHashSetItem); virtual;
          class function SizeOfItem: Integer; virtual;
+         function CreateItem(Key: Pointer; KeyLen: Integer; HashValue: LongWord): PHashSetItem;
        public
          constructor Create(InitSize: Integer; OwnKeys, OwnObjects: Boolean);
          destructor Destroy; override;
@@ -531,11 +532,7 @@ type
        PPTagHashSetItem = ^PTagHashSetItem;
        PTagHashSetItem = ^TTagHashSetItem;
        TTagHashSetItem = record
-         Next: PTagHashSetItem;
-         Key: Pointer;
-         KeyLength: Integer;
-         HashValue: LongWord;
-         Data: TObject;
+         Item: THashSetItem;
          Tag: LongWord;
        end;
 
@@ -544,7 +541,6 @@ type
          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 }
@@ -716,7 +712,7 @@ implementation
                TFPObjectList (Copied from rtl/objpas/classes/lists.inc)
 *****************************************************************************}
 
-procedure TFPList.RaiseIndexError(Index : Integer);noreturn;
+procedure TFPList.RaiseIndexError(Index : Integer);
 begin
   Error(SListIndexError, Index);
 end;
@@ -812,7 +808,7 @@ begin
   end;
 end;
 
-class procedure TFPList.Error(const Msg: string; Data: PtrInt);noreturn;
+class procedure TFPList.Error(const Msg: string; Data: PtrInt);
 begin
   Raise EListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame), get_caller_frame(get_frame);
 end;
@@ -1568,7 +1564,7 @@ begin
     Self.Delete(Result);
 end;
 
-class procedure TFPHashList.Error(const Msg: string; Data: PtrInt);noreturn;
+class procedure TFPHashList.Error(const Msg: string; Data: PtrInt);
 begin
   Raise EListError.CreateFmt(Msg,[Data])  at get_caller_addr(get_frame), get_caller_frame(get_frame);
 end;
@@ -2943,8 +2939,6 @@ end;
             next := item^.Next;
             if FOwnsObjects then
               item^.Data.Free;
-            if FOwnsKeys then
-              FreeMem(item^.Key);
             FreeItem(item);
             item := next;
           end;
@@ -2992,19 +2986,24 @@ end;
     function THashSet.Lookup(Key: Pointer; KeyLen: Integer;
       var Found: Boolean; CanCreate: Boolean): PHashSetItem;
       var
-        Entry: PPHashSetItem;
+        EntryPtr: PPHashSetItem;
+        Entry: PHashSetItem;
         h: LongWord;
       begin
         h := FPHash(Key, KeyLen);
-        Entry := @FBucket[h and (FBucketCount-1)];
-        while Assigned(Entry^) and
-          not ((Entry^^.HashValue = h) and (Entry^^.KeyLength = KeyLen) and
-            (CompareByte(Entry^^.Key^, Key^, KeyLen) = 0)) do
-              Entry := @Entry^^.Next;
-        Found := Assigned(Entry^);
+        EntryPtr := @FBucket[h and (FBucketCount-1)];
+        Entry := EntryPtr^;
+        while Assigned(Entry) and
+          not ((Entry^.HashValue = h) and (Entry^.KeyLength = KeyLen) and
+            (CompareByte(Entry^.Key^, Key^, KeyLen) = 0)) do
+              begin
+                EntryPtr := @Entry^.Next;
+                Entry := EntryPtr^;
+              end;
+        Found := Assigned(Entry);
         if Found or (not CanCreate) then
           begin
-            Result := Entry^;
+            Result := Entry;
             Exit;
           end;
         if FCount > FBucketCount then  { arbitrary limit, probably too high }
@@ -3015,20 +3014,9 @@ end;
           end
         else
           begin
-            GetMem(Result,SizeOfItem);
-            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^.Data := nil;
-            Result^.Next := nil;
+            Result := CreateItem(Key, KeyLen, h);
             Inc(FCount);
-            Entry^ := Result;
+            EntryPtr^ := Result;
           end;
         end;
 
@@ -3067,6 +3055,29 @@ end;
         Result := SizeOf(THashSetItem);
       end;
 
+    function THashSet.CreateItem(Key: Pointer; KeyLen: Integer; HashValue: LongWord): PHashSetItem;
+      var
+        itemSize, keyOfs: SizeUint;
+      begin
+        itemSize := SizeOfItem;
+        if FOwnsKeys then
+          begin
+            keyOfs := itemSize;
+            Result := GetMem(keyOfs + SizeUint(KeyLen));
+            Result^.Key := Pointer(Result) + keyOfs;
+            Move(Key^, Result^.Key^, KeyLen);
+          end
+        else
+          begin
+            Result := GetMem(itemSize);
+            Result^.Key := Key;
+          end;
+        Result^.Next := nil;
+        Result^.KeyLength := KeyLen;
+        Result^.HashValue := HashValue;
+        Result^.Data := nil;
+      end;
+
     function THashSet.Remove(Entry: PHashSetItem): Boolean;
       var
         chain: PPHashSetItem;
@@ -3079,8 +3090,6 @@ end;
                 chain^ := Entry^.Next;
                 if FOwnsObjects then
                   Entry^.Data.Free;
-                if FOwnsKeys then
-                  FreeMem(Entry^.Key);
                 FreeItem(Entry);
                 Dec(FCount);
                 Result := True;
@@ -3099,19 +3108,24 @@ end;
     function TTagHashSet.Lookup(Key: Pointer; KeyLen: Integer;
       Tag: LongWord; var Found: Boolean; CanCreate: Boolean): PTagHashSetItem;
       var
-        Entry: PPTagHashSetItem;
+        EntryPtr: PPTagHashSetItem;
+        Entry: PTagHashSetItem;
         h: LongWord;
       begin
         h := FPHash(Key, KeyLen, Tag);
-        Entry := @PPTagHashSetItem(FBucket)[h and (FBucketCount-1)];
-        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^);
+        EntryPtr := @PPTagHashSetItem(FBucket)[h and (FBucketCount-1)];
+        Entry := EntryPtr^;
+        while Assigned(Entry) and
+          not ((Entry^.Item.HashValue = h) and (Entry^.Item.KeyLength = KeyLen) and
+            (Entry^.Tag = Tag) and (CompareByte(Entry^.Item.Key^, Key^, KeyLen) = 0)) do
+              begin
+                EntryPtr := @Entry^.Item.Next;
+                Entry := EntryPtr^;
+              end;
+        Found := Assigned(Entry);
         if Found or (not CanCreate) then
           begin
-            Result := Entry^;
+            Result := Entry;
             Exit;
           end;
         if FCount > FBucketCount then  { arbitrary limit, probably too high }
@@ -3122,29 +3136,13 @@ end;
           end
         else
           begin
-            Getmem(Result,SizeOfItem);
-            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 := PTagHashSetItem(CreateItem(Key, KeyLen, h));
             Result^.Tag := Tag;
-            Result^.Data := nil;
-            Result^.Next := nil;
             Inc(FCount);
-            Entry^ := Result;
+            EntryPtr^ := Result;
           end;
       end;
 
-    class procedure TTagHashSet.FreeItem(item: PHashSetItem);
-      begin
-        Dispose(PTagHashSetItem(item));
-      end;
-
     class function TTagHashSet.SizeOfItem: Integer;
       begin
         Result := SizeOf(TTagHashSetItem);
@@ -3177,7 +3175,7 @@ end;
       begin
         e := Lookup(Key, KeyLen, Tag, Dummy, False);
         if Assigned(e) then
-          Result := e^.Data
+          Result := e^.Item.Data
         else
           Result := nil;
       end;

compiler/cgobj.pas

@@ -2732,17 +2732,22 @@ implementation
                   end;
                 include(rg[R_INTREGISTER].preserved_by_proc,regs_to_save_int[r]);
               end;
+            current_procinfo.saved_regs_int := rg[R_INTREGISTER].preserved_by_proc;
 
             if uses_registers(R_ADDRESSREGISTER) then
-              for r:=low(regs_to_save_address) to high(regs_to_save_address) do
-                begin
-                  if regs_to_save_address[r] in rg[R_ADDRESSREGISTER].used_in_proc then
-                    begin
-                      a_load_reg_ref(list,OS_ADDR,OS_ADDR,newreg(R_ADDRESSREGISTER,regs_to_save_address[r],R_SUBWHOLE),href);
-                      inc(href.offset,sizeof(aint));
-                    end;
-                  include(rg[R_ADDRESSREGISTER].preserved_by_proc,regs_to_save_address[r]);
-                end;
+              begin
+                for r:=low(regs_to_save_address) to high(regs_to_save_address) do
+                  begin
+                    if regs_to_save_address[r] in rg[R_ADDRESSREGISTER].used_in_proc then
+                      begin
+                        a_load_reg_ref(list,OS_ADDR,OS_ADDR,newreg(R_ADDRESSREGISTER,regs_to_save_address[r],R_SUBWHOLE),href);
+                        inc(href.offset,sizeof(aint));
+                      end;
+                    include(rg[R_ADDRESSREGISTER].preserved_by_proc,regs_to_save_address[r]);
+                  end;
+
+                current_procinfo.saved_regs_mm := rg[R_MMREGISTER].preserved_by_proc;
+              end;
 
             if uses_registers(R_MMREGISTER) then
               begin
@@ -2765,6 +2770,8 @@ implementation
                         include(rg[R_MMREGISTER].preserved_by_proc,regs_to_save_mm[r]);
                       end;
                   end;
+
+                current_procinfo.saved_regs_mm := rg[R_MMREGISTER].preserved_by_proc;
               end;
           end;
       end;

compiler/cgutils.pas

@@ -218,6 +218,12 @@ unit cgutils;
     procedure calc_divconst_magic_signed(N: byte; d: aInt; out magic_m: aInt; out magic_s: byte);
     procedure calc_divconst_magic_unsigned(N: byte; d: aWord; out magic_m: aWord; out magic_add: boolean; out magic_shift: byte);
 
+    { Functions for calculating the multiplicative inverse, or reciprocal, of
+      a divisor mod 2^N.  That is, a number r such that dr = 1 (mod 2^N).
+
+      WARNING: d must not be a power of 2 (including 2^0 = 1) }
+    procedure calc_mul_inverse(N: byte; d: aWord; out reciprocal: aWord; out shift: Byte);
+
 implementation
 
 uses
@@ -491,6 +497,67 @@ uses
         magic_m:=(q2+1) and mask;        { resulting magic number }
         magic_shift:=p-N;     { resulting shift }
       end;
+
+
+    procedure calc_mul_inverse(N: byte; d: aWord; out reciprocal: aWord; out shift: Byte);
+      var
+        mask, oldr, newd, swap_r, swap_d, q: aWord;
+      begin
+        { WARNING: d must not be a power of 2 (including 2^0 = 1) }
+{$push}
+{$warnings off }
+        if N=(SizeOf(aWord) * 8) then
+          newd:=0
+        else
+          newd:=aWord(1) shl N; { Used later }
+        mask:=newd-1;
+        oldr:=mask;
+{$pop}
+
+        { Trim off powers of 2 so d is an odd number }
+{$if defined(cpu64bitalu)}
+        shift:=BsfQWord(d);
+{$elseif defined(cpu32bitalu)}
+        shift:=BsfDWord(d);
+{$elseif defined(cpu16bitalu)}
+        shift:=BsfWord(d);
+{$elseif defined(cpu8bitalu)}
+        shift:=BsfByte(d);
+{$else}
+{$error ALU not defined}
+{$endif}
+        if shift = 255 then
+          { This is a divide by zero that should have been caught earlier }
+          InternalError(2021091001);
+
+        d := d shr shift;
+
+        { Calculate reciprocal using the Extended Euclidean Algorithm as
+          described on page 244 of Hacker's Delight, Second Edition.
+
+          x1 = oldr
+          x2 = reciprocal
+          x3 = swap_r
+
+          v1 = newd
+          v2 = d
+          v3 = swap_d
+        }
+        newd:=newd-d; { -d }
+        reciprocal:=1;
+
+        repeat
+          q := newd div d;
+
+          swap_d:=(newd-(q*d)) and mask;
+          newd:=d;
+          d:=swap_d;
+
+          swap_r:=(oldr-(q*reciprocal)) and mask;
+          oldr:=reciprocal;
+          reciprocal:=swap_r;
+        until d<=1;
+      end;
 {$pop}
 
 end.

compiler/compiler.pas

@@ -128,6 +128,9 @@ uses
 {$ifdef solaris}
   ,i_sunos
 {$endif solaris}
+{$ifdef sinclairql}
+  ,i_sinclairql
+{$endif sinclairql}
 {$ifdef wdosx}
   ,i_wdosx
 {$endif wdosx}

compiler/constexp.pas

@@ -26,6 +26,9 @@ unit constexp;
 
 interface
 
+  uses
+    sfpux80;
+
 type  Tconstexprint=record
         overflow:boolean;
         case signed:boolean of
@@ -37,6 +40,8 @@ type  Tconstexprint=record
 
       errorproc=procedure (i:longint);
 
+      TConstExprFloat = float128;
+
 {"Uses verbose" gives a dependency on cpuinfo through globals. This leads
  build trouble when compiling the directory utils, since the cpu directory
  isn't searched there. Therefore we use a procvar and make verbose install

compiler/dbgdwarf.pas

@@ -377,7 +377,7 @@ interface
         procedure append_entry(tag : tdwarf_tag;has_children : boolean;data : array of const);
         procedure append_block1(attr: tdwarf_attribute; size: aint);
         procedure append_labelentry(attr : tdwarf_attribute;sym : tasmsymbol);
-        procedure append_labelentry_addr_ref(attr : tdwarf_attribute;sym : tasmsymbol); virtual;
+        procedure append_labelentry_addr_ref(sym : tasmsymbol); virtual;
         procedure append_labelentry_ref(attr : tdwarf_attribute;sym : tasmsymbol);
         procedure append_labelentry_dataptr_abs(attr : tdwarf_attribute;sym : tasmsymbol);
         procedure append_labelentry_dataptr_rel(attr : tdwarf_attribute;sym,endsym : tasmsymbol);
@@ -462,7 +462,7 @@ interface
       TDebugInfoDwarf3 = class(TDebugInfoDwarf2)
       private
       protected
-        procedure append_labelentry_addr_ref(attr : tdwarf_attribute;sym : tasmsymbol); override;
+        procedure append_labelentry_addr_ref(sym : tasmsymbol); override;
         procedure appenddef_array(list:TAsmList;def:tarraydef); override;
         procedure appenddef_string(list:TAsmList;def:tstringdef);override;
         procedure appenddef_file(list:TAsmList;def:tfiledef); override;
@@ -1336,7 +1336,7 @@ implementation
         current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(aitconst_ptr_unaligned,sym));
       end;
 
-    procedure TDebugInfoDwarf.append_labelentry_addr_ref(attr : tdwarf_attribute;sym : tasmsymbol);
+    procedure TDebugInfoDwarf.append_labelentry_addr_ref(sym : tasmsymbol);
       begin
         AddConstToAbbrev(ord(DW_FORM_ref_addr));
 {$ifdef i8086}
@@ -1351,10 +1351,13 @@ implementation
       begin
         AddConstToAbbrev(ord(attr));
         if not(tf_dwarf_only_local_labels in target_info.flags) then
-          append_labelentry_addr_ref(attr, sym)
+          append_labelentry_addr_ref(sym)
         else
           begin
-            AddConstToAbbrev(ord(DW_FORM_ref4));
+            if use_64bit_headers then
+              AddConstToAbbrev(ord(DW_FORM_ref8))
+            else
+              AddConstToAbbrev(ord(DW_FORM_ref4));
             current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_info0',AB_LOCAL,AT_METADATA,voidpointertype),sym));
           end;
       end;
@@ -4238,7 +4241,7 @@ implementation
                               TDebugInfoDwarf3
 ****************************************************************************}
 
-    procedure TDebugInfoDwarf3.append_labelentry_addr_ref(attr : tdwarf_attribute;sym : tasmsymbol);
+    procedure TDebugInfoDwarf3.append_labelentry_addr_ref(sym : tasmsymbol);
       begin
         AddConstToAbbrev(ord(DW_FORM_ref_addr));
         { Since Dwarf 3 the length of a DW_FORM_ref_addr entry is not dependent on the pointer size of the

compiler/entfile.pas

@@ -161,7 +161,9 @@ const
     { 19 } 32 {'riscv32'},
     { 20 } 64 {'riscv64'},
     { 21 } 32 {'xtensa'},
-    { 22 } 16 {'z80'}
+    { 22 } 16 {'z80'},
+    { 23 } 64 {'mips64'},
+    { 24 } 64 {'mips64el'}
     );
   CpuAluBitSize : array[tsystemcpu] of longint =
     (
@@ -187,7 +189,9 @@ const
     { 19 } 32 {'riscv32'},
     { 20 } 64 {'riscv64'},
     { 21 } 32 {'xtensa'},
-    { 22 }  8 {'z80'}
+    { 22 }  8 {'z80'},
+    { 23 } 64 {'mips64'},
+    { 24 } 64 {'mips64el'}
     );
 {$endif generic_cpu}
 

compiler/fpcdefs.inc

@@ -15,6 +15,11 @@
   exceptions in the constructors }
 {$IMPLICITEXCEPTIONS OFF}
 
+{ We don't want the compiler to use fastmath
+  optimization because it considers negative zeroes
+  as normal zeroes }
+{$OPTIMIZATION NOFASTMATH}
+
 { We don't want C operators to be used inside the compiler }
 {$COPERATORS OFF}
 
@@ -257,21 +262,29 @@
 
 {$ifdef mipsel}
   {$define mips}
+  {$define mips32}
 {$else not mipsel}
   { Define both mips and mipseb if mipsel is not defined
     but mips cpu is wanted. }
   {$ifdef mipseb}
     {$define mips}
+    {$define mips32}
   {$endif mipseb}
   {$ifdef mips}
     {$define mipseb}
+    {$define mips32}
   {$endif mips}
 {$endif mipsel}
 
+{$ifdef mips64}
+  {$define mips}
+  {$define mips64}
+{$endif mips64}
+
 {$ifdef mips64el}
   {$define mips}
   {$define mips64}
-{$endif mipsel}
+{$endif mips64el}
 
 {$ifdef mips}
   {$ifndef mips64}

compiler/globals.pas

@@ -55,7 +55,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,
-          m_array_operators,m_prefixed_attributes];
+          m_array_operators,m_prefixed_attributes,m_underscoreisseparator];
        delphiunicodemodeswitches = delphimodeswitches + [m_systemcodepage,m_default_unicodestring];
        fpcmodeswitches =
          [m_fpc,m_string_pchar,m_nested_comment,m_repeat_forward,
@@ -306,7 +306,7 @@ interface
        exepath       : TPathStr;
        { Path to unicode charmap/collation binaries }
        unicodepath   : TPathStr;
-       { path for searching units, different paths can be seperated by ; }
+       { path for searching units, different paths can be separated by ; }
        librarysearchpath,
        unitsearchpath,
        objectsearchpath,
@@ -416,6 +416,10 @@ interface
        palmos_applicationid : string[4] = 'FPCA';
 {$endif defined(m68k) or defined(arm)}
 {$if defined(m68k)}
+       { Atari Specific }
+       ataritos_exe_flags: dword = 7;
+       ataritos_exe_format: string = 'ataritos';
+
        { Sinclair QL specific }
        sinclairql_metadata_format: string[4] = 'QHDR';
        sinclairql_vlink_experimental: boolean = true; { temporary }
@@ -537,10 +541,17 @@ interface
         fputype : fpu_none;
   {$endif avr}
   {$ifdef mips}
+  {$ifdef mips64}
+        cputype : cpu_mips3;
+        optimizecputype : cpu_mips3;
+        asmcputype : cpu_none;
+        fputype : fpu_mips3;
+  {$else mips64}
         cputype : cpu_mips2;
         optimizecputype : cpu_mips2;
         asmcputype : cpu_none;
         fputype : fpu_mips2;
+  {$endif mips64}
   {$endif mips}
   {$ifdef jvm}
         cputype : cpu_none;

compiler/globtype.pas

@@ -527,7 +527,8 @@ interface
          m_array_operators,     { use Delphi compatible array operators instead of custom ones ("+") }
          m_multi_helpers,       { helpers can appear in multiple scopes simultaneously }
          m_array2dynarray,      { regular arrays can be implicitly converted to dynamic arrays }
-         m_prefixed_attributes  { enable attributes that are defined before the type they belong to }
+         m_prefixed_attributes, { enable attributes that are defined before the type they belong to }
+         m_underscoreisseparator{ _ can be used as separator to group digits in numbers }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -678,7 +679,7 @@ interface
 
        cstylearrayofconst = [pocall_cdecl,pocall_cppdecl,pocall_mwpascal,pocall_sysv_abi_cdecl,pocall_ms_abi_cdecl];
 
-       modeswitchstr : array[tmodeswitch] of string[18] = ('',
+       modeswitchstr : array[tmodeswitch] of string[21] = ('',
          '','','','','','','',
          {$ifdef gpc_mode}'',{$endif}
          { more specific }
@@ -719,7 +720,8 @@ interface
          'ARRAYOPERATORS',
          'MULTIHELPERS',
          'ARRAYTODYNARRAY',
-         'PREFIXEDATTRIBUTES'
+         'PREFIXEDATTRIBUTES',
+         'UNDERSCOREISSEPARATOR'
          );
 
 

compiler/hlcgobj.pas

@@ -5478,7 +5478,7 @@ implementation
     begin
       pd:=search_system_proc('fpc_stackcheck');
       paraloc1.init;
-      { The parameter to fpc_stackcheck is loaded seperately via
+      { The parameter to fpc_stackcheck is loaded separately via
         gen_stack_check_size_para() }
       paramanager.getcgtempparaloc(list,pd,1,paraloc1);
       paramanager.freecgpara(list,paraloc1);

compiler/i386/i386prop.inc

@@ -389,7 +389,7 @@
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
-(Ch: [Ch_ROp1, Ch_WOp2, Ch_RFLAGScc]),
+(Ch: [Ch_ROp1, Ch_MOp2, Ch_RFLAGScc]),
 (Ch: [Ch_RFLAGScc]),
 (Ch: [Ch_RFLAGScc, Ch_WOp1]),
 (Ch: [Ch_RWESI, Ch_WMemEDI, Ch_RWEDI, Ch_RDirFlag]),

compiler/i8086/i8086prop.inc

@@ -389,7 +389,7 @@
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
-(Ch: [Ch_ROp1, Ch_WOp2, Ch_RFLAGScc]),
+(Ch: [Ch_ROp1, Ch_MOp2, Ch_RFLAGScc]),
 (Ch: [Ch_RFLAGScc]),
 (Ch: [Ch_RFLAGScc, Ch_WOp1]),
 (Ch: [Ch_RWESI, Ch_WMemEDI, Ch_RWEDI, Ch_RDirFlag]),

compiler/jvm/rgcpu.pas

@@ -362,45 +362,49 @@ implementation
               ait_regalloc:
                 with Tai_regalloc(p) do
                   begin
-                    case getregtype(reg) of
-                      R_INTREGISTER:
-                        if getsubreg(reg)=R_SUBD then
-                          size:=4
-                        else
-                          size:=8;
-                      R_ADDRESSREGISTER:
-                        size:=4;
-                      R_FPUREGISTER:
-                        if getsubreg(reg)=R_SUBFS then
-                          size:=4
-                        else
-                          size:=8;
-                      else
-                        internalerror(2010122912);
-                    end;
-                    case ratype of
-                      ra_alloc :
-                        tg.gettemp(templist,
-                                   size,1,
-                                   tt_regallocator,spill_temps[getregtype(reg)]^[getsupreg(reg)]);
-                      ra_dealloc :
-                        begin
-                          tg.ungettemp(templist,spill_temps[getregtype(reg)]^[getsupreg(reg)]);
-                          { don't invalidate the temp reference, may still be used one instruction
-                            later }
+                    { NR_DEFAULTFLAGS is NR_NO for JVM CPU }
+                    if (reg<>NR_DEFAULTFLAGS) then
+                      begin
+                        case getregtype(reg) of
+                          R_INTREGISTER:
+                            if getsubreg(reg)=R_SUBD then
+                              size:=4
+                            else
+                              size:=8;
+                          R_ADDRESSREGISTER:
+                            size:=4;
+                          R_FPUREGISTER:
+                            if getsubreg(reg)=R_SUBFS then
+                              size:=4
+                            else
+                              size:=8;
+                          else
+                            internalerror(2010122912);
+                        end;
+                        case ratype of
+                          ra_alloc :
+                            tg.gettemp(templist,
+                                       size,1,
+                                       tt_regallocator,spill_temps[getregtype(reg)]^[getsupreg(reg)]);
+                          ra_dealloc :
+                            begin
+                              tg.ungettemp(templist,spill_temps[getregtype(reg)]^[getsupreg(reg)]);
+                              { don't invalidate the temp reference, may still be used one instruction
+                                later }
+                            end;
+                          else
+                            ;
                         end;
-                      else
-                        ;
-                    end;
-                    { insert the tempallocation/free at the right place }
-                    list.insertlistbefore(p,templist);
-                    { remove the register allocation info for the register
-                      (p.previous is valid because we just inserted the temp
-                       allocation/free before p) }
-                    q:=Tai(p.previous);
-                    list.remove(p);
-                    p.free;
-                    p:=q;
+                        { insert the tempallocation/free at the right place }
+                        list.insertlistbefore(p,templist);
+                        { remove the register allocation info for the register
+                          (p.previous is valid because we just inserted the temp
+                           allocation/free before p) }
+                        q:=Tai(p.previous);
+                        list.remove(p);
+                        p.free;
+                        p:=q;
+                      end;
                   end;
               ait_instruction:
                 do_spill_replace_all(list,taicpu(p),spill_temps);

compiler/mips/cgcpu.pas

@@ -481,6 +481,9 @@ begin
     OS_32,
     OS_S32:
       Op := A_SW;
+    OS_64,
+    OS_S64:
+      Op := A_SD;
     else
       InternalError(2002122100);
   end;
@@ -1597,12 +1600,14 @@ begin
     if Count > 0 then
     begin
       tmpreg1 := GetIntRegister(list, OS_INT);
-      for count2 := 1 to Count do
+      count2:=1;
+      while count2 <= Count do
       begin
         list.concat(taicpu.op_reg_ref(A_LW, tmpreg1, src));
         list.concat(taicpu.op_reg_ref(A_SW, tmpreg1, dst));
         Inc(src.offset, 4);
         Inc(dst.offset, 4);
+	Inc(count2);
       end;
       len := len mod 4;
     end;
@@ -1674,12 +1679,14 @@ begin
     begin
       { unrolled loop }
       tmpreg1 := GetIntRegister(list, OS_INT);
-      for i := 1 to len do
+      i:=1;
+      while i <= len do
       begin
         list.concat(taicpu.op_reg_ref(A_LBU, tmpreg1, src));
         list.concat(taicpu.op_reg_ref(A_SB, tmpreg1, dst));
         Inc(src.offset);
         Inc(dst.offset);
+	Inc(i);
       end;
     end;
   end;

compiler/mips/ncpuadd.pas

@@ -34,22 +34,28 @@ type
 
   tmipsaddnode = class(tcgaddnode)
   private
+{$ifdef cpu32bit}
     procedure cmp64_lt(left_reg, right_reg: TRegister64;unsigned:boolean);
     procedure cmp64_le(left_reg, right_reg: TRegister64;unsigned:boolean);
-    procedure second_generic_cmp32(unsigned,is_smallset: boolean);
     procedure second_mul64bit;
+{$endif cpu32bit}
+    procedure second_generic_cmp32(unsigned,is_smallset: boolean);
   protected
     procedure second_addfloat; override;
     procedure second_cmpfloat; override;
     procedure second_cmpboolean; override;
     procedure second_cmpsmallset; override;
+{$ifdef cpu32bit}
     procedure second_add64bit; override;
     procedure second_cmp64bit; override;
+{$endif cpu32bit}
     procedure second_cmpordinal; override;
     procedure second_addordinal; override;
+{$ifdef cpu32bit}
   public
     function use_generic_mul32to64: boolean; override;
     function use_generic_mul64bit: boolean; override;
+{$endif cpu32bit}
   end;
 
 implementation
@@ -107,6 +113,7 @@ begin
 end;
 
 
+{$ifdef cpu32bit}
 procedure tmipsaddnode.second_add64bit;
 begin
   if (nodetype=muln) then
@@ -114,11 +121,13 @@ begin
   else
     inherited second_add64bit;
 end;
+{$endif cpu32bit}
 
 
 const
   cmpops: array[boolean] of TOpCmp = (OC_LT,OC_B);
 
+{$ifdef cpu32bit}
 procedure tmipsaddnode.cmp64_lt(left_reg, right_reg: TRegister64;unsigned: boolean);
 begin
   cg.a_cmp_reg_reg_label(current_asmdata.CurrAsmList,OS_INT,cmpops[unsigned],right_reg.reghi,left_reg.reghi,location.truelabel);
@@ -217,6 +226,7 @@ begin
       end;
   end;
 end;
+{$endif cpu32bit}
 
 
 procedure tmipsaddnode.second_addfloat;
@@ -343,6 +353,7 @@ procedure tmipsaddnode.second_addordinal;
 var
   unsigned: boolean;
 begin
+{$ifdef cpu32bit}
   unsigned:=not(is_signed(left.resultdef)) or
             not(is_signed(right.resultdef));
   if (nodetype=muln) and is_64bit(resultdef) then
@@ -357,9 +368,11 @@ begin
       current_asmdata.CurrAsmList.Concat(taicpu.op_reg(A_MFHI,location.register64.reghi));
     end
   else
+{$endif cpu32bit}
     inherited second_addordinal;
 end;
 
+{$ifdef cpu32bit}
 procedure tmipsaddnode.second_mul64bit;
 var
   list: TAsmList;
@@ -442,7 +455,7 @@ begin
   result:=needoverflowcheck or
     (not (CPUMIPS_HAS_ISA32R2 in cpu_capabilities[current_settings.cputype]));
 end;
-
+{$endif cpu32bit}
 
 begin
   caddnode := tmipsaddnode;

compiler/mips/ncpumat.pas

@@ -37,9 +37,11 @@ type
   end;
 
   tMIPSELshlshrnode = class(tcgshlshrnode)
+{$ifdef cpu32bit}
     procedure second_64bit;override;
     { everything will be handled in pass_2 }
     function first_shlshr64bitint: tnode; override;
+{$endif cpu32bit}
   end;
 
   tMIPSELnotnode = class(tcgnotnode)
@@ -156,6 +158,7 @@ end;
                              TMIPSelSHLRSHRNODE
 *****************************************************************************}
 
+{$ifdef cpu32bit}
 function TMIPSELShlShrNode.first_shlshr64bitint: TNode;
 begin
   { 64bit without constants need a helper }
@@ -231,7 +234,7 @@ begin
       end;
   end;
 end;
-
+{$endif cpu32bit}
 
 {*****************************************************************************
                                TMIPSelNOTNODE
@@ -252,6 +255,7 @@ begin
           location_reset(location,LOC_FLAGS,OS_NO);
           location.resflags.reg2:=NR_R0;
           location.resflags.cond:=OC_EQ;
+{$ifdef cpu32bit}
           if is_64bit(resultdef) then
             begin
               tmpreg:=cg.GetIntRegister(current_asmdata.CurrAsmList,OS_INT);
@@ -260,6 +264,7 @@ begin
               location.resflags.reg1:=tmpreg;
             end
           else
+{$endif cpu32bit}
             location.resflags.reg1:=left.location.register;
         end;
         else

compiler/msg/errorct.msg

@@ -1,6 +1,6 @@
 #
 #   This file is part of the Free Pascal Compiler
-#   Copyright (c) 1993-2021 by the Free Pascal Development team
+#   Copyright (c) 1993-2022 by the Free Pascal Development team
 #
 #   Catalan Language File for Free Pascal
 #
@@ -2103,7 +2103,7 @@ option_code_page_not_available=11039_E_La p
 #
 option_logo=11023_[
 Free Pascal Compiler versió $FPCFULLVERSION [$FPCDATE] per $FPCCPU
-Copyright (c) 1993-2021 per Florian Klaempfl and others
+Copyright (c) 1993-2022 per Florian Klaempfl and others
 ]
 
 #

compiler/msg/errord.msg

@@ -6,7 +6,7 @@
 #   Based on errore.msg of git commit ce1f9cce, 27 Jun, 2021
 #
 #   This file is part of the Free Pascal Compiler
-#   Copyright (c) 1998-2021 by the Free Pascal Development team
+#   Copyright (c) 1998-2022 by the Free Pascal Development team
 #
 #   See the file COPYING.v2, included in this distribution,
 #   for details about the copyright.
@@ -3810,7 +3810,7 @@ package_u_ppl_filename=13029_U_PPL Dateiname $1
 #
 option_logo=11023_[
 Free Pascal Compiler Version $FPCFULLVERSION [$FPCDATE] f�r $FPCTARGET
-Copyright (c) 1993-2021 Florian Kl„mpfl und andere
+Copyright (c) 1993-2022 Florian Kl„mpfl und andere
 ]
 
 #

compiler/msg/errorda.msg

@@ -3535,7 +3535,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 #
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] til $FPCTARGET
-Copyright (c) 1993-2021 Florian Klaempfl and others
+Copyright (c) 1993-2022 Florian Klaempfl and others
 ]
 
 #

compiler/msg/errordu.msg

@@ -6,7 +6,7 @@
 #   Based on errore.msg of git commit ce1f9cce, 27 Jun, 2021
 #
 #   This file is part of the Free Pascal Compiler
-#   Copyright (c) 1998-2021 by the Free Pascal Development team
+#   Copyright (c) 1998-2022 by the Free Pascal Development team
 #
 #   See the file COPYING.v2, included in this distribution,
 #   for details about the copyright.
@@ -3809,7 +3809,7 @@ package_u_ppl_filename=13029_U_PPL Dateiname $1
 #
 option_logo=11023_[
 Free Pascal Compiler Version $FPCFULLVERSION [$FPCDATE] für $FPCTARGET
-Copyright (c) 1993-2021 Florian Klämpfl und andere
+Copyright (c) 1993-2022 Florian Klämpfl und andere
 ]
 
 #

compiler/msg/errore.msg

@@ -445,7 +445,7 @@ scan_e_unexpected_endif=02108_E_$ENDIF directive found without a matching $IF(N)
 #
 # Parser
 #
-# 03355 is the last used one
+# 03361 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1632,6 +1632,9 @@ parser_e_location_regpair_only_consecutive=03359_E_Only consecutive registers ar
 % MorphOS syscall specific: only consecutive (f.e.: d1-d2) registers are supported for 64bit register pairs
 parser_e_constructurs_cannot_take_type_parameters=03360_E_Constructors cannot take type parameters
 % The use of type parameters in constructors is not allowed.
+parser_e_raise_with_noreturn_not_allowed=03361_E_Raise in subroutines declared as noreturn is not allowed
+% \var{noreturn} tells the compiler that the activation scope of the subroutine is never left. This includes exceptions
+% goto or any other mean. While the compiler cannot detect all such cases some are trivial and the compiler gives an error.
 %
 % \end{description}
 %
@@ -3705,7 +3708,7 @@ package_e_duplicate_package=13003_E_Duplicate package $1
 % a second time.
 package_e_unit_deny_package=13004_E_Unit $1 can not be part of a package
 % The unit can not be part of a package because the DenyPackageUnit directive is enabled for the unit.
-package_n_implicit_unit_import=13005_N_Unit $1 is implicitely imported into package $2
+package_n_implicit_unit_import=13005_N_Unit $1 is implicitly imported into package $2
 % The unit was not specified as part of the \var{contains} section and is also not included in one of the
 % required packages. Add the unit to the \var{contains} section to increase compatibility with other packages.
 package_f_cant_create_pcp=13006_F_Failed to create PCP file $2 for package $1
@@ -3781,7 +3784,7 @@ package_u_ppl_filename=13029_U_PPL filename $1
 #
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 
 #
@@ -4324,6 +4327,7 @@ A*2We_Use external resources (Darwin)
 P*2We_Use external resources (Darwin)
 p*2We_Use external resources (Darwin)
 3*2WF_Specify full-screen type application (EMX, OS/2)
+6*2WF<x>_Set TOS program flags to <x> (Atari)
 3*2WG_Specify graphic type application (EMX, OS/2, Windows)
 4*2WG_Specify graphic type application (Windows)
 A*2WG_Specify graphic type application (Windows)
@@ -4361,12 +4365,16 @@ x*2Wp<x>_Specify the controller type; see fpc -i or fpc -iu for possible values
 4*2WP<x>_Minimum iOS deployment version: 8.0, 8.0.2, ... (iphonesim)
 a*2WP<x>_Minimum iOS deployment version: 7.0, 7.1.2, ... (Darwin)
 A*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (Darwin)
+x*2WP<x>_Esp8266-rtos-sdk or esp-idf version number: 3.3, 3.4 (esp8266) or 4.2, 4.3 (esp32)
 3*2WR_Generate relocation code (Windows)
 4*2WR_Generate relocation code (Windows)
 A*2WR_Generate relocation code (Windows)
 8*2Wt<x>_Set the target executable format
 8*3Wtcom_Create a DOS .COM file (requires tiny memory model)
 8*3Wtexe_Create a DOS .EXE file (default)
+6*2Wt<x>_Set the target executable format (Atari)
+6*3Wttos_Create TOS executable file (default)
+6*3Wtmint_Create a MiNT executable file
 P*2WT_Specify MPW tool type application (Classic Mac OS)
 6*2WQ<x>_Set executable metadata format (Sinclair QL)
 6*3WQqhdr_Set metadata to QDOS File Header style (default)

compiler/msg/errores.msg

@@ -3477,7 +3477,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 #
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorf.msg

@@ -1715,7 +1715,7 @@ option_asm_forced=11022_W_"$1" assembler use forced
 #
 option_logo=11023_[
 Compilateur Free Pascal version $FPCFULLVERSION [$FPCDATE] pour $FPCTARGET
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorfi.msg

@@ -3499,7 +3499,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 # Logo (option -l)
 #
 option_logo=11023_[ Compilateur Free Pascal version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2021, Florian Klaempfl and others]
+Copyright (c) 1993-2022, Florian Klaempfl and others]
 #
 # Info (option -i)
 #

compiler/msg/errorhe.msg

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

compiler/msg/errorheu.msg

@@ -3496,7 +3496,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 #
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorid.msg

@@ -3504,7 +3504,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 #
 option_logo=11023_[
 Free Pascal Compiler versi $FPCFULLVERSION [$FPCDATE] untuk $FPCCPU
-Hak Cipta (c) 1993-2021 oleh Florian Klaempfl and others
+Hak Cipta (c) 1993-2022 oleh Florian Klaempfl and others
 ]
 
 #

compiler/msg/erroriu.msg

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

compiler/msg/errorn.msg

@@ -3485,7 +3485,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 #
 option_logo=11023_[
 Free Pascal Compiler versie $FPCFULLVERSION [$FPCDATE] voor $FPCTARGET
-Copyright (c) 1993-2021 door Florian Klaempfl en anderen
+Copyright (c) 1993-2022 door Florian Klaempfl en anderen
 ]
 #
 # Info (option -i)

compiler/msg/errorpl.msg

@@ -2119,7 +2119,7 @@ option_code_page_not_available=11039_E_Nieznana strona kodowa
 #
 option_logo=11023_[
 Free Pascal Compiler wersja $FPCFULLVERSION [$FPCDATE] dla $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorpli.msg

@@ -2119,7 +2119,7 @@ option_code_page_not_available=11039_E_Nieznana strona kodowa
 #
 option_logo=11023_[
 Free Pascal Compiler wersja $FPCFULLVERSION [$FPCDATE] dla $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 
 #

compiler/msg/errorpt.msg

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

compiler/msg/errorptu.msg

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

compiler/msg/errorr.msg

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

compiler/msg/errorru.msg

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

compiler/msg/errorues.msg

@@ -3471,7 +3471,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 #
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 
 #

compiler/msgidx.inc

@@ -474,6 +474,7 @@ const
   parser_e_location_regpair_only_data=03358;
   parser_e_location_regpair_only_consecutive=03359;
   parser_e_constructurs_cannot_take_type_parameters=03360;
+  parser_e_raise_with_noreturn_not_allowed=03361;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -1147,9 +1148,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 88971;
+  MsgTxtSize = 89309;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,109,361,131,99,63,148,37,223,69,
+    28,109,362,131,99,63,148,37,223,69,
     65,20,30,1,1,1,1,1,1,1
   );

compiler/nadd.pas

@@ -2516,6 +2516,7 @@ implementation
                    the result also unsigned. This is compatible with Delphi (PFV) }
                  if is_signed(ld) or
                     is_signed(rd) or
+                    (([m_iso,m_extpas]*current_settings.modeswitches)<>[]) or
 {$if defined(cpu16bitalu)}
                     (m_tp7 in current_settings.modeswitches) or
 {$endif}

compiler/ncginl.pas

@@ -295,7 +295,7 @@ implementation
            if is_widestring(left.resultdef) then
              lendef:=u32inttype
            else
-             lendef:=ossinttype;
+             lendef:=sizesinttype;
            { volatility of the ansistring/widestring refers to the volatility of the
              string pointer, not of the string data }
            hlcg.reference_reset_base(href,left.resultdef,left.location.register,-lendef.size,ctempposinvalid,lendef.alignment,[]);
@@ -338,12 +338,12 @@ implementation
         hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,left.resultdef,OC_EQ,0,left.location.register,nillab);
         { volatility of the dyn. array refers to the volatility of the
           string pointer, not of the string data }
-        hlcg.reference_reset_base(href,left.resultdef,left.location.register,-ossinttype.size,ctempposinvalid,ossinttype.alignment,[]);
+        hlcg.reference_reset_base(href,left.resultdef,left.location.register,-sizesinttype.size,ctempposinvalid,ossinttype.alignment,[]);
         { if the string pointer is nil, the length is 0 -> reuse the register
           that originally held the string pointer for the length, so that we
           can keep the original nil/0 as length in that case }
         hregister:=cg.makeregsize(current_asmdata.CurrAsmList,left.location.register,def_cgsize(resultdef));
-        hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,ossinttype,resultdef,href,hregister);
+        hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,sizesinttype,resultdef,href,hregister);
         hlcg.a_jmp_always(current_asmdata.CurrAsmList,donelab);
 
         cg.a_label(current_asmdata.CurrAsmList,nillab);
@@ -992,7 +992,7 @@ implementation
 
     procedure tcginlinenode.second_minmax;
       begin
-        internalerror(2020120501);
+        internalerror(2020120510);
       end;
 
 begin

compiler/ncgrtti.pas

@@ -1357,21 +1357,17 @@ implementation
 
         procedure recorddef_rtti(def:trecorddef);
 
-          procedure write_record_operators;
+          procedure write_record_operators(rttilab:tasmlabel);
           var
-            rttilab: Tasmsymbol;
             rttidef: tdef;
             tcb: ttai_typedconstbuilder;
             mop: tmanagementoperator;
             procdef: tprocdef;
           begin
-            rttilab := current_asmdata.DefineAsmSymbol(
-                internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),
-                AB_GLOBAL,AT_DATA,def);
             tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable]);
 
             tcb.begin_anonymous_record(
-              rttilab.Name,
+              '',
               defaultpacking,min(reqalign,SizeOf(PInt)),
               targetinfos[target_info.system]^.alignment.recordalignmin
             );
@@ -1400,6 +1396,8 @@ implementation
             tcb.free;
           end;
 
+        var
+          oplab : tasmlabel;
         begin
            write_header(tcb,def,tkRecord);
            { need extra reqalign record, because otherwise the u32 int will
@@ -1426,6 +1424,7 @@ implementation
 
            tcb.emit_ord_const(def.size,u32inttype);
 
+           oplab:=nil;
            { store rtti management operators only for init table }
            if rt=initrtti then
              begin
@@ -1434,9 +1433,12 @@ implementation
                if (trecordsymtable(def.symtable).managementoperators=[]) then
                  tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype)
                else
-                 tcb.emit_tai(Tai_const.Createname(
-                   internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),
-                   AT_DATA_FORCEINDIRECT,0),voidpointertype);
+                 begin
+                   current_asmdata.getlocaldatalabel(oplab);
+                   tcb.emit_tai(Tai_const.Createname(
+                     oplab.name,
+                     AT_DATA_FORCEINDIRECT,0),voidpointertype);
+                 end;
              end;
 
            fields_write_rtti_data(tcb,def,rt);
@@ -1445,7 +1447,7 @@ implementation
 
            { write pointers to operators if needed }
            if (rt=initrtti) and (trecordsymtable(def.symtable).managementoperators<>[]) then
-             write_record_operators;
+             write_record_operators(oplab);
         end;
 
 

compiler/ncgset.pas

@@ -1251,9 +1251,9 @@ implementation
 
                    distv:=max_label-min_label;
                    if distv>=0 then
-                     dist:=distv.uvalue
+                     dist:=min(distv.uvalue,high(dist))
                    else
-                     dist:=asizeuint(-distv.svalue);
+                     dist:=min(asizeuint(-distv.svalue),high(dist));
 
                    { optimize for size ? }
                    if cs_opt_size in current_settings.optimizerswitches  then

compiler/ncgvmt.pas

@@ -1229,11 +1229,14 @@ implementation
 {$if defined(cpuhighleveltarget)}
         usehighlevelwrapper:=true;
 {$else defined(cpuhighleveltarget)}
-{$if defined(powerpc64)}
-        if cs_create_pic in current_settings.moduleswitches then
+        { on PPC systems that use a TOC the linker needs to be able to insert
+          an instruction to restore the TOC register after every branch
+          between code fragments that use a different TOC (which has to be
+          executed when that "branch" returns). So we can't use tail call
+          branches to routines potentially using a different TOC there }
+        if target_info.system in systems_ppc_toc then
           usehighlevelwrapper:=true
         else
-{$endif defined(powerpc64)}
           usehighlevelwrapper:=false;
 {$endif defined(cpuhighleveltarget)}
         for i:=0 to _class.ImplementedInterfaces.count-1 do

compiler/ngenutil.pas

@@ -493,7 +493,7 @@ implementation
              if mf_classinits in current_module.moduleflags then
                append_struct_initfinis(current_module, potype_class_constructor, stat);
            end;
-         { units have seperate code for initilization and finalization }
+         { units have separate code for initilization and finalization }
          potype_unitfinalize: ;
          { program init/final is generated in separate procedure }
          potype_proginit: ;

compiler/ninl.pas

@@ -1651,8 +1651,8 @@ implementation
                 u8bit,u16bit,u32bit,u64bit:
                   begin
                     suffix := get_val_int_func(destpara.resultdef) + '_';
-                    { we also need a destsize para in the case of sint }
-                    if suffix = 'sint_' then
+                    { we also need a destsize para in the case of sint or uint }
+                    if (suffix = 'sint_') or (suffix = 'uint_') then
                       sizepara := ccallparanode.create(cordconstnode.create
                         (destpara.resultdef.size,s32inttype,true),nil);
                   end;
@@ -3201,7 +3201,7 @@ implementation
                   if is_shortstring(left.resultdef) then
                     resultdef:=u8inttype
                   else
-                    resultdef:=ossinttype;
+                    resultdef:=sizesinttype;
                 end;
 
               in_typeinfo_x:

compiler/ogbase.pas

@@ -780,28 +780,25 @@ implementation
 
     function align_aword(v:aword;a:longword):aword;
       begin
-        if a<=1 then
-          result:=v
-        else
-          result:=((v+a-1) div a) * a;
+        if a>0 then
+          a:=a-1;
+        result:=(v+a) and aword(not aword(a));
       end;
 
 
     function align_qword(v:qword;a:longword):qword;
       begin
-        if a<=1 then
-          result:=v
-        else
-          result:=((v+a-1) div a) * a;
+        if a>0 then
+          a:=a-1;
+        result:=(v+a) and qword(not qword(a));
       end;
 
 
     function align_objsecofs(v:TObjSectionOfs;a:longword):TObjSectionOfs;
       begin
-        if a<=1 then
-          result:=v
-        else
-          result:=((v+a-1) div a) * a;
+        if a>0 then
+          a:=a-1;
+        result:=(v+a) and TObjSectionOfs(not TObjSectionOfs(a));
       end;
 
 
@@ -989,6 +986,8 @@ implementation
 {$endif i8086}
         { Setting the secoptions allocates Data if needed }
         secoptions:=Aoptions;
+        if (Aalign and (Aalign-1))<>0 then
+          internalerror(2022010401); { alignment is not a power of two }
         secalign:=Aalign;
         secsymidx:=0;
         { relocation }

compiler/optdfa.pas

@@ -185,7 +185,7 @@ unit optdfa;
         { update life entry of a node with l, set changed if this changes
           life info for the node
         }
-        procedure updatelifeinfo(n : tnode;l : TDFASet);
+        procedure updatelifeinfo(n : tnode;const l : TDFASet);
           var
             b : boolean;
           begin
@@ -675,12 +675,6 @@ unit optdfa;
         inherited destroy;
       end;
 
-    var
-      { we have to pass the address of SearchNode in a call inside of SearchNode:
-        @SearchNode does not work because the compiler thinks we take the address of the result
-        so store the address from outside }
-      SearchNodeProcPointer : function(var n: tnode; arg: pointer): foreachnoderesult;
-
     type
       { helper structure to be able to pass more than one variable to the iterator function }
       TSearchNodeInfo = record
@@ -775,8 +769,8 @@ unit optdfa;
             begin
               { take care of short boolean evaluation: if the expression to be search is found in left,
                 we do not need to search right }
-              if foreachnodestatic(pm_postprocess,taddnode(n).left,SearchNodeProcPointer,arg) or
-                foreachnodestatic(pm_postprocess,taddnode(n).right,SearchNodeProcPointer,arg) then
+              if foreachnodestatic(pm_postprocess,taddnode(n).left,@optdfa.SearchNode,arg) or
+                foreachnodestatic(pm_postprocess,taddnode(n).right,@optdfa.SearchNode,arg) then
                 result:=fen_norecurse_true
               else
                 result:=fen_norecurse_false;
@@ -809,8 +803,8 @@ unit optdfa;
                       { don't warn about the method pointer }
                       AddFilepos(hpt.fileinfo);
 
-                      if not(foreachnodestatic(pm_postprocess,tcallnode(n).left,SearchNodeProcPointer,arg)) then
-                        foreachnodestatic(pm_postprocess,tcallnode(n).right,SearchNodeProcPointer,arg);
+                      if not(foreachnodestatic(pm_postprocess,tcallnode(n).left,@optdfa.SearchNode,arg)) then
+                        foreachnodestatic(pm_postprocess,tcallnode(n).right,@optdfa.SearchNode,arg);
                       result:=fen_norecurse_true
                     end;
                  end;
@@ -1005,6 +999,4 @@ unit optdfa;
       end;
 
 
-begin
-  SearchNodeProcPointer:=@SearchNode;
 end.

compiler/options.pas

@@ -2810,6 +2810,20 @@ begin
                       end;
                     'F':
                       begin
+{$if defined(m68k)}
+                        if target_info.system in [system_m68k_atari] then
+                          begin
+                            if (length(More)>j) then
+                              begin
+                                val(Copy(More,j+1,255),ataritos_exe_flags,code);
+                                if code<>0 then
+                                  IllegalPara(opt);
+                              end
+                            else
+                              IllegalPara(opt);
+                            break;
+                          end;
+{$endif defined(m68k)}
                         if target_info.system in systems_os2 then
                           begin
                             if UnsetBool(More, j, opt, false) then
@@ -2994,6 +3008,19 @@ begin
                           end
                         else
 {$endif defined(i8086)}
+{$if defined(m68k)}
+                        if (target_info.system in [system_m68k_atari]) then
+                          begin
+                            case Upper(Copy(More,j+1,255)) of
+                              'TOS': ataritos_exe_format := 'ataritos';
+                              'MINT': ataritos_exe_format := 'aoutmint';
+                              else
+                                IllegalPara(opt);
+                            end;
+                            break;
+                          end
+                        else
+{$endif defined(m68k)}
                           IllegalPara(opt);
                       end;
                     'T':
@@ -3797,14 +3824,15 @@ begin
   else
     features:=features+target_unsup_features;
 
-{$if defined(atari) or defined(hasamiga)}
-   { enable vlink as default linker on Atari and Amiga but not for cross compilers (for now) }
-   if (target_info.system in [system_m68k_amiga,system_m68k_atari,system_powerpc_amiga]) and
+{$if defined(hasamiga)}
+   { enable vlink as default linker on Amiga but not for cross compilers (for now) }
+   if (target_info.system in [system_m68k_amiga,system_powerpc_amiga]) and
       not LinkerSetExplicitly then
      include(init_settings.globalswitches,cs_link_vlink);
 {$endif}
 {$ifdef m68k}
-   if (target_info.system in [system_m68k_sinclairql]) and
+   { always enable vlink as default linker for the Sinclair QL and Atari }
+   if (target_info.system in [system_m68k_sinclairql,system_m68k_atari]) and
       not LinkerSetExplicitly then
      include(init_settings.globalswitches,cs_link_vlink);
 {$endif m68k}
@@ -4143,8 +4171,8 @@ procedure read_arguments(cmd:TCmdStr);
 
       {$ifdef mipsel}
         def_system_macro('CPUMIPS');
-        def_system_macro('CPUMIPS32');
         def_system_macro('CPUMIPSEL');
+        def_system_macro('CPUMIPS32');
         def_system_macro('CPUMIPSEL32');
         def_system_macro('CPU32');
         def_system_macro('FPC_HAS_TYPE_DOUBLE');
@@ -4162,8 +4190,8 @@ procedure read_arguments(cmd:TCmdStr);
 
       {$ifdef mipseb}
         def_system_macro('CPUMIPS');
-        def_system_macro('CPUMIPS32');
         def_system_macro('CPUMIPSEB');
+        def_system_macro('CPUMIPS32');
         def_system_macro('CPUMIPSEB32');
         def_system_macro('CPU32');
         def_system_macro('FPC_HAS_TYPE_DOUBLE');
@@ -4174,7 +4202,40 @@ procedure read_arguments(cmd:TCmdStr);
         def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
         { See comment above for mipsel }
         def_system_macro('FPC_LOCALS_ARE_STACK_REG_RELATIVE');
-      {$endif}
+      {$endif mipseb}
+
+      {$ifdef mips64}
+        def_system_macro('CPUMIPS');
+        def_system_macro('CPUMIPS64');
+        def_system_macro('CPUMIPSEB64');
+        def_system_macro('CPUMIPS64EB');
+        def_system_macro('CPU64');
+        def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
+        def_system_macro('FPC_CURRENCY_IS_INT64');
+        def_system_macro('FPC_COMP_IS_INT64');
+        def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
+        { See comment above for mipsel }
+        def_system_macro('FPC_LOCALS_ARE_STACK_REG_RELATIVE');
+      {$endif mips64}
+
+      {$ifdef mips64el}
+        def_system_macro('CPUMIPS');
+        def_system_macro('CPUMIPS64');
+        def_system_macro('CPUMIPSEL64');
+        def_system_macro('CPUMIPS64EL');
+        def_system_macro('CPU64');
+        def_system_macro('FPC_HAS_TYPE_DOUBLE');
+        def_system_macro('FPC_HAS_TYPE_SINGLE');
+        def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
+        def_system_macro('FPC_CURRENCY_IS_INT64');
+        def_system_macro('FPC_COMP_IS_INT64');
+        def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
+        { On most systems, locals are accessed relative to base pointer,
+          but for MIPS cpu, they are accessed relative to stack pointer.
+          This needs adaptation for so low level routines,
+          like MethodPointerLocal and related objects unit functions. }
+        def_system_macro('FPC_LOCALS_ARE_STACK_REG_RELATIVE');
+      {$endif mips64el}
 
       {$ifdef i8086}
         def_system_macro('CPU86');  { Borland compatibility }
@@ -4399,7 +4460,22 @@ begin
         utilsprefix:=target_cpu_string + '-linux-android-';
     end;
 
-  { Set up default value for the heap }
+  { Set up default value for the heap on Amiga-likes (values only apply if the OSHeap allocator is used) }
+  if target_info.system in systems_amigalike then
+    begin
+      case target_info.system of
+        system_m68k_amiga:
+          heapsize:=256*1024;
+        system_powerpc_amiga,
+        system_powerpc_morphos,
+        system_arm_aros,
+        system_i386_aros,
+        system_x86_64_aros:
+          heapsize:=1024*1024;
+        else
+          heapsize:=256*1024;
+      end;
+    end;
   if target_info.system in (systems_embedded+systems_freertos+[system_z80_zxspectrum,system_z80_msxdos]) then
     begin
       case target_info.system of
@@ -4978,6 +5054,7 @@ begin
             init_settings.fputype:=fpu_68881;
           end;
       end;
+    system_m68k_atari,
     system_m68k_sinclairql:
       begin
         if not option.CPUSetExplicitly then

compiler/optutils.pas

@@ -159,10 +159,68 @@ unit optutils;
       end;
 
 
+    type
+      PBreakContinueStackNode = ^TBreakContinueStackNode;
+      TBreakContinueStackNode = record
+        { successor node for a break statement in the current loop }
+        brk,
+        { successor node for a continue statement in the current loop }
+        cont : tnode;
+        next : PBreakContinueStackNode;
+      end;
+
+      { implements a stack to track successor nodes for break and continue
+        statements }
+      TBreakContinueStack = object
+        top: PBreakContinueStackNode;
+        constructor Init;
+        destructor Done;
+        procedure Push(brk,cont : tnode);
+        procedure Pop;
+      end;
+
+    const
+      NullBreakContinueStackNode : TBreakContinueStackNode = (brk: nil; cont: nil; next: nil);
+
+
+    constructor TBreakContinueStack.Init;
+      begin
+        top:=@NullBreakContinueStackNode;
+      end;
+
+
+    destructor TBreakContinueStack.Done;
+      begin
+        while top<>@NullBreakContinueStackNode do
+          Pop;
+      end;
+
+
+    procedure TBreakContinueStack.Push(brk,cont : tnode);
+      var
+        n : PBreakContinueStackNode;
+      begin
+        new(n);
+        n^.brk:=brk;
+        n^.cont:=cont;
+        n^.next:=top;
+        top:=n;
+      end;
+
+
+    procedure TBreakContinueStack.Pop;
+      var
+        n : PBreakContinueStackNode;
+      begin
+        n:=top;
+        top:=n^.next;
+        Dispose(n);
+      end;
+
+
     procedure SetNodeSucessors(p,last : tnode);
       var
-        Continuestack : TFPList;
-        Breakstack : TFPList;
+        BreakContinueStack : TBreakContinueStack;
         Exitsuccessor: TNode;
       { sets the successor nodes of a node tree block
         returns the first node of the tree if it's a controll flow node }
@@ -216,8 +274,7 @@ unit optutils;
               end;
             forn:
               begin
-                Breakstack.Add(succ);
-                Continuestack.Add(p);
+                BreakContinueStack.Push(succ,p);
                 result:=p;
                 { the successor of the last node of the for body is the dummy loop iteration node
                   it allows the dfa to inject needed life information into the loop }
@@ -225,23 +282,21 @@ unit optutils;
 
                 DoSet(tfornode(p).t2,tfornode(p).loopiteration);
                 p.successor:=succ;
-                Breakstack.Delete(Breakstack.Count-1);
-                Continuestack.Delete(Continuestack.Count-1);
+                BreakContinueStack.Pop;
               end;
             breakn:
               begin
                 result:=p;
-                p.successor:=tnode(Breakstack.Last);
+                p.successor:=BreakContinueStack.top^.brk;
               end;
             continuen:
               begin
                 result:=p;
-                p.successor:=tnode(Continuestack.Last);
+                p.successor:=BreakContinueStack.top^.cont;
               end;
             whilerepeatn:
               begin
-                Breakstack.Add(succ);
-                Continuestack.Add(p);
+                BreakContinueStack.Push(succ,p);
                 result:=p;
                 { the successor of the last node of the while/repeat body is the while node itself }
                 DoSet(twhilerepeatnode(p).right,p);
@@ -257,8 +312,7 @@ unit optutils;
                       p.successor:=nil;
                   end;
 
-                Breakstack.Delete(Breakstack.Count-1);
-                Continuestack.Delete(Continuestack.Count-1);
+                BreakContinueStack.Pop;
               end;
             ifn:
               begin
@@ -342,45 +396,40 @@ unit optutils;
         end;
 
       begin
-        Breakstack:=TFPList.Create;
-        Continuestack:=TFPList.Create;
+        BreakContinueStack.Init;
         Exitsuccessor:=nil;
         DoSet(p,last);
-        Continuestack.Free;
-        Breakstack.Free;
+        BreakContinueStack.Done;
       end;
 
-    var
-      defsum : TDFASet;
 
     function adddef(var n: tnode; arg: pointer): foreachnoderesult;
+      var
+        defsum : PDFASet absolute arg;
       begin
         if assigned(n.optinfo) then
           begin
-            DFASetIncludeSet(defsum,n.optinfo^.def);
+            DFASetIncludeSet(defsum^,n.optinfo^.def);
             { for nodes itself do not necessarily expose the definition of the counter as
               the counter might be undefined after the for loop, so include here the counter
               explicitly }
             if (n.nodetype=forn) and assigned(tfornode(n).left.optinfo) then
-              DFASetInclude(defsum,tfornode(n).left.optinfo^.index);
+              DFASetInclude(defsum^,tfornode(n).left.optinfo^.index);
           end;
         Result:=fen_false;
       end;
 
 
     procedure CalcDefSum(p : tnode);
+      var
+        defsum : PDFASet;
       begin
         p.allocoptinfo;
-        if not assigned(p.optinfo^.defsum) then
-          begin
-            defsum:=nil;
-            foreachnodestatic(pm_postprocess,p,@adddef,nil);
-            p.optinfo^.defsum:=defsum;
-          end;
+        defsum:[email protected]^.defsum;
+        if not assigned(defsum^) then
+            foreachnodestatic(pm_postprocess,p,@adddef,defsum);
       end;
 
-    var
-      usesum : TDFASet;
 
     function SetExecutionWeight(var n: tnode; arg: pointer): foreachnoderesult;
       var
@@ -429,22 +478,23 @@ unit optutils;
 
 
     function adduse(var n: tnode; arg: pointer): foreachnoderesult;
+      var
+        usesum : PDFASet absolute arg;
       begin
         if assigned(n.optinfo) then
-          DFASetIncludeSet(usesum,n.optinfo^.use);
+          DFASetIncludeSet(usesum^,n.optinfo^.use);
         Result:=fen_false;
       end;
 
 
     procedure CalcUseSum(p : tnode);
+      var
+        usesum : PDFASet;
       begin
         p.allocoptinfo;
-        if not assigned(p.optinfo^.usesum) then
-          begin
-            usesum:=nil;
-            foreachnodestatic(pm_postprocess,p,@adduse,nil);
-            p.optinfo^.usesum:=usesum;
-          end;
+        usesum:[email protected]^.usesum;
+        if not assigned(usesum^) then
+            foreachnodestatic(pm_postprocess,p,@adduse,usesum);
       end;
 
 

compiler/pass_1.pas

@@ -78,7 +78,7 @@ implementation
               p.free;
               { switch to new node }
               p:=hp;
-              { transfer generic paramter flag }
+              { transfer generic parameter flag }
               if nf_generic_para in oldflags then
                 include(p.flags,nf_generic_para);
             end;

compiler/pexpr.pas

@@ -2851,6 +2851,286 @@ implementation
 
   {$maxfpuregisters 0}
 
+
+    function factor_handle_sym(srsym:tsym;srsymtable:tsymtable;var again:boolean;getaddr:boolean;unit_found:boolean;flags:texprflags;var spezcontext:tspecializationcontext):tnode;
+      var
+        hdef : tdef;
+        pd : tprocdef;
+        callflags : tcallnodeflags;
+        tmpgetaddr : boolean;
+      begin
+        hdef:=nil;
+        result:=nil;
+        case srsym.typ of
+          absolutevarsym :
+            begin
+              if (tabsolutevarsym(srsym).abstyp=tovar) then
+                begin
+                  result:=nil;
+                  propaccesslist_to_node(result,nil,tabsolutevarsym(srsym).ref);
+                  result:=ctypeconvnode.create(result,tabsolutevarsym(srsym).vardef);
+                  include(result.flags,nf_absolute);
+                end
+              else
+                result:=cloadnode.create(srsym,srsymtable);
+            end;
+
+          staticvarsym,
+          localvarsym,
+          paravarsym,
+          fieldvarsym :
+            begin
+              { check if we are reading a field of an object/class/   }
+              { record. is_member_read() will deal with withsymtables }
+              { if needed.                                            }
+              result:=nil;
+              if is_member_read(srsym,srsymtable,result,hdef) then
+                begin
+                  { if the field was originally found in an     }
+                  { objectsymtable, it means it's part of self  }
+                  { if only method from which it was called is  }
+                  { not class static                            }
+                  if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
+                    { if we are accessing a owner procsym from the nested }
+                    { class we need to call it as a class member          }
+                    if assigned(current_structdef) and
+                        (((current_structdef<>hdef) and is_owned_by(current_structdef,hdef)) or
+                         (sp_static in srsym.symoptions)) then
+                      if srsymtable.symtabletype=recordsymtable then
+                        result:=ctypenode.create(hdef)
+                      else
+                        result:=cloadvmtaddrnode.create(ctypenode.create(hdef))
+                    else
+                      begin
+                        if assigned(current_procinfo) then
+                          begin
+                            pd:=current_procinfo.get_normal_proc.procdef;
+                            if assigned(pd) and pd.no_self_node then
+                              result:=cloadvmtaddrnode.create(ctypenode.create(pd.struct))
+                            else
+                              result:=load_self_node;
+                          end
+                        else
+                          result:=load_self_node;
+                      end;
+                  { now, if the field itself is part of an objectsymtab }
+                  { (it can be even if it was found in a withsymtable,  }
+                  {  e.g., "with classinstance do field := 5"), then    }
+                  { let do_member_read handle it                        }
+                  if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
+                    do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],nil)
+                  else
+                    { otherwise it's a regular record subscript }
+                    result:=csubscriptnode.create(srsym,result);
+                end
+              else
+                { regular non-field load }
+                result:=cloadnode.create(srsym,srsymtable);
+            end;
+
+          syssym :
+            begin
+              result:=statement_syssym(tsyssym(srsym).number);
+            end;
+
+          typesym :
+            begin
+              hdef:=ttypesym(srsym).typedef;
+              if not assigned(hdef) then
+               begin
+                 again:=false;
+               end
+              else
+               begin
+                 if (m_delphi in current_settings.modeswitches) and
+                     (sp_generic_dummy in srsym.symoptions) and
+                     (token in [_LT,_LSHARPBRACKET]) then
+                   begin
+                     if block_type in [bt_type,bt_const_type,bt_var_type] then
+                       begin
+                         if not handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) or (srsym.typ=procsym) then
+                           begin
+                             spezcontext.free;
+                             result:=cerrornode.create;
+                             if try_to_consume(_LKLAMMER) then
+                              begin
+                                parse_paras(false,false,_RKLAMMER);
+                                consume(_RKLAMMER);
+                              end;
+                           end
+                         else
+                           begin
+                             if srsym.typ<>typesym then
+                               internalerror(2015071705);
+                             hdef:=ttypesym(srsym).typedef;
+                             result:=handle_factor_typenode(hdef,getaddr,again,srsym,ef_type_only in flags);
+                           end;
+                       end
+                     else
+                       result:=cspecializenode.create(nil,getaddr,srsym)
+                   end
+                 else
+                   begin
+                     { We need to know if this unit uses Variants }
+                     if ((hdef=cvarianttype) or (hdef=colevarianttype)) and
+                        not(cs_compilesystem in current_settings.moduleswitches) then
+                       include(current_module.moduleflags,mf_uses_variants);
+                     result:=handle_factor_typenode(hdef,getaddr,again,srsym,ef_type_only in flags);
+                   end;
+               end;
+            end;
+
+          enumsym :
+            begin
+              result:=genenumnode(tenumsym(srsym));
+            end;
+
+          constsym :
+            begin
+              if tconstsym(srsym).consttyp=constresourcestring then
+                begin
+                  result:=cloadnode.create(srsym,srsymtable);
+                  do_typecheckpass(result);
+                  result.resultdef:=getansistringdef;
+                end
+              else
+                result:=genconstsymtree(tconstsym(srsym));
+            end;
+
+          procsym :
+            begin
+              result:=nil;
+              if (m_delphi in current_settings.modeswitches) and
+                  (sp_generic_dummy in srsym.symoptions) and
+                  (token in [_LT,_LSHARPBRACKET]) then
+                begin
+                  result:=cspecializenode.create(nil,getaddr,srsym)
+                end
+              { check if it's a method/class method }
+              else if is_member_read(srsym,srsymtable,result,hdef) then
+                begin
+                  { if we are accessing a owner procsym from the nested }
+                  { class we need to call it as a class member          }
+                  if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) and
+                    assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then
+                    result:=cloadvmtaddrnode.create(ctypenode.create(hdef));
+                  { not srsymtable.symtabletype since that can be }
+                  { withsymtable as well                          }
+                  if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
+                    begin
+                      do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],spezcontext);
+                      spezcontext:=nil;
+                    end
+                  else
+                    { no procsyms in records (yet) }
+                    internalerror(2007012006);
+                end
+              else
+                begin
+                  { regular procedure/function call }
+                  if not unit_found then
+                    callflags:=[]
+                  else
+                    callflags:=[cnf_unit_specified];
+                  { TP7 uglyness: @proc^ is parsed as (@proc)^,
+                    but @notproc^ is parsed as @(notproc^) }
+                  if m_tp_procvar in current_settings.modeswitches then
+                    tmpgetaddr:=getaddr and not(token in [_POINT,_LECKKLAMMER])
+                  else
+                    tmpgetaddr:=getaddr and not(token in [_CARET,_POINT,_LECKKLAMMER]);
+                  do_proc_call(srsym,srsymtable,nil,tmpgetaddr,
+                               again,result,callflags,spezcontext);
+                  spezcontext:=nil;
+                end;
+            end;
+
+          propertysym :
+            begin
+              result:=nil;
+              { property of a class/object? }
+              if is_member_read(srsym,srsymtable,result,hdef) then
+                begin
+                  if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
+                    { if we are accessing a owner procsym from the nested }
+                    { class or from a static class method we need to call }
+                    { it as a class member                                }
+                    if (assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef)) or
+                       (assigned(current_procinfo) and current_procinfo.get_normal_proc.procdef.no_self_node) then
+                      begin
+                        result:=ctypenode.create(hdef);
+                        if not is_record(hdef) then
+                          result:=cloadvmtaddrnode.create(result);
+                      end
+                    else
+                      result:=load_self_node;
+                  { not srsymtable.symtabletype since that can be }
+                  { withsymtable as well                          }
+                  if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
+                    do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],nil)
+                  else
+                    { no propertysyms in records (yet) }
+                    internalerror(2009111510);
+                end
+              else
+              { no method pointer }
+                begin
+                  handle_propertysym(tpropertysym(srsym),srsymtable,result);
+                end;
+            end;
+
+          labelsym :
+            begin
+              { Support @label }
+              if getaddr then
+                begin
+                  if srsym.owner<>current_procinfo.procdef.localst then
+                    CGMessage(parser_e_label_outside_proc);
+                  result:=cloadnode.create(srsym,srsym.owner)
+                end
+              else
+                begin
+                  consume(_COLON);
+                  if tlabelsym(srsym).defined then
+                    Message(sym_e_label_already_defined);
+                  if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
+                    begin
+                      include(current_procinfo.flags,pi_has_interproclabel);
+                      if (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
+                        Message(sym_e_interprocgoto_into_init_final_code_not_allowed);
+                    end;
+                  tlabelsym(srsym).defined:=true;
+                  result:=clabelnode.create(nil,tlabelsym(srsym));
+                  tlabelsym(srsym).code:=result;
+                end;
+            end;
+
+          undefinedsym :
+            begin
+              result:=cnothingnode.Create;
+              result.resultdef:=cundefineddef.create(true);
+              { clean up previously created dummy symbol }
+              srsym.free;
+            end;
+
+          errorsym :
+            begin
+              result:=cerrornode.create;
+              if try_to_consume(_LKLAMMER) then
+               begin
+                 parse_paras(false,false,_RKLAMMER);
+                 consume(_RKLAMMER);
+               end;
+            end;
+
+          else
+            begin
+              result:=cerrornode.create;
+              Message(parser_e_illegal_expression);
+            end;
+        end; { end case }
+      end;
+
+
     function factor(getaddr:boolean;flags:texprflags) : tnode;
 
          {---------------------------------------------
@@ -2878,16 +3158,14 @@ implementation
            srsym: tsym;
            srsymtable: TSymtable;
            hdef: tdef;
-           pd: tprocdef;
            orgstoredpattern,
            storedpattern: string;
-           callflags: tcallnodeflags;
            t : ttoken;
            consumeid,
            wasgenericdummy,
            allowspecialize,
            isspecialize,
-           unit_found, tmpgetaddr: boolean;
+           unit_found : boolean;
            dummypos,
            tokenpos: tfileposinfo;
            spezcontext : tspecializationcontext;
@@ -3181,273 +3459,7 @@ implementation
             end;
 
             begin
-              case srsym.typ of
-                absolutevarsym :
-                  begin
-                    if (tabsolutevarsym(srsym).abstyp=tovar) then
-                      begin
-                        p1:=nil;
-                        propaccesslist_to_node(p1,nil,tabsolutevarsym(srsym).ref);
-                        p1:=ctypeconvnode.create(p1,tabsolutevarsym(srsym).vardef);
-                        include(p1.flags,nf_absolute);
-                      end
-                    else
-                      p1:=cloadnode.create(srsym,srsymtable);
-                  end;
-
-                staticvarsym,
-                localvarsym,
-                paravarsym,
-                fieldvarsym :
-                  begin
-                    { check if we are reading a field of an object/class/   }
-                    { record. is_member_read() will deal with withsymtables }
-                    { if needed.                                            }
-                    p1:=nil;
-                    if is_member_read(srsym,srsymtable,p1,hdef) then
-                      begin
-                        { if the field was originally found in an     }
-                        { objectsymtable, it means it's part of self  }
-                        { if only method from which it was called is  }
-                        { not class static                            }
-                        if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
-                          { if we are accessing a owner procsym from the nested }
-                          { class we need to call it as a class member          }
-                          if assigned(current_structdef) and
-                              (((current_structdef<>hdef) and is_owned_by(current_structdef,hdef)) or
-                               (sp_static in srsym.symoptions)) then
-                            if srsymtable.symtabletype=recordsymtable then
-                              p1:=ctypenode.create(hdef)
-                            else
-                              p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))
-                          else
-                            begin
-                              if assigned(current_procinfo) then
-                                begin
-                                  pd:=current_procinfo.get_normal_proc.procdef;
-                                  if assigned(pd) and pd.no_self_node then
-                                    p1:=cloadvmtaddrnode.create(ctypenode.create(pd.struct))
-                                  else
-                                    p1:=load_self_node;
-                                end
-                              else
-                                p1:=load_self_node;
-                            end;
-                        { now, if the field itself is part of an objectsymtab }
-                        { (it can be even if it was found in a withsymtable,  }
-                        {  e.g., "with classinstance do field := 5"), then    }
-                        { let do_member_read handle it                        }
-                        if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
-                          do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[],nil)
-                        else
-                          { otherwise it's a regular record subscript }
-                          p1:=csubscriptnode.create(srsym,p1);
-                      end
-                    else
-                      { regular non-field load }
-                      p1:=cloadnode.create(srsym,srsymtable);
-                  end;
-
-                syssym :
-                  begin
-                    p1:=statement_syssym(tsyssym(srsym).number);
-                  end;
-
-                typesym :
-                  begin
-                    hdef:=ttypesym(srsym).typedef;
-                    if not assigned(hdef) then
-                     begin
-                       again:=false;
-                     end
-                    else
-                     begin
-                       if (m_delphi in current_settings.modeswitches) and
-                           (sp_generic_dummy in srsym.symoptions) and
-                           (token in [_LT,_LSHARPBRACKET]) then
-                         begin
-                           if block_type in [bt_type,bt_const_type,bt_var_type] then
-                             begin
-                               if not handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) or (srsym.typ=procsym) then
-                                 begin
-                                   spezcontext.free;
-                                   p1:=cerrornode.create;
-                                   if try_to_consume(_LKLAMMER) then
-                                    begin
-                                      parse_paras(false,false,_RKLAMMER);
-                                      consume(_RKLAMMER);
-                                    end;
-                                 end
-                               else
-                                 begin
-                                   if srsym.typ<>typesym then
-                                     internalerror(2015071705);
-                                   hdef:=ttypesym(srsym).typedef;
-                                   p1:=handle_factor_typenode(hdef,getaddr,again,srsym,ef_type_only in flags);
-                                 end;
-                             end
-                           else
-                             p1:=cspecializenode.create(nil,getaddr,srsym)
-                         end
-                       else
-                         begin
-                           { We need to know if this unit uses Variants }
-                           if ((hdef=cvarianttype) or (hdef=colevarianttype)) and
-                              not(cs_compilesystem in current_settings.moduleswitches) then
-                             include(current_module.moduleflags,mf_uses_variants);
-                           p1:=handle_factor_typenode(hdef,getaddr,again,srsym,ef_type_only in flags);
-                         end;
-                     end;
-                  end;
-
-                enumsym :
-                  begin
-                    p1:=genenumnode(tenumsym(srsym));
-                  end;
-
-                constsym :
-                  begin
-                    if tconstsym(srsym).consttyp=constresourcestring then
-                      begin
-                        p1:=cloadnode.create(srsym,srsymtable);
-                        do_typecheckpass(p1);
-                        p1.resultdef:=getansistringdef;
-                      end
-                    else
-                      p1:=genconstsymtree(tconstsym(srsym));
-                  end;
-
-                procsym :
-                  begin
-                    p1:=nil;
-                    if (m_delphi in current_settings.modeswitches) and
-                        (sp_generic_dummy in srsym.symoptions) and
-                        (token in [_LT,_LSHARPBRACKET]) then
-                      begin
-                        p1:=cspecializenode.create(nil,getaddr,srsym)
-                      end
-                    { check if it's a method/class method }
-                    else if is_member_read(srsym,srsymtable,p1,hdef) then
-                      begin
-                        { if we are accessing a owner procsym from the nested }
-                        { class we need to call it as a class member          }
-                        if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) and
-                          assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then
-                          p1:=cloadvmtaddrnode.create(ctypenode.create(hdef));
-                        { not srsymtable.symtabletype since that can be }
-                        { withsymtable as well                          }
-                        if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
-                          begin
-                            do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[],spezcontext);
-                            spezcontext:=nil;
-                          end
-                        else
-                          { no procsyms in records (yet) }
-                          internalerror(2007012006);
-                      end
-                    else
-                      begin
-                        { regular procedure/function call }
-                        if not unit_found then
-                          callflags:=[]
-                        else
-                          callflags:=[cnf_unit_specified];
-                        { TP7 uglyness: @proc^ is parsed as (@proc)^,
-                          but @notproc^ is parsed as @(notproc^) }
-                        if m_tp_procvar in current_settings.modeswitches then
-                          tmpgetaddr:=getaddr and not(token in [_POINT,_LECKKLAMMER])
-                        else
-                          tmpgetaddr:=getaddr and not(token in [_CARET,_POINT,_LECKKLAMMER]);
-                        do_proc_call(srsym,srsymtable,nil,tmpgetaddr,
-                                     again,p1,callflags,spezcontext);
-                        spezcontext:=nil;
-                      end;
-                  end;
-
-                propertysym :
-                  begin
-                    p1:=nil;
-                    { property of a class/object? }
-                    if is_member_read(srsym,srsymtable,p1,hdef) then
-                      begin
-                        if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
-                          { if we are accessing a owner procsym from the nested }
-                          { class or from a static class method we need to call }
-                          { it as a class member                                }
-                          if (assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef)) or
-                             (assigned(current_procinfo) and current_procinfo.get_normal_proc.procdef.no_self_node) then
-                            begin
-                              p1:=ctypenode.create(hdef);
-                              if not is_record(hdef) then
-                                p1:=cloadvmtaddrnode.create(p1);
-                            end
-                          else
-                            p1:=load_self_node;
-                        { not srsymtable.symtabletype since that can be }
-                        { withsymtable as well                          }
-                        if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
-                          do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[],nil)
-                        else
-                          { no propertysyms in records (yet) }
-                          internalerror(2009111510);
-                      end
-                    else
-                    { no method pointer }
-                      begin
-                        handle_propertysym(tpropertysym(srsym),srsymtable,p1);
-                      end;
-                  end;
-
-                labelsym :
-                  begin
-                    { Support @label }
-                    if getaddr then
-                      begin
-                        if srsym.owner<>current_procinfo.procdef.localst then
-                          CGMessage(parser_e_label_outside_proc);
-                        p1:=cloadnode.create(srsym,srsym.owner)
-                      end
-                    else
-                      begin
-                        consume(_COLON);
-                        if tlabelsym(srsym).defined then
-                          Message(sym_e_label_already_defined);
-                        if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
-                          begin
-                            include(current_procinfo.flags,pi_has_interproclabel);
-                            if (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
-                              Message(sym_e_interprocgoto_into_init_final_code_not_allowed);
-                          end;
-                        tlabelsym(srsym).defined:=true;
-                        p1:=clabelnode.create(nil,tlabelsym(srsym));
-                        tlabelsym(srsym).code:=p1;
-                      end;
-                  end;
-
-                undefinedsym :
-                  begin
-                    p1:=cnothingnode.Create;
-                    p1.resultdef:=cundefineddef.create(true);
-                    { clean up previously created dummy symbol }
-                    srsym.free;
-                  end;
-
-                errorsym :
-                  begin
-                    p1:=cerrornode.create;
-                    if try_to_consume(_LKLAMMER) then
-                     begin
-                       parse_paras(false,false,_RKLAMMER);
-                       consume(_RKLAMMER);
-                     end;
-                  end;
-
-                else
-                  begin
-                    p1:=cerrornode.create;
-                    Message(parser_e_illegal_expression);
-                  end;
-              end; { end case }
+              p1:=factor_handle_sym(srsym,srsymtable,again,getaddr,unit_found,flags,spezcontext);
 
               if assigned(spezcontext) then
                 internalerror(2015061207);
@@ -4420,6 +4432,9 @@ implementation
         filepos : tfileposinfo;
         gendef,parseddef : tdef;
         gensym : tsym;
+        genlist : tfpobjectlist;
+        dummyagain : boolean;
+        dummyspezctxt : tspecializationcontext;
       begin
         SubExprStart:
         if pred_level=highest_precedence then
@@ -4509,6 +4524,39 @@ implementation
 
                        { potential generic types that are followed by a "<": }
 
+                       if p1.nodetype=specializen then
+                         begin
+                           genlist:=tfpobjectlist(current_module.genericdummysyms.find(tspecializenode(p1).sym.name));
+                           if assigned(genlist) and (genlist.count>0) then
+                             begin
+                               gensym:=tgenericdummyentry(genlist.last).resolvedsym;
+                               check_hints(gensym,gensym.symoptions,gensym.deprecatedmsg,p1.fileinfo);
+
+                               dummyagain:=false;
+                               dummyspezctxt:=nil;
+
+                               ptmp:=factor_handle_sym(gensym,
+                                                       gensym.owner,
+                                                       dummyagain,
+                                                       tspecializenode(p1).getaddr,
+                                                       false,
+                                                       flags,
+                                                       dummyspezctxt);
+
+                               if dummyagain then
+                                 internalerror(2022012201);
+
+                               p1.free;
+                               p1:=ptmp;
+                             end
+                           else
+                             begin
+                               identifier_not_found(tspecializenode(p1).sym.realname);
+                               p1.free;
+                               p1:=cerrornode.create;
+                             end;
+                         end;
+
                        { a) might not have their resultdef set }
                        if not assigned(p1.resultdef) then
                          do_typecheckpass(p1);

compiler/pmodules.pas

@@ -415,8 +415,26 @@ implementation
 {$pop}
 {$ifdef XTENSA}
         if not(current_module.is_unit) and (target_info.system=system_xtensa_freertos) then
-          if (current_settings.controllertype=ct_esp32) and (idf_version>=40200) then
-            AddUnit('espidf_40200');
+          if (current_settings.controllertype=ct_esp32) then
+            begin
+              if (idf_version>=40100) and (idf_version<40200) then
+                AddUnit('espidf_40100')
+              else if (idf_version>=40200) and (idf_version<40400) then
+                AddUnit('espidf_40200')
+              else if idf_version>=40400 then
+                AddUnit('espidf_40400')
+              else
+                Comment(V_Warning, 'Unsupported esp-idf version');
+            end
+          else if (current_settings.controllertype=ct_esp8266) then
+            begin
+              if (idf_version>=30300) and (idf_version<30400) then
+                AddUnit('esp8266rtos_30300')
+              else if idf_version>=30400 then
+                AddUnit('esp8266rtos_30400')
+              else
+                Comment(V_Warning, 'Unsupported esp-rtos version');
+            end;
 {$endif XTENSA}
       end;
 

compiler/powerpc64/cgcpu.pas

@@ -337,10 +337,6 @@ begin
     reference_reset_base(tmpref, reg, 0, ctempposinvalid, sizeof(pint), []);
     a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, tempreg);
 
-    { save TOC pointer in stackframe }
-    reference_reset_base(tmpref, NR_STACK_POINTER_REG, get_rtoc_offset, ctempposinvalid, 8, []);
-    a_load_reg_ref(list, OS_ADDR, OS_ADDR, NR_RTOC, tmpref);
-
     { move actual function pointer to CTR register }
     list.concat(taicpu.op_reg(A_MTCTR, tempreg));
 
@@ -1273,6 +1269,13 @@ begin
     end;
   end;
 
+  { save current RTOC for restoration after calls if necessary }
+  if pi_do_call in current_procinfo.flags then
+    begin
+      reference_reset_base(href,NR_STACK_POINTER_REG,get_rtoc_offset,ctempposinvalid,target_info.stackalign,[]);
+      a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_RTOC,href);
+    end;
+
   { CR register not used by FPC atm }
 
   { keep R1 allocated??? }

compiler/procinfo.pas

@@ -145,6 +145,11 @@ unit procinfo;
           localrefsyms : tfpobjectlist;
           localrefdefs : tfpobjectlist;
 
+          { Registers saved by the current procedure - useful for peephole optimizers }
+          saved_regs_int,
+          saved_regs_address,
+          saved_regs_mm: TCPURegisterSet;
+
           constructor create(aparent:tprocinfo);virtual;
           destructor destroy;override;
 

compiler/pstatmnt.pas

@@ -855,6 +855,8 @@ implementation
               if (block_type<>bt_except) then
                 Message(parser_e_no_reraise_possible);
            end;
+         if (po_noreturn in current_procinfo.procdef.procoptions) and (exceptblockcounter=0) then
+           Message(parser_e_raise_with_noreturn_not_allowed);
          p:=craisenode.create(pobj,paddr,pframe);
          raise_statement:=p;
       end;

compiler/scanner.pas

@@ -3625,7 +3625,7 @@ type
             exit;
            repeat
            { still more to read?, then change the #0 to a space so its seen
-             as a seperator, this can't be used for macro's which can change
+             as a separator, this can't be used for macro's which can change
              the place of the #0 in the buffer with tempopen }
              if (c=#0) and (bufsize>0) and
                 not(inputfile.is_macro) and
@@ -4198,6 +4198,7 @@ type
       var
         base,
         i  : longint;
+        firstdigitread: Boolean;
       begin
         case c of
           '%' :
@@ -4227,17 +4228,20 @@ type
               i:=0;
             end;
         end;
+        firstdigitread:=false;
         while ((base>=10) and (c in ['0'..'9'])) or
               ((base=16) and (c in ['A'..'F','a'..'f'])) or
               ((base=8) and (c in ['0'..'7'])) or
-              ((base=2) and (c in ['0'..'1'])) do
+              ((base=2) and (c in ['0'..'1'])) or
+              ((m_underscoreisseparator in current_settings.modeswitches) and firstdigitread and (c='_')) do
          begin
-           if i<255 then
+           if (i<255) and (c<>'_') then
             begin
               inc(i);
               pattern[i]:=c;
             end;
            readchar;
+           firstdigitread:=true;
          end;
         pattern[0]:=chr(i);
       end;
@@ -4795,7 +4799,7 @@ type
         m       : longint;
         mac     : tmacro;
         asciinr : string[33];
-        iswidestring : boolean;
+        iswidestring , firstdigitread: boolean;
       label
          exit_label;
       begin
@@ -4938,7 +4942,7 @@ type
 
              '%' :
                begin
-                 if not(m_fpc in current_settings.modeswitches) then
+                 if [m_fpc,m_delphi] * current_settings.modeswitches = [] then
                   Illegal_Char(c)
                  else
                   begin
@@ -5006,10 +5010,14 @@ type
                            begin
                              { insert the number after the . }
                              pattern:=pattern+'.';
-                             while c in ['0'..'9'] do
+                             firstdigitread:=false;
+                             while (c in ['0'..'9']) or
+                              ((m_underscoreisseparator in current_settings.modeswitches) and firstdigitread and (c='_')) do
                               begin
-                                pattern:=pattern+c;
+                                if c<>'_' then
+                                  pattern:=pattern+c;
                                 readchar;
+                                firstdigitread:=true;
                               end;
                            end;
                          else
@@ -5031,11 +5039,15 @@ type
                           readchar;
                         end;
                        if not(c in ['0'..'9']) then
-                        Illegal_Char(c);
-                       while c in ['0'..'9'] do
+                         Illegal_Char(c);
+                       firstdigitread:=false;
+                       while (c in ['0'..'9']) or
+                        ((m_underscoreisseparator in current_settings.modeswitches) and firstdigitread and (c='_')) do
                         begin
+                          if c<>'_' then
                           pattern:=pattern+c;
                           readchar;
+                          firstdigitread:=true;
                         end;
                      end;
                     token:=_REALNUMBER;

compiler/symconst.pas

@@ -794,7 +794,6 @@ type
     itp_rtti_set_inner,
     itp_rtti_record,
     itp_rtti_record_inner,
-    itp_init_record_operators,
     itp_init_mop_offset_entry,
     itp_threadvar_record,
     itp_objc_method_list,
@@ -949,7 +948,6 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
        '$rtti_set_inner$',
        '$rtti_record$',
        '$rtti_record_inner$',
-       '$init_record_operators$',
        '$init_mop_offset_entry$',
        '$threadvar_record$',
        '$objc_method_list$',

compiler/systems.inc

@@ -56,7 +56,9 @@
              cpu_riscv32,                  { 19 }
              cpu_riscv64,                  { 20 }
              cpu_xtensa,                   { 21 }
-             cpu_z80                       { 22 }
+             cpu_z80,                      { 22 }
+             cpu_mips64,                   { 23 }
+             cpu_mips64el                  { 24 }
        );
 
        tasmmode= (asmmode_none
@@ -204,7 +206,10 @@
              system_z80_amstradcpc,     { 112 }
              system_m68k_sinclairql,    { 113 }
              system_wasm32_wasi,        { 114 }
-             system_aarch64_freebsd     { 115 }
+             system_aarch64_freebsd,    { 115 }
+             system_aarch64_embedded,   { 116 }
+             system_mips64_linux,       { 117 }
+             system_mips64el_linux      { 118 }
        );
 
      type

compiler/systems.pas

@@ -311,7 +311,8 @@ interface
                            system_powerpc64_embedded,system_avr_embedded,
                            system_jvm_java32,system_mipseb_embedded,system_mipsel_embedded,
                            system_i8086_embedded,system_riscv32_embedded,system_riscv64_embedded,
-                           system_xtensa_embedded,system_z80_embedded,system_wasm32_embedded];
+                           system_xtensa_embedded,system_z80_embedded,system_wasm32_embedded,
+                           system_aarch64_embedded];
 
        { all FreeRTOS systems }
        systems_freertos = [system_xtensa_freertos,system_arm_freertos];
@@ -390,7 +391,7 @@ interface
 
        systems_internal_sysinit = [system_i386_win32,system_x86_64_win64,
                                    system_i386_linux,system_powerpc64_linux,system_sparc64_linux,system_x86_64_linux,
-                                   system_xtensa_linux,
+                                   system_xtensa_linux,system_mips64_linux,system_mips64el_linux,
                                    system_m68k_atari,system_m68k_palmos,system_m68k_sinclairql,
                                    system_i386_haiku,system_x86_64_haiku,
                                    system_i386_openbsd,system_x86_64_openbsd,
@@ -447,6 +448,16 @@ interface
          on the caller side rather than on the callee side }
        systems_caller_copy_addr_value_para = [system_aarch64_ios,system_aarch64_darwin,system_aarch64_linux,system_aarch64_win64,system_aarch64_freebsd];
 
+       { all PPC systems that use a TOC register to address globals }
+       { TODO: not used by Darwin, but don't know about others (JM) }
+       systems_ppc_toc = [
+         system_powerpc_linux,
+         system_powerpc64_linux,
+         system_powerpc_aix,
+         system_powerpc64_aix,
+         system_powerpc_macosclassic
+       ];
+
        { pointer checking (requires special code in FPC_CHECKPOINTER,
          and can never work for libc-based targets or any other program
          linking to an external library)
@@ -468,7 +479,7 @@ interface
             ('','i386','m68k','alpha','powerpc','sparc','vm','ia64','x86_64',
              'mips','arm', 'powerpc64', 'avr', 'mipsel','jvm', 'i8086',
              'aarch64', 'wasm32', 'sparc64', 'riscv32', 'riscv64', 'xtensa',
-             'z80');
+             'z80', 'mips64', 'mips64el');
 
        abiinfo : array[tabi] of tabiinfo = (
          (name: 'DEFAULT'; supported: true),
@@ -1112,7 +1123,7 @@ begin
   default_target(system_avr_embedded);
 {$endif avr}
 
-{$ifdef mips}
+{$ifdef mips32}
 {$ifdef mipsel}
   {$ifdef cpumipsel}
     default_target(source_info.system);
@@ -1122,7 +1133,7 @@ begin
 {$else mipsel}
   default_target(system_mipseb_linux);
 {$endif mipsel}
-{$endif mips}
+{$endif mips32}
 
 {$ifdef jvm}
   default_target(system_jvm_java32);
@@ -1159,6 +1170,10 @@ begin
       default_target(system_aarch64_linux);
       {$define default_target_set}
     {$endif}
+    {$ifdef embedded}
+      {$define default_target_set}
+      default_target(system_aarch64_embedded);
+    {$endif}
   {$endif cpuaarch64}
 {$endif aarch64}
 
@@ -1189,6 +1204,13 @@ begin
   {$endif ndef default_target_set}
 {$endif xtensa}
 
+{$ifdef mips64}
+  default_target(system_mips64_linux);
+{$endif mips64}
+
+{$ifdef mips64el}
+  default_target(system_mips64el_linux);
+{$endif mips64el}
 end;
 
 

compiler/systems/i_atari.pas

@@ -61,9 +61,9 @@ unit i_atari;
             Cprefix      : '_';
             newline      : #13#10;
             dirsep       : '/'; { ... the underlying tools (binutils/vlink/vasm) prefer Unix paths }
-            assem        : as_m68k_as_aout;
-            assemextern  : as_m68k_as_aout;
-            link         : ld_atari;
+            assem        : as_m68k_vasm;
+            assemextern  : as_m68k_vasm;
+            link         : ld_none;
             linkextern   : ld_atari;
             ar           : ar_gnu_ar;
             res          : res_ext;

compiler/systems/i_embed.pas

@@ -35,6 +35,73 @@ unit i_embed;
        systems;
 
     const
+       system_aarch64_embedded_info : tsysteminfo =
+          (
+            system       : system_aarch64_embedded;
+            name         : 'Embedded';
+            shortname    : 'embedded';
+            flags        : [tf_needs_symbol_size,tf_files_case_sensitive,tf_requires_proper_alignment,
+                            tf_smartlink_sections,tf_init_final_units_by_calls];
+            cpu          : cpu_aarch64;
+            unit_env     : '';
+            extradefines : '';
+            exeext       : '';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            staticlibprefix : 'libp';
+            sharedlibprefix : 'lib';
+            sharedClibext : '.so';
+            staticClibext : '.a';
+            staticClibprefix : 'lib';
+            sharedClibprefix : 'lib';
+            importlibprefix : 'libimp';
+            importlibext : '.a';
+            Cprefix      : '';
+            newline      : #10;
+            dirsep       : '/';
+            assem        : as_gas;
+            assemextern  : as_gas;
+            link         : ld_none;
+            linkextern   : ld_embedded;
+            ar           : ar_gnu_ar;
+            res          : res_none;
+            dbg          : dbg_dwarf2;
+            script       : script_unix;
+            endian       : endian_little;
+            alignment    :
+              (
+                procalign       : 8;
+                loopalign       : 8;
+                jumpalign       : 0;
+                jumpalignskipmax    : 0;
+                coalescealign   : 0;
+                coalescealignskipmax: 0;
+                constalignmin   : 0;
+                constalignmax   : 8;
+                varalignmin     : 0;
+                varalignmax     : 8;
+                localalignmin   : 8;
+                localalignmax   : 8;
+                recordalignmin  : 0;
+                recordalignmax  : 8;
+                maxCrecordalign : 8
+              );
+            first_parm_offset : 8;
+            stacksize    : 262144;
+            stackalign   : 16;
+            abi : abi_default;
+            llvmdatalayout : 'e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128';
+          );
+
        system_arm_embedded_info : tsysteminfo =
           (
             system       : system_arm_embedded;
@@ -858,6 +925,11 @@ unit i_embed;
  implementation
 
 initialization
+{$ifdef cpuaarch64}
+  {$ifdef embedded}
+    set_source_info(system_aarch64_embedded_info);
+  {$endif embedded}
+{$endif cpuaarch64}
 {$ifdef CPUARM}
   {$ifdef embedded}
     set_source_info(system_arm_embedded_info);

compiler/systems/i_linux.pas

@@ -964,7 +964,7 @@ unit i_linux;
 
        system_mipseb_linux_info : tsysteminfo =
           (
-            system       : system_mipseb_LINUX;
+            system       : system_mipseb_linux;
             name         : 'Linux for MIPSEB';
             shortname    : 'Linux';
             flags        : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive,
@@ -1034,7 +1034,7 @@ unit i_linux;
 
        system_mipsel_linux_info : tsysteminfo =
           (
-            system       : system_mipsel_LINUX;
+            system       : system_mipsel_linux;
             name         : 'Linux for MIPSEL';
             shortname    : 'Linux';
             flags        : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive,
@@ -1102,6 +1102,146 @@ unit i_linux;
             llvmdatalayout : 'e-p:32:32:32-i1:8:8-i8:8:32-i16:16:32-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-n32-S64';
           );
 
+       system_mips64_linux_info : tsysteminfo =
+          (
+            system       : system_mips64_linux;
+            name         : 'Linux for MIPS64';
+            shortname    : 'Linux';
+            flags        : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive,
+                            tf_requires_proper_alignment,tf_library_needs_pic,
+                            tf_pic_uses_got,tf_safecall_exceptions,
+                            tf_smartlink_sections,tf_has_winlike_resources,tf_supports_hidden_symbols];
+            cpu          : cpu_mips64;
+            unit_env     : 'LINUXUNITS';
+            extradefines : 'UNIX;HASUNIX';
+            exeext       : '';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            staticlibprefix : 'libp';
+            sharedlibprefix : 'lib';
+            sharedClibext : '.so';
+            staticClibext : '.a';
+            staticClibprefix : 'lib';
+            sharedClibprefix : 'lib';
+            importlibprefix : 'libimp';
+            importlibext : '.a';
+//            p_ext_support : false;
+            Cprefix      : '';
+            newline      : #10;
+            dirsep       : '/';
+            assem        : as_gas;
+            assemextern  : as_gas;
+            link         : ld_none;
+            linkextern   : ld_linux;
+            ar           : ar_gnu_ar;
+            res          : res_elf;
+            dbg          : dbg_stabs;
+            script       : script_unix;
+            endian       : endian_big;
+            alignment    :
+              (
+                procalign       : 4;
+                loopalign       : 4;
+                jumpalign       : 0;
+                jumpalignskipmax    : 0;
+                coalescealign   : 0;
+                coalescealignskipmax: 0;
+                constalignmin   : 0;
+                constalignmax   : 8;
+                varalignmin     : 0;
+                varalignmax     : 8;
+                localalignmin   : 4;
+                localalignmax   : 8;
+                recordalignmin  : 0;
+                recordalignmax  : 8;
+                maxCrecordalign : 8
+              );
+            first_parm_offset : 0;
+            stacksize    : 32*1024*1024;
+            stackalign   : 8;
+            abi : abi_default;
+            llvmdatalayout : 'e-p:32:32:32-i1:8:8-i8:8:32-i16:16:32-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-n32-S64';
+          );
+
+       system_mips64el_linux_info : tsysteminfo =
+          (
+            system       : system_mips64el_linux;
+            name         : 'Linux for MIPS64EL';
+            shortname    : 'Linux';
+            flags        : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive,
+                            tf_requires_proper_alignment,tf_library_needs_pic,
+                            tf_pic_uses_got,tf_safecall_exceptions,
+                            tf_smartlink_sections,tf_has_winlike_resources,tf_supports_hidden_symbols];
+            cpu          : cpu_mips64el;
+            unit_env     : 'LINUXUNITS';
+            extradefines : 'UNIX;HASUNIX';
+            exeext       : '';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            staticlibprefix : 'libp';
+            sharedlibprefix : 'lib';
+            sharedClibext : '.so';
+            staticClibext : '.a';
+            staticClibprefix : 'lib';
+            sharedClibprefix : 'lib';
+            importlibprefix : 'libimp';
+            importlibext : '.a';
+//            p_ext_support : false;
+            Cprefix      : '';
+            newline      : #10;
+            dirsep       : '/';
+            assem        : as_gas;
+            assemextern  : as_gas;
+            link         : ld_none;
+            linkextern   : ld_linux;
+            ar           : ar_gnu_ar;
+            res          : res_elf;
+            dbg          : dbg_dwarf4;
+            script       : script_unix;
+            endian       : endian_little;
+            alignment    :
+              (
+                procalign       : 4;
+                loopalign       : 4;
+                jumpalign       : 0;
+                jumpalignskipmax    : 0;
+                coalescealign   : 0;
+                coalescealignskipmax: 0;
+                constalignmin   : 0;
+                constalignmax   : 8;
+                varalignmin     : 0;
+                varalignmax     : 8;
+                localalignmin   : 4;
+                localalignmax   : 8;
+                recordalignmin  : 0;
+                recordalignmax  : 8;
+                maxCrecordalign : 8
+              );
+            first_parm_offset : 0;
+            stacksize    : 32*1024*1024;
+            stackalign   : 8;
+            abi : abi_default;
+            llvmdatalayout : 'e-p:32:32:32-i1:8:8-i8:8:32-i16:16:32-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-n32-S64';
+          );
+
        system_riscv32_linux_info : tsysteminfo =
           (
             system       : system_riscv32_linux;
@@ -1394,5 +1534,15 @@ initialization
     set_source_info(system_xtensa_linux_info);
   {$endif linux}
 {$endif CPUXTENSA}
+{$ifdef CPUMIPS64EB}
+  {$ifdef linux}
+    set_source_info(system_mips64_linux_info);
+  {$endif linux}
+{$endif CPUMIPS64EB}
+{$ifdef CPUMIPS64EL}
+  {$ifdef linux}
+    set_source_info(system_mips64el_linux_info);
+  {$endif linux}
+{$endif CPUMIPS64EL}
 end.
 

compiler/systems/i_sinclairql.pas

@@ -100,8 +100,8 @@ unit i_sinclairql;
 
 initialization
 {$ifdef cpu68}
-  {$ifdef atari}
+  {$ifdef sinclairql}
     set_source_info(system_m68k_sinclairql_info);
-  {$endif atari}
+  {$endif sinclairql}
 {$endif cpu68}
 end.

compiler/systems/t_atari.pas

@@ -69,11 +69,11 @@ begin
    begin
     if not UseVLink then
      begin
-      ExeCmd[1]:='ld $DYNLINK $OPT -d -n -o $EXE $RES';
+      ExeCmd[1]:='ld $DYNLINK $FLAGS $OPT $STRIP $MAP -d -n -o $EXE -T $RES';
      end
     else
      begin
-      ExeCmd[1]:='vlink -b ataritos $FLAGS $GCSECTIONS $OPT $STRIP $MAP -o $EXE -T $RES';
+      ExeCmd[1]:='vlink -b '+ataritos_exe_format+' $FLAGS $GCSECTIONS $OPT $STRIP $MAP -o $EXE -T $RES';
      end;
    end;
 end;
@@ -126,6 +126,69 @@ begin
     HPath:=TCmdStrListItem(HPath.Next);
    end;
 
+  if not UseVLink then
+   begin
+    LinkRes.Add('SECTIONS');
+    LinkRes.Add('{');
+    LinkRes.Add('  .text 0xe4:');
+    LinkRes.Add('  {');
+    LinkRes.Add('    CREATE_OBJECT_SYMBOLS');
+    LinkRes.Add('    *(.text)');
+    LinkRes.Add('    CONSTRUCTORS');
+    LinkRes.Add('    _etext = .;');
+    LinkRes.Add('    __etext = .;');
+    LinkRes.Add('  }');
+    LinkRes.Add('  .data :');
+    LinkRes.Add('  {');
+    LinkRes.Add('    *(.data)');
+    LinkRes.Add('    _edata = .;');
+    LinkRes.Add('    __edata = .;');
+    LinkRes.Add('  }');
+    LinkRes.Add('  .bss :');
+    LinkRes.Add('  {');
+    LinkRes.Add('    __bss_start = .;');
+    LinkRes.Add('    *(.bss)');
+    LinkRes.Add('    *(COMMON)');
+    LinkRes.Add('    _end = .;');
+    LinkRes.Add('    __end = .;');
+    LinkRes.Add('  }');
+    LinkRes.Add('}');
+   end;
+  if (UseVLink) and (ataritos_exe_format = 'aoutmint') then
+   begin
+	LinkRes.Add('SECTIONS {');
+	LinkRes.Add('  . = 0xe4;');
+	LinkRes.Add('  .text: {');
+	LinkRes.Add('    *(.i* i* I*)');
+	LinkRes.Add('    *(.t* t* T* .c* c* CODE*)');
+	LinkRes.Add('    *(.f* f* F*)');
+	LinkRes.Add('    _etext = .;');
+	LinkRes.Add('    __etext = .;');
+	LinkRes.Add('    . = ALIGN(4);');
+	LinkRes.Add('  }');
+	LinkRes.Add('  .data: {');
+	LinkRes.Add('    PROVIDE(_LinkerDB = . + 0x8000);');
+	LinkRes.Add('    PROVIDE(_SDA_BASE_ = . + 0x8000);');
+	LinkRes.Add('    VBCC_CONSTRUCTORS');
+	LinkRes.Add('    *(.rodata*)');
+	LinkRes.Add('    *(.d* d* D*)');
+	LinkRes.Add('    *(.sdata*)');
+	LinkRes.Add('    *(__MERGED)');
+	LinkRes.Add('    _edata = .;');
+	LinkRes.Add('    __edata = .;');
+	LinkRes.Add('    . = ALIGN(4);');
+	LinkRes.Add('  }');
+	LinkRes.Add('  .bss: {');
+	LinkRes.Add('    *(.sbss*)');
+	LinkRes.Add('    *(.scommon)');
+	LinkRes.Add('    *(.b* b* B* .u* u* U*)');
+	LinkRes.Add('    *(COMMON)');
+	LinkRes.Add('    _end = ALIGN(4);');
+	LinkRes.Add('    __end = ALIGN(4);');
+	LinkRes.Add('  }');
+	LinkRes.Add('}');;
+   end;
+
   LinkRes.Add('INPUT (');
   { add objectfiles, start with prt0 always }
   if not (target_info.system in systems_internal_sysinit) then
@@ -224,10 +287,16 @@ begin
   GCSectionsStr:='';
   DynLinkStr:='';
   MapStr:='';
-  FlagsStr:='-tos-flags fastload,fastram';
+  if UseVLink then
+    FlagsStr:='-tos-flags '+tostr(ataritos_exe_flags)
+  else
+    FlagsStr:='--mprg-flags '+tostr(ataritos_exe_flags);
 
-  if UseVlink and (cs_link_map in current_settings.globalswitches) then
-    MapStr:='-M'+maybequoted(ScriptFixFileName(current_module.mapfilename));
+  if (cs_link_map in current_settings.globalswitches) then
+    if UseVLink then
+      MapStr:='-M'+maybequoted(ScriptFixFileName(current_module.mapfilename))
+    else
+      MapStr:='-Map '+maybequoted(ScriptFixFileName(current_module.mapfilename));
   if (cs_link_strip in current_settings.globalswitches) then
     StripStr:='-s';
   if rlinkpath<>'' then

compiler/systems/t_embed.pas

@@ -123,7 +123,7 @@ Var
 begin
   WriteResponseFile:=False;
   linklibc:=(SharedLibFiles.Find('c')<>nil);
-{$if defined(ARM) or defined(i386) or defined(x86_64) or defined(AVR) or defined(MIPSEL) or defined(RISCV32) or defined(XTENSA)}
+{$if defined(ARM) or defined(i386) or defined(x86_64) or defined(AVR) or defined(MIPSEL) or defined(RISCV32) or defined(XTENSA) or defined(AARCH64)}
   prtobj:='';
 {$else}
   prtobj:='prt0';
@@ -256,6 +256,107 @@ begin
       end;
    end;
 
+{$ifdef AARCH64}
+  case current_settings.controllertype of
+    ct_none:
+      begin
+      end;
+    ct_raspi3:
+      begin
+        with embedded_controllers[current_settings.controllertype] do
+        begin
+          with linkres do
+          begin
+            Add('ENTRY(_START)');
+            Add('MEMORY');
+            Add('{');
+            Add('    ram : ORIGIN = 0x' + IntToHex(srambase,8)
+              + ', LENGTH = 0x' + IntToHex(sramsize,8));
+
+            Add('}');
+            Add('_stack_top = 0x' + IntToHex(sramsize+srambase,8) + ';');
+
+            Add('SECTIONS');
+            Add('{');
+            Add('    .text :');
+            Add('    {');
+            Add('      _text_start = .;');
+            Add('      KEEP(*(.init .init.*))');
+            Add('      *(.text .text.* .gnu.linkonce.t*)');
+            Add('      *(.strings)');
+            Add('      *(.rodata .rodata.* .gnu.linkonce.r*)');
+            Add('      *(.comment)');
+            Add('      . = ALIGN(8);');
+            Add('      _etext = .;');
+            Add('    } >ram');
+            Add('    .note.gnu.build-id : { *(.note.gnu.build-id) } >ram ');
+
+            Add('    .data :');
+            Add('    {');
+            Add('      _data = .;');
+            Add('      *(.data .data.* .gnu.linkonce.d*)');
+            Add('      KEEP (*(.fpc .fpc.n_version .fpc.n_links))');
+            Add('      _edata = .;');
+            Add('    } >ram');
+
+            Add('    .bss :');
+            Add('    {');
+            Add('      . = ALIGN(16);');
+            Add('      _bss_start = .;');
+            Add('      *(.bss .bss.*)');
+            Add('      *(COMMON)');
+            Add('    } >ram');
+            Add('. = ALIGN(8);');
+            Add('_bss_end = . ;');
+
+            Add('  .stab          0 : { *(.stab) }');
+            Add('  .stabstr       0 : { *(.stabstr) }');
+            Add('  .stab.excl     0 : { *(.stab.excl) }');
+            Add('  .stab.exclstr  0 : { *(.stab.exclstr) }');
+            Add('  .stab.index    0 : { *(.stab.index) }');
+            Add('  .stab.indexstr 0 : { *(.stab.indexstr) }');
+            Add('  .comment       0 : { *(.comment) }');
+            Add('  /* DWARF debug sections.');
+            Add('     Symbols in the DWARF debugging sections are relative to the beginning');
+            Add('     of the section so we begin them at 0.  */');
+            Add('  /* DWARF 1 */');
+            Add('  .debug          0 : { *(.debug) }');
+            Add('  .line           0 : { *(.line) }');
+            Add('  /* GNU DWARF 1 extensions */');
+            Add('  .debug_srcinfo  0 : { *(.debug_srcinfo) }');
+            Add('  .debug_sfnames  0 : { *(.debug_sfnames) }');
+            Add('  /* DWARF 1.1 and DWARF 2 */');
+            Add('  .debug_aranges  0 : { *(.debug_aranges) }');
+            Add('  .debug_pubnames 0 : { *(.debug_pubnames) }');
+            Add('  /* DWARF 2 */');
+            Add('  .debug_info     0 : { *(.debug_info .gnu.linkonce.wi.*) }');
+            Add('  .debug_abbrev   0 : { *(.debug_abbrev) }');
+            Add('  .debug_line     0 : { *(.debug_line) }');
+            Add('  .debug_frame    0 : { *(.debug_frame) }');
+            Add('  .debug_str      0 : { *(.debug_str) }');
+            Add('  .debug_loc      0 : { *(.debug_loc) }');
+            Add('  .debug_macinfo  0 : { *(.debug_macinfo) }');
+            Add('  /* SGI/MIPS DWARF 2 extensions */');
+            Add('  .debug_weaknames 0 : { *(.debug_weaknames) }');
+            Add('  .debug_funcnames 0 : { *(.debug_funcnames) }');
+            Add('  .debug_typenames 0 : { *(.debug_typenames) }');
+            Add('  .debug_varnames  0 : { *(.debug_varnames) }');
+            Add('  /* DWARF 3 */');
+            Add('  .debug_pubtypes 0 : { *(.debug_pubtypes) }');
+            Add('  .debug_ranges   0 : { *(.debug_ranges) }');
+
+            Add('}');
+            Add('_bss_size = (_bss_end - _bss_start)>>3;');
+            Add('_end = .;');
+          end;
+        end;
+    end
+    else
+      if not (cs_link_nolink in current_settings.globalswitches) then
+          internalerror(200902011);
+  end;
+{$endif}
+
 {$ifdef ARM}
   case current_settings.controllertype of
       ct_none:
@@ -435,7 +536,7 @@ begin
       ct_stm32f107rc,
       ct_stm32f107vb,
       ct_stm32f107vc,
-      
+
       ct_stm32f401cb,
       ct_stm32f401rb,
       ct_stm32f401vb,
@@ -573,12 +674,12 @@ begin
       ct_lm3s9b92,
       ct_lm3s9b95,
       ct_lm3s9b96,
-      
+
       ct_lm3s5d51,
-      
+
       { TI - Stellaris something }
       ct_lm4f120h5,
-      
+
       { Infineon }
       ct_xmc4500x1024,
       ct_xmc4500x768,
@@ -631,14 +732,14 @@ begin
       ct_mk22fn512vll12,
       ct_mk22fn512vmp12,
       ct_freedom_k22f,
- 
+
       { Atmel }
       ct_sam3x8e,
       ct_samd51p19a,
       ct_arduino_due,
       ct_flip_n_click,
       ct_wio_terminal,
-      
+
       { Nordic Semiconductor }
       ct_nrf51422_xxaa,
       ct_nrf51422_xxab,
@@ -648,7 +749,7 @@ begin
       ct_nrf51822_xxac,
       ct_nrf52832_xxaa,
       ct_nrf52840_xxaa,
-      
+
       ct_sc32442b,
 
       { Raspberry Pi 2 }
@@ -681,8 +782,8 @@ begin
 
               Add('}');
               Add('_stack_top = 0x' + IntToHex(sramsize+srambase,8) + ';');
-    
-              // Add Checksum Calculation for LPC Controllers so that the bootloader starts the uploaded binary 
+
+              // Add Checksum Calculation for LPC Controllers so that the bootloader starts the uploaded binary
               writeln(controllerunitstr);
               if (controllerunitstr = 'LPC8xx') or (controllerunitstr = 'LPC11XX') or (controllerunitstr = 'LPC122X') then
                 Add('Startup_Checksum = 0 - (_stack_top + _START + 1 + NonMaskableInt_interrupt + 1 + Hardfault_interrupt + 1);');
@@ -1697,7 +1798,7 @@ function TLinkerEmbedded.postprocessexecutable(const fn : string;isdll:boolean):
 
 
 function TlinkerEmbedded.GenerateUF2(binFile,uf2File : string;baseAddress : longWord):boolean;
-type 
+type
   TFamilies= record
     k : String;
     v : longWord;
@@ -2124,6 +2225,11 @@ function TLinkerEmbedded_Wasm.MakeSharedLibrary: boolean;
 *****************************************************************************}
 
 initialization
+{$ifdef aarch64}
+  RegisterLinker(ld_embedded,TLinkerEmbedded);
+  RegisterTarget(system_aarch64_embedded_info);
+{$endif aarch64}
+
 {$ifdef arm}
   RegisterLinker(ld_embedded,TLinkerEmbedded);
   RegisterTarget(system_arm_embedded_info);

compiler/systems/t_freertos.pas

@@ -40,7 +40,7 @@ implementation
        private
           Function  WriteResponseFile: Boolean;
 {$ifdef XTENSA}
-          procedure GenerateDefaultLinkerScripts(out out_ld_filename,project_ld_filename: AnsiString);
+          procedure GenerateDefaultLinkerScripts(var memory_filename,sections_filename: AnsiString);
 {$endif XTENSA}
        public
           constructor Create; override;
@@ -946,14 +946,65 @@ end;
   default scripts so that linking can proceed.  Note: the generated
   scripts may not match the actual options chosen when the libraries
   were built. }
-procedure TlinkerFreeRTOS.GenerateDefaultLinkerScripts(out out_ld_filename,
-  project_ld_filename: AnsiString);
+procedure TlinkerFreeRTOS.GenerateDefaultLinkerScripts(var memory_filename,
+  sections_filename: AnsiString);
+type
+  Tesp_idf_index=(esp32_v4_2=0,esp32_v4_4,esp8266_v3_3);
+const
+  esp_fragment_list: array[esp32_v4_2..esp8266_v3_3] of array of string=(
+    ('xtensa/linker',
+    'soc/linker',
+    'esp_event/linker',
+    'spi_flash/linker',
+    'esp_wifi/linker',
+    'lwip/linker',
+    'heap/linker',
+    'esp_ringbuf/linker',
+    'espcoredump/linker',
+    'esp32/linker',
+    'esp32/ld/esp32_fragments',
+    'freertos/linker',
+    'newlib/newlib',
+    'esp_gdbstub/linker'),
+    ('driver/linker',
+    'esp_pm/linker',
+    'spi_flash/linker',
+    'esp_gdbstub/linker',
+    'espcoredump/linker',
+    'esp_phy/linker',
+    'esp_system/linker',
+    'esp_system/app',
+    'hal/linker',
+    'esp_event/linker',
+    'esp_wifi/linker',
+    'lwip/linker',
+    'log/linker',
+    'heap/linker',
+    'soc/linker',
+    'esp_hw_support/linker',
+    'xtensa/linker',
+    'esp_common/common',
+    'esp_common/soc',
+    'freertos/linker',
+    'newlib/newlib',
+    'newlib/system_libs',
+    'app_trace/linker',
+    'bt/linker'),
+    ('esp8266/ld/esp8266_fragments',
+    'esp8266/ld/esp8266_bss_fragments',
+    'esp8266/linker',
+    'freertos/linker',
+    'log/linker',
+    'lwip/linker',
+    'spi_flash/linker'));
+
 var
   S: Ansistring;
   t: Text;
   hp: TCmdStrListItem;
   filepath: TCmdStr = '';
   i,j: integer;
+  idf_index: Tesp_idf_index;
   lib,
   binstr,
   cmdstr: AnsiString;
@@ -1154,13 +1205,20 @@ begin
     exit;
   {$pop}
 
+  memory_filename:=IncludeTrailingPathDelimiter(outputexedir)+memory_filename;
+  cmdstr:='-C -P -x c -E -o '+memory_filename+' -I $OUTPUT ';
   binstr:='gcc';
   if current_settings.controllertype = ct_none then
     Message(exec_f_controllertype_expected)
   else if current_settings.controllertype = ct_esp32 then
-    cmdstr:='-C -P -x c -E -o $OUTPUT/esp32_out.ld -I $OUTPUT/ $IDF_PATH/components/esp32/ld/esp32.ld'
+    begin
+      if idf_version>=40400 then
+        cmdstr:=cmdstr+'$IDF_PATH/components/esp_system/ld/esp32/sections.ld.in'
+      else
+        cmdstr:=cmdstr+'$IDF_PATH/components/esp32/ld/esp32.ld';
+    end
   else
-    cmdstr:='-C -P -x c -E -o $OUTPUT/esp8266_out.ld -I $OUTPUT/ $IDF_PATH/components/esp8266/ld/esp8266.ld';
+    cmdstr:=cmdstr+'$IDF_PATH/components/esp8266/ld/esp8266.ld';
   Replace(cmdstr,'$IDF_PATH',idfpath);
   Replace(cmdstr,'$OUTPUT',outputexedir);
   success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,true);
@@ -1173,46 +1231,49 @@ begin
 {$endif UNIX}
   if source_info.exeext<>'' then
     binstr:=binstr+source_info.exeext;
-  S:=FindUtil(utilsprefix+'objdump');
+
+  sections_filename:=IncludeTrailingPathDelimiter(outputexedir)+sections_filename;
+
+  cmdstr:={$ifndef UNIX}'$IDF_PATH/tools/ldgen/ldgen.py '+{$endif UNIX}
+          '--config $OUTPUT/sdkconfig --fragments';
+
+  { Pick corresponding linker fragments list for SDK version }
+  if (current_settings.controllertype = ct_esp32) then
+    if idf_version>=40400 then
+      idf_index:=esp32_v4_4
+    else
+      idf_index:=esp32_v4_2
+  else
+    idf_index:=esp8266_v3_3;
+
+  for S in esp_fragment_list[idf_index] do
+    cmdstr:=cmdstr+' $IDF_PATH/components/'+S+'.lf';
+
   if (current_settings.controllertype = ct_esp32) then
     begin
-      project_ld_filename:=outputexedir+'/esp32.project.ld';
-      cmdstr:={$ifndef UNIX}'$IDF_PATH/tools/ldgen/ldgen.py '+{$endif UNIX}
-              '--config $OUTPUT/sdkconfig '+
-              '--fragments $IDF_PATH/components/xtensa/linker.lf $IDF_PATH/components/soc/linker.lf $IDF_PATH/components/esp_event/linker.lf '+
-              '$IDF_PATH/components/spi_flash/linker.lf $IDF_PATH/components/esp_wifi/linker.lf $IDF_PATH/components/lwip/linker.lf '+
-              '$IDF_PATH/components/heap/linker.lf $IDF_PATH/components/esp_ringbuf/linker.lf $IDF_PATH/components/espcoredump/linker.lf $IDF_PATH/components/esp32/linker.lf '+
-              '$IDF_PATH/components/esp32/ld/esp32_fragments.lf $IDF_PATH/components/freertos/linker.lf $IDF_PATH/components/newlib/newlib.lf '+
-              '$IDF_PATH/components/esp_gdbstub/linker.lf '+
-              '--input $IDF_PATH/components/esp32/ld/esp32.project.ld.in '+
-              '--output '+project_ld_filename+' '+
-              '--kconfig $IDF_PATH/Kconfig '+
-              '--env-file $OUTPUT/config.env '+
-              '--libraries-file $OUTPUT/ldgen_libraries '+
-              '--objdump '+S;
+     if idf_version>=40400 then
+       cmdstr:=cmdstr+' --input $IDF_PATH/components/esp_system/esp32/ld/sections.ld.in'
+     else
+       cmdstr:=cmdstr+' --input $IDF_PATH/components/esp32/ld/esp32.project.ld.in';
     end
   else
     begin
-      project_ld_filename:=outputexedir+'/esp8266.project.ld';
-      cmdstr:={$ifndef UNIX}'$IDF_PATH/tools/ldgen/ldgen.py '+{$endif UNIX}
-              '--config $OUTPUT/sdkconfig '+
-              '--fragments $IDF_PATH/components/esp8266/ld/esp8266_fragments.lf '+
-              '$IDF_PATH/components/esp8266/ld/esp8266_bss_fragments.lf $IDF_PATH/components/esp8266/linker.lf '+
-              '$IDF_PATH/components/freertos/linker.lf $IDF_PATH/components/log/linker.lf '+
-              '$IDF_PATH/components/lwip/linker.lf $IDF_PATH/components/spi_flash/linker.lf '+
-              '--env "COMPONENT_KCONFIGS_PROJBUILD=  $IDF_PATH/components/bootloader/Kconfig.projbuild '+
-              '$IDF_PATH/components/esptool_py/Kconfig.projbuild  $IDF_PATH/components/partition_table/Kconfig.projbuild"'+
-              '--env "COMPONENT_KCONFIGS=$IDF_PATH/components/app_update/Kconfig '+
-              '$IDF_PATH/components/esp8266/Kconfig  $IDF_PATH/components/freertos/Kconfig '+
-              '$IDF_PATH/components/log/Kconfig $IDF_PATH/components/lwip/Kconfig" '+
-              '--input $IDF_PATH/components/esp8266/ld/esp8266.project.ld.in '+
-              '--output '+project_ld_filename+' '+
-              '--kconfig $IDF_PATH/Kconfig '+
-              '--env-file $OUTPUT/config.env '+
-              '--libraries-file $OUTPUT/ldgen_libraries '+
-              '--objdump '+S;
+      cmdstr:=cmdstr+
+              ' --env "COMPONENT_KCONFIGS_PROJBUILD=  $IDF_PATH/components/bootloader/Kconfig.projbuild'+
+              ' $IDF_PATH/components/esptool_py/Kconfig.projbuild  $IDF_PATH/components/partition_table/Kconfig.projbuild"'+
+              ' --env "COMPONENT_KCONFIGS=$IDF_PATH/components/app_update/Kconfig'+
+              ' $IDF_PATH/components/esp8266/Kconfig  $IDF_PATH/components/freertos/Kconfig'+
+              ' $IDF_PATH/components/log/Kconfig $IDF_PATH/components/lwip/Kconfig"'+
+              ' --input $IDF_PATH/components/esp8266/ld/esp8266.project.ld.in';
     end;
 
+  S:=FindUtil(utilsprefix+'objdump');
+  cmdstr:=cmdstr+' --output '+sections_filename+
+          ' --kconfig $IDF_PATH/Kconfig'+
+          ' --env-file $OUTPUT/config.env'+
+          ' --libraries-file $OUTPUT/ldgen_libraries'+
+          ' --objdump '+S;
+
   Replace(cmdstr,'$IDF_PATH',idfpath);
   Replace(cmdstr,'$OUTPUT',outputexedir);
   if success then
@@ -1233,9 +1294,9 @@ var
   StripStr,
   FixedExeFileName: string;
 {$ifdef XTENSA}
-  esp_out_ld_filename,
-  esp_project_ld_filename: AnsiString;
-{$endif XTENSA}
+  memory_script,
+  sections_script: AnsiString;
+  {$endif XTENSA}
 begin
 {$ifdef XTENSA}
   { idfpath can be set by -Ff, else default to environment value of IDF_PATH }
@@ -1255,13 +1316,30 @@ begin
 
 {$ifdef XTENSA}
   { Locate linker scripts.  If not found, generate defaults. }
-  if ((current_settings.controllertype = ct_esp32) and
-      not (FindLibraryFile('esp32_out','', '.ld', esp_out_ld_filename) and
-           FindLibraryFile('esp32.project','', '.ld', esp_project_ld_filename))) or
-     ((current_settings.controllertype = ct_esp8266) and
-      not (FindLibraryFile('esp8266_out','', '.ld', esp_out_ld_filename) and
-           FindLibraryFile('esp8266.project','', '.ld', esp_project_ld_filename))) then
-    GenerateDefaultLinkerScripts(esp_out_ld_filename,esp_project_ld_filename);
+  { Cater for different script names in different esp-idf versions }
+
+  if (current_settings.controllertype = ct_esp32) then
+    begin
+      if idf_version >= 40400 then
+        begin
+          memory_script := 'memory.ld';
+          sections_script := 'sections.ld';
+        end
+      else
+      begin
+        memory_script := 'esp32_out.ld';
+        sections_script := 'esp32.project.ld';
+      end;
+    end
+  else if (current_settings.controllertype = ct_esp8266) then
+    begin
+     memory_script := 'esp8266_out.ld';
+     sections_script := 'esp8266.project.ld';
+    end;
+
+  if not (FindLibraryFile(memory_script,'','',memory_script) and
+         FindLibraryFile(sections_script,'','',sections_script)) then
+    GenerateDefaultLinkerScripts(memory_script,sections_script);
 
   if (current_settings.controllertype = ct_esp32) then
     begin
@@ -1269,16 +1347,22 @@ begin
        '-u newlib_include_heap_impl -u newlib_include_syscalls_impl -u newlib_include_pthread_impl -u app_main -u uxTopUsedPriority '+
        '-L $IDF_PATH/components/esp_rom/esp32/ld '+
        '-T esp32.rom.ld -T esp32.rom.libgcc.ld -T esp32.rom.newlib-data.ld -T esp32.rom.syscalls.ld -T esp32.rom.newlib-funcs.ld '+
-       '-T '+esp_out_ld_filename+' -T '+esp_project_ld_filename+' '+
-       '-L $IDF_PATH/components/esp32/ld -T esp32.peripherals.ld';
-      if idf_version>=40200 then
-        Info.ExeCmd[1]:=Info.ExeCmd[1]+' -L $IDF_PATH/components/esp32_rom/esp32/ld -T esp32.rom.api.ld';
+       '-T '+memory_script+' -T '+sections_script;
+
+      if idf_version<40400 then
+        Info.ExeCmd[1]:=Info.ExeCmd[1]+' -L $IDF_PATH/components/esp32/ld -T esp32.peripherals.ld'
+      else
+        Info.ExeCmd[1]:=Info.ExeCmd[1]+' -L $IDF_PATH/components/soc/esp32/ld -T esp32.peripherals.ld';
+      if idf_version>=40300 then
+        Info.ExeCmd[1]:=Info.ExeCmd[1]+' -T esp32.rom.api.ld';
+      if idf_version>=40400 then
+        Info.ExeCmd[1]:=Info.ExeCmd[1]+' -T esp32.rom.newlib-time.ld';
     end
   else
     begin
       Info.ExeCmd[1] := Info.ExeCmd[1]+' -u call_user_start -u g_esp_sys_info -u _printf_float -u _scanf_float '+
         '-L $IDF_PATH/components/esp8266/ld -T esp8266.peripherals.ld -T esp8266.rom.ld '+ { SDK scripts }
-        '-T '+esp_out_ld_filename+' -T '+esp_project_ld_filename; { Project scripts }
+        '-T '+memory_script+' -T '+sections_script; { Project scripts }
     end;
 
   Replace(Info.ExeCmd[1],'$IDF_PATH',idfpath);

compiler/systems/t_linux.pas

@@ -1305,17 +1305,27 @@ initialization
   RegisterExport(system_aarch64_linux,texportliblinux);
   RegisterTarget(system_aarch64_linux_info);
 {$endif aarch64}
-{$ifdef MIPS}
+{$ifdef MIPS32}
 {$ifdef MIPSEL}
   RegisterImport(system_mipsel_linux,timportliblinux);
   RegisterExport(system_mipsel_linux,texportliblinux);
   RegisterTarget(system_mipsel_linux_info);
-{$else MIPS}
+{$else MIPSEL}
   RegisterImport(system_mipseb_linux,timportliblinux);
   RegisterExport(system_mipseb_linux,texportliblinux);
   RegisterTarget(system_mipseb_linux_info);
 {$endif MIPSEL}
-{$endif MIPS}
+{$endif MIPS32}
+{$ifdef MIPS64}
+  RegisterImport(system_mips64_linux,timportliblinux);
+  RegisterExport(system_mips64_linux,texportliblinux);
+  RegisterTarget(system_mips64_linux_info);
+{$endif MIPS64}
+{$ifdef MIPS64EL}
+  RegisterImport(system_mips64el_linux,timportliblinux);
+  RegisterExport(system_mips64el_linux,texportliblinux);
+  RegisterTarget(system_mips64el_linux_info);
+{$endif MIPS64EL}
 {$ifdef riscv32}
   RegisterImport(system_riscv32_linux,timportliblinux);
   RegisterExport(system_riscv32_linux,texportliblinux);

compiler/utils/Makefile

@@ -2,7 +2,7 @@
 # Don't edit, this file is generated by FPCMake Version 2.0.0
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macosclassic m68k-embedded m68k-sinclairql powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macosclassic 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-haiku x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros arm-freertos arm-ios powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android mips64el-linux jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-freebsd aarch64-darwin aarch64-win64 aarch64-android aarch64-ios wasm32-embedded wasm32-wasi sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded xtensa-linux xtensa-embedded xtensa-freertos z80-embedded z80-zxspectrum z80-msxdos z80-amstradcpc
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macosclassic m68k-embedded m68k-sinclairql powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macosclassic 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-haiku x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros arm-freertos arm-ios powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android mips64el-linux jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-freebsd aarch64-darwin aarch64-win64 aarch64-embedded aarch64-android aarch64-ios wasm32-embedded wasm32-wasi sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded xtensa-linux xtensa-embedded xtensa-freertos z80-embedded z80-zxspectrum z80-msxdos z80-amstradcpc
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari
@@ -178,6 +178,8 @@ else
 ARCH=$(CPU_TARGET)
 endif
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+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)
@@ -620,6 +622,9 @@ endif
 ifeq ($(FULL_TARGET),aarch64-win64)
 override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove mka64ins mkarmins mkx86ins msg2inc mkx86inl mkz80ins
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove mka64ins mkarmins mkx86ins msg2inc mkx86inl mkz80ins
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove mka64ins mkarmins mkx86ins msg2inc mkx86inl mkz80ins
 endif
@@ -938,6 +943,9 @@ endif
 ifeq ($(FULL_TARGET),aarch64-win64)
 override CLEAN_UNITS+=ppu crc
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+override CLEAN_UNITS+=ppu crc
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 override CLEAN_UNITS+=ppu crc
 endif
@@ -1257,6 +1265,9 @@ endif
 ifeq ($(FULL_TARGET),aarch64-win64)
 override COMPILER_UNITDIR+=..
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+override COMPILER_UNITDIR+=..
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 override COMPILER_UNITDIR+=..
 endif
@@ -1575,6 +1586,9 @@ endif
 ifeq ($(FULL_TARGET),aarch64-win64)
 override COMPILER_SOURCEDIR+=..
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+override COMPILER_SOURCEDIR+=..
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 override COMPILER_SOURCEDIR+=..
 endif
@@ -2660,6 +2674,9 @@ endif
 ifeq ($(FULL_TARGET),aarch64-win64)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 REQUIRE_PACKAGES_RTL=1
 endif

compiler/utils/ppuutils/ppudump.pp

@@ -87,7 +87,9 @@ const
     { 19 } 'riscv32',
     { 20 } 'riscv64',
     { 21 } 'xtensa',
-    { 22 } 'z80'
+    { 22 } 'z80',
+    { 23 } 'mips64',
+    { 24 } 'mips64el'
     );
 
   CpuHasController : array[tsystemcpu] of boolean =
@@ -114,7 +116,9 @@ const
     { 19 } false {'riscv32'},
     { 20 } false {'riscv64'},
     { 21 } true  {'xtensa'},
-    { 22 } true  {'z80'}
+    { 22 } true  {'z80'},
+    { 23 } false {'mips64'},
+    { 24 } false {'mips64el'}
     );
 
 { List of all supported system-cpu couples }
@@ -235,7 +239,10 @@ const
   { 112 } 'AmstradCPC-Z80',
   { 113 } 'SinclairQL-m68k',
   { 114 } 'WASI-WASM32',
-  { 115 } 'FreeBSD-AArch64'
+  { 115 } 'FreeBSD-AArch64',
+  { 116 } 'Embedded-aarch64',
+  { 117 } 'Linux-MIPS64',
+  { 118 } 'Linux-MIPS64el'
   );
 
 const
@@ -2426,7 +2433,8 @@ const
          'm_array_operators',     { use Delphi compatible array operators instead of custom ones ("+") }
          'm_multi_helpers',       { helpers can appear in multiple scopes simultaneously }
          'm_array2dynarray',      { regular arrays can be implicitly converted to dynamic arrays }
-         'm_prefixed_attributes'  { enable attributes that are defined before the type they belong to }
+         'm_prefixed_attributes', { enable attributes that are defined before the type they belong to }
+         'm_underscoreisseparator'{ _ can be used as separator to group digits in numbers }
        );
        { optimizer }
        optimizerswitchname : array[toptimizerswitch] of string[50] =

compiler/verbose.pas

@@ -584,14 +584,17 @@ implementation
 
 
     procedure internalerror(i : longint);noreturn;
+      procedure doraise;
+        begin
+          raise ECompilerAbort.Create;
+        end;
       begin
         UpdateStatus;
         do_internalerror(i);
         GenerateError;
-        raise ECompilerAbort.Create;
+        doraise;
       end;
 
-
     procedure Comment(l:longint;s:ansistring);
       var
         dostop : boolean;

compiler/wasm32/hlcgcpu.pas

@@ -45,6 +45,7 @@ uses
       { checks whether the type needs special methodptr-like handling, when stored
         in a LOC_REGISTER location. This applies to the following types:
           - method pointers
+          - 8-byte records
           - nested proc ptrs
         When stored in a LOC_REGISTER tlocation, these types use both register
         and registerhi with the following sizes:
@@ -301,15 +302,16 @@ implementation
 
   function thlcgwasm.is_methodptr_like_type(d:tdef): boolean;
     var
-      is_methodptr, is_nestedprocptr: Boolean;
+      is_8byterecord, is_methodptr, is_nestedprocptr: Boolean;
     begin
+      is_8byterecord:=(d.typ=recorddef) and (d.size=8);
       is_methodptr:=(d.typ=procvardef)
         and (po_methodpointer in tprocvardef(d).procoptions)
         and not(po_addressonly in tprocvardef(d).procoptions);
       is_nestedprocptr:=(d.typ=procvardef)
         and is_nested_pd(tprocvardef(d))
         and not(po_addressonly in tprocvardef(d).procoptions);
-      result:=is_methodptr or is_nestedprocptr;
+      result:=is_8byterecord or is_methodptr or is_nestedprocptr;
     end;
 
   constructor thlcgwasm.create;

compiler/x86/cgx86.pas

@@ -1917,6 +1917,8 @@ unit cgx86;
                 if size in [OS_M256,OS_M512] then
                   Include(current_procinfo.flags,pi_uses_ymm);
               end
+            else if size in [OS_F32,OS_F64] then
+              asmop:=opmm2asmop[0,size,op]
             else
               asmop:=opmm2asmop_full[op];
           end

compiler/x86/nx86add.pas

@@ -48,6 +48,7 @@ unit nx86add;
         procedure second_addfloatavx;
       public
         function pass_1 : tnode;override;
+        function simplify(forinline : boolean) : tnode; override;
         function use_fma : boolean;override;
         procedure second_addfloat;override;
 {$ifndef i8086}
@@ -78,8 +79,8 @@ unit nx86add;
       symconst,symdef,
       cgobj,hlcgobj,cgx86,cga,cgutils,
       tgobj,ncgutil,
-      ncon,nset,ninl,ncnv,
-      defutil,
+      ncon,nset,ninl,ncnv,ncal,nmat,
+      defutil,defcmp,constexp,
       htypechk;
 
 { Range check must be disabled explicitly as the code serves
@@ -1185,6 +1186,331 @@ unit nx86add;
       end;
 
 
+    function tx86addnode.simplify(forinline : boolean) : tnode;
+      var
+        t, m, ThisNode, ConstNode: TNode;
+        lt,rt, ThisType: TNodeType;
+        ThisDef: TDef;
+        DoOptimisation: Boolean;
+
+        reciprocal, comparison, divisor: AWord;
+        shift, N: Byte;
+      begin
+        { Load into local variables to reduce the number of pointer deallocations }
+        rt:=right.nodetype;
+        lt:=left.nodetype;
+
+        DoOptimisation:=False;
+
+{$if defined(cpu64bitalu) or defined(cpu32bitalu) or defined(cpu16bitalu)}
+        if (cs_opt_level1 in current_settings.optimizerswitches) and
+          { The presence of overflow checks tends to cause internal errors with the multiplication nodes }
+          not (cs_check_overflow in current_settings.localswitches) and
+          (nodetype in [equaln,unequaln]) then
+          begin
+            if (lt=modn) and (rt=ordconstn) and (TOrdConstNode(right).value.uvalue=0) then
+              begin
+                t:=left;
+                m:=right;
+              end
+            else if (rt=modn) and (lt=ordconstn) and (TOrdConstNode(left).value.uvalue=0) then
+              begin
+                t:=right;
+                m:=left;
+              end
+            else
+              begin
+                t:=nil;
+                m:=nil;
+              end;
+
+            if Assigned(t) and (TModDivNode(t).right.nodetype=ordconstn) and
+{$ifndef cpu64bitalu}
+              { Converting Int64 and QWord division doesn't work under i386 }
+{$ifndef cpu32bitalu}
+              (TModDivNode(t).resultdef.size < 4) and
+{$else cpu32bitalu}
+              (TModDivNode(t).resultdef.size < 8) and
+{$endif cpu32bitalu}
+{$endif cpu64bitalu}
+              (TOrdConstNode(TModDivNode(t).right).value>=3) then
+              begin
+                divisor:=TOrdConstNode(TModDivNode(t).right).value.uvalue;
+
+                { Exclude powers of 2, as there are more efficient ways to handle those }
+                if PopCnt(divisor)>1 then
+                  begin
+                    if is_signed(TModDivNode(t).left.resultdef) then
+                      begin
+                        { See pages 250-251 of Hacker's Delight, Second Edition
+                          for an explanation and proof of the algorithm, but
+                          essentially, we're doing the following:
+
+                          - Convert the divisor d to the form k.2^b if it isn't
+                            already odd (in which case, k = d and b = 0)
+                          - Calculate r, the multiplicative inverse of k modulo 2^N
+                          - Calculate c = floor(2^(N-1) / k) & -(2^b)
+                          - Let q = ((n * r) + c) ror b (mod 2^N)
+                          - Repurpose c to equal floor(2c / 2^b) = c shr (b - 1)
+                            (some RISC platforms will benefit from doing this over
+                            precalculating the modified constant. For x86,
+                            it's better with the constant precalculated for
+                            32-bit and under, but for 64-bit, use SHR. )
+                          - If q is below or equal to c, then (n mod d) = 0
+                          }
+                        while True do
+                          begin
+                            ThisNode:=TModDivNode(t).left;
+                            case ThisNode.nodetype of
+                              typeconvn:
+                                begin
+                                  ThisDef:=TTypeConvNode(ThisNode).left.resultdef;
+                                  { See if we can simplify things to a smaller ordinal to
+                                    reduce code size and increase speed }
+                                  if is_signed(ThisDef) and
+                                    is_integer(ThisDef) and
+                                    { Byte-sized multiplications can cause problems }
+                                    (ThisDef.size>=2) and
+                                    { Make sure the divisor is in range }
+                                    (divisor>=TOrdDef(ThisDef).low) and
+                                    (divisor<=TOrdDef(ThisDef).high) then
+                                    begin
+                                      TOrdConstNode(TModDivNode(t).right).resultdef:=ThisDef;
+                                      TOrdConstNode(m).resultdef:=ThisDef;
+                                      TModDivNode(t).resultdef:=ThisDef;
+
+                                      { Destroy the typeconv node }
+                                      TModDivNode(t).left:=TTypeConvNode(ThisNode).left;
+                                      TTypeConvNode(ThisNode).left:=nil;
+                                      ThisNode.Free;
+                                      Continue;
+                                    end;
+                                  end;
+                              ordconstn:
+                                begin
+                                  { Just simplify into a constant }
+                                  Result:=inherited simplify(forinline);
+                                  Exit;
+                                end;
+                              else
+                                ;
+                            end;
+
+                            DoOptimisation:=True;
+                            Break;
+                          end;
+
+                        if DoOptimisation then
+                          begin
+                            ThisDef:=TModDivNode(t).left.resultdef;
+
+                            if nodetype = equaln then
+                              ThisType:=lten
+                            else
+                              ThisType:=gtn;
+
+                            N:=ThisDef.size*8;
+                            calc_mul_inverse(N, TOrdConstNode(TModDivNode(t).right).value.uvalue, reciprocal, shift);
+
+                            { Construct the following node tree for odd divisors:
+                                <lten> (for equaln) or <gtn> (for notequaln)
+                                  <addn>
+                                    <muln>
+                                      <typeconv signed-to-unsigned>
+                                        <numerator node (TModDivNode(t).left)>
+                                      <reciprocal constant>
+                                    <comparison constant (effectively a signed shift)>
+                                  <comparison constant * 2>
+
+                              For even divisors, convert them to the form k.2^b, with
+                              odd k, then construct the following:
+                                <lten> (for equaln) or <gtn> (for notequaln)
+                                  <ror>
+                                    (b)
+                                    <addn>
+                                      <muln>
+                                        <typeconv signed-to-unsigned>
+                                          <numerator node (TModDivNode(t).left)>
+                                        <reciprocal constant>
+                                      <comparison constant (effectively a signed shift)>
+                                  <comparison constant shr (b - 1)>
+                            }
+
+                            ThisNode:=ctypeconvnode.create_internal(TModDivNode(t).left, ThisDef);
+                            TTypeConvNode(ThisNode).convtype:=tc_int_2_int;
+                            ThisDef:=get_unsigned_inttype(ThisDef);
+                            ThisNode.resultdef:=ThisDef;
+
+                            TModDivNode(t).left:=nil;
+
+                            ConstNode:=cordconstnode.create(reciprocal, ThisDef, False);
+                            ConstNode.resultdef:=ThisDef;
+
+                            ThisNode:=caddnode.create_internal(muln, ThisNode, ConstNode);
+                            ThisNode.resultdef:=ThisDef;
+
+{$push}
+{$warnings off}
+                            if shift>0 then
+                              comparison:=((aWord(1) shl ((N-1) and (SizeOf(aWord)*8-1))) div (divisor shr shift)) and -(1 shl shift)
+                            else
+                              comparison:=(aWord(1) shl ((N-1) and (SizeOf(aWord)*8-1))) div divisor;
+{$pop}
+                            ConstNode:=cordconstnode.create(comparison, ThisDef, False);
+                            ConstNode.resultdef:=ThisDef;
+
+                            ThisNode:=caddnode.create_internal(addn, ThisNode, ConstNode);
+                            ThisNode.resultdef:=ThisDef;
+
+                            if shift>0 then
+                              begin
+                                ConstNode:=cordconstnode.create(shift, u8inttype, False);
+                                ConstNode.resultdef:=u8inttype;
+                                ThisNode:=cinlinenode.createintern(in_ror_x_y,false,
+                                  ccallparanode.create(ConstNode,
+                                  ccallparanode.create(ThisNode, nil)));
+
+                                ThisNode.resultdef:=ThisDef;
+
+                                ConstNode:=cordconstnode.create(comparison shr (shift - 1), ThisDef, False);
+                              end
+                            else
+                              ConstNode:=cordconstnode.create(comparison*2, ThisDef, False);
+
+                            ConstNode.resultdef:=ThisDef;
+
+                            Result:=CAddNode.create_internal(ThisType, ThisNode, ConstNode);
+                            Result.resultdef:=resultdef;
+                            Exit;
+                          end;
+                      end
+                    else
+                      begin
+                        { For bit length N, convert "(x mod d) = 0" or "(x mod d) <> 0", where
+                          d is an odd-numbered integer constant, to "(x * r) <= m", where
+                          dr = 1 (mod 2^N) and m = floor(2^N / d).
+
+                          If d is even, convert to the form k.2^b, where k is odd, then
+                          convert to "(x * r) ror b <= m", where kr = 1 (mod 2^N) and
+                          m = floor(2^N / d) = floor(2^(N-b) / k) }
+                        while True do
+                          begin
+                            ThisNode:=TModDivNode(t).left;
+                            case ThisNode.nodetype of
+                              typeconvn:
+                                begin
+                                  ThisDef:=TTypeConvNode(ThisNode).left.resultdef;
+                                  { See if we can simplify things to a smaller ordinal to
+                                    reduce code size and increase speed }
+                                  if not is_signed(ThisDef) and
+                                    is_integer(ThisDef) and
+                                    { Byte-sized multiplications can cause problems }
+                                    (ThisDef.size>=2) and
+                                    { Make sure the divisor is in range }
+                                    (divisor>=TOrdDef(ThisDef).low) and
+                                    (divisor<=TOrdDef(ThisDef).high) then
+                                    begin
+                                      TOrdConstNode(TModDivNode(t).right).resultdef:=ThisDef;
+                                      TOrdConstNode(m).resultdef:=ThisDef;
+                                      TModDivNode(t).resultdef:=ThisDef;
+
+                                      { Destroy the typeconv node }
+                                      TModDivNode(t).left:=TTypeConvNode(ThisNode).left;
+                                      TTypeConvNode(ThisNode).left:=nil;
+                                      ThisNode.Free;
+                                      Continue;
+                                    end;
+                                  end;
+                              ordconstn:
+                                begin
+                                  { Just simplify into a constant }
+                                  Result:=inherited simplify(forinline);
+                                  Exit;
+                                end;
+                              else
+                                ;
+                            end;
+
+                            DoOptimisation:=True;
+                            Break;
+                          end;
+
+                        if DoOptimisation then
+                          begin
+                            ThisDef:=TModDivNode(t).left.resultdef;
+
+                            { Construct the following node tree for odd divisors:
+                                <lten> (for equaln) or <gtn> (for notequaln)
+                                  <muln>
+                                    <numerator node (TModDivNode(t).left)>
+                                    <reciprocal constant>
+                                  (2^N / divisor)
+
+                              For even divisors, convert them to the form k.2^b, with
+                              odd k, then construct the following:
+                                <lten> (for equaln) or <gtn> (for notequaln)
+                                  <ror>
+                                    (b)
+                                    <muln>
+                                      <numerator node (TModDivNode(t).left)>
+                                      <reciprocal constant>
+                                  (2^N / divisor)
+                            }
+
+                            if nodetype=equaln then
+                              ThisType:=lten
+                            else
+                              ThisType:=gtn;
+
+                            N:=ThisDef.size*8;
+                            calc_mul_inverse(N, TOrdConstNode(TModDivNode(t).right).value.uvalue, reciprocal, shift);
+
+                            ConstNode:=cordconstnode.create(reciprocal, ThisDef, False);
+                            ConstNode.resultdef:=ThisDef;
+
+                            ThisNode:=caddnode.create_internal(muln, TModDivNode(t).left, ConstNode);
+                            ThisNode.resultdef:=ThisDef;
+
+                            TModDivNode(t).left:=nil;
+
+                            if shift>0 then
+                              begin
+                                ConstNode:=cordconstnode.create(shift, u8inttype, False);
+                                ConstNode.resultdef:=u8inttype;
+                                ThisNode:=cinlinenode.createintern(in_ror_x_y,false,
+                                  ccallparanode.create(ConstNode,
+                                  ccallparanode.create(ThisNode, nil)));
+
+                                ThisNode.resultdef:=ThisDef;
+
+                                comparison:=(aWord(1) shl ((N-shift) and (SizeOf(aWord)*8-1))) div (divisor shr shift);
+                              end
+                            else
+                              begin
+{$push}
+{$warnings off}
+                                { Because 2^N and divisor are relatively prime,
+                                  floor(2^N / divisor) = floor((2^N - 1) / divisor) }
+                                comparison:=(aWord(not 0) shr (((SizeOf(aWord)*8)-N) and (SizeOf(aWord)*8-1))) div divisor;
+{$pop}
+                              end;
+
+                            ConstNode:=cordconstnode.create(comparison, ThisDef, False);
+                            ConstNode.resultdef:=ThisDef;
+
+                            Result:=CAddNode.create_internal(ThisType, ThisNode, ConstNode);
+                            Result.resultdef:=resultdef;
+                            Exit;
+                          end;
+                      end;
+                  end;
+              end;
+          end;
+{$ifend defined(cpu64bitalu) or defined(cpu32bitalu) or defined(cpu16bitalu)}
+        Result:=inherited simplify(forinline);
+      end;
+
+
     function tx86addnode.use_fma : boolean;
       begin
 {$ifndef i8086}