* reintegrated debug_eh branch

   o the LLVM compiler is now functional for Darwin/x86-64, and also (but less
     tested) for Linux/x86-64, Linux/AArch64 and Linux/ARMHF. See
     https://wiki.freepascal.org/LLVM for details and the current state
   o Dwarf-eh-based "zero-cost" exceptions are available with the regular
     code generators for Linux/x86-64 and Linux/i386 if the compiler is
     compiled with -dpsabieh

git-svn-id: trunk@42260 -

.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
@@ -653,6 +659,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
@@ -9597,6 +9604,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

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
@@ -878,7 +881,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 +895,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 +979,12 @@ Implementation
       end;
 
 
+    function TExternalAssembler.RerunAssembler: boolean;
+      begin
+        result:=false;
+      end;
+
+
     procedure TExternalAssembler.WriteSourceLine(hp: tailineinfo);
       var
         module : tmodule;
@@ -1758,6 +1767,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 +2037,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/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/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/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/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/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/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/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

@@ -325,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,9 @@ 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}
 
         old_docrc:=ppufile.do_crc;
         ppufile.do_crc:=false;

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,8 @@ 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 }
        );
        tmoduleflags = set of tmoduleflag;
 
@@ -734,7 +739,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 +807,7 @@ interface
        link_static  = $2;
        link_smart   = $4;
        link_shared  = $8;
+       link_lto     = $10;
 
     type
       { a message state }

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;
 

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/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;
@@ -1099,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
@@ -1110,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;
@@ -1119,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;
@@ -1346,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 }
@@ -1564,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,
@@ -1652,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);
@@ -2029,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
@@ -2041,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

@@ -39,7 +39,8 @@ implementation
     tgllvm,hlcgllvm,
     nllvmadd,nllvmbas,nllvmcal,nllvmcnv,nllvmcon,nllvmflw,nllvminl,nllvmld,
     nllvmmat,nllvmmem,nllvmtcon,nllvmutil,
-    llvmpara,
-    symllvm;
+    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/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

@@ -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 = 82998;
+  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/msgtxt.inc

@@ -1,8 +1,8 @@
 const msgtxt_codepage=20127;
 {$ifdef Delphi}
