Add ELF relocation support

ober

08b7233983be6406496579a5802f75500ff2b835

diff --git a/Makefile b/Makefile
index 2a28126..1c7de7f 100644
--- a/Makefile
+++ b/Makefile
@@ -28,6 +28,7 @@ test-binary: binary
 	./$(BINARY) headers ./.jasm-sample.o
 	./$(BINARY) sections ./.jasm-sample.o
 	./$(BINARY) symbols ./.jasm-sample.o
+	./$(BINARY) relocs ./.jasm-sample.o
 	./$(BINARY) object --section .text --syntax intel ./.jasm-sample.o
 	rm -f ./.jasm-sample.o
 
diff --git a/docs/plan.md b/docs/plan.md
index 5aed984..9ff6fe4 100644
--- a/docs/plan.md
+++ b/docs/plan.md
@@ -42,10 +42,10 @@ reference material and parity targets.
 - `(jasm object elf)` can parse ELF32/ELF64 headers and section tables from a
   bytevector or file, map supported machines to decoder architectures, discover
   executable sections, return section bytes, and parse `.symtab`/`.dynsym`
-  symbol entries.
+  symbol entries and `SHT_REL`/`SHT_RELA` relocations.
 - The `jasm` binary has initial ELF-oriented `object`, `headers`, and
-  `sections`, and `symbols` commands. `object` disassembles executable sections
-  or a selected section by name.
+  `sections`, `symbols`, and `relocs` commands. `object` disassembles
+  executable sections or a selected section by name.
 
 ## Core Architecture
 
@@ -151,7 +151,7 @@ Initial commands:
 - `headers` (implemented for initial ELF metadata)
 - `sections` (implemented for initial ELF section tables)
 - `symbols` (implemented for initial ELF symbol tables)
-- `relocs`
+- `relocs` (implemented for initial ELF relocation tables)
 
 Common options:
 
@@ -205,8 +205,8 @@ Required:
 - Section-name string table. Initial parser is implemented.
 - Symbol tables: `.symtab`, `.dynsym`. Initial parser is implemented.
 - Relocations:
-  - `SHT_REL`
-  - `SHT_RELA`
+  - `SHT_REL` implemented in the initial parser.
+  - `SHT_RELA` implemented in the initial parser.
 - Executable section discovery. Initial parser is implemented.
 - Section filtering.
 - Address range filtering.
diff --git a/jasm b/jasm
index d332be5..f930e2b 100755
Binary files a/jasm and b/jasm differ
diff --git a/lib/jasm/object/elf.ss b/lib/jasm/object/elf.ss
index c7382d1..bd7abb6 100644
--- a/lib/jasm/object/elf.ss
+++ b/lib/jasm/object/elf.ss
@@ -13,6 +13,7 @@
     elf-object-entry
     elf-object-sections
     elf-object-symbols
+    elf-object-relocations
     elf-section?
     elf-section-index
     elf-section-name
@@ -38,16 +39,24 @@
     elf-symbol-type
     elf-symbol-visibility
     elf-symbol-section-index
-    elf-symbol-table-section)
+    elf-symbol-table-section
+    elf-relocation?
+    elf-relocation-index
+    elf-relocation-table-section
+    elf-relocation-target-section-index
+    elf-relocation-offset
+    elf-relocation-symbol-index
+    elf-relocation-type
+    elf-relocation-addend)
 
   (import (chezscheme))
 
