+ support for generating Dwarf CFI using .cfi_* directives

   o adjust peephole optimisers so they don't remove cfi_endproc directives
     in case of tail call optimisation

git-svn-id: branches/debug_eh@41578 -

.gitattributes

@@ -47,6 +47,7 @@ compiler/aarch64/racpugas.pas svneol=native#text/plain
 compiler/aarch64/rgcpu.pas svneol=native#text/plain
 compiler/aarch64/symcpu.pas svneol=native#text/plain
 compiler/aasmbase.pas svneol=native#text/plain
+compiler/aasmcfi.pas svneol=native#text/plain
 compiler/aasmcnst.pas svneol=native#text/plain
 compiler/aasmdata.pas svneol=native#text/plain
 compiler/aasmdef.pas svneol=native#text/plain

compiler/aasmcfi.pas

@@ -0,0 +1,198 @@
+{
+    Copyright (c) 2019 by Jonas Maebe, member of the
+    Free Pascal Compiler development team
+
+    Dwarf Call Frame Information directives
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit aasmcfi;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      globtype,
+      cgbase,
+      aasmtai;
+
+    type
+      tcfikind =
+        (cfi_startproc,
+         cfi_endproc,
+         cfi_personality,
+         cfi_personality_id,
+         cfi_fde_data,
+         cfi_lsda_encoding,
+         cfi_inline_lsda,
+         cfi_def_cfa,
+         cfi_def_cfa_register,
+         cfi_def_cfa_offset,
+         cfi_adjust_cfa_offset,
+         cfi_offset,
+         cfi_val_offset,
+         cfi_rel_offset,
+         cfi_register,
+         cfi_restore,
+         cfi_undefined,
+         cfi_same_value,
+         cfi_remember_state,
+         cfi_restore_state,
+         cfi_return_column,
+         cfi_signal_frame,
+         cfi_window_save,
+         cfi_escape,
+         cfi_val_encoded_addr
+        );
+
+{$push}
+{$j-}
+      const
+        cfi2str: array[tcfikind] of string[length('.cfi_adjust_cfa_offset')] =
+          ('.cfi_startproc',
+           '.cfi_endproc',
+           '.cfi_personality',
+           '.cfi_personality_id',
+           '.cfi_fde_data',
+           '.cfi_lsda_encoding',
+           '.cfi_inline_lsda',
+           '.cfi_def_cfa',
+           '.cfi_def_cfa_register',
+           '.cfi_def_cfa_offset',
+           '.cfi_adjust_cfa_offset',
+           '.cfi_offset',
+           '.cfi_val_offset',
+           '.cfi_rel_offset',
+           '.cfi_register',
+           '.cfi_restore',
+           '.cfi_undefined',
+           '.cfi_same_value',
+           '.cfi_remember_state',
+           '.cfi_restore_state',
+           '.cfi_return_column',
+           '.cfi_signal_frame',
+           '.cfi_window_save',
+           '.cfi_escape',
+           '.cfi_val_encoded_addr'
+          );
+{$pop}
+
+    type
+      tai_cfi_base = class abstract(tai)
+        cfityp: tcfikind;
+        constructor create(ctyp: tcfikind);
+      end;
+
+      tai_cfi_op_none = class(tai_cfi_base)
+      end;
+
+      tai_cfi_op_val = class(tai_cfi_base)
+        val1: aint;
+        constructor create(ctyp: tcfikind; const a: aint);
+      end;
+
+      tai_cfi_op_string = class(tai_cfi_base)
+        s1: TSymStr;
+        constructor create(ctyp: tcfikind; const str1: TSymStr);
+      end;
+
+      tai_cfi_op_val_string = class(tai_cfi_op_val)
+        s: TSymStr;
+        constructor create(ctyp: tcfikind; const a: aint; const str: TSymStr);
+      end;
+
+      tai_cfi_op_string_string = class(tai_cfi_op_string)
+        s2: TSymStr;
+        constructor create(ctyp: tcfikind; const str1, str2: TSymStr);
+      end;
+
+      tai_cfi_op_reg = class(tai_cfi_base)
+        reg1: tregister;
+        constructor create(ctyp: tcfikind; r: tregister);
+      end;
+
+      tai_cfi_op_reg_val = class(tai_cfi_op_reg)
+        val: aint;
+        constructor create(ctyp: tcfikind; r: tregister; a: aint);
+      end;
+
+      tai_cfi_op_reg_reg = class(tai_cfi_op_reg)
+        reg2: tregister;
+        constructor create(ctyp: tcfikind; r1, r2: tregister);
+      end;
+
+
+  implementation
+
+    constructor tai_cfi_base.create(ctyp: tcfikind);
+      begin
+        typ:=ait_cfi;
+        cfityp:=ctyp;
+      end;
+
+
+    constructor tai_cfi_op_val.create(ctyp: tcfikind; const a: aint);
+      begin
+        inherited create(ctyp);
+        val1:=a;
+      end;
+
+
+    constructor tai_cfi_op_string.create(ctyp: tcfikind; const str1: TSymStr);
+      begin
+        inherited create(ctyp);
+        s1:=str1;
+      end;
+
+
+    constructor tai_cfi_op_val_string.create(ctyp: tcfikind; const a: aint; const str: TSymStr);
+      begin
+        inherited create(ctyp,a);
+        s:=str;
+      end;
+
+
+    constructor tai_cfi_op_string_string.create(ctyp: tcfikind; const str1, str2: TSymStr);
+      begin
+        inherited create(ctyp,str1);
+        s2:=str2;
+      end;
+
+
+    constructor tai_cfi_op_reg.create(ctyp: tcfikind; r: tregister);
+      begin
+        inherited create(ctyp);
+        reg1:=r;
+      end;
+
+
+    constructor tai_cfi_op_reg_val.create(ctyp: tcfikind; r: tregister; a: aint);
+      begin
+        inherited create(ctyp,r);
+        val:=a;
+      end;
+
+
+    constructor tai_cfi_op_reg_reg.create(ctyp: tcfikind; r1, r2: tregister);
+      begin
+        inherited create(ctyp,r1);
+        reg2:=r2;
+      end;
+
+end.
+

compiler/aasmtai.pas

@@ -89,7 +89,9 @@ interface
           ait_llvmdecl, { llvm symbol declaration (global/external variable, external procdef) }
 {$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 = (
@@ -221,6 +223,7 @@ interface
           'llvmalias',
           'llvmdecl',
 {$endif}
+          'cfi',
           'seh_directive'
           );
 
@@ -321,7 +324,8 @@ interface
 {$ifdef llvm}
                      ait_llvmdecl,
 {$endif llvm}
-                     ait_seh_directive
+                     ait_seh_directive,
+                     ait_cfi
                     ];
 
 

compiler/aggas.pas

@@ -32,7 +32,7 @@ interface
 
     uses
       globtype,globals,
-      aasmbase,aasmtai,aasmdata,
+      aasmbase,aasmtai,aasmdata,aasmcfi,
       assemble;
 
     type
@@ -68,6 +68,7 @@ interface
         setcount: longint;
         procedure WriteDecodedSleb128(a: int64);
         procedure WriteDecodedUleb128(a: qword);
+        procedure WriteCFI(hp: tai_cfi_base);
         function NextSetLabel: string;
        protected
         InstrWriter: TCPUInstrWriter;
@@ -597,6 +598,39 @@ 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;
@@ -1431,6 +1465,10 @@ implementation
                    std_regname(tai_varloc(hp).newlocation)));
                writer.AsmLn;
              end;