-const msgtxt : array[0..000345] of string[240]=(
+const msgtxt : array[0..000347] of string[240]=(
 {$else Delphi}
-const msgtxt : array[0..000345,1..240] of char=(
+const msgtxt : array[0..000347,1..240] of char=(
 {$endif Delphi}
   '01000_T_Compiler: $1'#000+
   '01001_D_Compiler OS: $1'#000+
@@ -1214,167 +1214,170 @@ const msgtxt : array[0..000345,1..240] of char=(
   ' run time library.'#000+
   '10066_F_Internal type "$1" does not look as expected. Check if you use'+
   ' the correct run time library.'#000+
-  '11000_O_$1 [options] <inputfile> ','[options]'#000+
+  '10067_U_Skipping unit, PPU and co','mpiler have to be both compiled wit'+
+  'h or without LLVM support'#000+
+  '11000_O_$1 [options] <inputfile> [options]'#000+
   '11001_W_Only one source file supported, changing source file to compil'+
   'e from "$1" into "$2"'#000+
-  '11002_W_DEF file can be created only for OS/2'#000+
+  '11002_W_DEF file can be created only for OS/','2'#000+
   '11003_E_Nested response files are not supported'#000+
-  '11004_F_No source file name in command line'#000,
+  '11004_F_No source file name in command line'#000+
   '11005_N_No option inside $1 config file'#000+
   '11006_E_Illegal parameter: $1'#000+
   '11007_H_-? writes help pages'#000+
   '11008_F_Too many config files nested'#000+
-  '11009_F_Unable to open file $1'#000+
+  '11009_F_Un','able to open file $1'#000+
   '11010_D_Reading further options from $1'#000+
-  '11011_W_Target is already set to:',' $1'#000+
+  '11011_W_Target is already set to: $1'#000+
   '11012_W_Shared libs not supported on DOS platform, reverting to static'+
   #000+
   '11013_F_In options file $1 at line $2 too many #IF(N)DEFs encountered'#000+
-  '11014_F_In options file $1 at line $2 unexpected #ENDIFs encountered'#000+
-  '11015_F_Open conditional a','t the end of the options file'#000+
+  '1','1014_F_In options file $1 at line $2 unexpected #ENDIFs encountered'+
+  #000+
+  '11015_F_Open conditional at the end of the options file'#000+
   '11016_W_Debug information generation is not supported by this executab'+
   'le'#000+
   '11017_H_Try recompiling with -dGDB'#000+
-  '11018_W_You are using the obsolete switch $1'#000+
-  '11019_W_You are using the obsolete switch $1, please use ','$2'#000+
+  '11018_W_','You are using the obsolete switch $1'#000+
+  '11019_W_You are using the obsolete switch $1, please use $2'#000+
   '11020_N_Switching assembler to default source writing assembler'#000+
   '11021_W_Assembler output selected "$1" is not compatible with "$2"'#000+
-  '11022_W_"$1" assembler use forced'#000+
+  '11022_W_"$1"',' assembler use forced'#000+
   '11026_T_Reading options from file $1'#000+
-  '11027_T_Reading options from enviro','nment $1'#000+
+  '11027_T_Reading options from environment $1'#000+
   '11028_D_Handling option "$1"'#000+
   '11029_O_*** press enter ***'#000+
   '11030_H_Start of reading config file $1'#000+
   '11031_H_End of reading config file $1'#000+
-  '11032_D_Interpreting option "$1"'#000+
+  '11','032_D_Interpreting option "$1"'#000+
   '11036_D_Interpreting firstpass option "$1"'#000+
-  '11033_D_Interpreting',' file option "$1"'#000+
+  '11033_D_Interpreting file option "$1"'#000+
   '11034_D_Reading config file "$1"'#000+
   '11035_D_Found source file name "$1"'#000+
   '11039_E_Unknown codepage "$1"'#000+
-  '11040_F_Config file $1 is a directory'#000+
+  '11040_F_Config file $1 is a d','irectory'#000+
   '11041_W_Assembler output selected "$1" cannot generate debug info, deb'+
-  'ugging disabled',#000+
+  'ugging disabled'#000+
   '11042_W_Use of ppc386.cfg is deprecated, please use fpc.cfg instead'#000+
   '11043_F_In options file $1 at line $2 #ELSE directive without #IF(N)DE'+
-  'F found'#000+
+  'F found',#000+
   '11044_F_Option "$1" is not, or not yet, supported on the current targe'+
   't platform'#000+
-  '11045_F_The ','feature "$1" is not, or not yet, supported on the select'+
-  'ed target platform'#000+
+  '11045_F_The feature "$1" is not, or not yet, supported on the selected'+
+  ' target platform'#000+
   '11046_N_DWARF debug information cannot be used with smart linking on t'+
-  'his target, switching to static linking'#000+
-  '11047_W_Option "$1" is ignored for the current target p','latform.'#000+
+  'h','is target, switching to static linking'#000+
+  '11047_W_Option "$1" is ignored for the current target platform.'#000+
   '11048_W_Disabling external debug information because it is unsupported'+
   ' for the selected target/debug format combination.'#000+
-  '11049_N_DWARF debug information cannot be used with smart linking with'+
-  ' external assembler, disabling static li','brary creation.'#000+
+  '11049_N_DWARF de','bug information cannot be used with smart linking wi'+
+  'th external assembler, disabling static library creation.'#000+
   '11050_E_Invalid value for MACOSX_DEPLOYMENT_TARGET environment variabl'+
   'e: $1'#000+
-  '11051_E_Invalid value for IPHONEOS_DEPLOYMENT_TARGET environment varia'+
-  'ble: $1'#000+
-  '11052_E_You must use a FPU type of VFPV2, VFPV3 or VFPV3_D16 when usin',
+  '11051_E_Invalid value for IPHONEOS_DEPLOYMENT_TARGET e','nvironment var'+
+  'iable: $1'#000+
+  '11052_E_You must use a FPU type of VFPV2, VFPV3 or VFPV3_D16 when usin'+
   'g the EABIHF ABI target'#000+
   '11053_W_The selected debug format is not supported on the current targ'+
   'et, not changing the current setting'#000+
-  '11054_E_Argument to "$1" is missing'#000+
+  '11054_E_Argumen','t to "$1" is missing'#000+
   '11055_E_Malformed parameter: $1'#000+
-  '11056_W_Smart linking requires external l','inker'#000+
+  '11056_W_Smart linking requires external linker'#000+
   '11057_E_Creating .COM files is not supported in the current memory mod'+
   'el. Only the tiny memory model supports making .COM files.'#000+
-  '11058_W_Experimental CheckPointer option not enabled because it is inc'+
-  'omptatible with -Ur option.'#000+
-  '11059_E','_Unsupported target architecture -P$1, invoke the "fpc" compi'+
-  'ler driver instead.'#000+
-  '11060_E_Feature switches are only supported while compiling the system'+
-  ' unit.'#000+
+  '11058_W_Exp','erimental CheckPointer option not enabled because it is i'+
+  'ncomptatible with -Ur option.'#000+
+  '11059_E_Unsupported target architecture -P$1, invoke the "fpc" compile'+
+  'r driver instead.'#000+
+  '11060_E_Feature switches are only supported while compiling the s','yst'+
+  'em unit.'#000+
   '11061_N_The selected debug format is not supported by the internal lin'+
-  'ker, switchi','ng to external linking'#000+
+  'ker, switching to external linking'#000+
   '12000_F_Cannot open whole program optimization feedback file "$1"'#000+
-  '12001_D_Processing whole program optimization information in wpo feedb'+
-  'ack file "$1"'#000+
-  '12002_D_Finished processing the whole program optimization informat','i'+
-  'on in wpo feedback file "$1"'#000+
+  '12001_D_Processing whole program optimization information',' in wpo fee'+
+  'dback file "$1"'#000+
+  '12002_D_Finished processing the whole program optimization information'+
+  ' in wpo feedback file "$1"'#000+
   '12003_E_Expected section header, but got "$2" at line $1 of wpo feedba'+
   'ck file'#000+
-  '12004_W_No handler registered for whole program optimization section "'+
-  '$2" at line $1 of wpo feedback file, ignoring'#000+
-  '12005_D_Found wh','ole program optimization section "$1" with informati'+
-  'on about "$2"'#000+
+  '12004_W_No handler registered for whol','e program optimization section'+
+  ' "$2" at line $1 of wpo feedback file, ignoring'#000+
+  '12005_D_Found whole program optimization section "$1" with information'+
+  ' about "$2"'#000+
   '12006_F_The selected whole program optimizations require a previously '+
-  'generated feedback file (use -Fw to specify)'#000+
-  '12007_E_No collected information necessary to perform "$1" ','whole pro'+
-  'gram optimization found'#000+
+  'generated ','feedback file (use -Fw to specify)'#000+
+  '12007_E_No collected information necessary to perform "$1" whole progr'+
+  'am optimization found'#000+
   '12008_F_Specify a whole program optimization feedback file to store th'+
   'e generated info in (using -FW)'#000+
-  '12009_E_Not generating any whole program optimization information, yet'+
-  ' a feedback file was specified (usi','ng -FW)'#000+
+  '12009_E_Not',' generating any whole program optimization information, y'+
+  'et a feedback file was specified (using -FW)'#000+
   '12010_E_Not performing any whole program optimizations, yet an input f'+
   'eedback file was specified (using -Fw)'#000+
-  '12011_D_Skipping whole program optimization section "$1", because not '+
-  'needed by the requested optimizations'#000+
-  '12012_W_Overrid','ing previously read information for "$1" from feedbac'+
-  'k input file using information in section "$2"'#000+
-  '12013_E_Cannot extract symbol liveness information from program when s'+
-  'tripping symbols, use -Xs-'#000+
-  '12014_E_Cannot extract symbol liveness info','rmation from program when'+
-  ' when not linking'#000+
+  '12011_D_Skipping whole progra','m optimization section "$1", because no'+
+  't needed by the requested optimizations'#000+
+  '12012_W_Overriding previously read information for "$1" from feedback '+
+  'input file using information in section "$2"'#000+
+  '12013_E_Cannot extract symbol liveness informa','tion from program when'+
+  ' stripping symbols, use -Xs-'#000+
+  '12014_E_Cannot extract symbol liveness information from program when w'+
+  'hen not linking'#000+
   '12015_F_Cannot find "$1" or "$2" to extract symbol liveness informatio'+
   'n from linked program'#000+
-  '12016_E_Error during reading symbol liveness information produced by "'+
-  '$1"'#000+
-  '12017_F_Error executing "$1" (e','xitcode: $2) to extract symbol inform'+
-  'ation from linked program'#000+
+  '12016_E_Err','or during reading symbol liveness information produced by'+
+  ' "$1"'#000+
+  '12017_F_Error executing "$1" (exitcode: $2) to extract symbol informat'+
+  'ion from linked program'#000+
   '12018_E_Collection of symbol liveness information can only help when u'+
-  'sing smart linking, use -CX -XX'#000+
+  'sing smart li','nking, use -CX -XX'#000+
   '12019_E_Cannot create specified whole program optimisation feedback fi'+
-  'le "$','1"'#000+
+  'le "$1"'#000+
   '13001_F_Can'#039't find package $1'#000+
   '13002_U_PCP file for package $1 found'#000+
   '13003_E_Duplicate package $1'#000+
   '13004_E_Unit $1 can not be part of a package'#000+
-  '13005_N_Unit $1 is implicitely imported into package $2'#000+
-  '13006_F_Failed to create PCP file $2 fo','r package $1'#000+
+  '1','3005_N_Unit $1 is implicitely imported into package $2'#000+
+  '13006_F_Failed to create PCP file $2 for package $1'#000+
   '13007_F_Failed to read PCP file for package $1'#000+
   '13008_T_PCP loading $1'#000+
   '13009_U_PCP Name: $1'#000+
   '13010_U_PCP Flags: $1'#000+
-  '13011_U_PCP Crc: $1'#000+
+  '13011_U_PCP Crc: $1'#000,
   '13012_U_PCP Time: $1'#000+
   '13013_U_PCP File too short'#000+
-  '13014_U_PCP Invalid Header (no PCP at the begi','n)'#000+
+  '13014_U_PCP Invalid Header (no PCP at the begin)'#000+
   '13015_U_PCP Invalid Version $1'#000+
   '13016_U_PCP is compiled for another processor'#000+
   '13017_U_PCP is compiled for another target'#000+
   '13018_U_Writing $1'#000+
-  '13019_F_Can'#039't Write PCP-File'#000+
+  '1301','9_F_Can'#039't Write PCP-File'#000+
   '13020_F_Error reading PCP-File'#000+
   '13021_F_Unexpected end of PCP-File'#000+
-  '130','22_F_Invalid PCP-File entry: $1'#000+
+  '13022_F_Invalid PCP-File entry: $1'#000+
   '13023_U_Trying to use a unit which was compiled with a different FPU m'+
   'ode'#000+
   '13024_T_Packagesearch: $1'#000+
-  '13025_U_Required package $1'#000+
+  '13025_U_Requir','ed package $1'#000+
   '13026_U_Contained unit $1'#000+
   '13027_E_Unit $1 is already contained in package $2'#000+
-  '130','28_W_Unit $1 is imported from indirectly required package $2'#000+
+  '13028_W_Unit $1 is imported from indirectly required package $2'#000+
   '13029_U_PPL filename $1'#000+
-  '11023_Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPC'+
-  'CPU'#010+
+  '11023_Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE]',' for $F'+
+  'PCCPU'#010+
   'Copyright (c) 1993-2018 by Florian Klaempfl and others'#000+
-  '11024_Free Pascal Compiler',' version $FPCVERSION'#010+
+  '11024_Free Pascal Compiler version $FPCVERSION'#010+
   #010+
   'Compiler date      : $FPCDATE'#010+
   'Compiler CPU target: $FPCCPU'#010+
   #010+
   'Supported targets (targets marked with '#039'{*}'#039' are under develop'+
-  'ment):'#010+
+  'me','nt):'#010+
   '  $OSTARGETS'#010+
   #010+
   'Supported CPU instruction sets:'#010+
   '  $INSTRUCTIONSETS'#010+
   #010+
-  'Supported FPU instructi','on sets:'#010+
+  'Supported FPU instruction sets:'#010+
   '  $FPUINSTRUCTIONSETS'#010+
   #010+
   'Supported inline assembler modes:'#010+
@@ -1383,157 +1386,164 @@ const msgtxt : array[0..000345,1..240] of char=(
   'Recognized compiler and RTL features:'#010+
   '  $FEATURELIST'#010+
   #010+
-  'Supported ABI targets:'#010+
+  'Supported ABI',' targets:'#010+
   '  $ABITARGETS'#010+
   #010+
   'Supported Optimizations:'#010+
   '  $OPTIMIZATIONS'#010+
   #010+
-  'Supported Whole Program Op','timizations:'#010+
+  'Supported Whole Program Optimizations:'#010+
   '  All'#010+
   '  $WPOPTIMIZATIONS'#010+
   #010+
   'Supported Microcontroller types:$\n  $CONTROLLERTYPES$\n'#010+
-  'This program comes under the GNU General Public Licence'#010+
+  'This program comes under the GNU General Public Li','cence'#010+
   'For more information read COPYING.v2'#010+
   #010+
   'Please report bugs in our bug tracker on:'#010+
-  '        ','         http://bugs.freepascal.org'#010+
+  '                 http://bugs.freepascal.org'#010+
   #010+
   'More information may be found on our WWW pages (including directions'#010+
-  'for mailing lists useful for asking questions or discussing potential'#010+
+  'for mailing lists useful for asking ques','tions or discussing potentia'+
+  'l'#010+
   'new features, etc.):'#010+
-  '                 http://www.freepascal.org'#000,
+  '                 http://www.freepascal.org'#000+
   '11025_F*0*_Only options valid for the default or selected platform are'+
   ' listed.'#010+
-  '**0*_Put + after a boolean switch option to enable it, - to disable it'+
-  '.'#010+
+  '**0*_Put + after a boolean switch option to enable it, - to disable',' '+
+  'it.'#010+
   '**1@<x>_Read compiler options from <x> in addition to the default fpc.'+
   'cfg'#010+
-  '**1a_The compil','er does not delete the generated assembler file'#010+
+  '**1a_The compiler does not delete the generated assembler file'#010+
   '**2a5_Don'#039't generate Big Obj COFF files for GNU Binutils older tha'+
   'n 2.25 (Windows, NativeNT)'#010+
-  '**2al_List sourcecode lines in assembler file'#010+
-  '**2an_List node info in assembler file (-dEXTDEBUG co','mpiler)'#010+
+  '**2al','_List sourcecode lines in assembler file'#010+
+  '**2an_List node info in assembler file (-dEXTDEBUG compiler)'#010+
   '**2ao_Add an extra option to external assembler call (ignored for inte'+
   'rnal)'#010+
-  '*L2ap_Use pipes instead of creating temporary assembler files'#010+
+  '*L2ap_Use pipes instead of creating temporary assembler files'#010,
   '**2ar_List register allocation/release info in assembler file'#010+
-  '**2at_List temp allocation/relea','se info in assembler file'#010+
+  '**2at_List temp allocation/release info in assembler file'#010+
   '**1A<x>_Output format:'#010+
   '**2Adefault_Use default assembler'#010+
   '3*2Aas_Assemble using GNU AS'#010+
-  '3*2Amacho_Mach-O (Darwin, Intel 32 bit) using internal writer'#010+
+  '3*2Amacho_Mach-O (Darwin, Intel 32',' bit) using internal writer'#010+
   '8*2Anasm_Assemble using Nasm'#010+
   '8*2Anasmobj_Assemble using Nasm'#010+
-  '3*2An','asm_Assemble using Nasm'#010+
+  '3*2Anasm_Assemble using Nasm'#010+
   '3*2Anasmcoff_COFF (Go32v2) file using Nasm'#010+
   '3*2Anasmelf_ELF32 (Linux) file using Nasm'#010+
-  '3*2Anasmwin32_Win32 object file using Nasm'#010+
+  '3*2Anasmwin32_Win32 object file using',' Nasm'#010+
   '3*2Anasmwdosx_Win32/WDOSX object file using Nasm'#010+
-  '3*2Anasmdarwin_macho32 object file usin','g Nasm (experimental)'#010+
+  '3*2Anasmdarwin_macho32 object file using Nasm (experimental)'#010+
   '3*2Awasm_Obj file using Wasm (Watcom)'#010+
   '3*2Anasmobj_Obj file using Nasm'#010+
   '3*2Amasm_Obj file using Masm (Microsoft)'#010+
-  '3*2Atasm_Obj file using Tasm (Borland)'#010+
+  '3*2Atasm_Obj ','file using Tasm (Borland)'#010+
   '3*2Aelf_ELF (Linux) using internal writer'#010+
-  '3*2Acoff_COFF (Go32v2) usi','ng internal writer'#010+
+  '3*2Acoff_COFF (Go32v2) using internal writer'#010+
   '3*2Apecoff_PE-COFF (Win32) using internal writer'#010+
   '3*2Ayasm_Assemble using Yasm (experimental)'#010+
   '4*2Aas_Assemble using GNU AS'#010+
-  '4*2Agas_Assemble using GNU GAS'#010+
+  '4*2Ag','as_Assemble using GNU GAS'#010+
   '4*2Agas-darwin_Assemble darwin Mach-O64 using GNU GAS'#010+
-  '4*2Amasm_Win64',' object file using ml64 (Microsoft)'#010+
+  '4*2Amasm_Win64 object file using ml64 (Microsoft)'#010+
   '4*2Apecoff_PE-COFF (Win64) using internal writer'#010+
   '4*2Aelf_ELF (Linux-64bit) using internal writer'#010+
-  '4*2Ayasm_Assemble using Yasm (experimental)'#010+
+  '4*2Ayasm_Asse','mble using Yasm (experimental)'#010+
   '4*2Anasm_Assemble using Nasm (experimental)'#010+
-  '4*2Anasmwin64_Assem','ble Win64 object file using Nasm (experimental)'#010+
+  '4*2Anasmwin64_Assemble Win64 object file using Nasm (experimental)'#010+
   '4*2Anasmelf_Assemble Linux-64bit object file using Nasm (experimental)'+
   #010+
-  '4*2Anasmdarwin_Assemble darwin macho64 object file using Nasm (experim'+
-  'ental)'#010+
+  '4*2Anasmdarwin_Assemble dar','win macho64 object file using Nasm (exper'+
+  'imental)'#010+
   '6*2Aas_Unix o-file using GNU AS'#010+
-  '6*2Agas_GNU ','Motorola assembler'#010+
+  '6*2Agas_GNU Motorola assembler'#010+
   '6*2Amit_MIT Syntax (old GAS)'#010+
   '6*2Amot_Standard Motorola assembler'#010+
   'A*2Aas_Assemble using GNU AS'#010+
   'P*2Aas_Assemble using GNU AS'#010+
-  'S*2Aas_Assemble using GNU AS'#010+
+  'S*2A','as_Assemble using GNU AS'#010+
   '**1b_Generate browser info'#010+
   '**2bl_Generate local symbol info'#010+
-  '**1B_Buil','d all modules'#010+
+  '**1B_Build all modules'#010+
   '**1C<x>_Code generation options:'#010+
   '**2C3_Turn on ieee error checking for constants'#010+
-  '**2Ca<x>_Select ABI; see fpc -i or fpc -ia for possible values'#010+
+  '**2Ca<x>_Select ABI; see fpc -i or fpc -ia for poss','ible values'#010+
   '**2Cb_Generate code for a big-endian variant of the target architectur'+
   'e'#010+
-  '**2Cc<x>_S','et default calling convention to <x>'#010+
+  '**2Cc<x>_Set default calling convention to <x>'#010+
   '**2CD_Create also dynamic library (not supported)'#010+
   '**2Ce_Compilation with emulated floating point opcodes'#010+
-  '**2CE_Generate FPU code which can raise exceptions'#010+
-  '**2Cf<x>_Select fpu instruction set to use; see',' fpc -i or fpc -if fo'+
-  'r possible values'#010+
+  '**2C','E_Generate FPU code which can raise exceptions'#010+
+  '**2Cf<x>_Select fpu instruction set to use; see fpc -i or fpc -if for '+
+  'possible values'#010+
   '**2CF<x>_Minimal floating point constant precision (default, 32, 64)'#010+
   '**2Cg_Generate PIC code'#010+
-  '**2Ch<n>[,m]_<n> bytes min heap size (between 1023 and 67107840) and o'+
-  'ptionally [m] max heap size'#010+
-  '**2Ci_IO-c','hecking'#010+
+  '**2Ch<n>[,m]_<','n> bytes min heap size (between 1023 and 67107840) and'+
+  ' optionally [m] max heap size'#010+
+  '**2Ci_IO-checking'#010+
   'A*2CI<x>_Select instruction set on ARM: ARM or THUMB'#010+
+  'L*2CL<x>_LLVM code generation options'#010+
+  'L*3CLflto_Enable Link-time optimisation (needed',' both when compiling '+
+  'units and programs/libraries)'#010+
+  'L*3CLfltonosystem_Disable LTO for the system unit (needed with at leas'+
+  't Xcode 10.2 and earlier due to linker bugs)'#010+
+  'L*3CLv<x>_LLVM target version: 3.3, 3.4, .., Xcode-6.4, .., Xcode-10.1'+
+  ', 7.','0, 8.0'#010+
   '**2Cn_Omit linking stage'#010+
   'P*2CN_Generate nil-pointer checks (AIX-only)'#010+
   '**2Co_Check overflow of integer operations'#010+
   '**2CO_Check for possible overflow of integer operations'#010+
-  '**2Cp<x>_S','elect instruction set; see fpc -i or fpc -ic for possible '+
+  '**2Cp<x>_Select instruction set; see fpc -i or fpc -ic for possi','ble '+
   'values'#010+
   '**2CP<x>=<y>_ packing settings'#010+
   '**3CPPACKSET=<y>_ <y> set allocation: 0, 1 or DEFAULT or NORMAL, 2, 4 '+
   'and 8'#010+
-  '**3CPPACKENUM=<y>_ <y> enum packing: 0, 1, 2 and 4 or DEFAULT or NOR','M'+
-  'AL'#010+
-  '**3CPPACKRECORD=<y>_ <y> record packing: 0 or DEFAULT or NORMAL, 1, 2,'+
-  ' 4, 8, 16 and 32'#010+
+  '**3CPPACKENUM=<y>_ <y> enum packing: 0, 1, 2 and 4 or DEFAULT or NORMA'+
+  'L'#010+
+  '**3CPPACKRECORD=<y>_ <y> record packing: 0 or DEFA','ULT or NORMAL, 1, '+
+  '2, 4, 8, 16 and 32'#010+
   '**2Cr_Range checking'#010+
   '**2CR_Verify object method call validity'#010+
   '**2Cs<n>_Set stack checking size to <n>'#010+
-  '**2Ct_Stack checking (for testing only, see man','ual)'#010+
-  '8*2CT<x>_Target-specific code generation options'#010+
+  '**2Ct_Stack checking (for testing only, see manual)'#010+
+  '8*2CT<x>_Target-specific code generation options'#010,
   '3*2CT<x>_Target-specific code generation options'#010+
   '4*2CT<x>_Target-specific code generation options'#010+
   'p*2CT<x>_Target-specific code generation options'#010+
-  'P*2CT<x>_Target-specific code generatio','n options'#010+
-  'J*2CT<x>_Target-specific code generation options'#010+
+  'P*2CT<x>_Target-specific code generation options'#010+
+  'J*2CT<x>_Target-specific code generation opt','ions'#010+
   'A*2CT<x>_Target-specific code generation options'#010+
   'p*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed'+
   ' (AIX)'#010+
-  'P*3CTsmalltoc_ Generate smaller TOCs at the expense of ','execution spe'+
-  'ed (AIX)'#010+
-  'J*3CTautogetterprefix=X_  Automatically create getters for properties '+
-  'with prefix X (empty string disables)'#010+
+  'P*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed'+
+  ' (AIX)'#010+
+  'J*3CTautogetterprefix=X_  Automa','tically create getters for propertie'+
+  's with prefix X (empty string disables)'#010+
   'J*3CTautosetterprefix=X_  Automatically create setters for properties '+
   'with prefix X (empty string disables)'#010+
-  '8*','3CTcld_                 Emit a CLD instruction before using the x8'+
+  '8*3CTcld_                 Emit a CLD instruction before ','using the x8'+
   '6 string instructions'#010+
   '3*3CTcld_                 Emit a CLD instruction before using the x86 '+
   'string instructions'#010+
-  '4*3CTcld_                 Emit a CLD instruction before using ','the x8'+
-  '6 string instructions'#010+
-  '8*3CTfarprocspushoddbp_       Increment BP before pushing it in the pr'+
-  'ologue of far functions'#010+
+  '4*3CTcld_                 Emit a CLD instruction before using the x86 '+
+  'string instructions'#010+
+  '8*3CTfarprocspushoddbp_   ','    Increment BP before pushing it in the '+
+  'prologue of far functions'#010+
   'J*3CTcompactintarrayinit_ Generate smaller (but potentially slower) co'+
   'de for initializing integer array constants'#010+
-  'J*3C','Tenumfieldinit_       Initialize enumeration fields in construct'+
+  'J*3CTenumfieldinit_       Initialize enumeration fields in',' construct'+
   'ors to enumtype(0), after calling inherited constructors'#010+
   'J*3CTinitlocals_          Initialize local variables that trigger a JV'+
-  'M bytecode verification error if used uninitializ','ed (slows down code'+
-  ')'#010+
-  'J*3CTlowercaseprocstart_  Lowercase the first character of procedure/f'+
-  'unction/method names'#010+
+  'M bytecode verification error if used uninitialized (slows down code)'#010+
+  'J*3CTlowercaseprocstart_  Lowerca','se the first character of procedure'+
+  '/function/method names'#010+
   'A*3CTthumbinterworking_ Generate Thumb interworking-safe code if possi'+
   'ble'#010+
   'J*2Cv_Var/out parameter copy-out checking'#010+
-  '**2CX_Create',' also smartlinked library'#010+
-  '**1d<x>_Defines the symbol <x>'#010+
+  '**2CX_Create also smartlinked library'#010+
+  '**1d<x>_Defines the symbol <','x>'#010+
   '**1D_Generate a DEF file'#010+
   '**2Dd<x>_Set description to <x>'#010+
   '**2Dv<x>_Set DLL version to <x>'#010+
@@ -1541,176 +1551,176 @@ const msgtxt : array[0..000345,1..240] of char=(
   '**1e<x>_Set path to executable'#010+
   '**1E_Same as -Cn'#010+
   '**1fPIC_Same as -Cg'#010+
-  '**1F<','x>_Set file names and paths:'#010+
-  '**2Fa<x>[,y]_(for a program) load units <x> and [y] before uses is par'+
-  'sed'#010+
+  '**1F<x>_Set file names and paths:'#010+
+  '**2Fa<x>[,y]_(for a progr','am) load units <x> and [y] before uses is p'+
+  'arsed'#010+
   '**2Fc<x>_Set input codepage to <x>'#010+
   '**2FC<x>_Set RC compiler binary name to <x>'#010+
   '**2Fd_Disable the compiler'#039's internal directory cache'#010+
-  '**2F','D<x>_Set the directory where to search for compiler utilities'#010+
+  '**2FD<x>_Set the directory where to search for compiler ut','ilities'#010+
   '**2Fe<x>_Redirect error output to <x>'#010+
   '**2Ff<x>_Add <x> to framework path (Darwin only)'#010+
   '**2FE<x>_Set exe/unit output path to <x>'#010+
   '**2Fi<x>_Add <x> to include path'#010+
-  '**2Fl<x>_Add <x> ','to library path'#010+
+  '**2Fl<x>_Add <x> to library path'#010+
   '**2FL<x>_Use <x> as dynamic linker'#010+
-  '**2Fm<x>_Load unicode conversion table from <x>.txt in the compiler di'+
-  'r'#010+
+  '**2','Fm<x>_Load unicode conversion table from <x>.txt in the compiler '+
+  'dir'#010+
   '**2FM<x>_Set the directory where to search for unicode binary files'#010+
-  '**2FN<x>_Add <x> to list of default unit scopes (','namespaces)'#010+
+  '**2FN<x>_Add <x> to list of default unit scopes (namespaces)'#010+
   '**2Fo<x>_Add <x> to object path'#010+
-  '**2Fr<x>_Load error message file <x>'#010+
+  '**2Fr<x>_L','oad error message file <x>'#010+
   '**2FR<x>_Set resource (.res) linker to <x>'#010+
   '**2Fu<x>_Add <x> to unit path'#010+
   '**2FU<x>_Set unit output path to <x>, overrides -FE'#010+
-  '**2FW<x>_Store generated whole-pro','gram optimization feedback in <x>'#010+
-  '**2Fw<x>_Load previously stored whole-program optimization feedback fr'+
-  'om <x>'#010+
+  '**2FW<x>_Store generated whole-program optimization feedback in <x>'#010+
+  '**2Fw<x>_Load previo','usly stored whole-program optimization feedback '+
+  'from <x>'#010+
   '*g1g_Generate debug information (default format for target)'#010+
-  '*g2gc_Generate checks for pointers (experimental, only available on s',
-  'ome targets, might generate false positive)'#010+
-  '*g2gh_Use heaptrace unit (for memory leak/corruption debugging)'#010+
+  '*g2gc_Generate checks for pointers (experimental, only available on so'+
+  'me targets, might generate false positive)'#010+
+  '*g2gh_Use ','heaptrace unit (for memory leak/corruption debugging)'#010+
   '*g2gl_Use line info unit (show more info with backtraces)'#010+
   '*g2gm_Generate Microsoft CodeView debug information (experimental)'#010+
-  '*g2go<x','>_Set debug information options'#010+
-  '*g3godwarfsets_ Enable DWARF '#039'set'#039' type debug information (bre'+
-  'aks gdb < 6.5)'#010+
+  '*g2go<x>_Set debug information options'#010+
+  '*g3godwarfsets_ Enable',' DWARF '#039'set'#039' type debug information (b'+
+  'reaks gdb < 6.5)'#010+
   '*g3gostabsabsincludes_ Store absolute/full include file paths in Stabs'+
   #010+
-  '*g3godwarfmethodclassprefix_ Prefix method names in DWARF wi','th class'+
-  ' name'#010+
-  '*g3godwarfcpp_ Simulate C++ debug information in DWARF'#010+
+  '*g3godwarfmethodclassprefix_ Prefix method names in DWARF with class n'+
+  'ame'#010+
+  '*g3godwarfcpp_ Simulate C++ debug inform','ation in DWARF'#010+
   '*g3godwarfomflinnum_ Generate line number information in OMF LINNUM re'+
   'cords in MS LINK format in addition to the DWARF debug information (Op'+
-  'en Watcom Debugger/Linker compa','tibility)'#010+
+  'en Watcom Debugger/Linker compatibility)'#010+
   '*g2gp_Preserve case in stabs symbol names'#010+
-  '*g2gs_Generate Stabs debug information'#010+
+  '*g','2gs_Generate Stabs debug information'#010+
   '*g2gt_Trash local variables (to detect uninitialized uses; multiple '#039+
   't'#039' changes the trashing value)'#010+
-  '*g2gv_Generates programs traceable with Valgrind'#010,
-  '*g2gw_Generate DWARFv2 debug information (same as -gw2)'#010+
+  '*g2gv_Generates programs traceable with Valgrind'#010+
+  '*g2gw_Generate DWARFv2 debug information (same as -gw2',')'#010+
   '*g2gw2_Generate DWARFv2 debug information'#010+
   '*g2gw3_Generate DWARFv3 debug information'#010+
   '*g2gw4_Generate DWARFv4 debug information (experimental)'#010+
   '**1i_Information'#010+
-  '**2iD_Return compiler date',#010+
+  '**2iD_Return compiler date'#010+
   '**2iSO_Return compiler OS'#010+
-  '**2iSP_Return compiler host processor'#010+
+  '**2iSP_Return compiler host',' processor'#010+
   '**2iTO_Return target OS'#010+
   '**2iTP_Return target processor'#010+
   '**2iV_Return short compiler version'#010+
   '**2iW_Return full compiler version'#010+
   '**2ia_Return list of supported ABI targets'#010+
-  '**2ic_','Return list of supported CPU instruction sets'#010+
-  '**2if_Return list of supported FPU instruction sets'#010+
+  '**2ic_Return list of supported CPU instruction sets'#010+
+  '**2if_Re','turn list of supported FPU instruction sets'#010+
   '**2ii_Return list of supported inline assembler modes'#010+
   '**2io_Return list of supported optimizations'#010+
-  '**2ir_Return list of recognized compiler an','d RTL features'#010+
-  '**2it_Return list of supported targets'#010+
+  '**2ir_Return list of recognized compiler and RTL features'#010+
+  '**2it_Return list of supported targets'#010,
   '**2iu_Return list of supported microcontroller types'#010+
   '**2iw_Return list of supported whole program optimizations'#010+
   '**1I<x>_Add <x> to include path'#010+
   '**1k<x>_Pass <x> to the linker'#010+
-  '**1l_Write ','logo'#010+
+  '**1l_Write logo'#010+
   '**1M<x>_Set language mode to <x>'#010+
-  '**2Mfpc_Free Pascal dialect (default)'#010+
+  '**2Mfpc_Free Pas','cal dialect (default)'#010+
   '**2Mobjfpc_FPC mode with Object Pascal support'#010+
   '**2Mdelphi_Delphi 7 compatibility mode'#010+
   '**2Mtp_TP/BP 7.0 compatibility mode'#010+
-  '**2Mmacpas_Macintosh Pascal dialects compa','tibility mode'#010+
+  '**2Mmacpas_Macintosh Pascal dialects compatibility mode'#010+
   '**2Miso_ISO 7185 mode'#010+
-  '**2Mextendedpascal_ISO 10206 mode'#010+
+  '**2Mextendedpascal','_ISO 10206 mode'#010+
   '**2Mdelphiunicode_Delphi 2009 and later compatibility mode'#010+
   '**1n_Do not read the default config files'#010+
   '**1o<x>_Change the name of the executable produced to <x>'#010+
-  '**1O<x>_Opt','imizations:'#010+
+  '**1O<x>_Optimizations:'#010+
   '**2O-_Disable optimizations'#010+
-  '**2O1_Level 1 optimizations (quick and debugger friendly)'#010+
+  '**2O1_Level 1 ','optimizations (quick and debugger friendly)'#010+
   '**2O2_Level 2 optimizations (-O1 + quick optimizations)'#010+
   '**2O3_Level 3 optimizations (-O2 + slow optimizations)'#010+
-  '**2O4_Level 4 optimizations (-O','3 + optimizations which might have un'+
-  'expected side effects)'#010+
+  '**2O4_Level 4 optimizations (-O3 + optimizations which might have unex'+
+  'pected side eff','ects)'#010+
   '**2Oa<x>=<y>_Set alignment'#010+
   '**2Oo[NO]<x>_Enable or disable optimizations; see fpc -i or fpc -io fo'+
   'r possible values'#010+
-  '**2Op<x>_Set target cpu for optimizing; see fpc -i or fpc -ic for',' po'+
-  'ssible values'#010+
-  '**2OW<x>_Generate whole-program optimization feedback for optimization'+
-  ' <x>; see fpc -i or fpc -iw for possible values'#010+
+  '**2Op<x>_Set target cpu for optimizing; see fpc -i or fpc -ic for poss'+
+  'ible values'#010+
+  '**2OW<x>_Generate whole-program optim','ization feedback for optimizati'+
+  'on <x>; see fpc -i or fpc -iw for possible values'#010+
   '**2Ow<x>_Perform whole-program optimization <x>; see fpc -i or fpc -iw'+
   ' for possible values'#010+
-  '**2Os_Optimize',' for size rather than speed'#010+
-  '**1pg_Generate profile code for gprof (defines FPC_PROFILE)'#010+
+  '**2Os_Optimize for size rather than speed'#010+
+  '**1pg_Generate profile cod','e for gprof (defines FPC_PROFILE)'#010+
   'F*1P<x>_Target CPU / compiler related options:'#010+
   'F*2PB_Show default compiler binary'#010+
   'F*2PP_Show default target cpu'#010+
-  'F*2P<x>_Set target CPU (aarch64,arm,avr,','i386,i8086,jvm,m68k,mips,mip'+
-  'sel,powerpc,powerpc64,sparc,x86_64)'#010+
+  'F*2P<x>_Set target CPU (aarch64,arm,avr,i386,i8086,jvm,m68k,mips,mipse'+
+  'l,powerpc,powerpc64,spar','c,x86_64)'#010+
   '**1R<x>_Assembler reading style:'#010+
   '**2Rdefault_Use default assembler for target'#010+
   '3*2Ratt_Read AT&T style assembler'#010+
   '3*2Rintel_Read Intel style assembler'#010+
-  '4*2Ratt_Read AT&T style ass','embler'#010+
+  '4*2Ratt_Read AT&T style assembler'#010+
   '4*2Rintel_Read Intel style assembler'#010+
-  '8*2Ratt_Read AT&T style assembler'#010+
+  '8*2Ratt_Re','ad AT&T style assembler'#010+
   '8*2Rintel_Read Intel style assembler'#010+
   '6*2RMOT_Read Motorola style assembler'#010+
   '**1S<x>_Syntax options:'#010+
   '**2S2_Same as -Mobjfpc'#010+
-  '**2Sc_Support operators like C (*=,+=,/=',' and -=)'#010+
+  '**2Sc_Support operators like C (*=,+=,/= and -=)'#010+
   '**2Sa_Turn on assertions'#010+
-  '**2Sd_Same as -Mdelphi'#010+
+  '**2Sd_Same as -Mdelp','hi'#010+
   '**2Se<x>_Error options. <x> is a combination of the following:'#010+
   '**3*_<n> : Compiler halts after the <n> errors (default is 1)'#010+
   '**3*_w : Compiler also halts after warnings'#010+
-  '**3*_n : Compi','ler also halts after notes'#010+
-  '**3*_h : Compiler also halts after hints'#010+
+  '**3*_n : Compiler also halts after notes'#010+
+  '**3*_h : Compiler also halt','s after hints'#010+
   '**2Sf_Enable certain features in compiler and RTL; see fpc -i or fpc -'+
   'ir for possible values)'#010+
   '**2Sg_Enable LABEL and GOTO (default in -Mtp and -Mdelphi)'#010+
-  '**2Sh_Use reference',' counted strings (ansistring by default) instead '+
-  'of shortstrings'#010+
+  '**2Sh_Use reference counted strings (ansistring by default) instead of'+
+  ' sh','ortstrings'#010+
   '**2Si_Turn on inlining of procedures/functions declared as "inline"'#010+
   '**2Sj_Allows typed constants to be writeable (default in all modes)'#010+
   '**2Sk_Load fpcylix unit'#010+
-  '**2SI<x>_Set in','terface style to <x>'#010+
-  '**3SIcom_COM compatible interface (default)'#010+
+  '**2SI<x>_Set interface style to <x>'#010+
+  '**3SIcom_COM compatible interface',' (default)'#010+
   '**3SIcorba_CORBA compatible interface'#010+
   '**2Sm_Support macros like C (global)'#010+
   '**2So_Same as -Mtp'#010+
   '**2Sr_Transparent file names in ISO mode'#010+
-  '**2Ss_Constructor name must be init (des','tructor must be done)'#010+
-  '**2Sv_Support vector processing (use CPU vector extensions if availabl'+
-  'e)'#010+
+  '**2Ss_Constructor name must be init (destructor must be done)'#010+
+  '**2Sv_Support vector processing ','(use CPU vector extensions if availa'+
+  'ble)'#010+
   '**2Sx_Enable exception keywords (default in Delphi/ObjFPC modes)'#010+
   '**2Sy_@<pointer> returns a typed pointer, same as $T+'#010+
-  '**1s_Do not call assembler',' and linker'#010+
+  '**1s_Do not call assembler and linker'#010+
   '**2sh_Generate script to link on host'#010+
-  '**2st_Generate script to link on target'#010+
+  '**2s','t_Generate script to link on target'#010+
   '**2sr_Skip register allocation phase (use with -alr)'#010+
   '**1T<x>_Target operating system:'#010+
   '3*2Tandroid_Android'#010+
   '3*2Taros_AROS'#010+
   '3*2Tbeos_BeOS'#010+
-  '3*2Tdarwin_Darwi','n/Mac OS X'#010+
+  '3*2Tdarwin_Darwin/Mac OS X'#010+
   '3*2Tembedded_Embedded'#010+
-  '3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+
+  '3*2Temx_OS/2 via EMX ','(including EMX/RSX extender)'#010+
   '3*2Tfreebsd_FreeBSD'#010+
   '3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+
   '3*2Thaiku_Haiku'#010+
   '3*2Tiphonesim_iPhoneSimulator from iOS SDK 3.2+ (older versions: -Tdar'+
-  'win',')'#010+
+  'win)'#010+
   '3*2Tlinux_Linux'#010+
-  '3*2Tnativent_Native NT API (experimental)'#010+
+  '3*2Tnativent_Native NT API (experime','ntal)'#010+
   '3*2Tnetbsd_NetBSD'#010+
   '3*2Tnetware_Novell Netware Module (clib)'#010+
   '3*2Tnetwlibc_Novell Netware Module (libc)'#010+
   '3*2Topenbsd_OpenBSD'#010+
   '3*2Tos2_OS/2 / eComStation'#010+
   '3*2Tsymbian_Symbian OS'#010+
-  '3*2Tsolar','is_Solaris'#010+
+  '3*2Tsolaris_Solaris'#010+
   '3*2Twatcom_Watcom compatible DOS extender'#010+
-  '3*2Twdosx_WDOSX DOS extender'#010+
+  '3','*2Twdosx_WDOSX DOS extender'#010+
   '3*2Twin32_Windows 32 Bit'#010+
   '3*2Twince_Windows CE'#010+
   '4*2Taros_AROS'#010+
@@ -1718,9 +1728,9 @@ const msgtxt : array[0..000345,1..240] of char=(
   '4*2Tdragonfly_DragonFly BSD'#010+
   '4*2Tembedded_Embedded'#010+
   '4*2Tfreebsd_FreeBSD'#010+
-  '4','*2Tiphonesim_iPhoneSimulator'#010+
+  '4*2Tiphonesim_iPhoneSimulator'#010+
   '4*2Tlinux_Linux'#010+
-  '4*2Tnetbsd_NetBSD'#010+
+  '4*2Tnetbs','d_NetBSD'#010+
   '4*2Topenbsd_OpenBSD'#010+
   '4*2Tsolaris_Solaris'#010+
   '4*2Twin64_Win64 (64 bit Windows systems)'#010+
@@ -1728,20 +1738,20 @@ const msgtxt : array[0..000345,1..240] of char=(
   '6*2Tatari_Atari ST/STe/TT'#010+
   '6*2Tembedded_Embedded'#010+
   '6*2Tlinux_Linux'#010+
-  '6*2Tne','tbsd_NetBSD'#010+
+  '6*2Tnetbsd_NetBSD'#010+
   '6*2Tmacos_Mac OS'#010+
   '6*2Tpalmos_PalmOS'#010+
-  '8*2Tembedded_Embedded'#010+
+  '8*2Temb','edded_Embedded'#010+
   '8*2Tmsdos_MS-DOS (and compatible)'#010+
   '8*2Twin16_Windows 16 Bit'#010+
   'A*2Tandroid_Android'#010+
   'A*2Taros_AROS'#010+
   'A*2Tdarwin_Darwin/iPhoneOS/iOS'#010+
   'A*2Tembedded_Embedded'#010+
-  'A*2Tgba_Game Boy Advance'#010,
+  'A*2Tgba_Game Boy Advance'#010+
   'A*2Tlinux_Linux'#010+
   'A*2Tnds_Nintendo DS'#010+
-  'A*2Tnetbsd_NetBSD'#010+
+  'A*2Tnetbsd_NetBSD'#010,
   'A*2Tpalmos_PalmOS'#010+
   'A*2Tsymbian_Symbian'#010+
   'A*2Twince_Windows CE'#010+
@@ -1751,11 +1761,11 @@ const msgtxt : array[0..000345,1..240] of char=(
   'J*2Tjava_Java'#010+
   'm*2Tandroid_Android'#010+
   'm*2Tembedded_Embedded'#010+
-  'm*2Tlinux_Lin','ux'#010+
+  'm*2Tlinux_Linux'#010+
   'M*2Tembedded_Embedded'#010+
   'M*2Tlinux_Linux'#010+
   'P*2Taix_AIX'#010+
-  'P*2Tamiga_AmigaOS'#010+
+  'P','*2Tamiga_AmigaOS'#010+
   'P*2Tdarwin_Darwin/Mac OS X'#010+
   'P*2Tembedded_Embedded'#010+
   'P*2Tlinux_Linux'#010+
@@ -1764,10 +1774,10 @@ const msgtxt : array[0..000345,1..240] of char=(
   'P*2Tnetbsd_NetBSD'#010+
   'P*2Twii_Wii'#010+
   'p*2Taix_AIX'#010+
-  'p*2Tdarwin_Darw','in/Mac OS X'#010+
+  'p*2Tdarwin_Darwin/Mac OS X'#010+
   'p*2Tembedded_Embedded'#010+
   'p*2Tlinux_Linux'#010+
-  'R*2Tlinux_Linux'#010+
+  'R*2T','linux_Linux'#010+
   'R*2Tembedded_Embedded'#010+
   'r*2Tlinux_Linux'#010+
   'r*2Tembedded_Embedded'#010+
@@ -1776,143 +1786,143 @@ const msgtxt : array[0..000345,1..240] of char=(
   's*2Tlinux_Linux'#010+
   'V*2Tembedded_Embedded'#010+
   '**1u<x>_Undefines the symbol <x>'#010+
-  '**1U_Un','it options:'#010+
-  '**2Un_Do not check where the unit name matches the file name'#010+
+  '**1U_Unit options:'#010+
+  '**2Un_Do not check where the unit name mat','ches the file name'#010+
   '**2Ur_Generate release unit files (never automatically recompiled)'#010+
   '**2Us_Compile a system unit'#010+
   '**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+
-  '**2*_','e : Show errors (default)       0 : Show nothing (except errors'+
+  '**2*_e : Show errors (default)       0 : Show nothing (exce','pt errors'+
   ')'#010+
   '**2*_w : Show warnings               u : Show unit info'#010+
   '**2*_n : Show notes                  t : Show tried/used files'#010+
-  '**2*_h : Show hints                  c : Show conditiona','ls'#010+
-  '**2*_i : Show general info           d : Show debug info'#010+
+  '**2*_h : Show hints                  c : Show conditionals'#010+
+  '**2*_i : Show general info           d : Show debug',' info'#010+
   '**2*_l : Show linenumbers            r : Rhide/GCC compatibility mode'#010+
   '**2*_s : Show time stamps            q : Show message numbers'#010+
-  '**2*_a : Show everything             x : Show in','fo about invoked too'+
-  'ls'#010+
-  '**2*_b : Write file names messages   p : Write tree.log with parse tre'+
-  'e'#010+
+  '**2*_a : Show everything             x : Show info about invoked tools'+
+  #010+
+  '**2*_b : Write file names messa','ges   p : Write tree.log with parse t'+
+  'ree'#010+
   '**2*_    with full path              v : Write fpcdebug.txt with'#010+
   '**2*_z : Write output to stderr          lots of debugging info'#010+
-  '**2*_m<x>,<y> : ','Do not show messages numbered <x> and <y>'#010+
-  'F*1V<x>_Append '#039'-<x>'#039' to the used compiler binary name (e.g. f'+
-  'or version)'#010+
+  '**2*_m<x>,<y> : Do not show messages numbered <x> and <y>'#010+
+  'F*1V<x>_Appe','nd '#039'-<x>'#039' to the used compiler binary name (e.g.'+
+  ' for version)'#010+
   '**1W<x>_Target-specific options (targets)'#010+
   '3*2WA_Specify native type application (Windows)'#010+
-  '4*2WA_Specify native type applicat','ion (Windows)'#010+
-  'A*2WA_Specify native type application (Windows)'#010+
+  '4*2WA_Specify native type application (Windows)'#010+
+  'A*2WA_Specify native type application (W','indows)'#010+
   '3*2Wb_Create a bundle instead of a library (Darwin)'#010+
   'P*2Wb_Create a bundle instead of a library (Darwin)'#010+
   'p*2Wb_Create a bundle instead of a library (Darwin)'#010+
-  'a*2Wb_Create a bundle ','instead of a library (Darwin)'#010+
-  'A*2Wb_Create a bundle instead of a library (Darwin)'#010+
+  'a*2Wb_Create a bundle instead of a library (Darwin)'#010+
+  'A*2Wb_Create a bundle in','stead of a library (Darwin)'#010+
   '4*2Wb_Create a bundle instead of a library (Darwin)'#010+
   '3*2WB_Create a relocatable image (Windows, Symbian)'#010+
   '3*2WB<x>_Set image base to <x> (Windows, Symbian)'#010+
-  '4*2W','B_Create a relocatable image (Windows)'#010+
-  '4*2WB<x>_Set image base to <x> (Windows)'#010+
+  '4*2WB_Create a relocatable image (Windows)'#010+
+  '4*2WB<x>_Set im','age base to <x> (Windows)'#010+
   'A*2WB_Create a relocatable image (Windows, Symbian)'#010+
   'A*2WB<x>_Set image base to <x> (Windows, Symbian)'#010+
-  '3*2WC_Specify console type application (EMX, OS/2, Windows',')'#010+
+  '3*2WC_Specify console type application (EMX, OS/2, Windows)'#010+
   '4*2WC_Specify console type application (Windows)'#010+
-  'A*2WC_Specify console type application (Windows)'#010+
+  'A*2','WC_Specify console type application (Windows)'#010+
   'P*2WC_Specify console type application (Classic Mac OS)'#010+
   '3*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
-  '4*2WD_Use DEFFILE to e','xport functions of DLL or EXE (Windows)'#010+
-  'A*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
+  '4*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
+  'A*2WD_Use DEFF','ILE to export functions of DLL or EXE (Windows)'#010+
   '3*2We_Use external resources (Darwin)'#010+
   '4*2We_Use external resources (Darwin)'#010+
   'a*2We_Use external resources (Darwin)'#010+
-  'A*2We_Use external resou','rces (Darwin)'#010+
+  'A*2We_Use external resources (Darwin)'#010+
   'P*2We_Use external resources (Darwin)'#010+
-  'p*2We_Use external resources (Darwin)'#010+
+  'p*','2We_Use external resources (Darwin)'#010+
   '3*2WF_Specify full-screen type application (EMX, OS/2)'#010+
   '3*2WG_Specify graphic type application (EMX, OS/2, Windows)'#010+
-  '4*2WG_Specify graphic type applicat','ion (Windows)'#010+
-  'A*2WG_Specify graphic type application (Windows)'#010+
+  '4*2WG_Specify graphic type application (Windows)'#010+
+  'A*2WG_Specify graphic type application (','Windows)'#010+
   'P*2WG_Specify graphic type application (Classic Mac OS)'#010+
   '3*2Wi_Use internal resources (Darwin)'#010+
   '4*2Wi_Use internal resources (Darwin)'#010+
   'a*2Wi_Use internal resources (Darwin)'#010+
-  'A*2Wi_U','se internal resources (Darwin)'#010+
-  'P*2Wi_Use internal resources (Darwin)'#010+
+  'A*2Wi_Use internal resources (Darwin)'#010+
+  'P*2Wi_Use internal reso','urces (Darwin)'#010+
   'p*2Wi_Use internal resources (Darwin)'#010+
   '3*2WI_Turn on/off the usage of import sections (Windows)'#010+
   '4*2WI_Turn on/off the usage of import sections (Windows)'#010+
-  'A*2WI_Turn on/off t','he usage of import sections (Windows)'#010+
-  '8*2Wh_Use huge code for units (ignored for models with CODE in a uniqu'+
-  'e segment)'#010+
+  'A*2WI_Turn on/off the usage of import sections (Windows)'#010+
+  '8*2Wh_Use huge c','ode for units (ignored for models with CODE in a uni'+
+  'que segment)'#010+
   '8*2Wm<x>_Set memory model'#010+
   '8*3WmTiny_Tiny memory model'#010+
   '8*3WmSmall_Small memory model (default)'#010+
-  '8*3WmMedium_Medium memory m','odel'#010+
+  '8*3WmMedium_Medium memory model'#010+
   '8*3WmCompact_Compact memory model'#010+
-  '8*3WmLarge_Large memory model'#010+
+  '8*3WmLarge_Larg','e memory model'#010+
   '8*3WmHuge_Huge memory model'#010+
   '3*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
   'n)'#010+
-  '4*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi',
-  'n)'#010+
-  'p*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
+  '4*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
   'n)'#010+
+  'p*2WM<x>_Minimum Mac OS X deployment version: 10.4,',' 10.5.1, ... (Dar'+
+  'win)'#010+
   'P*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
   'n)'#010+
   '3*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
-  '4*2WN_Do not generate',' relocation code, needed for debugging (Windows'+
+  '4*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
+  'A*2WN','_Do not generate relocation code, needed for debugging (Windows'+
   ')'#010+
-  'A*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
   'A*2Wp<x>_Specify the controller type; see fpc -i or fpc -iu for possib'+
   'le values'#010+
-  'm*2Wp<x>_Specify the controller type; see',' fpc -i or fpc -iu for poss'+
-  'ible values'#010+
-  'V*2Wp<x>_Specify the controller type; see fpc -i or fpc -iu for possib'+
+  'm*2Wp<x>_Specify the controller type; see fpc -i or fpc -iu for possib'+
   'le values'#010+
+  'V*2Wp<x>_Specif','y the controller type; see fpc -i or fpc -iu for poss'+
+  'ible values'#010+
   '3*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (iphonesim)'#010+
-  '4*2WP<x>_Minimum iOS deployment version: 8.0, 8.0.2,',' ... (iphonesim)'+
-  #010+
-  'a*2WP<x>_Minimum iOS deployment version: 7.0, 7.1.2, ... (Darwin)'#010+
+  '4*2WP<x>_Minimum iOS deployment version: 8.0, 8.0.2, ... (iphonesim)'#010+
+  'a*2WP<x>_Minimum iOS deployment versi','on: 7.0, 7.1.2, ... (Darwin)'#010+
   'A*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (Darwin)'#010+
   '3*2WR_Generate relocation code (Windows)'#010+
   '4*2WR_Generate relocation code (Windows)'#010+
-  'A*2WR_Gen','erate relocation code (Windows)'#010+
-  '8*2Wt<x>_Set the target executable format'#010+
+  'A*2WR_Generate relocation code (Windows)'#010+
+  '8*2Wt<x>_Set the targe','t executable format'#010+
   '8*3Wtexe_Create a DOS .EXE file (default)'#010+
   '8*3Wtcom_Create a DOS .COM file (requires tiny memory model)'#010+
   'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010+
-  '**2WX_','Enable executable stack (Linux)'#010+
-  '**1X_Executable options:'#010+
+  '**2WX_Enable executable stack (Linux)'#010+
+  '**1X_Executable option','s:'#010+
   '**2X9_Generate linkerscript for GNU Binutils ld older than version 2.1'+
   '9.1 (Linux)'#010+
   '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+
   'ux)'#010+
-  '**2Xd_Do not search default',' library path (sometimes required for cro'+
-  'ss-compiling when not using -XR)'#010+
+  '**2Xd_Do not search default library path (sometimes required for cross'+
+  '-compiling ','when not using -XR)'#010+
   '**2Xe_Use external linker'#010+
   '**2Xf_Substitute pthread library name for linking (BSD)'#010+
   '**2Xg_Create debuginfo in a separate file and add a debuglink section '+
-  'to executable'#010,
-  '**2XD_Try to link units dynamically      (defines FPC_LINK_DYNAMIC)'#010+
+  'to executable'#010+
+  '**2XD_Try to link units dynamically      (defines FPC_','LINK_DYNAMIC)'#010+
   '**2Xi_Use internal linker'#010+
   '**2XLA_Define library substitutions for linking'#010+
   '**2XLO_Define order of library linking'#010+
   '**2XLD_Exclude default order of standard libraries'#010+
-  '**2Xm_Ge','nerate link map'#010+
-  '**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+
-  's '#039'main'#039')'#010+
+  '**2Xm_Generate link map'#010+
+  '**2XM<x>_Set the name of the '#039'main'#039' pr','ogram routine (default'+
+  ' is '#039'main'#039')'#010+
   '**2Xn_Use target system native linker instead of GNU ld (Solaris, AIX)'+
   #010+
   'F*2Xp<x>_First search for the compiler binary in the directory <x>'#010+
-  '**2XP<x>_Prepe','nd the binutils names with the prefix <x>'#010+
-  '**2Xr<x>_Set the linker'#039's rlink-path to <x> (needed for cross comp'+
-  'ile, see the ld manual for more information) (BeOS, Linux)'#010+
+  '**2XP<x>_Prepend the binutils names with the prefix <x>'#010+
+  '**2Xr<x>_Set',' the linker'#039's rlink-path to <x> (needed for cross co'+
+  'mpile, see the ld manual for more information) (BeOS, Linux)'#010+
   '**2XR<x>_Prepend <x> to all linker search paths (BeOS, Darwin, FreeBSD'+
-  ', L','inux, Mac OS, Solaris)'#010+
-  '**2Xs_Strip all symbols from executable'#010+
+  ', Linux, Mac OS, Solaris)'#010+
+  '**2Xs_Strip all symbols from ex','ecutable'#010+
   '**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+
   '**2Xt_Link with static libraries (-static is passed to linker)'#010+
-  '**2Xv_Generate table for Virtual Entry calls',#010+
-  '**2XV_Use VLink as external linker       (default on Amiga, MorphOS)'#010+
+  '**2Xv_Generate table for Virtual Entry calls'#010+
+  '**2XV_Use VLink as external linker       (default on ','Amiga, MorphOS)'+
+  #010+
   '**2XX_Try to smartlink units             (defines FPC_LINK_SMART)'#010+
   '**1*_'#010+
   '**1?_Show this help'#010+

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/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/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/nflw.pas

@@ -189,7 +189,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;
@@ -2202,6 +2205,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 +2295,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 +2321,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 +2337,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/ninl.pas

@@ -127,7 +127,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,
@@ -2298,7 +2298,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;

compiler/nutils.pas

@@ -205,8 +205,8 @@ implementation
               result := foreachnode(procmethod,tloopnode(n).t1,f,arg) or result;
               result := foreachnode(procmethod,tloopnode(n).t2,f,arg) or result;
             end;
-          raisen:
-            { frame tree }
+          raisen, tryfinallyn:
+            { frame tree/copy of finally code }
             result := foreachnode(ttertiarynode(n).third,f,arg) or result;
           tempcreaten:
             { temp. initialization code }
@@ -308,8 +308,8 @@ implementation
               result := foreachnodestatic(procmethod,tloopnode(n).t1,f,arg) or result;
               result := foreachnodestatic(procmethod,tloopnode(n).t2,f,arg) or result;
             end;
-          raisen:
-            { frame tree }
+          raisen, tryfinallyn:
+            { frame tree/copy of finally code }
             result := foreachnodestatic(ttertiarynode(n).third,f,arg) or result;
           tempcreaten:
             { temp. initialization code }

compiler/objcgutl.pas

@@ -48,6 +48,7 @@ implementation
     objcdef,objcutil,
     aasmcnst,
     symconst,symtype,symsym,symtable,
+    ngenutil,
     verbose;
 
   type
@@ -1909,23 +1910,10 @@ constructor tobjcrttiwriter_nonfragile.create;
 procedure MaybeGenerateObjectiveCImageInfo(globalst, localst: tsymtable);
   var
     objcrttiwriter: tobjcrttiwriter;
-    tcb: ttai_typedconstbuilder;
   begin
     if (m_objectivec1 in current_settings.modeswitches) then
       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;
+        cnodeutils.GenerateObjCImageInfo;
 
         { generate rtti for all obj-c classes, protocols and categories
           defined in this module. }

compiler/ogbase.pas

@@ -1255,7 +1255,8 @@ implementation
           {sec_objc_nlcatlist} [oso_data,oso_load],
           {sec_objc_protolist'} [oso_data,oso_load],
           {stack} [oso_load,oso_write],
-          {heap} [oso_load,oso_write]
+          {heap} [oso_load,oso_write],
+          {gcc_except_table} [oso_data,oso_load]
         );
       begin
         result:=secoptions[atype];

compiler/ogcoff.pas

@@ -592,7 +592,8 @@ implementation
           '.obcj_nlcatlist',
           '.objc_protolist',
           '.stack',
-          '.heap'
+          '.heap',
+          '.gcc_except_table'
         );
 
 const go32v2stub : array[0..2047] of byte=(

compiler/ogelf.pas

@@ -557,7 +557,8 @@ implementation
           '.obcj_nlcatlist',
           '.objc_protolist',
           '.stack',
-          '.heap'
+          '.heap',
+          '.gcc_except_table'
         );
       var
         sep : string[3];

compiler/omfbase.pas

@@ -86,7 +86,8 @@ interface
       'obcj_nlcatlist',
       'objc_protolist',
       'stack',
-      'heap'
+      'heap',
+      'gcc_except_table'
     );
 
     { OMF record types }
@@ -3018,7 +3019,8 @@ implementation
         {objc_nlcatlist} 'DATA',
         {objc_protolist} 'DATA',
         {stack} 'STACK',
-        {heap} 'HEAP'
+        {heap} 'HEAP',
+        {gcc_except_table} 'DATA'
       );
     begin
       result:=segclass[atype];

compiler/options.pas

@@ -707,6 +707,9 @@ begin
 {$endif}
 {$ifdef jvm}
       'J',
+{$endif}
+{$ifdef llvm}
+      'L',
 {$endif}
       '*' : show:=true;
      end;
@@ -917,9 +920,16 @@ function toption.ParseMacVersionMin(out minstr, emptystr: string; const compvarn
       end
     else if not ios and
        not osx_minor_two_digits then
-      compvarvalue:=compvarvalue+'0'
+      begin
+        compvarvalue:=compvarvalue+'0';
+        minstr:=minstr+'.0'
+      end
     else
-      compvarvalue:=compvarvalue+'00';
+      begin
+        compvarvalue:=compvarvalue+'00';
+        { command line versions still only use one 0 though }
+        minstr:=minstr+'.0'
+      end;
     set_system_compvar(compvarname,compvarvalue);
     MacVersionSet:=true;
     result:=true;
@@ -1040,6 +1050,9 @@ var
   d,s   : TCmdStr;
   hs    : TCmdStr;
   unicodemapping : punicodemap;
+{$ifdef llvm}
+  disable: boolean;
+{$endif}
 begin
   if opt='' then
    exit;
@@ -1283,6 +1296,62 @@ begin
                         break;
                       end;
 {$endif arm}
+{$ifdef llvm}
+                    'L':
+                      begin
+                        l:=j+1;
+                        while l<=length(More) do
+                          begin
+                            case More[l] of
+                              'f':
+                                begin
+                                  More:=copy(More,l+1,length(More));
+                                  disable:=Unsetbool(More,length(More)-1,opt,false);
+                                  case More of
+                                    'lto':
+                                       begin
+                                         if not disable then
+                                           begin
+                                             include(init_settings.moduleswitches,cs_lto);
+                                             LTOExt:='.bc';
+                                           end
+                                         else
+                                           exclude(init_settings.moduleswitches,cs_lto);
+                                       end;
+                                     'ltonosystem':
+                                         begin
+                                           if not disable then
+                                             begin
+                                               include(init_settings.globalswitches,cs_lto_nosystem);
+                                             end
+                                           else
+                                             exclude(init_settings.globalswitches,cs_lto_nosystem);
+                                         end;
+                                    else
+                                      begin
+                                        IllegalPara(opt);
+                                      end;
+                                  end;
+                                  l:=length(more)+1;
+                                end;
+                              'v':
+                                begin
+                                  init_settings.llvmversion:=llvmversion2enum(copy(More,l+1,length(More)));
+                                  if init_settings.llvmversion=llvmver_invalid then
+                                    begin
+                                      IllegalPara(opt);
+                                    end;
+                                  l:=length(More)+1;
+                                end
+                              else
+                                begin
+                                  IllegalPara(opt);
+                                end;
+                            end;
+                          end;
+                        j:=l;
+                      end;
+{$endif llvm}
                     'n' :
                       If UnsetBool(More, j, opt, false) then
                         exclude(init_settings.globalswitches,cs_link_nolink)
@@ -3174,6 +3243,12 @@ begin
     else
       undef_system_macro('FPC_SECTION_THREADVARS');
 
+  if (tf_use_psabieh in target_info.flags) then
+    if def then
+      def_system_macro('FPC_USE_PSABIEH')
+    else
+      undef_system_macro('FPC_USE_PSABIEH');
+
   { Code generation flags }
   if (tf_pic_default in target_info.flags) then
     if def then
@@ -3417,6 +3492,9 @@ procedure read_arguments(cmd:TCmdStr);
       controller: tcontrollertype;
       s: string;
     begin
+{$ifdef llvm}
+      def_system_macro('CPULLVM');
+{$endif}
       for cputype:=low(tcputype) to high(tcputype) do
         undef_system_macro('CPU'+Cputypestr[cputype]);
       def_system_macro('CPU'+Cputypestr[init_settings.cputype]);
@@ -3983,8 +4061,11 @@ begin
   librarysearchpath.AddList(unitsearchpath,false);
 
 {$ifdef llvm}
-  { force llvm assembler writer }
-  option.paratargetasm:=as_llvm;
+  { default to clang }
+  if (option.paratargetasm=as_none) then
+    begin
+      option.paratargetasm:=as_llvm_clang;
+    end;
 {$endif llvm}
   { maybe override assembler }
   if (option.paratargetasm<>as_none) then
@@ -4010,8 +4091,8 @@ begin
         begin
           option.paratargetdbg:=dbg_dwarf2;
         end;
-
     end;
+
   {TOptionheck a second time as we might have changed assembler just above }
   option.checkoptionscompatibility;
 
@@ -4378,7 +4459,7 @@ begin
     end;
 {$endif defined(i386) or defined(x86_64)}
 
-{$if defined(arm)}
+{$if defined(arm) and not defined(llvm)}
   { it is determined during system unit compilation if clz is used for bsf or not,
     this is not perfect but the current implementation bsf/bsr does not allow another
     solution }

compiler/parabase.pas

@@ -64,7 +64,7 @@ unit parabase;
                if llvmvalueloc=false: must be a tempreg. Means that the value is
                stored in a temp with this register as base address }
              LOC_REGISTER:  (reg: tregister);
-             LOC_CONSTANT:  (value: tcgint);
+             LOC_CONSTANT:  (value: int64);
          end;
 {$endif llvm}
          case TCGLoc of
@@ -106,7 +106,7 @@ unit parabase;
           Location  : PCGParalocation;
           IntSize   : tcgint; { size of the total location in bytes }
           DefDeref  : tderef;
-          Alignment : ShortInt;
+          Alignment : ShortInt; { in case of LLVM, a negative alignment mean: force write the alignment }
           Size      : TCGSize;  { Size of the parameter included in all locations }
           Temporary : boolean;  { created on the fly, no permanent references exist to this somewhere that will cause it to be disposed }
           constructor init;

compiler/pexpr.pas

@@ -917,6 +917,15 @@ implementation
             begin
               statement_syssym:=inline_insert;
             end;
+          in_const_eh_return_data_regno:
+            begin
+              consume(_LKLAMMER);
+              in_args:=true;
+              p1:=comp_expr([ef_accept_equal]);
+              p2:=geninlinenode(l,true,p1);
+              consume(_RKLAMMER);
+              statement_syssym:=p2;
+            end;
           else
             internalerror(15);
 

compiler/pmodules.pas

@@ -130,6 +130,11 @@ implementation
            current_module.linkunitstaticlibs.add(current_module.staticlibfilename ,link_smart);
            current_module.headerflags:=current_module.headerflags or uf_smart_linked;
          end;
+        if cs_lto in current_settings.moduleswitches then
+          begin
+            current_module.linkunitofiles.add(ChangeFileExt(current_module.objfilename,LTOExt),link_lto);
+            current_module.headerflags:=current_module.headerflags or uf_lto_linked;
+          end;
       end;
 
 

compiler/powerpc/agppcmpw.pas

@@ -119,6 +119,7 @@ interface
         '',
         '',
         '',
+        '',
         ''
       );
 

compiler/powerpc/cpubase.pas

@@ -398,6 +398,7 @@ uses
     function conditions_equal(const c1, c2: TAsmCond): boolean;
     function dwarf_reg(r:tregister):shortint;
     function dwarf_reg_no_error(r:tregister):shortint;
+    function eh_return_data_regno(nr: longint): longint;
 
 implementation
 
@@ -577,4 +578,13 @@ implementation
       begin
         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+3
+        else
+          result:=-1;
+      end;
+
 end.

compiler/powerpc/hlcgcpu.pas

@@ -40,8 +40,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
@@ -111,7 +109,7 @@ implementation
 
 
 
-  procedure create_hlcodegen;
+  procedure create_hlcodegen_cpu;
     begin
       hlcg:=thlcgcpu.create;
       create_codegen;
@@ -120,5 +118,6 @@ implementation
 
 begin
   chlcgobj:=thlcgcpu;
+  create_hlcodegen:=@create_hlcodegen_cpu;
 end.
 

compiler/powerpc64/cpubase.pas

@@ -398,6 +398,7 @@ function inverse_cond(const c: TAsmCond): Tasmcond;
 function conditions_equal(const c1, c2: TAsmCond): boolean;
 function dwarf_reg(r:tregister):shortint;
 function dwarf_reg_no_error(r:tregister):shortint;
+function eh_return_data_regno(nr: longint): longint;
 
 implementation
 
@@ -566,10 +567,18 @@ begin
     internalerror(200603251);
 end;
 
-    function dwarf_reg_no_error(r:tregister):shortint;
-      begin
-        result:=regdwarf_table[findreg_by_number(r)];
-      end;
+function dwarf_reg_no_error(r:tregister):shortint;
+  begin
+    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+3
+  else
+    result:=-1;
+end;
 
 end.
 

compiler/powerpc64/hlcgcpu.pas

@@ -41,8 +41,6 @@ type
     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
@@ -119,7 +117,7 @@ implementation
     end;
 
 
-  procedure create_hlcodegen;
+  procedure create_hlcodegen_cpu;
     begin
       hlcg:=thlcgcpu.create;
       create_codegen;
@@ -129,4 +127,5 @@ implementation
 
 begin
   chlcgobj:=thlcgcpu;
+  create_hlcodegen:=@create_hlcodegen_cpu;
 end.

compiler/ppu.pas

@@ -58,6 +58,7 @@ const
   uf_smart_linked        = $000040; { the ppu can be smartlinked }
   uf_static_linked       = $000080; { the ppu can be linked static }
   uf_shared_linked       = $000100; { the ppu can be linked shared }
+  uf_lto_linked          = $000200; { the ppu can be used with LTO }
   uf_no_link             = $000400; { unit has no .o generated, but can still have external linking! }
   uf_little_endian       = $001000;
   uf_fpu_emulation       = $008000; { this unit was compiled with fpu emulation on }

compiler/procinfo.pas

@@ -51,9 +51,6 @@ unit procinfo;
        { This object gives information on the current routine being
          compiled.
        }
-
-       { tprocinfo }
-
        tprocinfo = class(tlinkedlistitem)
        private
           { list to store the procinfo's of the nested procedures }
@@ -181,6 +178,16 @@ unit procinfo;
           procedure updatestackalignment(alignment: longint);
           { Specific actions after the code has been generated }
           procedure postprocess_code; virtual;
+
+          { set exception handling info }
+          procedure set_eh_info; virtual;
+
+          procedure setup_eh; virtual;
+          procedure finish_eh; virtual;
+          { called to insert needed eh info into the entry code }
+          procedure start_eh(list : TAsmList); virtual;
+          { called to insert needed eh info into the exit code }
+          procedure end_eh(list : TAsmList); virtual;
        end;
        tcprocinfo = class of tprocinfo;
 
@@ -322,9 +329,40 @@ implementation
           be initialized }
       end;
 
+
     procedure tprocinfo.postprocess_code;
       begin
         { no action by default }
       end;
 
+
+    procedure tprocinfo.set_eh_info;
+      begin
+        { default code is in tcgprocinfo }
+      end;
+
+
+    procedure tprocinfo.setup_eh;
+      begin
+        { no action by default }
+      end;
+
+
+    procedure tprocinfo.finish_eh;
+      begin
+        { no action by default }
+      end;
+
+
+    procedure tprocinfo.start_eh(list: TAsmList);
+      begin
+        { no action by default }
+      end;
+
+
+    procedure tprocinfo.end_eh(list: TAsmList);
+      begin
+        { no action by default }
+      end;
+
 end.

compiler/psabiehpi.pas

@@ -0,0 +1,811 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    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 psabiehpi;
+
+{ $define debug_eh}
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      { common }
+      cclasses,
+      { global }
+      globtype,
+      { symtable }
+      symconst,symtype,symdef,symsym,
+      node,nutils,
+      { aasm }
+      cpubase,cgbase,cgutils,
+      aasmbase,aasmdata,aasmtai,
+      psub;
+
+    type
+       TPSABIEHAction = class
+         landingpad : TAsmLabel;
+         actiontablelabel : TAsmLabel;
+         actionlist : TAsmList;
+         first : boolean;
+         constructor Create(pad : TAsmLabel);
+         destructor Destroy; override;
+         function AddAction(p: tobjectdef): LongInt;
+       end;
+
+       { This object gives information on the current routine being
+         compiled.
+       }
+       tpsabiehprocinfo = class(tcgprocinfo)
+         { set if the procedure needs exception tables because it
+           has exception generating nodes }
+         CreateExceptionTable: Boolean;
+
+         { if a procedure needs exception tables, this is the outmost landing pad
+           with "no action", covering everything not covered by other landing pads
+           since a procedure which has one landing pad need to be covered completely by landing pads }
+         OutmostLandingPad: TPSABIEHAction;
+
+         { This is a "no action" action for re-use, normally equal to OutmostLandingPad }
+         NoAction: TPSABIEHAction;
+
+         { label to language specific data }
+         LSDALabel : TAsmLabel;
+         callsite_table_data,
+         action_table_data,
+         gcc_except_table_data : TAsmList;
+         typefilterlistlabel,typefilterlistlabelref,
+         callsitetablestart,callsitetableend,
+         { first label which must be inserted into the entry code }
+         entrycallsitestart,
+         callsitelaststart : TAsmLabel;
+         typefilterlist,
+         landingpadstack,
+         actionstack : tfplist;
+         CurrentCallSiteNumber : Longint;
+
+         destructor destroy; override;
+
+         { PSABIEH stuff }
+         procedure PushAction(action: TPSABIEHAction);
+         function CurrentAction: TPSABIEHAction;inline;
+         function PopAction(action: TPSABIEHAction): boolean;
+         function FinalizeAndPopAction(action: TPSABIEHAction): boolean;
+         { a landing pad is also an action, however, when the landing pad is popped from the stack
+           the area covered by this landing pad ends, i.e. it is popped at the beginning of the finally/except clause,
+           the action above is popped at the end of the finally/except clause, so if on clauses add new types, they
+           are added to CurrentAction }
+         procedure PushLandingPad(action: TPSABIEHAction);
+         function CurrentLandingPad: TPSABIEHAction;inline;
+         function PopLandingPad(action: TPSABIEHAction): boolean;
+         procedure CreateNewPSABIEHCallsite(list: TAsmList);
+         { adds a new type to the type filter list and returns its index
+           be aware, that this method can also handle catch all filters so it
+           is valid to pass nil }
+         function AddTypeFilter(p: tobjectdef): Longint;
+         procedure set_eh_info; override;
+         procedure setup_eh; override;
+         procedure finish_eh; override;
+         procedure start_eh(list : TAsmList); override;
+         procedure end_eh(list : TAsmList); override;
+
+         function find_exception_handling(var n: tnode; para: pointer): foreachnoderesult; virtual;
+       end;
+
+implementation
+
+    uses
+      cutils,
+      verbose,
+      systems,
+      dwarfbase,
+      cfidwarf,
+      globals,
+      procinfo,
+      symtable,
+      defutil,
+      tgobj,
+      cgobj,cgexcept,
+      parabase,paramgr,
+      hlcgobj,
+      pass_2
+{$ifdef i386}
+      ,aasmcpu
+{$endif i386}
+      ;
+
+
+    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. }
+       tpsabiehexceptionstatehandler = class(tcgexceptionstatehandler)
+       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);
+       public
+         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;
+         { start of "except/finally" block }
+         class procedure emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptionstate: texceptionstate;var exceptiontemps:texceptiontemps); override;
+         { 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); override;
+         class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); override;
+         class procedure handle_reraise(list:TAsmList;const t:texceptiontemps;const entrystate: texceptionstate; const exceptframekind: texceptframekind); override;
+         { start of an "on" (catch) block }
+         class procedure begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister); override;
+         { end of an "on" (catch) block }
+         class procedure end_catch(list: TAsmList); override;
+         { called for a catch all exception }
+         class procedure catch_all_start(list: TAsmList); override;
+         class procedure catch_all_end(list: TAsmList); override;
+         class procedure catch_all_add(list: TAsmList); override;
+         class procedure cleanupobjectstack(list: TAsmList); override;
+         class procedure popaddrstack(list: TAsmList); override;
+       end;
+
+
+    constructor TPSABIEHAction.Create(pad: TAsmLabel);
+      begin
+        landingpad:=pad;
+        actionlist:=TAsmList.create;
+        current_asmdata.getlabel(actiontablelabel,alt_data);
+        actionlist.concat(tai_label.create(actiontablelabel));
+        first:=true;
+      end;
+
+
+    destructor TPSABIEHAction.Destroy;
+      begin
+        if not(actionlist.Empty) then
+          Internalerror(2019020501);
+        actionlist.Free;
+        inherited Destroy;
+      end;
+
+
+    function TPSABIEHAction.AddAction(p: tobjectdef) : LongInt;
+      var
+        index: LongInt;
+      begin
+        { if not first entry, signal that another action follows }
+        if not(first) then
+          actionlist.concat(tai_const.Create_sleb128bit(1));
+        first:=false;
+
+        { catch all? }
+        if p=tobjectdef(-1) then
+          index:=(current_procinfo as tpsabiehprocinfo).AddTypeFilter(nil)
+        else if assigned(p) then
+          index:=(current_procinfo as tpsabiehprocinfo).AddTypeFilter(p)
+        else
+          index:=-1;
+{$ifdef debug_eh}
+        if p=tobjectdef(-1) then
+          actionlist.concat(tai_comment.Create(strpnew('Catch all')))
+        else if assigned(p) then
+          actionlist.concat(tai_comment.Create(strpnew('Action for '+p.GetTypeName)))
+        else
+          actionlist.concat(tai_comment.Create(strpnew('Cleanup')));
+{$endif debug_eh}
+        if assigned(p) then
+          actionlist.concat(tai_const.Create_sleb128bit(index+1))
+        else
+          actionlist.concat(tai_const.Create_sleb128bit(0));
+        Result:=index;
+      end;
+
+{****************************************************************************
+                                 tpsabiehprocinfo
+****************************************************************************}
+
+
+    destructor tpsabiehprocinfo.destroy;
+      begin
+         gcc_except_table_data.free;
+         actionstack.free;
+         landingpadstack.free;
+         typefilterlist.free;
+         callsite_table_data.Free;
+         action_table_data.Free;
+         inherited;
+      end;
+
+
+    procedure tpsabiehprocinfo.PushAction(action: TPSABIEHAction);
+      begin
+        actionstack.add(action);
+      end;
+
+
+    function tpsabiehprocinfo.PopAction(action: TPSABIEHAction): boolean;
+      begin
+        if CurrentAction<>action then
+          internalerror(2019022501);
+        actionstack.count:=actionstack.count-1;
+        result:=actionstack.count=0;
+      end;
+
+
+    function tpsabiehprocinfo.FinalizeAndPopAction(action: TPSABIEHAction): boolean;
+      var
+        curpos: tasmlabel;
+      begin
+        include(flags,pi_has_except_table_data);
+        if CurrentAction<>action then
+          internalerror(2019021006);
+        { no further actions follow, finalize table
+          we check for >1 as the outmost landing pad has no action, so
+          we can ignore it }
+        if landingpadstack.count>1 then
+          begin
+            current_asmdata.getlabel(curpos,alt_data);
+            action.actionlist.concat(tai_label.create(curpos));
+            action.actionlist.concat(tai_const.Create_rel_sym(aitconst_sleb128bit,curpos,TPSABIEHAction(landingpadstack[landingpadstack.count-1]).actiontablelabel));
+          end
+        else
+          action.actionlist.concat(tai_const.Create_sleb128bit(0));
+        action_table_data.concatList(action.actionlist);
+        actionstack.count:=actionstack.count-1;
+        result:=actionstack.count=0;
+      end;
+
+
+    procedure tpsabiehprocinfo.PushLandingPad(action: TPSABIEHAction);
+      begin
+        landingpadstack.add(action);
+      end;
+
+
+    function tpsabiehprocinfo.CurrentLandingPad: TPSABIEHAction;
+      begin
+        result:=TPSABIEHAction(landingpadstack.last);
+      end;
+
+
+    function tpsabiehprocinfo.PopLandingPad(action: TPSABIEHAction): boolean;
+      begin
+        if CurrentLandingPad<>action then
+          internalerror(2019021007);
+        landingpadstack.count:=landingpadstack.count-1;
+        result:=landingpadstack.count=0;
+      end;
+
+
+    procedure tpsabiehprocinfo.CreateNewPSABIEHCallsite(list : TAsmList);
+      var
+        callsiteend : TAsmLabel;
+      begin
+        include(flags,pi_has_except_table_data);
+        { first, finish last entry }
+        if assigned(callsitelaststart) and assigned(CurrentLandingPad) then
+          begin
+{$ifdef debug_eh}
+            if assigned(CurrentLandingPad.actiontablelabel) then
+              callsite_table_data.concat(tai_comment.Create(strpnew('Call site '+tostr(CurrentCallSiteNumber)+', action table index = '+tostr(landingpadstack.count-1))))
+            else
+              callsite_table_data.concat(tai_comment.Create(strpnew('Call site '+tostr(CurrentCallSiteNumber)+', no action')));
+{$endif debug_eh}
+            callsite_table_data.concat(tai_const.create_rel_sym(aitconst_uleb128bit,current_asmdata.AsmCFI.get_frame_start,callsitelaststart));
+            current_asmdata.getlabel(callsiteend,alt_eh_end);
+            list.concat(tai_label.create(callsiteend));
+            callsite_table_data.concat(tai_const.create_rel_sym(aitconst_uleb128bit,callsitelaststart,callsiteend));
+            { landing pad? }
+            if assigned(CurrentLandingPad.landingpad) then
+              callsite_table_data.concat(tai_const.create_rel_sym(aitconst_uleb128bit,current_asmdata.AsmCFI.get_frame_start,CurrentLandingPad.landingpad))
+            else
+              callsite_table_data.concat(tai_const.Create_uleb128bit(0));
+            { action number set? if yes, concat }
+            if assigned(CurrentLandingPad.actiontablelabel) then
+              begin
+                callsite_table_data.concat(tai_const.Create_rel_sym_offset(aitconst_uleb128bit,callsitetableend,CurrentLandingPad.actiontablelabel,1));
+{$ifdef debug_eh}
+                list.concat(tai_comment.Create(strpnew('New call site '+tostr(CurrentCallSiteNumber)+', action table index = '+tostr(landingpadstack.count-1))));
+{$endif debug_eh}
+              end
+            else
+              begin
+                callsite_table_data.concat(tai_const.Create_uleb128bit(0));
+{$ifdef debug_eh}
+                list.concat(tai_comment.Create(strpnew('New call site '+tostr(CurrentCallSiteNumber)+', no action')));
+{$endif debug_eh}
+              end;
+            current_asmdata.getlabel(callsitelaststart,alt_eh_begin);
+            list.concat(tai_label.create(callsitelaststart));
+          end
+        else
+          begin
+            current_asmdata.getlabel(entrycallsitestart,alt_eh_begin);
+            callsitelaststart:=entrycallsitestart
+          end;
+
+        Inc(CurrentCallSiteNumber);
+      end;
+
+
+    function tpsabiehprocinfo.AddTypeFilter(p: tobjectdef) : Longint;
+      var
+        i: Integer;
+      begin
+        for i:=0 to typefilterlist.count-1 do
+          begin
+            if tobjectdef(typefilterlist[i])=p then
+              begin
+                result:=i;
+                exit;
+              end;
+          end;
+        result:=typefilterlist.add(p);
+      end;
+
+
+    procedure tpsabiehprocinfo.set_eh_info;
+      begin
+        inherited set_eh_info;
+        if (tf_use_psabieh in target_info.flags) and not(pi_has_except_table_data in flags) then
+          LSDALabel:=nil
+        else
+          current_asmdata.AsmCFI.get_cfa_list.concat(tdwarfitem.create_sym(DW_Set_LSDALabel,doe_32bit,LSDALabel));
+      end;
+
+
+    function tpsabiehprocinfo.CurrentAction: TPSABIEHAction; inline;
+      begin
+        result:=TPSABIEHAction(actionstack.last);
+      end;
+
+
+    function tpsabiehprocinfo.find_exception_handling(var n: tnode; para: pointer): foreachnoderesult;
+      begin
+        if n.nodetype in [tryfinallyn,tryexceptn,raisen,onn] then
+          Result:=fen_norecurse_true
+        else
+          Result:=fen_false;
+        end;
+
+
+    procedure tpsabiehprocinfo.setup_eh;
+      var
+        gcc_except_table: tai_section;
+      begin
+        if tf_use_psabieh in target_info.flags then
+          begin
+            CreateExceptionTable:=foreachnode(code,@find_exception_handling,nil);
+
+            gcc_except_table_data:=TAsmList.Create;
+            callsite_table_data:=TAsmList.Create;
+            action_table_data:=TAsmList.Create;
+            actionstack:=TFPList.Create;
+            landingpadstack:=TFPList.Create;
+            typefilterlist:=TFPList.Create;
+            gcc_except_table:=new_section(gcc_except_table_data,sec_gcc_except_table,'',0);
+            gcc_except_table.secflags:=SF_A;
+            gcc_except_table.secprogbits:=SPB_PROGBITS;
+{$ifdef debug_eh}
+            gcc_except_table_data.concat(tai_comment.Create(strpnew('gcc_except_table for '+procdef.fullprocname(true))));
+ {$endif debug_eh}
+            current_asmdata.getlabel(LSDALabel,alt_data);
+
+            current_asmdata.getlabel(callsitetablestart,alt_data);
+            current_asmdata.getlabel(callsitetableend,alt_data);
+
+            callsite_table_data.concat(tai_label.create(callsitetablestart));
+            cexceptionstatehandler:=tpsabiehexceptionstatehandler;
+
+            if CreateExceptionTable then
+              begin
+                CreateNewPSABIEHCallsite(current_asmdata.CurrAsmList);
+
+                OutmostLandingPad:=TPSABIEHAction.Create(nil);
+                NoAction:=OutmostLandingPad;
+                PushAction(OutmostLandingPad);
+                PushLandingPad(OutmostLandingPad);
+                OutmostLandingPad.AddAction(nil);
+              end;
+          end;
+      end;
+
+
+    procedure tpsabiehprocinfo.finish_eh;
+      var
+        i: Integer;
+      begin
+        if tf_use_psabieh in target_info.flags then
+          begin
+            if pi_has_except_table_data in flags then
+              begin
+                gcc_except_table_data.concat(tai_label.create(LSDALabel));
+                { landing pad base is relative to procedure start, so write an omit }
+                gcc_except_table_data.concat(tai_const.create_8bit(DW_EH_PE_omit));
+
+                if typefilterlist.count>0 then
+                  begin
+{$if defined(CPU64BITADDR)}
+                    gcc_except_table_data.concat(tai_const.create_8bit(DW_EH_PE_udata8));
+{$elseif defined(CPU32BITADDR)}
+                    gcc_except_table_data.concat(tai_const.create_8bit(DW_EH_PE_udata4));
+{$elseif defined(CPU16BITADDR)}
+                    gcc_except_table_data.concat(tai_const.create_8bit(DW_EH_PE_udata2));
+{$endif}
+                    current_asmdata.getlabel(typefilterlistlabel,alt_data);
+                    current_asmdata.getlabel(typefilterlistlabelref,alt_data);
+                    gcc_except_table_data.concat(tai_const.create_rel_sym(aitconst_uleb128bit,typefilterlistlabel,typefilterlistlabelref));
+                    gcc_except_table_data.concat(tai_label.create(typefilterlistlabel));
+                  end
+                else
+                  { default types table encoding }
+                  gcc_except_table_data.concat(tai_const.create_8bit(DW_EH_PE_omit));
+
+                { call-site table encoded using uleb128 }
+                gcc_except_table_data.concat(tai_const.create_8bit(DW_EH_PE_uleb128));
+                gcc_except_table_data.concat(tai_const.create_rel_sym(aitconst_uleb128bit,callsitetablestart,callsitetableend));
+
+                callsite_table_data.concat(tai_label.create(callsitetableend));
+{$ifdef debug_eh}
+                gcc_except_table_data.concat(tai_comment.Create(strpnew('Call site table for '+procdef.fullprocname(true))));
+{$endif debug_eh}
+                gcc_except_table_data.concatList(callsite_table_data);
+                { action table must follow immediatly after callsite table }
+{$ifdef debug_eh}
+                if not(action_table_data.Empty) then
+                  gcc_except_table_data.concat(tai_comment.Create(strpnew('Action table for '+procdef.fullprocname(true))));
+{$endif debug_eh}
+                gcc_except_table_data.concatlist(action_table_data);
+                if typefilterlist.count>0 then
+                  begin
+{$ifdef debug_eh}
+                    gcc_except_table_data.concat(tai_comment.Create(strpnew('Type filter list for '+procdef.fullprocname(true))));
+{$endif debug_eh}
+                    for i:=typefilterlist.count-1 downto 0 do
+                      begin
+{$ifdef debug_eh}
+                        gcc_except_table_data.concat(tai_comment.Create(strpnew('Type filter '+tostr(i))));
+{$endif debug_eh}
+                        if assigned(typefilterlist[i]) then
+                          gcc_except_table_data.concat(tai_const.Create_sym(current_asmdata.RefAsmSymbol(tobjectdef(typefilterlist[i]).vmt_mangledname, AT_DATA)))
+                        else
+                          gcc_except_table_data.concat(tai_const.Create_sym(nil));
+                      end;
+                    { the types are resolved by the negative offset, so the label must be written after all types }
+                    gcc_except_table_data.concat(tai_label.create(typefilterlistlabelref));
+                  end;
+
+                new_section(gcc_except_table_data,sec_code,'',0);
+                aktproccode.concatlist(gcc_except_table_data);
+              end;
+          end;
+      end;
+
+
+    procedure tpsabiehprocinfo.start_eh(list: TAsmList);
+      begin
+        inherited start_eh(list);
+        if CreateExceptionTable then
+          list.insert(tai_label.create(entrycallsitestart));
+      end;
+
+
+    procedure tpsabiehprocinfo.end_eh(list: TAsmList);
+      begin
+       inherited end_eh(list);
+       if CreateExceptionTable then
+         begin
+           CreateNewPSABIEHCallsite(list);
+           PopLandingPad(CurrentLandingPad);
+           FinalizeAndPopAction(OutmostLandingPad);
+         end;
+      end;
+
+
+    class procedure tpsabiehexceptionstatehandler.get_exception_temps(list: TAsmList; var t: texceptiontemps);
+      begin
+        tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
+      end;
+
+
+    class procedure tpsabiehexceptionstatehandler.unget_exception_temps(list: TAsmList; const t: texceptiontemps);
+      begin
+        tg.ungettemp(list,t.reasonbuf);
+        (current_procinfo as tpsabiehprocinfo).FinalizeAndPopAction((current_procinfo as tpsabiehprocinfo).CurrentAction);
+      end;
+
+
+    class procedure tpsabiehexceptionstatehandler.new_exception(list: TAsmList; const t: texceptiontemps;
+      const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
+      var
+        reg: tregister;
+        action: TPSABIEHAction;
+      begin
+        exceptstate.oldflowcontrol:=flowcontrol;
+        current_asmdata.getjumplabel(exceptstate.exceptionlabel);
+        if exceptframekind<>tek_except then
+          begin
+            current_asmdata.getjumplabel(exceptstate.finallycodelabel);
+            action:=TPSABIEHAction.Create(exceptstate.finallycodelabel);
+          end
+        else
+          begin
+            exceptstate.finallycodelabel:=nil;
+            action:=TPSABIEHAction.Create(exceptstate.exceptionlabel);
+          end;
+        (current_procinfo as tpsabiehprocinfo).CreateNewPSABIEHCallsite(list);
+        (current_procinfo as tpsabiehprocinfo).PushAction(action);
+        (current_procinfo as tpsabiehprocinfo).PushLandingPad(action);
+        if exceptframekind<>tek_except then
+          { no safecall? }
+          if use_cleanup(exceptframekind) then
+            (current_procinfo as tpsabiehprocinfo).CurrentAction.AddAction(nil)
+          else
+            { if safecall, catch all }
+            (current_procinfo as tpsabiehprocinfo).CurrentAction.AddAction(tobjectdef(-1));
+
+        flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
+        if exceptframekind<>tek_except then
+          begin
+            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);
+          end;
+      end;
+
+
+    class procedure tpsabiehexceptionstatehandler.emit_except_label(list: TAsmList; exceptframekind: texceptframekind;
+      var exceptionstate: texceptionstate;var exceptiontemps:texceptiontemps);
+      begin
+        hlcg.g_unreachable(list);
+        hlcg.a_label(list,exceptionstate.exceptionlabel);
+        if exceptframekind<>tek_except then
+          begin
+            if not assigned(exceptionstate.finallycodelabel) then
+              internalerror(2019021002);
+
+            hlcg.a_label(list,exceptionstate.finallycodelabel);
+            exceptionstate.finallycodelabel:=nil;
+            exceptiontemps.unwind_info:=cg.getaddressregister(list);
+            hlcg.a_load_reg_reg(list,voidpointertype,voidpointertype,NR_FUNCTION_RESULT_REG,exceptiontemps.unwind_info);
+          end;
+      end;
+
+
+    class procedure tpsabiehexceptionstatehandler.end_try_block(list: TAsmList; exceptframekind: texceptframekind; const t: texceptiontemps;
+      var exceptionstate: texceptionstate; endlabel: TAsmLabel);
+      var
+        reg: TRegister;
+      begin
+        if exceptframekind<>tek_except then
+          begin
+            { record that no exception happened in the reason buf, in case we are in a try block of a finally statement }
+            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);
+          end;
+        inherited;
+        if exceptframekind=tek_except then
+          hlcg.a_jmp_always(list,endlabel);
+        (current_procinfo as tpsabiehprocinfo).CreateNewPSABIEHCallsite(list);
+        (current_procinfo as tpsabiehprocinfo).PopLandingPad((current_procinfo as tpsabiehprocinfo).CurrentLandingPad);
+      end;
+
+
+    class procedure tpsabiehexceptionstatehandler.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint;
+      endexceptlabel: tasmlabel; onlyfree: boolean);
+      begin
+        { nothing to do }
+      end;
+
+
+    class procedure tpsabiehexceptionstatehandler.handle_reraise(list: TAsmList; const t: texceptiontemps; const entrystate: texceptionstate;
+      const exceptframekind: texceptframekind);
+      var
+        cgpara1: tcgpara;
+        pd: tprocdef;
+        action, ReRaiseLandingPad: TPSABIEHAction;
+        psabiehprocinfo: tpsabiehprocinfo;
+      begin
+        if not(fc_catching_exceptions in flowcontrol) and
+           use_cleanup(exceptframekind) then
+          begin
+            { Resume might not be called outside of an landing pad else
+              the unwind is immediatly terminated, so create an empty landing pad }
+            psabiehprocinfo:=current_procinfo as tpsabiehprocinfo;
+
+            if psabiehprocinfo.landingpadstack.count>1 then
+              begin
+                psabiehprocinfo.CreateNewPSABIEHCallsite(list);
+
+                psabiehprocinfo.PushAction(psabiehprocinfo.NoAction);
+                psabiehprocinfo.PushLandingPad(psabiehprocinfo.NoAction);
+              end;
+
+            pd:=search_system_proc('_unwind_resume');
+            cgpara1.init;
+            paramanager.getintparaloc(list,pd,1,cgpara1);
+            hlcg.a_load_reg_cgpara(list,voidpointertype,t.unwind_info,cgpara1);
+            paramanager.freecgpara(list,cgpara1);
+            hlcg.g_call_system_proc(list,'_unwind_resume',[@cgpara1],nil).resetiftemp;
+            { we do not have to clean up the stack, we never return }
+            cgpara1.done;
+
+            if psabiehprocinfo.landingpadstack.count>1 then
+              begin
+                psabiehprocinfo.CreateNewPSABIEHCallsite(list);
+                psabiehprocinfo.PopLandingPad(psabiehprocinfo.NoAction);
+                psabiehprocinfo.PopAction(psabiehprocinfo.NoAction);
+              end;
+          end
+        else
+          begin
+            psabiehprocinfo:=current_procinfo as tpsabiehprocinfo;
+            { empty landing pad needed to avoid immediate termination? }
+            if psabiehprocinfo.landingpadstack.Count=0 then
+              begin
+                psabiehprocinfo.CreateNewPSABIEHCallsite(list);
+
+                ReRaiseLandingPad:=psabiehprocinfo.NoAction;
+                psabiehprocinfo.PushAction(ReRaiseLandingPad);
+                psabiehprocinfo.PushLandingPad(ReRaiseLandingPad);
+              end
+            else
+              ReRaiseLandingPad:=nil;
+            hlcg.g_call_system_proc(list,'fpc_reraise',[],nil).resetiftemp;
+            if assigned(ReRaiseLandingPad) then
+              begin
+                psabiehprocinfo.CreateNewPSABIEHCallsite(list);
+                psabiehprocinfo.PopLandingPad(psabiehprocinfo.CurrentLandingPad);
+                psabiehprocinfo.PopAction(ReRaiseLandingPad);
+             end;
+          end;
+      end;
+
+
+    class procedure tpsabiehexceptionstatehandler.begin_catch_internal(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel;
+      add_catch: boolean; out exceptlocdef: tdef; out exceptlocreg: tregister);
+      var
+        catchstartlab : tasmlabel;
+        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;
+        typeindex : aint;
+      begin
+        paraloc1.init;
+        rttidef:=nil;
+        rttisym:=nil;
+        wrappedexception:=hlcg.getaddressregister(list,voidpointertype);
+        hlcg.a_load_reg_reg(list,voidpointertype,voidpointertype,NR_FUNCTION_RESULT_REG,wrappedexception);
+        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);
+              end;
+          end;
+        { check if the exception is handled by this node }
+        if assigned(excepttype) then
+          begin
+            typeindex:=(current_procinfo as tpsabiehprocinfo).CurrentAction.AddAction(excepttype);
+            current_asmdata.getjumplabel(catchstartlab);
+{$if defined(i386)}
+            hlcg.a_cmp_const_reg_label (list,osuinttype,OC_EQ,typeindex+1,NR_FUNCTION_RESULT64_HIGH_REG,catchstartlab);
+{$elseif defined(x86_64)}
+            hlcg.a_cmp_const_reg_label (list,s32inttype,OC_EQ,typeindex+1,NR_EDX,catchstartlab);
+{$else}
+            { we need to find a way to fix this in a generic way }
+            Internalerror(2019021008);
+{$endif}
+            hlcg.a_jmp_always(list,nextonlabel);
+            hlcg.a_label(list,catchstartlab);
+          end
+        else
+          (current_procinfo as tpsabiehprocinfo).CurrentAction.AddAction(tobjectdef(-1));
+
+        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 tpsabiehexceptionstatehandler.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;
+
+
+    class procedure tpsabiehexceptionstatehandler.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 tpsabiehexceptionstatehandler.end_catch(list: TAsmList);
+      begin
+        hlcg.g_call_system_proc(list,'fpc_psabi_end_catch',[],nil).resetiftemp;
+        inherited;
+      end;
+
+
+    class procedure tpsabiehexceptionstatehandler.catch_all_start(list: TAsmList);
+      begin
+        catch_all_start_internal(list,true);
+      end;
+
+
+    class procedure tpsabiehexceptionstatehandler.catch_all_add(list: TAsmList);
+      begin
+        (current_procinfo as tpsabiehprocinfo).CurrentAction.AddAction(nil);
+      end;
+
+
+    class procedure tpsabiehexceptionstatehandler.catch_all_end(list: TAsmList);
+      begin
+        hlcg.g_call_system_proc(list,'fpc_psabi_end_catch',[],nil).resetiftemp;
+      end;
+
+
+    class procedure tpsabiehexceptionstatehandler.cleanupobjectstack(list: TAsmList);
+      begin
+        { there is nothing to do }
+      end;
+
+
+    class procedure tpsabiehexceptionstatehandler.popaddrstack(list: TAsmList);
+      begin
+        { there is no addr stack, so do nothing }
+      end;
+
+end.

