Prechádzať zdrojové kódy

Synchronized with trunk, part 2 (make all works, avx-512 support not yet tested, no regression testing yet)

git-svn-id: branches/tg74/avx512@42643 -
florian 6 rokov pred
rodič
commit
f883dd6dbb
100 zmenil súbory, kde vykonal 5540 pridanie a 936 odobranie
  1. 950 11
      .gitattributes
  2. 5 4
      Makefile
  3. 21 11
      compiler/Makefile
  4. 14 5
      compiler/Makefile.fpc
  5. 10 0
      compiler/aarch64/cpubase.pas
  6. 6 0
      compiler/aarch64/cpuinfo.pas
  7. 7 4
      compiler/aarch64/cpunode.pas
  8. 5 4
      compiler/aarch64/hlcgcpu.pas
  9. 9 5
      compiler/aasmbase.pas
  10. 198 0
      compiler/aasmcfi.pas
  11. 10 12
      compiler/aasmcnst.pas
  12. 39 1
      compiler/aasmdata.pas
  13. 110 4
      compiler/aasmtai.pas
  14. 79 16
      compiler/aggas.pas
  15. 5 2
      compiler/aoptobj.pas
  16. 3 3
      compiler/arm/aasmcpu.pas
  17. 43 1
      compiler/arm/cgcpu.pas
  18. 10 0
      compiler/arm/cpubase.pas
  19. 42 0
      compiler/arm/cpuinfo.pas
  20. 8 4
      compiler/arm/cpunode.pas
  21. 2 2
      compiler/arm/cpupara.pas
  22. 3 4
      compiler/arm/hlcgcpu.pas
  23. 5 1
      compiler/arm/narmadd.pas
  24. 1 1
      compiler/arm/narmcal.pas
  25. 1 5
      compiler/arm/narmcnv.pas
  26. 2 2
      compiler/arm/narmcon.pas
  27. 17 8
      compiler/arm/narminl.pas
  28. 2 0
      compiler/arm/narmmat.pas
  29. 1 1
      compiler/armgen/armpara.pas
  30. 28 11
      compiler/assemble.pas
  31. 344 122
      compiler/avr/cgcpu.pas
  32. 8 0
      compiler/avr/cpubase.pas
  33. 2 0
      compiler/avr/cpuinfo.pas
  34. 2 3
      compiler/avr/hlcgcpu.pas
  35. 23 0
      compiler/avr/navradd.pas
  36. 25 1
      compiler/avr/navrinl.pas
  37. 2 0
      compiler/ccharset.pas
  38. 290 77
      compiler/cfidwarf.pas
  39. 1 1
      compiler/cgbase.pas
  40. 353 0
      compiler/cgexcept.pas
  41. 9 2
      compiler/cgobj.pas
  42. 1 0
      compiler/compinnr.pas
  43. 1 2
      compiler/cresstr.pas
  44. 19 19
      compiler/cstreams.pas
  45. 6 6
      compiler/cutils.pas
  46. 16 0
      compiler/dbgdwarf.pas
  47. 3 3
      compiler/defcmp.pas
  48. 149 29
      compiler/defutil.pas
  49. 90 0
      compiler/dwarfbase.pas
  50. 19 0
      compiler/elfbase.pas
  51. 38 32
      compiler/entfile.pas
  52. 1 0
      compiler/expunix.pas
  53. 18 0
      compiler/finput.pas
  54. 21 6
      compiler/fmodule.pas
  55. 2 0
      compiler/fpcdefs.inc
  56. 13 2
      compiler/fppu.pas
  57. 2 0
      compiler/generic/cpuinfo.pas
  58. 9 6
      compiler/globals.pas
  59. 17 6
      compiler/globtype.pas
  60. 4 14
      compiler/hlcgobj.pas
  61. 5 2
      compiler/i386/aoptcpu.pas
  62. 1 0
      compiler/i386/cgcpu.pas
  63. 2 2
      compiler/i386/cpupi.pas
  64. 0 1
      compiler/i386/cputarg.pas
  65. 7 8
      compiler/i386/hlcgcpu.pas
  66. 4 4
      compiler/i386/n386add.pas
  67. 3 4
      compiler/i8086/hlcgcpu.pas
  68. 6 3
      compiler/i8086/n8086add.pas
  69. 12 0
      compiler/i8086/n8086con.pas
  70. 6 0
      compiler/jvm/cpubase.pas
  71. 2 0
      compiler/jvm/cpuinfo.pas
  72. 2 3
      compiler/jvm/hlcgcpu.pas
  73. 66 56
      compiler/link.pas
  74. 134 28
      compiler/llvm/aasmllvm.pas
  75. 187 0
      compiler/llvm/aasmllvmmetadata.pas
  76. 371 100
      compiler/llvm/agllvm.pas
  77. 136 65
      compiler/llvm/hlcgllvm.pas
  78. 1 0
      compiler/llvm/itllvm.pas
  79. 58 4
      compiler/llvm/llvmbase.pas
  80. 147 0
      compiler/llvm/llvmcfi.pas
  81. 26 10
      compiler/llvm/llvmdef.pas
  82. 118 52
      compiler/llvm/llvminfo.pas
  83. 4 3
      compiler/llvm/llvmnode.pas
  84. 41 19
      compiler/llvm/llvmpara.pas
  85. 476 0
      compiler/llvm/llvmpi.pas
  86. 134 66
      compiler/llvm/llvmtype.pas
  87. 3 2
      compiler/llvm/nllvmbas.pas
  88. 15 2
      compiler/llvm/nllvmcnv.pas
  89. 81 6
      compiler/llvm/nllvmflw.pas
  90. 75 0
      compiler/llvm/nllvminl.pas
  91. 53 0
      compiler/llvm/nllvmset.pas
  92. 15 12
      compiler/llvm/nllvmtcon.pas
  93. 196 11
      compiler/llvm/nllvmutil.pas
  94. 10 10
      compiler/llvm/rgllvm.pas
  95. 5 0
      compiler/llvm/tgllvm.pas
  96. 1 2
      compiler/m68k/ag68kvasm.pas
  97. 6 0
      compiler/m68k/cpubase.pas
  98. 2 0
      compiler/m68k/cpuinfo.pas
  99. 3 4
      compiler/m68k/hlcgcpu.pas
  100. 2 4
      compiler/m68k/n68kadd.pas

Rozdielové dáta súboru neboli zobrazené, pretože súbor je príliš veľký
+ 950 - 11
.gitattributes


+ 5 - 4
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

+ 21 - 11
compiler/Makefile

@@ -496,6 +496,14 @@ endif
 NOCPUDEF=1
 MSGFILE=msg/error$(FPCLANG).msg
 SVNVERSION:=$(firstword $(wildcard $(addsuffix /svnversion$(SRCEXEEXT),$(SEARCHPATH))))
+PPUDUMPPROG:=$(firstword $(strip $(wildcard $(addsuffix /ppudump$(SRCEXEEXT),$(SEARCHPATH)))))
+ifndef PPUDUMP
+ifdef PPUDUMPPROG
+PPUDUMP=$(PPUDUMPPROG)
+else
+PPUDUMP=ppudump
+endif
+endif
 REVINC:=$(wildcard revision.inc)
 ifneq ($(REVINC),)
 override LOCALOPT+=-dREVINC
@@ -513,11 +521,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 +2468,7 @@ EXEEXT=.exe
 PPLEXT=.ppl
 PPUEXT=.ppu
 OEXT=.o
+LTOEXT=.bc
 ASMEXT=.s
 SMARTEXT=.sl
 STATICLIBEXT=.a
@@ -3407,7 +3416,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 +3445,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 +3476,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 +3519,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 +3680,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 +3731,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
@@ -4213,7 +4223,7 @@ ifdef CMP
 override DIFF:=$(CMP) -i218
 endif
 endif
-ifeq ($(findstring 2.4.,$(FPC_VERSION)),)
+ifneq ($(CYCLELEVEL),1)
 ifndef ALLOW_WARNINGS
 override LOCALOPT+=-Sew
 endif
@@ -4691,7 +4701,7 @@ rtlppulogs : $(RTLPPULOGLIST)
 vpath %.ppu $(PPUDIR) $(RTLPPUDIR) $(ALLPPUDIR)
 vpath %.log-ppu $(PPUDIR) $(RTLPPUDIR) $(ALLPPUDIR)
 %.log-ppu : %.ppu
-	ppudump -VA -M $< > $@
+	$(PPUDUMP) -VA -M $< > $@
 ./utils/ppudump$(EXEEXT):
 	$(MAKE) -C $(COMPILERUTILSDIR) ppudump$(EXEEXT)
 ppuinfo :

+ 14 - 5
compiler/Makefile.fpc

@@ -235,6 +235,15 @@ MSGFILE=msg/error$(FPCLANG).msg
 
 
 SVNVERSION:=$(firstword $(wildcard $(addsuffix /svnversion$(SRCEXEEXT),$(SEARCHPATH))))
+PPUDUMPPROG:=$(firstword $(strip $(wildcard $(addsuffix /ppudump$(SRCEXEEXT),$(SEARCHPATH)))))
+ifndef PPUDUMP
+ifdef PPUDUMPPROG
+PPUDUMP=$(PPUDUMPPROG)
+else
+PPUDUMP=ppudump
+endif
+endif
+
 # Check if revision.inc is present
 REVINC:=$(wildcard revision.inc)
 ifneq ($(REVINC),)
@@ -261,12 +270,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
@@ -408,7 +417,7 @@ endif
 
 # Use -Sew option by default
 # Allow disabling by setting ALLOW_WARNINGS=1
-ifeq ($(findstring 2.4.,$(FPC_VERSION)),)
+ifneq ($(CYCLELEVEL),1)
 ifndef ALLOW_WARNINGS
 override LOCALOPT+=-Sew
 endif
@@ -1121,7 +1130,7 @@ vpath %.log-ppu $(PPUDIR) $(RTLPPUDIR) $(ALLPPUDIR)
 
 # Use installed ppudump
 %.log-ppu : %.ppu
-	ppudump -VA -M $< > $@
+	$(PPUDUMP) -VA -M $< > $@
 
 
 ./utils/ppudump$(EXEEXT):

+ 10 - 0
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.

+ 6 - 0
compiler/aarch64/cpuinfo.pas

@@ -14,6 +14,8 @@
 
 Unit CPUInfo;
 
+{$i fpcdefs.inc}
+
 Interface
 
   uses
@@ -56,6 +58,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 ;-) *)

+ 7 - 4
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.

+ 5 - 4
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
@@ -163,7 +161,7 @@ implementation
       if make_global then
         list.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0,procdef))
       else
-        list.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0,procdef));
+        list.concat(Tai_symbol.Createname_hidden(labelname,AT_FUNCTION,0,procdef));
 
       { set param1 interface to self  }
       procdef.init_paraloc_info(callerside);
@@ -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.

+ 9 - 5
compiler/aasmbase.pas

@@ -39,8 +39,10 @@ interface
     type
        TAsmsymbind=(
          AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL,AB_WEAK_EXTERNAL,
-         { global in the current program/library, but not visible outside it }
-         AB_PRIVATE_EXTERN,AB_LAZY,AB_IMPORT,
+         { global in the current program/library, but not visible outside it
+           (= "hidden" in ELF) }
+         AB_PRIVATE_EXTERN,
+         AB_LAZY,AB_IMPORT,
          { a symbol that's internal to the compiler and used as a temp }
          AB_TEMP,
          { a global symbol that points to another global symbol and is only used
@@ -74,10 +76,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 +168,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;

+ 198 - 0
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.
+

+ 10 - 12
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);
@@ -393,7 +393,7 @@ type
         maxcrecordalign: specify maximum C record alignment (no equivalent in
           source code)
      }
-     function begin_anonymous_record(const optionalname: string; packrecords, recordalign, recordalignmin, maxcrecordalign: shortint): trecorddef; virtual;
+     function begin_anonymous_record(const optionalname: string; packrecords, recordalign, recordalignmin: shortint): trecorddef; virtual;
      function end_anonymous_record: trecorddef; virtual;
 
      { add a placeholder element at the current position that later can be
@@ -1399,7 +1399,7 @@ implementation
        result.ofs:=0;
        { pack the data, so that we don't add unnecessary null bytes after the
          constant string }
-       begin_anonymous_record('$'+get_dynstring_rec_name(stringtype,false,len),1,sizeof(TConstPtrUInt),1,1);
+       begin_anonymous_record('$'+get_dynstring_rec_name(stringtype,false,len),1,sizeof(TConstPtrUInt),1);
        string_symofs:=get_string_symofs(stringtype,false);
        { encoding }
        emit_tai(tai_const.create_16bit(encoding),u16inttype);
@@ -1611,7 +1611,7 @@ implementation
        if (typ<>st_widestring) or
           not winlike then
          begin
-           result:=crecorddef.create_global_internal('$'+name,1,1,1);
+           result:=crecorddef.create_global_internal('$'+name,1,1);
            { encoding }
            result.add_field_by_def('',u16inttype);
            { element size }
@@ -1637,8 +1637,7 @@ implementation
        else
          begin
            result:=crecorddef.create_global_internal('$'+name,4,
-             targetinfos[target_info.system]^.alignment.recordalignmin,
-             targetinfos[target_info.system]^.alignment.maxCrecordalign);
+             targetinfos[target_info.system]^.alignment.recordalignmin);
            { length in bytes }
            result.add_field_by_def('',s32inttype);
            streledef:=cwidechartype;
@@ -1689,8 +1688,7 @@ implementation
            result.lab:=startlab;
            datatcb.begin_anonymous_record('$'+get_dynstring_rec_name(st_widestring,true,strlength),
              4,4,
-             targetinfos[target_info.system]^.alignment.recordalignmin,
-             targetinfos[target_info.system]^.alignment.maxCrecordalign);
+             targetinfos[target_info.system]^.alignment.recordalignmin);
            datatcb.emit_tai(Tai_const.Create_32bit(strlength*cwidechartype.size),s32inttype);
            { can we optimise by placing the string constant label at the
              required offset? }