+           ait_cfi:
+             begin
+               WriteCFI(tai_cfi_base(hp));
+             end;
            else
              internalerror(2006012201);
          end;

compiler/aoptobj.pas

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

compiler/cfidwarf.pas

@@ -31,7 +31,7 @@ interface
       cclasses,
       globtype,
       cgbase,cpubase,
-      aasmbase,aasmtai,aasmdata;
+      aasmbase,aasmcfi,aasmtai,aasmdata;
 
     const
       maxdwarfops = 2;
@@ -63,6 +63,11 @@ interface
       end;
 
       TDwarfAsmCFI=class(TAsmCFI)
+        use_eh_frame : boolean;
+        constructor create;override;
+      end;
+
+      TDwarfAsmCFILowLevel=class(TDwarfAsmCFI)
       private
         FDwarfList : TLinkedList;
         FFrameStartLabel,
@@ -75,7 +80,6 @@ interface
         data_alignment_factor : shortint;
         property DwarfList:TlinkedList read FDwarfList;
       public
-        use_eh_frame : boolean;
         constructor create;override;
         destructor destroy;override;
         procedure generate_code(list:TAsmList);override;
@@ -94,6 +98,20 @@ 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
@@ -211,6 +229,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;
@@ -219,12 +250,10 @@ implementation
         code_alignment_factor:=1;
         data_alignment_factor:=-4;
         FDwarfList:=TLinkedList.Create;
-        if tf_use_psabieh in target_info.flags then
-          use_eh_frame:=true;
       end;
 
 
-    destructor TDwarfAsmCFI.destroy;
+    destructor TDwarfAsmCFILowLevel.destroy;
       begin
         FDwarfList.Free;
       end;
@@ -232,7 +261,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)));
@@ -243,7 +272,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)));
@@ -254,7 +283,7 @@ implementation
       end;
 {$endif i386}
 
-    procedure TDwarfAsmCFI.generate_code(list:TAsmList);
+    procedure TDwarfAsmCFILowLevel.generate_code(list:TAsmList);
       var
         hp : tdwarfitem;
         CurrentLSDALabel,
@@ -431,7 +460,7 @@ implementation
       end;
 
 
-    procedure TDwarfAsmCFI.start_frame(list:TAsmList);
+    procedure TDwarfAsmCFILowLevel.start_frame(list:TAsmList);
       begin
         current_asmdata.getlabel(FFrameEndLabel,alt_dbgframe);
         FLastloclabel:=get_frame_start;
