Wire ELF object mode into jasm

ober

739fbd91cb8ef7a35abdcfbe207bd44ee4c285b8

diff --git a/.gitignore b/.gitignore
index 571f2de..df31ea9 100644
--- a/.gitignore
+++ b/.gitignore
@@ -5,3 +5,5 @@
 petite_boot.h
 scheme_boot.h
 program_boot.h
+.jasm-sample.o
+.jasm-test-sample.o
diff --git a/Makefile b/Makefile
index ed4a005..7186400 100644
--- a/Makefile
+++ b/Makefile
@@ -24,7 +24,12 @@ test-binary: binary
 	file ./$(BINARY)
 	./$(BINARY) raw --arch x86-64 --syntax intel --hex '55 48 89 e5 c3'
 	./$(BINARY) raw --arch aarch64 --hex '20 00 80 d2 c0 03 5f d6'
+	$(SCHEME) --libdirs $(LIBDIRS) --script tests/write-sample-elf.ss ./.jasm-sample.o
+	./$(BINARY) headers ./.jasm-sample.o
+	./$(BINARY) sections ./.jasm-sample.o
+	./$(BINARY) object --section .text --syntax intel ./.jasm-sample.o
+	rm -f ./.jasm-sample.o
 
 clean:
-	rm -f $(BINARY) $(BINARY).wp.so $(BINARY)-main.c petite_boot.h scheme_boot.h program_boot.h
+	rm -f $(BINARY) $(BINARY).wp.so $(BINARY)-main.c petite_boot.h scheme_boot.h program_boot.h .jasm-sample.o .jasm-test-sample.o
 	find . \( -name '*.so' -o -name '*.wpo' \) -print0 | xargs -0 rm -f
diff --git a/docs/plan.md b/docs/plan.md
index 1fe2ca6..5ffcf60 100644
--- a/docs/plan.md
+++ b/docs/plan.md
@@ -42,6 +42,9 @@ 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, and return section bytes.
+- The `jasm` binary has initial ELF-oriented `object`, `headers`, and
+  `sections` commands. `object` disassembles executable sections or a selected
+  section by name.
 
 ## Core Architecture
 
@@ -142,10 +145,10 @@ jasm --reloc file.o
 
 Initial commands:
 
-- `raw`
-- `object`
-- `headers`
-- `sections`
+- `raw` (implemented for seed raw decoders)
+- `object` (implemented for initial ELF executable-section disassembly)
+- `headers` (implemented for initial ELF metadata)
+- `sections` (implemented for initial ELF section tables)
 - `symbols`
 - `relocs`
 
diff --git a/jasm b/jasm
index f231280..4263eaa 100755
Binary files a/jasm and b/jasm differ
diff --git a/main.ss b/main.ss
index eec0d6c..304b989 100644
--- a/main.ss
+++ b/main.ss
@@ -1,14 +1,18 @@
 #!chezscheme
 
-(import (chezscheme) (jasm disasm))
+(import (chezscheme) (jasm disasm) (jasm object elf))
 
 (define (usage)
   (display "Usage:\n")
   (display "  jasm raw --arch <x86-64|aarch64|mips|mipsel|mips64|mips64el> [--syntax att|intel] [--address n] --hex <bytes>\n")
+  (display "  jasm object [--arch <arch>] [--syntax att|intel] [--section name] <file>\n")
+  (display "  jasm headers <file>\n")
+  (display "  jasm sections <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")
-  (display "  jasm raw --arch mips --hex '27 bd ff e0 03 e0 00 08'\n"))
+  (display "  jasm raw --arch mips --hex '27 bd ff e0 03 e0 00 08'\n")
+  (display "  jasm object --section .text file.o\n"))
 
 (define (string->arch s)
   (normalize-architecture s))
@@ -18,6 +22,86 @@
     (unless n (error 'jasm "invalid number" s))
     n))
 
