Draft: Add RISC-V relocation types

TODO RGS: Finish me
TODO RGS: Cite T36

elf-edit.cabal

@@ -51,6 +51,7 @@ library
     Data.ElfEdit.Relocations.I386
     Data.ElfEdit.Relocations.PPC32
     Data.ElfEdit.Relocations.PPC64
+    Data.ElfEdit.Relocations.RISCV
     Data.ElfEdit.Relocations.X86_64
     Data.ElfEdit.Prim.Ehdr
     Data.ElfEdit.Prim.File

src/Data/ElfEdit/Prim.hs

@@ -28,6 +28,8 @@ module Data.ElfEdit.Prim
   , module Data.ElfEdit.Relocations.PPC32
     -- ** PPC64 relocations
   , module Data.ElfEdit.Relocations.PPC64
+    -- ** RISC-V relocations
+  , module Data.ElfEdit.Relocations.RISCV
     -- ** Android-specific
   , module Data.ElfEdit.Relocations.Android
   ) where
@@ -47,4 +49,5 @@ import Data.ElfEdit.Relocations.Common
 import Data.ElfEdit.Relocations.I386
 import Data.ElfEdit.Relocations.PPC32
 import Data.ElfEdit.Relocations.PPC64
+import Data.ElfEdit.Relocations.RISCV
 import Data.ElfEdit.Relocations.X86_64

src/Data/ElfEdit/Relocations/RISCV.hs