@@ -1749,7 +1747,7 @@ implementation
        result.ofs:=0;
        { pack the data, so that we don't add unnecessary null bytes after the
          constant string }
-       begin_anonymous_record('',1,sizeof(TConstPtrUInt),1,1);
+       begin_anonymous_record('',1,sizeof(TConstPtrUInt),1);
        dynarray_symofs:=get_dynarray_symofs;
        { what to do if ptrsinttype <> sizesinttype??? }
        emit_tai(tai_const.create_sizeint(-1),ptrsinttype);
@@ -1928,7 +1926,7 @@ implementation
      end;
 
 
-   function ttai_typedconstbuilder.begin_anonymous_record(const optionalname: string; packrecords, recordalign, recordalignmin, maxcrecordalign: shortint): trecorddef;
+   function ttai_typedconstbuilder.begin_anonymous_record(const optionalname: string; packrecords, recordalign, recordalignmin: shortint): trecorddef;
      var
        anonrecorddef: trecorddef;
        typesym: ttypesym;
@@ -1949,7 +1947,7 @@ implementation
              end;
          end;
        { create skeleton def }
-       anonrecorddef:=crecorddef.create_global_internal(optionalname,packrecords,recordalignmin,maxcrecordalign);
+       anonrecorddef:=crecorddef.create_global_internal(optionalname,packrecords,recordalignmin);
        trecordsymtable(anonrecorddef.symtable).recordalignment:=recordalign;
        { generic aggregate housekeeping }
        begin_aggregate_internal(anonrecorddef,true);

+ 39 - 1
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;
 
@@ -195,6 +198,7 @@ interface
         { asmsymbol }
         function  DefineAsmSymbolByClass(symclass: TAsmSymbolClass; const s : TSymStr;_bind:TAsmSymBind;_typ:Tasmsymtype; def: tdef) : TAsmSymbol; virtual;
         function  DefineAsmSymbol(const s : TSymStr;_bind:TAsmSymBind;_typ:Tasmsymtype; def: tdef) : TAsmSymbol;
+        function  DefineProcAsmSymbol(pd: tdef; const s: TSymStr; global: boolean): TAsmSymbol;
         function  WeakRefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype) : TAsmSymbol;
         function  RefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype;indirect:boolean=false) : TAsmSymbol;
         function  GetAsmSymbol(const s : TSymStr) : TAsmSymbol;
@@ -245,6 +249,7 @@ implementation
 
     uses
       verbose,
+      globals,
       symconst,
       aasmtai;
 
@@ -285,6 +290,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 +314,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
 *****************************************************************************}
@@ -552,6 +574,21 @@ implementation
       end;
 
 
+    function TAsmData.DefineProcAsmSymbol(pd: tdef; const s: TSymStr; global: boolean): TAsmSymbol;
+      begin
+        { The condition to use global or local symbol must match
+          the code written in hlcg.gen_proc_symbol to
+          avoid change from AB_LOCAL to AB_GLOBAL, which generates
+          erroneous code (at least for targets using GOT) }
+        if global or
+           (cs_profile in current_settings.moduleswitches) then
+          result:=DefineAsmSymbol(s,AB_GLOBAL,AT_FUNCTION,pd)
+        else if tf_supports_hidden_symbols in target_info.flags then
+          result:=DefineAsmSymbol(s,AB_PRIVATE_EXTERN,AT_FUNCTION,pd)
+        else
+          result:=DefineAsmSymbol(s,AB_LOCAL,AT_FUNCTION,pd);
+      end;
+
     function TAsmData.RefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype;indirect:boolean) : TAsmSymbol;
       var
         namestr : TSymStr;
@@ -674,7 +711,8 @@ initialization
   memasmlists:=TMemDebug.create('AsmLists');
   memasmlists.stop;
 {$endif MEMDEBUG}
-  CAsmCFI:=TAsmCFI;
+  if not(assigned(CAsmCFI)) then
+    CAsmCFI:=TAsmCFI;
 
 finalization
 {$ifdef MEMDEBUG}

+ 110 - 4
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
                     ];
 
 
@@ -477,6 +491,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);
@@ -539,6 +554,7 @@ interface
           constructor Create_Global(_sym:tasmsymbol;siz:longint);
           constructor Createname(const _name : string;_symtyp:Tasmsymtype;siz:longint;def:tdef);
           constructor Createname_global(const _name : string;_symtyp:Tasmsymtype;siz:longint;def:tdef);
+          constructor Createname_hidden(const _name : string;_symtyp:Tasmsymtype;siz:longint;def:tdef);
           constructor Createname_global_value(const _name : string;_symtyp:Tasmsymtype;siz:longint;val:ptruint;def:tdef);
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -622,6 +638,7 @@ interface
           sym       : tasmsymbol;
           size      : asizeint;
           constructor Create(const _name : string;_size : asizeint; def: tdef);
+          constructor Create_hidden(const _name : string;_size : asizeint; def: tdef);
           constructor Create_global(const _name : string;_size : asizeint; def: tdef);
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -641,6 +658,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);
@@ -685,6 +705,9 @@ interface
           constructor Create_int_codeptr_unaligned(_value: int64);
           constructor Create_int_dataptr(_value: int64);
           constructor Create_int_dataptr_unaligned(_value: int64);
+{$ifdef avr}
+          constructor Create_int_dataptr_unaligned(_value: int64; size: taiconst_type);
+{$endif}
 {$ifdef i8086}
           constructor Create_seg_name(const name:string);
           constructor Create_dgroup;
@@ -695,6 +718,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 }
@@ -1271,6 +1297,23 @@ implementation
          is_global:=false;
       end;
 
+    constructor tai_datablock.Create_hidden(const _name: string; _size: asizeint; def: tdef);
+      begin
+        if tf_supports_hidden_symbols in target_info.flags then
+          begin
+            inherited Create;
+            typ:=ait_datablock;
+            sym:=current_asmdata.DefineAsmSymbol(_name,AB_PRIVATE_EXTERN,AT_DATA,def);
+            { keep things aligned }
+            if _size<=0 then
+              _size:=sizeof(aint);
+            size:=_size;
+            is_global:=true;
+          end
+        else
+          Create(_name,_size,def);
+      end;
+
 
     constructor tai_datablock.Create_global(const _name : string;_size : asizeint; def: tdef);
       begin
@@ -1359,6 +1402,20 @@ implementation
          is_global:=true;
       end;
 
+    constructor tai_symbol.Createname_hidden(const _name: string; _symtyp: Tasmsymtype; siz: longint; def: tdef);
+      begin
+        if tf_supports_hidden_symbols in target_info.flags then
+          begin
+            inherited Create;
+            typ:=ait_symbol;
+            sym:=current_asmdata.DefineAsmSymbol(_name,AB_PRIVATE_EXTERN,_symtyp,def);
+            size:=siz;
+            is_global:=true;
+          end
+        else
+          Createname(_name, _symtyp, siz, def);
+      end;
+
 
     constructor tai_symbol.createname_global_value(const _name: string;_symtyp: tasmsymtype; siz: longint; val: ptruint;def:tdef);
       begin
@@ -1911,6 +1968,20 @@ implementation
       end;
 
 
+{$ifdef avr}
+    constructor tai_const.Create_int_dataptr_unaligned(_value: int64;
+      size: taiconst_type);
+      begin
+        inherited Create;
+        typ:=ait_const;
+        consttype:=size;
+        sym:=nil;
+        endsym:=nil;
+        symofs:=0;
+        value:=_value;
+      end;
+{$endif avr}
+
 {$ifdef i8086}
     constructor tai_const.Create_seg_name(const name:string);
       begin
@@ -1990,9 +2061,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;
@@ -2012,6 +2105,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
  ****************************************************************************}

+ 79 - 16
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
@@ -55,6 +55,7 @@ interface
         procedure WriteExtraFooter;virtual;
         procedure WriteInstruction(hp: tai);
         procedure WriteWeakSymbolRef(s: tasmsymbol); virtual;
+        procedure WriteHiddenSymbol(sym: TAsmSymbol);
         procedure WriteAixStringConst(hp: tai_string);
         procedure WriteAixIntConst(hp: tai_const);
         procedure WriteUnalignedIntConst(hp: tai_const);
@@ -68,6 +69,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 +272,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 +332,8 @@ implementation
           '.obcj_nlcatlist',
           '.objc_protolist',
           '.stack',
-          '.heap'
+          '.heap',
+          '.gcc_except_table'
         );
       var
         sep     : string[3];
@@ -583,7 +587,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 +597,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
@@ -799,8 +836,11 @@ implementation
                      processes). The alternate code creates some kind of common symbols
                      in the data segment.
                    }
+
                    if tai_datablock(hp).is_global then
                      begin
+                       if tai_datablock(hp).sym.bind=AB_PRIVATE_EXTERN then
+                         WriteHiddenSymbol(tai_datablock(hp).sym);
                        writer.AsmWrite('.globl ');
                        writer.AsmWriteln(tai_datablock(hp).sym.name);
                        writer.AsmWriteln('.data');
@@ -879,6 +919,8 @@ implementation
                      begin
                        if Tai_datablock(hp).is_global then
                          begin
+                           if (tai_datablock(hp).sym.bind=AB_PRIVATE_EXTERN) then
+                             WriteHiddenSymbol(tai_datablock(hp).sym);
                            writer.AsmWrite(#9'.globl ');
                            if replaceforbidden then
                              writer.AsmWriteln(ReplaceForbiddenAsmSymbolChars(Tai_datablock(hp).sym.name))
@@ -1179,14 +1221,6 @@ implementation
 
            ait_symbol :
              begin
-               if (tai_symbol(hp).sym.bind=AB_PRIVATE_EXTERN) then
-                 begin
-                   writer.AsmWrite(#9'.private_extern ');
-                   if replaceforbidden then
-                     writer.AsmWriteln(ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name))
-                   else
-                     writer.AsmWriteln(tai_symbol(hp).sym.name);
-                 end;
                if (target_info.system=system_powerpc64_linux) and
                   (tai_symbol(hp).sym.typ=AT_FUNCTION) and
                   (cs_profile in current_settings.moduleswitches) then
@@ -1199,6 +1233,8 @@ implementation
                     writer.AsmWriteln(ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name))
                   else
                     writer.AsmWriteln(tai_symbol(hp).sym.name);
+                  if (tai_symbol(hp).sym.bind=AB_PRIVATE_EXTERN) then
+                    WriteHiddenSymbol(tai_symbol(hp).sym);
                 end;
                if (target_info.system=system_powerpc64_linux) and
                   use_dotted_functions and
@@ -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;
@@ -1468,7 +1508,29 @@ implementation
 
     procedure TGNUAssembler.WriteWeakSymbolRef(s: tasmsymbol);
       begin
