Gambit disasm

disasm.ss

;; https://gitter.im/gambit/gambit/archives/2017/10/14
;; Marc Feeley @feeley Oct 14 2017 02:15 UTC
;; @ober A bit of a hack...
(define (peek addr)
  (##u8vector-ref 0 (- (+ addr 1) 8)))

(define (copy-mem addr len)
  (let ((v (make-u8vector len)))
    (let loop ((i 0))
      (if (< i len)
          (begin
            (u8vector-set! v i (peek (+ addr i)))
            (loop (+ i 1)))
          v))))

(define (disasm proc #!optional (len 30))
  (let ((addr (##u64vector-ref proc 1)))
    (let ((mem (copy-mem addr len)))
      (let ((ndisasm (open-process (list path: "ndisasm" arguments: '("-b" "64" "-")))))
        (write-subu8vector mem 0 len ndisasm)
        (close-output-port ndisasm)
        (let ((output (read-line ndisasm #f)))
          (close-port ndisasm)
          (write proc)
          (println ":")
          (print output))))))

(disasm ##car)
(disasm ##cdr)

;;prints:
;;
;;#<procedure #2 ##car>:
;;00000000  83BB9800000001    cmp dword [rbx+0x98],byte +0x1
;;00000007  750F              jnz 0x18
;;00000009  4D8B64240D        mov r12,[r12+0xd]
;;0000000E  488B442410        mov rax,[rsp+0x10]
;;00000013  E99D180000        jmp dword 0x18b5
;;00000018  49                rex.wb
;;00000019  8D                db 0x8d
;;0000001A  8620              xchg ah,[rax]
;;0000001C  3C01              cmp al,0x1
;;#<procedure #3 ##cdr>:
;;00000000  83BB9800000001    cmp dword [rbx+0x98],byte +0x1
;;00000007  750F              jnz 0x18
;;00000009  4D8B642405        mov r12,[r12+0x5]
;;0000000E  488B442410        mov rax,[rsp+0x10]
;;00000013  E98A170000        jmp dword 0x17a2
;;00000018  49                rex.wb
;;00000019  8D                db 0x8d
;;0000001A  86E0              xchg ah,al
;;0000001C  3C01              cmp al,0x1