-  (define (make-elf-object class endian machine entry sections symbols path bytes)
-    (vector 'elf-object class endian machine entry sections symbols path bytes))
+  (define (make-elf-object class endian machine entry sections symbols relocations path bytes)
+    (vector 'elf-object class endian machine entry sections symbols relocations path bytes))
 
   (define (elf-object? x)
     (and (vector? x)
-         (= (vector-length x) 9)
+         (= (vector-length x) 10)
          (eq? (vector-ref x 0) 'elf-object)))
 
   (define (elf-object-class obj) (vector-ref obj 1))
@@ -56,8 +65,9 @@
   (define (elf-object-entry obj) (vector-ref obj 4))
   (define (elf-object-sections obj) (vector-ref obj 5))
   (define (elf-object-symbols obj) (vector-ref obj 6))
-  (define (elf-object-path obj) (vector-ref obj 7))
-  (define (elf-object-bytes obj) (vector-ref obj 8))
+  (define (elf-object-relocations obj) (vector-ref obj 7))
+  (define (elf-object-path obj) (vector-ref obj 8))
+  (define (elf-object-bytes obj) (vector-ref obj 9))
 
   (define (make-elf-section index name type flags address offset size align entry-size link info)
     (vector 'elf-section index name type flags address offset size align entry-size link info))
@@ -97,6 +107,22 @@
   (define (elf-symbol-section-index symbol) (vector-ref symbol 8))
   (define (elf-symbol-table-section symbol) (vector-ref symbol 9))
 
+  (define (make-elf-relocation index table-section target-section-index offset symbol-index type addend)
+    (vector 'elf-relocation index table-section target-section-index offset symbol-index type addend))
+
+  (define (elf-relocation? x)
+    (and (vector? x)
+         (= (vector-length x) 8)
+         (eq? (vector-ref x 0) 'elf-relocation)))
+
+  (define (elf-relocation-index relocation) (vector-ref relocation 1))
+  (define (elf-relocation-table-section relocation) (vector-ref relocation 2))
+  (define (elf-relocation-target-section-index relocation) (vector-ref relocation 3))
+  (define (elf-relocation-offset relocation) (vector-ref relocation 4))
+  (define (elf-relocation-symbol-index relocation) (vector-ref relocation 5))
+  (define (elf-relocation-type relocation) (vector-ref relocation 6))
+  (define (elf-relocation-addend relocation) (vector-ref relocation 7))
+
   (define (bv-len bv) (bytevector-length bv))
 
   (define (require-range who bv offset size)
@@ -141,6 +167,12 @@
         (+ (* (u32 bv offset endian) #x100000000)
            (u32 bv (+ offset 4) endian))))
 
+  (define (s32 x)
+    (if (>= x #x80000000) (- x #x100000000) x))
+
+  (define (s64 x)
+    (if (>= x #x8000000000000000) (- x #x10000000000000000) x))
+
   (define (slice-bytevector bv offset size)
     (require-range 'elf-section-bytes bv offset size)
     (let ([out (make-bytevector size 0)])
@@ -395,6 +427,66 @@
                          symbols))]
           [else (loop (cdr remaining) symbols)]))))
 
+  (define (relocation-section? section)
+    (or (= (elf-section-type section) 4)
+        (= (elf-section-type section) 9)))
+
+  (define (parse-relocation-entry class endian bv offset rela?)
+    (if (eq? class 'elf64)
+        (let* ([relocation-offset (u64 bv offset endian)]
+               [info (u64 bv (+ offset 8) endian)]
+               [symbol-index (quotient info #x100000000)]
+               [type (modulo info #x100000000)]
+               [addend (and rela? (s64 (u64 bv (+ offset 16) endian)))])
+          (list relocation-offset symbol-index type addend))
+        (let* ([relocation-offset (u32 bv offset endian)]
+               [info (u32 bv (+ offset 4) endian)]
+               [symbol-index (quotient info #x100)]
+               [type (modulo info #x100)]
+               [addend (and rela? (s32 (u32 bv (+ offset 8) endian)))])
+          (list relocation-offset symbol-index type addend))))
+
+  (define (parse-relocations-for-section class endian bv table-section)
+    (let* ([rela? (= (elf-section-type table-section) 4)]
+           [entry-size (if (zero? (elf-section-entry-size table-section))
+                           (cond
+                             [(and (eq? class 'elf64) rela?) 24]
+                             [(eq? class 'elf64) 16]
+                             [rela? 12]
+                             [else 8])
+                           (elf-section-entry-size table-section))]
+           [count (quotient (elf-section-size table-section) entry-size)]
+           [target-section-index (elf-section-info table-section)])
+      (let loop ([index 0] [relocations '()])
+        (if (= index count)
+            (reverse relocations)
+            (let* ([entry-offset (+ (elf-section-offset table-section)
+                                    (* index entry-size))]
+                   [entry (parse-relocation-entry class endian bv entry-offset rela?)]
+                   [offset (list-ref entry 0)]
+                   [symbol-index (list-ref entry 1)]
+                   [type (list-ref entry 2)]
+                   [addend (list-ref entry 3)])
+              (loop (+ index 1)
+                    (cons (make-elf-relocation index
+                                               (elf-section-name table-section)
+                                               target-section-index
+                                               offset
+                                               symbol-index
+                                               type
+                                               addend)
+                          relocations)))))))
+
+  (define (parse-relocations class endian bv sections)
+    (let loop ([sections sections] [relocations '()])
+      (cond
+        [(null? sections) (reverse relocations)]
+        [(relocation-section? (car sections))
+         (loop (cdr sections)
+               (append (reverse (parse-relocations-for-section class endian bv (car sections)))
+                       relocations))]
+        [else (loop (cdr sections) relocations)])))
+
   (define (read-elf-bytevector bv . maybe-path)
     (let ([path (if (null? maybe-path) #f (car maybe-path))])
       (require-range 'read-elf-bytevector bv 0 64)
@@ -415,8 +507,9 @@
                                '()
                                (read-raw-section-headers class endian bv shoff shentsize shnum))]
              [sections (materialize-sections bv raw-sections shstrndx)]
-             [symbols (parse-symbols class endian bv sections)])
-        (make-elf-object class endian machine entry sections symbols path bv))))
+             [symbols (parse-symbols class endian bv sections)]
+             [relocations (parse-relocations class endian bv sections)])
+        (make-elf-object class endian machine entry sections symbols relocations path bv))))
 
   (define (read-elf-file path)
     (read-elf-bytevector (read-file-bytevector path) path))
diff --git a/main.ss b/main.ss
index 320220c..c8fe211 100644
--- a/main.ss
+++ b/main.ss
@@ -9,6 +9,7 @@
   (display "  jasm headers <file>\n")
   (display "  jasm sections <file>\n")
   (display "  jasm symbols <file>\n")
+  (display "  jasm relocs <file>\n")
   (display "\nExamples:\n")
   (display "  jasm raw --arch x86-64 --syntax intel --hex '55 48 89 e5 c3'\n")
   (display "  jasm raw --arch aarch64 --hex '20 00 80 d2 c0 03 5f d6'\n")
@@ -125,6 +126,33 @@
   (for-each (lambda (symbol) (print-symbol-row obj symbol))
             (elf-object-symbols obj)))
 
+(define (symbol-name-by-index obj index)
+  (if (and (>= index 0) (< index (length (elf-object-symbols obj))))
+      (elf-symbol-name (list-ref (elf-object-symbols obj) index))
+      (number->string index)))
+
+(define (print-relocation-row obj relocation)
+  (display "[")
+  (display (elf-relocation-index relocation))
+  (display "] ")
+  (display (hex-number (elf-relocation-offset relocation)))
+  (display "\ttype=")
+  (display (elf-relocation-type relocation))
+  (display "\tsymbol=")
+  (display (symbol-name-by-index obj (elf-relocation-symbol-index relocation)))
+  (display "\taddend=")
+  (let ([addend (elf-relocation-addend relocation)])
+    (display (if addend addend "")))
+  (display "\ttarget=")
+  (display (section-name-by-index obj (elf-relocation-target-section-index relocation)))
+  (display "\ttable=")
+  (display (elf-relocation-table-section relocation))
+  (newline))
+
+(define (print-elf-relocations obj)
+  (for-each (lambda (relocation) (print-relocation-row obj relocation))
+            (elf-object-relocations obj)))
+
 (define (one-file args command-name)
   (cond
     [(null? args) (error 'jasm (string-append command-name " requires a file"))]
@@ -212,6 +240,9 @@
 (define (parse-symbols args)
   (print-elf-symbols (read-elf-file (one-file args "symbols"))))
 
+(define (parse-relocs args)
+  (print-elf-relocations (read-elf-file (one-file args "relocs"))))
+
 (define (main args)
   (guard (exn [#t
                (display "jasm: " (current-error-port))
@@ -237,6 +268,10 @@
            (string=? (car args) "--syms")
            (string=? (car args) "-t"))
        (parse-symbols (cdr args))]
+      [(or (string=? (car args) "relocs")
+           (string=? (car args) "--reloc")
+           (string=? (car args) "-r"))
+       (parse-relocs (cdr args))]
       [else
        (usage)
        (exit 1)])))
diff --git a/tests/test-jasm.ss b/tests/test-jasm.ss
index e00e7cf..23f4d0f 100644
--- a/tests/test-jasm.ss
+++ b/tests/test-jasm.ss
@@ -27,7 +27,7 @@
     (instruction-text (car insns))))
 
 (define (sample-elf64le)
-  (let ([bv (make-bytevector #x300 0)])
+  (let ([bv (make-bytevector #x500 0)])
     (define (put8! offset value)
       (bytevector-u8-set! bv offset (modulo value #x100)))
     (define (put16le! offset value)
@@ -41,6 +41,8 @@
     (define (put64le! offset value)
       (put32le! offset (modulo value #x100000000))
       (put32le! (+ offset 4) (quotient value #x100000000)))
+    (define (put-s64le! offset value)
+      (put64le! offset (if (< value 0) (+ value #x10000000000000000) value)))
     (define (put-ascii! offset s)
       (let ([n (string-length s)])
         (let loop ([i 0])
@@ -65,6 +67,10 @@
       (put16le! (+ offset 6) section-index)
       (put64le! (+ offset 8) value)
       (put64le! (+ offset 16) size))
+    (define (put-rela64! offset relocation-offset symbol-index type addend)
+      (put64le! offset relocation-offset)
+      (put64le! (+ offset 8) (+ (* symbol-index #x100000000) type))
+      (put-s64le! (+ offset 16) addend))
     (put8! 0 #x7f)
     (put-ascii! 1 "ELF")
     (put8! 4 2)
@@ -81,17 +87,19 @@
     (put16le! 54 0)
     (put16le! 56 0)
     (put16le! 58 64)
-    (put16le! 60 5)
+    (put16le! 60 6)
     (put16le! 62 2)
     (put-ascii! #x80 (string #\x55 #\xc3 #\x90 #\x90 #\xc3))
-    (put-ascii! #x90 (string #\nul #\. #\t #\e #\x #\t #\nul #\. #\s #\h #\s #\t #\r #\t #\a #\b #\nul #\. #\s #\t #\r #\t #\a #\b #\nul #\. #\s #\y #\m #\t #\a #\b #\nul))
-    (put-ascii! #xb0 (string #\nul #\f #\u #\n #\c #\nul))
-    (put-sym64! #x238 1 #x12 0 1 #x1000 5)
+    (put-ascii! #x300 (string #\nul #\. #\t #\e #\x #\t #\nul #\. #\s #\h #\s #\t #\r #\t #\a #\b #\nul #\. #\s #\t #\r #\t #\a #\b #\nul #\. #\s #\y #\m #\t #\a #\b #\nul #\. #\r #\e #\l #\a #\. #\t #\e #\x #\t #\nul))
+    (put-ascii! #x340 (string #\nul #\f #\u #\n #\c #\nul))
+    (put-sym64! #x378 1 #x12 0 1 #x1000 5)
+    (put-rela64! #x390 #x1001 1 4 -4)
     (put-shdr64! #xc0 0 0 0 0 0 0 0 0 0 0)
     (put-shdr64! #x100 1 1 #x6 #x1000 #x80 5 0 0 16 0)
-    (put-shdr64! #x140 7 3 0 0 #x90 33 0 0 1 0)
-    (put-shdr64! #x180 17 3 0 0 #xb0 6 0 0 1 0)
-    (put-shdr64! #x1c0 25 2 0 0 #x220 48 3 1 8 24)
+    (put-shdr64! #x140 7 3 0 0 #x300 44 0 0 1 0)
+    (put-shdr64! #x180 17 3 0 0 #x340 6 0 0 1 0)
+    (put-shdr64! #x1c0 25 2 0 0 #x360 48 3 1 8 24)
+    (put-shdr64! #x200 33 4 0 0 #x390 24 4 1 8 24)
     bv))
 
 (define (write-test-bytevector-file path bv)
@@ -138,7 +146,7 @@
           (elf-section-address text)
           (elf-section-executable? text)
           (map elf-section-name (elf-executable-sections obj))))
-  '(5 #t 1 4096 #t (".text")))
+  '(6 #t 1 4096 #t (".text")))
 
 (test "elf section bytes"
   (let* ([obj (read-elf-bytevector (sample-elf64le))]
@@ -160,6 +168,19 @@
           (elf-symbol-table-section symbol)))
   '(2 #t "func" global func 4096 5 1 ".symtab"))
 
+(test "elf relocations"
+  (let* ([obj (read-elf-bytevector (sample-elf64le))]
+         [relocation (car (elf-object-relocations obj))])
+    (list (length (elf-object-relocations obj))
+          (elf-relocation? relocation)
+          (elf-relocation-table-section relocation)
+          (elf-relocation-target-section-index relocation)
+          (elf-relocation-offset relocation)
+          (elf-relocation-symbol-index relocation)
+          (elf-relocation-type relocation)
+          (elf-relocation-addend relocation)))
+  '(1 #t ".rela.text" 1 4097 1 4 -4))
+
 (test "elf file reader"
   (let ([path ".jasm-test-sample.o"])
     (write-test-bytevector-file path (sample-elf64le))
diff --git a/tests/write-sample-elf.ss b/tests/write-sample-elf.ss
index c032223..fa32354 100644
--- a/tests/write-sample-elf.ss
+++ b/tests/write-sample-elf.ss
@@ -3,7 +3,7 @@
 (import (chezscheme))
 
 (define (sample-elf64le)
-  (let ([bv (make-bytevector #x300 0)])
+  (let ([bv (make-bytevector #x500 0)])
     (define (put8! offset value)
       (bytevector-u8-set! bv offset (modulo value #x100)))
     (define (put16le! offset value)
@@ -17,6 +17,8 @@
     (define (put64le! offset value)
       (put32le! offset (modulo value #x100000000))
       (put32le! (+ offset 4) (quotient value #x100000000)))
+    (define (put-s64le! offset value)
+      (put64le! offset (if (< value 0) (+ value #x10000000000000000) value)))
     (define (put-ascii! offset s)
       (let ([n (string-length s)])
         (let loop ([i 0])
@@ -41,6 +43,10 @@
       (put16le! (+ offset 6) section-index)
       (put64le! (+ offset 8) value)
       (put64le! (+ offset 16) size))
+    (define (put-rela64! offset relocation-offset symbol-index type addend)
+      (put64le! offset relocation-offset)
+      (put64le! (+ offset 8) (+ (* symbol-index #x100000000) type))
+      (put-s64le! (+ offset 16) addend))
     (put8! 0 #x7f)
     (put-ascii! 1 "ELF")
     (put8! 4 2)
@@ -57,17 +63,19 @@
     (put16le! 54 0)
     (put16le! 56 0)
     (put16le! 58 64)
-    (put16le! 60 5)
+    (put16le! 60 6)
     (put16le! 62 2)
     (put-ascii! #x80 (string #\x55 #\xc3 #\x90 #\x90 #\xc3))
-    (put-ascii! #x90 (string #\nul #\. #\t #\e #\x #\t #\nul #\. #\s #\h #\s #\t #\r #\t #\a #\b #\nul #\. #\s #\t #\r #\t #\a #\b #\nul #\. #\s #\y #\m #\t #\a #\b #\nul))
-    (put-ascii! #xb0 (string #\nul #\f #\u #\n #\c #\nul))
-    (put-sym64! #x238 1 #x12 0 1 #x1000 5)
+    (put-ascii! #x300 (string #\nul #\. #\t #\e #\x #\t #\nul #\. #\s #\h #\s #\t #\r #\t #\a #\b #\nul #\. #\s #\t #\r #\t #\a #\b #\nul #\. #\s #\y #\m #\t #\a #\b #\nul #\. #\r #\e #\l #\a #\. #\t #\e #\x #\t #\nul))
+    (put-ascii! #x340 (string #\nul #\f #\u #\n #\c #\nul))
+    (put-sym64! #x378 1 #x12 0 1 #x1000 5)
+    (put-rela64! #x390 #x1001 1 4 -4)
     (put-shdr64! #xc0 0 0 0 0 0 0 0 0 0 0)
     (put-shdr64! #x100 1 1 #x6 #x1000 #x80 5 0 0 16 0)
-    (put-shdr64! #x140 7 3 0 0 #x90 33 0 0 1 0)
-    (put-shdr64! #x180 17 3 0 0 #xb0 6 0 0 1 0)
-    (put-shdr64! #x1c0 25 2 0 0 #x220 48 3 1 8 24)
+    (put-shdr64! #x140 7 3 0 0 #x300 44 0 0 1 0)
+    (put-shdr64! #x180 17 3 0 0 #x340 6 0 0 1 0)
+    (put-shdr64! #x1c0 25 2 0 0 #x360 48 3 1 8 24)
+    (put-shdr64! #x200 33 4 0 0 #x390 24 4 1 8 24)
     bv))
 
 (define (write-bytevector-file path bv)