+(define (ascii-downcase c)
+  (if (and (char>=? c #\A) (char<=? c #\Z))
+      (integer->char (+ (char->integer #\a)
+                        (- (char->integer c) (char->integer #\A))))
+      c))
+
+(define (number->hex n)
+  (list->string (map ascii-downcase
+                     (string->list (number->string n 16)))))
+
+(define (hex-number n)
+  (string-append "0x" (number->hex n)))
+
+(define (parse-syntax s)
+  (let ([value (string->symbol s)])
+    (unless (memq value '(att intel))
+      (error 'jasm "syntax must be att or intel" value))
+    value))
+
+(define (section-type-name type)
+  (case type
+    [(0) "NULL"]
+    [(1) "PROGBITS"]
+    [(2) "SYMTAB"]
+    [(3) "STRTAB"]
+    [(4) "RELA"]
+    [(8) "NOBITS"]
+    [(9) "REL"]
+    [(11) "DYNSYM"]
+    [else (number->string type)]))
+
+(define (print-elf-headers obj)
+  (display "Format: ELF ")
+  (display (elf-object-class obj))
+  (display " ")
+  (display (elf-object-endian obj))
+  (newline)
+  (display "Machine: ")
+  (display (elf-object-machine-name obj))
+  (display " (")
+  (display (elf-object-machine obj))
+  (display ")")
+  (newline)
+  (display "Architecture: ")
+  (guard (exn [#t (display "unsupported")])
+    (display (elf-object-architecture obj)))
+  (newline)
+  (display "Entry: ")
+  (display (hex-number (elf-object-entry obj)))
+  (newline)
+  (display "Sections: ")
+  (display (length (elf-object-sections obj)))
+  (newline))
+
+(define (print-section-row section)
+  (display "[")
+  (display (elf-section-index section))
+  (display "] ")
+  (display (elf-section-name section))
+  (display "\t")
+  (display (section-type-name (elf-section-type section)))
+  (display "\taddr=")
+  (display (hex-number (elf-section-address section)))
+  (display "\toff=")
+  (display (hex-number (elf-section-offset section)))
+  (display "\tsize=")
+  (display (hex-number (elf-section-size section)))
+  (display "\tflags=")
+  (display (hex-number (elf-section-flags section)))
+  (newline))
+
+(define (print-elf-sections obj)
+  (for-each print-section-row (elf-object-sections obj)))
+
+(define (one-file args command-name)
+  (cond
+    [(null? args) (error 'jasm (string-append command-name " requires a file"))]
+    [(null? (cdr args)) (car args)]
+    [else (error 'jasm (string-append command-name " accepts one file") args)]))
+
 (define (parse-raw args)
   (let loop ([args args]
              [arch #f]
@@ -35,10 +119,7 @@
        (loop (cddr args) (string->arch (cadr args)) syntax address hex)]
       [(string=? (car args) "--syntax")
        (when (null? (cdr args)) (error 'jasm "--syntax requires a value"))
-       (let ([value (string->symbol (cadr args))])
-         (unless (memq value '(att intel))
-           (error 'jasm "syntax must be att or intel" value))
-         (loop (cddr args) arch value address hex))]
+       (loop (cddr args) arch (parse-syntax (cadr args)) address hex)]
       [(string=? (car args) "--address")
        (when (null? (cdr args)) (error 'jasm "--address requires a value"))
        (loop (cddr args) arch syntax (parse-number (cadr args)) hex)]
@@ -47,6 +128,58 @@
        (loop (cddr args) arch syntax address (cadr args))]
       [else (error 'jasm "unknown raw option" (car args))])))
 
+(define (parse-object args)
+  (let loop ([args args]
+             [arch #f]
+             [syntax 'att]
+             [section-name #f]
+             [file #f])
+    (cond
+      [(null? args)
+       (unless file (error 'jasm "object requires a file"))
+       (let* ([obj (read-elf-file file)]
+              [resolved-arch (if arch arch (elf-object-architecture obj))]
+              [sections (if section-name
+                            (let ([section (elf-section-by-name obj section-name)])
+                              (unless section (error 'jasm "section not found" section-name))
+                              (list section))
+                            (elf-executable-sections obj))])
+         (for-each
+           (lambda (section)
+             (display "Disassembly of section ")
+             (display (elf-section-name section))
+             (display ":")
+             (newline)
+             (display (disassemble->string
+                        resolved-arch
+                        (elf-section-bytes obj section)
+                        (list (cons 'syntax syntax)
+                              (cons 'address (elf-section-address section)))))
+             (newline))
+           sections))]
+      [(string=? (car args) "--arch")
+       (when (null? (cdr args)) (error 'jasm "--arch requires a value"))
+       (loop (cddr args) (string->arch (cadr args)) syntax section-name file)]
+      [(string=? (car args) "--syntax")
+       (when (null? (cdr args)) (error 'jasm "--syntax requires a value"))
+       (loop (cddr args) arch (parse-syntax (cadr args)) section-name file)]
+      [(string=? (car args) "--section")
+       (when (null? (cdr args)) (error 'jasm "--section requires a value"))
+       (loop (cddr args) arch syntax (cadr args) file)]
+      [(and (> (string-length (car args)) 0)
+            (char=? (string-ref (car args) 0) #\-))
+       (error 'jasm "unknown object option" (car args))]
+      [file
+       (error 'jasm "object accepts one file" (car args))]
+      [else
+       (loop (cdr args) arch syntax section-name (car args))])))
+
+(define (parse-headers args)
+  (print-elf-headers (read-elf-file (one-file args "headers"))))
+
+(define (parse-sections args)
+  (print-elf-sections (read-elf-file (one-file args "sections"))))
+
 (define (main args)
   (guard (exn [#t
                (display "jasm: " (current-error-port))
@@ -60,6 +193,14 @@
        (usage)]
       [(string=? (car args) "raw")
        (parse-raw (cdr args))]
+      [(or (string=? (car args) "object")
+           (string=? (car args) "-d")
+           (string=? (car args) "--disassemble"))
+       (parse-object (cdr args))]
+      [(string=? (car args) "headers")
+       (parse-headers (cdr args))]
+      [(string=? (car args) "sections")
+       (parse-sections (cdr args))]
       [else
        (usage)
        (exit 1)])))
diff --git a/tests/test-jasm.ss b/tests/test-jasm.ss
index 9bf84da..899a47b 100644
--- a/tests/test-jasm.ss
+++ b/tests/test-jasm.ss
@@ -83,6 +83,13 @@
     (put-shdr64! #x140 7 3 0 0 #x90 17 0 0 1 0)
     bv))
 
+(define (write-test-bytevector-file path bv)
+  (when (file-exists? path)
+    (delete-file path))
+  (let ([port (open-file-output-port path (file-options no-fail))])
+    (put-bytevector port bv)
+    (close-port port)))
+
 (printf "--- jasm tests ---~%")
 
 (test "hex parser"
@@ -128,6 +135,16 @@
     (bytevector->u8-list (elf-section-bytes obj text)))
   '(85 195 144 144 195))
 
+(test "elf file reader"
+  (let ([path ".jasm-test-sample.o"])
+    (write-test-bytevector-file path (sample-elf64le))
+    (let ([result (let ([obj (read-elf-file path)])
+                    (list (elf-object-class obj)
+                          (elf-section-name (elf-section-by-name obj ".text"))))])
+      (delete-file path)
+      result))
+  '(elf64 ".text"))
+
 (test "instruction records are vector-backed"
   (let ([insn (car (disassemble-bytevector 'x86-64 (hex-string->bytevector "55")))])
     (list (instruction? insn)
diff --git a/tests/write-sample-elf.ss b/tests/write-sample-elf.ss
new file mode 100644
index 0000000..92efab9
--- /dev/null
+++ b/tests/write-sample-elf.ss
@@ -0,0 +1,72 @@
+#!chezscheme
+
+(import (chezscheme))
+
+(define (sample-elf64le)
+  (let ([bv (make-bytevector #x200 0)])
+    (define (put8! offset value)
+      (bytevector-u8-set! bv offset (modulo value #x100)))
+    (define (put16le! offset value)
+      (put8! offset value)
+      (put8! (+ offset 1) (quotient value #x100)))
+    (define (put32le! offset value)
+      (put8! offset value)
+      (put8! (+ offset 1) (quotient value #x100))
+      (put8! (+ offset 2) (quotient value #x10000))
+      (put8! (+ offset 3) (quotient value #x1000000)))
+    (define (put64le! offset value)
+      (put32le! offset (modulo value #x100000000))
+      (put32le! (+ offset 4) (quotient value #x100000000)))
+    (define (put-ascii! offset s)
+      (let ([n (string-length s)])
+        (let loop ([i 0])
+          (when (< i n)
+            (put8! (+ offset i) (char->integer (string-ref s i)))
+            (loop (+ i 1))))))
+    (define (put-shdr64! offset name type flags address file-offset size link info align entry-size)
+      (put32le! offset name)
+      (put32le! (+ offset 4) type)
+      (put64le! (+ offset 8) flags)
+      (put64le! (+ offset 16) address)
+      (put64le! (+ offset 24) file-offset)
+      (put64le! (+ offset 32) size)
+      (put32le! (+ offset 40) link)
+      (put32le! (+ offset 44) info)
+      (put64le! (+ offset 48) align)
+      (put64le! (+ offset 56) entry-size))
+    (put8! 0 #x7f)
+    (put-ascii! 1 "ELF")
+    (put8! 4 2)
+    (put8! 5 1)
+    (put8! 6 1)
+    (put16le! 16 1)
+    (put16le! 18 62)
+    (put32le! 20 1)
+    (put64le! 24 0)
+    (put64le! 32 0)
+    (put64le! 40 #xc0)
+    (put32le! 48 0)
+    (put16le! 52 64)
+    (put16le! 54 0)
+    (put16le! 56 0)
+    (put16le! 58 64)
+    (put16le! 60 3)
+    (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))
+    (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 17 0 0 1 0)
+    bv))
+
+(define (write-bytevector-file path bv)
+  (when (file-exists? path)
+    (delete-file path))
+  (let ([port (open-file-output-port path (file-options no-fail))])
+    (put-bytevector port bv)
+    (close-port port)))
+
+(let ([args (command-line-arguments)])
+  (unless (= (length args) 1)
+    (error 'write-sample-elf "usage: write-sample-elf <path>"))
+  (write-bytevector-file (car args) (sample-elf64le)))