@@ -440,7 +469,7 @@ implementation
       end;
 
 
-    function TDwarfAsmCFI.get_frame_start : TAsmLabel;
+    function TDwarfAsmCFILowLevel.get_frame_start : TAsmLabel;
       begin
         if not(assigned(FFrameStartLabel)) then
           current_asmdata.getlabel(FFrameStartLabel,alt_dbgframe);
@@ -448,20 +477,20 @@ implementation
       end;
 
 
-    function TDwarfAsmCFI.get_cfa_list: TAsmList;
+    function TDwarfAsmCFILowLevel.get_cfa_list: TAsmList;
       begin
        Result:=TAsmList(DwarfList);
       end;
 
 
-    procedure TDwarfAsmCFI.outmost_frame(list: TAsmList);
+    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);
@@ -473,7 +502,7 @@ implementation
       end;
 
 
-    procedure TDwarfAsmCFI.cfa_advance_loc(list:TAsmList);
+    procedure TDwarfAsmCFILowLevel.cfa_advance_loc(list:TAsmList);
       var
         currloclabel : tasmlabel;
       begin
@@ -486,7 +515,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}
@@ -495,27 +524,119 @@ implementation
       end;
 
 
-    procedure TDwarfAsmCFI.cfa_restore(list:TAsmList;reg:tregister);
+    procedure TDwarfAsmCFILowLevel.cfa_restore(list:TAsmList;reg:tregister);
       begin
         cfa_advance_loc(list);
         DwarfList.concat(tdwarfitem.create_reg(DW_CFA_restore_extended,doe_uleb,reg));
       end;
 
 
-    procedure TDwarfAsmCFI.cfa_def_cfa_register(list:TAsmList;reg:tregister);
+    procedure TDwarfAsmCFILowLevel.cfa_def_cfa_register(list:TAsmList;reg:tregister);
       begin
         cfa_advance_loc(list);
         DwarfList.concat(tdwarfitem.create_reg(DW_CFA_def_cfa_register,doe_uleb,reg));
       end;
 
 
-    procedure TDwarfAsmCFI.cfa_def_cfa_offset(list:TAsmList;ofs:longint);
+    procedure TDwarfAsmCFILowLevel.cfa_def_cfa_offset(list:TAsmList;ofs:longint);
       begin
         cfa_advance_loc(list);
         DwarfList.concat(tdwarfitem.create_const(DW_CFA_def_cfa_offset,doe_uleb,ofs));
       end;
 
 
+{****************************************************************************
+                             TDwarfAsmCFILowLevel
+****************************************************************************}
+
+
+    procedure TDwarfAsmCFIHighLevel.generate_code(list: TAsmList);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+      end;
+
+
+    procedure TDwarfAsmCFIHighLevel.start_frame(list: TAsmList);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+        list.concat(tai_cfi_op_none.create(cfi_startproc));
+      end;
+
+
+    procedure TDwarfAsmCFIHighLevel.end_frame(list: TAsmList);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+        list.concat(tai_cfi_op_none.create(cfi_endproc));
+      end;
+
+
+    procedure TDwarfAsmCFIHighLevel.outmost_frame(list: TAsmList);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+        list.concat(tai_cfi_op_reg.create(cfi_undefined,NR_RETURN_ADDRESS_REG));
+      end;
+
+
+    procedure TDwarfAsmCFIHighLevel.cfa_offset(list: TAsmList; reg: tregister; ofs: longint);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+        list.concat(tai_cfi_op_reg_val.create(cfi_offset,reg,ofs));
+      end;
+
+
+    procedure TDwarfAsmCFIHighLevel.cfa_restore(list: TAsmList; reg: tregister);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+        list.concat(tai_cfi_op_reg.create(cfi_restore,reg));
+      end;
+
+
+    procedure TDwarfAsmCFIHighLevel.cfa_def_cfa_register(list: TAsmList; reg: tregister);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+        list.concat(tai_cfi_op_reg.create(cfi_def_cfa_register,reg));
+      end;
+
+
+    procedure TDwarfAsmCFIHighLevel.cfa_def_cfa_offset(list: TAsmList; ofs: longint);
+      begin
+        if not(tf_use_hlcfi in target_info.flags) then
+          begin
+            inherited;
+            exit;
+          end;
+        list.concat(tai_cfi_op_val.create(cfi_def_cfa_offset,ofs));
+      end;
+
+
 begin
-  CAsmCFI:=TDwarfAsmCFI;
+  CAsmCFI:=TDwarfAsmCFIHighLevel;
 end.

compiler/i386/aoptcpu.pas

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

compiler/systems.pas

@@ -167,7 +167,9 @@ interface
               error will be generated if a package file is compiled }
             tf_supports_packages,
             { use PSABI/Dwarf-based "zero cost" exception handling }
-            tf_use_psabieh
+            tf_use_psabieh,
+            { use high level cfi directives to generate call frame information }
+            tf_use_hlcfi
        );
 
        psysteminfo = ^tsysteminfo;