never executed always true always false
    1 -- | Constants describing the DWARF format. Most of this simply
    2 -- mirrors \/usr\/include\/dwarf.h.
    3 
    4 module GHC.CmmToAsm.Dwarf.Constants where
    5 
    6 import GHC.Prelude
    7 
    8 import GHC.Utils.Asm
    9 import GHC.Platform
   10 import GHC.Utils.Outputable
   11 
   12 import GHC.Platform.Reg
   13 import GHC.CmmToAsm.X86.Regs
   14 import GHC.CmmToAsm.PPC.Regs (toRegNo)
   15 
   16 import Data.Word
   17 
   18 -- | Language ID used for Haskell.
   19 dW_LANG_Haskell :: Word
   20 dW_LANG_Haskell = 0x18
   21   -- Thanks to Nathan Howell for getting us our very own language ID!
   22 
   23 -- * Dwarf tags
   24 dW_TAG_compile_unit, dW_TAG_subroutine_type,
   25   dW_TAG_file_type, dW_TAG_subprogram, dW_TAG_lexical_block,
   26   dW_TAG_base_type, dW_TAG_structure_type, dW_TAG_pointer_type,
   27   dW_TAG_array_type, dW_TAG_subrange_type, dW_TAG_typedef,
   28   dW_TAG_variable, dW_TAG_arg_variable, dW_TAG_auto_variable,
   29   dW_TAG_ghc_src_note :: Word
   30 dW_TAG_array_type      = 1
   31 dW_TAG_lexical_block   = 11
   32 dW_TAG_pointer_type    = 15
   33 dW_TAG_compile_unit    = 17
   34 dW_TAG_structure_type  = 19
   35 dW_TAG_typedef         = 22
   36 dW_TAG_subroutine_type = 32
   37 dW_TAG_subrange_type   = 33
   38 dW_TAG_base_type       = 36
   39 dW_TAG_file_type       = 41
   40 dW_TAG_subprogram      = 46
   41 dW_TAG_variable        = 52
   42 dW_TAG_auto_variable   = 256
   43 dW_TAG_arg_variable    = 257
   44 
   45 dW_TAG_ghc_src_note    = 0x5b00
   46 
   47 -- * Dwarf attributes
   48 dW_AT_name, dW_AT_stmt_list, dW_AT_low_pc, dW_AT_high_pc, dW_AT_language,
   49   dW_AT_comp_dir, dW_AT_producer, dW_AT_external, dW_AT_frame_base,
   50   dW_AT_use_UTF8, dW_AT_linkage_name :: Word
   51 dW_AT_name              = 0x03
   52 dW_AT_stmt_list         = 0x10
   53 dW_AT_low_pc            = 0x11
   54 dW_AT_high_pc           = 0x12
   55 dW_AT_language          = 0x13
   56 dW_AT_comp_dir          = 0x1b
   57 dW_AT_producer          = 0x25
   58 dW_AT_external          = 0x3f
   59 dW_AT_frame_base        = 0x40
   60 dW_AT_use_UTF8          = 0x53
   61 dW_AT_linkage_name      = 0x6e
   62 
   63 -- * Custom DWARF attributes
   64 -- Chosen a more or less random section of the vendor-extensible region
   65 
   66 -- ** Describing C-- blocks
   67 -- These appear in DW_TAG_lexical_scope DIEs corresponding to C-- blocks
   68 dW_AT_ghc_tick_parent :: Word
   69 dW_AT_ghc_tick_parent     = 0x2b20
   70 
   71 -- ** Describing source notes
   72 -- These appear in DW_TAG_ghc_src_note DIEs
   73 dW_AT_ghc_span_file, dW_AT_ghc_span_start_line,
   74   dW_AT_ghc_span_start_col, dW_AT_ghc_span_end_line,
   75   dW_AT_ghc_span_end_col :: Word
   76 dW_AT_ghc_span_file       = 0x2b00
   77 dW_AT_ghc_span_start_line = 0x2b01
   78 dW_AT_ghc_span_start_col  = 0x2b02
   79 dW_AT_ghc_span_end_line   = 0x2b03
   80 dW_AT_ghc_span_end_col    = 0x2b04
   81 
   82 
   83 -- * Abbrev declarations
   84 dW_CHILDREN_no, dW_CHILDREN_yes :: Word8
   85 dW_CHILDREN_no  = 0
   86 dW_CHILDREN_yes = 1
   87 
   88 dW_FORM_addr, dW_FORM_data2, dW_FORM_data4, dW_FORM_string, dW_FORM_flag,
   89   dW_FORM_block1, dW_FORM_ref4, dW_FORM_ref_addr, dW_FORM_flag_present :: Word
   90 dW_FORM_addr   = 0x01
   91 dW_FORM_data2  = 0x05
   92 dW_FORM_data4  = 0x06
   93 dW_FORM_string = 0x08
   94 dW_FORM_flag   = 0x0c
   95 dW_FORM_block1 = 0x0a
   96 dW_FORM_ref_addr     = 0x10
   97 dW_FORM_ref4         = 0x13
   98 dW_FORM_flag_present = 0x19
   99 
  100 -- * Dwarf native types
  101 dW_ATE_address, dW_ATE_boolean, dW_ATE_float, dW_ATE_signed,
  102   dW_ATE_signed_char, dW_ATE_unsigned, dW_ATE_unsigned_char :: Word
  103 dW_ATE_address       = 1
  104 dW_ATE_boolean       = 2
  105 dW_ATE_float         = 4
  106 dW_ATE_signed        = 5
  107 dW_ATE_signed_char   = 6
  108 dW_ATE_unsigned      = 7
  109 dW_ATE_unsigned_char = 8
  110 
  111 -- * Call frame information
  112 dW_CFA_set_loc, dW_CFA_undefined, dW_CFA_same_value,
  113   dW_CFA_def_cfa, dW_CFA_def_cfa_offset, dW_CFA_def_cfa_expression,
  114   dW_CFA_expression, dW_CFA_offset_extended_sf, dW_CFA_def_cfa_offset_sf,
  115   dW_CFA_def_cfa_sf, dW_CFA_val_offset, dW_CFA_val_expression,
  116   dW_CFA_offset :: Word8
  117 dW_CFA_set_loc            = 0x01
  118 dW_CFA_undefined          = 0x07
  119 dW_CFA_same_value         = 0x08
  120 dW_CFA_def_cfa            = 0x0c
  121 dW_CFA_def_cfa_offset     = 0x0e
  122 dW_CFA_def_cfa_expression = 0x0f
  123 dW_CFA_expression         = 0x10
  124 dW_CFA_offset_extended_sf = 0x11
  125 dW_CFA_def_cfa_sf         = 0x12
  126 dW_CFA_def_cfa_offset_sf  = 0x13
  127 dW_CFA_val_offset         = 0x14
  128 dW_CFA_val_expression     = 0x16
  129 dW_CFA_offset             = 0x80
  130 
  131 -- * Operations
  132 dW_OP_addr, dW_OP_deref, dW_OP_consts,
  133   dW_OP_minus, dW_OP_mul, dW_OP_plus,
  134   dW_OP_lit0, dW_OP_breg0, dW_OP_call_frame_cfa :: Word8
  135 dW_OP_addr           = 0x03
  136 dW_OP_deref          = 0x06
  137 dW_OP_consts         = 0x11
  138 dW_OP_minus          = 0x1c
  139 dW_OP_mul            = 0x1e
  140 dW_OP_plus           = 0x22
  141 dW_OP_lit0           = 0x30
  142 dW_OP_breg0          = 0x70
  143 dW_OP_call_frame_cfa = 0x9c
  144 
  145 -- * Dwarf section declarations
  146 dwarfInfoSection, dwarfAbbrevSection, dwarfLineSection,
  147   dwarfFrameSection, dwarfGhcSection, dwarfARangesSection :: Platform -> SDoc
  148 dwarfInfoSection    platform = dwarfSection platform "info"
  149 dwarfAbbrevSection  platform = dwarfSection platform "abbrev"
  150 dwarfLineSection    platform = dwarfSection platform "line"
  151 dwarfFrameSection   platform = dwarfSection platform "frame"
  152 dwarfGhcSection     platform = dwarfSection platform "ghc"
  153 dwarfARangesSection platform = dwarfSection platform "aranges"
  154 
  155 dwarfSection :: Platform -> String -> SDoc
  156 dwarfSection platform name =
  157   case platformOS platform of
  158     os | osElfTarget os
  159        -> text "\t.section .debug_" <> text name <> text ",\"\","
  160           <> sectionType platform "progbits"
  161        | osMachOTarget os
  162        -> text "\t.section __DWARF,__debug_" <> text name <> text ",regular,debug"
  163        | otherwise
  164        -> text "\t.section .debug_" <> text name <> text ",\"dr\""
  165 
  166 -- * Dwarf section labels
  167 dwarfInfoLabel, dwarfAbbrevLabel, dwarfLineLabel, dwarfFrameLabel :: SDoc
  168 dwarfInfoLabel   = text ".Lsection_info"
  169 dwarfAbbrevLabel = text ".Lsection_abbrev"
  170 dwarfLineLabel   = text ".Lsection_line"
  171 dwarfFrameLabel  = text ".Lsection_frame"
  172 
  173 -- | Mapping of registers to DWARF register numbers
  174 dwarfRegNo :: Platform -> Reg -> Word8
  175 dwarfRegNo p r = case platformArch p of
  176   ArchX86
  177     | r == eax  -> 0
  178     | r == ecx  -> 1  -- yes, no typo
  179     | r == edx  -> 2
  180     | r == ebx  -> 3
  181     | r == esp  -> 4
  182     | r == ebp  -> 5
  183     | r == esi  -> 6
  184     | r == edi  -> 7
  185   ArchX86_64
  186     | r == rax  -> 0
  187     | r == rdx  -> 1 -- this neither. The order GCC allocates registers in?
  188     | r == rcx  -> 2
  189     | r == rbx  -> 3
  190     | r == rsi  -> 4
  191     | r == rdi  -> 5
  192     | r == rbp  -> 6
  193     | r == rsp  -> 7
  194     | r == r8   -> 8
  195     | r == r9   -> 9
  196     | r == r10  -> 10
  197     | r == r11  -> 11
  198     | r == r12  -> 12
  199     | r == r13  -> 13
  200     | r == r14  -> 14
  201     | r == r15  -> 15
  202     | r == xmm0 -> 17
  203     | r == xmm1 -> 18
  204     | r == xmm2 -> 19
  205     | r == xmm3 -> 20
  206     | r == xmm4 -> 21
  207     | r == xmm5 -> 22
  208     | r == xmm6 -> 23
  209     | r == xmm7 -> 24
  210     | r == xmm8 -> 25
  211     | r == xmm9 -> 26
  212     | r == xmm10 -> 27
  213     | r == xmm11 -> 28
  214     | r == xmm12 -> 29
  215     | r == xmm13 -> 30
  216     | r == xmm14 -> 31
  217     | r == xmm15 -> 32
  218   ArchPPC_64 _ -> fromIntegral $ toRegNo r
  219   ArchAArch64  -> fromIntegral $ toRegNo r
  220   _other -> error "dwarfRegNo: Unsupported platform or unknown register!"
  221 
  222 -- | Virtual register number to use for return address.
  223 dwarfReturnRegNo :: Platform -> Word8
  224 dwarfReturnRegNo p
  225   -- We "overwrite" IP with our pseudo register - that makes sense, as
  226   -- when using this mechanism gdb already knows the IP anyway. Clang
  227   -- does this too, so it must be safe.
  228   = case platformArch p of
  229     ArchX86    -> 8  -- eip
  230     ArchX86_64 -> 16 -- rip
  231     ArchPPC_64 ELF_V2 -> 65 -- lr (link register)
  232     ArchAArch64-> 30
  233     _other     -> error "dwarfReturnRegNo: Unsupported platform!"