Convert jasm sources to Jerboa
ober
ba9f90133ad215e5b9176ac15632775443d44c87
--- a/.gitignore +++ b/.gitignore @@ -8,3 +8,4 @@ program_boot.h .jasm-sample.o .jasm-test-sample.o .jasm-raw.bin +.jasm-main-build.ss --- a/Makefile +++ b/Makefile @@ -1,23 +1,36 @@ JERBOA_HOME ?= /Users/user/mine/jerboa -SCHEME ?= $(JERBOA_HOME)/.chez/bin/scheme -LIBDIRS := $(CURDIR)/lib +JERBOA ?= $(JERBOA_HOME)/bin/jerboa +LIBDIRS := $(JERBOA_HOME)/lib BINARY := jasm +BUILD_MAIN := .jasm-main-build.ss +JASM_SOURCES := \ + lib/jasm/instruction.ss \ + lib/jasm/format.ss \ + lib/jasm/disasm.ss \ + lib/jasm/object/elf.ss \ + lib/jasm/object/macho.ss \ + lib/jasm/object/coff.ss \ + lib/jasm/object/archive.ss -.PHONY: test check run binary test-binary clean +.PHONY: test check run build-main binary test-binary clean test: - $(SCHEME) --libdirs $(LIBDIRS) --script tests/test-jasm.ss + JERBOA_HOME=$(JERBOA_HOME) $(JERBOA) exec tests/test-jasm.ss check: test run: - $(SCHEME) --libdirs $(LIBDIRS) --script main.ss --help + JERBOA_HOME=$(JERBOA_HOME) $(JERBOA) exec main.ss --help -binary: test +build-main: + printf '(import (except (rnrs) partition) (jerboa prelude))\n\n' > $(BUILD_MAIN) + for f in $(JASM_SOURCES); do sed '/^(import (jerboa prelude))$$/d' $$f >> $(BUILD_MAIN); printf '\n' >> $(BUILD_MAIN); done + sed '1,/^(include "lib\/jasm\/object\/archive.ss")$$/d' main.ss >> $(BUILD_MAIN) + +binary: test build-main JERBOA_HOME=$(JERBOA_HOME) \ - SCHEME=$(SCHEME) \ BINARY_LIBDIRS=$(LIBDIRS) \ - $(JERBOA_HOME)/support/build-binary.sh main.ss $(BINARY) + $(JERBOA_HOME)/support/build-binary.sh $(BUILD_MAIN) $(BINARY) test-binary: binary test -x ./$(BINARY) @@ -26,9 +39,9 @@ test-binary: 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' ./$(BINARY) raw --arch riscv64 --hex '13 01 01 ff 67 80 00 00' - $(SCHEME) --libdirs $(LIBDIRS) --script tests/write-raw-bytes.ss ./.jasm-raw.bin + JERBOA_HOME=$(JERBOA_HOME) $(JERBOA) exec tests/write-raw-bytes.ss ./.jasm-raw.bin ./$(BINARY) raw --arch x86-64 --syntax intel --max-bytes 2 --file ./.jasm-raw.bin - $(SCHEME) --libdirs $(LIBDIRS) --script tests/write-sample-elf.ss ./.jasm-sample.o + JERBOA_HOME=$(JERBOA_HOME) $(JERBOA) exec tests/write-sample-elf.ss ./.jasm-sample.o ./$(BINARY) headers ./.jasm-sample.o ./$(BINARY) sections ./.jasm-sample.o ./$(BINARY) symbols ./.jasm-sample.o @@ -37,5 +50,5 @@ test-binary: binary rm -f ./.jasm-sample.o ./.jasm-raw.bin clean: - 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 .jasm-raw.bin + 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 .jasm-raw.bin $(BUILD_MAIN) find . \( -name '*.so' -o -name '*.wpo' \) -print0 | xargs -0 rm -f --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # jasm -`jasm` is a pure Jerboa binary-to-assembly library and CLI. +`jasm` is a pure Jerboa binary-to-assembly source library and CLI. The goal is to grow toward `llvm-objdump`-style decoding and output parity without linking to LLVM, shelling out to LLVM tools, using FFI, or requiring @@ -13,7 +13,7 @@ external libraries at runtime. - Seed AArch64 decoder for common integer/load/store/return instructions. - A Jerboa CLI for raw byte disassembly. -Object-file readers and broader ISA tables should be added in Jerboa modules. +Object-file readers and broader ISA tables live in Jerboa `.ss` source modules. ## Run @@ -25,10 +25,14 @@ make binary ./jasm raw --arch mips --hex '27 bd ff e0 03 e0 00 08' ``` -## Library API +## Source API ```scheme -(import (jasm disasm)) +(import (jerboa prelude)) + +(include "lib/jasm/instruction.ss") +(include "lib/jasm/format.ss") +(include "lib/jasm/disasm.ss") (disassemble->string 'x86-64 (hex-string->bytevector "55 48 89 e5") '((syntax . intel) (address . 0))) --- a/docs/plan.md +++ b/docs/plan.md @@ -1,6 +1,6 @@ # jasm Implementation Plan -`jasm` is a pure Jerboa binary-to-assembly library and executable. It must not +`jasm` is a pure Jerboa binary-to-assembly source library and executable. It must not use FFI, dynamic libraries, external disassembler libraries, or shell out to installed tools for decoding. LLVM source and documentation may be used only as reference material and parity targets. @@ -8,7 +8,7 @@ reference material and parity targets. ## Goals - Produce a real `jasm` binary, not a script. -- Provide a reusable Jerboa library API for Jerboa's future `disassemble` +- Provide reusable Jerboa source APIs for Jerboa's future `disassemble` facility. - Decode raw bytevectors into structured instruction records. - Format decoded instructions as assembly text. @@ -28,7 +28,7 @@ reference material and parity targets. ## Current State - `./jasm` builds as a native binary. -- `(jasm disasm)` exposes: +- `lib/jasm/disasm.ss` exposes, when included: - `hex-string->bytevector` - `decode-instruction` - `disassemble-bytevector` @@ -41,6 +41,8 @@ reference material and parity targets. - `riscv32`, `riscv64`: seed RV32/RV64 base integer decoding for common arithmetic, load/store, branch, jump, and system instructions. - Tests cover the initial decoder slice. +- Source files are plain Jerboa `.ss` files: no R6RS library source wrappers and + no direct low-level Scheme imports. - `(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` @@ -559,7 +561,7 @@ Required: ## Jerboa Integration -Jerboa's future `(std debug disassemble)` should call this library once it has +Jerboa's future `(std debug disassemble)` should call this source API once it has exact code bytes. Required exported API shape: @@ -727,7 +729,7 @@ Status: raw seed decoder started; ELF integration remains. ## Immediate Next Steps -1. Split current `(jasm disasm)` into architecture modules. +1. Split current decoder source into architecture modules. 2. Replace instruction alists with records. 3. Add x86 prefix, ModR/M, and SIB parsers. 4. Add AArch64 decode-group dispatch. Binary files a/jasm and b/jasm differ --- a/lib/jasm/disasm.ss +++ b/lib/jasm/disasm.ss @@ -1,821 +1,819 @@ -#!chezscheme - -(library (jasm disasm) - (export - supported-architectures - normalize-architecture - architecture-endianness - hex-string->bytevector - disassemble-bytevector - disassemble->string - decode-instruction - instruction? - instruction-arch - instruction-address - instruction-size - instruction-text - instruction-bytes) - - (import (chezscheme) - (jasm instruction) - (jasm format)) - - (define supported-architectures '(x86-64 aarch64 mips mipsel mips64 mips64el riscv32 riscv64)) - - (define architecture-aliases - '((x86-64 . x86-64) - (x86_64 . x86-64) - (amd64 . x86-64) - (aarch64 . aarch64) - (arm64 . aarch64) - (mips . mips) - (mips32 . mips) - (mipseb . mips) - (mips32eb . mips) - (mipsel . mipsel) - (mips32el . mipsel) - (mips64 . mips64) - (mips64eb . mips64) - (mips64el . mips64el) - (riscv . riscv64) - (risc-v . riscv64) - (riscv32 . riscv32) - (risc-v32 . riscv32) - (rv32 . riscv32) - (riscv64 . riscv64) - (risc-v64 . riscv64) - (rv64 . riscv64))) - - (define (normalize-architecture arch) - (let* ([sym (cond - [(symbol? arch) arch] - [(string? arch) (string->symbol arch)] - [else (error 'normalize-architecture "architecture must be a symbol or string" arch)])] - [cell (assq sym architecture-aliases)]) - (if cell - (cdr cell) - (error 'normalize-architecture "unsupported architecture" arch)))) - - (define (architecture-endianness arch) - (case (normalize-architecture arch) - [(mips mips64) 'big] - [(mipsel mips64el) 'little] - [else 'little])) - - (define (option-ref options key default) - (let ([cell (assq key options)]) - (if cell (cdr cell) default))) - - (define (hex-digit c) - (cond - [(and (char>=? c #\0) (char<=? c #\9)) - (- (char->integer c) (char->integer #\0))] - [(and (char>=? c #\a) (char<=? c #\f)) - (+ 10 (- (char->integer c) (char->integer #\a)))] - [(and (char>=? c #\A) (char<=? c #\F)) - (+ 10 (- (char->integer c) (char->integer #\A)))] - [else #f])) - - (define (hex-skip? c) - (or (char-whitespace? c) - (char=? c #\,) - (char=? c #\:) - (char=? c #\_))) - - (define (clean-hex-string s) - (let ([n (string-length s)]) - (let loop ([i 0] [out '()]) - (cond - [(= i n) (list->string (reverse out))] - [(and (< (+ i 1) n) - (char=? (string-ref s i) #\0) - (or (char=? (string-ref s (+ i 1)) #\x) - (char=? (string-ref s (+ i 1)) #\X))) - (loop (+ i 2) out)] - [(hex-skip? (string-ref s i)) - (loop (+ i 1) out)] - [else - (loop (+ i 1) (cons (string-ref s i) out))])))) - - (define (hex-string->bytevector s) - (let* ([clean (clean-hex-string s)] - [n (string-length clean)]) - (when (or (= n 0) (not (= (modulo n 2) 0))) - (error 'hex-string->bytevector "hex string must contain an even number of digits" s)) - (let ([bv (make-bytevector (quotient n 2) 0)]) - (let loop ([i 0] [j 0]) - (if (= i n) - bv - (let ([hi (hex-digit (string-ref clean i))] - [lo (hex-digit (string-ref clean (+ i 1)))]) - (unless (and hi lo) - (error 'hex-string->bytevector "invalid hex digit" s)) - (bytevector-u8-set! bv j (+ (* hi 16) lo)) - (loop (+ i 2) (+ j 1)))))))) - - (define (bv-slice bv start len) - (let ([out (make-bytevector len 0)]) - (bytevector-copy! bv start out 0 len) - out)) - - (define (byte->hex2 b) - (let ([digits "0123456789abcdef"]) - (string (string-ref digits (quotient b 16)) - (string-ref digits (modulo b 16))))) - - (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 (signed8 b) - (if (>= b 128) (- b 256) b)) - - (define (signed32/u32 x) - (if (>= x #x80000000) (- x #x100000000) x)) - - (define (bv-u8 bv offset) - (bytevector-u8-ref bv offset)) - - (define (bv-u32-le bv offset) - (+ (bv-u8 bv offset) - (* (bv-u8 bv (+ offset 1)) #x100) - (* (bv-u8 bv (+ offset 2)) #x10000) - (* (bv-u8 bv (+ offset 3)) #x1000000))) - - (define (bv-u32-be bv offset) - (+ (* (bv-u8 bv offset) #x1000000) - (* (bv-u8 bv (+ offset 1)) #x10000) - (* (bv-u8 bv (+ offset 2)) #x100) - (bv-u8 bv (+ offset 3)))) - - (define (signed16 x) - (if (>= x #x8000) (- x #x10000) x)) - - (define (sign-extend x width) - (let ([sign (expt 2 (- width 1))] - [limit (expt 2 width)]) - (if (>= x sign) (- x limit) x))) - - (define (bits n hi lo) - (modulo (quotient n (expt 2 lo)) (expt 2 (+ 1 (- hi lo))))) - - (define x86-reg64 - '#("rax" "rcx" "rdx" "rbx" "rsp" "rbp" "rsi" "rdi" - "r8" "r9" "r10" "r11" "r12" "r13" "r14" "r15")) - - (define x86-reg32 - '#("eax" "ecx" "edx" "ebx" "esp" "ebp" "esi" "edi" - "r8d" "r9d" "r10d" "r11d" "r12d" "r13d" "r14d" "r15d")) - - (define (x86-reg n bits) - (vector-ref (if (= bits 64) x86-reg64 x86-reg32) n)) - - (define (x86-att-reg name) - (string-append "%" name)) - - ;; Chez rejects accidental comma identifiers less clearly than a reader - ;; error here would. Keep this tiny helper separate so formatting is obvious. - (define (x86-intel-binop mnemonic dst src) - (string-append mnemonic "\t" dst ", " src)) - - (define (x86-att-binop mnemonic suffix dst src) - (string-append mnemonic suffix "\t" (x86-att-reg src) ", " (x86-att-reg dst))) - - (define (x86-format-binop mnemonic suffix syntax dst src) - (if (eq? syntax 'att) - (x86-att-binop mnemonic suffix dst src) - (x86-intel-binop mnemonic dst src))) - - (define (x86-format-immop mnemonic suffix syntax dst imm) - (let ([imm-text (if (>= imm 10) (hex-number imm) (number->string imm))]) +(import (jerboa prelude)) + +(def *jasm-disasm-module* + (let () + (define supported-architectures '(x86-64 aarch64 mips mipsel mips64 mips64el riscv32 riscv64)) + + (define architecture-aliases + '((x86-64 . x86-64) + (x86_64 . x86-64) + (amd64 . x86-64) + (aarch64 . aarch64) + (arm64 . aarch64) + (mips . mips) + (mips32 . mips) + (mipseb . mips) + (mips32eb . mips) + (mipsel . mipsel) + (mips32el . mipsel) + (mips64 . mips64) + (mips64eb . mips64) + (mips64el . mips64el) + (riscv . riscv64) + (risc-v . riscv64) + (riscv32 . riscv32) + (risc-v32 . riscv32) + (rv32 . riscv32) + (riscv64 . riscv64) + (risc-v64 . riscv64) + (rv64 . riscv64))) + + (define (normalize-architecture arch) + (let* ([sym (cond + [(symbol? arch) arch] + [(string? arch) (string->symbol arch)] + [else (error 'normalize-architecture "architecture must be a symbol or string" arch)])] + [cell (assq sym architecture-aliases)]) + (if cell + (cdr cell) + (error 'normalize-architecture "unsupported architecture" arch)))) + + (define (architecture-endianness arch) + (case (normalize-architecture arch) + [(mips mips64) 'big] + [(mipsel mips64el) 'little] + [else 'little])) + + (define (option-ref options key default) + (let ([cell (assq key options)]) + (if cell (cdr cell) default))) + + (define (hex-digit c) + (cond + [(and (char>=? c #\0) (char<=? c #\9)) + (- (char->integer c) (char->integer #\0))] + [(and (char>=? c #\a) (char<=? c #\f)) + (+ 10 (- (char->integer c) (char->integer #\a)))] + [(and (char>=? c #\A) (char<=? c #\F)) + (+ 10 (- (char->integer c) (char->integer #\A)))] + [else #f])) + + (define (hex-skip? c) + (or (char-whitespace? c) + (char=? c #\,) + (char=? c #\:) + (char=? c #\_))) + + (define (clean-hex-string s) + (let ([n (string-length s)]) + (let loop ([i 0] [out '()]) + (cond + [(= i n) (list->string (reverse out))] + [(and (< (+ i 1) n) + (char=? (string-ref s i) #\0) + (or (char=? (string-ref s (+ i 1)) #\x) + (char=? (string-ref s (+ i 1)) #\X))) + (loop (+ i 2) out)] + [(hex-skip? (string-ref s i)) + (loop (+ i 1) out)] + [else + (loop (+ i 1) (cons (string-ref s i) out))])))) + + (define (hex-string->bytevector s) + (let* ([clean (clean-hex-string s)] + [n (string-length clean)]) + (when (or (= n 0) (not (= (mod n 2) 0))) + (error 'hex-string->bytevector "hex string must contain an even number of digits" s)) + (let ([bv (make-bytevector (div n 2) 0)]) + (let loop ([i 0] [j 0]) + (if (= i n) + bv + (let ([hi (hex-digit (string-ref clean i))] + [lo (hex-digit (string-ref clean (+ i 1)))]) + (unless (and hi lo) + (error 'hex-string->bytevector "invalid hex digit" s)) + (bytevector-u8-set! bv j (+ (* hi 16) lo)) + (loop (+ i 2) (+ j 1)))))))) + + (define (bv-slice bv start len) + (let ([out (make-bytevector len 0)]) + (bytevector-copy! bv start out 0 len) + out)) + + (define (byte->hex2 b) + (let ([digits "0123456789abcdef"]) + (string (string-ref digits (div b 16)) + (string-ref digits (mod b 16))))) + + (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 (signed8 b) + (if (>= b 128) (- b 256) b)) + + (define (signed32/u32 x) + (if (>= x #x80000000) (- x #x100000000) x)) + + (define (bv-u8 bv offset) + (bytevector-u8-ref bv offset)) + + (define (bv-u32-le bv offset) + (+ (bv-u8 bv offset) + (* (bv-u8 bv (+ offset 1)) #x100) + (* (bv-u8 bv (+ offset 2)) #x10000) + (* (bv-u8 bv (+ offset 3)) #x1000000))) + + (define (bv-u32-be bv offset) + (+ (* (bv-u8 bv offset) #x1000000) + (* (bv-u8 bv (+ offset 1)) #x10000) + (* (bv-u8 bv (+ offset 2)) #x100) + (bv-u8 bv (+ offset 3)))) + + (define (signed16 x) + (if (>= x #x8000) (- x #x10000) x)) + + (define (sign-extend x width) + (let ([sign (expt 2 (- width 1))] + [limit (expt 2 width)]) + (if (>= x sign) (- x limit) x))) + + (define (bits n hi lo) + (mod (div n (expt 2 lo)) (expt 2 (+ 1 (- hi lo))))) + + (define x86-reg64 + '#("rax" "rcx" "rdx" "rbx" "rsp" "rbp" "rsi" "rdi" + "r8" "r9" "r10" "r11" "r12" "r13" "r14" "r15")) + + (define x86-reg32 + '#("eax" "ecx" "edx" "ebx" "esp" "ebp" "esi" "edi" + "r8d" "r9d" "r10d" "r11d" "r12d" "r13d" "r14d" "r15d")) + + (define (x86-reg n bits) + (vector-ref (if (= bits 64) x86-reg64 x86-reg32) n)) + + (define (x86-att-reg name) + (string-append "%" name)) + + ;; Keep this tiny helper separate so comma formatting is obvious. + (define (x86-intel-binop mnemonic dst src) + (string-append mnemonic "\t" dst ", " src)) + + (define (x86-att-binop mnemonic suffix dst src) + (string-append mnemonic suffix "\t" (x86-att-reg src) ", " (x86-att-reg dst))) + + (define (x86-format-binop mnemonic suffix syntax dst src) (if (eq? syntax 'att) - (string-append mnemonic suffix "\t$" imm-text ", " (x86-att-reg dst)) - (string-append mnemonic "\t" dst ", " imm-text)))) - - (define (x86-unknown bv offset address) - (make-instruction 'x86-64 address 1 - (string-append ".byte\t0x" (byte->hex2 (bv-u8 bv offset))) - (bv-slice bv offset 1))) - - (define (decode-x86-64 bv offset address options) - (let* ([len (bytevector-length bv)] - [syntax (option-ref options 'syntax 'att)]) - (if (>= offset len) - #f - (let* ([b0 (bv-u8 bv offset)] - [has-rex? (and (>= b0 #x40) (<= b0 #x4f))] - [rex (if has-rex? b0 0)] - [rex-w? (not (= (modulo (quotient rex 8) 2) 0))] - [rex-r (if (= (modulo (quotient rex 4) 2) 0) 0 8)] - [rex-b (if (= (modulo rex 2) 0) 0 8)] - [opoff (if has-rex? (+ offset 1) offset)]) - (if (>= opoff len) - (x86-unknown bv offset address) - (let ([op (bv-u8 bv opoff)]) - (cond - [(and (>= op #x50) (<= op #x57)) - (let* ([reg (x86-reg (+ (- op #x50) rex-b) 64)] - [text (if (eq? syntax 'att) - (string-append "pushq\t" (x86-att-reg reg)) - (string-append "push\t" reg))] - [size (+ 1 (if has-rex? 1 0))]) - (make-instruction 'x86-64 address size text - (bv-slice bv offset size)))] - [(= op #xc3) - (let ([size (+ 1 (if has-rex? 1 0))]) - (make-instruction 'x86-64 address size - (if (eq? syntax 'att) "retq" "ret") - (bv-slice bv offset size)))] - [(= op #x90) - (let ([size (+ 1 (if has-rex? 1 0))]) - (make-instruction 'x86-64 address size "nop" - (bv-slice bv offset size)))] - [(and (or (= op #x89) (= op #x8b)) - (< (+ opoff 1) len)) - (let* ([modrm (bv-u8 bv (+ opoff 1))] - [mod (quotient modrm 64)] - [reg (+ (modulo (quotient modrm 8) 8) rex-r)] - [rm (+ (modulo modrm 8) rex-b)] - [bits (if rex-w? 64 32)] - [size (+ 2 (if has-rex? 1 0))]) - (if (= mod 3) - (let* ([reg-name (x86-reg reg bits)] - [rm-name (x86-reg rm bits)] - [dst (if (= op #x89) rm-name reg-name)] - [src (if (= op #x89) reg-name rm-name)] - [suffix (if (= bits 64) "q" "l")]) - (make-instruction 'x86-64 address size - (x86-format-binop "mov" suffix syntax dst src) - (bv-slice bv offset size))) - (x86-unknown bv offset address)))] - [(and (or (= op #x83)) (< (+ opoff 2) len)) - (let* ([modrm (bv-u8 bv (+ opoff 1))] - [imm (bv-u8 bv (+ opoff 2))] - [mod (quotient modrm 64)] - [subop (modulo (quotient modrm 8) 8)] - [rm (+ (modulo modrm 8) rex-b)] - [bits (if rex-w? 64 32)] - [size (+ 3 (if has-rex? 1 0))]) - (if (and (= mod 3) (or (= subop 0) (= subop 5))) - (let ([mnemonic (if (= subop 0) "add" "sub")] - [suffix (if (= bits 64) "q" "l")]) - (make-instruction 'x86-64 address size - (x86-format-immop mnemonic suffix syntax (x86-reg rm bits) imm) - (bv-slice bv offset size))) - (x86-unknown bv offset address)))] - [(and (or (= op #xe8) (= op #xe9)) (< (+ opoff 4) len)) - (let* ([rel (signed32/u32 (bv-u32-le bv (+ opoff 1)))] - [size (+ 5 (if has-rex? 1 0))] - [target (+ address size rel)] - [mnemonic (if (= op #xe8) "call" "jmp")]) - (make-instruction 'x86-64 address size - (string-append mnemonic "\t" (hex-number target)) - (bv-slice bv offset size)))] - [(and (or (= op #x74) (= op #x75)) (< (+ opoff 1) len)) - (let* ([rel (signed8 (bv-u8 bv (+ opoff 1)))] - [size (+ 2 (if has-rex? 1 0))] - [target (+ address size rel)] - [mnemonic (if (= op #x74) "je" "jne")]) - (make-instruction 'x86-64 address size - (string-append mnemonic "\t" (hex-number target)) - (bv-slice bv offset size)))] - [else (x86-unknown bv offset address)]))))))) - - (define (a64-reg prefix n sp?) - (cond - [(and sp? (= n 31)) "sp"] - [(= n 31) (if (string=? prefix "x") "xzr" "wzr")] - [else (string-append prefix (number->string n))])) - - (define (a64-imm n) - (if (>= n 10) (string-append "#0x" (number->hex n)) (string-append "#" (number->string n)))) - - (define (a64-unknown-word bv offset address remaining) - (if (< remaining 4) - (make-instruction 'aarch64 address 1 - (string-append ".byte\t0x" (byte->hex2 (bv-u8 bv offset))) - (bv-slice bv offset 1)) - (let ([word (bv-u32-le bv offset)]) - (make-instruction 'aarch64 address 4 - (string-append ".word\t0x" (number->hex word)) - (bv-slice bv offset 4))))) - - (define (decode-aarch64 bv offset address options) - (let* ([len (bytevector-length bv)] - [remaining (- len offset)]) + (x86-att-binop mnemonic suffix dst src) + (x86-intel-binop mnemonic dst src))) + + (define (x86-format-immop mnemonic suffix syntax dst imm) + (let ([imm-text (if (>= imm 10) (hex-number imm) (number->string imm))]) + (if (eq? syntax 'att) + (string-append mnemonic suffix "\t$" imm-text ", " (x86-att-reg dst)) + (string-append mnemonic "\t" dst ", " imm-text)))) + + (define (x86-unknown bv offset address) + (make-instruction 'x86-64 address 1 + (string-append ".byte\t0x" (byte->hex2 (bv-u8 bv offset))) + (bv-slice bv offset 1))) + + (define (decode-x86-64 bv offset address options) + (let* ([len (bytevector-length bv)] + [syntax (option-ref options 'syntax 'att)]) + (if (>= offset len) + #f + (let* ([b0 (bv-u8 bv offset)] + [has-rex? (and (>= b0 #x40) (<= b0 #x4f))] + [rex (if has-rex? b0 0)] + [rex-w? (not (= (mod (div rex 8) 2) 0))] + [rex-r (if (= (mod (div rex 4) 2) 0) 0 8)] + [rex-b (if (= (mod rex 2) 0) 0 8)] + [opoff (if has-rex? (+ offset 1) offset)]) + (if (>= opoff len) + (x86-unknown bv offset address) + (let ([op (bv-u8 bv opoff)]) + (cond + [(and (>= op #x50) (<= op #x57)) + (let* ([reg (x86-reg (+ (- op #x50) rex-b) 64)] + [text (if (eq? syntax 'att) + (string-append "pushq\t" (x86-att-reg reg)) + (string-append "push\t" reg))] + [size (+ 1 (if has-rex? 1 0))]) + (make-instruction 'x86-64 address size text + (bv-slice bv offset size)))] + [(= op #xc3) + (let ([size (+ 1 (if has-rex? 1 0))]) + (make-instruction 'x86-64 address size + (if (eq? syntax 'att) "retq" "ret") + (bv-slice bv offset size)))] + [(= op #x90) + (let ([size (+ 1 (if has-rex? 1 0))]) + (make-instruction 'x86-64 address size "nop" + (bv-slice bv offset size)))] + [(and (or (= op #x89) (= op #x8b)) + (< (+ opoff 1) len)) + (let* ([modrm (bv-u8 bv (+ opoff 1))] + [mod-bits (div modrm 64)] + [reg (+ (mod (div modrm 8) 8) rex-r)] + [rm (+ (mod modrm 8) rex-b)] + [bits (if rex-w? 64 32)] + [size (+ 2 (if has-rex? 1 0))]) + (if (= mod-bits 3) + (let* ([reg-name (x86-reg reg bits)] + [rm-name (x86-reg rm bits)] + [dst (if (= op #x89) rm-name reg-name)] + [src (if (= op #x89) reg-name rm-name)] + [suffix (if (= bits 64) "q" "l")]) + (make-instruction 'x86-64 address size + (x86-format-binop "mov" suffix syntax dst src) + (bv-slice bv offset size))) + (x86-unknown bv offset address)))] + [(and (or (= op #x83)) (< (+ opoff 2) len)) + (let* ([modrm (bv-u8 bv (+ opoff 1))] + [imm (bv-u8 bv (+ opoff 2))] + [mod-bits (div modrm 64)] + [subop (mod (div modrm 8) 8)] + [rm (+ (mod modrm 8) rex-b)] + [bits (if rex-w? 64 32)] + [size (+ 3 (if has-rex? 1 0))]) + (if (and (= mod-bits 3) (or (= subop 0) (= subop 5))) + (let ([mnemonic (if (= subop 0) "add" "sub")] + [suffix (if (= bits 64) "q" "l")]) + (make-instruction 'x86-64 address size + (x86-format-immop mnemonic suffix syntax (x86-reg rm bits) imm) + (bv-slice bv offset size))) + (x86-unknown bv offset address)))] + [(and (or (= op #xe8) (= op #xe9)) (< (+ opoff 4) len)) + (let* ([rel (signed32/u32 (bv-u32-le bv (+ opoff 1)))] + [size (+ 5 (if has-rex? 1 0))] + [target (+ address size rel)] + [mnemonic (if (= op #xe8) "call" "jmp")]) + (make-instruction 'x86-64 address size + (string-append mnemonic "\t" (hex-number target)) + (bv-slice bv offset size)))] + [(and (or (= op #x74) (= op #x75)) (< (+ opoff 1) len)) + (let* ([rel (signed8 (bv-u8 bv (+ opoff 1)))] + [size (+ 2 (if has-rex? 1 0))] + [target (+ address size rel)] + [mnemonic (if (= op #x74) "je" "jne")]) + (make-instruction 'x86-64 address size + (string-append mnemonic "\t" (hex-number target)) + (bv-slice bv offset size)))] + [else (x86-unknown bv offset address)]))))))) + + (define (a64-reg prefix n sp?) + (cond + [(and sp? (= n 31)) "sp"] + [(= n 31) (if (string=? prefix "x") "xzr" "wzr")] + [else (string-append prefix (number->string n))])) + + (define (a64-imm n) + (if (>= n 10) (string-append "#0x" (number->hex n)) (string-append "#" (number->string n)))) + + (define (a64-unknown-word bv offset address remaining) (if (< remaining 4) - (a64-unknown-word bv offset address remaining) - (let* ([word (bv-u32-le bv offset)] - [rd (bits word 4 0)] - [rn (bits word 9 5)] - [rt rd]) - (cond - [(= word #xd65f03c0) - (make-instruction 'aarch64 address 4 "ret" (bv-slice bv offset 4))] - [(= (bitwise-and word #xff800000) #xd2800000) - (let* ([imm16 (bits word 20 5)] - [hw (bits word 22 21)] - [imm (* imm16 (expt 2 (* 16 hw)))] - [reg (a64-reg "x" rd #f)] - [suffix (if (= hw 0) "" (string-append ", lsl #" (number->string (* 16 hw))))]) - (make-instruction 'aarch64 address 4 - (string-append "mov\t" reg ", " (a64-imm imm) suffix) - (bv-slice bv offset 4)))] - [(= (bitwise-and word #xff800000) #x52800000) - (let* ([imm16 (bits word 20 5)] - [hw (bits word 22 21)] - [imm (* imm16 (expt 2 (* 16 hw)))] - [reg (a64-reg "w" rd #f)] - [suffix (if (= hw 0) "" (string-append ", lsl #" (number->string (* 16 hw))))]) - (make-instruction 'aarch64 address 4 - (string-append "mov\t" reg ", " (a64-imm imm) suffix) - (bv-slice bv offset 4)))] - [(or (= (bitwise-and word #x7f000000) #x11000000) - (= (bitwise-and word #x7f000000) #x51000000)) - (let* ([sf? (not (= (bits word 31 31) 0))] - [sub? (not (= (bits word 30 30) 0))] - [shift? (not (= (bits word 22 22) 0))] - [imm12 (bits word 21 10)] - [imm (if shift? (* imm12 4096) imm12)] - [prefix (if sf? "x" "w")] - [mnemonic (if sub? "sub" "add")]) - (make-instruction 'aarch64 address 4 - (string-append mnemonic "\t" - (a64-reg prefix rd #t) ", " - (a64-reg prefix rn #t) ", " - (a64-imm imm)) - (bv-slice bv offset 4)))] - [(or (= (bitwise-and word #xffc00000) #xb9000000) - (= (bitwise-and word #xffc00000) #xb9400000) - (= (bitwise-and word #xffc00000) #xf9000000) - (= (bitwise-and word #xffc00000) #xf9400000)) - (let* ([load? (not (= (bits word 22 22) 0))] - [x? (not (= (bits word 31 30) 2))] - [prefix (if x? "x" "w")] - [scale (if x? 8 4)] - [imm (* (bits word 21 10) scale)] - [mnemonic (if load? "ldr" "str")]) - (make-instruction 'aarch64 address 4 - (string-append mnemonic "\t" - (a64-reg prefix rt #f) ", [" - (a64-reg "x" rn #t) - (if (= imm 0) "" (string-append ", " (a64-imm imm))) - "]") - (bv-slice bv offset 4)))] - [else (a64-unknown-word bv offset address remaining)]))))) - - (define mips-abi-regs - '#("$zero" "$at" "$v0" "$v1" "$a0" "$a1" "$a2" "$a3" - "$t0" "$t1" "$t2" "$t3" "$t4" "$t5" "$t6" "$t7" - "$s0" "$s1" "$s2" "$s3" "$s4" "$s5" "$s6" "$s7" - "$t8" "$t9" "$k0" "$k1" "$gp" "$sp" "$fp" "$ra")) - - (define (mips-reg n options) - (if (eq? (option-ref options 'registers 'abi) 'numeric) - (string-append "$" (number->string n)) - (vector-ref mips-abi-regs n))) - - (define (mips-word arch bv offset) - ((if (eq? (architecture-endianness arch) 'little) bv-u32-le bv-u32-be) bv offset)) - - (define (mips-unknown arch bv offset address remaining) - (if (< remaining 4) - (make-instruction arch address 1 - (string-append ".byte\t0x" (byte->hex2 (bv-u8 bv offset))) - (bv-slice bv offset 1)) - (let ([word (mips-word arch bv offset)]) - (make-instruction arch address 4 - (string-append ".word\t0x" (number->hex word)) - (bv-slice bv offset 4))))) - - (define (mips-r3 mnemonic rd rs rt options) - (string-append mnemonic "\t" - (mips-reg rd options) ", " - (mips-reg rs options) ", " - (mips-reg rt options))) - - (define (mips-r-shift mnemonic rd rt shamt options) - (string-append mnemonic "\t" - (mips-reg rd options) ", " - (mips-reg rt options) ", " - (number->string shamt))) - - (define (mips-i3 mnemonic rt rs imm options) - (string-append mnemonic "\t" - (mips-reg rt options) ", " - (mips-reg rs options) ", " - (number->string imm))) - - (define (mips-i3-hex mnemonic rt rs imm options) - (string-append mnemonic "\t" - (mips-reg rt options) ", " - (mips-reg rs options) ", " - (hex-number imm))) - - (define (mips-load-store mnemonic rt rs imm options) - (string-append mnemonic "\t" - (mips-reg rt options) ", " - (number->string imm) - "(" (mips-reg rs options) ")")) - - (define (mips-branch-target address imm) - (+ address 4 (* (signed16 imm) 4))) - - (define (mips-jump-target address index) - (+ (bitwise-and (+ address 4) #xf0000000) - (* index 4))) - - (define (mips64? arch) - (or (eq? arch 'mips64) (eq? arch 'mips64el))) - - (define (decode-mips-special arch word bv offset address options) - (let* ([rs (bits word 25 21)] - [rt (bits word 20 16)] - [rd (bits word 15 11)] - [shamt (bits word 10 6)] - [funct (bits word 5 0)] - [text - (cond - [(= word 0) "nop"] - [(= funct #x00) (mips-r-shift "sll" rd rt shamt options)] - [(= funct #x02) (mips-r-shift "srl" rd rt shamt options)] - [(= funct #x03) (mips-r-shift "sra" rd rt shamt options)] - [(= funct #x08) (string-append "jr\t" (mips-reg rs options))] - [(= funct #x09) (string-append "jalr\t" (mips-reg rd options) ", " (mips-reg rs options))] - [(= funct #x0c) "syscall"] - [(= funct #x0d) "break"] - [(= funct #x21) (mips-r3 "addu" rd rs rt options)] - [(= funct #x23) (mips-r3 "subu" rd rs rt options)] - [(= funct #x24) (mips-r3 "and" rd rs rt options)] - [(= funct #x25) (mips-r3 "or" rd rs rt options)] - [(= funct #x26) (mips-r3 "xor" rd rs rt options)] - [(= funct #x27) (mips-r3 "nor" rd rs rt options)] - [(= funct #x2a) (mips-r3 "slt" rd rs rt options)] - [(= funct #x2b) (mips-r3 "sltu" rd rs rt options)] - [(and (mips64? arch) (= funct #x2d)) (mips-r3 "daddu" rd rs rt options)] - [(and (mips64? arch) (= funct #x2f)) (mips-r3 "dsubu" rd rs rt options)] - [(and (mips64? arch) (= funct #x38)) (mips-r-shift "dsll" rd rt shamt options)] - [(and (mips64? arch) (= funct #x3a)) (mips-r-shift "dsrl" rd rt shamt options)] - [(and (mips64? arch) (= funct #x3b)) (mips-r-shift "dsra" rd rt shamt options)] - [(and (mips64? arch) (= funct #x3c)) (mips-r-shift "dsll32" rd rt shamt options)] - [(and (mips64? arch) (= funct #x3e)) (mips-r-shift "dsrl32" rd rt shamt options)] - [(and (mips64? arch) (= funct #x3f)) (mips-r-shift "dsra32" rd rt shamt options)] - [else #f])]) - (if text - (make-instruction arch address 4 text (bv-slice bv offset 4)) - (mips-unknown arch bv offset address 4)))) - - (define (decode-mips-regimm arch word bv offset address options) - (let* ([rs (bits word 25 21)] - [rt (bits word 20 16)] - [imm (bits word 15 0)] - [target (hex-number (mips-branch-target address imm))] - [mnemonic (case rt - [(#x00) "bltz"] - [(#x01) "bgez"] - [(#x10) "bltzal"] - [(#x11) "bgezal"] - [else #f])]) - (if mnemonic - (make-instruction arch address 4 - (string-append mnemonic "\t" (mips-reg rs options) ", " target) - (bv-slice bv offset 4)) - (mips-unknown arch bv offset address 4)))) - - (define (decode-mips arch bv offset address options) - (let* ([arch (normalize-architecture arch)] - [remaining (- (bytevector-length bv) offset)]) + (make-instruction 'aarch64 address 1 + (string-append ".byte\t0x" (byte->hex2 (bv-u8 bv offset))) + (bv-slice bv offset 1)) + (let ([word (bv-u32-le bv offset)]) + (make-instruction 'aarch64 address 4 + (string-append ".word\t0x" (number->hex word)) + (bv-slice bv offset 4))))) + + (define (decode-aarch64 bv offset address options) + (let* ([len (bytevector-length bv)] + [remaining (- len offset)]) + (if (< remaining 4) + (a64-unknown-word bv offset address remaining) + (let* ([word (bv-u32-le bv offset)] + [rd (bits word 4 0)] + [rn (bits word 9 5)] + [rt rd]) + (cond + [(= word #xd65f03c0) + (make-instruction 'aarch64 address 4 "ret" (bv-slice bv offset 4))] + [(= (bitwise-and word #xff800000) #xd2800000) + (let* ([imm16 (bits word 20 5)] + [hw (bits word 22 21)] + [imm (* imm16 (expt 2 (* 16 hw)))] + [reg (a64-reg "x" rd #f)] + [suffix (if (= hw 0) "" (string-append ", lsl #" (number->string (* 16 hw))))]) + (make-instruction 'aarch64 address 4 + (string-append "mov\t" reg ", " (a64-imm imm) suffix) + (bv-slice bv offset 4)))] + [(= (bitwise-and word #xff800000) #x52800000) + (let* ([imm16 (bits word 20 5)] + [hw (bits word 22 21)] + [imm (* imm16 (expt 2 (* 16 hw)))] + [reg (a64-reg "w" rd #f)] + [suffix (if (= hw 0) "" (string-append ", lsl #" (number->string (* 16 hw))))]) + (make-instruction 'aarch64 address 4 + (string-append "mov\t" reg ", " (a64-imm imm) suffix) + (bv-slice bv offset 4)))] + [(or (= (bitwise-and word #x7f000000) #x11000000) + (= (bitwise-and word #x7f000000) #x51000000)) + (let* ([sf? (not (= (bits word 31 31) 0))] + [sub? (not (= (bits word 30 30) 0))] + [shift? (not (= (bits word 22 22) 0))] + [imm12 (bits word 21 10)] + [imm (if shift? (* imm12 4096) imm12)] + [prefix (if sf? "x" "w")] + [mnemonic (if sub? "sub" "add")]) + (make-instruction 'aarch64 address 4 + (string-append mnemonic "\t" + (a64-reg prefix rd #t) ", " + (a64-reg prefix rn #t) ", " + (a64-imm imm)) + (bv-slice bv offset 4)))] + [(or (= (bitwise-and word #xffc00000) #xb9000000) + (= (bitwise-and word #xffc00000) #xb9400000) + (= (bitwise-and word #xffc00000) #xf9000000) + (= (bitwise-and word #xffc00000) #xf9400000))