compiler/pstatmnt.pas

@@ -874,6 +874,7 @@ implementation
          t:ttoken;
          unit_found:boolean;
          oldcurrent_exceptblock: integer;
+         filepostry : tfileposinfo;
       begin
          p_default:=nil;
          p_specific:=nil;
@@ -882,6 +883,7 @@ implementation
 
          { read statements to try }
          consume(_TRY);
+         filepostry:=current_filepos;
          first:=nil;
          inc(exceptblockcounter);
          oldcurrent_exceptblock := current_exceptblock;
@@ -913,6 +915,7 @@ implementation
               current_exceptblock := exceptblockcounter;
               p_finally_block:=statements_til_end;
               try_statement:=ctryfinallynode.create(p_try_block,p_finally_block);
+              try_statement.fileinfo:=filepostry;
            end
          else
            begin

compiler/psub.pas

@@ -23,6 +23,8 @@ unit psub;
 
 {$i fpcdefs.inc}
 
+{ $define debug_eh}
+
 interface
 
     uses
@@ -65,6 +67,7 @@ interface
         procedure parse_body;
 
         function has_assembler_child : boolean;
+        procedure set_eh_info; override;
       end;
 
 
@@ -92,7 +95,7 @@ implementation
     uses
        sysutils,
        { common }
