LLVM backend: address sanitizer support

Activate with -Clfsanitize=address. Only tested on Darwin/x86-64 for now.

compiler/globtype.pas

@@ -199,7 +199,9 @@ interface
          { Record usage of checkpointer experimental feature }
          cs_checkpointer_called,
          { enable link time optimisation (both unit code generation and optimising the whole program/library) }
-         cs_lto
+         cs_lto,
+         { LLVM sanitizers }
+         cs_sanitize_address
        );
        tmoduleswitches = set of tmoduleswitch;
 

compiler/llvm/agllvm.pas

@@ -1053,6 +1053,8 @@ implementation
             writer.AsmWrite(' null_pointer_is_valid');
           if not(pio_fastmath in pd.implprocoptions) then
             writer.AsmWrite(' strictfp');
+          if cs_sanitize_address in current_settings.moduleswitches then
+            writer.AsmWrite(' sanitize_address');
         end;
 
       procedure WriteTypedConstData(hp: tai_abstracttypedconst; metadatakind: tmetadatakind);
@@ -1465,6 +1467,16 @@ implementation
                       writer.AsmWrite(', align ');
                       writer.AsmWrite(tostr(taillvmdecl(hp).alignment));
                     end;
+                  { address sanitizer adds a red zone after global variables,
+                    while vectorized sections like resource strings are indexed
+                    like arrays by Pascal code -> the red zones completely mess
+                    up this indexing }
+                  if (ldf_vectorized in (taillvmdecl(hp).flags)) and
+                     (cs_sanitize_address in current_settings.moduleswitches) and
+                     (llvmflag_sanitizer_attributes in llvmversion_properties[current_settings.llvmversion]) then
+                    begin
+                      writer.AsmWrite(', no_sanitize_address')
+                    end;
                   InstrWriter.WriterInstructionMetadata(', ',taillvmdecl(hp).metadata);
                   writer.AsmLn;
                 end;
@@ -1726,6 +1738,15 @@ implementation
            and (target_info.system in [system_aarch64_darwin, system_aarch64_linux]) then
           optstr:=optstr+' -march='+cputypestr[current_settings.cputype];
 
+        if ([cs_sanitize_address]*current_settings.moduleswitches)<>[] then
+          begin
+            optstr:=optstr+' -fsanitize=';
+            if cs_sanitize_address in current_settings.moduleswitches then
+              begin
+                optstr:=optstr+'address';
+              end;
+          end;
+
         replace(result,'$OPT',optstr);
         inc(fnextpass);
       end;

compiler/llvm/llvminfo.pas

@@ -67,7 +67,8 @@ type
      llvmflag_NoDISPFlagMainSubprogram,     { MainSubprogram still in DIFlags instead of DISPFlags }
      llvmflag_para_attr_type,               { parameter attributes such as noalias and byval need to repeat the type }
      llvmflag_opaque_ptr_transition,        { initial opaque pointer introduction, needs to some elementtype attributes }
-     llvmflag_opaque_ptr                    { only opaque pointers }
+     llvmflag_opaque_ptr,                   { only opaque pointers }
+     llvmflag_sanitizer_attributes          { can use attributes to exclude symbols from sanitizers }
    );
    tllvmversionflags = set of tllvmversionflag;
 

compiler/llvm/nllvmutil.pas

@@ -37,6 +37,7 @@ interface
       class procedure insertbsssym(list: tasmlist; sym: tstaticvarsym; size: asizeint; varalign: shortint; _typ:Tasmsymtype); override;
       class procedure InsertUsedList(var usedsyms: tfpobjectlist; const usedsymsname: TSymStr);
       class procedure InsertInitFiniList(var procdefs: tfplist; const initfinisymsname: TSymStr);
+      class procedure InsertAsanGlobals;
      public
       class procedure InsertObjectInfo; override;
       class procedure RegisterUsedAsmSym(sym: TAsmSymbol; def: tdef; compileronly: boolean); override;
@@ -48,7 +49,7 @@ interface
 implementation
 
     uses
-      verbose,cutils,globals,fmodule,systems,
+      verbose,cutils,globals,fmodule,systems,finput,
       aasmtai,cpubase,llvmbase,aasmllvm,
       aasmcnst,nllvmtcon,
       symbase,symtable,defutil,
@@ -101,7 +102,8 @@ implementation
     end;
 
 