@@ -0,0 +1,190 @@
+{-
+Copyright        : (c) Galois, Inc 2024
+Maintainer       : Ryan Scott <rscott@galois.com>
+
+RISC-V relocation types. The list of relocation types is taken from Table 3
+(Relocation types) of
+<https://github.com/riscv-non-isa/riscv-elf-psabi-doc/blob/17038f12910bf6e0bc8bb12d3a2d09dce3f9152a/riscv-elf.adoc#relocations>.
+-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Data.ElfEdit.Relocations.RISCV
+  ( RISCV_RelocationType(..)
+  , pattern R_RISCV_NONE
+  , pattern R_RISCV_32
+  , pattern R_RISCV_64
+  , pattern R_RISCV_RELATIVE
+  , pattern R_RISCV_COPY
+  , pattern R_RISCV_JUMP_SLOT
+  -- TODO RGS: Fill in the rest
+  , riscv_RelocationTypes
+  ) where
+
+import qualified Data.Map.Strict as Map
+import           Data.Proxy (Proxy(..))
+import           Data.Type.Equality ((:~:)(..))
+import           GHC.TypeLits (KnownNat, natVal, sameNat)
+
+import           Data.ElfEdit.Prim.Ehdr (ElfClass(..), ElfWidthConstraints, ElfWordType)
+import           Data.ElfEdit.Relocations.Common
+import           Data.ElfEdit.Utils (ppHex)
+
+------------------------------------------------------------------------
+-- RISCV_RelocationType
+
+-- | Relocation types for RISC-V code. The @w@ type parameter represents the
+-- word size (@32@ for ILP32 and @64@ for LP64).
+newtype RISCV_RelocationType w = RISCV_RelocationType { fromRISCV_RelocationType :: ElfWordType w }
+deriving instance Eq  (ElfWordType w) => Eq  (RISCV_RelocationType w)
+deriving instance Ord (ElfWordType w) => Ord (RISCV_RelocationType w)
+
+-- These values are derived from Table 3 (Relocation types) of
+-- https://github.com/riscv-non-isa/riscv-elf-psabi-doc/blob/17038f12910bf6e0bc8bb12d3a2d09dce3f9152a/riscv-elf.adoc#relocations.
+
+pattern R_RISCV_NONE :: (Eq (ElfWordType w), Num (ElfWordType w))
+                     => RISCV_RelocationType w
+pattern R_RISCV_NONE = RISCV_RelocationType 0
+
+pattern R_RISCV_32 :: (Eq (ElfWordType w), Num (ElfWordType w))
+                   => RISCV_RelocationType w
+pattern R_RISCV_32 = RISCV_RelocationType 1 -- S + A
+
+pattern R_RISCV_64 :: (Eq (ElfWordType w), Num (ElfWordType w))
+                   => RISCV_RelocationType w
+pattern R_RISCV_64 = RISCV_RelocationType 2 -- S + A
+
+pattern R_RISCV_RELATIVE :: (Eq (ElfWordType w), Num (ElfWordType w))
+                         => RISCV_RelocationType w
+pattern R_RISCV_RELATIVE = RISCV_RelocationType 3 -- B + A
+
+pattern R_RISCV_COPY :: (Eq (ElfWordType w), Num (ElfWordType w))
+                     => RISCV_RelocationType w
+pattern R_RISCV_COPY = RISCV_RelocationType 4
+
+pattern R_RISCV_JUMP_SLOT :: (Eq (ElfWordType w), Num (ElfWordType w))
+                          => RISCV_RelocationType w
+pattern R_RISCV_JUMP_SLOT = RISCV_RelocationType 5 -- S
+
+-- TODO RGS: Fill in the rest
+
+riscvReloc :: RISCV_RelocationType w
+           -> String
+           -> Int
+           -> (RISCV_RelocationType w, (String,Int))
+riscvReloc tp nm c = (tp, (nm, c))
+
+-- These values are derived from Table 5 (Variables used in relocation fields) of
+-- https://github.com/riscv-non-isa/riscv-elf-psabi-doc/blob/17038f12910bf6e0bc8bb12d3a2d09dce3f9152a/riscv-elf.adoc#relocations.
+--
+-- Note that the treatment of `TODO RGS` here is not correct. See
+-- https://github.com/GaloisInc/elf-edit/issues/39 for more information.
+
+none :: Int
+none = 0
+
+word6 :: Int
+word6 = 6
+
+word8 :: Int
+word8 = 8
+
+word16 :: Int
+word16 = 16
+
+word32 :: Int
+word32 = 32
+
+word64 :: Int
+word64 = 64
+
+uleb :: Int
+uleb = error "TODO RGS"
+
+bType :: Int
+bType = error "TODO RGS"
+
+cbType :: Int
+cbType = error "TODO RGS"
+
+ciType :: Int
+ciType = error "TODO RGS"
+
+cjType :: Int
+cjType = error "TODO RGS"
+
+iType :: Int
+iType = error "TODO RGS"
+
+sType :: Int
+sType = error "TODO RGS"
+
+uType :: Int
+uType = error "TODO RGS"
+
+jType :: Int
+jType = error "TODO RGS"
+
+uiType :: Int
+uiType = error "TODO RGS"
+
+-- This map is derived from Table 3 (Relocation types) of
+-- https://github.com/riscv-non-isa/riscv-elf-psabi-doc/blob/17038f12910bf6e0bc8bb12d3a2d09dce3f9152a/riscv-elf.adoc#relocations.
+
+riscv_RelocationTypes ::
+  forall w.
+  (ElfWidthConstraints w, KnownNat w) =>
+  Map.Map (RISCV_RelocationType w) (String, Int)
+riscv_RelocationTypes = Map.fromList
+  [ riscvReloc R_RISCV_NONE "R_RISCV_NONE" none
+  , riscvReloc R_RISCV_32 "R_RISCV_32" word32
+  , riscvReloc R_RISCV_64 "R_RISCV_64" word64
+  , riscvReloc R_RISCV_RELATIVE "R_RISCV_RELATIVE" wordclass
+  , riscvReloc R_RISCV_COPY "R_RISCV_COPY" none
+  , riscvReloc R_RISCV_JUMP_SLOT "R_RISCV_JUMP_SLOT" wordclass
+  -- TODO RGS: Fill in the rest
+  ]
+  where
+    wordclass :: Int
+    wordclass = withRiscvWordSize (Proxy @w) word32 word64
+
+instance (ElfWidthConstraints w, KnownNat w) => Show (RISCV_RelocationType w) where
+  show i =
+    case Map.lookup i riscv_RelocationTypes of
+      Just (s,_) -> s
+      Nothing -> ppHex (fromRISCV_RelocationType i)
+
+instance (ElfWidthConstraints w, KnownNat w) => IsRelocationType (RISCV_RelocationType w) where
+  type RelocationWidth (RISCV_RelocationType w) = w
+
+  relaWidth _ = withRiscvWordSize (Proxy @w) ELFCLASS32 ELFCLASS64
+
+  toRelocType = RISCV_RelocationType . fromIntegral
+
+  isRelative R_RISCV_RELATIVE = True
+  isRelative _                = False
+
+  relocTargetBits tp =
+    case Map.lookup tp riscv_RelocationTypes of
+      Just (_,w) -> w
+      Nothing -> fromInteger $ natVal $ Proxy @w
+
+-- We only support 32-bit and 64-bit RISC-V. This is a helper function for
+-- dispatching on the RISC-V word size, with each continuation having type-level
+-- evidence that the word size is equal to either 32 or 64.
+withRiscvWordSize :: KnownNat n => proxy n -> ((n ~ 32) => r) -> ((n ~ 64) => r) -> r
+withRiscvWordSize proxy k32 k64
+  | Just Refl <- sameNat proxy (Proxy @32)
+  = k32
+  | Just Refl <- sameNat proxy (Proxy @64)
+  = k64
+  | otherwise
+  = error $ "Unsupported RISC-V word size: " ++ show (natVal proxy)

tests/Makefile

@@ -1,4 +1,4 @@
-all: simple.elf simple.static.elf libsymbol_versions.2.so fmax.elf ppc32-relocs.elf ppc64-relocs.elf
+all: simple.elf simple.static.elf libsymbol_versions.2.so fmax.elf ppc32-relocs.elf ppc64-relocs.elf riscv32-relocs.elf riscv64-relocs.elf
 
 simple.elf: Makefile simple.c
 	gcc simple.c -o simple.elf
@@ -17,3 +17,9 @@ ppc32-relocs.elf: ppc32-relocs.c
 
 ppc64-relocs.elf: ppc64-relocs.c
 	powerpc64-linux-musl-gcc $< -o $@
+
+riscv32-relocs.elf: riscv-relocs.c
+	riscv32-linux-musl-gcc $< -o $@
+
+riscv64-relocs.elf: riscv-relocs.c
+	riscv64-linux-musl-gcc $< -o $@

tests/Test.hs

@@ -331,6 +331,40 @@ tests = T.testGroup "ELF Tests"
             -- , (0x0000000000020028, Elf.R_PPC64_JMP_SLOT)
             , (0x0000000000020030, Elf.R_PPC64_RELATIVE)
             ]