-       cutils, cmsgs,
+       cutils, cmsgs, cclasses,
        { global }
        globtype,tokens,verbose,comphook,constexp,
        systems,cpubase,aasmbase,aasmtai,aasmdata,
@@ -115,11 +118,10 @@ implementation
        pbase,pstatmnt,pdecl,pdecsub,pexports,pgenutil,pparautl,
        { codegen }
        tgobj,cgbase,cgobj,hlcgobj,hlcgcpu,dbgbase,
-{$ifdef llvm}
-      { override create_hlcodegen from hlcgcpu }
-      hlcgllvm,
-{$endif}
+
+       ncgflw,
        ncgutil,
+
        optbase,
        opttail,
        optcse,
@@ -1138,6 +1140,19 @@ implementation
           end;
       end;
 
+
+    procedure tcgprocinfo.set_eh_info;
+      begin
+        inherited;
+         if (tf_use_psabieh in target_info.flags) and
+            ((pi_uses_exceptions in flags) or
+             ((cs_implicit_exceptions in current_settings.moduleswitches) and
+              (pi_needs_implicit_finally in flags))) or
+             (pi_has_except_table_data in flags) then
+           procdef.personality:=search_system_proc('_FPC_PSABIEH_PERSONALITY_V0');
+      end;
+
+
     procedure tcgprocinfo.generate_code_tree;
       var
         hpi : tcgprocinfo;