-        writer.AsmWriteLn(#9'.weak '+s.name);
+        writer.AsmWrite(#9'.weak ');
+        if asminfo^.dollarsign='$' then
+          writer.AsmWriteLn(s.name)
+        else
+          writer.AsmWriteLn(ReplaceForbiddenAsmSymbolChars(s.name))
+      end;
+
+
+    procedure TGNUAssembler.WriteHiddenSymbol(sym: TAsmSymbol);
+      begin
+        { on Windows/(PE)COFF, global symbols are hidden by default: global
+          symbols that are not explicitly exported from an executable/library,
+          become hidden }
+        if target_info.system in systems_windows then
+          exit;
+        if target_info.system in systems_darwin then
+          writer.AsmWrite(#9'.private_extern ')
+        else
+          writer.AsmWrite(#9'.hidden ');
+        if asminfo^.dollarsign='$' then
+          writer.AsmWriteLn(sym.name)
+        else
+          writer.AsmWriteLn(ReplaceForbiddenAsmSymbolChars(sym.name))
       end;
 
 
@@ -1894,7 +1956,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);

+ 5 - 2
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

+ 3 - 3
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;

+ 43 - 1
compiler/arm/cgcpu.pas

@@ -61,6 +61,8 @@ unit cgcpu;
         procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override;
         procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override;
 
+        procedure g_check_for_fpu_exception(list : TAsmList; force,clear : boolean); override;
+
         procedure a_loadfpu_ref_cgpara(list : TAsmList;size : tcgsize;const ref : treference;const paraloc : TCGPara);override;
         {  comparison operations }
         procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister;
@@ -1720,6 +1722,34 @@ unit cgcpu;
        end;
 
 
+    procedure tbasecgarm.g_check_for_fpu_exception(list: TAsmList;force,clear : boolean);
+      var
+        r : TRegister;
+        ai: taicpu;
+        l: TAsmLabel;
+      begin
+        if ((cs_check_fpu_exceptions in current_settings.localswitches) and
+            not(FPUARM_HAS_EXCEPTION_TRAPPING in fpu_capabilities[current_settings.fputype]) and
+            (force or current_procinfo.FPUExceptionCheckNeeded)) then
+          begin
+            r:=getintregister(list,OS_INT);
+            list.concat(taicpu.op_reg_reg(A_FMRX,r,NR_FPSCR));
+            list.concat(setoppostfix(taicpu.op_reg_reg_const(A_AND,r,r,$9f),PF_S));
+            current_asmdata.getjumplabel(l);
+            ai:=taicpu.op_sym(A_B,l);
+            ai.is_jmp:=true;
+            ai.condition:=C_EQ;
+            list.concat(ai);
+            alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+            cg.a_call_name(list,'FPC_THROWFPUEXCEPTION',false);
+            dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+            a_label(list,l);
+            if clear then
+              current_procinfo.FPUExceptionCheckNeeded:=false;
+          end;
+      end;
+
+
     {  comparison operations }
     procedure tbasecgarm.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister;
       l : tasmlabel);
@@ -3069,6 +3099,7 @@ unit cgcpu;
           else
             ;
         end;
+        maybe_check_for_fpu_exception(list);
       end;
 
 
@@ -3134,6 +3165,7 @@ unit cgcpu;
 
         if (tmpmmreg<>reg) then
           a_loadmm_reg_reg(list,fromsize,tosize,tmpmmreg,reg,shuffle);
+        maybe_check_for_fpu_exception(list);
       end;
 
 
@@ -3199,6 +3231,7 @@ unit cgcpu;
           begin
              handle_load_store(list,A_VSTR,PF_None,tmpmmreg,ref);
           end;
+        maybe_check_for_fpu_exception(list);
       end;
 
 
@@ -3214,6 +3247,7 @@ unit cgcpu;
            not shufflescalar(shuffle) then
           internalerror(2009112516);
         list.concat(taicpu.op_reg_reg(A_VMOV,mmreg,intreg));
+        maybe_check_for_fpu_exception(list);
       end;
 
 
@@ -3229,6 +3263,7 @@ unit cgcpu;
            not shufflescalar(shuffle) then
           internalerror(2009112514);
         list.concat(taicpu.op_reg_reg(A_VMOV,intreg,mmreg));
+        maybe_check_for_fpu_exception(list);
       end;
 
 
@@ -3356,6 +3391,7 @@ unit cgcpu;
         if (mmsize<>OS_F64) then
           internalerror(2009112405);
         list.concat(taicpu.op_reg_reg_reg(A_VMOV,mmreg,intreg.reglo,intreg.reghi));
+        cg.maybe_check_for_fpu_exception(list);
       end;
 
 
@@ -3366,6 +3402,7 @@ unit cgcpu;
         if (mmsize<>OS_F64) then
           internalerror(2009112406);
         list.concat(taicpu.op_reg_reg_reg(A_VMOV,intreg.reglo,intreg.reghi,mmreg));
+        cg.maybe_check_for_fpu_exception(list);
       end;
 
 
@@ -5196,6 +5233,7 @@ unit cgcpu;
             instr:=setoppostfix(taicpu.op_reg_reg(A_VMOV,reg2,reg1), PF_F32);
             list.Concat(instr);
             add_move_instruction(instr);
+            maybe_check_for_fpu_exception(list);
           end
         else if (fromsize=OS_F64) and
           (tosize=OS_F64) then
@@ -5221,6 +5259,7 @@ unit cgcpu;
     procedure tthumb2cgarm.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference; shuffle: pmmshuffle);
       begin
         handle_load_store(list,A_VSTR,PF_None,reg,ref);
+        maybe_check_for_fpu_exception(list);
       end;
 
 
@@ -5238,7 +5277,10 @@ unit cgcpu;
       begin
         if //(shuffle=nil) and
           (fromsize=OS_F32) then
-          list.Concat(taicpu.op_reg_reg(A_VMOV,intreg,mmreg))
+          begin
+            list.Concat(taicpu.op_reg_reg(A_VMOV,intreg,mmreg));
+            maybe_check_for_fpu_exception(list);
+          end
         else
           internalerror(2012100814);
       end;

+ 10 - 0
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

+ 42 - 0
compiler/arm/cpuinfo.pas

@@ -14,6 +14,8 @@
 
 Unit CPUInfo;
 
+{$i fpcdefs.inc}
+
 Interface
 
   uses
@@ -69,8 +71,27 @@ Type
       fpu_vfpv3_d16,
       fpu_fpv4_s16,
       fpu_vfpv4
+      { when new elements added afterwards, update also fpu_vfp_last below }
      );
 
+Const
+   fpu_vfp_first = fpu_vfpv2;
+   fpu_vfp_last  = fpu_vfpv4;
+
+  fputypestrllvm : array[tfputype] of string[13] = ('',
+    '',
+    '',
+    '',
+    '',
+    '',
+    'fpu=vfpv2',
+    'fpu=vfpv3',
+    'fpu=vfpv3-d16',
+    'fpu=vfpv4-s16',
+    'fpu=vfpv4'
+  );
+
+Type
    tcontrollertype =
      (ct_none,
 
@@ -1032,6 +1053,13 @@ Const
        CPUARM_HAS_UMULL
       );
 
+   tfpuflags =
+      (
+        FPUARM_HAS_VFP_EXTENSION,     { fpu is a vfp extension                            }
+        FPUARM_HAS_VMOV_CONST,        { vmov supports (some) real constants               }
+        FPUARM_HAS_EXCEPTION_TRAPPING { vfp does exceptions trapping                      }
+      );
+
  const
    cpu_capabilities : array[tcputype] of set of tcpuflags =
      ( { cpu_none     } [],
@@ -1055,6 +1083,20 @@ Const
        { cpu_armv7em  } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL]
      );
 
+     fpu_capabilities : array[tfputype] of set of tfpuflags =
+       ( { fpu_none      } [],
+         { fpu_soft      } [],
+         { fpu_libgcc    } [],
+         { fpu_fpa       } [],
+         { fpu_fpa10     } [],
+         { fpu_fpa11     } [],
+         { fpu_vfpv2     } [FPUARM_HAS_VFP_EXTENSION],
+         { fpu_vfpv3     } [FPUARM_HAS_VFP_EXTENSION,FPUARM_HAS_VMOV_CONST],
+         { fpu_vfpv3_d16 } [FPUARM_HAS_VFP_EXTENSION,FPUARM_HAS_VMOV_CONST],
+         { fpu_fpv4_s16  } [FPUARM_HAS_VFP_EXTENSION,FPUARM_HAS_VMOV_CONST],
+         { fpu_vfpv4     } [FPUARM_HAS_VFP_EXTENSION,FPUARM_HAS_VMOV_CONST]
+       );
+
    { contains all CPU supporting any kind of thumb instruction set }
    cpu_has_thumb = [cpu_armv4t,cpu_armv5t,cpu_armv5te,cpu_armv5tej,cpu_armv6t2,cpu_armv6z,cpu_armv6m,cpu_armv7a,cpu_armv7r,cpu_armv7m,cpu_armv7em];
 

+ 8 - 4
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}
        ;
 
 

+ 2 - 2
compiler/arm/cpupara.pas

@@ -149,7 +149,7 @@ unit cpupara;
                 getparaloc:=LOC_MMREGISTER
               else if (calloption in cdecl_pocalls) or
                  (cs_fp_emulation in current_settings.moduleswitches) or
-                 (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv4,fpu_vfpv3_d16,fpu_fpv4_s16]) then
+                 (current_settings.fputype in [fpu_vfp_first..fpu_vfp_last]) then
                 { the ARM eabi also allows passing VFP values via VFP registers,
                   but Mac OS X doesn't seem to do that and linux only does it if
                   built with the "-mfloat-abi=hard" option }
@@ -757,7 +757,7 @@ unit cpupara;
               end
             else if (p.proccalloption in [pocall_softfloat]) or
                (cs_fp_emulation in current_settings.moduleswitches) or
-               (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv4,fpu_vfpv3_d16,fpu_fpv4_s16]) then
+               (current_settings.fputype in [fpu_vfp_first..fpu_vfp_last]) then
               begin
                 case retcgsize of
                   OS_64,

+ 3 - 4
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
@@ -179,7 +177,7 @@ implementation
       if make_global then
         list.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0,procdef))
       else
-        list.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0,procdef));
+        list.concat(Tai_symbol.Createname_hidden(labelname,AT_FUNCTION,0,procdef));
 
       { the wrapper might need aktlocaldata for the additional data to
         load the constant }
@@ -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.

+ 5 - 1
compiler/arm/narmadd.pas

@@ -238,6 +238,7 @@ interface
 
               current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(op,
                  location.register,left.location.register,right.location.register),pf));
+              cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
             end;
           fpu_fpv4_s16:
             begin
@@ -263,6 +264,7 @@ interface
               end;
 
               current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(op, location.register,left.location.register,right.location.register), PF_F32));
+              cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
             end;
           fpu_soft:
             { this case should be handled already by pass1 }
@@ -325,6 +327,7 @@ interface
 
               current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(op,
                 left.location.register,right.location.register), pf));
+              cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
               cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
               current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VMRS,NR_APSR_nzcv,NR_FPSCR));
               location.resflags:=GetFpuResFlags;
@@ -341,6 +344,7 @@ interface
 
               current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(op,
                 left.location.register,right.location.register),PF_F32));
+              cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
               cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
               current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg(A_VMRS, NR_APSR_nzcv, NR_FPSCR));
             end;
@@ -724,7 +728,7 @@ interface
       begin
         result:=GenerateThumbCode or
           not(CPUARM_HAS_UMULL in cpu_capabilities[current_settings.cputype]) or
-          (cs_check_overflow in current_settings.localswitches);
+          needoverflowcheck;
       end;
 
 begin

+ 1 - 1
compiler/arm/narmcal.pas

@@ -83,7 +83,7 @@ implementation
          (target_info.abi<>abi_eabihf) and
          (procdefinition.proccalloption<>pocall_hardfloat) and
          ((cs_fp_emulation in current_settings.moduleswitches) or
-          (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv4,fpu_vfpv3_d16,fpu_fpv4_s16])) then
+          (current_settings.fputype in [fpu_vfp_first..fpu_vfp_last])) then
         begin
           { keep the fpu values in integer registers for now, the code
             generator will move them to memory or an mmregister when necessary

+ 1 - 5
compiler/arm/narmcnv.pas

@@ -117,11 +117,7 @@ implementation
               fpu_fpa10,
               fpu_fpa11:
                 expectloc:=LOC_FPUREGISTER;
-              fpu_vfpv2,
-              fpu_vfpv3,
-              fpu_vfpv4,
-              fpu_vfpv3_d16,
-              fpu_fpv4_s16:
+              fpu_vfp_first..fpu_vfp_last:
                 expectloc:=LOC_MMREGISTER;
               else
                 internalerror(2009112702);

+ 2 - 2
compiler/arm/narmcon.pas

@@ -54,7 +54,7 @@ interface
     function tarmrealconstnode.pass_1 : tnode;
       begin
         result:=nil;
-        if (current_settings.fputype in [fpu_vfpv3,fpu_vfpv4,fpu_vfpv3_d16,fpu_fpv4_s16]) and
+        if (FPUARM_HAS_VMOV_CONST in fpu_capabilities[current_settings.fputype]) and
            IsVFPFloatImmediate(tfloatdef(resultdef).floattype,value_real) then
            expectloc:=LOC_MMREGISTER
          else
@@ -75,7 +75,7 @@ interface
          pf : TOpPostfix;
 
       begin
-        if (current_settings.fputype in [fpu_vfpv3,fpu_vfpv4,fpu_vfpv3_d16,fpu_fpv4_s16]) and
+        if (FPUARM_HAS_VMOV_CONST in fpu_capabilities[current_settings.fputype]) and
           IsVFPFloatImmediate(tfloatdef(resultdef).floattype,value_real) then
           begin
             location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef));