-  class procedure tllvmnodeutils.InsertUsedList(var usedsyms: tfpobjectlist; const usedsymsname: TSymstr);
+    class procedure tllvmnodeutils.InsertUsedList(var usedsyms: tfpobjectlist;
+    const usedsymsname: TSymStr);
     var
       useddef: tdef;
       tcb: ttai_typedconstbuilder;
@@ -203,6 +205,80 @@ implementation
     end;
 
 
+  class procedure tllvmnodeutils.InsertAsanGlobals;
+    var
+      asanglobal,
+      asanglobals,
+      globalfileloc: tai_llvmbasemetadatanode;
+      hp: tai;
+      hpdecl: taillvmdecl;
+      sourcefile: tinputfile;
+      module: tmodule;
+      list: TAsmList;
+      asmlisttype: TAsmListType;
+    begin
+      if not(cs_sanitize_address in current_settings.moduleswitches) or
+         (llvmflag_sanitizer_attributes in llvmversion_properties[current_settings.llvmversion]) then
+        exit;
+      asanglobals:=nil;
+      module:=get_module(current_filepos.moduleindex);
+      for asmlisttype:=low(asmlisttype) to high(asmlisttype) do
+        begin
+          list:=current_asmdata.AsmLists[asmlisttype];
+          if not assigned(list) then
+            continue;
+          hp:=tai(list.first);
+          while assigned(hp) do
+            begin
+              if (hp.typ=ait_llvmdecl) and
+                 (ldf_definition in taillvmdecl(hp).flags) and
+                 (taillvmdecl(hp).def.typ<>procdef) then
+                begin
+                  if not assigned(asanglobals) then
+                    begin
+                      asanglobals:=tai_llvmnamedmetadatanode.create('llvm.asan.globals');
+                      current_asmdata.AsmLists[al_rotypedconsts].concat(asanglobals);
+                    end;
+                  hpdecl:=taillvmdecl(hp);
+
+                  globalfileloc:=tai_llvmunnamedmetadatanode.create;
+                  current_asmdata.AsmLists[al_rotypedconsts].concat(globalfileloc);
+                  if assigned(hpdecl.sym) then
+                    begin
+                      sourcefile:=get_source_file(hpdecl.sym.fileinfo.moduleindex,hpdecl.sym.fileinfo.fileindex);
+                      globalfileloc.addvalue(tai_simpletypedconst.create(charpointertype,tai_string.Create(sourcefile.name)));
+                      globalfileloc.addvalue(tai_simpletypedconst.create(s32inttype,tai_const.Create_32bit(hpdecl.sym.fileinfo.line)));
+                      globalfileloc.addvalue(tai_simpletypedconst.create(s32inttype,tai_const.Create_32bit(hpdecl.sym.fileinfo.column)));
+                    end
+                  else
+                    begin
+                      sourcefile:=current_module.sourcefiles.get_file(1);
+                      globalfileloc.addvalue(tai_simpletypedconst.create(charpointertype,tai_string.Create(sourcefile.name)));
+                      globalfileloc.addvalue(tai_simpletypedconst.create(s32inttype,tai_const.Create_32bit(1)));
+                      globalfileloc.addvalue(tai_simpletypedconst.create(s32inttype,tai_const.Create_32bit(1)));
+                    end;
+
+                  asanglobal:=tai_llvmunnamedmetadatanode.create;
+                  current_asmdata.AsmLists[al_rotypedconsts].concat(asanglobal);
+                  asanglobal.addvalue(tai_simpletypedconst.create(cpointerdef.getreusable(hpdecl.def),tai_const.Create_sym(hpdecl.namesym)));
+                  asanglobal.addvalue(tai_simpletypedconst.create(llvm_metadatatype,llvm_getmetadatareftypedconst(globalfileloc)));
+                  if assigned(hpdecl.sym) then
+                    asanglobal.addvalue(tai_simpletypedconst.create(llvm_metadatatype,tai_string.Create(hpdecl.sym.RealName)))
+                  else
+                    asanglobal.addvalue(tai_simpletypedconst.create(llvm_metadatatype,tai_string.Create(hpdecl.namesym.Name)));
+                  { dynamic init }
+                  asanglobal.addvalue(tai_simpletypedconst.create(llvmbool1type,tai_const.Create_8bit(ord(false))));
+                  { no asan }
+                  asanglobal.addvalue(tai_simpletypedconst.create(llvmbool1type,tai_const.Create_8bit(ord((ldf_vectorized in taillvmdecl(hp).flags)))));
+
+                  asanglobals.addvalue(tai_simpletypedconst.create(llvm_metadatatype,llvm_getmetadatareftypedconst(asanglobal)));
+                end;
+              hp:=tai(hp.next);
+            end;
+        end;
+    end;
+
+
   class procedure tllvmnodeutils.InsertObjectInfo;
     var
       llvmmoduleflags,
