diff --git a/base/ChangeLog.md b/base/ChangeLog.md index c2087c6a..f9933314 100644 --- a/base/ChangeLog.md +++ b/base/ChangeLog.md @@ -11,6 +11,8 @@ - Add support for PPC32 and PPC64 relocations in `Data.Macaw.Memory.ElfLoader`. +- Add support for RISC-V relocations in `Data.Macaw.Memory.ElfLoader`. + ### API Changes - Architecture-specific block terminators can now contain macaw values diff --git a/base/src/Data/Macaw/Memory/ElfLoader.hs b/base/src/Data/Macaw/Memory/ElfLoader.hs index db737596..ac3963d3 100644 --- a/base/src/Data/Macaw/Memory/ElfLoader.hs +++ b/base/src/Data/Macaw/Memory/ElfLoader.hs @@ -14,6 +14,7 @@ Operations for creating a view of memory from an elf file. {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} module Data.Macaw.Memory.ElfLoader @@ -48,7 +49,8 @@ import Data.Bits import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import Data.ElfEdit.Prim - ( ElfWordType + ( ElfWidthConstraints + , ElfWordType , ElfClass(..) , ElfSectionIndex(..) @@ -62,10 +64,12 @@ import qualified Data.IntervalMap.Strict as IMap import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe +import Data.Proxy (Proxy(..)) import Data.Set (Set) import qualified Data.Set as Set import qualified Data.Vector as V import Data.Word +import GHC.TypeLits (KnownNat, natVal) import Numeric (showHex) import Data.Macaw.Memory @@ -967,6 +971,89 @@ relaTargetPPC64 end msegIndex symtab rel addend _relFlag = tp -> throwError $ RelocationUnsupportedType (show tp) +-- | Attempt to resolve a RISC-V–specific symbol. +relaTargetRISCV :: forall w + . (ElfWidthConstraints w, KnownNat w, MemWidth w) + => Endianness + -- ^ Endianness of relocations + -> Maybe SegmentIndex + -- ^ Index of segment for dynamic relocations + -> SymbolTable w -- ^ Symbol table + -> Elf.RelEntry (Elf.RISCV_RelocationType w) -- ^ Relocation entry + -> MemWord w + -- ^ Addend of symbol + -> RelFlag + -> SymbolResolver (Relocation w) +relaTargetRISCV end msegIndex symtab rel addend _relFlag = + let wordSize :: Int + wordSize = fromInteger $ natVal (Proxy @w) `div` 8 in + case Elf.relType rel of + Elf.R_RISCV_32 -> do + sym <- resolveRelocationSym symtab (Elf.relSym rel) + pure $! Relocation { relocationSym = sym + , relocationOffset = addend + , relocationIsRel = False + , relocationSize = 4 + , relocationIsSigned = False + , relocationEndianness = end + , relocationJumpSlot = False + } + Elf.R_RISCV_64 -> do + sym <- resolveRelocationSym symtab (Elf.relSym rel) + pure $! Relocation { relocationSym = sym + , relocationOffset = addend + , relocationIsRel = False + , relocationSize = 8 + , relocationIsSigned = False + , relocationEndianness = end + , relocationJumpSlot = False + } + Elf.R_RISCV_RELATIVE -> do + -- This relocation has the value B + A where + -- - A is the addend for the relocation, and + -- - B resolves to the difference between the + -- address at which the segment defining the symbol was + -- loaded and the address at which it was linked. + -- + -- Since the address at which it was linked is a constant, we + -- create a non-relative address but subtract the link address + -- from the offset. + + -- Get the address at which it was linked so we can subtract from offset. + let linktimeAddr = Elf.relAddr rel + + -- Resolve the symbol using the index in the relocation. + sym <- + if Elf.relSym rel == 0 then do + case msegIndex of + Nothing -> do + throwError $ RelocationZeroSymbol + Just idx -> + pure $! SegmentBaseAddr idx + else do + resolveRelocationSym symtab (Elf.relSym rel) + pure $! Relocation { relocationSym = sym + , relocationOffset = addend - fromIntegral linktimeAddr + , relocationIsRel = False + , relocationSize = wordSize + , relocationIsSigned = False + , relocationEndianness = end + , relocationJumpSlot = False + } + Elf.R_RISCV_JUMP_SLOT -> do + -- This is a PLT relocation + sym <- resolveRelocationSym symtab (Elf.relSym rel) + pure $! Relocation { relocationSym = sym + , relocationOffset = addend + , relocationIsRel = False + , relocationSize = wordSize + , relocationIsSigned = False + , relocationEndianness = end + , relocationJumpSlot = True + } + tp -> + throwError $ RelocationUnsupportedType (show tp) + toEndianness :: Elf.ElfData -> Endianness toEndianness Elf.ELFDATA2LSB = LittleEndian toEndianness Elf.ELFDATA2MSB = BigEndian @@ -988,6 +1075,10 @@ getRelocationResolver hdr = pure $ SomeRelocationResolver $ relaTargetPPC32 end (Elf.ELFCLASS64, Elf.EM_PPC64) -> pure $ SomeRelocationResolver $ relaTargetPPC64 end + (Elf.ELFCLASS32, Elf.EM_RISCV) -> + pure $ SomeRelocationResolver $ relaTargetRISCV end + (Elf.ELFCLASS64, Elf.EM_RISCV) -> + pure $ SomeRelocationResolver $ relaTargetRISCV end (_,mach) -> throwError $ UnsupportedArchitecture (show mach) where end = toEndianness (Elf.headerData hdr) diff --git a/deps/elf-edit b/deps/elf-edit index 5531161f..fcda0a56 160000 --- a/deps/elf-edit +++ b/deps/elf-edit @@ -1 +1 @@ -Subproject commit 5531161f64f92e13ae04cfe0de0042754ae050cd +Subproject commit fcda0a5604ef5334e722038ec54aa8b2435bbe53 diff --git a/macaw-riscv/tests/riscv/Makefile b/macaw-riscv/tests/riscv/Makefile new file mode 100644 index 00000000..e970f0d7 --- /dev/null +++ b/macaw-riscv/tests/riscv/Makefile @@ -0,0 +1,23 @@ +# These binaries were obtained from https://musl.cc/ +CC64=riscv64-linux-musl-gcc +CC32=riscv32-linux-musl-gcc +CFLAGS=-nostdlib -no-pie -static -fno-stack-protector +CFLAGS_DYNAMIC=-nostartfiles -fno-stack-protector + +rv32gc = $(patsubst %.c,%-rv32gc.exe,$(wildcard *.c)) +rv64gc = $(patsubst %.c,%-rv64gc.exe,$(wildcard *.c)) + +all: $(rv32gc) $(rv64gc) + +%-rv32gc.exe : %.c + $(CC32) $(CFLAGS) -O0 $< -o $@ + +%-rv64gc.exe : %.c + $(CC32) $(CFLAGS) -O0 $< -o $@ + +# This test relies on the binary having dynamic relocations. +relocs-rv32gc.exe: relocs.c + $(CC32) $(CFLAGS_DYNAMIC) $< -o $@ + +relocs-rv64gc.exe: relocs.c + $(CC64) $(CFLAGS_DYNAMIC) $< -o $@ diff --git a/macaw-riscv/tests/riscv/relocs-rv32gc.exe b/macaw-riscv/tests/riscv/relocs-rv32gc.exe new file mode 100755 index 00000000..de098938 Binary files /dev/null and b/macaw-riscv/tests/riscv/relocs-rv32gc.exe differ diff --git a/macaw-riscv/tests/riscv/relocs-rv32gc.expected b/macaw-riscv/tests/riscv/relocs-rv32gc.expected new file mode 100644 index 00000000..482f02b7 --- /dev/null +++ b/macaw-riscv/tests/riscv/relocs-rv32gc.expected @@ -0,0 +1,4 @@ +R { fileEntryPoint = Nothing + , funcs = [(0x1e0, [(0x1e0,26),(0x1fa,12)])] + , ignoreBlocks = [0x1d0] + } diff --git a/macaw-riscv/tests/riscv/relocs-rv64gc.exe b/macaw-riscv/tests/riscv/relocs-rv64gc.exe new file mode 100755 index 00000000..9dea976d Binary files /dev/null and b/macaw-riscv/tests/riscv/relocs-rv64gc.exe differ diff --git a/macaw-riscv/tests/riscv/relocs-rv64gc.expected b/macaw-riscv/tests/riscv/relocs-rv64gc.expected new file mode 100644 index 00000000..5a80d1e8 --- /dev/null +++ b/macaw-riscv/tests/riscv/relocs-rv64gc.expected @@ -0,0 +1,4 @@ +R { fileEntryPoint = Nothing + , funcs = [(0x2c0, [(0x2c0,28),(0x2dc,12)])] + , ignoreBlocks = [0x2b0] + } diff --git a/macaw-riscv/tests/riscv/relocs.c b/macaw-riscv/tests/riscv/relocs.c new file mode 100644 index 00000000..aba653d4 --- /dev/null +++ b/macaw-riscv/tests/riscv/relocs.c @@ -0,0 +1,6 @@ +#include + +int main(void) { + printf("Hello, %s!\n", "World"); + return 0; +}