@@ -1519,6 +1534,8 @@ implementation
           begin
             create_hlcodegen;
 
+            setup_eh;
+
             if (procdef.proctypeoption<>potype_exceptfilter) then
               setup_tempgen;
 
@@ -1739,6 +1756,9 @@ implementation
                 hlcg.gen_stack_check_size_para(templist);
                 aktproccode.insertlistafter(stackcheck_asmnode.currenttai,templist)
               end;
+
+            current_procinfo.set_eh_info;
+
             { Add entry code (stack allocation) after header }
             current_filepos:=entrypos;
             gen_proc_entry_code(templist);
@@ -1764,6 +1784,14 @@ implementation
                not(target_info.system in systems_garbage_collected_managed_types) then
              internalerror(200405231);
 
+             { sanity check }
+             if not(assigned(current_procinfo.procdef.personality)) and
+                (tf_use_psabieh in target_info.flags) and
+                ((pi_uses_exceptions in flags) or
+                 ((cs_implicit_exceptions in current_settings.moduleswitches) and
+                  (pi_needs_implicit_finally in flags))) then
+               Internalerror(2019021005);
+
             { Position markers are only used to insert additional code after the secondpass
               and before this point. They are of no use in optimizer. Instead of checking and
               ignoring all over the optimizer, just remove them here. }