@@ -210,6 +286,8 @@ implementation
       dwarfversionflag: tai_llvmbasemetadatanode;
       objcabiversion: longint;
     begin
+      InsertAsanGlobals;
+
       llvmmoduleflags:=tai_llvmnamedmetadatanode.create('llvm.module.flags');
       current_asmdata.AsmLists[al_rotypedconsts].Concat(llvmmoduleflags);
 

compiler/msg/errore.msg

@@ -3996,6 +3996,7 @@ A*2CI<x>_Select instruction set on ARM: ARM or THUMB
 L*2Cl<x>_LLVM code generation options
 L*3Clflto_Enable Link-time optimisation (needed both when compiling units and programs/libraries)
 L*3Clfltonosystem_Disable LTO for the system unit (needed with at least Xcode 10.2 and earlier due to linker bugs)
+L*3Clflsanitize=address_Enable address sanitizer
 L*3Clv<x>_LLVM target version: Xcode-10.1, 7.0, 8.0, .., 10.0
 **2Cn_Omit linking stage
 P*2CN_Generate nil-pointer checks (AIX-only)

compiler/options.pas

@@ -86,6 +86,9 @@ Type
     function ParseVersionStr(out ver: longint; const compvarname, value: string): boolean;
     procedure MaybeSetIdfVersionMacro;
 {$endif}
+{$ifdef llvm}
+    procedure LLVMEnableSanitizers(sanitizers: TCmdStr);
+{$endif llvm}
     procedure VerifyTargetProcessor;
   end;
 
@@ -1358,6 +1361,24 @@ begin
   end;
 end;
 
+{$ifdef llvm}
+procedure TOption.LLVMEnableSanitizers(sanitizers: TCmdStr);
+  var
+    sanitizer: TCMdStr;
+  begin
+    sanitizer:=GetToken(sanitizers,',');
+    repeat
+       case sanitizer of
+         'address':
+           include(init_settings.moduleswitches,cs_sanitize_address);
+         else
+           IllegalPara(sanitizer);
+       end;
+       sanitizer:=GetToken(sanitizers,',');
+    until sanitizer='';
+  end;
+{$endif}
+
 {$ifdef XTENSA}
 procedure TOption.MaybeSetIdfVersionMacro;
 begin
@@ -1689,7 +1710,7 @@ begin
                             case More[l] of
                               'f':
                                 begin
-                                  More:=copy(More,l+1,length(More));
+                                  delete(More,1,l);
                                   disable:=Unsetbool(More,length(More)-1,opt,false);
                                   case More of
                                     'lto':
@@ -1711,6 +1732,11 @@ begin
                                          else
                                            exclude(init_settings.globalswitches,cs_lto_nosystem);
                                        end;
+                                    else if More.StartsWith('sanitize=') then
+                                      begin
+                                        delete(More,1,length('sanitize='));
+                                        LLVMEnableSanitizers(more);
+                                      end
                                     else
                                       begin
                                         IllegalPara(opt);

compiler/pmodules.pas

@@ -328,7 +328,8 @@ implementation
            if (cs_use_heaptrc in current_settings.globalswitches) then
              AddUnit('heaptrc');
            { Valgrind requires c memory manager }
-           if (cs_gdb_valgrind in current_settings.globalswitches) then
+           if (cs_gdb_valgrind in current_settings.globalswitches) or
+              (([cs_sanitize_address]*current_settings.moduleswitches)<>[]) then
              AddUnit('cmem');
            { Lineinfo unit }
            if (cs_use_lineinfo in current_settings.globalswitches) then begin

compiler/utils/ppuutils/ppudump.pp

@@ -2285,6 +2285,7 @@ const
          { Record usage of checkpointer experimental feature }
         'CheckPointer used', {cs_checkpointer_called}
         'Supports LLVM Link-Time Optimization' {cs_lto}
+        ,'Enable LLVM Address Sanitizer'
        );
     globalswitchname : array[tglobalswitch] of string[50] =
        ('Global None',{cs_globalnone}