+ 17 - 8
compiler/arm/narminl.pas

@@ -86,11 +86,7 @@ implementation
                  location.loc := LOC_FPUREGISTER;
                end;
             end;
-          fpu_vfpv2,
-          fpu_vfpv3,
-          fpu_vfpv4,
-          fpu_vfpv3_d16,
-          fpu_fpv4_s16:
+          fpu_vfp_first..fpu_vfp_last:
             begin
               hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
               location_copy(location,left.location);
@@ -272,9 +268,13 @@ implementation
               else
                 pf:=PF_F64;
               current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_VABS,location.register,left.location.register),pf));
+              cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
             end;
           fpu_fpv4_s16:
-            current_asmdata.CurrAsmList.Concat(setoppostfix(taicpu.op_reg_reg(A_VABS,location.register,left.location.register), PF_F32));
+            begin
+              current_asmdata.CurrAsmList.Concat(setoppostfix(taicpu.op_reg_reg(A_VABS,location.register,left.location.register), PF_F32));
+              cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
+            end;
           fpu_soft:
             begin
               if singleprec then
@@ -309,9 +309,13 @@ implementation
               else
                 pf:=PF_F64;
               current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_VMUL,location.register,left.location.register,left.location.register),pf));
+              cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
             end;
           fpu_fpv4_s16:
-            current_asmdata.CurrAsmList.Concat(setoppostfix(taicpu.op_reg_reg_reg(A_VMUL,location.register,left.location.register,left.location.register), PF_F32));
+            begin
+              current_asmdata.CurrAsmList.Concat(setoppostfix(taicpu.op_reg_reg_reg(A_VMUL,location.register,left.location.register,left.location.register), PF_F32));
+              cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
+            end;
         else
           internalerror(2009111403);
         end;
@@ -339,9 +343,13 @@ implementation
               else
                 pf:=PF_F64;
               current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_VSQRT,location.register,left.location.register),pf));
+              cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
             end;
           fpu_fpv4_s16:
-            current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_VSQRT,location.register,left.location.register), PF_F32));
+            begin
+              current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_VSQRT,location.register,left.location.register), PF_F32));
+              cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
+            end;
         else
           internalerror(2009111402);
         end;
@@ -515,6 +523,7 @@ implementation
                oppostfix:=PF_F32;
              current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(op[negproduct,negop3],
                location.register,paraarray[1].location.register,paraarray[2].location.register),oppostfix));
+             cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
            end
          else
            internalerror(2014032301);

+ 2 - 0
compiler/arm/narmmat.pas

@@ -435,6 +435,7 @@ implementation
 
               current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_VNEG,
                 location.register,left.location.register), pf));
+              cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
             end;
           fpu_fpv4_s16:
             begin
@@ -444,6 +445,7 @@ implementation
                 location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
               current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_VNEG,
                 location.register,left.location.register), PF_F32));
+              cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
             end;
           fpu_soft:
             begin

+ 1 - 1
compiler/armgen/armpara.pas

@@ -20,7 +20,7 @@
 }
 unit armpara;
 
-{$mode objfpc}
+{$i fpcdefs.inc}
 
 interface
 

+ 28 - 11
compiler/assemble.pas

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

+ 344 - 122
compiler/avr/cgcpu.pas

@@ -60,9 +60,11 @@ unit cgcpu;
 
         procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); override;
         procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: TCGSize; src, dst : TRegister); override;
-        procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister); override;
         procedure a_op_const_reg_reg(list : TAsmList;op : TOpCg;size : tcgsize; a : tcgint;src,dst : tregister); override;
 
+        procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation); override;
+        procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation); override;
+
         { move instructions }
         procedure a_load_const_reg(list : TAsmList; size: tcgsize; a : tcgint;reg : tregister);override;
         procedure a_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override;
@@ -94,6 +96,7 @@ unit cgcpu;
         procedure g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint);
 
         procedure g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef); override;
+        procedure g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; ovloc: tlocation); override;
 
         procedure g_save_registers(list : TAsmList);override;
         procedure g_restore_registers(list : TAsmList);override;
@@ -109,6 +112,8 @@ unit cgcpu;
         function GetLoad(const ref : treference) : tasmop;
         function GetStore(const ref: treference): tasmop;
 
+        procedure gen_multiply(list: TAsmList; op: topcg; size: TCgSize; src2, src1, dst: tregister; check_overflow: boolean; var ovloc: tlocation);
+
       protected
         procedure a_op_reg_reg_internal(list: TAsmList; Op: TOpCG; size: TCGSize; src, srchi, dst, dsthi: TRegister);
         procedure a_op_const_reg_internal(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg, reghi: TRegister);
@@ -432,29 +437,6 @@ unit cgcpu;
        end;
 
 
-     procedure tcgavr.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister);
-       begin
-         if (op in [OP_MUL,OP_IMUL]) and (size in [OS_16,OS_S16]) and
-            (CPUAVR_HAS_MUL in cpu_capabilities[current_settings.cputype]) then
-           begin
-             getcpuregister(list,NR_R0);
-             getcpuregister(list,NR_R1);
-             list.concat(taicpu.op_reg_reg(A_MUL,src1,src2));
-             emit_mov(list,dst,NR_R0);
-             emit_mov(list,GetNextReg(dst),NR_R1);
-             list.concat(taicpu.op_reg_reg(A_MUL,GetNextReg(src1),src2));
-             list.concat(taicpu.op_reg_reg(A_ADD,GetNextReg(dst),NR_R0));
-             list.concat(taicpu.op_reg_reg(A_MUL,src1,GetNextReg(src2)));
-             list.concat(taicpu.op_reg_reg(A_ADD,GetNextReg(dst),NR_R0));
-             ungetcpuregister(list,NR_R0);
-             list.concat(taicpu.op_reg(A_CLR,NR_R1));
-             ungetcpuregister(list,NR_R1);
-           end
-         else
-          inherited a_op_reg_reg_reg(list,op,size,src1,src2,dst);
-       end;
-
-
      procedure tcgavr.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister);
        begin
          if (op in [OP_MUL,OP_IMUL]) and (size in [OS_16,OS_S16]) and (a in [2,4,8]) then
@@ -473,6 +455,36 @@ unit cgcpu;
            inherited a_op_const_reg_reg(list,op,size,a,src,dst);
        end;
 
+     procedure tcgavr.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation);
+       var
+         tmpreg: TRegister;
+       begin
+         if (op in [OP_MUL,OP_IMUL]) and
+            setflags then
+           begin
+             tmpreg:=getintregister(list,size);
+             a_load_const_reg(list,size,a,tmpreg);
+             a_op_reg_reg_reg_checkoverflow(list,op,size,tmpreg,src,dst,setflags,ovloc);
+           end
+         else
+           begin
+             inherited a_op_const_reg_reg_checkoverflow(list, op, size, a, src, dst, setflags, ovloc);
+             ovloc.loc:=LOC_FLAGS;
+           end;
+       end;
+
+     procedure tcgavr.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
+       begin
+         if (op in [OP_MUL,OP_IMUL]) and
+            setflags then
+           gen_multiply(list,op,size,src1,src2,dst,setflags,ovloc)
+         else
+           begin
+             inherited a_op_reg_reg_reg_checkoverflow(list, op, size, src1, src2, dst, setflags, ovloc);
+             ovloc.loc:=LOC_FLAGS;
+           end;
+       end;
+
 
      procedure tcgavr.a_op_reg_reg_internal(list : TAsmList; Op: TOpCG; size: TCGSize; src, srchi, dst, dsthi: TRegister);
        var
@@ -483,6 +495,7 @@ unit cgcpu;
          paraloc1,paraloc2 : TCGPara;
          l1,l2 : tasmlabel;
          pd : tprocdef;
+         hovloc: tlocation;
 
       { NextRegDst* is sometimes called before the register usage and sometimes afterwards }
        procedure NextSrcDstPreInc;
@@ -598,93 +611,13 @@ unit cgcpu;
 
            OP_MUL,OP_IMUL:
              begin
-               if size in [OS_8,OS_S8] then
-                 begin
-                   if CPUAVR_HAS_MUL in cpu_capabilities[current_settings.cputype] then
-                     begin
-                       cg.a_reg_alloc(list,NR_R0);
-                       cg.a_reg_alloc(list,NR_R1);
-                       list.concat(taicpu.op_reg_reg(topcg2asmop[op],dst,src));
-                       list.concat(taicpu.op_reg(A_CLR,NR_R1));
-                       cg.a_reg_dealloc(list,NR_R1);
-                       list.concat(taicpu.op_reg_reg(A_MOV,dst,NR_R0));
-                       cg.a_reg_dealloc(list,NR_R0);
-                     end
-                   else
-                     begin
-                       if size=OS_8 then
-                         pd:=search_system_proc('fpc_mul_byte')
-                       else
-                          pd:=search_system_proc('fpc_mul_shortint');
-                       paraloc1.init;
-                       paraloc2.init;
-                       paramanager.getintparaloc(list,pd,1,paraloc1);
-                       paramanager.getintparaloc(list,pd,2,paraloc2);
-                       a_load_reg_cgpara(list,OS_8,src,paraloc2);
-                       a_load_reg_cgpara(list,OS_8,dst,paraloc1);
-                       paramanager.freecgpara(list,paraloc2);
-                       paramanager.freecgpara(list,paraloc1);
-                       alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-                       if size=OS_8 then
-                         a_call_name(list,'FPC_MUL_BYTE',false)
-                       else
-                         a_call_name(list,'FPC_MUL_SHORTINT',false);
-                       dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-                       cg.a_reg_alloc(list,NR_R24);
-                       cg.a_load_reg_reg(list,OS_8,OS_8,NR_R24,dst);
-                       cg.a_reg_dealloc(list,NR_R24);
-                       paraloc2.done;
-                       paraloc1.done;
-                     end;
-                 end
-               else if size in [OS_16,OS_S16] then
+               tmpreg:=dst;
+               if size in [OS_16,OS_S16] then
                  begin
-                   if CPUAVR_HAS_MUL in cpu_capabilities[current_settings.cputype] then
-                     begin
-                       tmpreg:=getintregister(list,OS_16);
-                       emit_mov(list,tmpreg,dst);
-                       emit_mov(list,GetNextReg(tmpreg),GetNextReg(dst));
-                       list.concat(taicpu.op_reg_reg(A_MUL,tmpreg,src));
-                       emit_mov(list,dst,NR_R0);
-                       emit_mov(list,GetNextReg(dst),NR_R1);
-                       list.concat(taicpu.op_reg_reg(A_MUL,GetNextReg(tmpreg),src));
-                       list.concat(taicpu.op_reg_reg(A_ADD,GetNextReg(dst),NR_R0));
-                       list.concat(taicpu.op_reg_reg(A_MUL,tmpreg,GetNextReg(src)));
-                       list.concat(taicpu.op_reg_reg(A_ADD,GetNextReg(dst),NR_R0));
-                       list.concat(taicpu.op_reg(A_CLR,NR_R1));
-                     end
-                   else
-                     begin
-                       if size=OS_16 then
-                         pd:=search_system_proc('fpc_mul_word')
-                       else
-                          pd:=search_system_proc('fpc_mul_integer');
-                       paraloc1.init;
-                       paraloc2.init;
-                       paramanager.getintparaloc(list,pd,1,paraloc1);
-                       paramanager.getintparaloc(list,pd,2,paraloc2);
-                       a_load_reg_cgpara(list,OS_16,src,paraloc2);
-                       a_load_reg_cgpara(list,OS_16,dst,paraloc1);
-                       paramanager.freecgpara(list,paraloc2);
-                       paramanager.freecgpara(list,paraloc1);
-                       alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-                       if size=OS_16 then
-                         a_call_name(list,'FPC_MUL_WORD',false)
-                       else
-                         a_call_name(list,'FPC_MUL_INTEGER',false);
-                       dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-                       cg.a_reg_alloc(list,NR_R24);
-                       cg.a_reg_alloc(list,NR_R25);
-                       cg.a_load_reg_reg(list,OS_8,OS_8,NR_R24,dst);
-                       cg.a_reg_dealloc(list,NR_R24);
-                       cg.a_load_reg_reg(list,OS_8,OS_8,NR_R25,GetNextReg(dst));
-                       cg.a_reg_dealloc(list,NR_R25);
-                       paraloc2.done;
-                       paraloc1.done;
-                     end;
-                 end
-               else
-                 internalerror(2011022002);
+                   tmpreg:=getintregister(list,size);
+                   a_load_reg_reg(list,size,size,dst,tmpreg);
+                 end;
+               gen_multiply(list,op,size,src,tmpreg,dst,false,hovloc);
              end;
 
            OP_DIV,OP_IDIV:
@@ -1673,7 +1606,7 @@ unit cgcpu;
     procedure tcgavr.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;
       cmp_op : topcmp;a : tcgint;reg : tregister;l : tasmlabel);
       var
-        swapped : boolean;
+        swapped , test_msb: boolean;
         tmpreg : tregister;
         i : byte;
       begin
@@ -1704,18 +1637,31 @@ unit cgcpu;
                 end;
             end;
 
-            if swapped then
-              list.concat(taicpu.op_reg_reg(A_CP,NR_R1,reg))
-            else
-              list.concat(taicpu.op_reg_reg(A_CP,reg,NR_R1));
+            { If doing a signed test for x<0, we can simply test the sign bit
+              of the most significant byte }
+            if (cmp_op in [OC_LT,OC_GTE]) and
+               (not swapped) then
+              begin
+                for i:=2 to tcgsize2size[size] do
+                  reg:=GetNextReg(reg);
 
-            for i:=2 to tcgsize2size[size] do
+                list.concat(taicpu.op_reg_reg(A_CP,reg,NR_R1));
+              end
+            else
               begin
-                reg:=GetNextReg(reg);
                 if swapped then
-                  list.concat(taicpu.op_reg_reg(A_CPC,NR_R1,reg))
+                  list.concat(taicpu.op_reg_reg(A_CP,NR_R1,reg))
                 else
-                  list.concat(taicpu.op_reg_reg(A_CPC,reg,NR_R1));
+                  list.concat(taicpu.op_reg_reg(A_CP,reg,NR_R1));
+
+                for i:=2 to tcgsize2size[size] do
+                  begin
+                    reg:=GetNextReg(reg);
+                    if swapped then
+                      list.concat(taicpu.op_reg_reg(A_CPC,NR_R1,reg))
+                    else
+                      list.concat(taicpu.op_reg_reg(A_CPC,reg,NR_R1));
+                  end;
               end;
 
             a_jmp_cond(list,cmp_op,l);
@@ -1900,6 +1846,248 @@ unit cgcpu;
           result:=A_ST;
       end;
 
+    procedure tcgavr.gen_multiply(list: TAsmList; op: topcg; size: TCgSize; src2, src1, dst: tregister; check_overflow: boolean; var ovloc: tlocation);
+
+      procedure perform_r1_check(overflow_label: TAsmLabel; other_reg: TRegister=NR_R1);
+        var
+          ai: taicpu;
+        begin
+          if check_overflow then
+            begin
+              list.concat(taicpu.op_reg_reg(A_OR,NR_R1,other_reg));
+
+              ai:=Taicpu.Op_Sym(A_BRxx,overflow_label);
+              ai.SetCondition(C_NE);
+              ai.is_jmp:=true;
+              list.concat(ai);
+            end;
+        end;
+
+      procedure perform_ovf_check(overflow_label: TAsmLabel);
+        var
+          ai: taicpu;
+        begin
+          if check_overflow then
+            begin
+              ai:=Taicpu.Op_Sym(A_BRxx,overflow_label);
+              ai.SetCondition(C_CS);
+              ai.is_jmp:=true;
+              list.concat(ai);
+            end;
+        end;
+
+      var
+        pd: tprocdef;
+        paraloc1, paraloc2: tcgpara;
+        ai: taicpu;
+        hl, no_overflow: TAsmLabel;
+        name: String;
+      begin
+        ovloc.loc:=LOC_VOID;
+        if size in [OS_8,OS_S8] then
+          begin
+            if (CPUAVR_HAS_MUL in cpu_capabilities[current_settings.cputype]) and
+               (op=OP_MUL) then
+              begin
+                cg.a_reg_alloc(list,NR_R0);
+                cg.a_reg_alloc(list,NR_R1);
+                list.concat(taicpu.op_reg_reg(topcg2asmop[op],src1,src2));
+                // Check overflow
+                if check_overflow then
+                  begin
+                    current_asmdata.getjumplabel(hl);
+                    list.concat(taicpu.op_reg_reg(A_AND,NR_R1,NR_R1));
+
+                     { Clear carry as it's not affected by any of the instructions }
+                    list.concat(taicpu.op_none(A_CLC));
+
+                    ai:=Taicpu.Op_Sym(A_BRxx,hl);
+                    ai.SetCondition(C_EQ);
+                    ai.is_jmp:=true;
+                    list.concat(ai);
+
+                    list.concat(taicpu.op_reg(A_CLR,NR_R1));
+                    list.concat(taicpu.op_none(A_SEC));
+
+                    a_label(list,hl);
+
+                    ovloc.loc:=LOC_FLAGS;
+                  end
+                else
+                  list.concat(taicpu.op_reg(A_CLR,NR_R1));
+                cg.a_reg_dealloc(list,NR_R1);
+
+                list.concat(taicpu.op_reg_reg(A_MOV,dst,NR_R0));
+                cg.a_reg_dealloc(list,NR_R0);
+              end
+            else if (CPUAVR_HAS_MUL in cpu_capabilities[current_settings.cputype]) and
+               (op=OP_IMUL) then
+              begin
+                cg.a_reg_alloc(list,NR_R0);
+                cg.a_reg_alloc(list,NR_R1);
+                list.concat(taicpu.op_reg_reg(A_MULS,src1,src2));
+                list.concat(taicpu.op_reg_reg(A_MOV,dst,NR_R0));
+
+                // Check overflow
+                if check_overflow then
+                  begin
+                    current_asmdata.getjumplabel(no_overflow);
+
+                    list.concat(taicpu.op_reg_const(A_SBRC,NR_R0,7));
+                    list.concat(taicpu.op_reg(A_INC,NR_R1));
+                    list.concat(taicpu.op_reg(A_TST,NR_R1));
+
+                    ai:=Taicpu.Op_Sym(A_BRxx,no_overflow);
+                    ai.SetCondition(C_EQ);
+                    ai.is_jmp:=true;
+                    list.concat(ai);
+
+                    list.concat(taicpu.op_reg(A_CLR,NR_R1));
+
+                    a_call_name(list,'FPC_OVERFLOW',false);
+
+                    a_label(list,no_overflow);
+
+                    ovloc.loc:=LOC_VOID;
+                  end
+                else
+                  list.concat(taicpu.op_reg(A_CLR,NR_R1));
+                cg.a_reg_dealloc(list,NR_R1);
+                cg.a_reg_dealloc(list,NR_R0);
+              end
+            else
+              begin
+                if size=OS_8 then
+                  name:='fpc_mul_byte'
+                else
+                  name:='fpc_mul_shortint';
+
+                if check_overflow then
+                  name:=name+'_checkoverflow';
+
+                pd:=search_system_proc(name);
+                paraloc1.init;
+                paraloc2.init;
+                paramanager.getintparaloc(list,pd,1,paraloc1);
+                paramanager.getintparaloc(list,pd,2,paraloc2);
+                a_load_reg_cgpara(list,OS_8,src1,paraloc2);
+                a_load_reg_cgpara(list,OS_8,src2,paraloc1);
+                paramanager.freecgpara(list,paraloc2);
+                paramanager.freecgpara(list,paraloc1);
+                alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+                a_call_name(list,upper(name),false);
+                dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+                cg.a_reg_alloc(list,NR_R24);
+                cg.a_load_reg_reg(list,OS_8,OS_8,NR_R24,dst);
+                cg.a_reg_dealloc(list,NR_R24);
+                paraloc2.done;
+                paraloc1.done;
+              end;
+          end
+        else if size in [OS_16,OS_S16] then
+          begin
+            if (CPUAVR_HAS_MUL in cpu_capabilities[current_settings.cputype]) and
+               ((not check_overflow) or
+                (size=OS_16)) then
+              begin
+                if check_overflow then
+                  begin
+                    current_asmdata.getjumplabel(hl);
+                    current_asmdata.getjumplabel(no_overflow);
+                  end;
+                cg.a_reg_alloc(list,NR_R0);
+                cg.a_reg_alloc(list,NR_R1);
+                list.concat(taicpu.op_reg_reg(A_MUL,src2,src1));
+                emit_mov(list,dst,NR_R0);
+                emit_mov(list,GetNextReg(dst),NR_R1);
+                list.concat(taicpu.op_reg_reg(A_MUL,GetNextReg(src1),src2));
+                perform_r1_check(hl);
+                list.concat(taicpu.op_reg_reg(A_ADD,GetNextReg(dst),NR_R0));
+                perform_ovf_check(hl);
+                list.concat(taicpu.op_reg_reg(A_MUL,src1,GetNextReg(src2)));
+                perform_r1_check(hl);
+                list.concat(taicpu.op_reg_reg(A_ADD,GetNextReg(dst),NR_R0));
+                perform_ovf_check(hl);
+
+                if check_overflow then
+                  begin
+                    list.concat(taicpu.op_reg_reg(A_MUL,GetNextReg(src1),GetNextReg(src2)));
+                    perform_r1_check(hl,NR_R0);
+                  end;
+
+                cg.a_reg_dealloc(list,NR_R0);
+                list.concat(taicpu.op_reg(A_CLR,NR_R1));
+
+                if check_overflow then
+                  begin
+                    {
+                      CLV/CLC
+                      JMP no_overflow
+                    .hl:
+                      CLR R1
+                      SEV/SEC
+                    .no_overflow:
+                    }
+
+                    if op=OP_MUL then
+                      list.concat(taicpu.op_none(A_CLC))
+                    else
+                      list.concat(taicpu.op_none(A_CLV));
+
+                    a_jmp_always(list,no_overflow);
+
+                    a_label(list,hl);
+
+                    list.concat(taicpu.op_reg(A_CLR,NR_R1));
+
+                    if op=OP_MUL then
+                      list.concat(taicpu.op_none(A_SEC))
+                    else
+                      list.concat(taicpu.op_none(A_SEV));
+
+                    a_label(list,no_overflow);
+
+                    ovloc.loc:=LOC_FLAGS;
+                  end;
+
+                cg.a_reg_dealloc(list,NR_R1);
+              end
+            else
+              begin
+                if size=OS_16 then
+                  name:='fpc_mul_word'
+                else
+                  name:='fpc_mul_integer';
+
+                if check_overflow then
+                  name:=name+'_checkoverflow';
+
+                pd:=search_system_proc(name);
+                paraloc1.init;
+                paraloc2.init;
+                paramanager.getintparaloc(list,pd,1,paraloc1);
+                paramanager.getintparaloc(list,pd,2,paraloc2);
+                a_load_reg_cgpara(list,OS_16,src1,paraloc2);
+                a_load_reg_cgpara(list,OS_16,src2,paraloc1);
+                paramanager.freecgpara(list,paraloc2);
+                paramanager.freecgpara(list,paraloc1);
+                alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+                a_call_name(list,upper(name),false);
+                dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+                cg.a_reg_alloc(list,NR_R24);
+                cg.a_reg_alloc(list,NR_R25);
+                cg.a_load_reg_reg(list,OS_8,OS_8,NR_R24,dst);
+                cg.a_reg_dealloc(list,NR_R24);
+                cg.a_load_reg_reg(list,OS_8,OS_8,NR_R25,GetNextReg(dst));
+                cg.a_reg_dealloc(list,NR_R25);
+                paraloc2.done;
+                paraloc1.done;
+              end;
+          end
+        else
+          internalerror(2011022002);
+      end;
+
 
     procedure tcgavr.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);
       var
@@ -1908,7 +2096,8 @@ unit cgcpu;
       begin
         if current_procinfo.procdef.isempty then
           exit;
-        if po_interrupt in current_procinfo.procdef.procoptions then
+        if (po_interrupt in current_procinfo.procdef.procoptions) and
+          (not nostackframe) then
           begin
             { check if the framepointer is actually used, this is done here because
               we have to know the size of the locals (must be 0), avr does not know
@@ -2007,7 +2196,8 @@ unit cgcpu;
           exit;
         if po_interrupt in current_procinfo.procdef.procoptions then
           begin
-            if not(current_procinfo.procdef.isempty) then
+            if not(current_procinfo.procdef.isempty) and
+              (not nostackframe) then
               begin
                 regs:=rg[R_INTREGISTER].used_in_proc;
                 if current_procinfo.framepointer<>NR_NO then
@@ -2374,7 +2564,7 @@ unit cgcpu;
         end;
 
 
-    procedure tcgavr.g_overflowCheck(list : TAsmList;const l : tlocation;def : tdef);
+    procedure tcgavr.g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef);
       var
         hl : tasmlabel;
         ai : taicpu;