@@ -1808,6 +1836,8 @@ implementation
                (cs_use_lineinfo in current_settings.globalswitches) then
               current_debuginfo.insertlineinfo(aktproccode);
 
+            finish_eh;
+
             hlcg.record_generated_code_for_procdef(current_procinfo.procdef,aktproccode,aktlocaldata);
 
             { only now we can remove the temps }

compiler/psystem.pas

@@ -111,6 +111,7 @@ implementation
         systemunit.insert(csyssym.create('Insert',in_insert_x_y_z));
         systemunit.insert(csyssym.create('Delete',in_delete_x_y_z));
         systemunit.insert(csyssym.create('GetTypeKind',in_gettypekind_x));
+        systemunit.insert(csyssym.create('fpc_eh_return_data_regno', in_const_eh_return_data_regno));
         systemunit.insert(cconstsym.create_ord('False',constord,0,pasbool1type));
         systemunit.insert(cconstsym.create_ord('True',constord,1,pasbool1type));
       end;
@@ -618,6 +619,11 @@ implementation
         addfield(hrecst,cfieldvarsym.create('$parentfp',vs_value,parentfpvoidpointertype,[],true));
         nestedprocpointertype:=crecorddef.create('',hrecst);
         addtype('$nestedprocpointer',nestedprocpointertype);