+      , T.testCase "RISC-V (32-bit) relocations" $
+          testRelocEntries
+            (Proxy @(Elf.RISCV_RelocationType 32))
+            "./tests/riscv32-relocs.elf"
+            [ (0x00001f18, Elf.R_RISCV_RELATIVE)
+            , (0x00001f1c, Elf.R_RISCV_RELATIVE)
+            , (0x00002000, Elf.R_RISCV_RELATIVE)
+            , (0x0000200c, Elf.R_RISCV_JUMP_SLOT)
+            , (0x00002014, Elf.R_RISCV_32)
+            , (0x00002018, Elf.R_RISCV_32)
+            , (0x0000201c, Elf.R_RISCV_32)
+            , (0x00002020, Elf.R_RISCV_32)
+            , (0x00002024, Elf.R_RISCV_32)
+            , (0x00002028, Elf.R_RISCV_RELATIVE)
+            , (0x0000202c, Elf.R_RISCV_32)
+            , (0x00002030, Elf.R_RISCV_32)
+            ]
+      , T.testCase "RISC-V (64-bit) relocations" $
+          testRelocEntries
+            (Proxy @(Elf.RISCV_RelocationType 64))
+            "./tests/riscv64-relocs.elf"
+            [ (0x0000000000001e30, Elf.R_RISCV_RELATIVE)
+            , (0x0000000000001e38, Elf.R_RISCV_RELATIVE)
+            , (0x0000000000002000, Elf.R_RISCV_RELATIVE)
+            , (0x0000000000002018, Elf.R_RISCV_JUMP_SLOT)
+            , (0x0000000000002028, Elf.R_RISCV_64)
+            , (0x0000000000002030, Elf.R_RISCV_64)
+            , (0x0000000000002038, Elf.R_RISCV_64)
+            , (0x0000000000002040, Elf.R_RISCV_64)
+            , (0x0000000000002048, Elf.R_RISCV_64)
+            , (0x0000000000002050, Elf.R_RISCV_RELATIVE)
+            , (0x0000000000002058, Elf.R_RISCV_64)
+            , (0x0000000000002060, Elf.R_RISCV_64)
+            ]
       ]
     ]
 

tests/riscv-relocs.c

@@ -0,0 +1,3 @@
+int main(void) {
+  return 0;
+}