@@ -2400,6 +2590,38 @@ unit cgcpu;
       end;
 
 
+    procedure tcgavr.g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; ovloc: tlocation);
+      var
+        hl : tasmlabel;
+        ai : taicpu;
+        cond : TAsmCond;
+      begin
+        if not(cs_check_overflow in current_settings.localswitches) then
+         exit;
+
+        case ovloc.loc of
+          LOC_FLAGS:
+            begin
+              current_asmdata.getjumplabel(hl);
+              if not ((def.typ=pointerdef) or
+                     ((def.typ=orddef) and
+                      (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
+                                                pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
+                cond:=C_VC
+              else
+                cond:=C_CC;
+              ai:=Taicpu.Op_Sym(A_BRxx,hl);
+              ai.SetCondition(cond);
+              ai.is_jmp:=true;
+              list.concat(ai);
+
+              a_call_name(list,'FPC_OVERFLOW',false);
+              a_label(list,hl);
+            end;
+        end;
+      end;
+
+
     procedure tcgavr.g_save_registers(list: TAsmList);
       begin
         { this is done by the entry code }

+ 8 - 0
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;

+ 2 - 0
compiler/avr/cpuinfo.pas

@@ -14,6 +14,8 @@
 
 Unit CPUInfo;
 
+{$i fpcdefs.inc}
+
 Interface
 
   uses

+ 2 - 3
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.

+ 23 - 0
compiler/avr/navradd.pas

@@ -202,6 +202,29 @@ interface
               hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
           end;
 
+        if (not unsigned) and
+          (right.location.loc=LOC_CONSTANT) and
+          (right.location.value=0) and
+          (getresflags(unsigned) in [F_LT,F_GE]) then
+          begin
+            { This is a simple sign test, where we can just test the msb }
+            tmpreg1:=left.location.register;
+            for i:=2 to tcgsize2size[left.location.size] do
+              begin
+                if i=5 then
+                  tmpreg1:=left.location.registerhi
+                else
+                  tmpreg1:=cg.GetNextReg(tmpreg1);
+              end;
+
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CP,tmpreg1,NR_R1));
+
+            location_reset(location,LOC_FLAGS,OS_NO);
+            location.resflags:=getresflags(unsigned);
+
+            exit;
+          end;
+
         if right.location.loc=LOC_CONSTANT then
           begin
             { decrease register pressure on registers >= r16 }

+ 25 - 1
compiler/avr/navrinl.pas

@@ -26,10 +26,12 @@ unit navrinl;
   interface
 
     uses
-      node,ninl,ncginl;
+      node,ninl,ncginl, aasmbase;
 
     type
       tavrinlinenode = class(tcginlinenode)
+        procedure second_abs_long; override;
+
         function pass_typecheck_cpu:tnode;override;
         function first_cpu : tnode;override;
         procedure pass_generate_code_cpu;override;
@@ -42,11 +44,33 @@ unit navrinl;
       aasmdata,
       aasmcpu,
       symdef,
+      defutil,
       hlcgobj,
       pass_2,
       cgbase, cgobj, cgutils,
       cpubase;
 
+    procedure tavrinlinenode.second_abs_long;
+      var
+        hl: TAsmLabel;
+        size: TCgSize;
+      begin
+        secondpass(left);
+        hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
+
+        location:=left.location;
+        location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,left.resultdef);
+
+        size:=def_cgsize(left.resultdef);
+
+        current_asmdata.getjumplabel(hl);
+        cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,size,OC_GTE,0,left.location.register,hl);
+        cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,size,left.location.register,location.register);
+
+        cg.a_label(current_asmdata.CurrAsmList,hl);
+      end;
+
+
     function tavrinlinenode.pass_typecheck_cpu : tnode;
       begin
         Result:=nil;

+ 2 - 0
compiler/ccharset.pas

@@ -16,6 +16,8 @@
 {$mode objfpc}
 unit ccharset;
 
+{$i fpcdefs.inc}
+
   interface
 
     type

+ 290 - 77
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;
@@ -230,11 +247,11 @@ implementation
         FLastLocLabel:=nil;
         code_alignment_factor:=1;
         data_alignment_factor:=-4;
-        FDwarfList:=TLinkedList.Create;
+        FDwarfList:=TAsmList.Create;
       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.

+ 1 - 1
compiler/cgbase.pas

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

+ 353 - 0
compiler/cgexcept.pas

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

+ 9 - 2
compiler/cgobj.pas

@@ -453,7 +453,8 @@ unit cgobj;
 
           { some CPUs do not support hardware fpu exceptions, this procedure is called after instructions which
             might set FPU exception related flags, so it has to check these flags if needed and throw an exeception }
-          procedure g_check_for_fpu_exception(list: TAsmList); virtual;
+          procedure g_check_for_fpu_exception(list : TAsmList; force,clear : boolean); virtual;
+          procedure maybe_check_for_fpu_exception(list: TAsmList);
 
          protected
           function g_indirect_sym_load(list:TAsmList;const symname: string; const flags: tindsymflags): tregister;virtual;
@@ -2930,12 +2931,18 @@ implementation
       end;
 
 
-    procedure tcg.g_check_for_fpu_exception(list: TAsmList);
+    procedure tcg.g_check_for_fpu_exception(list: TAsmList;force,clear : boolean);
       begin
         { empty by default }
       end;
 
 
+    procedure tcg.maybe_check_for_fpu_exception(list: TAsmList);
+      begin
+        current_procinfo.FPUExceptionCheckNeeded:=true;
+        g_check_for_fpu_exception(list,false,true);
+      end;
+
 {*****************************************************************************
                                     TCG64
 *****************************************************************************}

+ 1 - 0
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,

+ 1 - 2
compiler/cresstr.pas

@@ -197,8 +197,7 @@ uses
         tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_vectorized_dead_strip_end,tcalo_data_force_indirect,tcalo_is_public_asm]);
         tcb.begin_anonymous_record(internaltypeprefixName[itp_emptyrec],
           default_settings.packrecords,sizeof(pint),
-          targetinfos[target_info.system]^.alignment.recordalignmin,
-          targetinfos[target_info.system]^.alignment.maxCrecordalign);
+          targetinfos[target_info.system]^.alignment.recordalignmin);
         current_asmdata.AsmLists[al_resourcestrings].concatList(
           tcb.get_final_asmlist_vectorized_dead_strip(
             tcb.end_anonymous_record,'RESSTR','',current_module.localsymtable,sizeof(pint)

+ 19 - 19
compiler/cstreams.pas

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

+ 6 - 6
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

+ 16 - 0
compiler/dbgdwarf.pas

@@ -48,6 +48,12 @@ interface
       DbgBase;
 
     type
+      {$ifdef avr}
+      // re-map to larger types because of offsets required to distinguish different memory spaces
+      puint = cardinal;
+      pint = longint;
+      {$endif avr}
+
       { Tag names and codes.   }
       tdwarf_tag = (DW_TAG_padding := $00,DW_TAG_array_type := $01,
         DW_TAG_class_type := $02,DW_TAG_entry_point := $03,
@@ -538,6 +544,11 @@ implementation
       { Implementation-defined range start.   }
       DW_LANG_hi_user = $ffff;
 
+      {$ifdef avr}
+      // More space required to include memory type offset
+      aitconst_ptr_unaligned = aitconst_32bit_unaligned;
+      {$endif avr}
+
     type
       { Names and codes for macro information.   }
       tdwarf_macinfo_record_type = (DW_MACINFO_define := 1,DW_MACINFO_undef := 2,
@@ -3142,7 +3153,12 @@ implementation
                  end;
                *)
                templist.concat(tai_const.create_8bit(3));
+               {$ifdef avr}
+               // Add $800000 to indicate that the address is in memory space
+               templist.concat(tai_const.create_int_dataptr_unaligned(sym.addroffset + $800000, aitconst_ptr_unaligned));
+               {$else}
                templist.concat(tai_const.create_int_dataptr_unaligned(sym.addroffset));
+               {$endif}
                blocksize:=1+sizeof(puint);
             end;
           toasm :

+ 3 - 3
compiler/defcmp.pas

@@ -808,9 +808,9 @@ implementation
                case def_from.typ of
                  orddef :
                    begin { ordinal to real }
-                     { only for implicit and internal typecasts in tp/delphi }
+                     { only for implicit and internal typecasts in tp }
                      if (([cdo_explicit,cdo_internal] * cdoptions <> [cdo_explicit]) or
-                         ([m_tp7,m_delphi] * current_settings.modeswitches = [])) and
+                         (not(m_tp7 in current_settings.modeswitches))) and
                         (is_integer(def_from) or
                          (is_currency(def_from) and
                           (s64currencytype.typ = floatdef))) then
@@ -1986,7 +1986,7 @@ implementation
            if (def1.typ = orddef) and (def2.typ = orddef) then
             Begin
               { see p.47 of Turbo Pascal 7.01 manual for the separation of types }
-              { range checking for case statements is done with testrange        }
+              { range checking for case statements is done with adaptrange        }
               case torddef(def1).ordtype of
                 u8bit,u16bit,u32bit,u64bit,
                 s8bit,s16bit,s32bit,s64bit :

+ 149 - 29
compiler/defutil.pas

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

+ 90 - 0
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.
+
+

+ 19 - 0
compiler/elfbase.pas

@@ -140,6 +140,11 @@ interface
     STT_TLS     = 6;
     STT_GNU_IFUNC = 10;
 
+    STV_DEFAULT = 0;
+    STV_INTERNAL = 1;
+    STV_HIDDEN = 2;
+    STV_PROTECTED = 3;
+
     { program header types }
     PT_NULL     = 0;
     PT_LOAD     = 1;
@@ -435,6 +440,9 @@ interface
     procedure MaybeSwapElfverneed(var h: TElfverneed);
     procedure MaybeSwapElfvernaux(var h: TElfvernaux);
 
+    function GetElfSymbolVisibility(other: byte): byte; inline;
+    procedure SetElfSymbolVisibility(var other: byte; vis: byte); inline;
+
 implementation
 
     uses
@@ -682,4 +690,15 @@ implementation
             end;
       end;
 
+
+    function GetElfSymbolVisibility(other: byte): byte; inline;
+      begin
+        result:=other and 3;
+      end;
+
+    procedure SetElfSymbolVisibility(var other: byte; vis: byte);
+      begin
+        other:=(other and not(3)) or vis;
+      end;
+
 end.

+ 38 - 32
compiler/entfile.pas

@@ -126,9 +126,9 @@ const
 
   ibmainname       = 90;
   ibsymtableoptions = 91;
-  ibrecsymtableoptions = 91;
   ibpackagefiles   = 92;
   ibpackagename    = 93;
+  ibrecsymtableoptions = 94;
   { target-specific things }
   iblinkotherframeworks = 100;
   ibjvmnamespace = 101;
@@ -257,7 +257,7 @@ type
     constructor create(const fn:string);
     destructor  destroy;override;
     function getversion:integer;
-    procedure flush;
+    procedure flush; {$ifdef USEINLINE}inline;{$endif}
     procedure closefile;virtual;
     procedure newentry;
     property position:longint read getposition write setposition;
@@ -278,9 +278,9 @@ type
     procedure readdata(out b;len:integer);
     procedure skipdata(len:integer);
     function  readentry:byte;
-    function  EndOfEntry:boolean;
-    function  entrysize:longint;
-    function  entryleft:longint;
+    function  EndOfEntry:boolean; {$ifdef USEINLINE}inline;{$endif}
+    function  entrysize:longint; {$ifdef USEINLINE}inline;{$endif}
+    function  entryleft:longint; {$ifdef USEINLINE}inline;{$endif}
     procedure getdatabuf(out b;len:integer;out res:integer);
     procedure getdata(out b;len:integer);
     function  getbyte:byte;
@@ -289,14 +289,14 @@ type
     function  getlongint:longint;
     function getint64:int64;
     function  getqword:qword;
-    function getaint:{$ifdef generic_cpu}int64{$else}aint{$endif};
-    function getasizeint:{$ifdef generic_cpu}int64{$else}asizeint{$endif};
-    function getpuint:{$ifdef generic_cpu}qword{$else}puint{$endif};
-    function getptruint:{$ifdef generic_cpu}qword{$else}TConstPtrUInt{$endif};
-    function getaword:{$ifdef generic_cpu}qword{$else}aword{$endif};
+    function getaint:{$ifdef generic_cpu}int64{$else}aint{$ifdef USEINLINE}; inline{$endif}{$endif};
+    function getasizeint:{$ifdef generic_cpu}int64{$else}asizeint{$ifdef USEINLINE}; inline{$endif}{$endif};
+    function getpuint:{$ifdef generic_cpu}qword{$else}puint{$ifdef USEINLINE}; inline{$endif}{$endif};
+    function getptruint:{$ifdef generic_cpu}qword{$else}TConstPtrUInt{$ifdef USEINLINE}; inline{$endif}{$endif};
+    function getaword:{$ifdef generic_cpu}qword{$else}aword{$ifdef USEINLINE}; inline{$endif}{$endif};
     function  getreal:entryreal;
     function  getrealsize(sizeofreal : longint):entryreal;
-    function  getboolean:boolean;inline;
+    function  getboolean:boolean; {$ifdef USEINLINE}inline;{$endif}
     function  getstring:string;
     function  getpshortstring:pshortstring;
     function  getansistring:ansistring;
@@ -311,23 +311,23 @@ type
     procedure writedata(const b;len:integer);
     procedure writeentry(ibnr:byte);
     procedure putdata(const b;len:integer);virtual;
-    procedure putbyte(b:byte);
-    procedure putword(w:word);
-    procedure putdword(w:dword);
-    procedure putlongint(l:longint);
-    procedure putint64(i:int64);
-    procedure putqword(q:qword);
-    procedure putaint(i:aint);
-    procedure putasizeint(i:asizeint);
-    procedure putpuint(i:puint);
-    procedure putptruint(v:TConstPtrUInt);
-    procedure putaword(i:aword);
+    procedure putbyte(b:byte); {$ifdef USEINLINE}inline;{$endif}
+    procedure putword(w:word); {$ifdef USEINLINE}inline;{$endif}
+    procedure putdword(w:dword); {$ifdef USEINLINE}inline;{$endif}
+    procedure putlongint(l:longint); {$ifdef USEINLINE}inline;{$endif}
+    procedure putint64(i:int64); {$ifdef USEINLINE}inline;{$endif}
+    procedure putqword(q:qword); {$ifdef USEINLINE}inline;{$endif}
+    procedure putaint(i:aint); {$ifdef USEINLINE}inline;{$endif}
+    procedure putasizeint(i:asizeint); {$ifdef USEINLINE}inline;{$endif}
+    procedure putpuint(i:puint); {$ifdef USEINLINE}inline;{$endif}
+    procedure putptruint(v:TConstPtrUInt); {$ifdef USEINLINE}inline;{$endif}
+    procedure putaword(i:aword); {$ifdef USEINLINE}inline;{$endif}
     procedure putreal(d:entryreal);
-    procedure putboolean(b:boolean);inline;
-    procedure putstring(const s:string);
+    procedure putboolean(b:boolean); {$ifdef USEINLINE}inline;{$endif}
+    procedure putstring(const s:string); {$ifdef USEINLINE}inline;{$endif}
     procedure putansistring(const s:ansistring);
-    procedure putnormalset(const b);
-    procedure putsmallset(const b);
+    procedure putnormalset(const b); {$ifdef USEINLINE}inline;{$endif}
+    procedure putsmallset(const b); {$ifdef USEINLINE}inline;{$endif}
     procedure tempclose;        // MG: not used, obsolete?
     function  tempopen:boolean; // MG: not used, obsolete?
   end;
@@ -1202,7 +1202,9 @@ function tentryfile.getrealsize(sizeofreal : longint):entryreal;
 var
   e : entryreal;
   d : double;
+  di : qword;{ integer of same size as double }
   s : single;
+  si : dword; { integer of same size as single }
 begin
   if sizeofreal=sizeof(e) then
     begin
@@ -1242,9 +1244,11 @@ begin
        end;
       readdata(d,sizeof(d));
       if change_endian then
-        result:=swapendian(pqword(@d)^)
-      else
-        result:=d;
+        begin
+          di:=swapendian(pqword(@d)^);
+          d:=pdouble(@di)^;
+        end;
+      result:=d;
       inc(entryidx,sizeof(d));
       result:=d;
 {$ifdef DEBUG_PPU}
@@ -1267,9 +1271,11 @@ begin
        end;
       readdata(s,sizeof(s));
       if change_endian then
-        result:=swapendian(pdword(@s)^)
-      else
-        result:=s;
+        begin
+          si:=swapendian(pdword(@s)^);
+          s:=psingle(@si)^;
+        end;
+      result:=s;
       inc(entryidx,sizeof(s));
       result:=s;
 {$ifdef DEBUG_PPU}

+ 1 - 0
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]);