+{$ifdef llvm}
+        llvm_metadatatype:=cpointerdef.create(voidtype);
+        { if this gets renamed, also adjust agllvm so it still writes the identifier of this type as "metadata" }
+        addtype('$metadata',llvm_metadatatype);
+{$endif}
         symtablestack.pop(systemunit);
       end;
 
@@ -733,6 +739,9 @@ implementation
           end;
         loadtype('methodpointer',methodpointertype);
         loadtype('nestedprocpointer',nestedprocpointertype);
+{$ifdef llvm}
+        loadtype('metadata',llvm_metadatatype);
+{$endif}
         loadtype('HRESULT',hresultdef);
         loadtype('TTYPEKIND',typekindtype);
         set_default_int_types;

compiler/rautils.pas

@@ -217,7 +217,7 @@ uses
   defutil,systems,verbose,globals,
   symtable,paramgr,
   aasmcpu,
-  procinfo;
+  procinfo,ngenutil;
 
 {*************************************************************************
                               TExprParse
@@ -1391,6 +1391,26 @@ begin
       srsym:=tprocdef(srsymtable.defowner).procsym;
       srsymtable:=srsym.Owner;
     end;
+  { llvm can't catch symbol references from inline assembler blocks }
+  if assigned(srsym) then
+    begin
+      case srsym.typ of
+         staticvarsym:
+           if not(vo_is_external in tstaticvarsym(srsym).varoptions) then
+             cnodeutils.RegisterUsedAsmSym(current_asmdata.RefAsmSymbol(srsym.mangledname,AT_DATA),tstaticvarsym(srsym).vardef,true);
+         procsym:
+           begin
+             { if it's a pure assembler routine, the definition of the symbol will also
+               be in assembler and it can't be removed by the compiler (and if we mark
+               it as used anyway, clang will get into trouble) }
+             if not(po_assembler in tprocdef(tprocsym(srsym).ProcdefList[0]).procoptions) and
+                not(po_external in tprocdef(tprocsym(srsym).ProcdefList[0]).procoptions) then
+               cnodeutils.RegisterUsedAsmSym(current_asmdata.RefAsmSymbol(tprocdef(tprocsym(srsym).ProcdefList[0]).mangledname,AT_FUNCTION),tprocdef(tprocsym(srsym).ProcdefList[0]),true);
+           end;
+         else
+           ;
+      end;
+    end;
 end;
 
 

compiler/riscv/hlcgrv.pas

@@ -256,5 +256,16 @@ implementation
       list.concat(Tai_symbol_end.Create(sym));
     end;
 
+
+  procedure create_hlcodegen_cpu;
+    begin
+      hlcg:=thlcgriscv.create;
+//      create_codegen;
+    end;
+
+
+begin
+  chlcgobj:=thlcgriscv;
+  create_hlcodegen:=@create_hlcodegen_cpu;
 end.
 

compiler/riscv32/cpubase.pas

@@ -330,6 +330,7 @@ uses
     function inverse_cond(const c: TAsmCond): Tasmcond; {$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 conditions_equal(const c1,c2: TAsmCond): boolean;
 
@@ -446,6 +447,14 @@ implementation
         result:=regdwarf_table[findreg_by_number(r)];
       end;
 
+    function eh_return_data_regno(nr: longint): longint;
+      begin
+        if (nr>=0) and (nr<4) then
+          result:=nr+10
+        else
+          result:=-1;
+      end;
+
     function conditions_equal(const c1, c2: TAsmCond): boolean;
       begin
         result:=c1=c2;