* synchronize with trunk

git-svn-id: branches/unicodekvm@42319 -

.gitattributes

@@ -47,6 +47,7 @@ compiler/aarch64/racpugas.pas svneol=native#text/plain
 compiler/aarch64/rgcpu.pas svneol=native#text/plain
 compiler/aarch64/symcpu.pas svneol=native#text/plain
 compiler/aasmbase.pas svneol=native#text/plain
+compiler/aasmcfi.pas svneol=native#text/plain
 compiler/aasmcnst.pas svneol=native#text/plain
 compiler/aasmdata.pas svneol=native#text/plain
 compiler/aasmdef.pas svneol=native#text/plain
@@ -149,6 +150,7 @@ compiler/cfidwarf.pas svneol=native#text/plain
 compiler/cfileutl.pas svneol=native#text/plain
 compiler/cg64f32.pas svneol=native#text/plain
 compiler/cgbase.pas svneol=native#text/plain
+compiler/cgexcept.pas svneol=native#text/plain
 compiler/cghlcpu.pas svneol=native#text/plain
 compiler/cgobj.pas svneol=native#text/plain
 compiler/cgutils.pas svneol=native#text/plain
@@ -173,6 +175,7 @@ compiler/dbgstabx.pas svneol=native#text/plain
 compiler/defcmp.pas svneol=native#text/plain
 compiler/defutil.pas svneol=native#text/plain
 compiler/dirparse.pas svneol=native#text/plain
+compiler/dwarfbase.pas svneol=native#text/plain
 compiler/elfbase.pas svneol=native#text/plain
 compiler/entfile.pas svneol=native#text/plain
 compiler/export.pas svneol=native#text/plain
@@ -335,15 +338,18 @@ compiler/jvm/tgcpu.pas svneol=native#text/plain
 compiler/ldscript.pas svneol=native#text/plain
 compiler/link.pas svneol=native#text/plain
 compiler/llvm/aasmllvm.pas svneol=native#text/plain
+compiler/llvm/aasmllvmmetadata.pas svneol=native#text/plain
 compiler/llvm/agllvm.pas svneol=native#text/plain
 compiler/llvm/cgllvm.pas svneol=native#text/plain
 compiler/llvm/hlcgllvm.pas svneol=native#text/plain
 compiler/llvm/itllvm.pas svneol=native#text/plain
 compiler/llvm/llvmbase.pas svneol=native#text/plain
+compiler/llvm/llvmcfi.pas svneol=native#text/plain
 compiler/llvm/llvmdef.pas svneol=native#text/plain
 compiler/llvm/llvminfo.pas svneol=native#text/plain
 compiler/llvm/llvmnode.pas svneol=native#text/plain
 compiler/llvm/llvmpara.pas svneol=native#text/plain
+compiler/llvm/llvmpi.pas svneol=native#text/plain
 compiler/llvm/llvmsym.pas svneol=native#text/plain
 compiler/llvm/llvmtarg.pas svneol=native#text/plain
 compiler/llvm/llvmtype.pas svneol=native#text/plain
@@ -357,6 +363,7 @@ compiler/llvm/nllvminl.pas svneol=native#text/plain
 compiler/llvm/nllvmld.pas svneol=native#text/plain
 compiler/llvm/nllvmmat.pas svneol=native#text/plain
 compiler/llvm/nllvmmem.pas svneol=native#text/plain
+compiler/llvm/nllvmset.pas svneol=native#text/plain
 compiler/llvm/nllvmtcon.pas svneol=native#text/plain
 compiler/llvm/nllvmutil.pas svneol=native#text/plain
 compiler/llvm/rgllvm.pas svneol=native#text/plain
@@ -653,6 +660,7 @@ compiler/ppheap.pas svneol=native#text/plain
 compiler/ppu.pas svneol=native#text/plain
 compiler/procdefutil.pas svneol=native#text/plain
 compiler/procinfo.pas svneol=native#text/plain
+compiler/psabiehpi.pas svneol=native#text/plain
 compiler/pstatmnt.pas svneol=native#text/plain
 compiler/psub.pas svneol=native#text/plain
 compiler/psystem.pas svneol=native#text/plain
@@ -2647,6 +2655,7 @@ packages/fcl-passrc/tests/tcmoduleparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tconstparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcpassrcutil.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcprocfunc.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tcresolvegenerics.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcresolver.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcscanner.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcstatements.pas svneol=native#text/plain
@@ -5898,6 +5907,12 @@ packages/libndsfpc/examples/graphics/Sprites/sprite_extended_palettes/SpriteExte
 packages/libndsfpc/examples/graphics/Sprites/sprite_rotate/Makefile svneol=native#text/plain
 packages/libndsfpc/examples/graphics/Sprites/sprite_rotate/Makefile.fpc svneol=native#text/plain
 packages/libndsfpc/examples/graphics/Sprites/sprite_rotate/SpriteRotate.pp svneol=native#text/plain
+packages/libndsfpc/examples/graphics/grit/256colorTilemap/Makefile svneol=native#text/plain
+packages/libndsfpc/examples/graphics/grit/256colorTilemap/Makefile.fpc svneol=native#text/plain
+packages/libndsfpc/examples/graphics/grit/256colorTilemap/gfx/tilemap.grit svneol=native#text/plain
+packages/libndsfpc/examples/graphics/grit/256colorTilemap/gfx/tilemap.png -text
+packages/libndsfpc/examples/graphics/grit/256colorTilemap/tilemap_256_color.pp svneol=native#text/plain
+packages/libndsfpc/examples/graphics/grit/Makefile.fpc svneol=native#text/plain
 packages/libndsfpc/examples/hello_world/Makefile svneol=native#text/plain
 packages/libndsfpc/examples/hello_world/Makefile.fpc svneol=native#text/plain
 packages/libndsfpc/examples/hello_world/helloWorld.pp svneol=native#text/plain
@@ -5963,8 +5978,10 @@ packages/libndsfpc/src/maxmod/inc/mm_msl.inc svneol=native#text/plain
 packages/libndsfpc/src/maxmod/inc/mm_types.inc svneol=native#text/plain
 packages/libndsfpc/src/maxmod/maxmod7.pp svneol=native#text/plain
 packages/libndsfpc/src/maxmod/maxmod9.pp svneol=native#text/plain
+packages/libndsfpc/src/nds/arm7/aes.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm7/audio.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm7/clock.inc svneol=native#text/plain
+packages/libndsfpc/src/nds/arm7/codec.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm7/i2c.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm7/input.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm7/sdmmc.inc svneol=native#text/plain
@@ -5973,9 +5990,11 @@ packages/libndsfpc/src/nds/arm7/touch.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm9/background.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm9/boxtest.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm9/cache.inc svneol=native#text/plain
+packages/libndsfpc/src/nds/arm9/cache_asm.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm9/console.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm9/decompress.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm9/dldi.inc svneol=native#text/plain
+packages/libndsfpc/src/nds/arm9/dldi_asm.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm9/dynamicArray.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm9/exceptions.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm9/guitarGrip.inc svneol=native#text/plain
@@ -5984,6 +6003,7 @@ packages/libndsfpc/src/nds/arm9/input.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm9/keyboard.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm9/linkedlist.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm9/math.inc svneol=native#text/plain
+packages/libndsfpc/src/nds/arm9/nand.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm9/ndsmotion.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm9/paddle.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/arm9/pcx.inc svneol=native#text/plain
@@ -6015,6 +6035,8 @@ packages/libndsfpc/src/nds/nds.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/ndsinclude.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/ndstypes.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/registers_alt.inc svneol=native#text/plain
+packages/libndsfpc/src/nds/rsa.inc svneol=native#text/plain
+packages/libndsfpc/src/nds/sha1.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/system.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/timers.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/touch.inc svneol=native#text/plain
@@ -9617,6 +9639,8 @@ rtl/inc/objcnf.inc svneol=native#text/plain
 rtl/inc/objpas.inc svneol=native#text/plain
 rtl/inc/objpash.inc svneol=native#text/plain
 rtl/inc/pagemem.pp svneol=native#text/plain
+rtl/inc/psabieh.inc svneol=native#text/plain
+rtl/inc/psabiehh.inc svneol=native#text/plain
 rtl/inc/readme -text
 rtl/inc/real2str.inc svneol=native#text/plain
 rtl/inc/resh.inc svneol=native#text/plain
@@ -14053,6 +14077,7 @@ tests/test/trtti18a.pp svneol=native#text/pascal
 tests/test/trtti18b.pp svneol=native#text/pascal
 tests/test/trtti19.pp svneol=native#text/pascal
 tests/test/trtti2.pp svneol=native#text/plain
+tests/test/trtti20.pp svneol=native#text/pascal
 tests/test/trtti3.pp svneol=native#text/plain
 tests/test/trtti4.pp svneol=native#text/plain
 tests/test/trtti5.pp svneol=native#text/plain
@@ -14927,6 +14952,8 @@ tests/webtbf/tw35149a.pp svneol=native#text/plain
 tests/webtbf/tw35348.pp svneol=native#text/pascal
 tests/webtbf/tw3553.pp svneol=native#text/plain
 tests/webtbf/tw3562.pp svneol=native#text/plain
+tests/webtbf/tw35671.pp svneol=native#text/plain
+tests/webtbf/tw35753.pp svneol=native#text/plain
 tests/webtbf/tw3583.pp svneol=native#text/plain
 tests/webtbf/tw3626.pp svneol=native#text/plain
 tests/webtbf/tw3631.pp svneol=native#text/plain

Makefile

@@ -961,6 +961,7 @@ EXEEXT=.exe
 PPLEXT=.ppl
 PPUEXT=.ppu
 OEXT=.o
+LTOEXT=.bc
 ASMEXT=.s
 SMARTEXT=.sl
 STATICLIBEXT=.a
@@ -1602,9 +1603,9 @@ override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPP
 endif
 ifdef INSTALLPPUFILES
 ifneq ($(IMPORTLIBPREFIX)-$(STATICLIBEXT),$(STATICLIBPREFIX)-$(STATICLIBEXT))
-override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(subst $(PPUEXT),$(LTOEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
 else
-override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(subst $(PPUEXT),$(LTOEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
 endif
 ifneq ($(UNITTARGETDIRPREFIX),)
 override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
@@ -1763,7 +1764,7 @@ ifdef CLEAN_UNITS
 override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
 endif
 ifdef CLEANPPUFILES
-override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(subst $(PPUEXT),$(LTOEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
 ifdef DEBUGSYMEXT
 override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
 endif
@@ -1814,7 +1815,7 @@ ifdef CLEAN_FILES
 endif
 	-$(DELTREE) units
 	-$(DELTREE) bin
-	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+	-$(DEL) *$(OEXT) *$(LTOEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a
 endif

compiler/Makefile

@@ -513,11 +513,11 @@ endif
 endif
 override LOCALOPT+=-d$(CPC_TARGET) -dGDB -dBROWSERLOG
 ifdef LLVM
-ifeq ($(findstring $(PPC_TARGET),x86_64),)
-$(error The $(PPC_TARGET) architecture is not (yet) support by the FPC/LLVM code generator)
+ifeq ($(findstring $(PPC_TARGET),x86_64 aarch64 arm),)
+$(error The $(PPC_TARGET) architecture is not (yet) supported by the FPC/LLVM code generator)
 endif
 ifeq ($(findstring $(OS_TARGET),darwin iphonesim linux),)
-$(error The $(PPC_TARGET) target OS is not (yet) support by the FPC/LLVM code generator)
+$(error The $(PPC_TARGET) target OS is not (yet) supported by the FPC/LLVM code generator)
 endif
 override LOCALOPT+=-dllvm -Fullvm
 endif
@@ -2460,6 +2460,7 @@ EXEEXT=.exe
 PPLEXT=.ppl
 PPUEXT=.ppu
 OEXT=.o
+LTOEXT=.bc
 ASMEXT=.s
 SMARTEXT=.sl
 STATICLIBEXT=.a
@@ -3407,7 +3408,7 @@ endif
 ifndef CROSSINSTALL
 ifneq ($(TARGET_PROGRAMS),)
 override EXEFILES=$(addsuffix $(EXEEXT),$(TARGET_PROGRAMS))
-override EXEOFILES:=$(addsuffix $(OEXT),$(TARGET_PROGRAMS)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS))) $(addprefix $(IMPORTLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS)))
+override EXEOFILES:=$(addsuffix $(OEXT),$(TARGET_PROGRAMS)) $(addsuffix $(LTOEXT),$(TARGET_PROGRAMS))$(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS))) $(addprefix $(IMPORTLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS)))
 override EXEDBGFILES:=$(addsuffix $(EXEDBGEXT),$(TARGET_PROGRAMS))
 override ALLTARGET+=fpc_exes
 override INSTALLEXEFILES+=$(EXEFILES)
@@ -3436,7 +3437,7 @@ fpc_debug:
 	$(MAKE) all DEBUG=1
 fpc_release:
 	$(MAKE) all RELEASE=1
-.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) $(LTOEXT) .pas .lpr .dpr .pp .rc .res
 $(COMPILER_UNITTARGETDIR):
 	$(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
 $(COMPILER_TARGETDIR):
@@ -3467,6 +3468,7 @@ vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
 vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
 vpath %.inc $(COMPILER_INCLUDEDIR)
 vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(LTOEXT) $(COMPILER_UNITTARGETDIR)
 vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
 .PHONY: fpc_shared
 override INSTALLTARGET+=fpc_shared_install
@@ -3509,9 +3511,9 @@ override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPP
 endif
 ifdef INSTALLPPUFILES
 ifneq ($(IMPORTLIBPREFIX)-$(STATICLIBEXT),$(STATICLIBPREFIX)-$(STATICLIBEXT))
-override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(subst $(PPUEXT),$(LTOEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
 else
-override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(subst $(PPUEXT),$(LTOEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
 endif
 ifneq ($(UNITTARGETDIRPREFIX),)
 override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
@@ -3670,7 +3672,7 @@ ifdef CLEAN_UNITS
 override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
 endif
 ifdef CLEANPPUFILES
-override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(subst $(PPUEXT),$(LTOEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
 ifdef DEBUGSYMEXT
 override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
 endif
@@ -3721,7 +3723,7 @@ ifdef CLEAN_FILES
 endif
 	-$(DELTREE) units
 	-$(DELTREE) bin
-	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+	-$(DEL) *$(OEXT) *$(LTOEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a
 endif

compiler/Makefile.fpc

@@ -261,12 +261,12 @@ override LOCALOPT+=-d$(CPC_TARGET) -dGDB -dBROWSERLOG
 
 #include LLVM define/directory if requested
 ifdef LLVM
-ifeq ($(findstring $(PPC_TARGET),x86_64),)
-$(error The $(PPC_TARGET) architecture is not (yet) support by the FPC/LLVM code generator)
+ifeq ($(findstring $(PPC_TARGET),x86_64 aarch64 arm),)
+$(error The $(PPC_TARGET) architecture is not (yet) supported by the FPC/LLVM code generator)
 endif
 
 ifeq ($(findstring $(OS_TARGET),darwin iphonesim linux),)
-$(error The $(PPC_TARGET) target OS is not (yet) support by the FPC/LLVM code generator)
+$(error The $(PPC_TARGET) target OS is not (yet) supported by the FPC/LLVM code generator)
 endif
 
 override LOCALOPT+=-dllvm -Fullvm

compiler/aarch64/cpubase.pas

@@ -328,6 +328,7 @@ unit cpubase;
 
     function dwarf_reg(r:tregister):shortint;
     function dwarf_reg_no_error(r:tregister):shortint;
+    function eh_return_data_regno(nr: longint): longint;
 
     function is_shifter_const(d: aint; size: tcgsize): boolean;
 
@@ -609,4 +610,13 @@ unit cpubase;
           end;
       end;
 
+
+  function eh_return_data_regno(nr: longint): longint;
+    begin
+      if (nr>=0) and (nr<2) then
+        result:=nr
+      else
+        result:=-1;
+    end;
+
 end.

compiler/aarch64/cpuinfo.pas

@@ -56,6 +56,10 @@ Type
 
 
 Const
+   fputypestrllvm : array[tfputype] of string[6] = ('',
+     ''
+   );
+
    { Is there support for dealing with multiple microcontrollers available }
    { for this platform? }
    ControllerSupport = false; (* Not yet at least ;-) *)

compiler/aarch64/cpunode.pas

@@ -31,11 +31,14 @@ implementation
 
   uses
     ncgbas,ncgflw,ncgcal,ncgcnv,ncgld,ncgmem,ncgcon,ncgset,ncgobjc,
-    ncpuadd,ncpumat,ncpumem,ncpuinl,ncpucnv,ncpuset,
-    { this not really a node }
-    rgcpu,
     { symtable }
     symcpu,
-    aasmdef;
+    aasmdef,
+{$ifndef llvm}
+    ncpuadd,ncpumat,ncpumem,ncpuinl,ncpucnv,ncpuset
+{$else llvm}
+    llvmnode
+{$endif llvm}
+    ;
 
 end.

compiler/aarch64/hlcgcpu.pas

@@ -45,8 +45,6 @@ interface
       procedure a_load_regconst_subsetreg_intern(list: TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); override;
     end;
 
-  procedure create_hlcodegen;
-
 implementation
 
   uses
@@ -222,11 +220,14 @@ implementation
     end;
 
 
-  procedure create_hlcodegen;
+  procedure create_hlcodegen_cpu;
     begin
       hlcg:=thlcgaarch64.create;
       create_codegen;
     end;
 
 
+begin
+  chlcgobj:=thlcgaarch64;
+  create_hlcodegen:=@create_hlcodegen_cpu;
 end.

compiler/aasmbase.pas

@@ -74,10 +74,10 @@ interface
        { is the label only there for getting an DataOffset (e.g. for i/o
          checks -> alt_addr) or is it a jump target (alt_jump), for debug
          info alt_dbgline and alt_dbgfile, etc. }
-       TAsmLabelType = (alt_jump,alt_addr,alt_data,alt_dbgline,alt_dbgfile,alt_dbgtype,alt_dbgframe);
+       TAsmLabelType = (alt_jump,alt_addr,alt_data,alt_dbgline,alt_dbgfile,alt_dbgtype,alt_dbgframe,alt_eh_begin,alt_eh_end);
 
     const
-       asmlabeltypeprefix : array[TAsmLabeltype] of char = ('j','a','d','l','f','t','c');
+       asmlabeltypeprefix : array[TAsmLabeltype] of string[2] = ('j','a','d','l','f','t','c','eb','ee');
        asmsymbindname : array[TAsmsymbind] of string[23] = ('none', 'external','common',
        'local','global','weak external','private external','lazy','import','internal temp',
        'indirect','external indirect');
@@ -166,7 +166,9 @@ interface
          { stack segment for 16-bit DOS }
          sec_stack,
          { initial heap segment for 16-bit DOS }
-         sec_heap
+         sec_heap,
+         { dwarf based/gcc style exception handling }
+         sec_gcc_except_table
        );
 
        TObjCAsmSectionType = sec_objc_class..sec_objc_protolist;

compiler/aasmcfi.pas

@@ -0,0 +1,198 @@
+{
+    Copyright (c) 2019 by Jonas Maebe, member of the
+    Free Pascal Compiler development team
+
+    Dwarf Call Frame Information directives
+
+    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 aasmcfi;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      globtype,
+      cgbase,
+      aasmtai;
+
+    type
+      tcfikind =
+        (cfi_startproc,
+         cfi_endproc,
+         cfi_personality,
+         cfi_personality_id,
+         cfi_fde_data,
+         cfi_lsda_encoding,
+         cfi_inline_lsda,
+         cfi_def_cfa,
+         cfi_def_cfa_register,
+         cfi_def_cfa_offset,
+         cfi_adjust_cfa_offset,
+         cfi_offset,
+         cfi_val_offset,
+         cfi_rel_offset,
+         cfi_register,
+         cfi_restore,
+         cfi_undefined,
+         cfi_same_value,
+         cfi_remember_state,
+         cfi_restore_state,
+         cfi_return_column,
+         cfi_signal_frame,
+         cfi_window_save,
+         cfi_escape,
+         cfi_val_encoded_addr
+        );
+
+{$push}
+{$j-}
+      const
+        cfi2str: array[tcfikind] of string[length('.cfi_adjust_cfa_offset')] =
+          ('.cfi_startproc',
+           '.cfi_endproc',
+           '.cfi_personality',
+           '.cfi_personality_id',
+           '.cfi_fde_data',
+           '.cfi_lsda_encoding',
+           '.cfi_inline_lsda',
+           '.cfi_def_cfa',
+           '.cfi_def_cfa_register',
+           '.cfi_def_cfa_offset',
+           '.cfi_adjust_cfa_offset',
+           '.cfi_offset',
+           '.cfi_val_offset',
+           '.cfi_rel_offset',
+           '.cfi_register',
+           '.cfi_restore',
+           '.cfi_undefined',
+           '.cfi_same_value',
+           '.cfi_remember_state',
+           '.cfi_restore_state',
+           '.cfi_return_column',
+           '.cfi_signal_frame',
+           '.cfi_window_save',
+           '.cfi_escape',
+           '.cfi_val_encoded_addr'
+          );
+{$pop}
+
+    type
+      tai_cfi_base = class abstract(tai)
+        cfityp: tcfikind;
+        constructor create(ctyp: tcfikind);
+      end;
+
+      tai_cfi_op_none = class(tai_cfi_base)
+      end;
+
+      tai_cfi_op_val = class(tai_cfi_base)
+        val1: aint;
+        constructor create(ctyp: tcfikind; const a: aint);
+      end;
+
+      tai_cfi_op_string = class(tai_cfi_base)
+        s1: TSymStr;
+        constructor create(ctyp: tcfikind; const str1: TSymStr);
+      end;
+
+      tai_cfi_op_val_string = class(tai_cfi_op_val)
+        s: TSymStr;
+        constructor create(ctyp: tcfikind; const a: aint; const str: TSymStr);
+      end;
+
+      tai_cfi_op_string_string = class(tai_cfi_op_string)
+        s2: TSymStr;
+        constructor create(ctyp: tcfikind; const str1, str2: TSymStr);
+      end;
+
+      tai_cfi_op_reg = class(tai_cfi_base)
+        reg1: tregister;
+        constructor create(ctyp: tcfikind; r: tregister);
+      end;
+
+      tai_cfi_op_reg_val = class(tai_cfi_op_reg)
+        val: aint;
+        constructor create(ctyp: tcfikind; r: tregister; a: aint);
+      end;
+
+      tai_cfi_op_reg_reg = class(tai_cfi_op_reg)
+        reg2: tregister;
+        constructor create(ctyp: tcfikind; r1, r2: tregister);
+      end;
+
+
+  implementation
+
+    constructor tai_cfi_base.create(ctyp: tcfikind);
+      begin
+        typ:=ait_cfi;
+        cfityp:=ctyp;
+      end;
+
+
+    constructor tai_cfi_op_val.create(ctyp: tcfikind; const a: aint);
+      begin
+        inherited create(ctyp);
+        val1:=a;
+      end;
+
+
+    constructor tai_cfi_op_string.create(ctyp: tcfikind; const str1: TSymStr);
+      begin
+        inherited create(ctyp);
+        s1:=str1;
+      end;
+
+
+    constructor tai_cfi_op_val_string.create(ctyp: tcfikind; const a: aint; const str: TSymStr);
+      begin
+        inherited create(ctyp,a);
+        s:=str;
+      end;
+
+
+    constructor tai_cfi_op_string_string.create(ctyp: tcfikind; const str1, str2: TSymStr);
+      begin
+        inherited create(ctyp,str1);
+        s2:=str2;
+      end;
+
+
+    constructor tai_cfi_op_reg.create(ctyp: tcfikind; r: tregister);
+      begin
+        inherited create(ctyp);
+        reg1:=r;
+      end;
+
+
+    constructor tai_cfi_op_reg_val.create(ctyp: tcfikind; r: tregister; a: aint);
+      begin
+        inherited create(ctyp,r);
+        val:=a;
+      end;
+
+
+    constructor tai_cfi_op_reg_reg.create(ctyp: tcfikind; r1, r2: tregister);
+      begin
+        inherited create(ctyp,r1);
+        reg2:=r2;
+      end;
+
+end.
+

compiler/aasmcnst.pas

@@ -52,7 +52,7 @@ type
 
    { a simple data element; the value is stored as a tai }
    tai_simpletypedconst = class(tai_abstracttypedconst)
-   private
+    private
      procedure setval(AValue: tai);
     protected
      fval: tai;
@@ -90,7 +90,7 @@ type
     public
      constructor create(_adetyp: ttypedconstkind; _fdef: tdef);
      function getenumerator: tadeenumerator;
-     procedure addvalue(val: tai_abstracttypedconst);
+     procedure addvalue(val: tai_abstracttypedconst); virtual;
      function valuecount: longint;
      procedure insertvaluebeforepos(val: tai_abstracttypedconst; pos: longint);
      procedure replacevalueatpos(val: tai_abstracttypedconst; pos: longint);

compiler/aasmdata.pas

@@ -160,10 +160,13 @@ interface
         procedure generate_code(list:TAsmList);virtual;
         procedure start_frame(list:TAsmList);virtual;
         procedure end_frame(list:TAsmList);virtual;
+        procedure outmost_frame(list:TAsmList);virtual;
         procedure cfa_offset(list:TAsmList;reg:tregister;ofs:longint);virtual;
         procedure cfa_restore(list:TAsmList;reg:tregister);virtual;
         procedure cfa_def_cfa_register(list:TAsmList;reg:tregister);virtual;
         procedure cfa_def_cfa_offset(list:TAsmList;ofs:longint);virtual;
+        function get_frame_start: TAsmLabel;virtual;
+        function get_cfa_list : TAsmList;virtual;
       end;
       TAsmCFIClass=class of TAsmCFI;
 
@@ -285,6 +288,11 @@ implementation
       end;
 
 
+    procedure TAsmCFI.outmost_frame(list: TAsmList);
+      begin
+      end;
+
+
     procedure TAsmCFI.cfa_offset(list:TAsmList;reg:tregister;ofs:longint);
       begin
       end;
@@ -304,6 +312,18 @@ implementation
       begin
       end;
 
+
+    function TAsmCFI.get_frame_start: TAsmLabel;
+      begin
+        Result:=nil;
+      end;
+
+
+    function TAsmCFI.get_cfa_list: TAsmList;
+      begin
+        Result:=nil;
+      end;
+
 {*****************************************************************************
                                  TTCInitItem
 *****************************************************************************}
@@ -674,7 +694,8 @@ initialization
   memasmlists:=TMemDebug.create('AsmLists');
   memasmlists.stop;
 {$endif MEMDEBUG}
-  CAsmCFI:=TAsmCFI;
+  if not(assigned(CAsmCFI)) then
+    CAsmCFI:=TAsmCFI;
 
 finalization
 {$ifdef MEMDEBUG}

compiler/aasmtai.pas

@@ -87,9 +87,14 @@ interface
           ait_llvmins, { llvm instruction }
           ait_llvmalias, { alias for a symbol }
           ait_llvmdecl, { llvm symbol declaration (global/external variable, external procdef) }
+          ait_llvmmetadatanode, (* llvm metadata node: !id = !{type value, ...} *)
+          ait_llvmmetadatareftypedconst, { reference to metadata inside a metadata constant }
+          ait_llvmmetadatarefoperand, { llvm metadata referece: !metadataname !id }
 {$endif}
           { SEH directives used in ARM,MIPS and x86_64 COFF targets }
-          ait_seh_directive
+          ait_seh_directive,
+          { Dwarf CFI directive }
+          ait_cfi
           );
 
         taiconst_type = (
@@ -220,7 +225,11 @@ interface
           'llvmins',
           'llvmalias',
           'llvmdecl',
+          'llvmmetadata',
+          'llvmmetadatareftc',
+          'llvmmetadatarefop',
 {$endif}
+          'cfi',
           'seh_directive'
           );
 
@@ -265,6 +274,7 @@ interface
        ,top_cond
        ,top_para
        ,top_asmlist
+       ,top_callingconvention
 {$endif llvm}
 {$if defined(riscv32) or defined(riscv64)}
        ,top_fenceflags
@@ -319,8 +329,12 @@ interface
 {$endif JVM}
 {$ifdef llvm}
                      ait_llvmdecl,
+                     ait_llvmmetadatanode,
+                     ait_llvmmetadatareftypedconst,
+                     ait_llvmmetadatarefoperand,
 {$endif llvm}
-                     ait_seh_directive
+                     ait_seh_directive,
+                     ait_cfi
                     ];
 
 
@@ -474,6 +488,7 @@ interface
             top_fpcond : (fpcond: tllvmfpcmp);
             top_para   : (paras: tfplist);
             top_asmlist : (asmlist: tasmlist);
+            top_callingconvention: (callingconvention: tproccalloption);
         {$endif llvm}
         {$if defined(riscv32) or defined(riscv64)}
             top_fenceflags : (fenceflags : TFenceFlags);
@@ -638,6 +653,9 @@ interface
           symofs,
           value   : int64;
           consttype : taiconst_type;
+          { sleb128 and uleb128 values have a varying length, by calling FixSize their size can be fixed
+            to avoid that other offsets need to be changed. The value to write is stored in fixed_size }
+          fixed_size : byte;
           { we use for the 128bit int64/qword for now because I can't imagine a
             case where we need 128 bit now (FK) }
           constructor Create(_typ:taiconst_type;_value : int64);
@@ -692,6 +710,9 @@ interface
           procedure derefimpl;override;
           function getcopy:tlinkedlistitem;override;
           function size:longint;
+          { sleb128 and uleb128 values have a varying length, by calling FixSize their size can be fixed
+            to avoid that other offsets need to be changed. The value to write is stored in fixed_size }
+          Procedure FixSize;
        end;
 
        { floating point const }
@@ -1987,9 +2008,31 @@ implementation
             else
               result:=sizeof(pint);
           aitconst_uleb128bit :
-            result:=LengthUleb128(qword(value));
+            begin
+              if fixed_size>0 then
+                result:=fixed_size
+              else if sym=nil then
+                begin
+                  FixSize;
+                  result:=fixed_size;
+                end
+              else
+                { worst case }
+                result:=sizeof(pint)+2;
+            end;
           aitconst_sleb128bit :
-            result:=LengthSleb128(value);
+            begin
+              if fixed_size>0 then
+                result:=fixed_size
+              else if sym=nil then
+                begin
+                  FixSize;
+                  result:=fixed_size;
+                end
+              else
+                { worst case }
+                result:=sizeof(pint)+2;
+            end;
           aitconst_half16bit,
           aitconst_gs:
             result:=2;
@@ -2009,6 +2052,19 @@ implementation
       end;
 
 
+    procedure tai_const.FixSize;
+      begin
+        case consttype of
+          aitconst_uleb128bit:
+            fixed_size:=LengthUleb128(qword(value));
+          aitconst_sleb128bit:
+            fixed_size:=LengthSleb128(value);
+          else
+            Internalerror(2019030301);
+        end;
+      end;
+
+
 {****************************************************************************
                                TAI_realconst
  ****************************************************************************}

compiler/aggas.pas

@@ -1,4 +1,4 @@
-{
+  {
     Copyright (c) 1998-2006 by the Free Pascal team
 
     This unit implements the generic part of the GNU assembler
@@ -32,7 +32,7 @@ interface
 
     uses
       globtype,globals,
-      aasmbase,aasmtai,aasmdata,
+      aasmbase,aasmtai,aasmdata,aasmcfi,
       assemble;
 
     type
@@ -68,6 +68,7 @@ interface
         setcount: longint;
         procedure WriteDecodedSleb128(a: int64);
         procedure WriteDecodedUleb128(a: qword);
+        procedure WriteCFI(hp: tai_cfi_base);
         function NextSetLabel: string;
        protected
         InstrWriter: TCPUInstrWriter;
@@ -270,7 +271,8 @@ implementation
           '.obcj_nlcatlist',
           '.objc_protolist',
           '.stack',
-          '.heap'
+          '.heap',
+          '.gcc_except_table'
         );
         secnames_pic : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','',
           '.text',
@@ -329,7 +331,8 @@ implementation
           '.obcj_nlcatlist',
           '.objc_protolist',
           '.stack',
-          '.heap'
+          '.heap',
+          '.gcc_except_table'
         );
       var
         sep     : string[3];
@@ -583,7 +586,7 @@ implementation
         i,len : longint;
         buf   : array[0..63] of byte;
       begin
-        len:=EncodeUleb128(a,buf);
+        len:=EncodeUleb128(a,buf,0);
         for i:=0 to len-1 do
           begin
             if (i > 0) then
@@ -593,12 +596,45 @@ implementation
       end;
 
 
+    procedure TGNUAssembler.WriteCFI(hp: tai_cfi_base);
+      begin
+        writer.AsmWrite(cfi2str[hp.cfityp]);
+        case hp.cfityp of
+          cfi_startproc,
+          cfi_endproc:
+            ;
+          cfi_undefined,
+          cfi_restore,
+          cfi_def_cfa_register:
+            begin
+              writer.AsmWrite(' ');
+              writer.AsmWrite(gas_regname(tai_cfi_op_reg(hp).reg1));
+            end;
+          cfi_def_cfa_offset:
+            begin
+              writer.AsmWrite(' ');
+              writer.AsmWrite(tostr(tai_cfi_op_val(hp).val1));
+            end;
+          cfi_offset:
+            begin
+              writer.AsmWrite(' ');
+              writer.AsmWrite(gas_regname(tai_cfi_op_reg_val(hp).reg1));
+              writer.AsmWrite(',');
+              writer.AsmWrite(tostr(tai_cfi_op_reg_val(hp).val));
+            end;
+          else
+            internalerror(2019030203);
+        end;
+        writer.AsmLn;
+      end;
+
+
     procedure TGNUAssembler.WriteDecodedSleb128(a: int64);
       var
         i,len : longint;
         buf   : array[0..255] of byte;
       begin
-        len:=EncodeSleb128(a,buf);
+        len:=EncodeSleb128(a,buf,0);
         for i:=0 to len-1 do
           begin
             if (i > 0) then
@@ -1441,6 +1477,10 @@ implementation
                    std_regname(tai_varloc(hp).newlocation)));
                writer.AsmLn;
              end;
+           ait_cfi:
+             begin
+               WriteCFI(tai_cfi_base(hp));
+             end;
            else
              internalerror(2006012201);
          end;
@@ -1894,7 +1934,8 @@ implementation
          sec_none (* sec_objc_nlcatlist *),
          sec_none (* sec_objc_protlist *),
          sec_none (* sec_stack *),
-         sec_none (* sec_heap *)
+         sec_none (* sec_heap *),
+         sec_none (* gcc_except_table *)
         );
       begin
         Result := inherited SectionName (SecXTable [AType], AName, AOrder);

compiler/aoptobj.pas

@@ -380,6 +380,7 @@ Unit AoptObj;
       globals,
       verbose,
       aoptutils,
+      aasmcfi,
       procinfo;
 
 
@@ -1592,8 +1593,10 @@ Unit AoptObj;
                                      (JumpTargetOp(taicpu(hp1))^.ref^.symbol is TAsmLabel) then
                                      TAsmLabel(JumpTargetOp(taicpu(hp1))^.ref^.symbol).decrefs;
                                   { don't kill start/end of assembler block,
-                                    no-line-info-start/end etc }
-                                  if not(hp1.typ in [ait_align,ait_marker]) then
+                                    no-line-info-start/end, cfi end, etc }
+                                  if not(hp1.typ in [ait_align,ait_marker]) and
+                                     ((hp1.typ<>ait_cfi) or
+                                      (tai_cfi_base(hp1).cfityp<>cfi_endproc)) then
                                     begin
 {$ifdef cpudelayslot}
                                       if (hp1.typ=ait_instruction) and (taicpu(hp1).is_jmp) then

compiler/arm/aasmcpu.pas

@@ -198,7 +198,7 @@ uses
          roundingmode : troundingmode;
          procedure loadshifterop(opidx:longint;const so:tshifterop);
          procedure loadregset(opidx:longint; regsetregtype: tregistertype; regsetsubregtype: tsubregister; const s:tcpuregisterset; ausermode: boolean=false);
-         procedure loadconditioncode(opidx:longint;const cond:tasmcond);
+         procedure loadconditioncode(opidx:longint;const acond:tasmcond);
          procedure loadmodeflags(opidx:longint;const flags:tcpumodeflags);
          procedure loadspecialreg(opidx:longint;const areg:tregister; const aflags:tspecialregflags);
          procedure loadrealconst(opidx:longint;const _value:bestreal);
@@ -388,14 +388,14 @@ implementation
       end;
 
 
-    procedure taicpu.loadconditioncode(opidx:longint;const cond:tasmcond);
+    procedure taicpu.loadconditioncode(opidx:longint;const acond:tasmcond);
       begin
         allocate_oper(opidx+1);
         with oper[opidx]^ do
          begin
            if typ<>top_conditioncode then
              clearop(opidx);
-           cc:=cond;
+           cc:=acond;
            typ:=top_conditioncode;
          end;
       end;

compiler/arm/cpubase.pas

@@ -380,6 +380,8 @@ unit cpubase;
     function is_continuous_mask(d : aword;var lsb, width: byte) : boolean;
     function dwarf_reg(r:tregister):shortint;
     function dwarf_reg_no_error(r:tregister):shortint;
+    function eh_return_data_regno(nr: longint): longint;
+
 
     function IsIT(op: TAsmOp) : boolean;
     function GetITLevels(op: TAsmOp) : longint;
@@ -663,6 +665,14 @@ unit cpubase;
         result:=regdwarf_table[findreg_by_number(r)];
       end;
 
+    function eh_return_data_regno(nr: longint): longint;
+      begin
+        if (nr>=0) and (nr<2) then
+          result:=nr
+        else
+          result:=-1;
+      end;
+
       { Low part of 64bit return value }
     function NR_FUNCTION_RESULT64_LOW_REG: tregister; {$ifdef USEINLINE}inline;{$endif USEINLINE}
     begin

compiler/arm/cpuinfo.pas

@@ -71,6 +71,21 @@ Type
       fpu_vfpv4
      );
 
+Const
+  fputypestrllvm : array[tfputype] of string[13] = ('',
+    '',
+    '',
+    '',
+    '',
+    '',
+    'fpu=vfpv2',
+    'fpu=vfpv3',
+    'fpu=vfpv3-d16',
+    'fpu=vfpv4-s16',
+    'fpu=vfpv4'
+  );
+
+Type
    tcontrollertype =
      (ct_none,
 

compiler/arm/cpunode.pas

@@ -30,10 +30,14 @@ unit cpunode;
     uses
        { generic nodes }
        ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgopt,ncgmat,ncgobjc,
+       { symtable }
+       symcpu,
+       aasmdef,
        { to be able to only parts of the generic code,
          the processor specific nodes must be included
          after the generic one (FK)
        }
+{$ifndef llvm}
        narmadd,
        narmcal,
        narmmat,
@@ -42,10 +46,10 @@ unit cpunode;
        narmcnv,
        narmcon,
        narmset,
-       narmmem,
-       { symtable }
-       symcpu,
-       aasmdef
+       narmmem
+{$else}
+       llvmnode
+{$endif}
        ;
 
 

compiler/arm/hlcgcpu.pas

@@ -46,8 +46,6 @@ interface
       procedure a_jmp_external_name(list: TAsmList; const externalname: TSymStr); override;
     end;
 
-  procedure create_hlcodegen;
-
 implementation
 
   uses
@@ -257,7 +255,7 @@ implementation
 
 
 
-  procedure create_hlcodegen;
+  procedure create_hlcodegen_cpu;
     begin
       if GenerateThumbCode then
         hlcg:=tthumbhlcgcpu.create
@@ -268,4 +266,5 @@ implementation
 
 begin
   chlcgobj:=tbasehlcgarm;
+  create_hlcodegen:=@create_hlcodegen_cpu;
 end.

compiler/assemble.pas

@@ -156,9 +156,12 @@ interface
         function single2str(d : single) : string; virtual;
         function double2str(d : double) : string; virtual;
         function extended2str(e : extended) : string; virtual;
-        Function DoPipe:boolean;
+        Function DoPipe:boolean; virtual;
 
         function CreateNewAsmWriter: TExternalAssemblerOutputFile; virtual;
+
+        {# Return true if the external assembler should run again }
+        function RerunAssembler: boolean; virtual;
       public
 
         {# Returns the complete path and executable name of the assembler
@@ -739,9 +742,13 @@ Implementation
 
     Function TExternalAssembler.DoPipe:boolean;
       begin
+{$ifdef hasunix}
         DoPipe:=(cs_asm_pipe in current_settings.globalswitches) and
                 (([cs_asm_extern,cs_asm_leave,cs_link_on_target] * current_settings.globalswitches) = []) and
                 ((asminfo^.id in [as_gas,as_ggas,as_darwin,as_powerpc_xcoff,as_clang,as_solaris_as]));
+{$else hasunix}
+        DoPipe:=false;
+{$endif}
       end;
 
 
@@ -878,7 +885,7 @@ Implementation
 
     Function TExternalAssembler.DoAssemble:boolean;
       begin
-        DoAssemble:=true;
+        result:=true;
         if DoPipe then
          exit;
         if not(cs_asm_extern in current_settings.globalswitches) then
@@ -892,13 +899,13 @@ Implementation
            Message1(exec_i_assembling,name);
          end;
 
-        if CallAssembler(FindAssembler,MakeCmdLine) then
-         writer.RemoveAsm
+        repeat
+          result:=CallAssembler(FindAssembler,MakeCmdLine)
+        until not(result) or not RerunAssembler;
+        if result then
+          writer.RemoveAsm
         else
-         begin
-            DoAssemble:=false;
-            GenerateError;
-         end;
+          GenerateError;
       end;
 
 
@@ -976,6 +983,12 @@ Implementation
       end;
 
 
+    function TExternalAssembler.RerunAssembler: boolean;
+      begin
+        result:=false;
+      end;
+
+
     procedure TExternalAssembler.WriteSourceLine(hp: tailineinfo);
       var
         module : tmodule;
@@ -1758,6 +1771,8 @@ Implementation
                      else
                        Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
                    end;
+                 if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) then
+                   Tai_const(hp).fixsize;
                  ObjData.alloc(tai_const(hp).size);
                end;
              ait_section:
@@ -2026,11 +2041,13 @@ Implementation
                    aitconst_uleb128bit,
                    aitconst_sleb128bit :
                      begin
+                       if Tai_const(hp).fixed_size=0 then
+                         Internalerror(2019030302);
                        if tai_const(hp).consttype=aitconst_uleb128bit then
-                         leblen:=EncodeUleb128(qword(Tai_const(hp).value),lebbuf)
+                         leblen:=EncodeUleb128(qword(Tai_const(hp).value),lebbuf,Tai_const(hp).fixed_size)
                        else
-                         leblen:=EncodeSleb128(Tai_const(hp).value,lebbuf);
-                       if leblen<>tai_const(hp).size then
+                         leblen:=EncodeSleb128(Tai_const(hp).value,lebbuf,Tai_const(hp).fixed_size);
+                       if leblen<>tai_const(hp).fixed_size then
                          internalerror(200709271);
                        ObjData.writebytes(lebbuf,leblen);
                      end;

compiler/avr/cpubase.pas

@@ -305,6 +305,8 @@ unit cpubase;
 
     function dwarf_reg(r:tregister):byte;
     function dwarf_reg_no_error(r:tregister):shortint;
+    function eh_return_data_regno(nr: longint): longint;
+
 
     function is_calljmp(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
 
@@ -432,6 +434,12 @@ unit cpubase;
         result:=regdwarf_table[findreg_by_number(r)];
       end;
 
+    function eh_return_data_regno(nr: longint): longint;
+      begin
+        result:=-1;
+      end;
+
+
     function is_calljmp(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
       begin
         is_calljmp:= o in call_jmp_instructions;

compiler/avr/cpuinfo.pas

@@ -50,7 +50,7 @@ Type
    tfputype =
      (fpu_none,
       fpu_soft,
-      fp_libgcc
+      fpu_libgcc
      );
 
    tcontrollertype =

compiler/avr/cpupara.pas

@@ -220,7 +220,10 @@ unit cpupara;
                paraloc^.loc:=LOC_REFERENCE;
                paraloc^.reference.index:=NR_STACK_POINTER_REG;
                paraloc^.reference.offset:=stack_offset;
+{$push}
+{$R-}
                dec(stack_offset,2);
+{$pop}
             end;
         end;
 

compiler/avr/hlcgcpu.pas

@@ -38,8 +38,6 @@ interface
       procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
     end;
 
-  procedure create_hlcodegen;
-
 implementation
 
   uses
@@ -52,7 +50,7 @@ implementation
     end;
 
 
-  procedure create_hlcodegen;
+  procedure create_hlcodegen_cpu;
     begin
       hlcg:=thlcgcpu.create;
       create_codegen;
@@ -60,4 +58,5 @@ implementation
 
 begin
   chlcgobj:=thlcgcpu;
+  create_hlcodegen:=@create_hlcodegen_cpu;
 end.

compiler/avr/rgcpu.pas

@@ -155,6 +155,13 @@ unit rgcpu;
               A_LDI:
                 for r:=RS_R0 to RS_R15 do
                   add_edge(r,GetSupReg(taicpu(p).oper[0]^.reg));
+              A_STS:
+                for r:=RS_R0 to RS_R15 do
+                  add_edge(r,GetSupReg(taicpu(p).oper[1]^.reg));
+              A_ADIW:
+                for r:=RS_R0 to RS_R31 do
+                  if not (r in [RS_R24,RS_R26,RS_R28,RS_R30]) then
+                    add_edge(r,GetSupReg(taicpu(p).oper[0]^.reg));
               A_MULS:
                 begin
                   for r:=RS_R0 to RS_R15 do
@@ -162,6 +169,14 @@ unit rgcpu;
                   for r:=RS_R0 to RS_R15 do
                     add_edge(r,GetSupReg(taicpu(p).oper[1]^.reg));
                 end;
+              A_LDD:
+                for r:=RS_R0 to RS_R31 do
+                  if not (r in [RS_R28,RS_R30]) then
+                    add_edge(r,GetSupReg(taicpu(p).oper[1]^.ref^.base));
+              A_STD:
+                for r:=RS_R0 to RS_R31 do
+                  if not (r in [RS_R28,RS_R30]) then
+                    add_edge(r,GetSupReg(taicpu(p).oper[0]^.ref^.base));
             end;
           end;
       end;
@@ -175,8 +190,8 @@ unit rgcpu;
         if not(spilltemp.offset in [0..63]) then
           exit;
 
-        { Replace 'mov  dst,orgreg' with 'ld  dst,spilltemp'
-          and     'mov  orgreg,src' with 'st  dst,spilltemp' }
+        { Replace 'mov  dst,orgreg' with 'ldd  dst,spilltemp'
+          and     'mov  orgreg,src' with 'std  spilltemp,src' }
         with instr do
           begin
             if (opcode=A_MOV) and (ops=2) and (oper[1]^.typ=top_reg) and (oper[0]^.typ=top_reg) then
@@ -185,10 +200,8 @@ unit rgcpu;
                    (get_alias(getsupreg(oper[0]^.reg))=orgreg) and
                    (get_alias(getsupreg(oper[1]^.reg))<>orgreg) then
                   begin
-                    { str expects the register in oper[0] }
-                    instr.loadreg(0,oper[1]^.reg);
-                    instr.loadref(1,spilltemp);
-                    opcode:=A_ST;
+                    instr.loadref(0,spilltemp);
+                    opcode:=A_STD;
                     result:=true;
                   end
                 else if (getregtype(oper[1]^.reg)=regtype) and
@@ -196,7 +209,7 @@ unit rgcpu;
                    (get_alias(getsupreg(oper[0]^.reg))<>orgreg) then
                   begin
                     instr.loadref(1,spilltemp);
-                    opcode:=A_LD;
+                    opcode:=A_LDD;
                     result:=true;
                   end;
               end;

compiler/cfidwarf.pas

@@ -23,13 +23,15 @@ unit cfidwarf;
 
 {$i fpcdefs.inc}
 
+{ $define debug_eh}
+
 interface
 
     uses
       cclasses,
       globtype,
       cgbase,cpubase,
-      aasmbase,aasmtai,aasmdata;
+      aasmbase,aasmcfi,aasmtai,aasmdata;
 
     const
       maxdwarfops = 2;
@@ -54,12 +56,18 @@ interface
         constructor create(aop:byte);
         constructor create_reg(aop:byte;enc1:tdwarfoperenc;reg:tregister);
         constructor create_const(aop:byte;enc1:tdwarfoperenc;val:int64);
+        constructor create_sym(aop: byte; enc1: tdwarfoperenc; sym: TAsmSymbol);
         constructor create_reloffset(aop:byte;enc1:tdwarfoperenc;beginlab,endlab:tasmsymbol);
         constructor create_reg_const(aop:byte;enc1:tdwarfoperenc;reg:tregister;enc2:tdwarfoperenc;val:longint);
         procedure generate_code(list:TAsmList);
       end;
 
       TDwarfAsmCFI=class(TAsmCFI)
+        use_eh_frame : boolean;
+        constructor create;override;
+      end;
+
+      TDwarfAsmCFILowLevel=class(TDwarfAsmCFI)
       private
         FDwarfList : TLinkedList;
         FFrameStartLabel,
@@ -75,9 +83,14 @@ interface
         constructor create;override;
         destructor destroy;override;
         procedure generate_code(list:TAsmList);override;
+
+        function get_frame_start: TAsmLabel;override;
+        function get_cfa_list : TAsmList;override;
+
         { operations }
         procedure start_frame(list:TAsmList);override;
         procedure end_frame(list:TAsmList);override;
+        procedure outmost_frame(list: TAsmList);override;
         procedure cfa_offset(list:TAsmList;reg:tregister;ofs:longint);override;
         procedure cfa_restore(list:TAsmList;reg:tregister);override;
         procedure cfa_def_cfa_register(list:TAsmList;reg:tregister);override;
@@ -85,47 +98,27 @@ interface
       end;
 
 
+      TDwarfAsmCFIHighLevel=class(TDwarfAsmCFILowLevel)
+      public
+        procedure generate_code(list:TAsmList);override;
+
+        { operations }
+        procedure start_frame(list:TAsmList);override;
+        procedure end_frame(list:TAsmList);override;
+        procedure outmost_frame(list: TAsmList);override;
+        procedure cfa_offset(list:TAsmList;reg:tregister;ofs:longint);override;
+        procedure cfa_restore(list:TAsmList;reg:tregister);override;
+        procedure cfa_def_cfa_register(list:TAsmList;reg:tregister);override;
+        procedure cfa_def_cfa_offset(list:TAsmList;ofs:longint);override;
+      end;
+
 implementation
 
     uses
       systems,
-      verbose;
-
-    const
-      { Call frame information }
-      DW_CFA_set_loc          = $01;
-      DW_CFA_advance_loc1     = $02;
-      DW_CFA_advance_loc2     = $03;
-      DW_CFA_advance_loc4     = $04;
-      DW_CFA_offset_extended  = $05;
-      DW_CFA_restore_extended = $06;
-      DW_CFA_def_cfa          = $0c;
-      DW_CFA_def_cfa_register = $0d;
-      DW_CFA_def_cfa_offset   = $0e;
-      { Own additions }
-      DW_CFA_start_frame = $f0;
-      DW_CFA_end_frame   = $f1;
-
-      DW_LNS_copy            = $01;
-      DW_LNS_advance_pc      = $02;
-      DW_LNS_advance_line    = $03;
-      DW_LNS_set_file        = $04;
-      DW_LNS_set_column      = $05;
-      DW_LNS_negate_stmt     = $06;
-      DW_LNS_set_basic_block = $07;
-      DW_LNS_const_add_pc    = $08;
-
-      DW_LNS_fixed_advance_pc   = $09;
-      DW_LNS_set_prologue_end   = $0a;
-      DW_LNS_set_epilogue_begin = $0b;
-      DW_LNS_set_isa            = $0c;
-
-      DW_LNE_end_sequence = $01;
-      DW_LNE_set_address  = $02;
-      DW_LNE_define_file  = $03;
-      DW_LNE_lo_user      = $80;
-      DW_LNE_hi_user      = $ff;
-
+      cutils,
+      verbose,
+      dwarfbase;
 
 {****************************************************************************
                                 TDWARFITEM
@@ -161,6 +154,17 @@ implementation
       end;
 
 
+    constructor tdwarfitem.create_sym(aop:byte;enc1:tdwarfoperenc;sym:TAsmSymbol);
+      begin
+        inherited create;
+        op:=aop;
+        ops:=1;
+        oper[0].typ:=dop_sym;
+        oper[0].enc:=enc1;
+        oper[0].sym:=sym;
+      end;
+
+
     constructor tdwarfitem.create_reloffset(aop:byte;enc1:tdwarfoperenc;beginlab,endlab:tasmsymbol);
       begin
         inherited create;
@@ -223,6 +227,19 @@ implementation
 ****************************************************************************}
 
     constructor TDwarfAsmCFI.create;
+      begin
+        inherited;
+        if tf_use_psabieh in target_info.flags then
+          use_eh_frame:=true;
+      end;
+
+
+
+{****************************************************************************
+                             TDwarfAsmCFILowLevel
+****************************************************************************}
+
+    constructor TDwarfAsmCFILowLevel.create;
       begin
         inherited create;
         FFrameStartLabel:=nil;
@@ -234,7 +251,7 @@ implementation
       end;
 
 
-    destructor TDwarfAsmCFI.destroy;
+    destructor TDwarfAsmCFILowLevel.destroy;
       begin
         FDwarfList.Free;
       end;
@@ -242,7 +259,7 @@ implementation
 
 {$ifdef i386}
     { if more cpu dependend stuff is implemented, this needs more refactoring }
-    procedure TDwarfAsmCFI.generate_initial_instructions(list:TAsmList);
+    procedure TDwarfAsmCFILowLevel.generate_initial_instructions(list:TAsmList);
       begin
         list.concat(tai_const.create_8bit(DW_CFA_def_cfa));
         list.concat(tai_const.create_uleb128bit(dwarf_reg(NR_STACK_POINTER_REG)));
@@ -253,7 +270,7 @@ implementation
       end;
 {$else i386}
     { if more cpu dependend stuff is implemented, this needs more refactoring }
-    procedure TDwarfAsmCFI.generate_initial_instructions(list:TAsmList);
+    procedure TDwarfAsmCFILowLevel.generate_initial_instructions(list:TAsmList);
       begin
         list.concat(tai_const.create_8bit(DW_CFA_def_cfa));
         list.concat(tai_const.create_uleb128bit(dwarf_reg(NR_STACK_POINTER_REG)));
@@ -264,24 +281,46 @@ implementation
       end;
 {$endif i386}
 
-    procedure TDwarfAsmCFI.generate_code(list:TAsmList);
+    procedure TDwarfAsmCFILowLevel.generate_code(list:TAsmList);
       var
         hp : tdwarfitem;
+        CurrentLSDALabel,
         cielabel,
         lenstartlabel,
-        lenendlabel    : tasmlabel;
+        lenendlabel,
+        augendlabel,
+        augstartlabel,
+        fdeofslabel, curpos: tasmlabel;
         tc             : tai_const;
       begin
-        new_section(list,sec_debug_frame,'',0);
-        { CIE
-           DWORD   length
-           DWORD   CIE_Id = 0xffffffff
-           BYTE    version = 1
-           STRING  augmentation = "" = BYTE 0
-           ULEB128 code alignment factor = 1
-           ULEB128 data alignment factor = -1
-           BYTE    return address register
-           <...>   start sequence
+        CurrentLSDALabel:=nil;
+        if use_eh_frame then
+          new_section(list,sec_eh_frame,'',0)
+        else
+          new_section(list,sec_debug_frame,'',0);
+        { debug_frame:
+            CIE
+             DWORD   length
+             DWORD   CIE_Id = 0xffffffff
+             BYTE    version = 1
+             STRING  augmentation = "" = BYTE 0
+             ULEB128 code alignment factor = 1
+             ULEB128 data alignment factor = -1
+             BYTE    return address register
+             <...>   augmentation
+             <...>   start sequence
+
+          eh_frame:
+            CIE
+             DWORD   length
+             DWORD   CIE_Id = 0
+             BYTE    version = 1
+             STRING  augmentation = 'zPLR'#0
+             ULEB128 code alignment factor = 1
+             ULEB128 data alignment factor = -1
+             BYTE    return address register
+             <...>   start sequence
+
         }
         current_asmdata.getlabel(cielabel,alt_dbgframe);
         list.concat(tai_label.create(cielabel));
@@ -289,12 +328,47 @@ implementation
         current_asmdata.getlabel(lenendlabel,alt_dbgframe);
         list.concat(tai_const.create_rel_sym(aitconst_32bit,lenstartlabel,lenendlabel));
         list.concat(tai_label.create(lenstartlabel));
-        list.concat(tai_const.create_32bit(longint($ffffffff)));
-        list.concat(tai_const.create_8bit(1));
-        list.concat(tai_const.create_8bit(0)); { empty string }
+        if use_eh_frame then
+          begin
+            list.concat(tai_const.create_32bit(0));
+            list.concat(tai_const.create_8bit(1));
+            list.concat(tai_const.create_8bit(ord('z')));
+            list.concat(tai_const.create_8bit(ord('P')));
+            list.concat(tai_const.create_8bit(ord('L')));
+            list.concat(tai_const.create_8bit(ord('R')));
+            list.concat(tai_const.create_8bit(0));
+          end
+        else
+          begin
+            list.concat(tai_const.create_32bit(longint($ffffffff)));
+            list.concat(tai_const.create_8bit(1));
+            list.concat(tai_const.create_8bit(0)); { empty string }
+          end;
         list.concat(tai_const.create_uleb128bit(code_alignment_factor));
         list.concat(tai_const.create_sleb128bit(data_alignment_factor));
         list.concat(tai_const.create_8bit(dwarf_reg(NR_RETURN_ADDRESS_REG)));
+        { augmentation data }
+        if use_eh_frame then
+          begin
+            current_asmdata.getlabel(augstartlabel,alt_dbgframe);
+            current_asmdata.getlabel(augendlabel,alt_dbgframe);
+            { size of augmentation data ('z') }
+            list.concat(tai_const.create_rel_sym(aitconst_uleb128bit,augstartlabel,augendlabel));
+            list.concat(tai_label.create(augstartlabel));
+            { personality function ('P') }
+            { encoding }
+            list.concat(tai_const.create_8bit({DW_EH_PE_indirect or DW_EH_PE_pcrel or} DW_EH_PE_sdata4));
+            { address of personality function }
+            list.concat(tai_const.Createname('_FPC_psabieh_personality_v0',AT_FUNCTION,0));
+
+            { LSDA encoding  ('L')}
+            list.concat(tai_const.create_8bit({DW_EH_PE_pcrel or }DW_EH_PE_sdata4));
+
+            { FDE encoding ('R') }
+            list.concat(tai_const.create_8bit({DW_EH_PE_pcrel or }DW_EH_PE_sdata4));
+            list.concat(tai_label.create(augendlabel));
+          end;
+
         { Generate standard code
             def_cfa(stackpointer,sizeof(aint))
             cfa_offset_extended(returnaddres,-sizeof(aint))
@@ -327,13 +401,40 @@ implementation
                   }
                   list.concat(tai_const.create_rel_sym(aitconst_32bit,lenstartlabel,lenendlabel));
                   list.concat(tai_label.create(lenstartlabel));
-                  tc:=tai_const.create_sym(cielabel);
-                  { force label offset to secrel32 for windows systems }
-                  if (target_info.system in systems_windows+systems_wince) then
-                    tc.consttype:=aitconst_secrel32_symbol;
-                  list.concat(tc);
-                  list.concat(tai_const.create_sym(hp.oper[0].beginsym));
+                  if use_eh_frame then
+                    begin
+                      { relative offset to the CIE }
+                      current_asmdata.getlabel(fdeofslabel,alt_dbgframe);
+                      list.concat(tai_label.create(fdeofslabel));
+                      list.concat(tai_const.create_rel_sym(aitconst_32bit,cielabel,fdeofslabel));
+                    end
+                  else
+                    begin
+                      tc:=tai_const.create_sym(cielabel);
+                      { force label offset to secrel32 for windows systems }
+                      if (target_info.system in systems_windows+systems_wince) then
+                        tc.consttype:=aitconst_secrel32_symbol;
+                      list.concat(tc);
+                    end;
+
+                  current_asmdata.getlabel(curpos,alt_dbgframe);
+                  list.concat(tai_label.create(curpos));
+                  list.concat(tai_const.Create_sym(hp.oper[0].beginsym));
                   list.concat(tai_const.create_rel_sym(aitconst_ptr,hp.oper[0].beginsym,hp.oper[0].endsym));
+
+                  { we wrote a 'z' into the CIE augmentation data }
+                  if use_eh_frame then
+                    begin
+                      { size of augmentation }
+                      list.concat(tai_const.create_8bit(sizeof(pint)));
+{$ifdef debug_eh}
+                      list.concat(tai_comment.Create(strpnew('LSDA')));
+{$endif debug_eh}
+                      { address of LSDA}
+                      list.concat(tai_const.Create_sym(CurrentLSDALabel));
+                      { do not reuse LSDA label }
+                      CurrentLSDALabel:=nil;
+                    end;
                 end;
               DW_CFA_End_Frame :
                 begin
@@ -342,6 +443,8 @@ implementation
                   lenstartlabel:=nil;
                   lenendlabel:=nil;
                 end;
+              DW_Set_LSDALabel:
+                CurrentLSDALabel:=hp.oper[0].sym as TAsmLabel;
               else
                 hp.generate_code(list);
             end;
@@ -355,19 +458,37 @@ implementation
       end;
 
 
-    procedure TDwarfAsmCFI.start_frame(list:TAsmList);
+    procedure TDwarfAsmCFILowLevel.start_frame(list:TAsmList);
       begin
-        if assigned(FFrameStartLabel) then
-          internalerror(200404129);
-        current_asmdata.getlabel(FFrameStartLabel,alt_dbgframe);
         current_asmdata.getlabel(FFrameEndLabel,alt_dbgframe);
-        FLastloclabel:=FFrameStartLabel;
-        list.concat(tai_label.create(FFrameStartLabel));
-        DwarfList.concat(tdwarfitem.create_reloffset(DW_CFA_start_frame,doe_32bit,FFrameStartLabel,FFrameEndLabel));
+        FLastloclabel:=get_frame_start;
+        list.concat(tai_label.create(get_frame_start));
+        DwarfList.concat(tdwarfitem.create_reloffset(DW_CFA_start_frame,doe_32bit,get_frame_start,FFrameEndLabel));
+      end;
+
+
+    function TDwarfAsmCFILowLevel.get_frame_start : TAsmLabel;
+      begin
+        if not(assigned(FFrameStartLabel)) then
+          current_asmdata.getlabel(FFrameStartLabel,alt_dbgframe);
+        Result:=FFrameStartLabel;
+      end;
+
+
+    function TDwarfAsmCFILowLevel.get_cfa_list: TAsmList;
+      begin
+       Result:=TAsmList(DwarfList);
+      end;
+
+
+    procedure TDwarfAsmCFILowLevel.outmost_frame(list: TAsmList);
+      begin
+        cfa_advance_loc(list);
+        DwarfList.concat(tdwarfitem.create_reg(DW_CFA_undefined,doe_uleb,NR_RETURN_ADDRESS_REG));
       end;
 
 
-    procedure TDwarfAsmCFI.end_frame(list:TAsmList);
+    procedure TDwarfAsmCFILowLevel.end_frame(list:TAsmList);
       begin
         if not assigned(FFrameStartLabel) then
           internalerror(2004041213);
@@ -379,7 +500,7 @@ implementation
       end;
 
 
-    procedure TDwarfAsmCFI.cfa_advance_loc(list:TAsmList);
+    procedure TDwarfAsmCFILowLevel.cfa_advance_loc(list:TAsmList);
       var
         currloclabel : tasmlabel;
       begin
@@ -392,7 +513,7 @@ implementation
       end;
 
 
-    procedure TDwarfAsmCFI.cfa_offset(list:TAsmList;reg:tregister;ofs:longint);
+    procedure TDwarfAsmCFILowLevel.cfa_offset(list:TAsmList;reg:tregister;ofs:longint);
       begin
         cfa_advance_loc(list);
 { TODO: check if ref is a temp}
@@ -401,27 +522,119 @@ implementation
       end;
 
 
-    procedure TDwarfAsmCFI.cfa_restore(list:TAsmList;reg:tregister);
+    procedure TDwarfAsmCFILowLevel.cfa_restore(list:TAsmList;reg:tregister);
       begin
         cfa_advance_loc(list);
         DwarfList.concat(tdwarfitem.create_reg(DW_CFA_restore_extended,doe_uleb,reg));
       end;
 
 
-    procedure TDwarfAsmCFI.cfa_def_cfa_register(list:TAsmList;reg:tregister);
+    procedure TDwarfAsmCFILowLevel.cfa_def_cfa_register(list:TAsmList;reg:tregister);
       begin
         cfa_advance_loc(list);
         DwarfList.concat(tdwarfitem.create_reg(DW_CFA_def_cfa_register,doe_uleb,reg));
       end;
 
 
-    procedure TDwarfAsmCFI.cfa_def_cfa_offset(list:TAsmList;ofs:longint);
+    procedure TDwarfAsmCFILowLevel.cfa_def_cfa_offset(list:TAsmList;ofs:longint);
       begin
         cfa_advance_loc(list);
         DwarfList.concat(tdwarfitem.create_const(DW_CFA_def_cfa_offset,doe_uleb,ofs));
       end;
 
 
+{****************************************************************************
+                             TDwarfAsmCFILowLevel
+****************************************************************************}
+
+
+    procedure TDwarfAsmCFIHighLevel.generate_code(list: TAsmList);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+      end;
+
+
+    procedure TDwarfAsmCFIHighLevel.start_frame(list: TAsmList);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+        list.concat(tai_cfi_op_none.create(cfi_startproc));
+      end;
+
+
+    procedure TDwarfAsmCFIHighLevel.end_frame(list: TAsmList);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+        list.concat(tai_cfi_op_none.create(cfi_endproc));
+      end;
+
+
+    procedure TDwarfAsmCFIHighLevel.outmost_frame(list: TAsmList);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+        list.concat(tai_cfi_op_reg.create(cfi_undefined,NR_RETURN_ADDRESS_REG));
+      end;
+
+
+    procedure TDwarfAsmCFIHighLevel.cfa_offset(list: TAsmList; reg: tregister; ofs: longint);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+        list.concat(tai_cfi_op_reg_val.create(cfi_offset,reg,ofs));
+      end;
+
+
+    procedure TDwarfAsmCFIHighLevel.cfa_restore(list: TAsmList; reg: tregister);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+        list.concat(tai_cfi_op_reg.create(cfi_restore,reg));
+      end;
+
+
+    procedure TDwarfAsmCFIHighLevel.cfa_def_cfa_register(list: TAsmList; reg: tregister);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+        list.concat(tai_cfi_op_reg.create(cfi_def_cfa_register,reg));
+      end;
+
+
+    procedure TDwarfAsmCFIHighLevel.cfa_def_cfa_offset(list: TAsmList; ofs: longint);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+        list.concat(tai_cfi_op_val.create(cfi_def_cfa_offset,ofs));
+      end;
+
+
 begin
-  CAsmCFI:=TDwarfAsmCFI;
+  CAsmCFI:=TDwarfAsmCFIHighLevel;
 end.

compiler/cgbase.pas

@@ -329,7 +329,7 @@ interface
 
        { Invalid register number }
        RS_INVALID    = high(tsuperregister);
-       NR_INVALID    = tregister($fffffffff);
+       NR_INVALID    = tregister($ffffffff);
 
        tcgsize2size : Array[tcgsize] of integer =
         (0,

compiler/cgexcept.pas

@@ -0,0 +1,353 @@
+{
+    Copyright (c) 2017-2019 by Jonas Maebe, member of the
+    Free Pascal Compiler development team
+
+    Base class for exception handling support (setjump/longjump-based)
+
+    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 cgexcept;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      globtype,
+      aasmbase, aasmdata,
+      symtype,symdef,
+      cgbase,cgutils,pass_2;
+
+    type
+      { Utility class for exception handling state management that is used
+        by tryexcept/tryfinally/on nodes (in a separate class so it can both
+        be shared and overridden)
+
+        Never instantiated. }
+      tcgexceptionstatehandler = class
+       type
+        texceptiontemps=record
+          jmpbuf,
+          envbuf,
+          reasonbuf  : treference;
+          { when using dwarf based eh handling, the landing pads get the unwind info passed, it is
+            stored in the given register so it can be passed to unwind_resume }
+          unwind_info : TRegister;
+        end;
+
+        texceptionstate = record
+          exceptionlabel: TAsmLabel;
+          oldflowcontrol,
+          newflowcontrol: tflowcontrol;
+          finallycodelabel  : TAsmLabel;
+        end;
+
+        texceptframekind = (tek_except, tek_implicitfinally, tek_normalfinally);
+
+        class procedure get_exception_temps(list:TAsmList;var t:texceptiontemps); virtual;
+        class procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps); virtual;
+        class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); virtual;
+        { start of "except/finally" block }
+        class procedure emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptstate: texceptionstate;var exceptiontemps:texceptiontemps); virtual;
+        { end of a try-block, label comes after the end of try/except or
+          try/finally }
+        class procedure end_try_block(list: TAsmList; exceptframekind: texceptframekind; const t: texceptiontemps; var exceptionstate: texceptionstate; endlabel: TAsmLabel); virtual;
+        class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); virtual;
+        class procedure handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate); virtual;
+        class procedure handle_reraise(list:TAsmList;const t:texceptiontemps;const entrystate: texceptionstate; const exceptframekind: texceptframekind); virtual;
+        { start of an "on" (catch) block }
+        class procedure begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister); virtual;
+        { end of an "on" (catch) block }
+        class procedure end_catch(list: TAsmList); virtual;
+        { called for a catch all exception }
+        class procedure catch_all_start(list: TAsmList); virtual;
+        { called after the catch all exception has been started with new_exception }
+        class procedure catch_all_add(list: TAsmList); virtual;
+        class procedure catch_all_end(list: TAsmList); virtual;
+        class procedure cleanupobjectstack(list: TAsmList); virtual;
+        class procedure popaddrstack(list: TAsmList); virtual;
+        class function use_cleanup(const exceptframekind: texceptframekind): boolean;
+      end;
+      tcgexceptionstatehandlerclass = class of tcgexceptionstatehandler;
+
+    var
+      cexceptionstatehandler: tcgexceptionstatehandlerclass = tcgexceptionstatehandler;
+
+  implementation
+
+    uses
+      globals,
+      systems,
+      fmodule,
+      aasmtai,
+      symconst,symtable,defutil,
+      parabase,paramgr,
+      procinfo,
+      tgobj,
+      hlcgobj;
+
+{*****************************************************************************
+                     tcgexceptionstatehandler
+*****************************************************************************}
+
+    class function tcgexceptionstatehandler.use_cleanup(const exceptframekind: texceptframekind): boolean;
+      begin
+        { in case of an exception caught by the implicit exception frame of
+          a safecall routine, this is not a cleanup frame but one that
+          catches the exception and returns a value from the function }
+        result:=
+          (exceptframekind=tek_implicitfinally) and
+          not((tf_safecall_exceptions in target_info.flags) and
+             (current_procinfo.procdef.proccalloption=pocall_safecall));
+      end;
+
+    {  Allocate the buffers for exception management and setjmp environment.
+       Return a pointer to these buffers, send them to the utility routine
+       so they are registered, and then call setjmp.
+
+       Then compare the result of setjmp with 0, and if not equal
+       to zero, then jump to exceptlabel.
+
+       Also store the result of setjmp to a temporary space by calling g_save_exception_reason
+
+       It is to note that this routine may be called *after* the stackframe of a
+       routine has been called, therefore on machines where the stack cannot
+       be modified, all temps should be allocated on the heap instead of the
+       stack. }
+
+
+    class procedure tcgexceptionstatehandler.get_exception_temps(list:TAsmList;var t:texceptiontemps);
+     begin
+        tg.gethltemp(list,rec_exceptaddr,rec_exceptaddr.size,tt_persistent,t.envbuf);
+        tg.gethltemp(list,rec_jmp_buf,rec_jmp_buf.size,tt_persistent,t.jmpbuf);
+        tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
+      end;
+
+
+    class procedure tcgexceptionstatehandler.unget_exception_temps(list:TAsmList;const t:texceptiontemps);
+      begin
+        tg.Ungettemp(list,t.jmpbuf);
+        tg.ungettemp(list,t.envbuf);
+        tg.ungettemp(list,t.reasonbuf);
+      end;
+
+
+    class procedure tcgexceptionstatehandler.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
+      var
+        paraloc1, paraloc2, paraloc3, pushexceptres, setjmpres: tcgpara;
+        pd: tprocdef;
+        tmpresloc: tlocation;
+      begin
+        current_asmdata.getjumplabel(exceptstate.exceptionlabel);
+        exceptstate.oldflowcontrol:=flowcontrol;
+        exceptstate.finallycodelabel:=nil;;
+
+        paraloc1.init;
+        paraloc2.init;
+        paraloc3.init;
+
+        { fpc_pushexceptaddr(exceptionframetype, setjmp_buffer, exception_address_chain_entry) }
+        pd:=search_system_proc('fpc_pushexceptaddr');
+        paramanager.getintparaloc(list,pd,1,paraloc1);
+        paramanager.getintparaloc(list,pd,2,paraloc2);
+        paramanager.getintparaloc(list,pd,3,paraloc3);
+        if pd.is_pushleftright then
+          begin
+            { type of exceptionframe }
+            hlcg.a_load_const_cgpara(list,paraloc1.def,1,paraloc1);
+            { setjmp buffer }
+            hlcg.a_loadaddr_ref_cgpara(list,rec_jmp_buf,t.jmpbuf,paraloc2);
+            { exception address chain entry }
+            hlcg.a_loadaddr_ref_cgpara(list,rec_exceptaddr,t.envbuf,paraloc3);
+          end
+        else
+          begin
+            hlcg.a_loadaddr_ref_cgpara(list,rec_exceptaddr,t.envbuf,paraloc3);
+            hlcg.a_loadaddr_ref_cgpara(list,rec_jmp_buf,t.jmpbuf,paraloc2);
+            hlcg.a_load_const_cgpara(list,paraloc1.def,1,paraloc1);
+          end;
+        paramanager.freecgpara(list,paraloc3);
+        paramanager.freecgpara(list,paraloc2);
+        paramanager.freecgpara(list,paraloc1);
+        { perform the fpc_pushexceptaddr call }
+        pushexceptres:=hlcg.g_call_system_proc(list,pd,[@paraloc1,@paraloc2,@paraloc3],nil);
+        paraloc1.done;
+        paraloc2.done;
+        paraloc3.done;
+
+        { get the result }
+        location_reset(tmpresloc,LOC_REGISTER,def_cgsize(pushexceptres.def));
+        tmpresloc.register:=hlcg.getaddressregister(list,pushexceptres.def);
+        hlcg.gen_load_cgpara_loc(list,pushexceptres.def,pushexceptres,tmpresloc,true);
+        pushexceptres.resetiftemp;
+
+        { fpc_setjmp(result_of_pushexceptaddr_call) }
+        pd:=search_system_proc('fpc_setjmp');
+        paramanager.getintparaloc(list,pd,1,paraloc1);
+
+        hlcg.a_load_reg_cgpara(list,pushexceptres.def,tmpresloc.register,paraloc1);
+        paramanager.freecgpara(list,paraloc1);
+        { perform the fpc_setjmp call }
+        setjmpres:=hlcg.g_call_system_proc(list,pd,[@paraloc1],nil);
+        paraloc1.done;
+        location_reset(tmpresloc,LOC_REGISTER,def_cgsize(setjmpres.def));
+        tmpresloc.register:=hlcg.getintregister(list,setjmpres.def);
+        hlcg.gen_load_cgpara_loc(list,setjmpres.def,setjmpres,tmpresloc,true);
+        hlcg.g_exception_reason_save(list,setjmpres.def,ossinttype,tmpresloc.register,t.reasonbuf);
+        { if we get 1 here in the function result register, it means that we
+          longjmp'd back here }
+        hlcg.a_cmp_const_reg_label(list,setjmpres.def,OC_NE,0,tmpresloc.register,exceptstate.exceptionlabel);
+        setjmpres.resetiftemp;
+
+        flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
+     end;
+
+
+    class procedure tcgexceptionstatehandler.emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptstate: texceptionstate;var exceptiontemps:texceptiontemps);
+      begin
+        hlcg.a_label(list,exceptstate.exceptionlabel);
+      end;
+
+
+    class procedure tcgexceptionstatehandler.end_try_block(list: TAsmList; exceptframekind: texceptframekind; const t: texceptiontemps; var exceptionstate: texceptionstate; endlabel: TAsmLabel);
+      begin
+         exceptionstate.newflowcontrol:=flowcontrol;
+         flowcontrol:=exceptionstate.oldflowcontrol;
+      end;
+
+
+    class procedure tcgexceptionstatehandler.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree: boolean);
+      var
+        reasonreg: tregister;
+      begin
+         popaddrstack(list);
+         if not onlyfree then
+          begin
+            reasonreg:=hlcg.getintregister(list,osuinttype);
+            hlcg.g_exception_reason_load(list,osuinttype,osuinttype,t.reasonbuf,reasonreg);
+            hlcg.a_cmp_const_reg_label(list,osuinttype,OC_EQ,a,reasonreg,endexceptlabel);
+          end;
+      end;
+
+
+    { does the necessary things to clean up the object stack }
+    { in the except block                                    }
+    class procedure tcgexceptionstatehandler.cleanupobjectstack(list: TAsmList);
+      begin
+         hlcg.g_call_system_proc(list,'fpc_doneexception',[],nil).resetiftemp;
+      end;
+
+
+    { generates code to be executed when another exeception is raised while
+      control is inside except block }
+    class procedure tcgexceptionstatehandler.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
+      var
+         exitlabel: tasmlabel;
+      begin
+         current_asmdata.getjumplabel(exitlabel);
+         { add an catch all action clause, at least psabieh needs this }
+         catch_all_add(list);
+         end_try_block(list,tek_except,t,entrystate,exitlabel);
+         emit_except_label(list,tek_except,entrystate,t);
+         { don't generate line info for internal cleanup }
+         list.concat(tai_marker.create(mark_NoLineInfoStart));
+         free_exception(list,t,entrystate,0,exitlabel,false);
+         { we don't need to save/restore registers here because reraise never }
+         { returns                                                            }
+         hlcg.g_call_system_proc(list,'fpc_raise_nested',[],nil).resetiftemp;
+         hlcg.a_label(list,exitlabel);
+         cleanupobjectstack(list);
+      end;
+
+
+    class procedure tcgexceptionstatehandler.handle_reraise(list: TAsmList; const t: texceptiontemps; const entrystate: texceptionstate; const exceptframekind: texceptframekind);
+      begin
+        hlcg.g_call_system_proc(list,'fpc_reraise',[],nil).resetiftemp;
+      end;
+
+
+    class procedure tcgexceptionstatehandler.begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister);
+      var
+        pd: tprocdef;
+        href2: treference;
+        fpc_catches_res,
+        paraloc1: tcgpara;
+        exceptloc: tlocation;
+        indirect: boolean;
+        otherunit: boolean;
+      begin
+        paraloc1.init;
+        otherunit:=findunitsymtable(excepttype.owner).moduleid<>findunitsymtable(current_procinfo.procdef.owner).moduleid;
+        indirect:=(tf_supports_packages in target_info.flags) and
+                    (target_info.system in systems_indirect_var_imports) and
+                    (cs_imported_data in current_settings.localswitches) and
+                    otherunit;
+
+        { send the vmt parameter }
+        pd:=search_system_proc('fpc_catches');
+        reference_reset_symbol(href2, current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname, AT_DATA, indirect), 0, sizeof(pint), []);
+        if otherunit then
+          current_module.add_extern_asmsym(excepttype.vmt_mangledname, AB_EXTERNAL, AT_DATA);
+        paramanager.getintparaloc(list, pd, 1, paraloc1);
+        hlcg.a_loadaddr_ref_cgpara(list, excepttype.vmt_def, href2, paraloc1);
+        paramanager.freecgpara(list, paraloc1);
+        fpc_catches_res:=hlcg.g_call_system_proc(list, pd, [@paraloc1], nil);
+        location_reset(exceptloc, LOC_REGISTER, def_cgsize(fpc_catches_res.def));
+        exceptloc.register:=hlcg.getaddressregister(list, fpc_catches_res.def);
+        hlcg.gen_load_cgpara_loc(list, fpc_catches_res.def, fpc_catches_res, exceptloc, true);
+
+        { is it this catch? No. go to next onlabel }
+        hlcg.a_cmp_const_reg_label(list, fpc_catches_res.def, OC_EQ, 0, exceptloc.register, nextonlabel);
+
+        paraloc1.done;
+
+        exceptlocdef:=fpc_catches_res.def;
+        exceptlocreg:=exceptloc.register;
+      end;
+
+
+    class procedure tcgexceptionstatehandler.end_catch(list: TAsmList);
+      begin
+        { nothing to do by default }
+      end;
+
+
+    class procedure tcgexceptionstatehandler.catch_all_start(list: TAsmList);
+      begin
+        { nothing to do by default }
+      end;
+
+
+    class procedure tcgexceptionstatehandler.catch_all_add(list: TAsmList);
+      begin
+        { nothing to do by default }
+      end;
+
+
+    class procedure tcgexceptionstatehandler.catch_all_end(list: TAsmList);
+      begin
+        { nothing to do by default }
+      end;
+
+    class procedure tcgexceptionstatehandler.popaddrstack(list: TAsmList);
+      begin
+        hlcg.g_call_system_proc(list,'fpc_popaddrstack',[],nil).resetiftemp;
+      end;
+
+
+end.
+

compiler/compinnr.pas

@@ -130,6 +130,7 @@ type
      in_hi_qword         = 107,
      in_const_swap_qword = 108,
      in_prefetch_var     = 109,
+     in_const_eh_return_data_regno = 110,
 
 { FPU functions }
      in_trunc_real       = 120,

compiler/cstreams.pas

@@ -67,8 +67,8 @@ type
 
   TCStream = class(TObject)
   private
-    function GetPosition: Longint;
-    procedure SetPosition(Pos: Longint);
+    function GetPosition: Longint; {$ifdef USEINLINE}inline;{$endif}
+    procedure SetPosition(Pos: Longint); {$ifdef USEINLINE}inline;{$endif}
     function GetSize: Longint;
   protected
     procedure SetSize(NewSize: Longint); virtual;
@@ -79,22 +79,22 @@ type
     procedure ReadBuffer(var Buffer; Count: Longint);
     procedure WriteBuffer(const Buffer; Count: Longint);
     function CopyFrom(Source: TCStream; Count: Longint): Longint;
-    function ReadComponent(Instance: TCComponent): TCComponent;
-    function ReadComponentRes(Instance: TCComponent): TCComponent;
-    procedure WriteComponent(Instance: TCComponent);
-    procedure WriteComponentRes(const ResName: string; Instance: TCComponent);
-    procedure WriteDescendent(Instance, Ancestor: TCComponent);
-    procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TCComponent);
-    procedure WriteResourceHeader(const ResName: string; {!!!:out} var FixupInfo: Integer);
-    procedure FixupResourceHeader(FixupInfo: Integer);
-    procedure ReadResHeader;
-    function ReadByte : Byte;
-    function ReadWord : Word;
-    function ReadDWord : Cardinal;
+    function ReadComponent(Instance: TCComponent): TCComponent; {$ifdef USEINLINE}inline;{$endif}
+    function ReadComponentRes(Instance: TCComponent): TCComponent; {$ifdef USEINLINE}inline;{$endif}
+    procedure WriteComponent(Instance: TCComponent); {$ifdef USEINLINE}inline;{$endif}
+    procedure WriteComponentRes(const ResName: string; Instance: TCComponent); {$ifdef USEINLINE}inline;{$endif}
+    procedure WriteDescendent(Instance, Ancestor: TCComponent); {$ifdef USEINLINE}inline;{$endif}
+    procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TCComponent); {$ifdef USEINLINE}inline;{$endif}
+    procedure WriteResourceHeader(const ResName: string; {!!!:out} var FixupInfo: Integer); {$ifdef USEINLINE}inline;{$endif}
+    procedure FixupResourceHeader(FixupInfo: Integer); {$ifdef USEINLINE}inline;{$endif}
+    procedure ReadResHeader; {$ifdef USEINLINE}inline;{$endif}
+    function ReadByte : Byte; {$ifdef USEINLINE}inline;{$endif}
+    function ReadWord : Word; {$ifdef USEINLINE}inline;{$endif}
+    function ReadDWord : Cardinal; {$ifdef USEINLINE}inline;{$endif}
     function ReadAnsiString : AnsiString;
-    procedure WriteByte(b : Byte);
-    procedure WriteWord(w : Word);
-    procedure WriteDWord(d : Cardinal);
+    procedure WriteByte(b : Byte); {$ifdef USEINLINE}inline;{$endif}
+    procedure WriteWord(w : Word); {$ifdef USEINLINE}inline;{$endif}
+    procedure WriteDWord(d : Cardinal); {$ifdef USEINLINE}inline;{$endif}
     Procedure WriteAnsiString (S : AnsiString);
     property Position: Longint read GetPosition write SetPosition;
     property Size: Longint read GetSize write SetSize;
@@ -153,11 +153,11 @@ type
     FMemory: Pointer;
     FSize, FPosition: Longint;
   protected
-    procedure SetPointer(Ptr: Pointer; ASize: Longint);
+    procedure SetPointer(Ptr: Pointer; ASize: Longint); {$ifdef USEINLINE}inline;{$endif}
   public
     function Read(var Buffer; Count: Longint): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
-    procedure SaveToStream(Stream: TCStream);
+    procedure SaveToStream(Stream: TCStream); {$ifdef USEINLINE}inline;{$endif}
     procedure SaveToFile(const FileName: string);
     property Memory: Pointer read FMemory;
   end;

compiler/cutils.pas

@@ -182,8 +182,8 @@ interface
 
     function LengthUleb128(a: qword) : byte;
     function LengthSleb128(a: int64) : byte;
-    function EncodeUleb128(a: qword;out buf) : byte;
-    function EncodeSleb128(a: int64;out buf) : byte;
+    function EncodeUleb128(a: qword;out buf;len: byte) : byte;
+    function EncodeSleb128(a: int64;out buf;len: byte) : byte;
 
   { hide Sysutils.ExecuteProcess in units using this one after SysUtils}
   const
@@ -1672,7 +1672,7 @@ implementation
       end;
 
 
-    function EncodeUleb128(a: qword;out buf) : byte;
+    function EncodeUleb128(a: qword;out buf;len : byte) : byte;
       var
         b: byte;
         pbuf : pbyte;
@@ -1687,13 +1687,13 @@ implementation
           pbuf^:=b;
           inc(pbuf);
           inc(result);
-          if a=0 then
+          if (a=0) and  (result>=len) then
             break;
         until false;
       end;
 
 
-    function EncodeSleb128(a: int64;out buf) : byte;
+    function EncodeSleb128(a: int64;out buf;len : byte) : byte;
       var
         b, size: byte;
         more: boolean;
@@ -1707,7 +1707,7 @@ implementation
           b := a and $7f;
           a := SarInt64(a, 7);
 
-          if (
+          if (result+1>=len) and (
             ((a = 0) and (b and $40 = 0)) or
             ((a = -1) and (b and $40 <> 0))
           ) then

compiler/dbgstabs.pas

@@ -1642,7 +1642,7 @@ implementation
         ss:='';
         if not assigned(sym.typedef) then
           internalerror(200509262);
-        if sym.typedef.typ in tagtypes then
+        if use_tag_prefix(sym.typedef) then
           stabchar:=tagtypeprefix
         else
           stabchar:='t';

compiler/dbgstabx.pas

@@ -158,7 +158,7 @@ implementation
           declstabnr:=def_stab_number(def)
         end;
       if (symname='') or
-         not(def.typ in tagtypes) then
+         not(use_tag_prefix(def)) then
         begin
           st:=def_stabstr_evaluate(def,':$1$2=',[stabchar,declstabnr]);
           st:='"'+def_stabstr_evaluate(def,symname,[])+st+ss;

compiler/defcmp.pas

@@ -1986,7 +1986,7 @@ implementation
            if (def1.typ = orddef) and (def2.typ = orddef) then
             Begin
               { see p.47 of Turbo Pascal 7.01 manual for the separation of types }
-              { range checking for case statements is done with testrange        }
+              { range checking for case statements is done with adaptrange        }
               case torddef(def1).ordtype of
                 u8bit,u16bit,u32bit,u64bit,
                 s8bit,s16bit,s32bit,s64bit :

compiler/defutil.pas

@@ -68,6 +68,9 @@ interface
 
     procedure int_to_type(const v:TConstExprInt;var def:tdef);
 
+    {# Return true if the type (orddef or enumdef) spans its entire bitrange }
+    function spans_entire_range(def: tdef): boolean;
+
     {# Returns true, if definition defines an integer type }
     function is_integer(def : tdef) : boolean;
 
@@ -156,6 +159,9 @@ interface
     }
     function is_special_array(p : tdef) : boolean;
 
+    {# Returns true, if p points to a normal array, bitpacked arrays are included }
+    function is_normal_array(p : tdef) : boolean;
+
     {# Returns true if p is a bitpacked array }
     function is_packed_array(p: tdef) : boolean;
 
@@ -283,15 +289,25 @@ interface
     { true, if def is a signed int type, equal in size to the processor's native int size }
     function is_nativesint(def : tdef) : boolean;
 
+  type
+    tperformrangecheck = (
+      rc_internal,  { never at all, internal conversion }
+      rc_explicit,  { no, but this is a user conversion and hence can still give warnings in some cases }
+      rc_default,   { only if range checking is enabled }
+      rc_always     { always }
+    );
     {# If @var(l) isn't in the range of todef a range check error (if not explicit) is generated and
       the value is placed within the range
     }
-    procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean);
+    procedure adaptrange(todef : tdef;var l : tconstexprint; rangecheck: tperformrangecheck);
+    { for when used with nf_explicit/nf_internal nodeflags }
+    procedure adaptrange(todef : tdef;var l : tconstexprint; internal, explicit: boolean);
 
     {# Returns the range of def, where @var(l) is the low-range and @var(h) is
       the high-range.
     }
     procedure getrange(def : tdef;out l, h : TConstExprInt);
+    procedure getrangedefmasksize(def: tdef; out rangedef: tdef; out mask: TConstExprInt; out size: longint);
 
     { Returns the range type of an ordinal type in the sense of ISO-10206 }
     function get_iso_range_type(def: tdef): tdef;
@@ -548,6 +564,47 @@ implementation
       end;
 
 
+    function spans_entire_range(def: tdef): boolean;
+      var
+         lv, hv: Tconstexprint;
+         mask: qword;
+         size: longint;
+      begin
+        case def.typ of
+          orddef,
+          enumdef:
+            getrange(def,lv,hv);
+          else
+            internalerror(2019062203);
+        end;
+        size:=def.size;
+        case size of
+          1: mask:=$ff;
+          2: mask:=$ffff;
+          4: mask:=$ffffffff;
+          8: mask:=qword(-1);
+          else
+            internalerror(2019062204);
+        end;
+        result:=false;
+        if is_signed(def) then
+          begin
+            if (lv.uvalue and mask)<>(qword(1) shl (size*8-1)) then
+              exit;
+            if (hv.uvalue and mask)<>(mask shr 1) then
+              exit;
+          end
+        else
+          begin
+            if lv<>0 then
+              exit;
+            if hv.uvalue<>mask then
+              exit;
+          end;
+        result:=true;
+      end;
+
+
     { true if p is an integer }
     function is_integer(def : tdef) : boolean;
       begin
@@ -752,6 +809,14 @@ implementation
                  );
       end;
 
+    { true, if p points to a normal array, bitpacked arrays are included }
+    function is_normal_array(p : tdef) : boolean;
+      begin
+         result:=(p.typ=arraydef) and
+                 ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])=[]) and
+                 not(is_open_array(p));
+      end;
+
     { true if p is an ansi string def }
     function is_ansistring(p : tdef) : boolean;
       begin
@@ -1031,53 +1096,86 @@ implementation
 
     { if l isn't in the range of todef a range check error (if not explicit) is generated and
       the value is placed within the range }
-    procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean);
+    procedure adaptrange(todef : tdef;var l : tconstexprint; rangecheck: tperformrangecheck);
       var
-         lv,hv: TConstExprInt;
+         lv,hv,oldval,sextval,mask: TConstExprInt;
+         rangedef: tdef;
+         rangedefsize: longint;
+         warned: boolean;
       begin
-         { for 64 bit types we need only to check if it is less than }
-         { zero, if def is a qword node                              }
          getrange(todef,lv,hv);
          if (l<lv) or (l>hv) then
            begin
-             if not explicit then
+             warned:=false;
+             if rangecheck in [rc_default,rc_always] then
                begin
-                 if ((todef.typ=enumdef) and
-                     { delphi allows range check errors in
-                      enumeration type casts FK }
-                     not(m_delphi in current_settings.modeswitches)) or
-                    (cs_check_range in current_settings.localswitches) or
-                    forcerangecheck then
+                 if (rangecheck=rc_always) or
+                    (todef.typ=enumdef) or
+                    (cs_check_range in current_settings.localswitches) then
                    Message3(type_e_range_check_error_bounds,tostr(l),tostr(lv),tostr(hv))
                  else
                    Message3(type_w_range_check_error_bounds,tostr(l),tostr(lv),tostr(hv));
+                 warned:=true;
+               end
+             { give warnings about range errors with explicit typeconversions if the target
+               type does not span the entire range that can be represented by its bits
+               (subrange type or enum), because then the result is undefined }
+             else if (rangecheck<>rc_internal) and
+                     (not is_pasbool(todef) and
+                      not spans_entire_range(todef)) then
+               begin
+                 Message3(type_w_range_check_error_bounds,tostr(l),tostr(lv),tostr(hv));
+                 warned:=true;
                end;
+
              { Fix the value to fit in the allocated space for this type of variable }
-             case longint(todef.size) of
-               1: l := l and $ff;
-               2: l := l and $ffff;
-               4: l := l and $ffffffff;
-               else
-                 ;
-             end;
+             oldval:=l;
+             getrangedefmasksize(todef,rangedef,mask,rangedefsize);
+             l:=l and mask;
              {reset sign, i.e. converting -1 to qword changes the value to high(qword)}
              l.signed:=false;
+             sextval:=0;
              { do sign extension if necessary (JM) }
-             if is_signed(todef) then
-              begin
-                case longint(todef.size) of
-                  1: l.svalue := shortint(l.svalue);
-                  2: l.svalue := smallint(l.svalue);
-                  4: l.svalue := longint(l.svalue);
-                  else
-                    ;
-                end;
-                l.signed:=true;
+             case rangedefsize of
+               1: sextval.svalue:=shortint(l.svalue);
+               2: sextval.svalue:=smallint(l.svalue);
+               4: sextval.svalue:=longint(l.svalue);
+               8: sextval.svalue:=l.svalue;
+               else
+                 internalerror(201906230);
               end;
+              sextval.signed:=true;
+              { Detect if the type spans the entire range, but more bits were specified than
+                the type can contain, e.g. shortint($fff).
+                However, none of the following should result in a warning:
+                  1) shortint($ff) (-> $ff -> $ff -> $ffff ffff ffff ffff)
+                  2) shortint(longint(-1)) ($ffff ffff ffff ffff ffff -> $ff -> $ffff ffff ffff ffff
+                  3) cardinal(-1) (-> $ffff ffff ffff ffff -> $ffff ffff)
+              }
+              if not warned and
+                (rangecheck<>rc_internal) and
+                (oldval.uvalue<>l.uvalue) and
+                (oldval.uvalue<>sextval.uvalue) then
+               begin
+                 Message3(type_w_range_check_error_bounds,tostr(oldval),tostr(lv),tostr(hv));
+               end;
+              if is_signed(rangedef) then
+                l:=sextval;
            end;
       end;
 
 
+    procedure adaptrange(todef: tdef; var l: tconstexprint; internal, explicit: boolean);
+      begin
+        if internal then
+          adaptrange(todef, l, rc_internal)
+        else if explicit then
+          adaptrange(todef, l, rc_explicit)
+        else
+          adaptrange(todef, l, rc_default)
+      end;
+
+
     { return the range from def in l and h }
     procedure getrange(def : tdef;out l, h : TConstExprInt);
       begin
@@ -1108,6 +1206,39 @@ implementation
       end;
 
 
+    procedure getrangedefmasksize(def: tdef; out rangedef: tdef; out mask: TConstExprInt; out size: longint);
+      begin
+        case def.typ of
+          orddef, enumdef:
+            begin
+              rangedef:=def;
+              size:=def.size;
+              case size of
+                1: mask:=$ff;
+                2: mask:=$ffff;
+                4: mask:=$ffffffff;
+                8: mask:=$ffffffffffffffff;
+                else
+                  internalerror(2019062305);
+                end;
+            end;
+          arraydef:
+            begin
+              rangedef:=tarraydef(def).rangedef;
+              getrangedefmasksize(rangedef,rangedef,mask,size);
+            end;
+          undefineddef:
+            begin
+              rangedef:=sizesinttype;
+              size:=rangedef.size;
+              mask:=-1;
+            end;
+          else
+            internalerror(2019062306);
+        end;
+      end;
+
+
     function mmx_type(p : tdef) : tmmxtype;
       begin
          mmx_type:=mmxno;

compiler/dwarfbase.pas

@@ -0,0 +1,90 @@
+{
+    Copyright (c) 2003-2019 by Peter Vreman and Florian Klaempfl
+
+    This units contains special support for DWARF debug info
+
+    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 dwarfbase;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    const
+      { Call frame information }
+      DW_CFA_set_loc          = $01;
+      DW_CFA_advance_loc1     = $02;
+      DW_CFA_advance_loc2     = $03;
+      DW_CFA_advance_loc4     = $04;
+      DW_CFA_offset_extended  = $05;
+      DW_CFA_restore_extended = $06;
+      DW_CFA_undefined        = $07;
+      DW_CFA_def_cfa          = $0c;
+      DW_CFA_def_cfa_register = $0d;
+      DW_CFA_def_cfa_offset   = $0e;
+      { Own additions }
+      DW_CFA_start_frame = $f0;
+      DW_CFA_end_frame   = $f1;
+      { pseudo operation to set the LSDALable, must
+        be set before DW_CFA_start_frame is executed }
+      DW_Set_LSDALabel   = $f2;
+
+      DW_LNS_copy            = $01;
+      DW_LNS_advance_pc      = $02;
+      DW_LNS_advance_line    = $03;
+      DW_LNS_set_file        = $04;
+      DW_LNS_set_column      = $05;
+      DW_LNS_negate_stmt     = $06;
+      DW_LNS_set_basic_block = $07;
+      DW_LNS_const_add_pc    = $08;
+
+      DW_LNS_fixed_advance_pc   = $09;
+      DW_LNS_set_prologue_end   = $0a;
+      DW_LNS_set_epilogue_begin = $0b;
+      DW_LNS_set_isa            = $0c;
+
+      DW_LNE_end_sequence = $01;
+      DW_LNE_set_address  = $02;
+      DW_LNE_define_file  = $03;
+      DW_LNE_lo_user      = $80;
+      DW_LNE_hi_user      = $ff;
+
+      DW_EH_PE_absptr	= $00;
+      DW_EH_PE_uleb128	= $01;
+      DW_EH_PE_udata2	= $02;
+      DW_EH_PE_udata4	= $03;
+      DW_EH_PE_udata8	= $04;
+      DW_EH_PE_sleb128	= $09;
+      DW_EH_PE_sdata2	= $0A;
+      DW_EH_PE_sdata4	= $0B;
+      DW_EH_PE_sdata8	= $0C;
+
+      DW_EH_PE_pcrel	= $10;
+      DW_EH_PE_textrel	= $20;
+      DW_EH_PE_datarel	= $30;
+      DW_EH_PE_funcrel	= $40;
+      DW_EH_PE_aligned	= $50;
+      DW_EH_PE_indirect = $80;
+
+      DW_EH_PE_omit     = $ff;
+
+  implementation
+
+end.
+
+

compiler/entfile.pas

@@ -257,7 +257,7 @@ type
     constructor create(const fn:string);
     destructor  destroy;override;
     function getversion:integer;
-    procedure flush;
+    procedure flush; {$ifdef USEINLINE}inline;{$endif}
     procedure closefile;virtual;
     procedure newentry;
     property position:longint read getposition write setposition;
@@ -278,9 +278,9 @@ type
     procedure readdata(out b;len:integer);
     procedure skipdata(len:integer);
     function  readentry:byte;
-    function  EndOfEntry:boolean;
-    function  entrysize:longint;
-    function  entryleft:longint;
+    function  EndOfEntry:boolean; {$ifdef USEINLINE}inline;{$endif}
+    function  entrysize:longint; {$ifdef USEINLINE}inline;{$endif}
+    function  entryleft:longint; {$ifdef USEINLINE}inline;{$endif}
     procedure getdatabuf(out b;len:integer;out res:integer);
     procedure getdata(out b;len:integer);
     function  getbyte:byte;
@@ -289,14 +289,14 @@ type
     function  getlongint:longint;
     function getint64:int64;
     function  getqword:qword;
-    function getaint:{$ifdef generic_cpu}int64{$else}aint{$endif};
-    function getasizeint:{$ifdef generic_cpu}int64{$else}asizeint{$endif};
-    function getpuint:{$ifdef generic_cpu}qword{$else}puint{$endif};
-    function getptruint:{$ifdef generic_cpu}qword{$else}TConstPtrUInt{$endif};
-    function getaword:{$ifdef generic_cpu}qword{$else}aword{$endif};
+    function getaint:{$ifdef generic_cpu}int64{$else}aint{$ifdef USEINLINE}; inline{$endif}{$endif};
+    function getasizeint:{$ifdef generic_cpu}int64{$else}asizeint{$ifdef USEINLINE}; inline{$endif}{$endif};
+    function getpuint:{$ifdef generic_cpu}qword{$else}puint{$ifdef USEINLINE}; inline{$endif}{$endif};
+    function getptruint:{$ifdef generic_cpu}qword{$else}TConstPtrUInt{$ifdef USEINLINE}; inline{$endif}{$endif};
+    function getaword:{$ifdef generic_cpu}qword{$else}aword{$ifdef USEINLINE}; inline{$endif}{$endif};
     function  getreal:entryreal;
     function  getrealsize(sizeofreal : longint):entryreal;
-    function  getboolean:boolean;inline;
+    function  getboolean:boolean; {$ifdef USEINLINE}inline;{$endif}
     function  getstring:string;
     function  getpshortstring:pshortstring;
     function  getansistring:ansistring;
@@ -311,23 +311,23 @@ type
     procedure writedata(const b;len:integer);
     procedure writeentry(ibnr:byte);
     procedure putdata(const b;len:integer);virtual;
-    procedure putbyte(b:byte);
-    procedure putword(w:word);
-    procedure putdword(w:dword);
-    procedure putlongint(l:longint);
-    procedure putint64(i:int64);
-    procedure putqword(q:qword);
-    procedure putaint(i:aint);
-    procedure putasizeint(i:asizeint);
-    procedure putpuint(i:puint);
-    procedure putptruint(v:TConstPtrUInt);
-    procedure putaword(i:aword);
+    procedure putbyte(b:byte); {$ifdef USEINLINE}inline;{$endif}
+    procedure putword(w:word); {$ifdef USEINLINE}inline;{$endif}
+    procedure putdword(w:dword); {$ifdef USEINLINE}inline;{$endif}
+    procedure putlongint(l:longint); {$ifdef USEINLINE}inline;{$endif}
+    procedure putint64(i:int64); {$ifdef USEINLINE}inline;{$endif}
+    procedure putqword(q:qword); {$ifdef USEINLINE}inline;{$endif}
+    procedure putaint(i:aint); {$ifdef USEINLINE}inline;{$endif}
+    procedure putasizeint(i:asizeint); {$ifdef USEINLINE}inline;{$endif}
+    procedure putpuint(i:puint); {$ifdef USEINLINE}inline;{$endif}
+    procedure putptruint(v:TConstPtrUInt); {$ifdef USEINLINE}inline;{$endif}
+    procedure putaword(i:aword); {$ifdef USEINLINE}inline;{$endif}
     procedure putreal(d:entryreal);
-    procedure putboolean(b:boolean);inline;
-    procedure putstring(const s:string);
+    procedure putboolean(b:boolean); {$ifdef USEINLINE}inline;{$endif}
+    procedure putstring(const s:string); {$ifdef USEINLINE}inline;{$endif}
     procedure putansistring(const s:ansistring);
-    procedure putnormalset(const b);
-    procedure putsmallset(const b);
+    procedure putnormalset(const b); {$ifdef USEINLINE}inline;{$endif}
+    procedure putsmallset(const b); {$ifdef USEINLINE}inline;{$endif}
     procedure tempclose;        // MG: not used, obsolete?
     function  tempopen:boolean; // MG: not used, obsolete?
   end;

compiler/expunix.pas

@@ -139,6 +139,7 @@ begin
       anyhasalias:=false;
       { if the procedure has the exported name as one of its aliases, we don't
         need a separate stub }
+      pd:=nil;
       for i:=0 to tprocsym(hp.sym).procdeflist.count-1 do
         begin
           pd:=tprocdef(tprocsym(hp.sym).procdeflist[i]);

compiler/finput.pas

@@ -145,6 +145,9 @@ interface
           objfilename,              { fullname of the objectfile }
           asmfilename,              { fullname of the assemblerfile }
           ppufilename,              { fullname of the ppufile }
+{$ifdef DEBUG_NODE_XML}
+          ppxfilename,              { fullname of the intermediate node XML file }
+{$endif DEBUG_NODE_XML}
           importlibfilename,        { fullname of the import libraryfile }
           staticlibfilename,        { fullname of the static libraryfile }
           sharedlibfilename,        { fullname of the shared libraryfile }
@@ -154,6 +157,9 @@ interface
           dbgfilename,              { fullname of the debug info file }
           path,                     { path where the module is find/created }
           outputpath   : TPathStr;  { path where the .s / .o / exe are created }
+{$ifdef DEBUG_NODE_XML}
+          ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
+{$endif DEBUG_NODE_XML}
           constructor create(const s:string);
           destructor destroy;override;
           procedure setfilename(const fn:TPathStr;allowoutput:boolean);
@@ -625,6 +631,9 @@ uses
          asmfilename:=p+n+target_info.asmext;
          objfilename:=p+n+target_info.objext;
          ppufilename:=p+n+target_info.unitext;
+{$ifdef DEBUG_NODE_XML}
+         ppxfilename:=p+n+'-node-dump.xml';
+{$endif DEBUG_NODE_XML}
          importlibfilename:=p+target_info.importlibprefix+n+target_info.importlibext;
          staticlibfilename:=p+target_info.staticlibprefix+n+target_info.staticlibext;
          exportfilename:=p+'exp'+n+target_info.objext;
@@ -668,6 +677,9 @@ uses
         realmodulename:=stringdup(s);
         mainsource:='';
         ppufilename:='';
+{$ifdef DEBUG_NODE_XML}
+        ppxfilename:='';
+{$endif DEBUG_NODE_XML}
         objfilename:='';
         asmfilename:='';
         importlibfilename:='';
@@ -679,6 +691,12 @@ uses
         outputpath:='';
         paramfn:='';
         path:='';
+{$ifdef DEBUG_NODE_XML}
+        { Setting ppxfilefail to true will stop it from being written to if it
+          was never initialised, which happens if a module doesn't need
+          recompiling. }
+        ppxfilefail := True;
+{$endif DEBUG_NODE_XML}
         { status }
         state:=ms_registered;
         { unit index }

compiler/fmodule.pas

@@ -149,8 +149,10 @@ interface
         procaddrdefs  : THashSet; { list of procvardefs created when getting the address of a procdef (not saved/restored) }
 {$ifdef llvm}
         llvmdefs      : THashSet; { defs added for llvm-specific reasons (not saved/restored) }
-        llvmusedsyms  : TFPObjectList; { a list of tllvmdecls of all symbols that need to be added to llvm.used (so they're not removed by llvm optimisation passes nor by the linker) }
-        llvmcompilerusedsyms : TFPObjectList; { a list of tllvmdecls of all symbols that need to be added to llvm.compiler.used (so they're not removed by llvm optimisation passes) }
+        llvmusedsyms  : TFPObjectList; { a list of asmsymbols and their defs that need to be added to llvm.used (so they're not removed by llvm optimisation passes nor by the linker) }
+        llvmcompilerusedsyms : TFPObjectList; { a list of asmsymbols and their defs that need to be added to llvm.compiler.used (so they're not removed by llvm optimisation passes) }
+        llvminitprocs,
+        llvmfiniprocs : TFPList;
 {$endif llvm}
         ansistrdef    : tobject; { an ansistring def redefined for the current module }
         wpoinfo       : tunitwpoinfobase; { whole program optimization-related information that is generated during the current run for this unit }
@@ -596,8 +598,10 @@ implementation
         procaddrdefs:=THashSet.Create(64,true,false);
 {$ifdef llvm}
         llvmdefs:=THashSet.Create(64,true,false);
-        llvmusedsyms:=TFPObjectList.Create(false);
-        llvmcompilerusedsyms:=TFPObjectList.Create(false);
+        llvmusedsyms:=TFPObjectList.Create(true);
+        llvmcompilerusedsyms:=TFPObjectList.Create(true);
+        llvminitprocs:=TFPList.Create;
+        llvmfiniprocs:=TFPList.Create;
 {$endif llvm}
         ansistrdef:=nil;
         wpoinfo:=nil;
@@ -727,6 +731,8 @@ implementation
         llvmdefs.free;
         llvmusedsyms.free;
         llvmcompilerusedsyms.free;
+        llvminitprocs.free;
+        llvmfiniprocs.free;
 {$endif llvm}
         ansistrdef:=nil;
         wpoinfo.free;
@@ -798,9 +804,13 @@ implementation
         llvmdefs.free;
         llvmdefs:=THashSet.Create(64,true,false);
         llvmusedsyms.free;
-        llvmusedsyms:=TFPObjectList.Create(false);
+        llvmusedsyms:=TFPObjectList.Create(true);
         llvmcompilerusedsyms.free;
-        llvmcompilerusedsyms:=TFPObjectList.Create(false);
+        llvmcompilerusedsyms:=TFPObjectList.Create(true);
+        llvminitprocs.free;
+        llvminitprocs:=TFPList.Create;
+        llvmfiniprocs.free;
+        llvmfiniprocs:=TFPList.Create;
 {$endif llvm}
         wpoinfo.free;
         wpoinfo:=nil;

compiler/fpcdefs.inc

@@ -34,6 +34,11 @@
 
 {$define USEEXCEPT}
 
+{$ifdef VER3_0}
+  { fix bootstrapping dfa gives warnings on 3.2+ code due to changed case behaviour }
+  {$OPTIMIZATION NODFA}
+{$endif VER3_0}
+
 { This fake CPU is used to allow incorporation of globtype unit
   into utils/ppudump without any CPU specific code PM }
 {$ifdef generic_cpu}
@@ -320,6 +325,8 @@
 }
 {$ifdef llvm}
   {$undef SUPPORT_MMX}
+  {$undef cpuneedsmulhelper}
+  {$undef cpuneedsdivhelper}
   {$define cpuhighleveltarget}
   {$define cpucg64shiftsupport}
   {$define symansistr}

compiler/fppu.pas

@@ -336,6 +336,11 @@ var
               exit;
             end;
 {$endif i8086}
+          if {$ifdef llvm}not{$endif}(mf_llvm in moduleflags) then
+            begin
+              Message(unit_u_ppu_llvm_mismatch,@queuecomment);
+              exit;
+            end;
           result:=true;
         end;
 
@@ -1013,6 +1018,12 @@ var
         if current_settings.x86memorymodel in [mm_tiny,mm_small,mm_medium] then
           include(moduleflags,mf_i8086_ss_equals_ds);
 {$endif i8086}
+{$ifdef llvm}
+        include(moduleflags,mf_llvm);
+{$endif}
+{$ifdef symansistr}
+        include(moduleflags,mf_symansistr);
+{$endif}
 
         old_docrc:=ppufile.do_crc;
         ppufile.do_crc:=false;
@@ -1500,7 +1511,7 @@ var
            headerflags:=headerflags or uf_fpu_emulation;
 {$endif cpufpemu}
 {$ifdef Test_Double_checksum_write}
-         Assign(CRCFile,s+'.IMP');
+         Assign(CRCFile,ppufilename+'.IMP');
          Rewrite(CRCFile);
 {$endif def Test_Double_checksum_write}
 
@@ -1681,7 +1692,7 @@ var
     procedure tppumodule.getppucrc;
       begin
 {$ifdef Test_Double_checksum_write}
-         Assign(CRCFile,s+'.INT')
+         Assign(CRCFile,ppufilename+'.INT');
          Rewrite(CRCFile);
 {$endif def Test_Double_checksum_write}
 

compiler/globals.pas

@@ -399,6 +399,7 @@ interface
        defaultmainaliasname = 'main';
        mainaliasname : string = defaultmainaliasname;
 
+      LTOExt: TCmdStr = '';
 
     const
       default_settings : TSettings = (
@@ -567,7 +568,7 @@ interface
         instructionset : is_arm;
 {$endif defined(ARM)}
 {$if defined(LLVM) and not defined(GENERIC_CPU)}
-        llvmversion    : llvmver_3_9_0;
+        llvmversion    : llvmver_3_9;
 {$endif defined(LLVM) and not defined(GENERIC_CPU)}
         controllertype : ct_none;
         pmessage : nil;

compiler/globtype.pas

@@ -196,7 +196,9 @@ interface
          cs_huge_code,
          cs_win16_smartcallbacks,
          { Record usage of checkpointer experimental feature }
-         cs_checkpointer_called
+         cs_checkpointer_called,
+         { enable link time optimisation (both unit code generation and optimising the whole program/library) }
+         cs_lto
        );
        tmoduleswitches = set of tmoduleswitch;
 
@@ -225,7 +227,9 @@ interface
          cs_link_map,cs_link_pthread,cs_link_no_default_lib_order,
          cs_link_native,
          cs_link_pre_binutils_2_19,
-         cs_link_vlink
+         cs_link_vlink,
+         { disable LTO for the system unit (needed to work around linker bugs on macOS) }
+         cs_lto_nosystem
        );
        tglobalswitches = set of tglobalswitch;
 
@@ -372,7 +376,9 @@ interface
          mf_i8086_cs_equals_ds,       { this unit uses an i8086 memory model with CS=DS (i.e. tiny) }
          mf_i8086_ss_equals_ds,       { this unit uses an i8086 memory model with SS=DS (i.e. tiny, small or medium) }
          mf_package_deny,             { this unit must not be part of a package }
-         mf_package_weak              { this unit may be completely contained in a package }
+         mf_package_weak,             { this unit may be completely contained in a package }
+         mf_llvm,                     { compiled for LLVM code generator, not compatible with regular compiler because of different nodes in inline functions }
+         mf_symansistr                { symbols are ansistrings (for ppudump) }
        );
        tmoduleflags = set of tmoduleflag;
 
@@ -734,7 +740,9 @@ interface
            to restore DS segment register  }
          pi_has_open_array_parameter,
          { subroutine uses threadvars }
-         pi_uses_threadvar
+         pi_uses_threadvar,
+         { set if the procedure has generated data which shall go in an except table }
+         pi_has_except_table_data
        );
        tprocinfoflags=set of tprocinfoflag;
 
@@ -800,6 +808,7 @@ interface
        link_static  = $2;
        link_smart   = $4;
        link_shared  = $8;
+       link_lto     = $10;
 
     type
       { a message state }

compiler/hlcg2ll.pas

@@ -1319,6 +1319,10 @@ implementation
       ncgutil.maketojumpboollabels(list,p,truelabel,falselabel);
     end;
 
+{$if first_mm_imreg = 0}
+  {$WARN 4044 OFF} { Comparison might be always false ... }
+{$endif}
+
   procedure thlcg2ll.gen_load_para_value(list: TAsmList);
 
     procedure get_para(const paraloc:TCGParaLocation);

compiler/hlcgobj.pas

@@ -669,7 +669,7 @@ unit hlcgobj;
        { class type of high level code generator class (also valid when hlcg is
          nil, in order to be able to call its virtual class methods) }
        chlcgobj: thlcgobjclass;
-
+       create_hlcodegen: TProcedure;
 
     procedure destroy_hlcodegen;
 
@@ -823,9 +823,13 @@ implementation
           objectdef,
           procvardef,
           procdef,
-          arraydef,
           formaldef:
             result:=R_ADDRESSREGISTER;
+          arraydef:
+            if tstoreddef(def).is_intregable then
+              result:=R_INTREGISTER
+            else
+              result:=R_ADDRESSREGISTER;
           floatdef:
             if use_vectorfpu(def) then
               result:=R_MMREGISTER

compiler/i386/aoptcpu.pas

@@ -52,6 +52,7 @@ unit aoptcpu;
       cpuinfo,
       aasmcpu,
       aoptutils,
+      aasmcfi,
       procinfo,
       cgutils,
       { units we should get rid off: }
@@ -267,8 +268,10 @@ begin
                       if not(hp1.typ in ([ait_label]+skipinstr)) then
                         begin
                           { don't kill start/end of assembler block,
-                            no-line-info-start/end etc }
-                          if not(hp1.typ in [ait_align,ait_marker]) then
+                            no-line-info-start/end, cfi end, etc }
+                          if not(hp1.typ in [ait_align,ait_marker]) and
+                             ((hp1.typ<>ait_cfi) or
+                              (tai_cfi_base(hp1).cfityp<>cfi_endproc)) then
                             begin
                               asml.remove(hp1);
                               hp1.free;

compiler/i386/cgcpu.pas

@@ -319,6 +319,7 @@ unit cgcpu;
                   internal_restore_regs(list,true);
                 if (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
                   list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[OS_ADDR],NR_FRAME_POINTER_REG));
+                current_asmdata.asmcfi.cfa_def_cfa_offset(list,sizeof(pint));
               end
             else
               begin

compiler/i386/cpupi.pas

@@ -28,10 +28,10 @@ unit cpupi;
   interface
 
     uses
-       psub,procinfo,aasmdata;
+       psub,procinfo,psabiehpi,aasmdata;
 
     type
-       tcpuprocinfo = class(tcgprocinfo)
+       tcpuprocinfo = class(tpsabiehprocinfo)
          constructor create(aparent:tprocinfo);override;
          procedure set_first_temp_offset;override;
          function calc_stackframe_size:longint;override;

compiler/i386/hlcgcpu.pas

@@ -52,8 +52,6 @@ interface
       procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
     end;
 
-  procedure create_hlcodegen;
-
 implementation
 
   uses
@@ -231,7 +229,7 @@ implementation
 
   procedure thlcgcpu.g_exception_reason_save(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const href: treference);
     begin
-      if not paramanager.use_fixed_stack then
+      if not(paramanager.use_fixed_stack) and not(tf_use_psabieh in target_info.flags) then
         list.concat(Taicpu.op_reg(A_PUSH,tcgsize2opsize[def_cgsize(tosize)],reg))
       else
         inherited
@@ -240,7 +238,7 @@ implementation
 
   procedure thlcgcpu.g_exception_reason_save_const(list: TAsmList; size: tdef; a: tcgint; const href: treference);
     begin
-      if not paramanager.use_fixed_stack then
+      if not(paramanager.use_fixed_stack) and not(tf_use_psabieh in target_info.flags) then
         list.concat(Taicpu.op_const(A_PUSH,tcgsize2opsize[def_cgsize(size)],a))
       else
         inherited;
@@ -249,7 +247,7 @@ implementation
 
   procedure thlcgcpu.g_exception_reason_load(list: TAsmList; fromsize, tosize: tdef; const href: treference; reg: tregister);
     begin
-      if not paramanager.use_fixed_stack then
+      if not(paramanager.use_fixed_stack) and not(tf_use_psabieh in target_info.flags) then
         list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[def_cgsize(tosize)],reg))
       else
         inherited;
@@ -258,7 +256,7 @@ implementation
 
   procedure thlcgcpu.g_exception_reason_discard(list: TAsmList; size: tdef; href: treference);
     begin
-      if not paramanager.use_fixed_stack then
+      if not(paramanager.use_fixed_stack) and not(tf_use_psabieh in target_info.flags) then
         begin
           getcpuregister(list,NR_FUNCTION_RESULT_REG);
           list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[def_cgsize(size)],NR_FUNCTION_RESULT_REG));
@@ -444,7 +442,7 @@ implementation
     end;
 
 
-  procedure create_hlcodegen;
+  procedure create_hlcodegen_cpu;
     begin
       hlcg:=thlcgcpu.create;
       create_codegen;
@@ -454,4 +452,5 @@ implementation
 
 begin
   chlcgobj:=thlcgcpu;
+  create_hlcodegen:=@create_hlcodegen_cpu;
 end.

compiler/i8086/hlcgcpu.pas

@@ -89,8 +89,6 @@ interface
       procedure location_force_mem(list:TAsmList;var l:tlocation;size:tdef);override;
     end;
 
-  procedure create_hlcodegen;
-
 implementation
 
   uses
@@ -713,7 +711,7 @@ implementation
     end;
 
 
-  procedure create_hlcodegen;
+  procedure create_hlcodegen_cpu;
     begin
       hlcg:=thlcgcpu.create;
       create_codegen;
@@ -722,4 +720,5 @@ implementation
 
 begin
   chlcgobj:=thlcgcpu;
+  create_hlcodegen:=@create_hlcodegen_cpu;
 end.

compiler/i8086/n8086con.pas

@@ -35,6 +35,9 @@ interface
       ti8086pointerconstnode = class(tcgpointerconstnode)
         constructor create(v : TConstPtrUInt;def:tdef);override;
         procedure printnodedata(var t: text);override;
+{$ifdef DEBUG_NODE_XML}
+        procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
         procedure pass_generate_code;override;
       end;
 
@@ -70,6 +73,15 @@ implementation
           inherited printnodedata(t);
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure Ti8086PointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
+          WriteLn(T, PrintNodeIndention, '<value>$', hexstr(word(value shr 16),4),':',hexstr(word(value),4), '</value>')
+        else
+          inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_XML}
 
     procedure ti8086pointerconstnode.pass_generate_code;
       begin

compiler/jvm/cpubase.pas

@@ -277,6 +277,8 @@ uses
     function std_regname(r:Tregister):string;
     function findreg_by_number(r:Tregister):tregisterindex;
 
+    function eh_return_data_regno(nr: longint): longint;
+
     { since we don't use tasmconds, don't call this routine
       (it will internalerror). We need it anyway to get aoptobj
       to compile (but it won't execute it).
@@ -340,6 +342,10 @@ uses
           result:=generic_regname(r);
       end;
 
+    function eh_return_data_regno(nr: longint): longint;
+      begin
+        result:=-1;
+      end;
 
     function inverse_cond(const c: TAsmCond): Tasmcond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
       begin

compiler/jvm/hlcgcpu.pas

@@ -234,8 +234,6 @@ uses
 
     end;
 
-  procedure create_hlcodegen;
-
 
   const
     opcmp2if: array[topcmp] of tasmop = (A_None,
@@ -2569,7 +2567,7 @@ implementation
       result:=get_call_result_cgpara(pd,forceresdef);
     end;
 
-  procedure create_hlcodegen;
+  procedure create_hlcodegen_cpu;
     begin
       hlcg:=thlcgjvm.create;
       create_codegen;
@@ -2577,4 +2575,5 @@ implementation
 
 begin
   chlcgobj:=thlcgjvm;
+  create_hlcodegen:=@create_hlcodegen_cpu;
 end.

compiler/link.pas

@@ -389,62 +389,72 @@ Implementation
             begin
               { create mask which unit files need linking }
               mask:=link_always;
-              { static linking ? }
-              if (cs_link_static in current_settings.globalswitches) then
-               begin
-                 if (headerflags and uf_static_linked)=0 then
-                  begin
-                    { if smart not avail then try static linking }
-                    if (headerflags and uf_smart_linked)<>0 then
-                     begin
-                       Message1(exec_t_unit_not_static_linkable_switch_to_smart,modulename^);
-                       mask:=mask or link_smart;
-                     end
-                    else
-                     Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
-                  end
-                 else
-                   mask:=mask or link_static;
-               end;
-              { smart linking ? }
-
-              if (cs_link_smart in current_settings.globalswitches) then
-               begin
-                 if (headerflags and uf_smart_linked)=0 then
-                  begin
-                    { if smart not avail then try static linking }
-                    if (headerflags and uf_static_linked)<>0 then
-                     begin
-                       { if not create_smartlink_library, then smart linking happens using the
-                         regular object files
-                       }
-                       if create_smartlink_library then
-                         Message1(exec_t_unit_not_smart_linkable_switch_to_static,modulename^);
-                       mask:=mask or link_static;
-                     end
-                    else
-                     Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
-                  end
-                 else
-                  mask:=mask or link_smart;
-               end;
-              { shared linking }
-              if (cs_link_shared in current_settings.globalswitches) then
-               begin
-                 if (headerflags and uf_shared_linked)=0 then
-                  begin
-                    { if shared not avail then try static linking }
-                    if (headerflags and uf_static_linked)<>0 then
-                     begin
-                       Message1(exec_t_unit_not_shared_linkable_switch_to_static,modulename^);
+              { lto linking ?}
+              if (cs_lto in current_settings.moduleswitches) and
+                 ((headerflags and uf_lto_linked)<>0) and
+                 (not(cs_lto_nosystem in init_settings.globalswitches) or
+                  (hp.modulename^<>'SYSTEM')) then
+                begin
+                  mask:=mask or link_lto;
+                end
+              else
+                begin
+                  { static linking ? }
+                  if (cs_link_static in current_settings.globalswitches) then
+                   begin
+                     if (headerflags and uf_static_linked)=0 then
+                      begin
+                        { if static not avail then try smart linking }
+                        if (headerflags and uf_smart_linked)<>0 then
+                         begin
+                           Message1(exec_t_unit_not_static_linkable_switch_to_smart,modulename^);
+                           mask:=mask or link_smart;
+                         end
+                        else
+                         Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
+                      end
+                     else
                        mask:=mask or link_static;
-                     end
-                    else
-                     Message1(exec_e_unit_not_shared_or_static_linkable,modulename^);
-                  end
-                 else
-                  mask:=mask or link_shared;
-               end;
+                   end;
+                  { smart linking ? }
+                  if (cs_link_smart in current_settings.globalswitches) then
+                   begin
+                     if (headerflags and uf_smart_linked)=0 then
+                      begin
+                        { if smart not avail then try static linking }
+                        if (headerflags and uf_static_linked)<>0 then
+                         begin
+                           { if not create_smartlink_library, then smart linking happens using the
+                             regular object files
+                           }
+                           if create_smartlink_library then
+                             Message1(exec_t_unit_not_smart_linkable_switch_to_static,modulename^);
+                           mask:=mask or link_static;
+                         end
+                        else
+                         Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
+                      end
+                     else
+                      mask:=mask or link_smart;
+                   end;
+                  { shared linking }
+                  if (cs_link_shared in current_settings.globalswitches) then
+                   begin
+                     if (headerflags and uf_shared_linked)=0 then
+                      begin
+                        { if shared not avail then try static linking }
+                        if (headerflags and uf_static_linked)<>0 then
+                         begin
+                           Message1(exec_t_unit_not_shared_linkable_switch_to_static,modulename^);
+                           mask:=mask or link_static;
+                         end
+                        else
+                         Message1(exec_e_unit_not_shared_or_static_linkable,modulename^);
+                      end
+                     else
+                      mask:=mask or link_shared;
+                   end;
+                end;
               { unit files }
               while not linkunitofiles.empty do
                 AddObject(linkunitofiles.getusemask(mask),path,true);
@@ -487,7 +497,7 @@ Implementation
 
     Procedure TLinker.AddObject(const S,unitpath : TPathStr;isunit:boolean);
       begin
-        ObjectFiles.Concat(FindObjectFile(s,unitpath,isunit));
+        ObjectFiles.Concat(FindObjectFile(s,unitpath,isunit))
       end;
 
 

compiler/llvm/aasmllvm.pas

@@ -110,11 +110,19 @@ interface
         constructor blockaddress(size: tdef; fun, lab: tasmsymbol);
         constructor landingpad(dst:tregister;def:tdef;firstclause:taillvm);
         constructor exceptclause(op:tllvmop;def:tdef;kind:TAsmSymbol;nextclause:taillvm);
+        constructor cleanupclause;
 
         { e.g. dst = call retsize name (paras) }
-        constructor call_size_name_paras(callpd: tdef; dst: tregister;retsize: tdef;name:tasmsymbol;paras: tfplist);
+        constructor call_size_name_paras(callpd: tdef;cc: tproccalloption;dst: tregister;retsize: tdef;name:tasmsymbol;paras: tfplist);
         { e.g. dst = call retsize reg (paras) }
-        constructor call_size_reg_paras(callpd: tdef; dst: tregister;retsize: tdef;reg:tregister;paras: tfplist);
+        constructor call_size_reg_paras(callpd: tdef; cc: tproccalloption; dst: tregister;retsize: tdef;reg:tregister;paras: tfplist);
+        { e.g. dst = invoke retsize name (paras) to label <normal label> unwind label <exception label> }
+        constructor invoke_size_name_paras_retlab_exceptlab(callpd: tdef; cc: tproccalloption; dst: tregister; retsize: tdef;name: tasmsymbol; paras: tfplist; retlab, exceptlab:TAsmLabel);
+        { e.g. dst = invoke retsize reg (paras) to label <normal label> unwind label <exception label> }
+        constructor invoke_size_reg_paras_retlab_exceptlab(callpd: tdef; cc: tproccalloption; dst: tregister; retsize: tdef; reg: tregister; paras: tfplist; retlab, exceptlab:TAsmLabel);
+
+        { e.g. dst := extractvalue srcsize src, 0 (note: no type for the index) }
+        constructor extract(op: tllvmop; dst: tregister; srcsize: tdef; src: tregister; idx: longint);
 
         { inline function-level assembler code and parameters }
         constructor asm_paras(asmlist: tasmlist; paras: tfplist);
@@ -133,6 +141,9 @@ interface
         procedure loadfpcond(opidx: longint; _fpcond: tllvmfpcmp);
         procedure loadparas(opidx: longint; _paras: tfplist);
         procedure loadasmlist(opidx: longint; _asmlist: tasmlist);
+        procedure loadcallingconvention(opidx: longint; calloption: tproccalloption);
+
+        procedure landingpad_add_clause(op: tllvmop; def: tdef; kind: TAsmSymbol);
 
         { register spilling code }
         function spilling_get_operation_type(opnr: longint): topertype;override;
@@ -193,15 +204,17 @@ interface
     pllvmcallpara = ^tllvmcallpara;
     tllvmcallpara = record
       def: tdef;
+      alignment: shortint;
       valueext: tllvmvalueextension;
       byval,
       sret: boolean;
-      case loc: tcgloc of
-        LOC_REFERENCE,
-        LOC_REGISTER,
-        LOC_FPUREGISTER,
-        LOC_MMREGISTER: (reg: tregister);
-        LOC_CONSTANT: (value: tcgint);
+      case typ: toptype of
+        top_none: ();
+        top_reg: (register: tregister);
+        top_ref: (sym: tasmsymbol);
+        top_const: (value: int64);
+        top_undef :  ();
+        top_tai    : (ai: tai);
     end;
 
 
@@ -311,9 +324,9 @@ uses
                 new(callpara);
                 callpara^:=pllvmcallpara(o.paras[i])^;
                 oper[opidx]^.paras.add(callpara);
-                if (callpara^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER]) and
+                if (callpara^.typ = top_reg) and
                    assigned(add_reg_instruction_hook) then
-                  add_reg_instruction_hook(self,callpara^.reg);
+                  add_reg_instruction_hook(self,callpara^.register);
               end;
           end;
       end;
@@ -321,13 +334,23 @@ uses
 
     procedure taillvm.clearop(opidx: longint);
       var
+        callpara: pllvmcallpara;
         i: longint;
       begin
         case oper[opidx]^.typ of
           top_para:
             begin
               for i:=0 to oper[opidx]^.paras.count-1 do
-                dispose(pllvmcallpara(oper[opidx]^.paras[i]));
+                begin
+                  callpara:=pllvmcallpara(oper[opidx]^.paras[i]);
+                  case callpara^.typ of
+                    top_tai:
+                      callpara^.ai.free;
+                    else
+                      ;
+                  end;
+                  dispose(callpara);
+                end;
               oper[opidx]^.paras.free;
             end;
           top_tai:
@@ -453,9 +476,9 @@ uses
             for i:=0 to _paras.count-1 do
               begin
                 callpara:=pllvmcallpara(_paras[i]);
-                if (callpara^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER]) and
+                if (callpara^.typ=top_reg) and
                    assigned(add_reg_instruction_hook) then
-                  add_reg_instruction_hook(self,callpara^.reg);
+                  add_reg_instruction_hook(self,callpara^.register);
               end;
             typ:=top_para;
           end;
@@ -474,6 +497,36 @@ uses
       end;
 
 
+    procedure taillvm.loadcallingconvention(opidx: longint; calloption: tproccalloption);
+      begin
+        allocate_oper(opidx+1);
+        with oper[opidx]^ do
+         begin
+           clearop(opidx);
+           callingconvention:=calloption;
+           typ:=top_callingconvention;
+         end;
+      end;
+
+
+    procedure taillvm.landingpad_add_clause(op: tllvmop; def: tdef; kind: TAsmSymbol);
+      var
+        lastclause,
+        clause: taillvm;
+      begin
+        if llvmopcode<>la_landingpad then
+          internalerror(2018052001);
+        if op<>la_cleanup then
+          clause:=taillvm.exceptclause(op,def,kind,nil)
+        else
+          clause:=taillvm.cleanupclause;
+        lastclause:=self;
+        while assigned(lastclause.oper[2]^.ai) do
+          lastclause:=taillvm(lastclause.oper[2]^.ai);
+        lastclause.loadtai(2,clause);
+      end;
+
+
     function taillvm.spilling_get_operation_type(opnr: longint): topertype;
       begin
         case llvmopcode of
@@ -545,7 +598,7 @@ uses
               end;
             end;
           la_ret, la_switch, la_indirectbr,
-          la_resume:
+          la_resume, la_catch:
             begin
               { ret size reg }
               if opnr=1 then
@@ -557,10 +610,10 @@ uses
             begin
               case opnr of
                 1: result:=oper[0]^.def;
-                3:
+                4:
                   begin
-                    if oper[3]^.typ=top_reg then
-                      result:=oper[2]^.def
+                    if oper[4]^.typ=top_reg then
+                      result:=oper[3]^.def
                     else
                       internalerror(2015112001)
                   end
@@ -1062,19 +1115,29 @@ uses
 
 
     constructor taillvm.exceptclause(op: tllvmop; def: tdef; kind: TAsmSymbol; nextclause: taillvm);
+      var
+        ref: treference;
       begin
         create_llvm(op);
         ops:=3;
         loaddef(0,def);
-        loadsymbol(1,kind,0);
+        reference_reset_symbol(ref,kind,0,def.alignment,[]);
+        loadref(1,ref);
         loadtai(2,nextclause);
       end;
 
 
-    constructor taillvm.call_size_name_paras(callpd: tdef; dst: tregister; retsize: tdef; name:tasmsymbol; paras: tfplist);
+    constructor taillvm.cleanupclause;
+      begin
+        create_llvm(la_cleanup);
+        ops:=0;
+      end;
+
+
+    constructor taillvm.call_size_name_paras(callpd: tdef; cc: tproccalloption; dst: tregister; retsize: tdef; name:tasmsymbol; paras: tfplist);
       begin
         create_llvm(la_call);
-        ops:=5;
+        ops:=6;
         { we need this in case the call symbol is an alias for a symbol with a
           different def in the same module (via "external"), because then we
           have to insert a type conversion later from the alias def to the
@@ -1082,21 +1145,64 @@ uses
           is generated, because the alias declaration may occur anywhere }
         loaddef(0,retsize);
         loadreg(1,dst);
-        loaddef(2,callpd);
-        loadsymbol(3,name,0);
-        loadparas(4,paras);
+        loadcallingconvention(2,cc);
+        loaddef(3,callpd);
+        loadsymbol(4,name,0);
+        loadparas(5,paras);
       end;
 
 
-    constructor taillvm.call_size_reg_paras(callpd: tdef; dst: tregister; retsize: tdef; reg: tregister; paras: tfplist);
+    constructor taillvm.call_size_reg_paras(callpd: tdef; cc: tproccalloption; dst: tregister; retsize: tdef; reg: tregister; paras: tfplist);
       begin
         create_llvm(la_call);
-        ops:=5;
+        ops:=6;
+        loaddef(0,retsize);
+        loadreg(1,dst);
+        loadcallingconvention(2,cc);
+        loaddef(3,callpd);
+        loadreg(4,reg);
+        loadparas(5,paras);
+      end;
+
+
+    constructor taillvm.invoke_size_name_paras_retlab_exceptlab(callpd: tdef; cc: tproccalloption; dst: tregister; retsize: tdef; name: tasmsymbol; paras: tfplist; retlab, exceptlab: TAsmLabel);
+      begin
+        create_llvm(la_invoke);
+        ops:=8;
+        loaddef(0,retsize);
+        loadreg(1,dst);
+        loadcallingconvention(2,cc);
+        loaddef(3,callpd);
+        loadsymbol(4,name,0);
+        loadparas(5,paras);
+        loadsymbol(6,retlab,0);
+        loadsymbol(7,exceptlab,0);
+      end;
+
+
+    constructor taillvm.invoke_size_reg_paras_retlab_exceptlab(callpd: tdef; cc: tproccalloption; dst: tregister; retsize: tdef; reg: tregister; paras: tfplist; retlab, exceptlab: TAsmLabel);
+      begin
+        create_llvm(la_invoke);
+        ops:=8;
         loaddef(0,retsize);
         loadreg(1,dst);
-        loaddef(2,callpd);
-        loadreg(3,reg);
-        loadparas(4,paras);
+        loadcallingconvention(2,cc);
+        loaddef(3,callpd);
+        loadreg(4,reg);
+        loadparas(5,paras);
+        loadsymbol(6,retlab,0);
+        loadsymbol(7,exceptlab,0);
+      end;
+
+
+    constructor taillvm.extract(op: tllvmop; dst: tregister; srcsize: tdef; src: tregister; idx: longint);
+      begin
+        create_llvm(op);
+        ops:=4;
+        loadreg(0,dst);
+        loaddef(1,srcsize);
+        loadreg(2,src);
+        loadconst(3,idx)
       end;
 
 

compiler/llvm/aasmllvmmetadata.pas

@@ -0,0 +1,187 @@
+{
+    Copyright (c) 2019 by Jonas Maebe,
+    member of the Free Pascal Compiler development team
+
+    Support for LLVM metadata
+
+    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 aasmllvmmetadata;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    aasmtai, aasmcnst,
+    symtype;
+
+  type
+    tspecialisedmetadatanodekind = (
+      smeta_DIFile,
+      smeta_DIBasicType,
+      smeta_DISubroutineType,
+      smeta_DIDerivedType,
+      smeta_DICompositeType,
+      smeta_DISubrange,
+      smeta_DIEnumerator,
+      smeta_DITemplateTypeParameter,
+      smeta_DITemplateValueParameter,
+      smeta_DINamespace,
+      smeta_DIGlobalVariable,
+      smeta_DISubprogram,
+      smeta_DILexicalBlock,
+      smeta_DILexicalBlockFile,
+      smeta_DILocation,
+      smeta_DILocalVariable,
+      smeta_DIExpression,
+      smeta_DIObjCProperty,
+      smeta_DIImportedEntity,
+      smeta_DIMacro,
+      smeta_DIMacroFile
+    );
+
+    tai_llvmbasemetadatanode = class abstract(tai_aggregatetypedconst)
+     strict protected
+      function getname: ansistring; virtual; abstract;
+     public
+      procedure addvalue(val: tai_abstracttypedconst); override;
+      property name: ansistring read getname;
+      constructor create; reintroduce;
+    end;
+
+    (* !0 = !{ type1 value1, ... } *)
+    tai_llvmunnamedmetadatanode = class(tai_llvmbasemetadatanode)
+     strict private class var
+      snextid: cardinal;
+      class function getnextid: cardinal;
+     strict protected
+      fnameval: cardinal;
+     public
+      constructor create; reintroduce;
+      function getname: ansistring; override;
+    end;
+
+    (* !name = !{ type1 value1, ... } *)
+    tai_llvmnamedmetadatanode = class(tai_llvmbasemetadatanode)
+     strict protected
+      fname: ansistring;
+      function getname: ansistring; override;
+     public
+      constructor create(const aName: ansistring);
+    end;
+
+    tai_llvmmetadatareftypedconst = class(tai_simple)
+     strict private
+      fval: tai_llvmbasemetadatanode;
+     public
+      constructor create(_val: tai_llvmbasemetadatanode);
+      property val: tai_llvmbasemetadatanode read fval;
+    end;
+
+    { @g1 = global i32 0, *!id !value.name* }
+    tai_llvmmetadatareferenceoperand = class(tai_simple)
+     strict private
+      fid: ansistring;
+      fvalue: tai_llvmbasemetadatanode;
+     public
+      constructor create(const anID: ansistring; aValue: tai_llvmbasemetadatanode);
+      property id: ansistring read fid;
+      property value: tai_llvmbasemetadatanode read fvalue;
+    end;
+
+      { !name = !kindname(field1: value1, ...) }
+    tai_llvmspecialisedmetadatanode = class(tai_llvmunnamedmetadatanode)
+      { identifies name and fieldnames }
+      kind: tspecialisedmetadatanodekind;
+    end;
+
+    function llvm_getmetadatareftypedconst(metadata: tai_llvmbasemetadatanode): tai_simpletypedconst;
+
+implementation
+
+  uses
+    symdef;
+
+  function llvm_getmetadatareftypedconst(metadata: tai_llvmbasemetadatanode): tai_simpletypedconst;
+    begin
+      result:=tai_simpletypedconst.create(llvm_metadatatype, tai_llvmmetadatareftypedconst.create(metadata));
+    end;
+
+  procedure tai_llvmbasemetadatanode.addvalue(val: tai_abstracttypedconst);
+    begin
+      { bypass string merging attempts, as we add tai_strings directly here }
+      fvalues.add(val);
+    end;
+
+  constructor tai_llvmbasemetadatanode.create;
+    begin
+      inherited create(tck_array, llvm_metadatatype);
+      typ:=ait_llvmmetadatanode;
+    end;
+
+
+  class function tai_llvmunnamedmetadatanode.getnextid: cardinal;
+    begin
+      result:=snextid;
+      inc(snextid);
+    end;
+
+
+  function tai_llvmunnamedmetadatanode.getname: ansistring;
+    begin
+      str(fnameval,result);
+    end;
+
+
+  constructor tai_llvmunnamedmetadatanode.create;
+    begin
+      inherited;
+      fnameval:=getnextid;
+    end;
+
+
+  function tai_llvmnamedmetadatanode.getname: ansistring;
+    begin
+      result:=fname;
+    end;
+
+
+  constructor tai_llvmnamedmetadatanode.create(const aName: ansistring);
+    begin
+      inherited create;
+      fname:=aName;
+    end;
+
+
+  constructor tai_llvmmetadatareftypedconst.create(_val: tai_llvmbasemetadatanode);
+    begin
+      inherited create(ait_llvmmetadatareftypedconst);
+      fval:=_val;
+    end;
+
+
+  constructor tai_llvmmetadatareferenceoperand.create(const anID: ansistring; aValue: tai_llvmbasemetadatanode);
+    begin
+      inherited create(ait_llvmmetadatarefoperand);
+      fid:=anID;
+      fvalue:=aValue;
+    end;
+
+
+end.
+

compiler/llvm/agllvm.pas

@@ -26,10 +26,11 @@ unit agllvm;
 interface
 
     uses
+      cclasses,
       globtype,globals,systems,
       aasmbase,aasmtai,aasmdata,
       assemble,
-      aasmllvm;
+      aasmllvm, aasmllvmmetadata;
 
     type
       TLLVMInstrWriter = class;
@@ -60,10 +61,9 @@ interface
         procedure WriteDirectiveName(dir: TAsmDirective); virtual;
         procedure WriteRealConst(hp: tai_realconst; do_line: boolean);
         procedure WriteOrdConst(hp: tai_const);
-        procedure WriteTai(const replaceforbidden: boolean; const do_line: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
+        procedure WriteTai(const replaceforbidden: boolean; const do_line, inmetadata: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
        public
         constructor CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean); override;
-        function MakeCmdLine: TCmdStr; override;
         procedure WriteTree(p:TAsmList);override;
         procedure WriteAsmList;override;
         procedure WriteFunctionInlineAsmList(list: tasmlist);
@@ -72,6 +72,22 @@ interface
         InstrWriter: TLLVMInstrWriter;
       end;
 
+      TLLVMLLCAssember=class(TLLVMAssember)
+      public
+       function MakeCmdLine: TCmdStr; override;
+      end;
+
+      TLLVMClangAssember=class(TLLVMAssember)
+      public
+       function MakeCmdLine: TCmdStr; override;
+       function DoAssemble: boolean; override;
+       function RerunAssembler: boolean; override;
+      protected
+       function DoPipe: boolean; override;
+      private
+       fnextpass: byte;
+      end;
+
 
       {# This is the base class for writing instructions.
 
@@ -88,6 +104,7 @@ interface
 
         function getopcodestr(hp: taillvm): TSymStr;
         function getopstr(const o:toper; refwithalign: boolean) : TSymStr;
+        procedure writeparas(const paras: tfplist);
         procedure WriteAsmRegisterAllocationClobbers(list: tasmlist);
       end;
 
@@ -96,12 +113,12 @@ implementation
 
     uses
       SysUtils,
-      cutils,cclasses,cfileutl,
+      cutils,cfileutl,
       fmodule,verbose,
       objcasm,
       aasmcnst,symconst,symdef,symtable,
       llvmbase,itllvm,llvmdef,
-      cgbase,cgutils,cpubase,llvminfo;
+      cgbase,cgutils,cpubase,cpuinfo,llvminfo;
 
     const
       line_length = 70;
@@ -150,6 +167,7 @@ implementation
          extended2str:=hs
       end;
 
+
 {****************************************************************************}
 {               Decorator for module-level inline assembly                   }
 {****************************************************************************}
@@ -302,39 +320,72 @@ implementation
       end;
 
 
-   function getparas(const paras: tfplist): ansistring;
+   procedure TLLVMInstrWriter.writeparas(const paras: tfplist);
      var
        i: longint;
+       tmpinline: cardinal;
        para: pllvmcallpara;
+       tmpasmblock: boolean;
+       hp: tai;
      begin
-       result:='(';
+       tmpinline:=1;
+       tmpasmblock:=false;
+       owner.writer.AsmWrite(fstr);
+       fstr:='';
+       owner.writer.AsmWrite('(');
        for i:=0 to paras.count-1 do
          begin
            if i<>0 then
-             result:=result+', ';
+             owner.writer.AsmWrite(', ');
            para:=pllvmcallpara(paras[i]);
-           result:=result+llvmencodetypename(para^.def);
+           owner.writer.AsmWrite(llvmencodetypename(para^.def));
            if para^.valueext<>lve_none then
-             result:=result+llvmvalueextension2str[para^.valueext];
+             owner.writer.AsmWrite(llvmvalueextension2str[para^.valueext]);
            if para^.byval then
-             result:=result+' byval';
+             owner.writer.AsmWrite(' byval');
            if para^.sret then
-             result:=result+' sret';
-           case para^.loc of
-             LOC_REGISTER,
-             LOC_FPUREGISTER,
-             LOC_MMREGISTER:
-               result:=result+' '+getregisterstring(para^.reg);
-             LOC_CONSTANT:
-               result:=result+' '+tostr(int64(para^.value));
+             owner.writer.AsmWrite(' sret');
+           { For byval, this means "alignment on the stack" and of the passed source data.
+             For other pointer parameters, this means "alignment of the passed source data" }
+           if (para^.alignment<>std_param_align) or
+              (para^.alignment<0) then
+             begin
+               owner.writer.AsmWrite(' align ');
+               owner.writer.AsmWrite(tostr(abs(para^.alignment)));
+             end;
+           case para^.typ of
+             top_reg:
+               begin
+                 owner.writer.AsmWrite(' ');
+                 owner.writer.AsmWrite(getregisterstring(para^.register));
+               end;
+             top_ref:
+               begin
+                 owner.writer.AsmWrite(' ');
+                 owner.writer.AsmWrite(llvmasmsymname(para^.sym));
+               end;
+             top_const:
+               begin
+                 owner.writer.AsmWrite(' ');
+                 owner.writer.AsmWrite(tostr(para^.value));
+               end;
+             top_tai:
+               begin
+                 tmpinline:=1;
+                 tmpasmblock:=false;
+                 hp:=para^.ai;
+                 owner.writer.AsmWrite(fstr);
+                 fstr:='';
+                 owner.WriteTai(false,false,para^.def=llvm_metadatatype,tmpinline,tmpasmblock,hp);
+               end;
              { empty records }
-             LOC_VOID:
-               result:=result+' undef';
+             top_undef:
+               owner.writer.AsmWrite(' undef');
              else
                internalerror(2014010801);
            end;
          end;
-       result:=result+')';
+       owner.writer.AsmWrite(')');
      end;
 
 
@@ -385,7 +436,6 @@ implementation
 
    function TLLVMInstrWriter.getopstr(const o:toper; refwithalign: boolean) : TSymStr;
      var
-       hs : ansistring;
        hp: tai;
        tmpinline: cardinal;
        tmpasmblock: boolean;
@@ -436,7 +486,8 @@ implementation
            end;
          top_para:
            begin
-             result:=getparas(o.paras);
+             writeparas(o.paras);
+             result:='';
            end;
          top_tai:
            begin
@@ -447,7 +498,7 @@ implementation
                  hp:=o.ai;
                  owner.writer.AsmWrite(fstr);
                  fstr:='';
-                 owner.WriteTai(false,false,tmpinline,tmpasmblock,hp);
+                 owner.WriteTai(false,false,false,tmpinline,tmpasmblock,hp);
                end;
              result:='';
            end;
@@ -458,7 +509,9 @@ implementation
            end;
 {$endif cpuextended}
          top_undef:
-           result:='undef'
+           result:='undef';
+         top_callingconvention:
+           result:=llvm_callingconvention_name(o.callingconvention);
          else
            internalerror(2013060227);
        end;
@@ -531,7 +584,7 @@ implementation
             owner.writer.AsmWrite('~{memory},~{fpsr},~{flags}');
             WriteAsmRegisterAllocationClobbers(taillvm(hp).oper[0]^.asmlist);
             owner.writer.AsmWrite('"');
-            owner.writer.AsmWrite(getparas(taillvm(hp).oper[1]^.paras));
+            writeparas(taillvm(hp).oper[1]^.paras);
             done:=true;
           end;
         la_load,
@@ -570,18 +623,20 @@ implementation
               end
           end;
         la_ret, la_br, la_switch, la_indirectbr,
-        la_invoke, la_resume,
+        la_resume,
         la_unreachable,
         la_store,
         la_fence,
         la_cmpxchg,
         la_atomicrmw,
         la_catch,
-        la_filter:
+        la_filter,
+        la_cleanup:
           begin
             { instructions that never have a result }
           end;
-        la_call:
+        la_call,
+        la_invoke:
           begin
             if taillvm(hp).oper[1]^.reg<>NR_NO then
               owner.writer.AsmWrite(getregisterstring(taillvm(hp).oper[1]^.reg)+' = ');
@@ -589,8 +644,14 @@ implementation
             if llvmflag_call_no_ptr in llvmversion_properties[current_settings.llvmversion] then
               begin
                 owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
+                tmpstr:=llvm_callingconvention_name(taillvm(hp).oper[2]^.callingconvention);
+                if tmpstr<>'' then
+                  begin
+                    owner.writer.AsmWrite(' ');
+                    owner.writer.AsmWrite(tmpstr);
+                  end;
                 opdone:=true;
-                tmpstr:=llvmencodetypename(taillvm(hp).oper[2]^.def);
+                tmpstr:=llvmencodetypename(taillvm(hp).oper[3]^.def);
                 if tmpstr[length(tmpstr)]<>'*' then
                   begin
                     writeln(tmpstr);
@@ -599,7 +660,7 @@ implementation
                 else
                   setlength(tmpstr,length(tmpstr)-1);
                 owner.writer.AsmWrite(tmpstr);
-                opstart:=3;
+                opstart:=4;
               end;
           end;
         la_blockaddress:
@@ -690,9 +751,16 @@ implementation
               for i:=opstart to taillvm(hp).ops-1 do
                 begin
                    owner.writer.AsmWrite(sep);
+                   { special invoke interjections: "to label X unwind label Y" }
+                   if (op=la_invoke) then
+                     case i of
+                       6: owner.writer.AsmWrite('to ');
+                       7: owner.writer.AsmWrite('unwind ');
+                     end;
+
                    owner.writer.AsmWrite(getopstr(taillvm(hp).oper[i]^,op in [la_load,la_store]));
                    if (taillvm(hp).oper[i]^.typ in [top_def,top_cond,top_fpcond]) or
-                      (op in [la_call,la_landingpad,la_catch,la_filter]) then
+                      (op in [la_call,la_invoke,la_landingpad,la_catch,la_filter,la_cleanup]) then
                      sep :=' '
                    else
                      sep:=', ';
@@ -740,47 +808,6 @@ implementation
       end;
 
 
-    function TLLVMAssember.MakeCmdLine: TCmdStr;
-      var
-        optstr: TCmdStr;
-      begin
-        result := inherited MakeCmdLine;
-        { standard optimization flags for llc -- todo: this needs to be split
-          into a call to opt and one to llc }
-        if cs_opt_level3 in current_settings.optimizerswitches then
-          optstr:='-O3'
-        else if cs_opt_level2 in current_settings.optimizerswitches then
-          optstr:='-O2'
-        else if cs_opt_level1 in current_settings.optimizerswitches then
-          optstr:='-O1'
-        else
-          optstr:='-O0';
-        { stack frame elimination }
-        if not(cs_opt_stackframe in current_settings.optimizerswitches) then
-          optstr:=optstr+' -disable-fp-elim';
-        { fast math }
-        if cs_opt_fastmath in current_settings.optimizerswitches then
-          optstr:=optstr+' -enable-unsafe-fp-math -enable-fp-mad -fp-contract=fast';
-        { smart linking }
-        if cs_create_smart in current_settings.moduleswitches then
-          optstr:=optstr+' -data-sections -function-sections';
-        { pic }
-        if cs_create_pic in current_settings.moduleswitches then
-          optstr:=optstr+' -relocation-model=pic'
-        else if not(target_info.system in systems_darwin) then
-          optstr:=optstr+' -relocation-model=static'
-        else
-          optstr:=optstr+' -relocation-model=dynamic-no-pic';
-        { our stack alignment is non-standard on some targets. The following
-          parameter is however ignored on some targets by llvm, so it may not
-          be enough }
-        optstr:=optstr+' -stack-alignment='+tostr(target_info.stackalign*8);
-        { force object output instead of textual assembler code }
-        optstr:=optstr+' -filetype=obj';
-        replace(result,'$OPT',optstr);
-      end;
-
-
     procedure TLLVMAssember.WriteTree(p:TAsmList);
     var
       hp       : tai;
@@ -811,7 +838,7 @@ implementation
               WriteSourceLine(hp as tailineinfo);
           end;
 
-         WriteTai(replaceforbidden, do_line, InlineLevel, asmblock, hp);
+         WriteTai(replaceforbidden, do_line, false, InlineLevel, asmblock, hp);
          hp:=tai(hp.next);
        end;
     end;
@@ -944,7 +971,7 @@ implementation
       end;
 
 
-    procedure TLLVMAssember.WriteTai(const replaceforbidden: boolean; const do_line: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
+    procedure TLLVMAssember.WriteTai(const replaceforbidden: boolean; const do_line, inmetadata: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
 
       procedure WriteLinkageVibilityFlags(bind: TAsmSymBind);
         begin
@@ -976,6 +1003,7 @@ implementation
 
       procedure WriteFunctionFlags(pd: tprocdef);
         begin
+          { function attributes }
           if (pos('FPC_SETJMP',upper(pd.mangledname))<>0) or
              (pd.mangledname=(target_info.cprefix+'setjmp')) then
             writer.AsmWrite(' returns_twice');
@@ -991,23 +1019,42 @@ implementation
             writer.AsmWrite(' nobuiltin');
           if po_noreturn in pd.procoptions then
             writer.AsmWrite(' noreturn');
+          if llvmflag_null_pointer_valid in llvmversion_properties[current_settings.llvmversion] then
+            writer.AsmWrite(' "null-pointer-is-valid"="true"');
         end;
 
 
-      procedure WriteTypedConstData(hp: tai_abstracttypedconst);
+      procedure WriteTypedConstData(hp: tai_abstracttypedconst; metadata: boolean);
         var
           p: tai_abstracttypedconst;
           pval: tai;
           defstr: TSymStr;
           first, gotstring: boolean;
         begin
-          defstr:=llvmencodetypename(hp.def);
+          if hp.def<>llvm_metadatatype then
+            begin
+              defstr:=llvmencodetypename(hp.def)
+            end
+          else
+            begin
+              defstr:=''
+            end;
           { write the struct, array or simple type }
           case hp.adetyp of
             tck_record:
               begin
-                writer.AsmWrite(defstr);
-                writer.AsmWrite(' <{');
+                if not(metadata) then
+                  begin
+                    writer.AsmWrite(defstr);
+                    if not(df_llvm_no_struct_packing in hp.def.defoptions) then
+                      writer.AsmWrite(' <{')
+                    else
+                      writer.AsmWrite(' {')
+                  end
+                else
+                  begin
+                    writer.AsmWrite(' !{');
+                  end;
                 first:=true;
                 for p in tai_aggregatetypedconst(hp) do
                   begin
@@ -1015,19 +1062,32 @@ implementation
                       writer.AsmWrite(', ')
                     else
                       first:=false;
-                    WriteTypedConstData(p);
+                    WriteTypedConstData(p,metadata);
+                  end;
+                if not(metadata) then
+                  begin
+                    if not(df_llvm_no_struct_packing in hp.def.defoptions) then
+                      writer.AsmWrite(' }>')
+                    else
+                      writer.AsmWrite(' }')
+                  end
+                else
+                  begin
+                    writer.AsmWrite(' }');
                   end;
-                writer.AsmWrite('}>');
               end;
             tck_array:
               begin
-                writer.AsmWrite(defstr);
+                if not(metadata) then
+                  begin
+                    writer.AsmWrite(defstr);
+                  end;
                 first:=true;
                 gotstring:=false;
                 for p in tai_aggregatetypedconst(hp) do
                   begin
                     if not first then
-                      writer.AsmWrite(',')
+                      writer.AsmWrite(', ')
                     else
                       begin
                         writer.AsmWrite(' ');
@@ -1038,33 +1098,65 @@ implementation
                           end
                         else
                           begin
-                            writer.AsmWrite('[');
+                            if not metadata then
+                              begin
+                                writer.AsmWrite('[');
+                              end
+                            else
+                              begin
+                                writer.AsmWrite('!{');
+                              end;
                           end;
                         first:=false;
                       end;
                     { cannot concat strings and other things }
                     if gotstring and
+                       not metadata and
                        ((tai_abstracttypedconst(p).adetyp<>tck_simple) or
                         (tai_simpletypedconst(p).val.typ<>ait_string)) then
                       internalerror(2014062701);
-                    WriteTypedConstData(p);
+                    WriteTypedConstData(p,metadata);
                   end;
                 if not gotstring then
-                  writer.AsmWrite(']');
+                  begin
+                    if not metadata then
+                      begin
+                        writer.AsmWrite(']');
+                      end
+                    else
+                      begin
+                        writer.AsmWrite('}');
+                      end;
+                  end;
               end;
             tck_simple:
               begin
                 pval:=tai_simpletypedconst(hp).val;
-                if pval.typ<>ait_string then
+                if (pval.typ<>ait_string) and
+                   (defstr<>'') then
                   begin
                     writer.AsmWrite(defstr);
                     writer.AsmWrite(' ');
                   end;
-                WriteTai(replaceforbidden,do_line,InlineLevel,asmblock,pval);
+                WriteTai(replaceforbidden,do_line,metadata,InlineLevel,asmblock,pval);
               end;
           end;
         end;
 
+      procedure WriteLlvmMetadataNode(hp: tai_llvmbasemetadatanode);
+        begin
+          { must only appear at the top level }
+          if fdecllevel<>0 then
+            internalerror(2019050111);
+          writer.AsmWrite('!');
+          writer.AsmWrite(tai_llvmbasemetadatanode(hp).name);
+          writer.AsmWrite(' =');
+          inc(fdecllevel);
+          WriteTypedConstData(hp,true);
+          writer.AsmLn;
+          dec(fdecllevel);
+        end;
+
       var
         hp2: tai;
         s: string;
@@ -1135,7 +1227,10 @@ implementation
             begin
               if fdecllevel=0 then
                 internalerror(2016120201);
-              writer.AsmWrite('c"');
+              if not inmetadata then
+                writer.AsmWrite('c"')
+              else
+                writer.AsmWrite('!"');
               for i:=1 to tai_string(hp).len do
                begin
                  ch:=tai_string(hp).str[i-1];
@@ -1205,6 +1300,14 @@ implementation
                       WriteLinkageVibilityFlags(taillvmdecl(hp).namesym.bind);
                       writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), '', lpd_def));
                       WriteFunctionFlags(tprocdef(taillvmdecl(hp).def));
+                      if assigned(tprocdef(taillvmdecl(hp).def).personality) then
+                        begin
+                          writer.AsmWrite(' personality i8* bitcast (');
+                          writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def).personality, '', lpd_procvar));
+                          writer.AsmWrite('* ');
+                          writer.AsmWrite(llvmmangledname(tprocdef(taillvmdecl(hp).def).personality.mangledname));
+                          writer.AsmWrite(' to i8*)');
+                        end;
                       writer.AsmWriteln(' {');
                     end;
                 end
@@ -1243,7 +1346,7 @@ implementation
                       hp2:=tai(taillvmdecl(hp).initdata.first);
                       while assigned(hp2) do
                         begin
-                          WriteTai(replaceforbidden,do_line,InlineLevel,asmblock,hp2);
+                          WriteTai(replaceforbidden,do_line,inmetadata,InlineLevel,asmblock,hp2);
                           hp2:=tai(hp2.next);
                         end;
                       dec(fdecllevel);
@@ -1295,6 +1398,28 @@ implementation
               writer.AsmWrite('* ');
               writer.AsmWriteln(LlvmAsmSymName(taillvmalias(hp).oldsym));
             end;
+          ait_llvmmetadatanode:
+            begin
+              WriteLlvmMetadataNode(tai_llvmbasemetadatanode(hp));
+            end;
+          ait_llvmmetadatareftypedconst:
+            begin
+              { must only appear as an element in a typed const }
+              if fdecllevel=0 then
+                internalerror(2019050110);
+              writer.AsmWrite('!');
+              writer.AsmWrite(tai_llvmbasemetadatanode(tai_llvmmetadatareftypedconst(hp).val).name);
+            end;
+          ait_llvmmetadatarefoperand:
+            begin
+              { must only appear as an operand }
+              if fdecllevel=0 then
+                internalerror(2019050110);
+              writer.AsmWrite('!');
+              writer.AsmWrite(tai_llvmmetadatareferenceoperand(hp).id);
+              writer.AsmWrite(' !');
+              writer.AsmWrite(tai_llvmmetadatareferenceoperand(hp).value.name);
+            end;
           ait_symbolpair:
             begin
               { should be emitted as part of the symbol def }
@@ -1380,10 +1505,10 @@ implementation
             end;
            ait_typedconst:
              begin
-               WriteTypedConstData(tai_abstracttypedconst(hp));
+               WriteTypedConstData(tai_abstracttypedconst(hp),false);
              end
           else
-            internalerror(2006012201);
+            internalerror(2019012010);
         end;
       end;
 
@@ -1404,7 +1529,6 @@ implementation
     procedure TLLVMAssember.WriteAsmList;
       var
         hal : tasmlisttype;
-        i: longint;
         a: TExternalAssembler;
         decorator: TLLVMModuleInlineAssemblyDecorator;
       begin
@@ -1416,7 +1540,7 @@ implementation
                current_asmdata.asmlists[hal].Empty then
               continue;
             writer.AsmWriteLn(asminfo^.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
-            if hal<>al_pure_assembler then
+            if not(hal in [al_pure_assembler,al_dwarf_frame]) then
               writetree(current_asmdata.asmlists[hal])
             else
               begin
@@ -1466,22 +1590,169 @@ implementation
        end;
 
 
+{****************************************************************************}
+{                               llc Assember                                 }
+{****************************************************************************}
+
+     function TLLVMLLCAssember.MakeCmdLine: TCmdStr;
+       var
+         optstr: TCmdStr;
+       begin
+         result:=inherited;
+         { standard optimization flags for llc -- todo: this needs to be split
+           into a call to opt and one to llc }
+         if cs_opt_level3 in current_settings.optimizerswitches then
+           optstr:='-O3'
+         else if cs_opt_level2 in current_settings.optimizerswitches then
+           optstr:='-O2'
+         else if cs_opt_level1 in current_settings.optimizerswitches then
+           optstr:='-O1'
+         else
+           optstr:='-O0';
+         { stack frame elimination }
+         if not(cs_opt_stackframe in current_settings.optimizerswitches) then
+           optstr:=optstr+' -disable-fp-elim';
+         { fast math }
+         if cs_opt_fastmath in current_settings.optimizerswitches then
+           optstr:=optstr+' -enable-unsafe-fp-math -fp-contract=fast';  { -enable-fp-mad support depends on version }
+         { smart linking }
+         if cs_create_smart in current_settings.moduleswitches then
+           optstr:=optstr+' -data-sections -function-sections';
+         { pic }
+         if cs_create_pic in current_settings.moduleswitches then
+           optstr:=optstr+' -relocation-model=pic'
+         else if not(target_info.system in systems_darwin) then
+           optstr:=optstr+' -relocation-model=static'
+         else
+           optstr:=optstr+' -relocation-model=dynamic-no-pic';
+         { force object output instead of textual assembler code }
+         optstr:=optstr+' -filetype=obj';
+         if fputypestrllvm[current_settings.fputype]<>'' then
+           optstr:=optstr+' -mattr=+'+fputypestrllvm[current_settings.fputype];
+         replace(result,'$OPT',optstr);
+       end;
+
+
+{****************************************************************************}
+{                               clang Assember                               }
+{****************************************************************************}
+
+    function TLLVMClangAssember.MakeCmdLine: TCmdStr;
+      var
+        wpostr,
+        optstr: TCmdStr;
+      begin
+        wpostr:='';
+        if cs_lto in current_settings.moduleswitches then
+          begin
+            case fnextpass of
+              0:
+                begin
+                  ObjFileName:=ChangeFileExt(ObjFileName,'.bc');
+                  wpostr:=' -flto';
+                end;
+              1:
+                begin
+                  ObjFileName:=ChangeFileExt(ObjFileName,'.o');
+                end;
+            end;
+          end;
+        result:=inherited;
+        { standard optimization flags for llc -- todo: this needs to be split
+          into a call to opt and one to llc }
+        if cs_opt_level3 in current_settings.optimizerswitches then
+          optstr:='-O3'
+        else if cs_opt_level2 in current_settings.optimizerswitches then
+          optstr:='-O2'
+        else if cs_opt_level1 in current_settings.optimizerswitches then
+          optstr:='-O1'
+        else
+          optstr:='-O0';
+        optstr:=optstr+wpostr;
+        { stack frame elimination }
+        if not(cs_opt_stackframe in current_settings.optimizerswitches) then
+          optstr:=optstr+' -fno-omit-frame-pointer'
+        else
+          optstr:=optstr+' -fomit-frame-pointer';
+        { fast math }
+        if cs_opt_fastmath in current_settings.optimizerswitches then
+          optstr:=optstr+' -ffast-math';
+        { smart linking }
+        if cs_create_smart in current_settings.moduleswitches then
+          optstr:=optstr+' -fdata-sections -ffunction-sections';
+        { pic }
+        if cs_create_pic in current_settings.moduleswitches then
+          optstr:=optstr+' -fpic'
+        else if not(target_info.system in systems_darwin) then
+          optstr:=optstr+' -static'
+        else
+          optstr:=optstr+' -mdynamic-no-pic';
+        if not(target_info.system in systems_darwin) then
+          begin
+            optstr:=optstr+' --target='+llvm_target_name;
+          end;
+
+        if fputypestrllvm[current_settings.fputype]<>'' then
+          optstr:=optstr+' -m'+fputypestrllvm[current_settings.fputype];
+
+        replace(result,'$OPT',optstr);
+        inc(fnextpass);
+      end;
+
+
+    function TLLVMClangAssember.DoAssemble: boolean;
+      begin
+        fnextpass:=0;
+        result:=inherited;
+      end;
+
+
+    function TLLVMClangAssember.RerunAssembler: boolean;
+      begin
+        result:=
+          (cs_lto in current_settings.moduleswitches) and
+          (fnextpass<=1);
+      end;
+
+
+    function TLLVMClangAssember.DoPipe: boolean;
+      begin
+        result:=
+          not(cs_lto in current_settings.moduleswitches) and
+          inherited;
+      end;
+
+
    const
-     as_llvm_info : tasminfo =
+     as_llvm_llc_info : tasminfo =
         (
-          id     : as_llvm;
+          id     : as_llvm_llc;
 
-          idtxt  : 'LLVM-AS';
+          idtxt  : 'LLVM-LLC';
           asmbin : 'llc';
           asmcmd: '$OPT -o $OBJ $ASM';
-          supported_targets : [system_x86_64_linux,system_x86_64_darwin,system_powerpc64_darwin];
+          supported_targets : [system_x86_64_linux,system_x86_64_darwin,system_aarch64_linux,system_arm_linux];
           flags : [af_smartlink_sections];
           labelprefix : 'L';
           comment : '; ';
           dollarsign: '$';
         );
 
+     as_llvm_clang_info : tasminfo =
+        (
+          id     : as_llvm_clang;
+
+          idtxt  : 'LLVM-CLANG';
+          asmbin : 'clang';
+          asmcmd: '$OPT $DARWINVERSION -c -o $OBJ $ASM';
+          supported_targets : [system_x86_64_linux,system_x86_64_darwin,system_aarch64_linux,system_arm_linux];
+          flags : [af_smartlink_sections];
+          labelprefix : 'L';
+          comment : '; ';
+          dollarsign: '$';
+        );
 
 begin
-  RegisterAssembler(as_llvm_info,TLLVMAssember);
+  RegisterAssembler(as_llvm_llc_info,TLLVMLLCAssember);
+  RegisterAssembler(as_llvm_clang_info,TLLVMClangAssember);
 end.

compiler/llvm/hlcgllvm.pas

@@ -158,21 +158,21 @@ uses
       procedure set_call_function_result(const list: TAsmList; const pd: tabstractprocdef; const llvmretdef, hlretdef: tdef; const resval: tregister; var retpara: tcgpara);
     end;
 
-  procedure create_hlcodegen;
-
-
 implementation
 
   uses
     verbose,cutils,globals,fmodule,constexp,systems,
     defutil,llvmdef,llvmsym,
     aasmtai,aasmcpu,
-    aasmllvm,llvmbase,tgllvm,
+    aasmllvm,llvmbase,llvminfo,tgllvm,
     symtable,symllvm,
     paramgr,
-    procinfo,cpuinfo,cgobj,cgllvm,cghlcpu,
+    pass_2,procinfo,llvmpi,cpuinfo,cgobj,cgllvm,cghlcpu,
     cgcpu,hlcgcpu;
 
+  var
+    create_hlcodegen_cpu: TProcedure = nil;
+
   const
     topcg2llvmop: array[topcg] of tllvmop =
      { OP_NONE  OP_MOVE     OP_ADD  OP_AND  OP_DIV   OP_IDIV  OP_IMUL OP_MUL }
@@ -205,10 +205,19 @@ implementation
       totaloffset:=0;
       orgsize:=size;
       a_load_ref_cgpara_init_src(list,cgpara,r,size,initialref);
+      if initialref.refaddr=addr_full then
+        begin
+          cgpara.check_simple_location;
+          location^.llvmvalueloc:=true;
+          location^.llvmloc.loc:=LOC_CREFERENCE;
+          location^.llvmloc.sym:=initialref.symbol;
+          exit;
+        end;
       userecord:=
         (orgsize<>size) and
         assigned(cgpara.location^.next);
       paralocidx:=0;
+      fielddef:=nil;
       while assigned(location) do
         begin
           if userecord then
@@ -305,8 +314,9 @@ implementation
       newrefsize: tdef;
       reg: tregister;
     begin
-      newrefsize:=llvmgetcgparadef(para,true);
-      if refsize<>newrefsize then
+      newrefsize:=llvmgetcgparadef(para,true,callerside);
+      if (refsize<>newrefsize) and
+         (initialref.refaddr<>addr_full) then
         begin
           reg:=getaddressregister(list,cpointerdef.getreusable(newrefsize));
           a_loadaddr_ref_reg(list,refsize,cpointerdef.getreusable(newrefsize),initialref,reg);
@@ -401,24 +411,21 @@ implementation
 
   procedure thlcgllvm.a_call_common(list: TAsmList; pd: tabstractprocdef; const paras: array of pcgpara; const forceresdef: tdef; out res: tregister; out hlretdef: tdef; out llvmretdef: tdef; out callparas: tfplist);
 
-    procedure load_ref_anyreg(def: tdef; const ref: treference; reg: tregister; var callpara: pllvmcallpara);
+    procedure load_ref_anyreg(def: tdef; const ref: treference; reg: tregister);
       begin
         case getregtype(reg) of
           R_INTREGISTER,
           R_ADDRESSREGISTER:
             begin
               a_load_ref_reg(list,def,def,ref,reg);
-              callpara^.loc:=LOC_REGISTER;
             end;
           R_FPUREGISTER:
             begin
               a_loadfpu_ref_reg(list,def,def,ref,reg);
-              callpara^.loc:=LOC_FPUREGISTER;
             end;
           R_MMREGISTER:
             begin
               a_loadmm_ref_reg(list,def,def,ref,reg,mms_movescalar);
-              callpara^.loc:=LOC_MMREGISTER;
             end;
           else
             internalerror(2014012213);
@@ -430,6 +437,7 @@ implementation
     href: treference;
     callpara: pllvmcallpara;
     paraloc: pcgparalocation;
+    firstparaloc: boolean;
   begin
     callparas:=tfplist.Create;
     for i:=0 to high(paras) do
@@ -438,10 +446,15 @@ implementation
         if paras[i]^.isempty then
           continue;
         paraloc:=paras[i]^.location;
+        firstparaloc:=true;
         while assigned(paraloc) do
           begin
             new(callpara);
             callpara^.def:=paraloc^.def;
+            if firstparaloc then
+              callpara^.alignment:=paras[i]^.Alignment
+            else
+              callpara^.alignment:=std_param_align;
             { if the paraloc doesn't contain the value itself, it's a byval
               parameter }
             if paraloc^.retvalloc then
@@ -455,50 +468,60 @@ implementation
                 callpara^.byval:=not paraloc^.llvmvalueloc;
               end;
             llvmextractvalueextinfo(paras[i]^.def, callpara^.def, callpara^.valueext);
-            if paraloc^.llvmloc.loc=LOC_CONSTANT then
-              begin
-                callpara^.loc:=LOC_CONSTANT;
-                callpara^.value:=paraloc^.llvmloc.value;
-              end
-            else
-              begin
-                callpara^.loc:=paraloc^.loc;
-                case callpara^.loc of
-                  LOC_REFERENCE:
-                    begin
-                      if paraloc^.llvmvalueloc then
-                        internalerror(2014012307)
-                      else
-                        begin
-                          reference_reset_base(href, cpointerdef.getreusable(callpara^.def), paraloc^.reference.index, paraloc^.reference.offset, ctempposinvalid, paraloc^.def.alignment, []);
-                          res:=getregisterfordef(list, paraloc^.def);
-                          load_ref_anyreg(callpara^.def, href, res, callpara);
-                        end;
-                      callpara^.reg:=res
-                    end;
-                  LOC_REGISTER,
-                  LOC_FPUREGISTER,
-                  LOC_MMREGISTER:
-                    begin
-                      { undo explicit value extension }
-                      if callpara^.valueext<>lve_none then
-                        begin
-                          res:=getregisterfordef(list, callpara^.def);
-                          a_load_reg_reg(list, paraloc^.def, callpara^.def, paraloc^.register, res);
-                          paraloc^.register:=res;
-                        end;
-                        callpara^.reg:=paraloc^.register
-                    end;
-                  { empty records }
-                  LOC_VOID:
-                    begin
-                    end
-                  else
-                    internalerror(2014010605);
+            case paraloc^.llvmloc.loc of
+              LOC_CONSTANT:
+                begin
+                  callpara^.typ:=top_const;
+                  callpara^.value:=paraloc^.llvmloc.value;
+                end;
+              LOC_CREFERENCE:
+                begin
+                  callpara^.typ:=top_ref;
+                  callpara^.sym:=paraloc^.llvmloc.sym;
+                end
+              else
+                begin
+                  case paraloc^.loc of
+                    LOC_REFERENCE:
+                      begin
+                        if paraloc^.llvmvalueloc then
+                          internalerror(2014012307)
+                        else
+                          begin
+                            callpara^.typ:=top_reg;
+                            reference_reset_base(href, cpointerdef.getreusable(callpara^.def), paraloc^.reference.index, paraloc^.reference.offset, ctempposinvalid, paraloc^.def.alignment, []);
+                            res:=getregisterfordef(list, paraloc^.def);
+                            load_ref_anyreg(callpara^.def, href, res);
+                          end;
+                        callpara^.register:=res
+                      end;
+                    LOC_REGISTER,
+                    LOC_FPUREGISTER,
+                    LOC_MMREGISTER:
+                      begin
+                        callpara^.typ:=top_reg;
+                        { undo explicit value extension }
+                        if callpara^.valueext<>lve_none then
+                          begin
+                            res:=getregisterfordef(list, callpara^.def);
+                            a_load_reg_reg(list, paraloc^.def, callpara^.def, paraloc^.register, res);
+                            paraloc^.register:=res;
+                          end;
+                        callpara^.register:=paraloc^.register
+                      end;
+                    { empty records }
+                    LOC_VOID:
+                      begin
+                        callpara^.typ:=top_undef;
+                      end
+                    else
+                      internalerror(2014010605);
+                  end;
                 end;
               end;
             callparas.add(callpara);
             paraloc:=paraloc^.next;
+            firstparaloc:=false;
           end;
       end;
     { the Pascal level may expect a different returndef compared to the
@@ -509,7 +532,7 @@ implementation
       hlretdef:=forceresdef;
     { llvm will always expect the original return def }
     if not paramanager.ret_in_param(hlretdef, pd) then
-      llvmretdef:=llvmgetcgparadef(pd.funcretloc[callerside], true)
+      llvmretdef:=llvmgetcgparadef(pd.funcretloc[callerside], true, callerside)
     else
       llvmretdef:=voidtype;
     if not is_void(llvmretdef) then
@@ -530,9 +553,21 @@ implementation
       llvmretdef,
       hlretdef: tdef;
       res: tregister;
+      nextinslab,
+      exceptlab: TAsmLabel;
     begin
       a_call_common(list,pd,paras,forceresdef,res,hlretdef,llvmretdef,callparas);
-      list.concat(taillvm.call_size_name_paras(get_call_pd(pd),res,llvmretdef,current_asmdata.RefAsmSymbol(s,AT_FUNCTION),callparas));
+      if not(fc_catching_exceptions in flowcontrol) or
+         { no invoke for intrinsics }
+         (copy(s,1,5)='llvm.') then
+        list.concat(taillvm.call_size_name_paras(get_call_pd(pd),pd.proccalloption,res,llvmretdef,current_asmdata.RefAsmSymbol(s,AT_FUNCTION),callparas))
+      else
+        begin
+          current_asmdata.getjumplabel(nextinslab);
+          exceptlab:=tllvmprocinfo(current_procinfo).CurrExceptLabel;
+          list.concat(taillvm.invoke_size_name_paras_retlab_exceptlab(get_call_pd(pd),pd.proccalloption,res,llvmretdef,current_asmdata.RefAsmSymbol(s,AT_FUNCTION),callparas,nextinslab,exceptlab));
+          a_label(list,nextinslab);
+        end;
       result:=get_call_result_cgpara(pd,forceresdef);
       set_call_function_result(list,pd,llvmretdef,hlretdef,res,result);
     end;
@@ -544,9 +579,19 @@ implementation
       llvmretdef,
       hlretdef: tdef;
       res: tregister;
+      nextinslab,
+      exceptlab: TAsmLabel;
     begin
       a_call_common(list,pd,paras,nil,res,hlretdef,llvmretdef,callparas);
-      list.concat(taillvm.call_size_reg_paras(get_call_pd(pd),res,llvmretdef,reg,callparas));
+      if not(fc_catching_exceptions in flowcontrol) then
+        list.concat(taillvm.call_size_reg_paras(get_call_pd(pd),pd.proccalloption,res,llvmretdef,reg,callparas))
+      else
+        begin
+          current_asmdata.getjumplabel(nextinslab);
+          exceptlab:=tllvmprocinfo(current_procinfo).CurrExceptLabel;
+          list.concat(taillvm.invoke_size_reg_paras_retlab_exceptlab(get_call_pd(pd),pd.proccalloption,res,llvmretdef,reg,callparas,nextinslab,exceptlab));
+          a_label(list,nextinslab);
+        end;
       result:=get_call_result_cgpara(pd,nil);
       set_call_function_result(list,pd,llvmretdef,hlretdef,res,result);
     end;
@@ -1057,35 +1102,6 @@ implementation
       invert: boolean;
       fallthroughlab, falselab, tmplab: tasmlabel;
     begin
-      { since all comparisons return their results in a register, we'll often
-        get comparisons against true/false -> optimise }
-      if (size=pasbool1type) and
-         (cmp_op in [OC_EQ,OC_NE]) then
-        begin
-          { convert to an llvmbool1type and use directly }
-          tmpreg:=getintregister(list,llvmbool1type);
-          a_load_reg_reg(list,size,llvmbool1type,reg,tmpreg);
-          case cmp_op of
-            OC_EQ:
-              invert:=a=0;
-            OC_NE:
-              invert:=a=1;
-            else
-              { avoid uninitialised warning }
-              internalerror(2015031504);
-            end;
-          current_asmdata.getjumplabel(falselab);
-          fallthroughlab:=falselab;
-          if invert then
-            begin
-              tmplab:=l;
-              l:=falselab;
-              falselab:=tmplab;
-            end;
-          list.concat(taillvm.op_size_reg_lab_lab(la_br,llvmbool1type,tmpreg,l,falselab));
-          a_label(list,fallthroughlab);
-          exit;
-        end;
       tmpreg:=getregisterfordef(list,size);
       a_load_const_reg(list,size,a,tmpreg);
       a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
@@ -1128,6 +1144,7 @@ implementation
       pd: tprocdef;
       sourcepara, destpara, sizepara, alignpara, volatilepara: tcgpara;
       maxalign: longint;
+      indivalign: boolean;
     begin
       { perform small copies directly; not larger ones, because then llvm
         will try to load the entire large datastructure into registers and
@@ -1139,7 +1156,11 @@ implementation
           a_load_ref_ref(list,size,size,source,dest);
           exit;
         end;
-      pd:=search_system_proc('llvm_memcpy64');
+      indivalign:=llvmflag_memcpy_indiv_align in llvmversion_properties[current_settings.llvmversion];
+      if indivalign then
+        pd:=search_system_proc('llvm_memcpy64_indivalign')
+      else
+        pd:=search_system_proc('llvm_memcpy64');
       sourcepara.init;
       destpara.init;
       sizepara.init;
@@ -1148,15 +1169,27 @@ implementation
       paramanager.getintparaloc(list,pd,1,destpara);
       paramanager.getintparaloc(list,pd,2,sourcepara);
       paramanager.getintparaloc(list,pd,3,sizepara);
-      paramanager.getintparaloc(list,pd,4,alignpara);
-      paramanager.getintparaloc(list,pd,5,volatilepara);
+      if indivalign then
+        begin
+          paramanager.getintparaloc(list,pd,4,volatilepara);
+          destpara.Alignment:=-dest.alignment;
+          sourcepara.Alignment:=-source.alignment;
+        end
+      else
+        begin
+          paramanager.getintparaloc(list,pd,4,alignpara);
+          paramanager.getintparaloc(list,pd,5,volatilepara);
+          maxalign:=newalignment(max(source.alignment,dest.alignment),min(source.alignment,dest.alignment));
+          a_load_const_cgpara(list,u32inttype,maxalign,alignpara);
+        end;
       a_loadaddr_ref_cgpara(list,size,dest,destpara);
       a_loadaddr_ref_cgpara(list,size,source,sourcepara);
       a_load_const_cgpara(list,u64inttype,size.size,sizepara);
-      maxalign:=newalignment(max(source.alignment,dest.alignment),min(source.alignment,dest.alignment));
-      a_load_const_cgpara(list,u32inttype,maxalign,alignpara);
       a_load_const_cgpara(list,llvmbool1type,ord((vol_read in source.volatility) or (vol_write in dest.volatility)),volatilepara);
-      g_call_system_proc(list,pd,[@destpara,@sourcepara,@sizepara,@alignpara,@volatilepara],nil).resetiftemp;
+      if indivalign then
+        g_call_system_proc(list,pd,[@destpara,@sourcepara,@sizepara,@volatilepara],nil).resetiftemp
+      else
+        g_call_system_proc(list,pd,[@destpara,@sourcepara,@sizepara,@alignpara,@volatilepara],nil).resetiftemp;
       sourcepara.done;
       destpara.done;
       sizepara.done;
@@ -1375,7 +1408,7 @@ implementation
             LOC_MMREGISTER:
               begin
                 if not llvmaggregatetype(resdef) then
-                  list.concat(taillvm.op_reg_size_undef(la_bitcast,resloc.location^.register,llvmgetcgparadef(resloc,true)))
+                  list.concat(taillvm.op_reg_size_undef(la_bitcast,resloc.location^.register,llvmgetcgparadef(resloc,true,calleeside)))
                 else
                   { bitcast doesn't work for aggregates -> just load from the
                     (uninitialised) function result memory location }
@@ -1593,7 +1626,7 @@ implementation
         end;
       { get the LLVM representation of the function result (e.g. a
         struct with two i64 fields for a record with 4 i32 fields) }
-      result.def:=llvmgetcgparadef(result,true);
+      result.def:=llvmgetcgparadef(result,true,callerside);
       if assigned(result.location^.next) then
         begin
           { unify the result into a sinlge location; unlike for parameters,
@@ -1681,7 +1714,7 @@ implementation
       { get the equivalent llvm def used to pass the parameter (e.g. a record
         with two int64 fields for passing a record consisiting of 8 bytes on
         x86-64) }
-      llvmparadef:=llvmgetcgparadef(para,true);
+      llvmparadef:=llvmgetcgparadef(para,true,calleeside);
       userecord:=
         (llvmparadef<>para.def) and
         assigned(para.location^.next);
@@ -2058,7 +2091,7 @@ implementation
     end;
 
 
-  procedure create_hlcodegen;
+  procedure create_hlcodegen_llvm;
     begin
       if not assigned(current_procinfo) or
          not(po_assembler in current_procinfo.procdef.procoptions) then
@@ -2070,11 +2103,20 @@ implementation
       else
         begin
           tgobjclass:=orgtgclass;
-          hlcgcpu.create_hlcodegen;
+          create_hlcodegen_cpu;
           { todo: handle/remove chlcgobj }
         end;
     end;
 
 begin
   chlcgobj:=thlcgllvm;
+  { this unit must initialise after hlcgobj;
+    message system has not been initialised yet here }
+  if not assigned(create_hlcodegen) then
+    begin
+      writeln('Internalerror 2018052003');
+      halt(1);
+    end;
+  create_hlcodegen_cpu:=create_hlcodegen;
+  create_hlcodegen:=@create_hlcodegen_llvm;
 end.

compiler/llvm/itllvm.pas

@@ -62,6 +62,7 @@ interface
         'type', { type definition }
         'catch', { catch exception }
         'filter', { exception filter }
+        'cleanup', { exception cleanup/finally }
         'invalid1', { la_x_to_inttoptr }
         'invalid2', { la_ptrtoint_to_x }
         'asm' { la_asmblock }

compiler/llvm/llvmbase.pas

@@ -70,6 +70,7 @@ interface
       la_type, { type definition }
       la_catch, { catch clause of a landingpad }
       la_filter, { filter clause of a landingpad }
+      la_cleanup, { cleanup clause of a landingpad (finally) }
       la_x_to_inttoptr, { have to convert something first to int before it can be converted to a pointer }
       la_ptrtoint_to_x, { have to convert a pointer first to int before it can be converted to something else }
       la_asmblock
@@ -98,11 +99,13 @@ interface
     llvmop2strtable=array[tllvmop] of string[14];
 
   const
-    { = max(cpubase.max_operands,7) }
-    max_operands = ((-ord(cpubase.max_operands<=7)) and 7) or ((-ord(cpubase.max_operands>7)) and cpubase.max_operands);
+    { = max(cpubase.max_operands,8) }
+    max_operands = ((-ord(cpubase.max_operands<=8)) and 15) or ((-ord(cpubase.max_operands>8)) and cpubase.max_operands);
 
   function llvm_target_name: ansistring;
 
+  function llvm_callingconvention_name(c: tproccalloption): ansistring;
+
 implementation
 
   uses
@@ -110,6 +113,7 @@ implementation
     systems;
 
 {$j-}
+{$ifndef arm}
   const
     llvmsystemcpu: array[tsystemcpu] of ansistring =
       ('unknown',
@@ -134,6 +138,7 @@ implementation
        'riscv32',
        'riscv64'
       );
+{$endif}
 
   function llvm_target_name: ansistring;
     begin
@@ -153,7 +158,7 @@ implementation
             llvm_target_name:=llvm_target_name+'-ios'+iPhoneOSVersionMin;
         end
       else if target_info.system in (systems_linux+systems_android) then
-        llvm_target_name:=llvm_target_name+'-linux'
+        llvm_target_name:=llvm_target_name+'-unknown-linux'
       else if target_info.system in systems_windows then
         begin
           { WinCE isn't supported (yet) by llvm, but if/when added this is
@@ -190,7 +195,56 @@ implementation
         llvm_target_name:=llvm_target_name+'-android' }
       else
         llvm_target_name:=llvm_target_name+'-gnueabi';
-{$endif FPC_ARM_HF}
+{$else}
+      if target_info.system in systems_linux then
+        llvm_target_name:=llvm_target_name+'-gnu';
+{$endif}
+    end;
+
+
+  function llvm_callingconvention_name(c: tproccalloption): ansistring;
+    begin
+      // TODO (unsupported by LLVM at this time):
+      //   * pocall_pascal
+      //   * pocall_oldfpccall
+      //   * pocall_syscall
+      //   * pocall_far16
+      //   * possibly pocall_softfloat
+      case c of
+        { to prevent errors if none of the defines below is active }
+        pocall_none:
+          result:='';
+{$ifdef i386}
+        pocall_register:
+          result:='x86_borlandregcallcc';
+        pocall_stdcall:
+          result:='x86_stdcallcc';
+{$endif i386}
+{$ifdef x86}
+        pocall_interrupt:
+          result:='x86_intrcc';
+        pocall_sysv_abi_default,
+        pocall_sysv_abi_cdecl:
+          result:='x86_64_sysvcc';
+        pocall_ms_abi_default,
+        pocall_ms_abi_cdecl:
+          result:='win64cc';
+        pocall_vectorcall:
+          result:='x86_vectorcallcc';
+        pocall_internproc:
+          result:=llvm_callingconvention_name(pocall_default);
+{$endif x86}
+{$ifdef avr}
+        pocall_interrupt:
+          result:='avr_intrcc';
+{$endif avr}
+{$if defined(arm) and not defined(FPC_ARMHF)}
+        pocall_hardfloat:
+          result:='arm_aapcs_vfpcc';
+{$endif arm and not FPC_ARMHF}
+        else
+          result:='';
+      end;
     end;
 
 end.

compiler/llvm/llvmcfi.pas

@@ -0,0 +1,147 @@
+{
+    Copyright (c) 2019 by Jonas Maebe, member of the Free Pascal Compiler
+    development team
+
+    LLVM CFI wrapper: use native CFI instance for pure assembler routines,
+    and dummy one for LLVM (the LLVM code generator will take care of CFI)
+
+    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 llvmcfi;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      aasmbase,
+      aasmdata,
+      cgbase;
+
+    type
+      tllvmcfi = class(TAsmCFI)
+        constructor create; override;
+        destructor destroy; override;
+        procedure generate_code(list: TAsmList); override;
+        procedure start_frame(list:TAsmList);override;
+        procedure end_frame(list:TAsmList);override;
+        procedure outmost_frame(list:TAsmList);override;
+        procedure cfa_offset(list:TAsmList;reg:tregister;ofs:longint);override;
+        procedure cfa_restore(list:TAsmList;reg:tregister);override;
+        procedure cfa_def_cfa_register(list:TAsmList;reg:tregister);override;
+        procedure cfa_def_cfa_offset(list:TAsmList;ofs:longint);override;
+        function get_frame_start: TAsmLabel; override;
+        function get_cfa_list: TAsmList; override;
+       private
+         fnativecfi: TAsmCFI;
+      end;
+
+  implementation
+
+    uses
+      symconst,
+      procinfo;
+
+    var
+      nativecficlass: TAsmCFIClass;
+
+    constructor tllvmcfi.create;
+      begin
+        inherited;
+        fnativecfi:=nativecficlass.create;
+      end;
+
+
+    destructor tllvmcfi.destroy;
+      begin
+        fnativecfi.free;
+        inherited destroy;
+      end;
+
+
+    procedure tllvmcfi.generate_code(list: TAsmList);
+      begin
+        fnativecfi.generate_code(list);
+      end;
+
+
+    procedure tllvmcfi.start_frame(list: TAsmList);
+      begin
+        if po_assembler in current_procinfo.procdef.procoptions then
+          fnativecfi.start_frame(list);
+      end;
+
+
+    procedure tllvmcfi.end_frame(list: TAsmList);
+      begin
+        if po_assembler in current_procinfo.procdef.procoptions then
+          fnativecfi.end_frame(list);
+      end;
+
+
+    procedure tllvmcfi.outmost_frame(list: TAsmList);
+      begin
+        if po_assembler in current_procinfo.procdef.procoptions then
+          fnativecfi.outmost_frame(list);
+      end;
+
+
+    procedure tllvmcfi.cfa_offset(list: TAsmList; reg: tregister; ofs: longint);
+      begin
+        if po_assembler in current_procinfo.procdef.procoptions then
+          fnativecfi.cfa_offset(list, reg, ofs);
+      end;
+
+
+    procedure tllvmcfi.cfa_restore(list: TAsmList; reg: tregister);
+      begin
+        if po_assembler in current_procinfo.procdef.procoptions then
+          fnativecfi.cfa_restore(list, reg);
+      end;
+
+
+    procedure tllvmcfi.cfa_def_cfa_register(list: TAsmList; reg: tregister);
+      begin
+        if po_assembler in current_procinfo.procdef.procoptions then
+          fnativecfi.cfa_def_cfa_register(list, reg);
+      end;
+
+
+    procedure tllvmcfi.cfa_def_cfa_offset(list: TAsmList; ofs: longint);
+      begin
+        if po_assembler in current_procinfo.procdef.procoptions then
+          fnativecfi.cfa_def_cfa_offset(list, ofs);
+      end;
+
+
+    function tllvmcfi.get_frame_start: TAsmLabel;
+      begin
+        result:=fnativecfi.get_frame_start;
+      end;
+
+
+    function tllvmcfi.get_cfa_list: TAsmList;
+      begin
+        result:=fnativecfi.get_cfa_list;
+      end;
+
+
+begin
+  nativecficlass:=CAsmCFI;
+  CAsmCFI:=tllvmcfi;
+end.
+

compiler/llvm/llvmdef.pas

@@ -30,7 +30,7 @@ interface
       cclasses,globtype,
       aasmbase,
       parabase,
-      symbase,symtype,symdef,
+      symconst,symbase,symtype,symdef,
       llvmbase;
 
    type
@@ -76,7 +76,7 @@ interface
       such parameters to be zero/sign extended. The second parameter can be used
       to get the type before zero/sign extension, as e.g. required to generate
       function declarations. }
-    function llvmgetcgparadef(const cgpara: tcgpara; beforevalueext: boolean): tdef;
+    function llvmgetcgparadef(const cgpara: tcgpara; beforevalueext: boolean; callercallee: tcallercallee): tdef;
 
     { can be used to extract the value extension info from acgpara. Pass in
       the def of the cgpara as first parameter and a local variable holding
@@ -116,7 +116,7 @@ implementation
     globals,cutils,constexp,
     verbose,systems,
     fmodule,
-    symtable,symconst,symsym,
+    symtable,symsym,
     llvmsym,hlcgobj,
     defutil,blockutl,cgbase,paramgr,
     cpubase;
@@ -796,6 +796,7 @@ implementation
 
     procedure llvmaddencodedproctype(def: tabstractprocdef; const customname: TSymStr; pddecltype: tllvmprocdefdecltype; var encodedstr: TSymStr);
       var
+        callingconv: ansistring;
         usedef: tdef;
         paranr: longint;
         hp: tparavarsym;
@@ -803,6 +804,12 @@ implementation
         useside: tcallercallee;
         first: boolean;
       begin
+        if not(pddecltype in [lpd_alias,lpd_procvar]) then
+          begin
+            callingconv:=llvm_callingconvention_name(def.proccalloption);
+            if callingconv<>'' then
+              encodedstr:=encodedstr+' "'+callingconv+'"';
+          end;
         { when writing a definition, we have to write the parameter names, and
           those are only available on the callee side. In all other cases,
           we are at the callerside }
@@ -815,7 +822,7 @@ implementation
         { function result (return-by-ref is handled explicitly) }
         if not paramanager.ret_in_param(def.returndef,def) then
           begin
-            usedef:=llvmgetcgparadef(def.funcretloc[useside],false);
+            usedef:=llvmgetcgparadef(def.funcretloc[useside],false,useside);
             llvmextractvalueextinfo(def.returndef,usedef,signext);
             { specifying result sign extention information for an alias causes
               an error for some reason }
@@ -922,7 +929,7 @@ implementation
       end;
 
 
-    function llvmgetcgparadef(const cgpara: tcgpara; beforevalueext: boolean): tdef;
+    function llvmgetcgparadef(const cgpara: tcgpara; beforevalueext: boolean; callercallee: tcallercallee): tdef;
       var
         retdeflist: array[0..9] of tdef;
         retloc: pcgparalocation;
@@ -967,6 +974,16 @@ implementation
               retdeflist[i]:=retloc^.def;
               dec(sizeleft,retloc^.def.size);
             end
+          { on the callerside, "byval" parameter locations have the implicit
+            pointer in their type -> remove if we wish to create a record
+            containing all actual parameter data }
+          else if (callercallee=callerside) and
+             not retloc^.llvmvalueloc then
+            begin
+              if retloc^.def.typ<>pointerdef then
+                internalerror(2019020201);
+              retdeflist[i]:=tpointerdef(retloc^.def).pointeddef
+            end
           else if retloc^.def.size<>sizeleft then
             begin
               case sizeleft of

compiler/llvm/llvminfo.pas

@@ -3,14 +3,24 @@
 
     Basic Processor information for LLVM
 
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
+    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.
+    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.
+
+ ****************************************************************************
+}
+
+{$i fpcdefs.inc}
 
 Unit llvminfo;
 
@@ -22,25 +32,37 @@ uses
 Type
    { possible supported processors for this target }
    tllvmversion =
-      ({ may add older/newer versions if required/appropriate }
+      (llvmver_invalid,
        llvmver_3_3,
-       llvmver_3_4_0,
-       llvmver_3_4_1,
-       llvmver_3_4_2,
-       llvmver_3_5_0,
-       llvmver_3_5_1,
-       llvmver_3_5_2,
-       llvmver_3_6_0,
-       llvmver_3_6_1,
-       llvmver_3_6_2,
-       llvmver_3_7_0,
-       llvmver_3_8_0,
-       llvmver_3_9_0,
+       llvmver_3_4,
+       llvmver_3_5,
        { Xcode versions use snapshots of LLVM and don't correspond to released
          versions of llvm (they don't ship with the llvm utilities either, but
-         they do come with Clang, which can also be used to some extent instead
-         of opt/llc) }
-       llvmver_xc_6_4
+         they do come with Clang, which can be used instead of opt/llc) }
+       llvmver_xc_6_4,
+       llvmver_3_6,
+       llvmver_3_7,
+       llvmver_xc_7_0,
+       llvmver_xc_7_1,
+       llvmver_xc_7_2,
+       llvmver_3_8,
+       llvmver_xc_7_3,
+       llvmver_3_9,
+       llvmver_xc_8_0,
+       llvmver_xc_8_1,
+       llvmver_xc_8_2,
+       llvmver_4_0,
+       llvmver_xc_9_0,
+       llvmver_5_0,
+       llvmver_xc_9_1,
+       llvmver_xc_9_2,
+       llvmver_xc_9_3,
+       llvmver_6_0,
+       llvmver_xc_10_0,
+       llvmver_xc_10_1,
+       llvmver_7_0,
+       llvmver_7_1,
+       llvmver_8_0
       );
 
 type
@@ -49,44 +71,75 @@ type
      llvmflag_linker_private,      { have linker_private linkage type (later versions use global in combination with hidden visibility) }
      llvmflag_load_getelptr_type,  { the return type of loads and the base type of getelementptr must be specified }
      llvmflag_call_no_ptr,         { with direct calls, the function type is not a function pointer }
-     llvmflag_alias_double_type    { with "alias" declarations, have to print both aliasee and aliasee* types }
+     llvmflag_alias_double_type,   { with "alias" declarations, have to print both aliasee and aliasee* types }
+     llvmflag_fembed_bitcode,      { support embedding bitcode in object files }
+     llvmflag_memcpy_indiv_align,  { memcpy intrinsic supports separate alignment for source and dest }
+     llvmflag_null_pointer_valid   { supports "llvmflag_null_pointer_valid" attribute, which indicates access to nil should not be optimized as undefined behaviour }
    );
    tllvmversionflags = set of tllvmversionflag;
 
 Const
    llvmversionstr : array[tllvmversion] of string[14] = (
-     'LLVM-3.3',
-     'LLVM-3.4.0',
-     'LLVM-3.4.1',
-     'LLVM-3.4.2',
-     'LLVM-3.5.0',
-     'LLVM-3.5.1',
-     'LLVM-3.5.2',
-     'LLVM-3.6.0',
-     'LLVM-3.6.1',
-     'LLVM-3.6.2',
-     'LLVM-3.7.0',
-     'LLVM-3.8.0',
-     'LLVM-3.9.0',
-     'LLVM-Xcode-6.4' { somewhere around LLVM 3.6.0 }
+     '',
+     '3.3',
+     '3.4',
+     '3.5',
+     'Xcode-6.4',
+     '3.6',
+     '3.7',
+     'Xcode-7.0',
+     'Xcode-7.1',
+     'Xcode-7.2',
+     '3.8',
+     'Xcode-7.3',
+     '3.9',
+     'Xcode-8.0',
+     'Xcode-8.1',
+     'Xcode-8.2',
+     '4.0',
+     'Xcode-9.0',
+     '5.0',
+     'Xcode-9.1',
+     'Xcode-9.2',
+     'Xcode-9.3',
+     '6.0',
+     'Xcode-10.0',
+     'Xcode-10.1',
+     '7.0',
+     '7.1',
+     '8.0'
    );
 
    llvmversion_properties: array[tllvmversion] of tllvmversionflags =
      (
-       { llvmver_3_3    } [llvmflag_metadata_keyword,llvmflag_linker_private],
-       { llvmver_3_4_0  } [llvmflag_metadata_keyword,llvmflag_linker_private],
-       { llvmver_3_4_1  } [llvmflag_metadata_keyword,llvmflag_linker_private],
-       { llvmver_3_4_2  } [llvmflag_metadata_keyword,llvmflag_linker_private],
-       { llvmver_3_5_0  } [llvmflag_metadata_keyword],
-       { llvmver_3_5_1  } [llvmflag_metadata_keyword],
-       { llvmver_3_5_2  } [llvmflag_metadata_keyword],
-       { llvmver_3_6_0  } [],
-       { llvmver_3_6_1  } [],
-       { llvmver_3_6_2  } [],
-       { llvmver_3_7_0  } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr],
-       { llvmver_3_8_0  } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type],
-       { llvmver_3_9_0  } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type],
-       { llvmver_xc_6_4 } [llvmflag_metadata_keyword]
+       { invalid         } [],
+       { llvmver_3_3     } [llvmflag_metadata_keyword,llvmflag_linker_private],
+       { llvmver_3_4     } [llvmflag_metadata_keyword,llvmflag_linker_private],
+       { llvmver_3_5     } [llvmflag_metadata_keyword],
+       { llvmver_xc_6_4  } [llvmflag_metadata_keyword],
+       { llvmver_3_6     } [],
+       { llvmver_3_7     } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr],
+       { llvmver_xc_7_0  } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr],
+       { llvmver_xc_7_1  } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr],
+       { llvmver_xc_7_2  } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr],
+       { llvmver_3_8     } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type],
+       { llvmver_xc_7_3  } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type],
+       { llvmver_3_9     } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode],
+       { llvmver_xc_8_0  } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode],
+       { llvmver_xc_8_1  } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode],
+       { llvmver_xc_8_2  } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode],
+       { llvmver_4_0     } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode],
+       { llvmver_xc_9_0  } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode],
+       { llvmver_5_0     } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode],
+       { llvmver_xc_9_0  } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode],
+       { llvmver_xc_9_1  } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode],
+       { llvmver_xc_9_2  } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode],
+       { llvmver_6_0     } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode],
+       { llvmver_xc_10_0 } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode],
+       { llvmver_xc_10_1 } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode],
+       { llvmver_7_0     } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode,llvmflag_memcpy_indiv_align,llvmflag_null_pointer_valid],
+       { llvmver_7_1     } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode,llvmflag_memcpy_indiv_align,llvmflag_null_pointer_valid],
+       { llvmver_8_0     } [llvmflag_load_getelptr_type,llvmflag_call_no_ptr,llvmflag_alias_double_type,llvmflag_fembed_bitcode,llvmflag_memcpy_indiv_align,llvmflag_null_pointer_valid]
      );
 
    { Supported optimizations, only used for information }
@@ -95,13 +148,26 @@ Const
                                  genericlevel3optimizerswitches-
                                  { no need to write info about those }
                                  [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
-                                 [cs_opt_loopunroll,cs_opt_nodecse];
+                                 [cs_opt_loopunroll,cs_opt_stackframe,
+				  cs_opt_nodecse,cs_opt_reorder_fields,cs_opt_fastmath];
 
    level1optimizerswitches = genericlevel1optimizerswitches;
-   level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + [cs_opt_nodecse];
-   level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}];
+   level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + [cs_opt_nodecse,cs_opt_stackframe];
+   level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [];
    level4optimizerswitches = genericlevel4optimizerswitches + level3optimizerswitches + [];
 
+   function llvmversion2enum(const s: string): tllvmversion;
+
 Implementation
 
+  function llvmversion2enum(const s: string): tllvmversion;
+    begin
+      for result:=succ(low(llvmversionstr)) to high(llvmversionstr) do
+        begin
+          if s=llvmversionstr[result] then
+            exit;
+        end;
+      result:=llvmver_invalid;
+    end;
+
 end.

compiler/llvm/llvmnode.pas

@@ -38,8 +38,9 @@ implementation
     ncgadd,ncgcal,ncgmat,ncginl,
     tgllvm,hlcgllvm,
     nllvmadd,nllvmbas,nllvmcal,nllvmcnv,nllvmcon,nllvmflw,nllvminl,nllvmld,
-    nllvmmat,nllvmmem,nllvmtcon,nllvmutil,
-    llvmpara,
-    symllvm;
+    nllvmmat,nllvmmem,nllvmset,nllvmtcon,nllvmutil,
+    llvmpara,llvmpi,
+    symllvm,
+    llvmcfi;
 
 end.

compiler/llvm/llvmpara.pas

@@ -49,12 +49,14 @@ unit llvmpara;
         function param_use_paraloc(const cgpara: tcgpara): boolean; override;
         procedure createtempparaloc(list: TAsmList; calloption: tproccalloption; parasym: tparavarsym; can_use_final_stack_loc: boolean; var cgpara: TCGPara); override;
         function create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint; override;
+        function create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee; varargspara: tvarargsparalist): longint; override;
         function get_funcretloc(p: tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara; override;
        private
+        procedure create_paraloc_info_internllvm(p: tabstractprocdef; side: tcallercallee);
         procedure set_llvm_paraloc_name(p: tabstractprocdef; hp: tparavarsym; var para: tcgpara);
         procedure add_llvm_callee_paraloc_names(p: tabstractprocdef);
         procedure reducetosingleregparaloc(paraloc: PCGParaLocation; def: tdef; reg: tregister);
-        procedure reduceparalocs(p: tabstractprocdef; side: tcallercallee);
+        procedure reduceparalocs(p: tabstractprocdef; side: tcallercallee; paras: tparalist);
       end;
 
 
@@ -108,15 +110,15 @@ unit llvmpara;
     end;
 
 
-  procedure tllvmparamanager.reduceparalocs(p: tabstractprocdef; side: tcallercallee);
+  procedure tllvmparamanager.reduceparalocs(p: tabstractprocdef; side: tcallercallee; paras: tparalist);
     var
       paranr: longint;
       hp: tparavarsym;
       paraloc: PCGParaLocation;
     begin
-      for paranr:=0 to p.paras.count-1 do
+      for paranr:=0 to paras.count-1 do
         begin
-          hp:=tparavarsym(p.paras[paranr]);
+          hp:=tparavarsym(paras[paranr]);
           paraloc:=hp.paraloc[side].location;
           if assigned(paraloc) and
              assigned(paraloc^.next) and
@@ -211,21 +213,17 @@ unit llvmpara;
 
   function tllvmparamanager.create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint;
     begin
-      result:=inherited create_paraloc_info(p, side);
-      { on the calleeside, llvm declares the parameters similar to Pascal or C
-        (a list of parameters and their types), but they correspond more
-        closely to parameter locations than to parameters -> add names to the
-        locations }
-      if (side=calleeside) and
-         not(po_assembler in p.procoptions) then
-        begin
-          add_llvm_callee_paraloc_names(p);
-          reduceparalocs(p,side);
-        end
-      else if side=callerside then
-        begin
-          reduceparalocs(p,side);
-        end;
+      result:=inherited;
+      create_paraloc_info_internllvm(p,side);
+    end;
+
+
+  function tllvmparamanager.create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee; varargspara: tvarargsparalist): longint;
+    begin
+      result:=inherited;
+      create_paraloc_info_internllvm(p,side);
+      if assigned(varargspara) then
+        reduceparalocs(p,side,varargspara);
     end;
 
 
@@ -252,6 +250,25 @@ unit llvmpara;
     end;
 
 
+  procedure tllvmparamanager.create_paraloc_info_internllvm(p: tabstractprocdef; side: tcallercallee);
+    begin
+      { on the calleeside, llvm declares the parameters similar to Pascal or C
+        (a list of parameters and their types), but they correspond more
+        closely to parameter locations than to parameters -> add names to the
+        locations }
+      if (side=calleeside) and
+         not(po_assembler in p.procoptions) then
+        begin
+          add_llvm_callee_paraloc_names(p);
+          reduceparalocs(p,side,p.paras);
+        end
+      else if side=callerside then
+        begin
+          reduceparalocs(p,side,p.paras);
+        end;
+    end;
+
+
   { hp non-nil: parasym to check
     hp nil: function result
   }
@@ -289,6 +306,11 @@ unit llvmpara;
     end;
 
 begin
+  if not assigned(paramanager) then
+    begin
+      writeln('Internalerror 2018052006');
+      halt(1);
+    end;
   { replace the native parameter manager. Maybe this has to be moved to a
     procedure like the creations of the code generators, but possibly not since
     we still call the original paramanager }

compiler/llvm/llvmpi.pas

@@ -0,0 +1,477 @@
+{
+    Copyright (c) 2016 by Jonas Maebe
+
+    Information about the current procedure that is being compiled
+
+    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 llvmpi;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      cclasses,
+      aasmbase,
+      procinfo,
+      cpupi,
+      aasmdata,aasmllvm;
+
+    type
+      tllvmprocinfo = class(tcpuprocinfo)
+       private
+        fexceptlabelstack: tfplist;
+        flandingpadstack: tfplist;
+       public
+        constructor create(aparent: tprocinfo); override;
+        destructor destroy; override;
+        procedure pushexceptlabel(lab: TAsmLabel);
+        { returns true if there no more landing pads on the stack }
+        function popexceptlabel(lab: TAsmLabel): boolean;
+        function CurrExceptLabel: TAsmLabel;
+        procedure pushlandingpad(pad: taillvm);
+        procedure poppad;
+        function currlandingpad: taillvm;
+        procedure setup_eh; override;
+        procedure finish_eh; override;
+        procedure start_eh(list: TAsmList); override;
+        procedure end_eh(list: TAsmList); override;
+      end;
+
+implementation
+
+    uses
+      globtype,globals,verbose,systems,
+      symconst,symtype,symdef,symsym,symtable,defutil,llvmdef,
+      pass_2,
+      parabase,paramgr,
+      cgbase,cgutils,cgexcept,tgobj,hlcgobj,llvmbase;
+
+    {*****************************************************************************
+                         tllvmexceptionstatehandler
+    *****************************************************************************}
+
+    type
+      tllvmexceptionstatehandler = class(tcgexceptionstatehandler)
+        class procedure get_exception_temps(list: TAsmList; var t: texceptiontemps); override;
+        class procedure unget_exception_temps(list: TAsmList; const t: texceptiontemps); override;
+        class procedure new_exception(list: TAsmList; const t: texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); override;
+        class procedure emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptionstate: texceptionstate;var exceptiontemps:texceptiontemps); override;
+        class procedure end_try_block(list: TAsmList; exceptframekind: texceptframekind; const t: texceptiontemps; var exceptionstate: texceptionstate; endlabel: TAsmLabel); override;
+        class procedure cleanupobjectstack(list: TAsmList); override;
+        class procedure popaddrstack(list: TAsmList); override;
+        class procedure handle_reraise(list: TAsmList; const t: texceptiontemps; const entrystate: texceptionstate; const exceptframekind: texceptframekind); override;
+        class procedure begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister); override;
+        class procedure end_catch(list: TAsmList); override;
+        class procedure catch_all_start(list: TAsmList); override;
+        class procedure catch_all_end(list: TAsmList); override;
+       protected
+        class procedure begin_catch_internal(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; add_catch: boolean; out exceptlocdef: tdef; out exceptlocreg: tregister);
+        class procedure catch_all_start_internal(list: TAsmList; add_catch: boolean);
+      end;
+
+
+      class procedure tllvmexceptionstatehandler.get_exception_temps(list: TAsmList; var t: texceptiontemps);
+        begin
+          tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.unget_exception_temps(list: TAsmList; const t: texceptiontemps);
+        begin
+          tg.ungettemp(list,t.reasonbuf);
+          tllvmprocinfo(current_procinfo).poppad;
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.new_exception(list: TAsmList; const t: texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
+        var
+          reg: tregister;
+        begin
+          exceptstate.oldflowcontrol:=flowcontrol;
+          if exceptframekind<>tek_except then
+            current_asmdata.getjumplabel(exceptstate.finallycodelabel)
+          else
+            exceptstate.finallycodelabel:=nil;
+          { all calls inside the exception block have to be invokes instead,
+            which refer to the exception label:
+              exceptionlabel:
+                %reg = landingpad ..
+                <exception handling code>
+          }
+          current_asmdata.getjumplabel(exceptstate.exceptionlabel);
+          { for consistency checking when popping }
+          tllvmprocinfo(current_procinfo).pushexceptlabel(exceptstate.exceptionlabel);
+          flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
+          { the reasonbuf is set to 1 by the generic code if we got in
+            the exception block by catching an exception -> do the same here, so
+            we can share that generic code; llvm will optimise it away. The
+            reasonbuf is later also used for break/continue/... }
+          reg:=hlcg.getintregister(list,ossinttype);
+          hlcg.a_load_const_reg(list,ossinttype,1,reg);
+          hlcg.g_exception_reason_save(list,ossinttype,ossinttype,reg,t.reasonbuf);
+          { There can only be a landingpad if there were any invokes in the try-block,
+            as otherwise we get an error; we can also generate exceptions from
+            invalid memory accesses and the like, but LLVM cannot model that
+            --
+            We cheat for now by adding an invoke to a dummy routine at the start and at
+            the end of the try-block. That will not magically fix the state
+            of all variables when the exception gets caught though. }
+          hlcg.g_call_system_proc(list,'FPC_DUMMYPOTENTIALRAISE',[],nil).resetiftemp;
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptionstate: texceptionstate;var exceptiontemps:texceptiontemps);
+        var
+          reg: tregister;
+          landingpad: taillvm;
+          landingpaddef: trecorddef;
+        begin
+          hlcg.g_unreachable(list);
+          hlcg.a_label(list,exceptionstate.exceptionlabel);
+          { use packrecords 1 because we don't want padding (LLVM 4.0+ requires
+            exactly two fields in this struct) }
+          landingpaddef:=llvmgettemprecorddef([voidpointertype,u32inttype],
+            1,
+            targetinfos[target_info.system]^.alignment.recordalignmin,
+            targetinfos[target_info.system]^.alignment.maxCrecordalign);
+          reg:=hlcg.getregisterfordef(list,landingpaddef);
+          landingpad:=taillvm.landingpad(reg,landingpaddef,{clause}nil);
+          list.concat(landingpad);
+          if exceptframekind<>tek_except then
+            begin
+              if not assigned(exceptionstate.finallycodelabel) then
+                internalerror(2018111102);
+              if use_cleanup(exceptframekind) then
+                landingpad.landingpad_add_clause(la_cleanup, nil, nil)
+              else
+                landingpad.landingpad_add_clause(la_catch, voidpointertype, nil);
+              hlcg.a_label(list,exceptionstate.finallycodelabel);
+              exceptionstate.finallycodelabel:=nil;
+            end;
+          { consistency check }
+          tllvmprocinfo(current_procinfo).popexceptlabel(exceptionstate.exceptionlabel);
+          tllvmprocinfo(current_procinfo).pushlandingpad(landingpad);
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.end_try_block(list: TAsmList; exceptframekind: texceptframekind; const t: texceptiontemps; var exceptionstate: texceptionstate; endlabel: TAsmLabel);
+        var
+          reg: tregister;
+        begin
+          { llvm does not allow creating a landing pad if there are no invokes in
+            the try block -> create a call to a dummy routine that cannot be
+            analysed by llvm and that supposedly may raise an exception. Has to
+            be combined with marking stores inside try blocks as volatile and the
+            loads afterwards as well in order to guarantee correct optimizations
+            in case an exception gets triggered inside a try-block though }
+          hlcg.g_call_system_proc(list,'FPC_DUMMYPOTENTIALRAISE',[],nil).resetiftemp;
+
+          { record that no exception happened in the reason buf }
+          reg:=hlcg.getintregister(list,ossinttype);
+          hlcg.a_load_const_reg(list,ossinttype,0,reg);
+          hlcg.g_exception_reason_save(list,ossinttype,ossinttype,reg,t.reasonbuf);
+          inherited;
+          if exceptframekind=tek_except then
+            hlcg.a_jmp_always(list,endlabel);
+        end;
+
+      class procedure tllvmexceptionstatehandler.cleanupobjectstack(list: TAsmList);
+        var
+          landingpad: taillvm;
+        begin
+          { if not a single catch block added -> catch all }
+          landingpad:=tllvmprocinfo(current_procinfo).currlandingpad;
+          if assigned(landingpad) and
+             not assigned(landingpad.oper[2]^.ai) then
+            begin
+              landingpad.landingpad_add_clause(la_catch,voidpointertype,nil);
+            end;
+        end;
+
+      class procedure tllvmexceptionstatehandler.popaddrstack(list: TAsmList);
+        begin
+          // nothing
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.handle_reraise(list: TAsmList; const t: texceptiontemps; const entrystate: texceptionstate; const exceptframekind: texceptframekind);
+        var
+          landingpad: taillvm;
+          landingpadres: tregister;
+          landingpadresdef: tdef;
+        begin
+          { We use resume to propagate the exception to an outer function frame, and call
+            reraise in case we are nested in another exception frame in the current function
+            (because then we will emit an invoke which will tie this re-raise to that other
+             exception frame; that is impossible to do with a resume instruction).
+
+            Furthermore, the resume opcode only works for landingpads with a cleanup clause,
+            which we only generate for outer implicitfinally frames }
+          if not(fc_catching_exceptions in flowcontrol) and
+             use_cleanup(exceptframekind) then
+            begin
+              { resume <result from catchpad> }
+              landingpad:=tllvmprocinfo(current_procinfo).currlandingpad;
+              landingpadres:=landingpad.oper[0]^.reg;
+              landingpadresdef:=landingpad.oper[1]^.def;
+              list.concat(taillvm.op_size_reg(la_resume,landingpadresdef,landingpadres));
+            end
+          else
+            begin
+              { Need a begin_catch so that the reraise will know what exception to throw.
+                Don't need to add a "catch all" to the landing pad, as it contains one.
+                We want to rethrow whatever exception was caught rather than guarantee
+                that all possible kinds of exceptions get caught. }
+              catch_all_start_internal(list,false);
+              hlcg.g_call_system_proc(list,'fpc_reraise',[],nil).resetiftemp;
+            end;
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister);
+        begin
+          begin_catch_internal(list,excepttype,nextonlabel,true,exceptlocdef,exceptlocreg);
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.end_catch(list: TAsmList);
+        begin
+          hlcg.g_call_system_proc(list,'fpc_psabi_end_catch',[],nil).resetiftemp;
+          inherited;
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.catch_all_start(list: TAsmList);
+        begin
+          catch_all_start_internal(list,true);
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.catch_all_end(list: TAsmList);
+        begin
+          hlcg.g_call_system_proc(list,'fpc_psabi_end_catch',[],nil).resetiftemp;
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.begin_catch_internal(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; add_catch: boolean; out exceptlocdef: tdef; out exceptlocreg: tregister);
+        var
+          catchstartlab: tasmlabel;
+          landingpad: taillvm;
+          begincatchres,
+          typeidres,
+          paraloc1: tcgpara;
+          pd: tprocdef;
+          landingpadstructdef,
+          landingpadtypeiddef: tdef;
+          rttisym: TAsmSymbol;
+          rttidef: tdef;
+          rttiref: treference;
+          wrappedexception,
+          exceptiontypeidreg,
+          landingpadres: tregister;
+          exceptloc: tlocation;
+          indirect: boolean;
+          otherunit: boolean;
+        begin
+          paraloc1.init;
+          landingpad:=tllvmprocinfo(current_procinfo).currlandingpad;
+          rttidef:=nil;
+          rttisym:=nil;
+          if add_catch then
+            begin
+              if assigned(excepttype) then
+                begin
+                  otherunit:=findunitsymtable(excepttype.owner).moduleid<>findunitsymtable(current_procinfo.procdef.owner).moduleid;
+                  indirect:=(tf_supports_packages in target_info.flags) and
+                          (target_info.system in systems_indirect_var_imports) and
+                          (cs_imported_data in current_settings.localswitches) and
+                          otherunit;
+                  { add "catch exceptiontype" clause to the landing pad }
+                  rttidef:=cpointerdef.getreusable(excepttype.vmt_def);
+                  rttisym:=current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname, AT_DATA, indirect);
+                  landingpad.landingpad_add_clause(la_catch,rttidef,rttisym);
+                end
+              else
+                begin
+                  landingpad.landingpad_add_clause(la_catch,voidpointertype,nil);
+                end;
+            end;
+          { pascal_exception := FPC_psabi_begin_catch(wrappedExceptionObject) where
+            wrappedExceptionObject is the exception returned by the landingpad }
+          landingpadres:=landingpad.oper[0]^.reg;
+          landingpadstructdef:=landingpad.oper[1]^.def;
+          { check if the exception is handled by this node }
+          if assigned(excepttype) then
+            begin
+              landingpadtypeiddef:=tfieldvarsym(trecorddef(landingpadstructdef).symtable.symlist[1]).vardef;
+              exceptiontypeidreg:=hlcg.getaddressregister(list,landingpadtypeiddef);
+              pd:=search_system_proc('llvm_eh_typeid_for');
+              paramanager.getintparaloc(list,pd,1,paraloc1);
+              reference_reset_symbol(rttiref,rttisym,0,rttidef.alignment,[]);
+              rttiref.refaddr:=addr_full;
+              hlcg.a_load_ref_cgpara(list,cpointerdef.getreusable(rttidef),rttiref,paraloc1);
+              typeidres:=hlcg.g_call_system_proc(list,pd,[@paraloc1],nil);
+              location_reset(exceptloc, LOC_REGISTER, def_cgsize(landingpadtypeiddef));
+              exceptloc.register:=hlcg.getintregister(list,landingpadtypeiddef);
+              hlcg.gen_load_cgpara_loc(list, landingpadtypeiddef, typeidres, exceptloc, true);
+              list.concat(taillvm.extract(la_extractvalue,exceptiontypeidreg,landingpadstructdef,landingpadres,1));
+              current_asmdata.getjumplabel(catchstartlab);
+              hlcg.a_cmp_reg_loc_label(list,typeidres.Def,OC_EQ,exceptiontypeidreg,exceptloc,catchstartlab);
+              hlcg.a_jmp_always(list,nextonlabel);
+              hlcg.a_label(list,catchstartlab);
+              typeidres.resetiftemp;
+            end;
+
+          wrappedexception:=hlcg.getaddressregister(list,voidpointertype);
+          list.concat(taillvm.extract(la_extractvalue,wrappedexception,landingpadstructdef,landingpadres,0));
+
+          pd:=search_system_proc('fpc_psabi_begin_catch');
+          paramanager.getintparaloc(list, pd, 1, paraloc1);
+          hlcg.a_load_reg_cgpara(list,voidpointertype,wrappedexception,paraloc1);
+          begincatchres:=hlcg.g_call_system_proc(list,pd,[@paraloc1],nil);
+          location_reset(exceptloc, LOC_REGISTER, def_cgsize(begincatchres.def));
+          exceptloc.register:=hlcg.getaddressregister(list, begincatchres.def);
+          hlcg.gen_load_cgpara_loc(list, begincatchres.def, begincatchres, exceptloc, true);
+
+          begincatchres.resetiftemp;
+          paraloc1.done;
+
+          exceptlocdef:=begincatchres.def;
+          exceptlocreg:=exceptloc.register;
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.catch_all_start_internal(list: TAsmList; add_catch: boolean);
+        var
+          exceptlocdef: tdef;
+          exceptlocreg: tregister;
+        begin
+          begin_catch_internal(list,nil,nil,add_catch,exceptlocdef,exceptlocreg);
+        end;
+
+
+
+{*****************************************************************************
+                     tllvmprocinfo
+*****************************************************************************}
+
+    constructor tllvmprocinfo.create(aparent: tprocinfo);
+      begin
+        inherited;
+        fexceptlabelstack:=tfplist.create;
+        flandingpadstack:=tfplist.create;
+      end;
+
+    destructor tllvmprocinfo.destroy;
+      begin
+        if fexceptlabelstack.Count<>0 then
+          Internalerror(2016121301);
+        fexceptlabelstack.free;
+        if flandingpadstack.Count<>0 then
+          internalerror(2018051901);
+        flandingpadstack.free;
+        inherited;
+      end;
+
+
+    procedure tllvmprocinfo.pushexceptlabel(lab: TAsmLabel);
+      begin
+        fexceptlabelstack.add(lab);
+      end;
+
+
+    function tllvmprocinfo.popexceptlabel(lab: TAsmLabel): boolean;
+      begin
+        if CurrExceptLabel<>lab then
+          internalerror(2016121302);
+        fexceptlabelstack.count:=fexceptlabelstack.count-1;
+        result:=fexceptlabelstack.count=0;
+      end;
+
+
+    function tllvmprocinfo.CurrExceptLabel: TAsmLabel; inline;
+      begin
+        result:=TAsmLabel(fexceptlabelstack.last);
+        if not assigned(result) then
+          internalerror(2016121703);
+      end;
+
+
+    procedure tllvmprocinfo.pushlandingpad(pad: taillvm);
+      begin
+        flandingpadstack.add(pad);
+      end;
+
+    procedure tllvmprocinfo.poppad;
+      begin
+        if flandingpadstack.Count=0 then
+          internalerror(2018051902);
+        flandingpadstack.Count:=flandingpadstack.Count-1;
+      end;
+
+
+    function tllvmprocinfo.currlandingpad: taillvm;
+      begin
+        if flandingpadstack.Count=0 then
+          internalerror(2018051903);
+        result:=taillvm(flandingpadstack.last);
+      end;
+
+
+    procedure tllvmprocinfo.setup_eh;
+      begin
+        if po_assembler in procdef.procoptions then
+          inherited
+        else
+          begin
+            cexceptionstatehandler:=tllvmexceptionstatehandler;
+          end;
+      end;
+
+
+    procedure tllvmprocinfo.finish_eh;
+      begin
+        if po_assembler in procdef.procoptions then
+          inherited;
+      end;
+
+
+    procedure tllvmprocinfo.start_eh(list: TAsmList);
+      begin
+        if po_assembler in procdef.procoptions then
+          inherited;
+      end;
+
+
+    procedure tllvmprocinfo.end_eh(list: TAsmList);
+      begin
+        if po_assembler in procdef.procoptions then
+          inherited;
+      end;
+
+
+begin
+  if not assigned(cprocinfo) then
+    begin
+      writeln('Internalerror 2018052005');
+      halt(1);
+    end;
+  cprocinfo:=tllvmprocinfo;
+end.
+

compiler/llvm/llvmtype.pas

@@ -54,6 +54,7 @@ interface
           generated, as these alias declarations can appear anywhere }
         asmsymtypes: THashSet;
 
+        function check_insert_bitcast(toplevellist: tasmlist; sym: tasmsymbol; const opdef: tdef): taillvm;
         procedure record_asmsym_def(sym: TAsmSymbol; def: tdef; redefine: boolean);
         function  get_asmsym_def(sym: TAsmSymbol): tdef;
 
@@ -109,7 +110,7 @@ implementation
       ;
 
 {****************************************************************************
-                              TDebugInfoDwarf
+                              TLLVMTypeInfo
 ****************************************************************************}
 
     procedure TLLVMTypeInfo.record_asmsym_def(sym: TAsmSymbol; def: tdef; redefine: boolean);
@@ -127,6 +128,50 @@ implementation
       end;
 
 
+    function equal_llvm_defs(def1, def2: tdef): boolean;
+      var
+        def1str, def2str: TSymStr;
+      begin
+        if def1=def2 then
+          exit(true);
+        def1str:=llvmencodetypename(def1);
+        def2str:=llvmencodetypename(def2);
+        { normalise both type representations in case one is a procdef
+          and the other is a procvardef}
+        if def1.typ=procdef then
+          def1str:=def1str+'*';
+        if def2.typ=procdef then
+          def2str:=def2str+'*';
+        result:=def1str=def2str;
+      end;
+
+
+    function TLLVMTypeInfo.check_insert_bitcast(toplevellist: tasmlist; sym: tasmsymbol; const opdef: tdef): taillvm;
+      var
+        opcmpdef: tdef;
+        symdef: tdef;
+      begin
+        result:=nil;
+        case opdef.typ of
+          pointerdef:
+            opcmpdef:=tpointerdef(opdef).pointeddef;
+          procvardef,
+          procdef:
+            opcmpdef:=opdef;
+          else
+            internalerror(2015073101);
+        end;
+        maybe_insert_extern_sym_decl(toplevellist, sym, opcmpdef);
+        symdef:=get_asmsym_def(sym);
+        if not equal_llvm_defs(symdef, opcmpdef) then
+          begin
+            if symdef.typ=procdef then
+              symdef:=cpointerdef.getreusable(symdef);
+            result:=taillvm.op_reg_size_sym_size(la_bitcast, NR_NO, cpointerdef.getreusable(symdef), sym, opdef);
+          end;
+      end;
+
+
     function TLLVMTypeInfo.get_asmsym_def(sym: TAsmSymbol): tdef;
       var
         res: PHashSetItem;
@@ -146,6 +191,9 @@ implementation
         if def.stab_number<>0 then
           exit;
         def.stab_number:=1;
+        { this is an internal llvm type }
+        if def=llvm_metadatatype then
+          exit;
         if def.dbg_state=dbg_state_unused then
           begin
             def.dbg_state:=dbg_state_used;
@@ -197,9 +245,9 @@ implementation
                    assigned(p.oper[opidx]^.ref^.symbol) and
                    (p.oper[opidx]^.ref^.symbol.bind<>AB_TEMP) then
                   begin
-                    if (opidx=3) and
-                       (p.llvmopcode=la_call) then
-                      record_asmsym_def(p.oper[opidx]^.ref^.symbol,tpointerdef(p.oper[2]^.def).pointeddef,false)
+                    if (opidx=4) and
+                       (p.llvmopcode in [la_call,la_invoke]) then
+                      record_asmsym_def(p.oper[opidx]^.ref^.symbol,tpointerdef(p.oper[3]^.def).pointeddef,false)
                     { not a named register }
                     else if (p.oper[opidx]^.ref^.refaddr<>addr_full) then
                       record_asmsym_def(p.oper[opidx]^.ref^.symbol,p.spilling_get_reg_type(opidx),false);
@@ -210,6 +258,8 @@ implementation
                 begin
                   callpara:=pllvmcallpara(p.oper[opidx]^.paras[paraidx]);
                   record_def(callpara^.def);
+                  if callpara^.typ=top_tai then
+                    collect_tai_info(deftypelist,callpara^.ai);
                 end;
             else
               ;
@@ -267,53 +317,63 @@ implementation
       end;
 
 
-    function equal_llvm_defs(def1, def2: tdef): boolean;
-      var
-        def1str, def2str: TSymStr;
-      begin
-        if def1=def2 then
-          exit(true);
-        def1str:=llvmencodetypename(def1);
-        def2str:=llvmencodetypename(def2);
-        { normalise both type representations in case one is a procdef
-          and the other is a procvardef}
-        if def1.typ=procdef then
-          def1str:=def1str+'*';
-        if def2.typ=procdef then
-          def2str:=def2str+'*';
-        result:=def1str=def2str;
-      end;
-
-
     procedure TLLVMTypeInfo.insert_llvmins_typeconversions(toplevellist: tasmlist; p: taillvm);
       var
         symdef,
-        opdef,
-        opcmpdef: tdef;
+        opdef: tdef;
+        callpara: pllvmcallpara;
         cnv: taillvm;
-        i: longint;
+        i, paraidx: longint;
       begin
         case p.llvmopcode of
-          la_call:
-            if p.oper[3]^.typ=top_ref then
-              begin
-                maybe_insert_extern_sym_decl(toplevellist,p.oper[3]^.ref^.symbol,tpointerdef(p.oper[2]^.def).pointeddef);
-                symdef:=get_asmsym_def(p.oper[3]^.ref^.symbol);
-                { the type used in the call is different from the type used to
-                  declare the symbol -> insert a typecast }
-                if not equal_llvm_defs(symdef,p.oper[2]^.def) then
-                  begin
-                    if symdef.typ=procdef then
-                      { ugly, but can't use getcopyas(procvardef) due to the
-                        symtablestack not being available here (cpointerdef.getreusable
-                        is hardcoded to put things in the current module's
-                        symtable) and "pointer to procedure" results in the
-                        correct llvm type }
-                      symdef:=cpointerdef.getreusable(tprocdef(symdef));
-                    cnv:=taillvm.op_reg_size_sym_size(la_bitcast,NR_NO,symdef,p.oper[3]^.ref^.symbol,p.oper[2]^.def);
-                    p.loadtai(3,cnv);
-                  end;
-              end;
+          la_call,
+          la_invoke:
+            begin
+              if p.oper[4]^.typ=top_ref then
+                begin
+                  maybe_insert_extern_sym_decl(toplevellist,p.oper[4]^.ref^.symbol,tpointerdef(p.oper[3]^.def).pointeddef);
+                  symdef:=get_asmsym_def(p.oper[4]^.ref^.symbol);
+                  { the type used in the call is different from the type used to
+                    declare the symbol -> insert a typecast }
+                  if not equal_llvm_defs(symdef,p.oper[3]^.def) then
+                    begin
+                      if symdef.typ=procdef then
+                        { ugly, but can't use getcopyas(procvardef) due to the
+                          symtablestack not being available here (cpointerdef.getreusable
+                          is hardcoded to put things in the current module's
+                          symtable) and "pointer to procedure" results in the
+                          correct llvm type }
+                        symdef:=cpointerdef.getreusable(tprocdef(symdef));
+                      cnv:=taillvm.op_reg_size_sym_size(la_bitcast,NR_NO,symdef,p.oper[4]^.ref^.symbol,p.oper[3]^.def);
+                      p.loadtai(4,cnv);
+                    end;
+                end;
+              for i:=0 to p.ops-1 do
+                begin
+                  if p.oper[i]^.typ=top_para then
+                    begin
+                      for paraidx:=0 to p.oper[i]^.paras.count-1 do
+                        begin
+                          callpara:=pllvmcallpara(p.oper[i]^.paras[paraidx]);
+                          case callpara^.typ of
+                            top_tai:
+                              insert_tai_typeconversions(toplevellist,callpara^.ai);
+                            top_ref:
+                              begin
+                                cnv:=check_insert_bitcast(toplevellist,callpara^.sym,callpara^.def);
+                                if assigned(cnv) then
+                                  begin
+                                    callpara^.typ:=top_tai;
+                                    callpara^.ai:=cnv;
+                                  end;
+                              end;
+                            else
+                              ;
+                          end;
+                        end;
+                    end;
+                end;
+            end
           else if p.llvmopcode<>la_br then
             begin
               { check the types of all symbolic operands }
@@ -325,24 +385,9 @@ implementation
                        (p.oper[i]^.ref^.symbol.bind<>AB_TEMP) then
                       begin
                         opdef:=p.spilling_get_reg_type(i);
-                        case opdef.typ of
-                          pointerdef:
-                            opcmpdef:=tpointerdef(opdef).pointeddef;
-                          procvardef,
-                          procdef:
-                            opcmpdef:=opdef;
-                          else
-                            internalerror(2015073101);
-                        end;
-                        maybe_insert_extern_sym_decl(toplevellist,p.oper[i]^.ref^.symbol,opcmpdef);
-                        symdef:=get_asmsym_def(p.oper[i]^.ref^.symbol);
-                        if not equal_llvm_defs(symdef,opcmpdef) then
-                          begin
-                            if symdef.typ=procdef then
-                              symdef:=cpointerdef.getreusable(symdef);
-                            cnv:=taillvm.op_reg_size_sym_size(la_bitcast,NR_NO,cpointerdef.getreusable(symdef),p.oper[i]^.ref^.symbol,opdef);
-                            p.loadtai(i,cnv);
-                          end;
+                        cnv:=check_insert_bitcast(toplevellist,p.oper[i]^.ref^.symbol, opdef);
+                        if assigned(cnv) then
+                          p.loadtai(i, cnv);
                       end;
                   top_tai:
                     insert_tai_typeconversions(toplevellist,p.oper[i]^.ai);
@@ -409,7 +454,15 @@ implementation
           ait_typedconst:
             insert_typedconst_typeconversion(toplevellist,tai_abstracttypedconst(p));
           ait_llvmdecl:
-            insert_asmlist_typeconversions(toplevellist,taillvmdecl(p).initdata);
+            begin
+              if (ldf_definition in taillvmdecl(p).flags) and
+                 (taillvmdecl(p).def.typ=procdef) and
+                 assigned(tprocdef(taillvmdecl(p).def).personality) then
+                maybe_insert_extern_sym_decl(toplevellist,
+                  current_asmdata.RefAsmSymbol(tprocdef(taillvmdecl(p).def).personality.mangledname,AT_FUNCTION,false),
+                  tprocdef(taillvmdecl(p).def).personality);
+              insert_asmlist_typeconversions(toplevellist,taillvmdecl(p).initdata);
+            end;
           else
             ;
         end;
@@ -434,6 +487,7 @@ implementation
     procedure TLLVMTypeInfo.maybe_insert_extern_sym_decl(toplevellist: tasmlist; sym: tasmsymbol; def: tdef);
       var
         sec: tasmsectiontype;
+        i: longint;
       begin
         { Necessery for "external" declarations for symbols not declared in the
           current unit. We can't create these declarations when the alias is
@@ -451,6 +505,20 @@ implementation
               sec:=sec_data;
             toplevellist.Concat(taillvmdecl.createdecl(sym,def,nil,sec,def.alignment));
             record_asmsym_def(sym,def,true);
+            { the external symbol may never be called, in which case the types
+              of its parameters will never be process -> do it here }
+            if (def.typ=procdef) then
+              begin
+                { can't use this condition to determine whether or not we need
+                  to generate the argument defs, because this information does
+                  not get reset when multiple units are compiled during a
+                  single compiler invocation }
+                if (tprocdef(def).has_paraloc_info=callnoside) then
+                  tprocdef(def).init_paraloc_info(callerside);
+                for i:=0 to tprocdef(def).paras.count-1 do
+                  record_def(llvmgetcgparadef(tparavarsym(tprocdef(def).paras[i]).paraloc[callerside],true,calleeside));
+                record_def(llvmgetcgparadef(tprocdef(def).funcretloc[callerside],true,calleeside));
+              end;
           end;
       end;
 
@@ -535,8 +603,8 @@ implementation
           types that are then casted to the real type when they are used }
         def.init_paraloc_info(callerside);
         for i:=0 to def.paras.count-1 do
-          appenddef(list,llvmgetcgparadef(tparavarsym(def.paras[i]).paraloc[callerside],true));
-        appenddef(list,llvmgetcgparadef(def.funcretloc[callerside],true));
+          appenddef(list,llvmgetcgparadef(tparavarsym(def.paras[i]).paraloc[callerside],true,calleeside));
+        appenddef(list,llvmgetcgparadef(def.funcretloc[callerside],true,calleeside));
         if assigned(def.typesym) and
            not def.is_addressonly then
           list.concat(taillvm.op_size(LA_TYPE,record_def(def)));

compiler/llvm/nllvmbas.pas

@@ -84,6 +84,7 @@ interface
         if not assigned(res^.Data) then
           begin
             new(callpara);
+            callpara^.alignment:=std_param_align;
             callpara^.def:=cpointerdef.getreusable(sym.vardef);
             if (sym.typ=paravarsym) and
                paramanager.push_addr_param(sym.varspez,sym.vardef,current_procinfo.procdef.proccalloption) then
@@ -91,7 +92,7 @@ interface
             callpara^.sret:=false;
             callpara^.byval:=false;
             callpara^.valueext:=lve_none;
-            callpara^.loc:=LOC_REGISTER;
+            callpara^.typ:=top_reg;
             { address must be a temp register }
             if (sym.localloc.loc<>LOC_REFERENCE) or
                (sym.localloc.reference.base=NR_NO) or
@@ -99,7 +100,7 @@ interface
                (sym.localloc.reference.offset<>0) or
                assigned(sym.localloc.reference.symbol) then
               internalerror(2016111001);
-            callpara^.reg:=sym.localloc.reference.base;
+            callpara^.register:=sym.localloc.reference.base;
             fsymboldata.add(callpara);
             ptruint(res^.Data):=fsymboldata.count-1;
           end;

compiler/llvm/nllvmcnv.pas

@@ -83,7 +83,19 @@ class function tllvmtypeconvnode.target_specific_need_equal_typeconv(fromdef, to
         still need a conversion }
       (
        ((fromdef.typ=procvardef) and
-        (todef.typ=procvardef))
+        (todef.typ=procvardef)) or
+       { same for two different specialisations }
+       ((df_specialization in fromdef.defoptions) and
+        (df_specialization in todef.defoptions)) or
+       { typed from/to untyped filedef in ISO mode: have to keep because of
+         the get/put buffer }
+       ((fromdef.typ=filedef) and
+        (tfiledef(fromdef).filetyp=ft_typed) and
+        (todef.typ=filedef) and
+        (tfiledef(todef).filetyp=ft_typed) and
+        (not equal_defs(tfiledef(fromdef).typedfiledef, tfiledef(todef).typedfiledef) or
+         target_specific_need_equal_typeconv(tfiledef(fromdef).typedfiledef, tfiledef(todef).typedfiledef))
+       )
       );
   end;
 
@@ -275,7 +287,8 @@ procedure tllvmtypeconvnode.second_nothing;
                (left.resultdef.typ=filedef) and
                (tfiledef(left.resultdef).filetyp=ft_typed) and
                (resultdef.typ=filedef) and
-               (tfiledef(resultdef).filetyp=ft_untyped)
+               (tfiledef(resultdef).filetyp in [ft_untyped,ft_typed]) and
+               (resultdef.size<left.resultdef.size)
            ) and
            { anything else with different size that ends up here is an error }
            (left.resultdef.size<>resultdef.size) then

compiler/llvm/nllvmflw.pas

@@ -26,25 +26,44 @@ unit nllvmflw;
 interface
 
     uses
-      aasmbase,
-      nflw, ncgflw, ncgnstfl;
+      globtype,
+      symtype,symdef,
+      aasmbase,aasmdata,
+      cgbase,
+      node, nflw, ncgflw, ncgnstfl;
 
     type
       tllvmlabelnode = class(tcglabelnode)
         function getasmlabel: tasmlabel; override;
       end;
 
+    tllvmtryexceptnode = class(tcgtryexceptnode)
+    end;
+
+    tllvmtryfinallynode = class(tcgtryfinallynode)
+      function pass_1: tnode; override;
+    end;
+
+    tllvmraisenode = class(tcgraisenode)
+      function pass_1: tnode; override;
+      procedure pass_generate_code; override;
+    end;
+
 
 implementation
 
+    uses
+      systems,globals,verbose,
+      symconst,symtable,symsym,llvmdef,defutil,
+      pass_2,cgutils,hlcgobj,parabase,paramgr,tgobj,
+      llvmbase,aasmtai,aasmllvm,
+      procinfo,llvmpi;
+
+
 {*****************************************************************************
                              SecondLabel
 *****************************************************************************}
 
-    uses
-      aasmdata;
-
-
     function tllvmlabelnode.getasmlabel: tasmlabel;
       begin
         { don't allocate global labels even if the label is accessed from
@@ -61,7 +80,63 @@ implementation
         result:=asmlabel
       end;
 
+
+{*****************************************************************************
+                          tllvmtryfinallynode
+*****************************************************************************}
+
+    function tllvmtryfinallynode.pass_1: tnode;
+      begin
+        { make a copy of the "finally" code for the "no exception happened"
+          case }
+        if not assigned(third) then
+          third:=right.getcopy;
+        result:=inherited;
+      end;
+
+
+{*****************************************************************************
+                             tllvmraisenode
+*****************************************************************************}
+
+    function tllvmraisenode.pass_1: tnode;
+      begin
+        if assigned(left) then
+          result:=inherited
+        else
+          begin
+            expectloc:=LOC_VOID;
+            result:=nil;
+          end;
+      end;
+
+
+    procedure tllvmraisenode.pass_generate_code;
+      var
+        currexceptlabel: tasmlabel;
+      begin
+        location_reset(location,LOC_VOID,OS_NO);
+        currexceptlabel:=nil;
+        { a reraise must raise the exception to the parent exception frame }
+        if fc_catching_exceptions in flowcontrol then
+          begin
+            currexceptlabel:=tllvmprocinfo(current_procinfo).CurrExceptLabel;
+            if tllvmprocinfo(current_procinfo).popexceptlabel(currexceptlabel) then
+              exclude(flowcontrol,fc_catching_exceptions);
+          end;
+        hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil).resetiftemp;
+        if assigned(currexceptlabel) then
+          begin
+            tllvmprocinfo(current_procinfo).pushexceptlabel(currexceptlabel);
+            include(flowcontrol,fc_catching_exceptions);
+          end;
+      end;
+
+
 begin
   clabelnode:=tllvmlabelnode;
+  ctryexceptnode:=tllvmtryexceptnode;
+  ctryfinallynode:=tllvmtryfinallynode;
+  craisenode:=tllvmraisenode;
 end.
 

compiler/llvm/nllvminl.pas

@@ -36,10 +36,12 @@ interface
 
         function first_get_frame: tnode; override;
         function first_abs_real: tnode; override;
+        function first_bitscan: tnode; override;
         function first_fma: tnode; override;
         function first_sqr_real: tnode; override;
         function first_sqrt_real: tnode; override;
         function first_trunc_real: tnode; override;
+        function first_popcnt: tnode; override;
        public
         procedure second_length; override;
         procedure second_sqr_real; override;
@@ -148,6 +150,73 @@ implementation
         left:=nil;
       end;
 
+
+    function tllvminlinenode.first_bitscan: tnode;
+      var
+        leftdef: tdef;
+        resulttemp,
+        lefttemp: ttempcreatenode;
+        stat: tstatementnode;
+        block: tblocknode;
+        cntresult: tnode;
+        procname: string[15];
+      begin
+        {
+          if left<>0 then
+            result:=llvm_ctlz/cttz(unsigned(left),true)
+          else
+            result:=255;
+        }
+        if inlinenumber=in_bsr_x then
+          procname:='LLVM_CTLZ'
+        else
+          procname:='LLVM_CTTZ';
+        leftdef:=left.resultdef;
+        block:=internalstatements(stat);
+        resulttemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
+        addstatement(stat,resulttemp);
+        lefttemp:=maybereplacewithtemp(left,block,stat,left.resultdef.size,true);
+        cntresult:=
+          ccallnode.createintern(
+            procname,
+            ccallparanode.create(cordconstnode.create(1,llvmbool1type,false),
+              ccallparanode.create(
+                ctypeconvnode.create_explicit(left,get_unsigned_inttype(leftdef)),nil
+              )
+            )
+          );
+        { ctlz returns the number of leading zero bits, while bsr returns the bit
+          number of the first non-zero bit (with the least significant bit as 0)
+          -> invert result }
+        if inlinenumber=in_bsr_x then
+          begin
+            cntresult:=
+              caddnode.create(xorn,
+                cntresult,
+                genintconstnode(leftdef.size*8-1)
+              );
+          end;
+        addstatement(stat,
+          cifnode.create(caddnode.create(unequaln,left.getcopy,genintconstnode(0)),
+            cassignmentnode.create(
+              ctemprefnode.create(resulttemp),
+              cntresult
+            ),
+            cassignmentnode.create(
+              ctemprefnode.create(resulttemp),
+              genintconstnode(255)
+            )
+          )
+        );
+        if assigned(lefttemp) then
+          addstatement(stat,ctempdeletenode.create(lefttemp));
+        addstatement(stat,ctempdeletenode.create_normal_temp(resulttemp));
+        addstatement(stat,ctemprefnode.create(resulttemp));
+        left:=nil;
+        result:=block;
+      end;
+
+
     function tllvminlinenode.first_fma: tnode;
       var
         procname: string[15];
@@ -216,6 +285,12 @@ implementation
           result:=inherited;
       end;
 
+    function tllvminlinenode.first_popcnt: tnode;
+      begin
+        result:=ctypeconvnode.create(ccallnode.createintern('LLVM_CTPOP', ccallparanode.create(left,nil)),resultdef);
+        left:=nil;
+      end;
+
 
     procedure tllvminlinenode.second_length;
       var

compiler/llvm/nllvmset.pas

@@ -0,0 +1,53 @@
+{
+    Copyright (c) 2019 by Jonas Maebe
+
+    Generate LLVM bytecode for set/case nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit nllvmset;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    nset, ncgset;
+
+  type
+    tllvmcasenode = class(tcgcasenode)
+     protected
+      procedure genlinearlist(hp: pcaselabel); override;
+    end;
+
+
+implementation
+
+  procedure tllvmcasenode.genlinearlist(hp: pcaselabel);
+    begin
+      { genlinearlist constantly updates the case value in the register,
+        which causes tons of spilling with LLVM due to the need to bring
+        it back into SSA form. LLVM will recognise and optimise the linear
+        cmp list just as well (or even better), while the code that FPC
+        has to generate is much smaller (no spilling) }
+      genlinearcmplist(hp);
+    end;
+
+begin
+  ccasenode:=tllvmcasenode;
+end.
+

compiler/llvm/nllvmtcon.pas

@@ -131,7 +131,8 @@ implementation
     aasmdata,
     procinfo,
     cpubase,cpuinfo,llvmbase,
-    symtable,llvmdef,defutil,defcmp;
+    symtable,llvmdef,defutil,defcmp,
+    ngenutil;
 
   { tllvmaggregateinformation }
 
@@ -213,9 +214,9 @@ implementation
           why it's done like this, but this is how Clang does it) }
         if (target_info.system in systems_darwin) and
            (section in [low(TObjCAsmSectionType)..high(TObjCAsmSectionType)]) then
-          current_module.llvmcompilerusedsyms.add(decl)
+          cnodeutils.RegisterUsedAsmSym(sym,def,false)
         else
-          current_module.llvmusedsyms.add(decl);
+          cnodeutils.RegisterUsedAsmSym(sym,def,true);
       newasmlist.concat(decl);
       fasmlist:=newasmlist;
     end;

compiler/llvm/nllvmutil.pas

@@ -27,7 +27,7 @@ interface
 
   uses
     globtype,cclasses,
-    aasmdata,ngenutil,
+    aasmbase,aasmdata,aasmllvmmetadata, ngenutil,
     symtype,symconst,symsym,symdef;
 
 
@@ -35,9 +35,14 @@ interface
     tllvmnodeutils = class(tnodeutils)
      strict protected
       class procedure insertbsssym(list: tasmlist; sym: tstaticvarsym; size: asizeint; varalign: shortint); override;
-      class procedure InsertUsedList(var usedsyms: tfpobjectlist; const usedsymsname: TSymstr);
+      class procedure InsertUsedList(var usedsyms: tfpobjectlist; const usedsymsname: TSymStr);
+      class procedure InsertInitFiniList(var procdefs: tfplist; const initfinisymsname: TSymStr);
      public
       class procedure InsertObjectInfo; override;
+      class procedure RegisterUsedAsmSym(sym: TAsmSymbol; def: tdef; compileronly: boolean); override;
+      class procedure GenerateObjCImageInfo; override;
+      class procedure RegisterModuleInitFunction(pd: tprocdef); override;
+      class procedure RegisterModuleFiniFunction(pd: tprocdef); override;
     end;
 
 
@@ -45,16 +50,16 @@ implementation
 
     uses
       verbose,cutils,globals,fmodule,systems,
-      aasmbase,aasmtai,cpubase,llvmbase,aasmllvm,
+      aasmtai,cpubase,llvmbase,aasmllvm,
       aasmcnst,nllvmtcon,
       symbase,symtable,defutil,
-      llvmtype;
+      llvmtype,llvmdef,
+      objcasm;
 
   class procedure tllvmnodeutils.insertbsssym(list: tasmlist; sym: tstaticvarsym; size: asizeint; varalign: shortint);
     var
       asmsym: tasmsymbol;
       field1, field2: tsym;
-      tcb: ttai_typedconstbuilder;
     begin
       if sym.globalasmsym then
         asmsym:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_GLOBAL,AT_DATA,sym.vardef)
@@ -71,24 +76,73 @@ implementation
     end;
 
 
+  type
+    TTypedAsmSym = class
+      sym: TAsmSymbol;
+      def: tdef;
+      constructor Create(s: TAsmSymbol; d: tdef);
+    end;
+
+
+  constructor TTypedAsmSym.Create(s: TAsmSymbol; d: tdef);
+    begin
+      sym:=s;
+      def:=d;
+    end;
+
+
+  function TypedAsmSymComparer(p1, p2: Pointer): Integer;
+    var
+      sym1: TTypedAsmSym absolute p1;
+      sym2: TTypedAsmSym absolute p2;
+    begin
+      result:=CompareStr(sym1.sym.Name,sym2.sym.Name);
+    end;
+
+
   class procedure tllvmnodeutils.InsertUsedList(var usedsyms: tfpobjectlist; const usedsymsname: TSymstr);
     var
       useddef: tdef;
       tcb: ttai_typedconstbuilder;
-      decl: taillvmdecl;
-      i: longint;
+      prevasmsym: TAsmSymbol;
+      typedsym: TTypedAsmSym;
+      uniquesyms, i: longint;
     begin
       if usedsyms.count<>0 then
         begin
+          { a symbol can appear multiple times -> sort the list so we can filter out doubles }
+          usedsyms.Sort(@TypedAsmSymComparer);
+          { count uniques }
+          prevasmsym:=nil;
+          uniquesyms:=0;
+          for i:=0 to usedsyms.count-1 do
+            begin
+              typedsym:=TTypedAsmSym(usedsyms[i]);
+              if (prevasmsym<>typedsym.sym) and
+                { even though we already filter on pure assembler routines when adding the symbols,
+                  some may slip through because of forward definitions that are not yet resolved }
+                 not((typedsym.def.typ=procdef) and
+                     (po_assembler in tprocdef(typedsym.def).procoptions)) then
+                inc(uniquesyms);
+              prevasmsym:=typedsym.sym;
+              end;
+          { emit uniques }
+          prevasmsym:=nil;
           tcb:=ctai_typedconstbuilder.create([tcalo_new_section]);
           tllvmtai_typedconstbuilder(tcb).appendingdef:=true;
-          useddef:=carraydef.getreusable(voidpointertype,usedsyms.count);
+          useddef:=carraydef.getreusable(voidpointertype,uniquesyms);
           tcb.maybe_begin_aggregate(useddef);
           for i:=0 to usedsyms.count-1 do
             begin
-              decl:=taillvmdecl(usedsyms[i]);
-              tcb.queue_init(voidpointertype);
-              tcb.queue_emit_asmsym(decl.namesym,decl.def);
+              typedsym:=TTypedAsmSym(usedsyms[i]);
+              if (prevasmsym<>typedsym.sym) and
+                 not((typedsym.def.typ=procdef) and
+                     (po_assembler in tprocdef(typedsym.def).procoptions)) then
+                begin
+                  tcb.queue_init(voidpointertype);
+                  tcb.queue_emit_asmsym(typedsym.sym,typedsym.def);
+                  prevasmsym:=typedsym.sym;
+                end;
             end;
           tcb.maybe_end_aggregate(useddef);
           current_asmdata.AsmLists[al_globals].concatlist(
@@ -105,6 +159,50 @@ implementation
     end;
 
 
+  class procedure tllvmnodeutils.InsertInitFiniList(var procdefs: tfplist; const initfinisymsname: TSymStr);
+    var
+      itemdef: trecorddef;
+      arraydef: tarraydef;
+      pd: tprocdef;
+      fields: array[0..2] of tdef;
+      tcb: ttai_typedconstbuilder;
+      i: longint;
+    begin
+      if procdefs.count<>0 then
+        begin
+          pd:=tprocdef(procdefs[0]);
+          fields[0]:=s32inttype;
+          fields[1]:=pd.getcopyas(procvardef,pc_address_only,'');
+          fields[2]:=voidpointertype;
+          itemdef:=llvmgettemprecorddef(fields,C_alignment,
+            targetinfos[target_info.system]^.alignment.recordalignmin,
+            targetinfos[target_info.system]^.alignment.maxCrecordalign);
+          include(itemdef.defoptions,df_llvm_no_struct_packing);
+          tcb:=ctai_typedconstbuilder.create([tcalo_new_section]);
+          tllvmtai_typedconstbuilder(tcb).appendingdef:=true;
+          arraydef:=carraydef.getreusable(itemdef,procdefs.Count);
+          tcb.maybe_begin_aggregate(arraydef);
+          for i:=0 to procdefs.count-1 do
+            begin
+              tcb.maybe_begin_aggregate(itemdef);
+              tcb.emit_ord_const(65535,s32inttype);
+              tcb.emit_procdef_const(tprocdef(procdefs[i]));
+              tcb.emit_tai(Tai_const.Create_sym(nil),voidpointertype);
+              tcb.maybe_end_aggregate(itemdef);
+            end;
+          tcb.maybe_end_aggregate(arraydef);
+          current_asmdata.AsmLists[al_globals].concatlist(
+            tcb.get_final_asmlist(
+              current_asmdata.DefineAsmSymbol(
+                initfinisymsname,AB_GLOBAL,AT_DATA,arraydef),arraydef,sec_data,
+                initfinisymsname,voidpointertype.alignment
+            )
+          );
+          tcb.free;
+        end;
+    end;
+
+
   class procedure tllvmnodeutils.InsertObjectInfo;
     begin
       inherited;
@@ -113,6 +211,10 @@ implementation
       InsertUsedList(current_module.llvmcompilerusedsyms,'llvm.compiler.used');
       { add the llvm.used array }
       InsertUsedList(current_module.llvmusedsyms,'llvm.used');
+      { add the llvm.global_ctors array }
+      InsertInitFiniList(current_module.llvminitprocs,'llvm.global_ctors');
+      { add the llvm.global_dtors array }
+      InsertInitFiniList(current_module.llvmfiniprocs,'llvm.global_dtors');
 
       { add "type xx = .." statements for all used recorddefs }
       with TLLVMTypeInfo.Create do
@@ -123,6 +225,88 @@ implementation
     end;
 
 
+  class procedure tllvmnodeutils.RegisterUsedAsmSym(sym: TAsmSymbol; def: tdef; compileronly: boolean);
+    var
+      last: TTypedAsmSym;
+    begin
+      if compileronly then
+        begin
+          { filter multiple adds in succession here already }
+          last:=TTypedAsmSym(current_module.llvmcompilerusedsyms.Last);
+          if not assigned(last) or
+             (last.sym<>sym) then
+            current_module.llvmcompilerusedsyms.Add(TTypedAsmSym.Create(sym,def))
+        end
+      else
+        begin
+          last:=TTypedAsmSym(current_module.llvmusedsyms.Last);
+          if not assigned(last) or
+             (last.sym<>sym) then
+          current_module.llvmusedsyms.Add(TTypedAsmSym.Create(sym,def))
+        end;
+    end;
+
+
+  class procedure tllvmnodeutils.GenerateObjCImageInfo;
+    var
+      llvmmoduleflags,
+       objcmoduleflag: tai_llvmbasemetadatanode;
+      objcabiversion: longint;
+    begin
+      llvmmoduleflags:=tai_llvmnamedmetadatanode.create('llvm.module.flags');
+      current_asmdata.AsmLists[al_rotypedconsts].Concat(llvmmoduleflags);
+
+      { Objective-C ABI version }
+      if not(target_info.system in [system_powerpc_darwin,system_powerpc64_darwin,system_i386_darwin,system_x86_64_darwin]) or
+         (CompareVersionStrings(MacOSXVersionMin,'10.5')>=0) then
+        objcabiversion:=2
+      else
+        objcabiversion:=1;
+      objcmoduleflag:=tai_llvmunnamedmetadatanode.create;
+      objcmoduleflag.addvalue(tai_simpletypedconst.create(s32inttype,tai_const.Create_32bit(1)));
+      objcmoduleflag.addvalue(tai_simpletypedconst.create(charpointertype,tai_string.Create('Objective-C Version')));
+      objcmoduleflag.addvalue(tai_simpletypedconst.create(s32inttype,tai_const.Create_32bit(objcabiversion)));
+      llvmmoduleflags.addvalue(llvm_getmetadatareftypedconst(objcmoduleflag));
+      current_asmdata.AsmLists[al_rotypedconsts].Concat(objcmoduleflag);
+
+      { image info version }
+      objcmoduleflag:=tai_llvmunnamedmetadatanode.create;
+      objcmoduleflag.addvalue(tai_simpletypedconst.create(s32inttype,tai_const.Create_32bit(1)));
+      objcmoduleflag.addvalue(tai_simpletypedconst.create(charpointertype,tai_string.Create('Objective-C Image Info Version')));
+      objcmoduleflag.addvalue(tai_simpletypedconst.create(s32inttype,tai_const.Create_32bit(0)));
+      llvmmoduleflags.addvalue(llvm_getmetadatareftypedconst(objcmoduleflag));
+      current_asmdata.AsmLists[al_rotypedconsts].Concat(objcmoduleflag);
+
+      { image info section }
+      objcmoduleflag:=tai_llvmunnamedmetadatanode.create;
+      objcmoduleflag.addvalue(tai_simpletypedconst.create(s32inttype,tai_const.Create_32bit(1)));
+      objcmoduleflag.addvalue(tai_simpletypedconst.create(charpointertype,tai_string.Create('Objective-C Image Info Section')));
+      objcmoduleflag.addvalue(tai_simpletypedconst.create(charpointertype,tai_string.Create(objc_section_name(sec_objc_image_info))));
+      llvmmoduleflags.addvalue(llvm_getmetadatareftypedconst(objcmoduleflag));
+      current_asmdata.AsmLists[al_rotypedconsts].Concat(objcmoduleflag);
+
+      { garbage collection }
+      objcmoduleflag:=tai_llvmunnamedmetadatanode.create;
+      objcmoduleflag.addvalue(tai_simpletypedconst.create(s32inttype,tai_const.Create_32bit(1)));
+      objcmoduleflag.addvalue(tai_simpletypedconst.create(charpointertype,tai_string.Create('Objective-C Garbage Collection')));
+      objcmoduleflag.addvalue(tai_simpletypedconst.create(s32inttype,tai_const.Create_32bit(0)));
+      llvmmoduleflags.addvalue(llvm_getmetadatareftypedconst(objcmoduleflag));
+      current_asmdata.AsmLists[al_rotypedconsts].Concat(objcmoduleflag);
+    end;
+
+
+  class procedure tllvmnodeutils.RegisterModuleInitFunction(pd: tprocdef);
+    begin
+      current_module.llvminitprocs.add(pd);
+    end;
+
+
+  class procedure tllvmnodeutils.RegisterModuleFiniFunction(pd: tprocdef);
+    begin
+      current_module.llvmfiniprocs.add(pd);
+    end;
+
+
 begin
   cnodeutils:=tllvmnodeutils;
 end.

compiler/llvm/rgllvm.pas

@@ -118,7 +118,7 @@ implementation
 
     function trgllvm.instr_get_oper_spilling_info(var regs: tspillregsinfo; const r: tsuperregisterset; instr: tai_cpu_abstract_sym; opidx: longint): boolean;
       var
-        i, paracnt: longint;
+        paracnt: longint;
         callpara: pllvmcallpara;
       begin
         result:=false;
@@ -130,10 +130,10 @@ implementation
                   for paracnt:=0 to paras.count-1 do
                     begin
                       callpara:=pllvmcallpara(paras[paracnt]);
-                      if (callpara^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER]) and
-                         (getregtype(callpara^.reg)=regtype) then
+                      if (callpara^.typ=top_reg) and
+                         (getregtype(callpara^.register)=regtype) then
                         begin
-                          result:=addreginfo(regs,r,callpara^.reg,operand_read) or result;
+                          result:=addreginfo(regs,r,callpara^.register,operand_read) or result;
                           break
                         end;
                     end;
@@ -157,9 +157,9 @@ implementation
                 for paracnt:=0 to paras.count-1 do
                   begin
                     callpara:=pllvmcallpara(paras[paracnt]);
-                    if (callpara^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER]) and
-                       (getregtype(callpara^.reg)=regtype) then
-                      try_replace_reg(regs, callpara^.reg,true);
+                    if (callpara^.typ=top_reg) and
+                       (getregtype(callpara^.register)=regtype) then
+                      try_replace_reg(regs, callpara^.register,true);
                   end;
               end;
             else
@@ -242,9 +242,9 @@ implementation
                   for paracnt:=0 to taillvm(supstart).oper[i]^.paras.count-1 do
                     begin
                       callpara:=pllvmcallpara(taillvm(supstart).oper[i]^.paras[paracnt]);
-                      if (callpara^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER]) and
-                         (getregtype(callpara^.reg)=regtype) and
-                         (getsupreg(callpara^.reg)=supreg) then
+                      if (callpara^.typ=top_reg) and
+                         (getregtype(callpara^.register)=regtype) and
+                         (getsupreg(callpara^.register)=supreg) then
                         begin
                           def:=callpara^.def;
                           break

compiler/llvm/tgllvm.pas

@@ -217,6 +217,11 @@ implementation
 
 
 begin
+  if not assigned(tgobjclass) then
+    begin
+      writeln('Internalerror 2018052004');
+      halt(1);
+    end;
   orgtgclass:=tgobjclass;
   tgobjclass:=ttgllvm;
 end.

compiler/m68k/cpubase.pas

@@ -370,6 +370,7 @@ unit cpubase;
     function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
     function dwarf_reg(r:tregister):shortint;
     function dwarf_reg_no_error(r:tregister):shortint;
+    function eh_return_data_regno(nr: longint): longint;
 
     function isvalue8bit(val: tcgint): boolean;
     function isvalue16bit(val: tcgint): boolean;
@@ -600,6 +601,11 @@ implementation
         result:=regdwarf_table[findreg_by_number(r)];
       end;
 
+    function eh_return_data_regno(nr: longint): longint;
+      begin
+        result:=-1;
+      end;
+
     { returns true if given value fits to an 8bit signed integer }
     function isvalue8bit(val: tcgint): boolean;
       begin

compiler/m68k/hlcgcpu.pas

@@ -47,8 +47,6 @@ interface
       procedure gen_load_loc_function_result(list: TAsmList; vardef: tdef; const l: tlocation);override;
     end;
 
-  procedure create_hlcodegen;
-
 implementation
 
   uses
@@ -264,7 +262,7 @@ implementation
     end;
 
 
-  procedure create_hlcodegen;
+  procedure create_hlcodegen_cpu;
     begin
       hlcg:=thlcgcpu.create;
       create_codegen;
@@ -272,4 +270,5 @@ implementation
 
 begin
   chlcgobj:=thlcgcpu;
+  create_hlcodegen:=@create_hlcodegen_cpu;
 end.

compiler/mips/cpubase.pas

@@ -271,6 +271,7 @@ unit cpubase;
     function std_regname(r:Tregister):string;
     function dwarf_reg(r:tregister):shortint;
     function dwarf_reg_no_error(r:tregister):shortint;
+    function eh_return_data_regno(nr: longint): longint;
 
   implementation
 
@@ -425,5 +426,15 @@ unit cpubase;
         end;
         result:=regdwarf_table[findreg_by_number(r)];
       end;
+
+    function eh_return_data_regno(nr: longint): longint;
+      begin
+        if (nr>=0) and (nr<2) then
+          result:=nr+4
+        else
+          result:=-1;
+      end;
+
+
 begin
 end.

compiler/mips/hlcgcpu.pas

@@ -46,8 +46,6 @@ uses
       procedure a_jmp_external_name(list: TAsmList; const externalname: TSymStr);override;
   end;
 
-  procedure create_hlcodegen;
-
 implementation
 
   uses
@@ -277,7 +275,7 @@ implementation
   end;
 
 
-  procedure create_hlcodegen;
+  procedure create_hlcodegen_cpu;
     begin
       hlcg:=thlcgmips.create;
       create_codegen;
@@ -285,4 +283,5 @@ implementation
 
 begin
   chlcgobj:=thlcgmips;
+  create_hlcodegen:=@create_hlcodegen_cpu;
 end.

compiler/msg/errore.msg

@@ -2758,15 +2758,15 @@ asmr_w_unable_to_determine_reference_size_using_byte=07101_W_No size specified a
 % the compiler is unable to determine what size (byte,word,dword,etc.) it
 % should use for the reference. This warning is only used in Delphi mode where
 % it falls back to use BYTE as default.
-asmr_w_no_direct_ebp_for_parameter=07102_W_Use of +offset(%ebp) for parameters invalid here
+asmr_w_no_direct_ebp_for_parameter=07102_W_Use of $1 for parameters invalid here
 % Using direct 8(%ebp) reference for function/procedure parameters is invalid
 % if parameters are in registers.
-asmr_w_direct_ebp_for_parameter_regcall=07103_W_Use of +offset(%ebp) is not compatible with regcall convention
+asmr_w_direct_ebp_for_parameter_regcall=07103_W_Use of $1 is not compatible with regcall convention
 % Using direct 8(%ebp) reference for function/procedure parameters is invalid
 % if parameters are in registers.
-asmr_w_direct_ebp_neg_offset=07104_W_Use of -offset(%ebp) is not recommended for local variable access
+asmr_w_direct_ebp_neg_offset=07104_W_Use of $1 is not recommended for local variable access
 % Using -8(%ebp) to access a local variable is not recommended
-asmr_w_direct_esp_neg_offset=07105_W_Use of -offset(%esp), access may cause a crash or value may be lost
+asmr_w_direct_esp_neg_offset=07105_W_Use of $1, access may cause a crash or value may be lost
 % Using -8(%esp) to access a local stack is not recommended, as
 % this stack portion can be overwritten by any function calls or interrupts.
 asmr_e_no_vmtoffset_possible=07106_E_VMTOffset must be used in combination with a virtual method, and "$1" is not virtual
@@ -3352,6 +3352,9 @@ cg_f_internal_type_does_not_match=10066_F_Internal type "$1" does not look as ex
 % and you didn't change the runtime library code, it's very likely that the runtime library
 % you're using doesn't match the compiler in use. If you changed the runtime library this error means
 % that you changed a type which the compiler needs for internal use and which needs to have a certain structure.
+unit_u_ppu_llvm_mismatch=10067_U_Skipping unit, PPU and compiler have to be both compiled with or without LLVM support
+% Units compiled by a compiler built with the LLVM code generator cannot be used with a regular compiler,
+% and vice versa.
 % \end{description}
 # EndOfTeX
 
@@ -3844,6 +3847,10 @@ S*2Aas_Assemble using GNU AS
 **2Ch<n>[,m]_<n> bytes min heap size (between 1023 and 67107840) and optionally [m] max heap size
 **2Ci_IO-checking
 A*2CI<x>_Select instruction set on ARM: ARM or THUMB
+L*2CL<x>_LLVM code generation options
+L*3CLflto_Enable Link-time optimisation (needed both when compiling units and programs/libraries)
+L*3CLfltonosystem_Disable LTO for the system unit (needed with at least Xcode 10.2 and earlier due to linker bugs)
+L*3CLv<x>_LLVM target version: 3.3, 3.4, .., Xcode-6.4, .., Xcode-10.1, 7.0, 8.0
 **2Cn_Omit linking stage
 P*2CN_Generate nil-pointer checks (AIX-only)
 **2Co_Check overflow of integer operations

compiler/msgidx.inc

@@ -1000,6 +1000,7 @@ const
   unit_u_loading_from_package=10064;
   cg_f_internal_type_not_found=10065;
   cg_f_internal_type_does_not_match=10066;
+  unit_u_ppu_llvm_mismatch=10067;
   option_usage=11000;
   option_only_one_source_support=11001;
   option_def_only_for_os2=11002;
@@ -1110,9 +1111,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 83042;
+  MsgTxtSize = 83424;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,106,351,126,99,61,142,34,221,67,
+    28,106,351,126,99,61,142,34,221,68,
     62,20,30,1,1,1,1,1,1,1
   );

compiler/nadd.pas

@@ -2126,7 +2126,8 @@ implementation
                  end;
                subn:
                  begin
-                    if (cs_extsyntax in current_settings.moduleswitches) then
+                    if (cs_extsyntax in current_settings.moduleswitches) or
+                       (nf_internal in flags) then
                       begin
                         if is_voidpointer(right.resultdef) then
                         begin
@@ -2440,7 +2441,7 @@ implementation
               begin
                 if (rt=niln) then
                   CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,'NIL');
-                if not(cs_extsyntax in current_settings.moduleswitches) or
+                if (not(cs_extsyntax in current_settings.moduleswitches) and not(nf_internal in flags))  or
                    (not (is_pchar(ld) or is_chararray(ld) or is_open_chararray(ld) or is_widechar(ld) or is_widechararray(ld) or is_open_widechararray(ld)) and
                     not(cs_pointermath in current_settings.localswitches) and
                     not((ld.typ=pointerdef) and tpointerdef(ld).has_pointer_math)) then
@@ -2473,7 +2474,7 @@ implementation
                begin
                  if (lt=niln) then
                    CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),'NIL',rd.typename);
-                 if not(cs_extsyntax in current_settings.moduleswitches) or
+                 if (not(cs_extsyntax in current_settings.moduleswitches) and not(nf_internal in flags)) or
                    (not (is_pchar(ld) or is_chararray(ld) or is_open_chararray(ld) or is_widechar(ld) or is_widechararray(ld) or is_open_widechararray(ld)) and
                     not(cs_pointermath in current_settings.localswitches) and
                     not((ld.typ=pointerdef) and tpointerdef(ld).has_pointer_math)) then

compiler/nbas.pas

@@ -37,6 +37,9 @@ interface
           constructor create;virtual;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeTree(var T: Text); override;
+{$endif DEBUG_NODE_XML}
        end;
        tnothingnodeclass = class of tnothingnode;
 
@@ -83,6 +86,9 @@ interface
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function docompare(p: tnode): boolean; override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
        end;
        tasmnodeclass = class of tasmnode;
 
@@ -224,6 +230,10 @@ interface
           procedure includetempflag(flag: ttempinfoflag); inline;
           procedure excludetempflag(flag: ttempinfoflag); inline;
           property tempflags: ttempinfoflags read gettempinfoflags write settempinfoflags;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
        end;
 
        { a node which will create a (non)persistent temp of a given type with a given  }
@@ -251,6 +261,9 @@ interface
           function pass_typecheck: tnode; override;
           function docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
         end;
        ttempcreatenodeclass = class of ttempcreatenode;
 
@@ -286,6 +299,9 @@ interface
           function docompare(p: tnode): boolean; override;
           destructor destroy; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
          protected
           release_to_normal : boolean;
         private
@@ -315,6 +331,8 @@ interface
        { if the complexity of n is "high", creates a reference temp to n's
          location and replace n with a ttemprefnode referring to that location }
        function maybereplacewithtempref(var n: tnode; var block: tblocknode; var stat: tstatementnode; size: ASizeInt; readonly: boolean): ttempcreatenode;
+       { same as above, but create a regular temp rather than reference temp }
+       function maybereplacewithtemp(var n: tnode; var block: tblocknode; var stat: tstatementnode; size: ASizeInt; allowreg: boolean): ttempcreatenode;
 
 implementation
 
@@ -324,6 +342,14 @@ implementation
       pass_1,
       nutils,nld,
       procinfo
+{$ifdef DEBUG_NODE_XML}
+{$ifndef jvm}
+      ,
+      cpubase,
+      cutils,
+      itcpugas
+{$endif jvm}
+{$endif DEBUG_NODE_XML}
       ;
 
 
@@ -371,6 +397,20 @@ implementation
           end;
       end;
 
+    function maybereplacewithtemp(var n: tnode; var block: tblocknode; var stat: tstatementnode; size: ASizeInt; allowreg: boolean): ttempcreatenode;
+      begin
+        result:=nil;
+        if node_complexity(n) > 4 then
+          begin
+            result:=ctempcreatenode.create_value(n.resultdef,size,tt_persistent,allowreg,n);
+            typecheckpass(tnode(result));
+            n:=ctemprefnode.create(result);
+            typecheckpass(n);
+            if not assigned(stat) then
+              block:=internalstatements(stat);
+            addstatement(stat,result)
+          end;
+      end;
 
 {*****************************************************************************
                              TFIRSTNOTHING
@@ -395,6 +435,15 @@ implementation
         expectloc:=LOC_VOID;
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TNothingNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        { "Nothing nodes" contain no data, so just use "/>" to terminate it early }
+        WriteLn(T, ' />');
+      end;
+{$endif DEBUG_NODE_XML}
 
 {*****************************************************************************
                              TFIRSTERROR
@@ -892,6 +941,159 @@ implementation
         docompare := false;
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TAsmNode.XMLPrintNodeData(var T: Text);
+
+      procedure PadString(var S: string; Len: Integer);
+        var
+          X, C: Integer;
+        begin
+          C := Length(S);
+          if C < Len then
+            begin
+              SetLength(S, 7);
+              for X := C + 1 to Len do
+                S[X] := ' '
+            end;
+        end;
+
+{$ifndef jvm}
+      function FormatOp(const Oper: POper): string;
+        begin
+          case Oper^.typ of
+            top_const:
+              begin
+                case Oper^.val of
+                  -15..15:
+                    Result := '$' + tostr(Oper^.val);
+                  $10..$FF:
+                    Result := '$0x' + hexstr(Oper^.val, 2);
+                  $100..$FFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 4);
+                  $10000..$FFFFFFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 8);
+                  else
+                    Result := '$0x' + hexstr(Oper^.val, 16);
+                end;
+              end;
+            top_reg:
+              Result := gas_regname(Oper^.reg);
+            top_ref:
+              with Oper^.ref^ do
+                begin
+{$if defined(x86)}
+                  if segment <> NR_NO then
+                    Result := gas_regname(segment) + ':'
+                  else
+                    Result := '';
+{$endif defined(x86)}
+
+                  if Assigned(symbol) then
+                    begin
+                      Result := Result + symbol.Name;
+                      if offset > 0 then
+                        Result := Result + '+';
+                    end;
+
+                  if offset <> 0 then
+                    Result := Result + tostr(offset)
+                  else
+                    Result := Result;
+
+                  if (base <> NR_NO) or (index <> NR_NO) then
+                    begin
+                      Result := Result + '(';
+
+                      if base <> NR_NO then
+                        begin
+                          Result := Result + gas_regname(base);
+                          if index <> NR_NO then
+                            Result := Result + ',';
+                        end;
+
+                      if index <> NR_NO then
+                        Result := Result + gas_regname(index);
+
+                      if scalefactor <> 0 then
+                        Result := Result + ',' + tostr(scalefactor) + ')'
+                      else
+                        Result := Result + ')';
+                    end;
+                end;
+            top_bool:
+              begin
+                if Oper^.b then
+                  Result := 'TRUE'
+                else
+                  Result := 'FALSE';
+              end
+            else
+              Result := '';
+          end;
+        end;
+
+{$if defined(x86)}
+      procedure ProcessInstruction(p: tai); inline;
+        var
+          ThisOp, ThisOper: string;
+          X: Integer;
+        begin
+          case p.typ of
+            ait_label:
+              WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name);
+
+            ait_instruction:
+              begin
+                ThisOp := gas_op2str[taicpu(p).opcode]+cond2str[taicpu(p).condition];
+                if gas_needsuffix[taicpu(p).opcode] <> AttSufNONE then
+                  ThisOp := ThisOp + gas_opsize2str[taicpu(p).opsize];
+
+                { Pad the opcode with spaces so the succeeding operands are aligned }
+                PadString(ThisOp, 7);
+
+                Write(T, PrintNodeIndention, '  ', ThisOp); { Extra indentation to account for label formatting }
+                for X := 0 to taicpu(p).ops - 1 do
+                  begin
+                    Write(T, ' ');
+
+                    ThisOper := FormatOp(taicpu(p).oper[X]);
+                    if X < taicpu(p).ops - 1 then
+                      begin
+                        ThisOper := ThisOper + ',';
+                        PadString(ThisOper, 7);
+                      end;
+
+                    Write(T, ThisOper);
+                  end;
+                WriteLn(T);
+              end;
+            else
+              { Do nothing };
+          end;
+        end;
+
+      var
+        hp: tai;
+      begin
+        if not Assigned(p_asm) then
+          Exit;
+
+        hp := tai(p_asm.First);
+        while Assigned(hp) do
+          begin
+            ProcessInstruction(hp);
+            hp := tai(hp.Next);
+          end;
+{$else defined(x86)}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
+{$endif defined(x86)}
+{$else jvm}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Should assembly language even be possible under JVM?)');
+{$endif jvm}
+      end;
+{$endif DEBUG_NODE_XML}
 
 {*****************************************************************************
                           TEMPBASENODE
@@ -939,6 +1141,47 @@ implementation
         settempinfoflags(gettempinfoflags-[flag])
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TTempBaseNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited XMLPrintNodeInfo(T);
+
+        { The raw pointer is the only way to uniquely identify the temp }
+        Write(T, ' id="', WritePointer(tempinfo), '"');
+      end;
+
+
+    procedure TTempBaseNode.XMLPrintNodeData(var T: Text);
+      var
+        Flag: TTempInfoFlag;
+        NotFirst: Boolean;
+      begin
+        inherited XMLPrintNodeData(t);
+
+        if not assigned(tempinfo) then
+          exit;
+
+        WriteLn(T, PrintNodeIndention, '<typedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</typedef>');
+
+        NotFirst := False;
+        for Flag := Low(TTempInfoFlag) to High(TTempInfoFlag) do
+          if (Flag in tempinfo^.flags) then
+            if not NotFirst then
+              begin
+                Write(T, PrintNodeIndention, '<tempflags>', Flag);
+                NotFirst := True;
+              end
+            else
+              Write(T, ',', Flag);
+
+        if NotFirst then
+          WriteLn(T, '</tempflags>')
+        else
+          WriteLn(T, PrintNodeIndention, '<tempflags />');
+
+        WriteLn(T, PrintNodeIndention, '<temptype>', tempinfo^.temptype, '</temptype>');
+      end;
+{$endif DEBUG_NODE_XML}
 
 {*****************************************************************************
                           TEMPCREATENODE
@@ -1136,6 +1379,24 @@ implementation
         printnode(t,tempinfo^.tempinitcode);
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
+        if Assigned(TempInfo^.TempInitCode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<tempinit>');
+            PrintNodeIndent;
+            XMLPrintNode(T, TempInfo^.TempInitCode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</tempinit>');
+          end
+        else
+          WriteLn(T, PrintNodeIndention, '<tempinit />');
+      end;
+{$endif DEBUG_NODE_XML}
+
 {*****************************************************************************
                              TEMPREFNODE
 *****************************************************************************}
@@ -1393,4 +1654,12 @@ implementation
           tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
+      end;
+{$endif DEBUG_NODE_XML}
+
 end.

compiler/ncal.pas

@@ -201,6 +201,9 @@ interface
        {$endif state_tracking}
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
           function  para_count:longint;
           function  required_para_count:longint;
           { checks if there are any parameters which end up at the stack, i.e.
@@ -1836,6 +1839,56 @@ implementation
            (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags)));
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TCallNode.XMLPrintNodeData(var T: Text);
+      begin
+        if assigned(procdefinition) and (procdefinition.typ=procdef) then
+          WriteLn(T, PrintNodeIndention, '<procname>', SanitiseXMLString(TProcDef(procdefinition).FullProcName(True)), '</procname>')
+        else
+          begin
+            if assigned(symtableprocentry) then
+              WriteLn(T, PrintNodeIndention, '<procname>', symtableprocentry.name, '</procname>')
+          end;
+
+        if assigned(methodpointer) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<methodpointer>');
+            PrintNodeIndent;
+            XMLPrintNode(T, methodpointer);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</methodpointer>');
+          end;
+
+        if assigned(funcretnode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<funcretnode>');
+            PrintNodeIndent;
+            XMLPrintNode(T, funcretnode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</funcretnode>');
+          end;
+
+        if assigned(callinitblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callinitblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callinitblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callinitblock>');
+          end;
+
+        if assigned(callcleanupblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callcleanupblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callcleanupblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callcleanupblock>');
+          end;
+
+        inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_XML}
 
     procedure tcallnode.printnodedata(var t:text);
       begin

compiler/ncgflw.pas

@@ -28,8 +28,10 @@ interface
 
     uses
       globtype,
-      aasmbase,aasmdata,nflw,
-      pass_2,cgutils,ncgutil;
+      symtype,symdef,
+      aasmbase,aasmdata,
+      node,nflw,
+      pass_2,cgbase,cgutils,ncgutil,cgexcept;
 
     type
        tcgwhilerepeatnode = class(twhilerepeatnode)
@@ -72,43 +74,27 @@ interface
        end;
 
        tcgraisenode = class(traisenode)
+         function pass_1: tnode;override;
+{$ifndef jvm}
+         procedure pass_generate_code;override;
+{$endif jvm}
        end;
 
-       { Utility class for exception handling state management that is used
-         by tryexcept/tryfinally/on nodes (in a separate class so it can both
-         be shared and overridden)
-
-         Never instantiated. }
-       tcgexceptionstatehandler = class
-         type
-           texceptiontemps=record
-             jmpbuf,
-             envbuf,
-             reasonbuf  : treference;
-           end;
-
-          texceptionstate = record
-            exceptionlabel: TAsmLabel;
-            oldflowcontrol,
-            newflowcontrol: tflowcontrol;
-          end;
-
-          class procedure get_exception_temps(list:TAsmList;var t:texceptiontemps); virtual;
-          class procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps); virtual;
-          class procedure new_exception(list:TAsmList;const t:texceptiontemps; out exceptstate: texceptionstate); virtual;
-          class procedure emit_except_label(list: TAsmList; var exceptstate: texceptionstate); virtual;
-          class procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean); virtual;
-          class procedure cleanupobjectstack; virtual;
-          class procedure handle_nested_exception(list:TAsmList;const t:texceptiontemps;var entrystate: texceptionstate); virtual;
-       end;
-       tcgexceptionstatehandlerclass = class of tcgexceptionstatehandler;
-
-
        tcgtryexceptnode = class(ttryexceptnode)
+        protected
+          type
+            tframetype = (ft_try,ft_except);
+
+          procedure emit_jump_out_of_try_except_frame(list: TasmList; frametype: tframetype; const exceptiontate: tcgexceptionstatehandler.texceptionstate; var excepttemps: tcgexceptionstatehandler.texceptiontemps; framelabel, outerlabel: tasmlabel); virtual;
+        public
           procedure pass_generate_code;override;
        end;
 
        tcgtryfinallynode = class(ttryfinallynode)
+        protected
+          procedure emit_jump_out_of_try_finally_frame(list: TasmList; const reason: byte; const finallycodelabel: tasmlabel; var excepttemps: tcgexceptionstatehandler.texceptiontemps; framelabel: tasmlabel);
+          function get_jump_out_of_try_finally_frame_label(const finallyexceptionstate: tcgexceptionstatehandler.texceptionstate): tasmlabel;
+        public
           procedure handle_safecall_exception;
           procedure pass_generate_code;override;
        end;
@@ -118,22 +104,21 @@ interface
        end;
 
 
-     var
-       cexceptionstatehandler: tcgexceptionstatehandlerclass;
-
 implementation
 
     uses
       cutils,
       verbose,globals,systems,
-      symconst,symdef,symsym,symtable,symtype,aasmtai,aasmcpu,defutil,
-      procinfo,cgbase,parabase,
+      symconst,symsym,symtable,aasmtai,aasmcpu,defutil,
+      procinfo,parabase,
       fmodule,
       cpubase,
       tgobj,paramgr,
       cgobj,hlcgobj,nutils
+{$ifndef jvm}
+      ,psabiehpi
+{$endif jvm}
       ;
-
 {*****************************************************************************
                          Second_While_RepeatN
 *****************************************************************************}
@@ -533,160 +518,6 @@ implementation
       end;
 
 
-{*****************************************************************************
-                     tcgexceptionstatehandler
-*****************************************************************************}
-
-    {  Allocate the buffers for exception management and setjmp environment.
-       Return a pointer to these buffers, send them to the utility routine
-       so they are registered, and then call setjmp.
-
-       Then compare the result of setjmp with 0, and if not equal
-       to zero, then jump to exceptlabel.
-
-       Also store the result of setjmp to a temporary space by calling g_save_exception_reason
-
-       It is to note that this routine may be called *after* the stackframe of a
-       routine has been called, therefore on machines where the stack cannot
-       be modified, all temps should be allocated on the heap instead of the
-       stack. }
-
-
-    class procedure tcgexceptionstatehandler.get_exception_temps(list:TAsmList;var t:texceptiontemps);
-     begin
-        tg.gethltemp(list,rec_exceptaddr,rec_exceptaddr.size,tt_persistent,t.envbuf);
-        tg.gethltemp(list,rec_jmp_buf,rec_jmp_buf.size,tt_persistent,t.jmpbuf);
-        tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
-      end;
-
-
-    class procedure tcgexceptionstatehandler.unget_exception_temps(list:TAsmList;const t:texceptiontemps);
-      begin
-        tg.Ungettemp(list,t.jmpbuf);
-        tg.ungettemp(list,t.envbuf);
-        tg.ungettemp(list,t.reasonbuf);
-      end;
-
-
-    class procedure tcgexceptionstatehandler.new_exception(list:TAsmList;const t:texceptiontemps; out exceptstate: texceptionstate);
-      var
-        paraloc1, paraloc2, paraloc3, pushexceptres, setjmpres: tcgpara;
-        pd: tprocdef;
-        tmpresloc: tlocation;
-      begin
-        current_asmdata.getjumplabel(exceptstate.exceptionlabel);
-        exceptstate.oldflowcontrol:=flowcontrol;
-
-        paraloc1.init;
-        paraloc2.init;
-        paraloc3.init;
-
-        { fpc_pushexceptaddr(exceptionframetype, setjmp_buffer, exception_address_chain_entry) }
-        pd:=search_system_proc('fpc_pushexceptaddr');
-        paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,1,paraloc1);
-        paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,2,paraloc2);
-        paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,3,paraloc3);
-        if pd.is_pushleftright then
-          begin
-            { type of exceptionframe }
-            hlcg.a_load_const_cgpara(list,paraloc1.def,1,paraloc1);
-            { setjmp buffer }
-            hlcg.a_loadaddr_ref_cgpara(list,rec_jmp_buf,t.jmpbuf,paraloc2);
-            { exception address chain entry }
-            hlcg.a_loadaddr_ref_cgpara(list,rec_exceptaddr,t.envbuf,paraloc3);
-          end
-        else
-          begin
-            hlcg.a_loadaddr_ref_cgpara(list,rec_exceptaddr,t.envbuf,paraloc3);
-            hlcg.a_loadaddr_ref_cgpara(list,rec_jmp_buf,t.jmpbuf,paraloc2);
-            hlcg.a_load_const_cgpara(list,paraloc1.def,1,paraloc1);
-          end;
-        paramanager.freecgpara(list,paraloc3);
-        paramanager.freecgpara(list,paraloc2);
-        paramanager.freecgpara(list,paraloc1);
-        { perform the fpc_pushexceptaddr call }
-        pushexceptres:=hlcg.g_call_system_proc(list,pd,[@paraloc1,@paraloc2,@paraloc3],nil);
-        paraloc1.done;
-        paraloc2.done;
-        paraloc3.done;
-
-        { get the result }
-        location_reset(tmpresloc,LOC_REGISTER,def_cgsize(pushexceptres.def));
-        tmpresloc.register:=hlcg.getaddressregister(list,pushexceptres.def);
-        hlcg.gen_load_cgpara_loc(list,pushexceptres.def,pushexceptres,tmpresloc,true);
-        pushexceptres.resetiftemp;
-
-        { fpc_setjmp(result_of_pushexceptaddr_call) }
-        pd:=search_system_proc('fpc_setjmp');
-        paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,1,paraloc1);
-
-        hlcg.a_load_reg_cgpara(list,pushexceptres.def,tmpresloc.register,paraloc1);
-        paramanager.freecgpara(list,paraloc1);
-        { perform the fpc_setjmp call }
-        setjmpres:=hlcg.g_call_system_proc(list,pd,[@paraloc1],nil);
-        paraloc1.done;
-        location_reset(tmpresloc,LOC_REGISTER,def_cgsize(setjmpres.def));
-        tmpresloc.register:=hlcg.getintregister(list,setjmpres.def);
-        hlcg.gen_load_cgpara_loc(list,setjmpres.def,setjmpres,tmpresloc,true);
-        hlcg.g_exception_reason_save(list,setjmpres.def,ossinttype,tmpresloc.register,t.reasonbuf);
-        { if we get 0 here in the function result register, it means that we
-          longjmp'd back here }
-        hlcg.a_cmp_const_reg_label(list,setjmpres.def,OC_NE,0,tmpresloc.register,exceptstate.exceptionlabel);
-        setjmpres.resetiftemp;
-
-        flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
-     end;
-
-
-    class procedure tcgexceptionstatehandler.emit_except_label(list: TAsmList; var exceptstate: texceptionstate);
-      begin
-        hlcg.a_label(list,exceptstate.exceptionlabel);
-        exceptstate.newflowcontrol:=flowcontrol;
-        flowcontrol:=exceptstate.oldflowcontrol;
-      end;
-
-
-    class procedure tcgexceptionstatehandler.free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
-      var
-        reasonreg: tregister;
-      begin
-         hlcg.g_call_system_proc(list,'fpc_popaddrstack',[],nil);
-         if not onlyfree then
-          begin
-            reasonreg:=hlcg.getintregister(list,osuinttype);
-            hlcg.g_exception_reason_load(list,osuinttype,osuinttype,t.reasonbuf,reasonreg);
-            hlcg.a_cmp_const_reg_label(list,osuinttype,OC_EQ,a,reasonreg,endexceptlabel);
-          end;
-      end;
-
-
-    { does the necessary things to clean up the object stack }
-    { in the except block                                    }
-    class procedure tcgexceptionstatehandler.cleanupobjectstack;
-      begin
-         hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_doneexception',[],nil);
-      end;
-
-    { generates code to be executed when another exeception is raised while
-      control is inside except block }
-    class procedure tcgexceptionstatehandler.handle_nested_exception(list:TAsmList;const t:texceptiontemps;var entrystate: texceptionstate);
-      var
-         exitlabel: tasmlabel;
-      begin
-         { don't generate line info for internal cleanup }
-         list.concat(tai_marker.create(mark_NoLineInfoStart));
-         current_asmdata.getjumplabel(exitlabel);
-         emit_except_label(current_asmdata.CurrAsmList,entrystate);
-         free_exception(list,t,0,exitlabel,false);
-         { we don't need to save/restore registers here because reraise never }
-         { returns                                                            }
-         hlcg.g_call_system_proc(list,'fpc_raise_nested',[],nil);
-         hlcg.a_label(list,exitlabel);
-         cleanupobjectstack;
-      end;
-
-
-
 {*****************************************************************************
                              SecondTryExcept
 *****************************************************************************}
@@ -694,6 +525,22 @@ implementation
     var
        endexceptlabel : tasmlabel;
 
+     { jump out of an try/except block }
+     procedure tcgtryexceptnode.emit_jump_out_of_try_except_frame(list: TasmList; frametype: tframetype; const exceptiontate: tcgexceptionstatehandler.texceptionstate; var excepttemps: tcgexceptionstatehandler.texceptiontemps; framelabel, outerlabel: tasmlabel);
+       begin
+          hlcg.a_label(list,framelabel);
+          { we must also destroy the address frame which guards
+            the exception object }
+          cexceptionstatehandler.popaddrstack(list);
+          hlcg.g_exception_reason_discard(list,osuinttype,excepttemps.reasonbuf);
+          if frametype=ft_except then
+            begin
+              cexceptionstatehandler.cleanupobjectstack(list);
+              cexceptionstatehandler.end_catch(list);
+            end;
+          hlcg.a_jmp_always(list,outerlabel);
+       end;
+
 
     procedure tcgtryexceptnode.pass_generate_code;
 
@@ -712,6 +559,7 @@ implementation
          destroytemps,
          excepttemps : tcgexceptionstatehandler.texceptiontemps;
          trystate,doobjectdestroyandreraisestate: tcgexceptionstatehandler.texceptionstate;
+         afteronflowcontrol: tflowcontrol;
       label
          errorexit;
       begin
@@ -750,7 +598,7 @@ implementation
          current_asmdata.getjumplabel(lastonlabel);
 
          cexceptionstatehandler.get_exception_temps(current_asmdata.CurrAsmList,excepttemps);
-         cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,trystate);
+         cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,tek_except,trystate);
 
          { try block }
          { set control flow labels for the try block }
@@ -768,9 +616,10 @@ implementation
          { don't generate line info for internal cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
 
-         cexceptionstatehandler.emit_except_label(current_asmdata.CurrAsmList,trystate);
+         cexceptionstatehandler.end_try_block(current_asmdata.CurrAsmList,tek_except,excepttemps,trystate,endexceptlabel);
 
-         cexceptionstatehandler.free_exception(current_asmdata.CurrAsmList, excepttemps, 0, endexceptlabel, false);
+         cexceptionstatehandler.emit_except_label(current_asmdata.CurrAsmList,tek_except,trystate,excepttemps);
+         cexceptionstatehandler.free_exception(current_asmdata.CurrAsmList, excepttemps, trystate, 0, endexceptlabel, false);
 
          { end cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
@@ -784,11 +633,13 @@ implementation
             current_procinfo.CurrBreakLabel:=breakexceptlabel;
           end;
 
-         flowcontrol:=[fc_inflowcontrol];
+         flowcontrol:=[fc_inflowcontrol]+trystate.oldflowcontrol*[fc_catching_exceptions];
          { on statements }
          if assigned(right) then
            secondpass(right);
 
+         afteronflowcontrol:=flowcontrol;
+
          { don't generate line info for internal cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
 
@@ -804,18 +655,22 @@ implementation
               { guarded by an exception frame, but it can be omitted }
               { if there's no user code in 'except' block            }
 
+              cexceptionstatehandler.catch_all_start(current_asmdata.CurrAsmList);
               if not (has_no_code(t1)) then
                begin
+                 { if there is an outer frame that catches exceptions, remember this for the "except"
+                   part of this try/except }
+                 flowcontrol:=trystate.oldflowcontrol*[fc_inflowcontrol,fc_catching_exceptions];
                  cexceptionstatehandler.get_exception_temps(current_asmdata.CurrAsmList,destroytemps);
-                 cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,destroytemps,doobjectdestroyandreraisestate);
+                 cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,destroytemps,tek_except,doobjectdestroyandreraisestate);
+                 cexceptionstatehandler.catch_all_add(current_asmdata.CurrAsmList);
                  { the flowcontrol from the default except-block must be merged
                    with the flowcontrol flags potentially set by the
                    on-statements handled above (secondpass(right)), as they are
                    at the same program level }
                  flowcontrol:=
                    flowcontrol+
-                   doobjectdestroyandreraisestate.oldflowcontrol;
-
+                   afteronflowcontrol;
 
                  { except block needs line info }
                  current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
@@ -825,79 +680,41 @@ implementation
                  cexceptionstatehandler.handle_nested_exception(current_asmdata.CurrAsmList,destroytemps,doobjectdestroyandreraisestate);
 
                  cexceptionstatehandler.unget_exception_temps(current_asmdata.CurrAsmList,destroytemps);
+                 cexceptionstatehandler.catch_all_end(current_asmdata.CurrAsmList);
                  hlcg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
                end
-               else
-                 begin
-                   doobjectdestroyandreraisestate.newflowcontrol:=flowcontrol;
-                   cexceptionstatehandler.cleanupobjectstack;
-                   hlcg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
-                 end;
+             else
+               begin
+                 doobjectdestroyandreraisestate.newflowcontrol:=afteronflowcontrol;
+                 cexceptionstatehandler.cleanupobjectstack(current_asmdata.CurrAsmList);
+                 cexceptionstatehandler.catch_all_end(current_asmdata.CurrAsmList);
+                 hlcg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
+               end;
            end
          else
            begin
-              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil);
-              doobjectdestroyandreraisestate.newflowcontrol:=flowcontrol;
+             cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,trystate,tek_except);
+             doobjectdestroyandreraisestate.newflowcontrol:=afteronflowcontrol;
            end;
 
          if fc_exit in doobjectdestroyandreraisestate.newflowcontrol then
-           begin
-              { do some magic for exit in the try block }
-              hlcg.a_label(current_asmdata.CurrAsmList,exitexceptlabel);
-              { we must also destroy the address frame which guards }
-              { exception object                                    }
-              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
-              hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
-              cexceptionstatehandler.cleanupobjectstack;
-              hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
-           end;
+           emit_jump_out_of_try_except_frame(current_asmdata.CurrAsmList,ft_except,doobjectdestroyandreraisestate,excepttemps,exitexceptlabel,oldCurrExitLabel);
 
          if fc_break in doobjectdestroyandreraisestate.newflowcontrol then
-           begin
-              hlcg.a_label(current_asmdata.CurrAsmList,breakexceptlabel);
-              { we must also destroy the address frame which guards }
-              { exception object                                    }
-              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
-              hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
-              cexceptionstatehandler.cleanupobjectstack;
-              hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
-           end;
+           emit_jump_out_of_try_except_frame(current_asmdata.CurrAsmList,ft_except,doobjectdestroyandreraisestate,excepttemps,breakexceptlabel,oldBreakLabel);
 
          if fc_continue in doobjectdestroyandreraisestate.newflowcontrol then
-           begin
-              hlcg.a_label(current_asmdata.CurrAsmList,continueexceptlabel);
-              { we must also destroy the address frame which guards }
-              { exception object                                    }
-              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
-              hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
-              cexceptionstatehandler.cleanupobjectstack;
-              hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
-           end;
+           emit_jump_out_of_try_except_frame(current_asmdata.CurrAsmList,ft_except,doobjectdestroyandreraisestate,excepttemps,continueexceptlabel,oldContinueLabel);
 
          if fc_exit in trystate.newflowcontrol then
-           begin
-              { do some magic for exit in the try block }
-              hlcg.a_label(current_asmdata.CurrAsmList,exittrylabel);
-              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
-              hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
-              hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
-           end;
+           emit_jump_out_of_try_except_frame(current_asmdata.CurrAsmList,ft_try,trystate,excepttemps,exittrylabel,oldCurrExitLabel);
 
          if fc_break in trystate.newflowcontrol then
-           begin
-              hlcg.a_label(current_asmdata.CurrAsmList,breaktrylabel);
-              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
-              hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
-              hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
-           end;
+          emit_jump_out_of_try_except_frame(current_asmdata.CurrAsmList,ft_try,trystate,excepttemps,breaktrylabel,oldBreakLabel);
 
          if fc_continue in trystate.newflowcontrol then
-           begin
-              hlcg.a_label(current_asmdata.CurrAsmList,continuetrylabel);
-              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
-              hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
-              hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
-           end;
+           emit_jump_out_of_try_except_frame(current_asmdata.CurrAsmList,ft_try,trystate,excepttemps,continuetrylabel,oldContinueLabel);
+
          cexceptionstatehandler.unget_exception_temps(current_asmdata.CurrAsmList,excepttemps);
          hlcg.a_label(current_asmdata.CurrAsmList,endexceptlabel);
 
@@ -933,16 +750,10 @@ implementation
          oldBreakLabel : tasmlabel;
          doobjectdestroyandreraisestate: tcgexceptionstatehandler.texceptionstate;
          excepttemps : tcgexceptionstatehandler.texceptiontemps;
-         href2: treference;
-         paraloc1 : tcgpara;
          exceptvarsym : tlocalvarsym;
-         pd : tprocdef;
-         fpc_catches_res: TCGPara;
-         fpc_catches_resloc: tlocation;
-         otherunit,
-         indirect : boolean;
+         exceptlocdef: tdef;
+         exceptlocreg: tregister;
       begin
-         paraloc1.init;
          location_reset(location,LOC_VOID,OS_NO);
          oldCurrExitLabel:=nil;
          continueonlabel:=nil;
@@ -951,27 +762,7 @@ implementation
 
          current_asmdata.getjumplabel(nextonlabel);
 
-         otherunit:=findunitsymtable(excepttype.owner).moduleid<>findunitsymtable(current_procinfo.procdef.owner).moduleid;
-         indirect:=(tf_supports_packages in target_info.flags) and
-                     (target_info.system in systems_indirect_var_imports) and
-                     (cs_imported_data in current_settings.localswitches) and
-                     otherunit;
-
-         { send the vmt parameter }
-         pd:=search_system_proc('fpc_catches');
-         reference_reset_symbol(href2,current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname,AT_DATA,indirect),0,sizeof(pint),[]);
-         if otherunit then
-           current_module.add_extern_asmsym(excepttype.vmt_mangledname,AB_EXTERNAL,AT_DATA);
-         paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,1,paraloc1);
-         hlcg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,excepttype.vmt_def,href2,paraloc1);
-         paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
-         fpc_catches_res:=hlcg.g_call_system_proc(current_asmdata.CurrAsmList,pd,[@paraloc1],nil);
-         location_reset(fpc_catches_resloc,LOC_REGISTER,def_cgsize(fpc_catches_res.def));
-         fpc_catches_resloc.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,fpc_catches_res.def);
-         hlcg.gen_load_cgpara_loc(current_asmdata.CurrAsmList,fpc_catches_res.def,fpc_catches_res,fpc_catches_resloc,true);
-
-         { is it this catch? No. go to next onlabel }
-         hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,fpc_catches_res.def,OC_EQ,0,fpc_catches_resloc.register,nextonlabel);
+         cexceptionstatehandler.begin_catch(current_asmdata.CurrAsmList,excepttype,nextonlabel,exceptlocdef,exceptlocreg);
 
          { Retrieve exception variable }
          if assigned(excepTSymtable) then
@@ -981,16 +772,15 @@ implementation
 
          if assigned(exceptvarsym) then
            begin
-             location_reset_ref(exceptvarsym.localloc,LOC_REFERENCE,def_cgsize(voidpointertype),voidpointertype.alignment,[]);
-             tg.GetLocal(current_asmdata.CurrAsmList,exceptvarsym.vardef.size,exceptvarsym.vardef,exceptvarsym.localloc.reference);
-             hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,fpc_catches_res.def,exceptvarsym.vardef,fpc_catches_resloc.register,exceptvarsym.localloc.reference);
+             location_reset_ref(exceptvarsym.localloc, LOC_REFERENCE, def_cgsize(voidpointertype), voidpointertype.alignment, []);
+             tg.GetLocal(current_asmdata.CurrAsmList, exceptvarsym.vardef.size, exceptvarsym.vardef, exceptvarsym.localloc.reference);
+             hlcg.a_load_reg_ref(current_asmdata.CurrAsmList, exceptlocdef, exceptvarsym.vardef, exceptlocreg, exceptvarsym.localloc.reference);
            end;
-
          { in the case that another exception is risen
-           we've to destroy the old one:
-           call setjmp, and jump to finally label on non-zero result }
+           we've to destroy the old one, so create a new
+           exception frame for the catch-handler }
          cexceptionstatehandler.get_exception_temps(current_asmdata.CurrAsmList,excepttemps);
-         cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,doobjectdestroyandreraisestate);
+         cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,tek_except,doobjectdestroyandreraisestate);
 
          oldBreakLabel:=nil;
          oldContinueLabel:=nil;
@@ -1020,6 +810,7 @@ implementation
              tg.UngetLocal(current_asmdata.CurrAsmList,exceptvarsym.localloc.reference);
              exceptvarsym.localloc.loc:=LOC_INVALID;
            end;
+         cexceptionstatehandler.end_catch(current_asmdata.CurrAsmList);
          hlcg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
 
          if assigned(right) then
@@ -1056,10 +847,11 @@ implementation
 
          cexceptionstatehandler.unget_exception_temps(current_asmdata.CurrAsmList,excepttemps);
          hlcg.a_label(current_asmdata.CurrAsmList,nextonlabel);
-         flowcontrol:=doobjectdestroyandreraisestate.oldflowcontrol+(doobjectdestroyandreraisestate.newflowcontrol-[fc_inflowcontrol,fc_catching_exceptions]);
-         paraloc1.done;
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
 
+         { propagate exit/break/continue }
+         flowcontrol:=doobjectdestroyandreraisestate.oldflowcontrol+(doobjectdestroyandreraisestate.newflowcontrol-[fc_inflowcontrol,fc_catching_exceptions]);
+
          { next on node }
          if assigned(left) then
            secondpass(left);
@@ -1069,6 +861,22 @@ implementation
                              SecondTryFinally
 *****************************************************************************}
 
+    { jump out of a finally block }
+    procedure tcgtryfinallynode.emit_jump_out_of_try_finally_frame(list: TasmList; const reason: byte; const finallycodelabel: tasmlabel; var excepttemps: tcgexceptionstatehandler.texceptiontemps; framelabel: tasmlabel);
+      begin
+         hlcg.a_label(list,framelabel);
+         hlcg.g_exception_reason_discard(list,osuinttype,excepttemps.reasonbuf);
+         hlcg.g_exception_reason_save_const(list,osuinttype,reason,excepttemps.reasonbuf);
+         hlcg.a_jmp_always(list,finallycodelabel);
+      end;
+
+
+    function tcgtryfinallynode.get_jump_out_of_try_finally_frame_label(const finallyexceptionstate: tcgexceptionstatehandler.texceptionstate): tasmlabel;
+      begin
+        current_asmdata.getjumplabel(result);
+      end;
+
+
     procedure tcgtryfinallynode.handle_safecall_exception;
       var
         cgpara: tcgpara;
@@ -1095,6 +903,7 @@ implementation
         cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_FUNCTION_RESULT_REG, NR_FUNCTION_RETURN_REG);
       end;
 
+
     procedure tcgtryfinallynode.pass_generate_code;
       var
          endfinallylabel,
@@ -1103,10 +912,37 @@ implementation
          breakfinallylabel,
          oldCurrExitLabel,
          oldContinueLabel,
-         oldBreakLabel : tasmlabel;
+         oldBreakLabel,
+         finallyNoExceptionLabel: tasmlabel;
          finallyexceptionstate: tcgexceptionstatehandler.texceptionstate;
          excepttemps : tcgexceptionstatehandler.texceptiontemps;
          reasonreg : tregister;
+         exceptframekind: tcgexceptionstatehandler.texceptframekind;
+         tmplist: TAsmList;
+
+        procedure handle_breakcontinueexit(const finallycode: tasmlabel; doreraise: boolean);
+          begin
+            { no exception happened, but maybe break/continue/exit }
+            hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
+            if fc_exit in finallyexceptionstate.newflowcontrol then
+              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,2,reasonreg,oldCurrExitLabel);
+            if fc_break in finallyexceptionstate.newflowcontrol then
+              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,3,reasonreg,oldBreakLabel);
+            if fc_continue in finallyexceptionstate.newflowcontrol then
+              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,4,reasonreg,oldContinueLabel);
+            if doreraise then
+              cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,tek_normalfinally)
+            else
+              hlcg.g_unreachable(current_asmdata.CurrAsmList);
+            { redirect break/continue/exit to the label above, with the reasonbuf set appropriately }
+            if fc_exit in finallyexceptionstate.newflowcontrol then
+              emit_jump_out_of_try_finally_frame(current_asmdata.CurrAsmList,2,finallycode,excepttemps,exitfinallylabel);
+            if fc_break in finallyexceptionstate.newflowcontrol then
+              emit_jump_out_of_try_finally_frame(current_asmdata.CurrAsmList,3,finallycode,excepttemps,breakfinallylabel);
+            if fc_continue in finallyexceptionstate.newflowcontrol then
+              emit_jump_out_of_try_finally_frame(current_asmdata.CurrAsmList,4,finallycode,excepttemps,continuefinallylabel);
+          end;
+
       begin
          location_reset(location,LOC_VOID,OS_NO);
          oldBreakLabel:=nil;
@@ -1114,34 +950,28 @@ implementation
          continuefinallylabel:=nil;
          breakfinallylabel:=nil;
 
+         if not implicitframe then
+           exceptframekind:=tek_normalfinally
+         else
+           exceptframekind:=tek_implicitfinally;
+
          current_asmdata.getjumplabel(endfinallylabel);
 
          { call setjmp, and jump to finally label on non-zero result }
          cexceptionstatehandler.get_exception_temps(current_asmdata.CurrAsmList,excepttemps);
-         cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate);
+         cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,exceptframekind,finallyexceptionstate);
 
          { the finally block must catch break, continue and exit }
          { statements                                            }
          oldCurrExitLabel:=current_procinfo.CurrExitLabel;
-         if implicitframe then
-           exitfinallylabel:=finallyexceptionstate.exceptionlabel
-         else
-           current_asmdata.getjumplabel(exitfinallylabel);
+         exitfinallylabel:=get_jump_out_of_try_finally_frame_label(finallyexceptionstate);
          current_procinfo.CurrExitLabel:=exitfinallylabel;
          if assigned(current_procinfo.CurrBreakLabel) then
           begin
             oldContinueLabel:=current_procinfo.CurrContinueLabel;
             oldBreakLabel:=current_procinfo.CurrBreakLabel;
-            if implicitframe then
-              begin
-                breakfinallylabel:=finallyexceptionstate.exceptionlabel;
-                continuefinallylabel:=finallyexceptionstate.exceptionlabel;
-              end
-            else
-              begin
-                current_asmdata.getjumplabel(breakfinallylabel);
-                current_asmdata.getjumplabel(continuefinallylabel);
-              end;
+            breakfinallylabel:=get_jump_out_of_try_finally_frame_label(finallyexceptionstate);
+            continuefinallylabel:=get_jump_out_of_try_finally_frame_label(finallyexceptionstate);
             current_procinfo.CurrContinueLabel:=continuefinallylabel;
             current_procinfo.CurrBreakLabel:=breakfinallylabel;
           end;
@@ -1157,9 +987,37 @@ implementation
          { don't generate line info for internal cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
 
-         cexceptionstatehandler.emit_except_label(current_asmdata.CurrAsmList,finallyexceptionstate);
+         cexceptionstatehandler.end_try_block(current_asmdata.CurrAsmList,exceptframekind,excepttemps,finallyexceptionstate,finallyexceptionstate.finallycodelabel);
+         if assigned(third) then
+           begin
+             tmplist:=TAsmList.create;
+             { emit the except label already (to a temporary list) to ensure that any calls in the
+               finally block refer to the outer exception frame rather than to the exception frame
+               that emits this same finally code in case an exception does happen }
+             cexceptionstatehandler.emit_except_label(tmplist,exceptframekind,finallyexceptionstate,excepttemps);
+
+             flowcontrol:=finallyexceptionstate.oldflowcontrol*[fc_inflowcontrol,fc_catching_exceptions];
+             current_asmdata.getjumplabel(finallyNoExceptionLabel);
+             hlcg.a_label(current_asmdata.CurrAsmList,finallyNoExceptionLabel);
+             if not implicitframe then
+               current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
+             secondpass(third);
+             if codegenerror then
+               exit;
+             if not implicitframe then
+               current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
+             reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,osuinttype);
+             hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,osuinttype,osuinttype,excepttemps.reasonbuf,reasonreg);
+             handle_breakcontinueexit(finallyNoExceptionLabel,false);
+
+             current_asmdata.CurrAsmList.concatList(tmplist);
+             tmplist.free;
+           end
+         else
+           cexceptionstatehandler.emit_except_label(current_asmdata.CurrAsmList,exceptframekind,finallyexceptionstate,excepttemps);
+
          { just free the frame information }
-         cexceptionstatehandler.free_exception(current_asmdata.CurrAsmList,excepttemps,1,finallyexceptionstate.exceptionlabel,true);
+         cexceptionstatehandler.free_exception(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,1,finallyexceptionstate.exceptionlabel,true);
 
          { end cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
@@ -1168,11 +1026,11 @@ implementation
            finally code is unconditionally executed; we do have to filter out
            flags regarding break/contrinue/etc. because we have to give an
            error in case one of those is used in the finally-code }
-         flowcontrol:=finallyexceptionstate.oldflowcontrol*[fc_inflowcontrol];
+         flowcontrol:=finallyexceptionstate.oldflowcontrol*[fc_inflowcontrol,fc_catching_exceptions];
          secondpass(right);
          { goto is allowed if it stays inside the finally block,
            this is checked using the exception block number }
-         if (flowcontrol-[fc_gotolabel])<>(finallyexceptionstate.oldflowcontrol*[fc_inflowcontrol]) then
+         if (flowcontrol-[fc_gotolabel])<>(finallyexceptionstate.oldflowcontrol*[fc_inflowcontrol,fc_catching_exceptions]) then
            CGMessage(cg_e_control_flow_outside_finally);
          if codegenerror then
            exit;
@@ -1180,53 +1038,52 @@ implementation
          { don't generate line info for internal cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
 
-         { the value should now be in the exception handler }
-         reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,osuinttype);
-         hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,osuinttype,osuinttype,excepttemps.reasonbuf,reasonreg);
-         if implicitframe then
+         { same level as before try, but this part is only executed if an exception occcurred
+           -> always fc_in_flowcontrol }
+         flowcontrol:=finallyexceptionstate.oldflowcontrol*[fc_catching_exceptions];
+         include(flowcontrol,fc_inflowcontrol);
+         if not assigned(third) then
            begin
-             hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
-             { finally code only needed to be executed on exception (-> in
-               if-branch -> fc_inflowcontrol) }
-             flowcontrol:=[fc_inflowcontrol];
-             if (tf_safecall_exceptions in target_info.flags) and
-                (current_procinfo.procdef.proccalloption=pocall_safecall) then
-               handle_safecall_exception
+             { the value should now be in the exception handler }
+             reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,osuinttype);
+             hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,osuinttype,osuinttype,excepttemps.reasonbuf,reasonreg);
+             if implicitframe then
+               begin
+                 hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
+                 { finally code only needed to be executed on exception (-> in
+                   if-branch -> fc_inflowcontrol) }
+                 if (tf_safecall_exceptions in target_info.flags) and
+                    (current_procinfo.procdef.proccalloption=pocall_safecall) then
+                   begin
+                     handle_safecall_exception;
+                     { we have to jump immediatly as we have to return the value of FPC_SAFECALL }
+                     hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
+                   end
+                 else
+                   cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,exceptframekind);
+                 { we have to load 0 into the execepttemp, else the program thinks an exception happended }
+                 emit_jump_out_of_try_finally_frame(current_asmdata.CurrAsmList,0,finallyexceptionstate.exceptionlabel,excepttemps,exitfinallylabel);
+               end
              else
-                hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil);
+               begin
+                 handle_breakcontinueexit(finallyexceptionstate.exceptionlabel,true);
+               end;
            end
          else
            begin
-             hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
-             if fc_exit in finallyexceptionstate.newflowcontrol then
-               hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,2,reasonreg,oldCurrExitLabel);
-             if fc_break in finallyexceptionstate.newflowcontrol then
-               hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,3,reasonreg,oldBreakLabel);
-             if fc_continue in finallyexceptionstate.newflowcontrol then
-               hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,4,reasonreg,oldContinueLabel);
-             hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil);
-             { do some magic for exit,break,continue in the try block }
-             if fc_exit in finallyexceptionstate.newflowcontrol then
+             if implicitframe then
                begin
-                  hlcg.a_label(current_asmdata.CurrAsmList,exitfinallylabel);
-                  hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
-                  hlcg.g_exception_reason_save_const(current_asmdata.CurrAsmList,osuinttype,2,excepttemps.reasonbuf);
-                  hlcg.a_jmp_always(current_asmdata.CurrAsmList,finallyexceptionstate.exceptionlabel);
-               end;
-             if fc_break in finallyexceptionstate.newflowcontrol then
-              begin
-                 hlcg.a_label(current_asmdata.CurrAsmList,breakfinallylabel);
-                 hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
-                 hlcg.g_exception_reason_save_const(current_asmdata.CurrAsmList,osuinttype,3,excepttemps.reasonbuf);
-                 hlcg.a_jmp_always(current_asmdata.CurrAsmList,finallyexceptionstate.exceptionlabel);
-               end;
-             if fc_continue in finallyexceptionstate.newflowcontrol then
+                 if (tf_safecall_exceptions in target_info.flags) and
+                    (current_procinfo.procdef.proccalloption=pocall_safecall) then
+                   handle_safecall_exception
+                 else
+                   cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,exceptframekind);
+               end
+             else
                begin
-                  hlcg.a_label(current_asmdata.CurrAsmList,continuefinallylabel);
-                  hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
-                  hlcg.g_exception_reason_save_const(current_asmdata.CurrAsmList,osuinttype,4,excepttemps.reasonbuf);
-                  hlcg.a_jmp_always(current_asmdata.CurrAsmList,finallyexceptionstate.exceptionlabel);
+                 cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,exceptframekind);
                end;
+
            end;
          cexceptionstatehandler.unget_exception_temps(current_asmdata.CurrAsmList,excepttemps);
          hlcg.a_label(current_asmdata.CurrAsmList,endfinallylabel);
@@ -1244,6 +1101,67 @@ implementation
       end;
 
 
+    function tcgraisenode.pass_1: tnode;
+      begin
+        if not(tf_use_psabieh in target_info.flags) or assigned(left) then
+          result:=inherited
+        else
+          begin
+            expectloc:=LOC_VOID;
+            result:=nil;
+          end;
+      end;
+
+{$ifndef jvm}
+    { has to be factored out as well }
+    procedure tcgraisenode.pass_generate_code;
+      var
+        CurrentLandingPad, CurrentAction, ReRaiseLandingPad: TPSABIEHAction;
+        psabiehprocinfo: tpsabiehprocinfo;
+      begin
+        if not(tf_use_psabieh in target_info.flags) then
+          Internalerror(2019021701);
+
+        location_reset(location,LOC_VOID,OS_NO);
+        CurrentLandingPad:=nil;
+        CurrentAction:=nil;
+        ReRaiseLandingPad:=nil;
+        psabiehprocinfo:=current_procinfo as tpsabiehprocinfo;
+        { a reraise must raise the exception to the parent exception frame }
+        if fc_catching_exceptions in flowcontrol then
+          begin
+            psabiehprocinfo.CreateNewPSABIEHCallsite(current_asmdata.CurrAsmList);
+            CurrentLandingPad:=psabiehprocinfo.CurrentLandingPad;
+            if psabiehprocinfo.PopLandingPad(CurrentLandingPad) then
+              exclude(flowcontrol,fc_catching_exceptions);
+            CurrentAction:=psabiehprocinfo.CurrentAction;
+            psabiehprocinfo.FinalizeAndPopAction(CurrentAction);
+
+            if not(fc_catching_exceptions in flowcontrol) then
+              begin
+                ReRaiseLandingPad:=psabiehprocinfo.NoAction;
+                psabiehprocinfo.PushAction(ReRaiseLandingPad);
+                psabiehprocinfo.PushLandingPad(ReRaiseLandingPad);
+              end;
+          end;
+        hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil).resetiftemp;
+        if assigned(CurrentLandingPad) then
+          begin
+            psabiehprocinfo.CreateNewPSABIEHCallsite(current_asmdata.CurrAsmList);
+            if not(fc_catching_exceptions in flowcontrol) then
+              begin
+                psabiehprocinfo.PopLandingPad(psabiehprocinfo.CurrentLandingPad);
+                psabiehprocinfo.PopAction(ReRaiseLandingPad);
+              end;
+
+            psabiehprocinfo.PushAction(CurrentAction);
+            psabiehprocinfo.PushLandingPad(CurrentLandingPad);
+            include(flowcontrol,fc_catching_exceptions);
+          end;
+      end;
+{$endif jvm}
+
+
 begin
    cwhilerepeatnode:=tcgwhilerepeatnode;
    cifnode:=tcgifnode;

compiler/ncgmem.pas

@@ -855,7 +855,9 @@ implementation
          paraloc2 : tcgpara;
          subsetref : tsubsetreference;
          temp : longint;
+         hreg : tregister;
          indexdef : tdef;
+         i : Integer;
       begin
          paraloc1.init;
          paraloc2.init;
@@ -936,19 +938,29 @@ implementation
            end
          else
            begin
-              { may happen in case of function results }
-              case left.location.loc of
-                LOC_CSUBSETREG,
-                LOC_CREGISTER,
-                LOC_CMMREGISTER,
-                LOC_SUBSETREG,
-                LOC_REGISTER,
-                LOC_MMREGISTER:
-                  hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef);
-                else
-                  ;
-              end;
-             location_copy(location,left.location);
+             { may happen in case of function results }
+             case left.location.loc of
+               LOC_CREGISTER,
+               LOC_REGISTER:
+                 begin
+                   if not(is_constnode(right)) or (tarraydef(left.resultdef).elementdef.size<>alusinttype.size) then
+                     hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef);
+                   { we use location here only to get the right offset }
+                   location_reset_ref(location,LOC_REFERENCE,OS_NO,1,[]);
+                 end;
+               LOC_CSUBSETREG,
+               LOC_CMMREGISTER,
+               LOC_SUBSETREG,
+               LOC_MMREGISTER:
+                 begin
+                   hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef);
+                   location_copy(location,left.location);
+                 end;
+               LOC_INVALID:
+                 Internalerror(2019061101);
+               else
+                 location_copy(location,left.location);
+             end;
            end;
 
          { location must be memory }
@@ -994,6 +1006,37 @@ implementation
                   update_reference_offset(location.reference,extraoffset,bytemulsize);
                   { adjust alignment after this change }
                   location.reference.alignment:=newalignment(location.reference.alignment,extraoffset*bytemulsize);
+
+                  { actually an array in a register? }
+                  if (left.location.loc in [LOC_CREGISTER,LOC_REGISTER]) and
+                    is_normal_array(left.resultdef) then
+                    begin
+{$if defined(cpu64bitalu)}
+                      hreg:=left.location.register;
+{$else defined(cpu64bitalu)}
+                      if target_info.endian=endian_little then
+                        begin
+                          if location.reference.offset>3 then
+                            hreg:=left.location.register64.reghi
+                          else
+                            hreg:=left.location.register64.reglo;
+                        end
+                      else
+                        begin
+                          if location.reference.offset>3 then
+                            hreg:=left.location.register64.reglo
+                          else
+                            hreg:=left.location.register64.reghi;
+                        end;
+{$endif defined(cpu64bitalu)}
+{$if defined(cpu8bitalu) or defined(cpu16bitalu)}
+                      { we support only the case that one element fills at least one register }
+                      for i:=1 to location.reference.offset mod 4 do
+                        hreg:=cg.GetNextReg(hreg);
+{$endif defined(cpu8bitalu) or defined(cpu16bitalu)}
+                      location_reset(location,left.location.loc,def_cgsize(tarraydef(left.resultdef).elementdef));
+                      location.register:=hreg;
+                    end;
                 end
               else
                 begin

compiler/ncgutil.pas

@@ -109,10 +109,6 @@ implementation
     dbgbase,
     nbas,ncon,nld,nmem,nutils,
     tgobj,cgobj,hlcgobj,hlcgcpu
-{$ifdef llvm}
-    { override create_hlcodegen from hlcgcpu }
-    , hlcgllvm
-{$endif}
 {$ifdef powerpc}
     , cpupi
 {$endif}
@@ -734,6 +730,12 @@ implementation
         { generate call frame marker for dwarf call frame info }
         current_asmdata.asmcfi.start_frame(list);
 
+        { labels etc. for exception frames are inserted here }
+        current_procinfo.start_eh(list);
+
+        if current_procinfo.procdef.proctypeoption=potype_proginit then
+          current_asmdata.asmcfi.outmost_frame(list);
+
         { All temps are know, write offsets used for information }
         if (cs_asm_source in current_settings.globalswitches) and
            (current_procinfo.tempstart<>tg.lasttemp) then
@@ -791,6 +793,9 @@ implementation
         { generate target specific proc exit code }
         hlcg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
 
+        { labels etc. for exception frames are inserted here }
+        current_procinfo.end_eh(list);
+
         { release return registers, needed for optimizer }
         if not is_void(current_procinfo.procdef.returndef) then
           paramanager.freecgpara(list,current_procinfo.procdef.funcretloc[calleeside]);

compiler/ncnv.pas

@@ -64,6 +64,9 @@ interface
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_XML}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function simplify(forinline : boolean):tnode; override;
@@ -1047,6 +1050,31 @@ implementation
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TTypeConvNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TTypeConvNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T,' convtype="', convtype);
+        First := True;
+        for i := Low(TTypeConvNodeFlag) to High(TTypeConvNodeFlag) do
+          if i in ConvNodeFlags then
+            begin
+              if First then
+                begin
+                  Write(T, '" convnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+           end;
+
+        { If no flags were printed, this is the closing " for convtype }
+        Write(T, '"');
+      end;
+{$endif DEBUG_NODE_XML}
 
     function ttypeconvnode.typecheck_cord_to_pointer : tnode;
 
@@ -1454,9 +1482,13 @@ implementation
              result:=cpointerconstnode.create(TConstPtrUInt(v.uvalue),resultdef)
            else
              begin
-               if is_currency(left.resultdef) and
-                  not(nf_internal in flags) then
-                 v:=v div 10000;
+               if is_currency(left.resultdef) then
+                 begin
+                  if not(nf_internal in flags) then
+                    v:=v div 10000;
+                 end
+               else if (resultdef.typ in [orddef,enumdef]) then
+                 adaptrange(resultdef,v,([nf_internal,nf_absolute]*flags)<>[],nf_explicit in flags);
                result:=cordconstnode.create(v,resultdef,false);
              end;
          end
@@ -3045,12 +3077,10 @@ implementation
                      end
                    else
                      begin
-                       { for constant values on absolute variables, swaping is required }
+                       { for constant values on absolute variables, swapping is required }
                        if (target_info.endian = endian_big) and (nf_absolute in flags) then
                          swap_const_value(tordconstnode(left).value,tordconstnode(left).resultdef.size);
-                       if not(nf_internal in flags) then
-                         testrange(resultdef,tordconstnode(left).value,(nf_explicit in flags)
-                                   or (nf_absolute in flags),false);
+                       adaptrange(resultdef,tordconstnode(left).value,([nf_internal,nf_absolute]*flags)<>[],nf_explicit in flags);
                        { swap value back, but according to new type }
                        if (target_info.endian = endian_big) and (nf_absolute in flags) then
                          swap_const_value(tordconstnode(left).value,resultdef.size);
@@ -3255,6 +3285,7 @@ implementation
 
       begin
          first_array_to_pointer:=nil;
+         make_not_regable(left,[ra_addr_regable]);
          expectloc:=LOC_REGISTER;
       end;
 

compiler/ncon.pas

@@ -48,6 +48,9 @@ interface
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
        end;
        trealconstnodeclass = class of trealconstnode;
 
@@ -70,6 +73,10 @@ interface
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
        end;
        tordconstnodeclass = class of tordconstnode;
 
@@ -87,6 +94,9 @@ interface
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t : text); override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
        end;
        tpointerconstnodeclass = class of tpointerconstnode;
 
@@ -124,6 +134,9 @@ interface
           { returns whether this platform uses the nil pointer to represent
             empty dynamic strings }
           class function emptydynstrnil: boolean; virtual;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
        end;
        tstringconstnodeclass = class of tstringconstnode;
 
@@ -494,6 +507,13 @@ implementation
         writeln(t,printnodeindention,'value = ',value_real);
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TRealConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', value_real, '</value>');
+      end;
+{$endif DEBUG_NODE_XML}
 
 {*****************************************************************************
                               TORDCONSTNODE
@@ -562,7 +582,7 @@ implementation
         { only do range checking when explicitly asked for it
           and if the type can be range checked, see tests/tbs/tb0539.pp }
         if (resultdef.typ in [orddef,enumdef]) then
-           testrange(resultdef,value,not rangecheck,false)
+          adaptrange(resultdef,value,nf_internal in flags, not rangecheck)
       end;
 
     function tordconstnode.pass_1 : tnode;
@@ -586,6 +606,20 @@ implementation
         writeln(t,printnodeindention,'value = ',tostr(value));
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T, ' rangecheck="', rangecheck, '"');
+      end;
+
+
+    procedure TOrdConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', tostr(value), '</value>');
+      end;
+{$endif DEBUG_NODE_XML}
 
 {*****************************************************************************
                             TPOINTERCONSTNODE
@@ -668,6 +702,13 @@ implementation
         writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<value>$', hexstr(PUInt(value),sizeof(PUInt)*2), '</value>');
+      end;
+{$endif DEBUG_NODE_XML}
 
 {*****************************************************************************
                              TSTRINGCONSTNODE
@@ -1031,6 +1072,52 @@ implementation
         result:=true;
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TStringConstNode.XMLPrintNodeData(var T: Text);
+      var
+        OutputStr: ansistring;
+      begin
+        inherited XMLPrintNodeData(T);
+        Write(T, printnodeindention, '<stringtype>');
+        case cst_type of
+        cst_conststring:
+          Write(T, 'conststring');
+        cst_shortstring:
+          Write(T, 'shortstring');
+        cst_longstring:
+          Write(T, 'longstring');
+        cst_ansistring:
+          Write(T, 'ansistring');
+        cst_widestring:
+          Write(T, 'widestring');
+        cst_unicodestring:
+          Write(T, 'unicodestring');
+        end;
+        WriteLn(T, '</stringtype>');
+        WriteLn(T, printnodeindention, '<length>', len, '</length>');
+
+        if len = 0 then
+          begin
+            WriteLn(T, printnodeindention, '<value />');
+            Exit;
+          end;
+
+        case cst_type of
+        cst_widestring, cst_unicodestring:
+          begin
+            { value_str is of type PCompilerWideString }
+            SetLength(OutputStr, len);
+            UnicodeToUtf8(PChar(OutputStr), PUnicodeChar(PCompilerWideString(value_str)^.data), len + 1); { +1 for the null terminator }
+          end;
+        else
+          OutputStr := ansistring(value_str);
+          SetLength(OutputStr, len);
+        end;
+
+        WriteLn(T, printnodeindention, '<value>', SanitiseXMLString(OutputStr), '</value>');
+      end;
+{$endif DEBUG_NODE_XML}
+
 {*****************************************************************************
                              TSETCONSTNODE
 *****************************************************************************}

compiler/nflw.pas

@@ -68,6 +68,10 @@ interface
           procedure derefimpl;override;
           procedure insertintolist(l : tnodelist);override;
           procedure printnodetree(var t:text);override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeTree(var T: Text); override;
+{$endif DEBUG_NODE_XML}
           function docompare(p: tnode): boolean; override;
        end;
 
@@ -189,7 +193,10 @@ interface
        end;
        ttryexceptnodeclass = class of ttryexceptnode;
 
-       ttryfinallynode = class(tbinarynode)
+       { the third node is to store a copy of the finally code for llvm:
+         it needs one copy to execute in case an exception occurs, and
+         one in case no exception occurs }
+       ttryfinallynode = class(ttertiarynode)
           implicitframe : boolean;
           constructor create(l,r:tnode);virtual;reintroduce;
           constructor create_implicit(l,r:tnode);virtual;
@@ -1049,6 +1056,119 @@ implementation
         writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TLoopFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
+
+        First := True;
+        for i := Low(TLoopFlag) to High(TLoopFlag) do
+          if i in loopflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' loopflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+
+    procedure TLoopNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        if Assigned(Left) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '<condition>');
+            PrintNodeIndent;
+            XMLPrintNode(T, Left);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '</condition>');
+          end;
+
+        if Assigned(Right) then
+          begin
+            case nodetype of
+              ifn:
+                WriteLn(T, PrintNodeIndention, '<then>');
+              forn:
+                WriteLn(T, PrintNodeIndention, '<first>');
+              else
+                WriteLn(T, PrintNodeIndention, '<right>');
+            end;
+            PrintNodeIndent;
+            XMLPrintNode(T, Right);
+            PrintNodeUnindent;
+            case nodetype of
+              ifn:
+                WriteLn(T, PrintNodeIndention, '</then>');
+              forn:
+                WriteLn(T, PrintNodeIndention, '</first>');
+              else
+                WriteLn(T, PrintNodeIndention, '</right>');
+            end;
+          end;
+
+        if Assigned(t1) then
+          begin
+            case nodetype of
+              ifn:
+                WriteLn(T, PrintNodeIndention, '<else>');
+              forn:
+                WriteLn(T, PrintNodeIndention, '<last>');
+              else
+                WriteLn(T, PrintNodeIndention, '<t1>');
+            end;
+            PrintNodeIndent;
+            XMLPrintNode(T, t1);
+            PrintNodeUnindent;
+            case nodetype of
+              ifn:
+                WriteLn(T, PrintNodeIndention, '</else>');
+              forn:
+                WriteLn(T, PrintNodeIndention, '</last>');
+              else
+                WriteLn(T, PrintNodeIndention, '</t1>');
+            end;
+          end;
+
+        if Assigned(t2) then
+          begin
+
+            if nodetype <> forn then
+              begin
+                WriteLn(T, PrintNodeIndention, '<loop>');
+                PrintNodeIndent;
+              end;
+
+            XMLPrintNode(T, t2);
+
+            if nodetype <> forn then
+              begin
+                PrintNodeUnindent;
+                WriteLn(T, PrintNodeIndention, '</loop>');
+              end;
+          end;
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_XML}
 
     function tloopnode.docompare(p: tnode): boolean;
       begin
@@ -2202,6 +2322,10 @@ implementation
                 current_addr:=clabelnode.create(cnothingnode.create,clabelsym.create('$raiseaddr'));
                 addstatement(statements,current_addr);
                 right:=caddrnode.create(cloadnode.create(current_addr.labsym,current_addr.labsym.owner));
+
+                { raise address off by one so we are for sure inside the action area for the raise }
+                if tf_use_psabieh in target_info.flags then
+                  right:=caddnode.create_internal(addn,right,cordconstnode.create(1,sizesinttype,false));
               end;
 
             raisenode:=ccallnode.createintern('fpc_raiseexception',
@@ -2288,14 +2412,16 @@ implementation
 
     constructor ttryfinallynode.create(l,r:tnode);
       begin
-        inherited create(tryfinallyn,l,r);
+        inherited create(tryfinallyn,l,r,nil);
+        third:=nil;
         implicitframe:=false;
       end;
 
 
     constructor ttryfinallynode.create_implicit(l,r:tnode);
       begin
-        inherited create(tryfinallyn,l,r);
+        inherited create(tryfinallyn,l,r,nil);
+        third:=nil;
         implicitframe:=true;
       end;
 
@@ -2312,6 +2438,12 @@ implementation
         typecheckpass(right);
         // "except block" is "used"? (JM)
         set_varstate(right,vs_readwritten,[vsf_must_be_valid]);
+
+        if assigned(third) then
+          begin
+            typecheckpass(third);
+            set_varstate(third,vs_readwritten,[vsf_must_be_valid]);
+          end;
       end;
 
 
@@ -2322,6 +2454,8 @@ implementation
         firstpass(left);
 
         firstpass(right);
+        if assigned(third) then
+          firstpass(third);
 
         include(current_procinfo.flags,pi_do_call);
 

compiler/ngenutil.pas

@@ -146,6 +146,8 @@ interface
       class procedure RegisterModuleInitFunction(pd: tprocdef); virtual;
       class procedure RegisterModuleFiniFunction(pd: tprocdef); virtual;
 
+      class procedure GenerateObjCImageInfo; virtual;
+
      strict protected
       class procedure add_main_procdef_paras(pd: tdef); virtual;
     end;
@@ -1580,6 +1582,26 @@ implementation
     end;
 
 
+  class procedure tnodeutils.GenerateObjCImageInfo;
+    var
+      tcb: ttai_typedconstbuilder;
+    begin
+      { first 4 bytes contain version information about this section (currently version 0),
+        next 4 bytes contain flags (currently only regarding whether the code in the object
+        file supports or requires garbage collection)
+      }
+      tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_no_dead_strip]);
+      tcb.emit_ord_const(0,u64inttype);
+      current_asmdata.asmlists[al_objc_data].concatList(
+        tcb.get_final_asmlist(
+          current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'_OBJC_IMAGE_INFO',AB_LOCAL,AT_DATA,u64inttype),
+          u64inttype,sec_objc_image_info,'_OBJC_IMAGE_INFO',sizeof(pint)
+        )
+      );
+      tcb.free;
+    end;
+
+
    class procedure tnodeutils.add_main_procdef_paras(pd: tdef);
      var
        pvs: tparavarsym;

compiler/ngtcon.pas

@@ -627,7 +627,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
              begin
                 if is_constboolnode(node) then
                   begin
-                    testrange(def,tordconstnode(node).value,false,false);
+                    adaptrange(def,tordconstnode(node).value,rc_default);
                     ftcb.emit_ord_const(tordconstnode(node).value.svalue,def)
                   end
                 else
@@ -661,7 +661,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
              begin
                 if is_constintnode(node) then
                   begin
-                    testrange(def,tordconstnode(node).value,false,false);
+                    adaptrange(def,tordconstnode(node).value,rc_default);
                     ftcb.emit_ord_const(tordconstnode(node).value.svalue,def);
                   end
                 else
@@ -1074,7 +1074,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
             if equal_defs(node.resultdef,def) or
                is_subequal(node.resultdef,def) then
               begin
-                testrange(def,tordconstnode(node).value,false,false);
+                adaptrange(def,tordconstnode(node).value,rc_default);
                 case longint(node.resultdef.size) of
                   1 : ftcb.emit_tai(Tai_const.Create_8bit(Byte(tordconstnode(node).value.svalue)),def);
                   2 : ftcb.emit_tai(Tai_const.Create_16bit(Word(tordconstnode(node).value.svalue)),def);

compiler/ninl.pas

@@ -36,6 +36,9 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeInfo(var t : text);override;
+{$endif DEBUG_NODE_XML}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function pass_typecheck_cpu:tnode;virtual;
@@ -85,6 +88,7 @@ interface
           function first_assigned: tnode; virtual;
           function first_assert: tnode; virtual;
           function first_popcnt: tnode; virtual;
+          function first_bitscan: tnode; virtual;
           { override these for Seg() support }
           function typecheck_seg: tnode; virtual;
           function first_seg: tnode; virtual;
@@ -127,7 +131,7 @@ implementation
       verbose,globals,systems,constexp,
       globtype,cutils,cclasses,fmodule,
       symconst,symdef,symsym,symcpu,symtable,paramgr,defcmp,defutil,symbase,
-      cpuinfo,
+      cpuinfo,cpubase,
       pass_1,
       ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,nutils,
       nobjc,objcdef,
@@ -191,6 +195,13 @@ implementation
         write(t,', inlinenumber = ',inlinenumber);
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited;
+        Write(T, ' inlinenumber="', inlinenumber, '"');
+      end;
+{$endif DEBUG_NODE_XML}
 
     function get_str_int_func(def: tdef): string;
     var
@@ -2298,7 +2309,14 @@ implementation
 {$else}
                      hp:=cpointerconstnode.create((vl2.uvalue shl 4)+vl.uvalue,voidpointertype);
 {$endif}
-                   end
+                   end;
+                 in_const_eh_return_data_regno:
+                   begin
+                     vl:=eh_return_data_regno(vl.svalue);
+                     if vl=-1 then
+                       CGMessagePos(left.fileinfo,type_e_range_check_error_bounds);
+                     hp:=genintconstnode(vl);
+                   end;
                  else
                    internalerror(88);
                end;
@@ -2497,13 +2515,14 @@ implementation
                         else
                           vl:=tordconstnode(left).value-1;
                         if is_integer(left.resultdef) then
-                        { the type of the original integer constant is irrelevant,
-                          it should be automatically adapted to the new value
-                          (except when inlining) }
+                          { the type of the original integer constant is irrelevant,
+                            it should be automatically adapted to the new value
+                            (except when inlining) }
                           result:=create_simplified_ord_const(vl,resultdef,forinline)
                         else
                           { check the range for enums, chars, booleans }
-                          result:=cordconstnode.create(vl,left.resultdef,not(nf_internal in flags))
+                          result:=cordconstnode.create(vl,left.resultdef,not(nf_internal in flags));
+                        result.flags:=result.flags+(flags*[nf_internal]);
                       end;
                     addn,
                     subn:
@@ -2849,9 +2868,9 @@ implementation
                  (index.left.nodetype = ordconstn) and
                  not is_special_array(unpackedarraydef) then
                 begin
-                  testrange(unpackedarraydef,tordconstnode(index.left).value,false,false);
+                  adaptrange(unpackedarraydef,tordconstnode(index.left).value,rc_default);
                   tempindex := tordconstnode(index.left).value + packedarraydef.highrange-packedarraydef.lowrange;
-                  testrange(unpackedarraydef,tempindex,false,false);
+                  adaptrange(unpackedarraydef,tempindex,rc_default);
                 end;
             end;
 
@@ -4072,10 +4091,11 @@ implementation
          in_rol_x,
          in_rol_x_y,
          in_ror_x,
-         in_ror_x_y,
+         in_ror_x_y:
+           expectloc:=LOC_REGISTER;
          in_bsf_x,
          in_bsr_x:
-           expectloc:=LOC_REGISTER;
+           result:=first_bitscan;
          in_sar_x,
          in_sar_x_y:
            result:=first_sar;
@@ -4712,6 +4732,12 @@ implementation
          left:=nil;
        end;
 
+     function tinlinenode.first_bitscan: tnode;
+       begin
+         result:=nil;
+         expectloc:=LOC_REGISTER;
+       end;
+
 
      function tinlinenode.typecheck_seg: tnode;
        begin

compiler/nld.pas

@@ -71,6 +71,9 @@ interface
           procedure mark_write;override;
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
           procedure setprocdef(p : tprocdef);
           property procdef: tprocdef read fprocdef write setprocdef;
        end;
@@ -97,6 +100,9 @@ interface
           function track_state_pass(exec_known:boolean):boolean;override;
        {$endif state_tracking}
           function docompare(p: tnode): boolean; override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
        end;
        tassignmentnodeclass = class of tassignmentnode;
 
@@ -471,6 +477,16 @@ implementation
         writeln(t,'');
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TLoadNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<symbol>', symtableentry.name, '</symbol>');
+
+        if symtableentry.typ = procsym then
+          WriteLn(T, printnodeindention, '<procdef>', fprocdef.mangledname, '</procdef>');
+      end;
+{$endif DEBUG_NODE_XML}
 
     procedure tloadnode.setprocdef(p : tprocdef);
       begin
@@ -956,6 +972,18 @@ implementation
 {$endif}
 
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TAssignmentNode.XMLPrintNodeData(var T: Text);
+      begin
+        { For assignments, put the left and right branches on the same level for clarity }
+        XMLPrintNode(T, Left);
+        XMLPrintNode(T, Right);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_XML}
+
+
 {*****************************************************************************
                            TARRAYCONSTRUCTORRANGENODE
 *****************************************************************************}

compiler/nmem.pas

@@ -88,6 +88,9 @@ interface
           procedure buildderefimpl;override;
           procedure derefimpl;override;
           procedure printnodeinfo(var t: text); override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_XML}
           function docompare(p: tnode): boolean; override;
           function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
@@ -121,6 +124,9 @@ interface
           function docompare(p: tnode): boolean; override;
           function pass_typecheck:tnode;override;
           procedure mark_write;override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
        end;
        tsubscriptnodeclass = class of tsubscriptnode;
 
@@ -133,6 +139,9 @@ interface
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           procedure mark_write;override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
        end;
        tvecnodeclass = class of tvecnode;
 
@@ -481,6 +490,29 @@ implementation
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TAddrNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TAddrNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(t);
+        First := True;
+        for i := Low(TAddrNodeFlag) to High(TAddrNodeFlag) do
+          if i in addrnodeflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' addrnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+{$endif DEBUG_NODE_XML}
 
     function taddrnode.docompare(p: tnode): boolean;
       begin
@@ -897,6 +929,13 @@ implementation
           (vs = tsubscriptnode(p).vs);
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TSubscriptNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<field>', vs.Name, '</field>');
+      end;
+{$endif DEBUG_NODE_XML}
 
 {*****************************************************************************
                                TVECNODE
@@ -1054,7 +1093,9 @@ implementation
            that has a field of one of these types -> in that case the record
            can't be a regvar either }
          if ((left.resultdef.typ=arraydef) and
-             not is_special_array(left.resultdef)) or
+             not is_special_array(left.resultdef) and
+             { arrays with elements equal to the alu size and with a constant index can be kept in register }
+             not(is_constnode(right) and (tarraydef(left.resultdef).elementdef.size=alusinttype.size))) or
             ((left.resultdef.typ=stringdef) and
              (tstringdef(left.resultdef).stringtype in [st_shortstring,st_longstring])) then
            make_not_regable(left,[ra_addr_regable]);
@@ -1297,6 +1338,24 @@ implementation
     end;
 
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TVecNode.XMLPrintNodeData(var T: Text);
+      begin
+        XMLPrintNode(T, Left);
+
+        { The right node is the index }
+        WriteLn(T, PrintNodeIndention, '<index>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Right);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</index>');
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_XML}
+
+
     function is_big_untyped_addrnode(p: tnode): boolean;
       begin
         is_big_untyped_addrnode:=(p.nodetype=addrn) and

compiler/node.pas

@@ -383,6 +383,15 @@ interface
          procedure printnodeinfo(var t:text);virtual;
          procedure printnodedata(var t:text);virtual;
          procedure printnodetree(var t:text);virtual;
+{$ifdef DEBUG_NODE_XML}
+         { For writing nodes to XML files - do not call directly, but
+           instead call XMLPrintNode to write a complete tree }
+         procedure XMLPrintNodeInfo(var T: Text); dynamic;
+         procedure XMLPrintNodeData(var T: Text); virtual;
+         procedure XMLPrintNodeTree(var T: Text); virtual;
+         class function SanitiseXMLString(const S: ansistring): ansistring; static;
+         class function WritePointer(const P: Pointer): ansistring; static;
+{$endif DEBUG_NODE_XML}
          procedure concattolist(l : tlinkedlist);virtual;
          function ischild(p : tnode) : boolean;virtual;
 
@@ -413,6 +422,9 @@ interface
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_XML}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
       end;
 
       //pbinarynode = ^tbinarynode;
@@ -431,6 +443,10 @@ interface
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_XML}
+         procedure XMLPrintNodeTree(var T: Text); override;
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
          procedure printnodelist(var t:text);
       end;
 
@@ -449,11 +465,17 @@ interface
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_XML}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
       end;
 
       tbinopnode = class(tbinarynode)
          constructor create(t:tnodetype;l,r : tnode);virtual;
          function docompare(p : tnode) : boolean;override;
+{$ifdef DEBUG_NODE_XML}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_XML}
       end;
 
     var
@@ -476,7 +498,9 @@ interface
     procedure printnodeunindent;
     procedure printnode(var t:text;n:tnode);
     procedure printnode(n:tnode);
-
+{$ifdef DEBUG_NODE_XML}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+{$endif DEBUG_NODE_XML}
     function is_constnode(p : tnode) : boolean;
     function is_constintnode(p : tnode) : boolean;
     function is_constcharnode(p : tnode) : boolean;
@@ -494,6 +518,9 @@ implementation
 
     uses
        verbose,entfile,comphook,
+{$ifdef DEBUG_NODE_XML}
+       cutils,
+{$endif DEBUG_NODE_XML}
        symconst,
        nutils,nflw,
        defutil;
@@ -656,6 +683,13 @@ implementation
         printnode(output,n);
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+      begin
+        if Assigned(N) then
+          N.XMLPrintNodeTree(T);
+      end;
+{$endif DEBUG_NODE_XML}
 
     function is_constnode(p : tnode) : boolean;
       begin
@@ -898,6 +932,354 @@ implementation
          writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    { For writing nodes to XML files - do not call directly, but
+      instead call XMLPrintNode to write a complete tree }
+    procedure tnode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TNodeFlag;
+        first: Boolean;
+      begin
+        if Assigned(resultdef) then
+          Write(T,' resultdef="', SanitiseXMLString(resultdef.typesymbolprettyname), '"');
+
+        Write(T,' pos="',fileinfo.line,',',fileinfo.column);
+
+        First := True;
+        for i := Low(TNodeFlag) to High(TNodeFlag) do
+          if i in flags then
+            begin
+              if First then
+                begin
+                  Write(T, '" flags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+
+        write(t,'" complexity="',node_complexity(self),'"');
+      end;
+
+    procedure tnode.XMLPrintNodeData(var T: Text);
+      begin
+        { Nothing by default }
+      end;
+
+    procedure tnode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+
+    class function TNode.WritePointer(const P: Pointer): ansistring;
+      begin
+        case PtrUInt(P) of
+          0:
+            WritePointer := 'nil';
+          1..$FFFF:
+            WritePointer := '$' + hexstr(PtrUInt(P), 4);
+          $10000..$FFFFFFFF:
+            WritePointer := '$' + hexstr(PtrUInt(P), 8);
+{$ifdef CPU64}
+          else
+            WritePointer := '$' + hexstr(PtrUInt(P), 16);
+{$endif CPU64}
+        end;
+      end;
+
+    class function TNode.SanitiseXMLString(const S: ansistring): ansistring;
+      var
+        X, UTF8Len, UTF8Char, CurrentChar: Integer;
+        needs_quoting, in_quotes, add_end_quote: Boolean;
+        DoASCII: Boolean;
+
+        { Write the given byte as #xxx }
+        procedure EncodeControlChar(Value: Byte);
+          begin
+            if X = Length(Result) then
+              add_end_quote := False;
+
+            Delete(Result, X, 1);
+            if in_quotes then
+              begin
+                Insert('#' + tostr(Value) + '''', Result, X);
+
+                { If the entire string consists of control characters, it
+                  doesn't need quoting, so only set the flag here }
+                needs_quoting := True;
+
+                in_quotes := False;
+              end
+            else
+              Insert('#' + tostr(Value), Result, X);
+          end;
+
+        { Write the given byte as either a plain character or an XML keyword }
+        procedure EncodeStandardChar(Value: Byte);
+          begin
+            if not in_quotes then
+              begin
+                in_quotes := True;
+                if (X < Length(Result)) then
+                  begin
+                    needs_quoting := True;
+                    Insert('''', Result, X + 1)
+                  end;
+              end;
+
+            { Check the character for anything that could be mistaken for an XML element }
+            case CurrentChar of
+              Ord('#'):
+                { Required to differentiate '#27' from the escape code #27, for example }
+                needs_quoting:=true;
+
+              Ord('<'):
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&lt;', Result, X);
+                end;
+              Ord('>'):
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&gt;', Result, X);
+                end;
+              Ord('&'):
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&amp;', Result, X);
+                end;
+              Ord('"'):
+                begin
+                  needs_quoting := True;
+                  Delete(Result, X, 1);
+                  Insert('&quot;', Result, X);
+                end;
+              Ord(''''):
+                begin
+                  needs_quoting:=true;
+                  { Simply double it like in pascal strings }
+                  Insert('''', Result, X);
+                end;
+              else
+                { Do nothing };
+            end;
+          end;
+
+        { Convert character between $80 and $FF to UTF-8 }
+        procedure EncodeExtendedChar(Value: Byte);
+          begin
+            if not in_quotes then
+              begin
+                in_quotes := True;
+                if (X < Length(Result)) then
+                  begin
+                    needs_quoting := True;
+                    Insert('''', Result, X + 1)
+                  end;
+              end;
+
+            case Value of
+              $80..$BF: { Add $C2 before the value }
+                Insert(#$C2, Result, X);
+              $C0..$FF: { Zero the $40 bit and add $C3 before the value }
+                begin
+                  Result[X] := Char(Byte(Result[X]) and $BF);
+                  Insert(#$C3, Result, X);
+                end;
+              else
+                { Previous conditions should prevent this procedure from being
+                  called if Value < $80 }
+                InternalError(2019061901);
+            end;
+          end;
+
+      begin
+        needs_quoting := False;
+        Result := S;
+
+        { Gets set to True if an invalid UTF-8 sequence is found }
+        DoASCII := False;
+
+        { By setting in_quotes to false here, we can exclude the single
+          quotation marks surrounding the string if it doesn't contain any
+          control characters, or consists entirely of control characters. }
+        in_quotes := False;
+
+        add_end_quote := True;
+
+        X := Length(Result);
+        while X > 0 do
+          begin
+            CurrentChar := Ord(Result[X]);
+
+            { Control characters and extended characters need special handling }
+            case CurrentChar of
+              $00..$1F, $7F:
+                EncodeControlChar(CurrentChar);
+
+              $20..$7E:
+                EncodeStandardChar(CurrentChar);
+
+              { UTF-8 continuation byte }
+              $80..$BF:
+                begin
+                  if not in_quotes then
+                    begin
+                      in_quotes := True;
+                      if (X < Length(Result)) then
+                        begin
+                          needs_quoting := True;
+                          Insert('''', Result, X + 1)
+                        end;
+                    end;
+
+                  UTF8Char := CurrentChar and $3F; { The data bits of the continuation byte }
+                  UTF8Len := 1; { This variable actually holds 1 less than the length }
+
+                  { By setting DoASCII to true, it marks the string as 'invalid UTF-8'
+                    automatically if it reaches the beginning of the string unexpectedly }
+                  DoASCII := True;
+
+                  Dec(X);
+                  while X > 0 do
+                    begin
+                      CurrentChar := Ord(Result[X]);
+
+                      case CurrentChar of
+                        { A standard character here is invalid UTF-8 }
+                        $00..$7F:
+                          Break;
+
+                        { Another continuation byte }
+                        $80..$BF:
+                          begin
+                            UTF8Char := UTF8Char or ((CurrentChar and $3F) shl (6 * UTF8Len));
+
+                            Inc(UTF8Len);
+                            if UTF8Len >= 4 then
+                              { Sequence too long }
+                              Break;
+                          end;
+
+                        { Lead byte for 2-byte sequences }
+                        $C2..$DF:
+                          begin
+                            if UTF8Len <> 1 then Break;
+
+                            UTF8Char := UTF8Char or ((CurrentChar and $1F) shl 6);
+
+                            { Check to see if the code is in range and not part of an 'overlong' sequence }
+                            case UTF8Char of
+                              $0080..$07FF:
+                                DoASCII := False;
+                              else
+                                { Do nothing - DoASCII is already true }
+                            end;
+                            Break;
+                          end;
+
+                        { Lead byte for 3-byte sequences }
+                        $E0..$EF:
+                          begin
+                            if UTF8Len <> 2 then Break;
+
+                            UTF8Char := UTF8Char or ((CurrentChar and $0F) shl 12);
+
+                            { Check to see if the code is in range and not part of an 'overlong' sequence }
+                            case UTF8Char of
+                              $0800..$D7FF, $E000..$FFFF: { $D800..$DFFF is reserved and hence invalid }
+                                DoASCII := False;
+                              else
+                                { Do nothing - DoASCII is already true }
+                            end;
+                            Break;
+                          end;
+
+                        { Lead byte for 4-byte sequences }
+                        $F0..$F4:
+                          begin
+                            if UTF8Len <> 3 then Break;
+
+                            UTF8Char := UTF8Char or ((CurrentChar and $07) shl 18);
+
+                            { Check to see if the code is in range and not part of an 'overlong' sequence }
+                            case UTF8Char of
+                              $010000..$10FFFF:
+                                DoASCII := False;
+                              else
+                                { Do nothing - DoASCII is already true }
+                            end;
+                            Break;
+                          end;
+
+                        { Invalid character }
+                        else
+                          Break;
+                      end;
+                    end;
+
+                  if DoASCII then
+                    Break;
+
+                  { If all is fine, we don't need to encode any more characters }
+                end;
+
+              { Invalid UTF-8 bytes and lead bytes without continuation bytes }
+              $C0..$FF:
+                begin
+                  DoASCII := True;
+                  Break;
+                end;
+            end;
+
+            Dec(X);
+          end;
+
+        { UTF-8 failed, so encode the string as plain ASCII }
+        if DoASCII then
+          begin
+            { Reset the flags and Result }
+            needs_quoting := False;
+            Result := S;
+            in_quotes := False;
+            add_end_quote := True;
+
+            for X := Length(Result) downto 1 do
+              begin
+                CurrentChar := Ord(Result[X]);
+
+                { Control characters and extended characters need special handling }
+                case CurrentChar of
+                  $00..$1F, $7F:
+                    EncodeControlChar(CurrentChar);
+
+                  $20..$7E:
+                    EncodeStandardChar(CurrentChar);
+
+                  { Extended characters }
+                  else
+                    EncodeExtendedChar(CurrentChar);
+
+                end;
+              end;
+          end;
+
+        if needs_quoting then
+          begin
+            if in_quotes then
+              Result := '''' + Result;
+
+            if add_end_quote then
+              Result := Result + '''';
+          end;
+      end;
+{$endif DEBUG_NODE_XML}
 
     function tnode.isequal(p : tnode) : boolean;
       begin
@@ -1058,6 +1440,13 @@ implementation
          printnode(t,left);
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TUnaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         inherited XMLPrintNodeData(T);
+         XMLPrintNode(T, Left);
+      end;
+{$endif DEBUG_NODE_XML}
 
     procedure tunarynode.concattolist(l : tlinkedlist);
       begin
@@ -1185,6 +1574,26 @@ implementation
          printnode(t,right);
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+      end;
+
+
+    procedure TBinaryNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+        { Right nodes are on the same indentation level }
+        XMLPrintNode(T, Right);
+      end;
+{$endif DEBUG_NODE_XML}
 
     procedure tbinarynode.printnodelist(var t:text);
       var
@@ -1286,6 +1695,21 @@ implementation
          printnode(t,third);
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         if Assigned(Third) then
+           begin
+             WriteLn(T, PrintNodeIndention, '<third-branch>');
+             PrintNodeIndent;
+             XMLPrintNode(T, Third);
+             PrintNodeUnindent;
+             WriteLn(T, PrintNodeIndention, '</third-branch>');
+           end;
+
+         inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_XML}
 
     procedure ttertiarynode.concattolist(l : tlinkedlist);
       begin
@@ -1320,6 +1744,18 @@ implementation
             right.isequal(tbinopnode(p).left));
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TBinOpNode.XMLPrintNodeData(var T: Text);
+      begin
+        { For binary operations, put the left and right branches on the same level for clarity }
+        XMLPrintNode(T, Left);
+        XMLPrintNode(T, Right);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_XML}
+
+
 begin
 {$push}{$warnings off}
   { tvaroption must fit into a 4 byte set for speed reasons }