+ 18 - 0
compiler/finput.pas

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

+ 21 - 6
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 }
@@ -205,6 +207,9 @@ interface
         { contains a list of specializations for which the method bodies need
           to be generated }
         pendingspecializations : TFPHashObjectList;
+        { list of attributes that are used and thus need their construction
+          functions generated }
+        used_rtti_attrs: tfpobjectlist;
 
         { this contains a list of units that needs to be waited for until the
           unit can be finished (code generated, etc.); this is needed to handle
@@ -596,8 +601,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;
@@ -607,6 +614,7 @@ implementation
         pendingspecializations:=tfphashobjectlist.create(false);
         waitingforunit:=tfpobjectlist.create(false);
         waitingunits:=tfpobjectlist.create(false);
+        used_rtti_attrs:=tfpobjectlist.create(false);
         globalsymtable:=nil;
         localsymtable:=nil;
         globalmacrosymtable:=nil;
@@ -705,6 +713,7 @@ implementation
         pendingspecializations.free;
         waitingforunit.free;
         waitingunits.free;
+        used_rtti_attrs.free;
         stringdispose(asmprefix);
         stringdispose(deprecatedmsg);
         stringdispose(namespace);
@@ -727,6 +736,8 @@ implementation
         llvmdefs.free;
         llvmusedsyms.free;
         llvmcompilerusedsyms.free;
+        llvminitprocs.free;
+        llvmfiniprocs.free;
 {$endif llvm}
         ansistrdef:=nil;
         wpoinfo.free;
@@ -798,9 +809,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;

+ 2 - 0
compiler/fpcdefs.inc

@@ -325,6 +325,8 @@
 }
 {$ifdef llvm}
   {$undef SUPPORT_MMX}
+  {$undef cpuneedsmulhelper}
+  {$undef cpuneedsdivhelper}
   {$define cpuhighleveltarget}
   {$define cpucg64shiftsupport}
   {$define symansistr}

+ 13 - 2
compiler/fppu.pas

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

+ 2 - 0
compiler/generic/cpuinfo.pas

@@ -15,6 +15,8 @@
 
 Unit CPUInfo;
 
+{$i fpcdefs.inc}
+
 Interface
 
   uses

+ 9 - 6
compiler/globals.pas

@@ -55,7 +55,7 @@ interface
           m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal,m_default_ansistring,
           m_out,m_default_para,m_duplicate_names,m_hintdirective,
           m_property,m_default_inline,m_except,m_advanced_records,
-          m_array_operators];
+          m_array_operators,m_prefixed_attributes];
        delphiunicodemodeswitches = delphimodeswitches + [m_systemcodepage,m_default_unicodestring];
        fpcmodeswitches =
          [m_fpc,m_string_pchar,m_nested_comment,m_repeat_forward,
@@ -399,6 +399,9 @@ interface
        defaultmainaliasname = 'main';
        mainaliasname : string = defaultmainaliasname;
 
+       custom_attribute_suffix = 'ATTRIBUTE';
+
+      LTOExt: TCmdStr = '';
 
     const
       default_settings : TSettings = (
@@ -535,14 +538,14 @@ interface
         fputype : fpu_x87;
   {$endif i8086}
   {$ifdef riscv32}
-        cputype : cpu_rv32imafd;
-        optimizecputype : cpu_rv32imafd;
+        cputype : cpu_rv32ima;
+        optimizecputype : cpu_rv32ima;
         asmcputype : cpu_none;
         fputype : fpu_fd;
   {$endif riscv32}
   {$ifdef riscv64}
-        cputype : cpu_rv64imafdc;
-        optimizecputype : cpu_rv64imafdc;
+        cputype : cpu_rv64imac;
+        optimizecputype : cpu_rv64imac;
         asmcputype : cpu_none;
         fputype : fpu_fd;
   {$endif riscv64}
@@ -567,7 +570,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;

+ 17 - 6
compiler/globtype.pas

@@ -196,7 +196,9 @@ interface
          cs_huge_code,
          cs_win16_smartcallbacks,
          { Record usage of checkpointer experimental feature }
-         cs_checkpointer_called
+         cs_checkpointer_called,
+         { enable link time optimisation (both unit code generation and optimising the whole program/library) }
+         cs_lto
        );
        tmoduleswitches = set of tmoduleswitch;
 
@@ -225,7 +227,9 @@ interface
          cs_link_map,cs_link_pthread,cs_link_no_default_lib_order,
          cs_link_native,
          cs_link_pre_binutils_2_19,
-         cs_link_vlink
+         cs_link_vlink,
+         { disable LTO for the system unit (needed to work around linker bugs on macOS) }
+         cs_lto_nosystem
        );
        tglobalswitches = set of tglobalswitch;
 
@@ -372,7 +376,9 @@ interface
          mf_i8086_cs_equals_ds,       { this unit uses an i8086 memory model with CS=DS (i.e. tiny) }
          mf_i8086_ss_equals_ds,       { this unit uses an i8086 memory model with SS=DS (i.e. tiny, small or medium) }
          mf_package_deny,             { this unit must not be part of a package }
-         mf_package_weak              { this unit may be completely contained in a package }
+         mf_package_weak,             { this unit may be completely contained in a package }
+         mf_llvm,                     { compiled for LLVM code generator, not compatible with regular compiler because of different nodes in inline functions }
+         mf_symansistr                { symbols are ansistrings (for ppudump) }
        );
        tmoduleflags = set of tmoduleflag;
 
@@ -484,7 +490,8 @@ interface
          m_isolike_mod,         { mod operation as it is required by an iso compatible compiler }
          m_array_operators,     { use Delphi compatible array operators instead of custom ones ("+") }
          m_multi_helpers,       { helpers can appear in multiple scopes simultaneously }
-         m_array2dynarray       { regular arrays can be implicitly converted to dynamic arrays }
+         m_array2dynarray,      { regular arrays can be implicitly converted to dynamic arrays }
+         m_prefixed_attributes  { enable attributes that are defined before the type they belong to }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -675,7 +682,8 @@ interface
          'ISOMOD',
          'ARRAYOPERATORS',
          'MULTIHELPERS',
-         'ARRAYTODYNARRAY'
+         'ARRAYTODYNARRAY',
+         'PREFIXEDATTRIBUTES'
          );
 
 
@@ -734,7 +742,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 +810,7 @@ interface
        link_static  = $2;
        link_smart   = $4;
        link_shared  = $8;
+       link_lto     = $10;
 
     type
       { a message state }

+ 4 - 14
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;
 
@@ -3935,7 +3935,7 @@ implementation
         end
       else
         begin
-          sym:=current_asmdata.DefineAsmSymbol(wrappername,AB_LOCAL,AT_FUNCTION,procdef);
+          sym:=current_asmdata.DefineAsmSymbol(wrappername,AB_PRIVATE_EXTERN,AT_FUNCTION,procdef);
           list.concat(Tai_symbol.Create(sym,0));
         end;
       a_jmp_external_name(list,externalname);
@@ -4590,14 +4590,7 @@ implementation
     begin
       item:=TCmdStrListItem(current_procinfo.procdef.aliasnames.first);
       firstitem:=item;
-      global:=
-        (cs_profile in current_settings.moduleswitches) or
-        { smart linking using a library requires to promote
-          all non-nested procedures to AB_GLOBAL
-          otherwise you get undefined symbol error at linking
-          for msdos  target with -CX option for instance }
-        (create_smartlink_library and not is_nested_pd(current_procinfo.procdef)) or
-        (po_global in current_procinfo.procdef.procoptions);
+      global:=current_procinfo.procdef.needsglobalasmsym;
       while assigned(item) do
         begin
 {$ifdef arm}
@@ -4614,13 +4607,10 @@ implementation
               if global then
                 begin
                   list.concat(tai_symbolpair.create(spk_set_global,item.str,firstitem.str));
-                  { needed for generating the tai_symbol_end }
-                  current_asmdata.DefineAsmSymbol(item.str,AB_GLOBAL,AT_FUNCTION,current_procinfo.procdef);
                 end
               else
                 begin
                   list.concat(tai_symbolpair.create(spk_set,item.str,firstitem.str));
-                  current_asmdata.DefineAsmSymbol(item.str,AB_LOCAL,AT_FUNCTION,current_procinfo.procdef);
                 end;
             end
           else
@@ -4628,7 +4618,7 @@ implementation
               if global then
                 list.concat(Tai_symbol.createname_global(item.str,AT_FUNCTION,0,current_procinfo.procdef))
               else
-                list.concat(Tai_symbol.createname(item.str,AT_FUNCTION,0,current_procinfo.procdef));
+                list.concat(Tai_symbol.Createname_hidden(item.str,AT_FUNCTION,0,current_procinfo.procdef));
               if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
                 list.concat(Tai_function_name.create(item.str));
             end;

+ 5 - 2
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;

+ 1 - 0
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

+ 2 - 2
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;

+ 0 - 1
compiler/i386/cputarg.pas

@@ -106,7 +106,6 @@ implementation
 
       ,ogcoff
       ,ogelf
-      ,ogmacho
       ,cpuelf
 
 {**************************************

+ 7 - 8
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));
@@ -396,7 +394,7 @@ implementation
       if make_global then
         List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0,procdef))
       else
-        List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0,procdef));
+        List.concat(Tai_symbol.Createname_hidden(labelname,AT_FUNCTION,0,procdef));
 
       { set param1 interface to self  }
       g_adjust_self_value(list,procdef,ioffset);
@@ -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.

+ 4 - 4
compiler/i386/n386add.pas

@@ -64,7 +64,7 @@ interface
 
     function ti386addnode.use_generic_mul64bit: boolean;
     begin
-      result:=(cs_check_overflow in current_settings.localswitches) or
+      result:=needoverflowcheck or
         (cs_opt_size in current_settings.optimizerswitches);
     end;
 
@@ -78,7 +78,7 @@ interface
                 not(is_signed(right.resultdef));
       { use IMUL instead of MUL in case overflow checking is off and we're
         doing a 32->32-bit multiplication }
-      if not (cs_check_overflow in current_settings.localswitches) and
+      if not needoverflowcheck and
          not is_64bit(resultdef) then
         unsigned:=false;
       if (nodetype=muln) and (unsigned or is_64bit(resultdef)) then
@@ -213,7 +213,7 @@ interface
         { is in unsigned VAR!!                              }
         if mboverflow then
          begin
-           if cs_check_overflow in current_settings.localswitches  then
+           if needoverflowcheck then
             begin
               current_asmdata.getjumplabel(hl4);
               if unsigned then
@@ -487,7 +487,7 @@ interface
         emit_ref(asmops[unsigned],S_L,ref)
       else
         emit_reg(asmops[unsigned],S_L,reg);
-      if (cs_check_overflow in current_settings.localswitches) and
+      if needoverflowcheck and
         { 32->64 bit cannot overflow }
         (not is_64bit(resultdef)) then
         begin

+ 3 - 4
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
@@ -601,7 +599,7 @@ implementation
       if make_global then
         List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0,procdef))
       else
-        List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0,procdef));
+        List.concat(Tai_symbol.Createname_hidden(labelname,AT_FUNCTION,0,procdef));
 
       { set param1 interface to self  }
       g_adjust_self_value(list,procdef,ioffset);
@@ -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.

+ 6 - 3
compiler/i8086/n8086add.pas

@@ -315,7 +315,7 @@ interface
         { is in unsigned VAR!!                              }
         if mboverflow then
          begin
-           if cs_check_overflow in current_settings.localswitches  then
+           if needoverflowcheck then
             begin
               current_asmdata.getjumplabel(hl4);
               if unsigned then
@@ -1002,6 +1002,7 @@ interface
         ref:Treference;
         use_ref:boolean;
         hl4 : tasmlabel;
+        overflowcheck: boolean;
 
     const
       asmops: array[boolean] of tasmop = (A_IMUL, A_MUL);
@@ -1012,10 +1013,12 @@ interface
 
       pass_left_right;
 
+      overflowcheck:=needoverflowcheck;
+
       { MUL is faster than IMUL on the 8086 & 8088 (and equal in speed on 286+),
         but it's only safe to use in place of IMUL when overflow checking is off
         and we're doing a 16-bit>16-bit multiplication }
-      if not (cs_check_overflow in current_settings.localswitches) and
+      if not overflowcheck and
         (not is_32bitint(resultdef)) then
         unsigned:=true;
 
@@ -1048,7 +1051,7 @@ interface
         emit_ref(asmops[unsigned],S_W,ref)
       else
         emit_reg(asmops[unsigned],S_W,reg);
-      if (cs_check_overflow in current_settings.localswitches) and
+      if overflowcheck and
         { 16->32 bit cannot overflow }
         (not is_32bitint(resultdef)) then
         begin

+ 12 - 0
compiler/i8086/n8086con.pas

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

+ 6 - 0
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

+ 2 - 0
compiler/jvm/cpuinfo.pas

@@ -14,6 +14,8 @@
 
 Unit cpuinfo;
 
+{$i fpcdefs.inc}
+
 Interface
 
   uses

+ 2 - 3
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.

+ 66 - 56
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;
 
 

+ 134 - 28
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;
 
 

+ 187 - 0
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.
+

+ 371 - 100
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.

+ 136 - 65
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.

+ 1 - 0
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 }

+ 58 - 4
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.

+ 147 - 0
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.
+

+ 26 - 10
compiler/llvm/llvmdef.pas

@@ -30,7 +30,7 @@ interface
       cclasses,globtype,
       aasmbase,
       parabase,
-      symbase,symtype,symdef,
+      symconst,symbase,symtype,symdef,
       llvmbase;
 
    type
@@ -68,7 +68,7 @@ interface
       record consisting of 4 longints must be returned as a record consisting of
       two int64's on x86-64. This function is used to create (and reuse)
       temporary recorddefs for such purposes.}
-    function llvmgettemprecorddef(const fieldtypes: array of tdef; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef;
+    function llvmgettemprecorddef(const fieldtypes: array of tdef; packrecords, recordalignmin: shortint): trecorddef;
 
     { get the llvm type corresponding to a parameter, e.g. a record containing
       two integer int64 for an arbitrary record split over two individual int64
@@ -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 }
@@ -855,7 +862,7 @@ implementation
       end;
 
 
-    function llvmgettemprecorddef(const fieldtypes: array of tdef; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef;
+    function llvmgettemprecorddef(const fieldtypes: array of tdef; packrecords, recordalignmin: shortint): trecorddef;
       var
         i: longint;
         res: PHashSetItem;
@@ -913,7 +920,7 @@ implementation
         if not assigned(res^.Data) then
           begin
             res^.Data:=crecorddef.create_global_internal(typename,packrecords,
-              recordalignmin,maxcrecordalign);
+              recordalignmin);
             for i:=low(fieldtypes) to high(fieldtypes) do
               trecorddef(res^.Data).add_field_by_def('F'+tostr(i),fieldtypes[i]);
           end;
@@ -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
@@ -1006,8 +1023,7 @@ implementation
           retloc:=retloc^.next;
         until not assigned(retloc);
         result:=llvmgettemprecorddef(slice(retdeflist,i),C_alignment,
-          targetinfos[target_info.system]^.alignment.recordalignmin,
-          targetinfos[target_info.system]^.alignment.maxCrecordalign);
+          targetinfos[target_info.system]^.alignment.recordalignmin);
         include(result.defoptions,df_llvm_no_struct_packing);
       end;
 

+ 118 - 52
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.

+ 4 - 3
compiler/llvm/llvmnode.pas

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

+ 41 - 19
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 }

+ 476 - 0
compiler/llvm/llvmpi.pas

@@ -0,0 +1,476 @@
+{
+    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);
+          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.
+

+ 134 - 66
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)));

+ 3 - 2
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;

+ 15 - 2
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

+ 81 - 6
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.
 

+ 75 - 0
compiler/llvm/nllvminl.pas

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

+ 53 - 0
compiler/llvm/nllvmset.pas

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

+ 15 - 12
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;
@@ -384,13 +385,15 @@ implementation
             arraydef:
               { in an array, all elements come right after each other ->
                 replace with a packed record }
-              newdef:=crecorddef.create_global_internal('',1,1,1);
+              newdef:=crecorddef.create_global_internal('',1,1);
             recorddef,
             objectdef:
-              newdef:=crecorddef.create_global_internal('',
-                tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).recordalignment,
-                tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).recordalignmin,
-                tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).maxCrecordalign);
+              begin
+                newdef:=crecorddef.create_global_internal('',
+                  tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).usefieldalignment,
+                  tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).recordalignmin);
+                tabstractrecordsymtable(newdef.symtable).recordalignment:=tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).recordalignment;
+              end
             else
               internalerror(2015122401);
           end;
@@ -412,13 +415,12 @@ implementation
 
   procedure tllvmtai_typedconstbuilder.emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);
     var
-      srsym     : tsym;
-      srsymtable: tsymtable;
       strrecdef : trecorddef;
       strdef: tdef;
       offset: pint;
       field: tfieldvarsym;
       dataptrdef: tdef;
+      typesym: ttypesym;
     begin
       { nil pointer? }
       if not assigned(ll.lab) then
@@ -434,9 +436,10 @@ implementation
       if ll.ofs<>0 then
         begin
           { get the recorddef for this string constant }
-          if not searchsym_type(ctai_typedconstbuilder.get_dynstring_rec_name(st,winlikewidestring,strlength),srsym,srsymtable) then
+          typesym:=try_search_current_module_type(ctai_typedconstbuilder.get_dynstring_rec_name(st,winlikewidestring,strlength));
+          if not assigned(typesym) then
             internalerror(2014080406);
-          strrecdef:=trecorddef(ttypesym(srsym).typedef);
+          strrecdef:=trecorddef(typesym.typedef);
           { offset in the record of the the string data }
           offset:=ctai_typedconstbuilder.get_string_symofs(st,winlikewidestring);
           { field corresponding to this offset }

+ 196 - 11
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,19 +50,21 @@ 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)
+      else if tf_supports_hidden_symbols in target_info.flags then
+        asmsym:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_PRIVATE_EXTERN,AT_DATA,sym.vardef)
       else
         asmsym:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_LOCAL,AT_DATA,sym.vardef);
       if not(vo_is_thread_var in sym.varoptions) then
@@ -71,24 +78,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 +161,49 @@ 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);
+          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 +212,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 +226,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.

+ 10 - 10
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

+ 5 - 0
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.

+ 1 - 2
compiler/m68k/ag68kvasm.pas

@@ -99,7 +99,6 @@ unit ag68kvasm;
           system_m68k_amiga: objtype:='-Felf';
           { atari never had a standard object format, a.out is limited, vasm/vlink author recommends vobj }
           system_m68k_atari: objtype:='-Fvobj';
-          system_m68k_linux: objtype:='-Felf';
         else
           internalerror(2016052601);
         end;
@@ -133,7 +132,7 @@ unit ag68kvasm;
          idtxt  : 'VASM';
          asmbin : 'vasmm68k_std';
          asmcmd:  '-quiet -elfregs -gas $OTYPE $ARCH -o $OBJ $EXTRAOPT $ASM';
-         supported_targets : [system_m68k_amiga,system_m68k_atari,system_m68k_linux];
+         supported_targets : [system_m68k_amiga,system_m68k_atari];
          flags : [af_needar,af_smartlink_sections];
          labelprefix : '.L';
          comment : '# ';

+ 6 - 0
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

+ 2 - 0
compiler/m68k/cpuinfo.pas

@@ -14,6 +14,8 @@
 
 Unit CPUInfo;
 
+{$i fpcdefs.inc}
+
 Interface
 
   uses

+ 3 - 4
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
@@ -214,7 +212,7 @@ implementation
       if make_global then
         List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0,procdef))
       else
-        List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0,procdef));
+        List.concat(Tai_symbol.Createname_hidden(labelname,AT_FUNCTION,0,procdef));
 
       { set param1 interface to self  }
       g_adjust_self_value(list,procdef,ioffset);
@@ -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.

+ 2 - 4
compiler/m68k/n68kadd.pas

@@ -399,9 +399,7 @@ implementation
       begin
         { if we need to handle overflow checking, fall back to the generic cg }
         if (nodetype in [addn,subn,muln]) and
-           (left.resultdef.typ<>pointerdef) and
-           (right.resultdef.typ<>pointerdef) and
-           (cs_check_overflow in current_settings.localswitches) then
+           needoverflowcheck then
           begin
             inherited;
             exit;
@@ -609,7 +607,7 @@ implementation
 
     function t68kaddnode.use_generic_mul64bit: boolean;
     begin
-      result:=(cs_check_overflow in current_settings.localswitches) or
+      result:=needoverflowcheck  or
         (cs_opt_size in current_settings.optimizerswitches) or
         not (CPUM68K_HAS_64BITMUL in cpu_capabilities[current_settings.cputype]);
     end;

Niektoré súbory nie sú zobrazené, pretože je v týchto rozdielových dátach zmenené mnoho súborov