dsm-x86.k

(define r32 (list->array (list "%eax" "%ecx" "%edx" "%ebx" "%esp" "%ebp" "%esi" "%edi")))

(define-function between (a b c)	(and (>= a b) (<= a c)))

(define-function getMRM (d)
  (let* ((mrm (getB d))
	 (mod (>> mrm 6))
	 (src (& 7 mrm))
	 (sib)
	 (dsp))
    (and (= 4 src) (!= 3 mod) (set sib (getB d)))
    (and (= 1 mod) (set dsp (getB d)))
    (and (= 2 mod) (set dsp (getL d)))
    (values mrm sib dsp)))
  
(define-function mrm-reg (mrm) (& 7 (>> mrm 3)))

(define-function mrm-write (p mrm sib dsp)
  (let* ((mod (>> mrm 6))
	 (src (& 7 mrm))
	 (idx)
	 (mul))
    (and sib
	 (let ((sr (& 7 (>> sib 3))))
	   (set src (& sib 7))
	   (and (!= 4 sr) (set idx sr))
	   (set mul (<< 1 (>> sib 6)))))
    (cond
      ((= 0 mod)	(port-write p    "("(array-at r32 src)))
      ((= 1 mod)	(port-write p dsp"("(array-at r32 src)))
      ((= 2 mod)	(port-write p dsp"("(array-at r32 src)))
      ((= 3 mod)	(port-write p       (array-at r32 src))))
    (and idx (port-write p ","(array-at r32 idx)"*"mul))
    (cond
      ((= 0 mod)	(port-write p ")"))
      ((= 1 mod)	(port-write p ")"))
      ((= 2 mod)	(port-write p ")")))))
  
(define-function rm32-r32 (d p op)
  (let (mrm sib dsp)
    (receive (getMRM d) mrm sib dsp)
    (port-write p op"\t"(array-at r32 (mrm-reg mrm))",")
    (mrm-write p mrm sib dsp)))

(define-function r32-rm32 (d p op)
  (let (mrm sib dsp)
    (receive (getMRM d) mrm sib dsp)
    (port-write p op"\t")
    (mrm-write p mrm sib dsp)
    (port-write p ","(array-at r32 (mrm-reg mrm)))))

(define-function r32-imm32 (d p op)
  (let (mrm sib dsp)
    (receive (getMRM d) mrm sib dsp)
    (port-write p op"\t$"(getL d)",")
    (mrm-write p mrm sib dsp)))

(define-function o-rm32-imm8 (d p ops)
  (let (mrm sib dsp)
    (receive (getMRM d) mrm sib dsp)
    (port-write p (nth (mrm-reg mrm) ops)"\t$"(getB d)",")
    (mrm-write p mrm sib dsp)))

(define-function o-rm32-imm32 (d p ops)
  (let (mrm sib dsp)
    (receive (getMRM d) mrm sib dsp)
    (port-write p (nth (mrm-reg mrm) ops)"\t$"(getL d)",")
    (mrm-write p mrm sib dsp)))

(define-function jb (d p op)	(port-write p op"\t"(getD1 d)))
(define-function jv (d p op)	(port-write p op"\t"(getD4 d)))

(define-function disassemble-on (d p)
  (let ((b0 (getB d)))
    (cond
      ((=	b0 0x01	    )	(rm32-r32 d p "addl"))
      ((=	b0 0x03	    )	(r32-rm32 d p "addl"))
      ((=	b0 0x31	    )	(rm32-r32 d p "xorl"))
      ((between b0 0x40 0x47)	(port-write p "incl\t"(array-at r32 (& 0x7 b0))))
      ((between b0 0x50 0x57)	(port-write p "pushl\t"(array-at r32 (& 0x7 b0))))
      ((=	b0 0x75	    )	(jb d p "jnz"))
      ((=	b0 0x81	    )	(o-rm32-imm32 d p '(addl orl adcl sbbl andl subl xorl cmpl)))
      ((=	b0 0x83	    )	(o-rm32-imm8  d p '(addl orl adcl sbbl andl subl xorl cmpl)))
      ((=	b0 0x89	    )	(rm32-r32 d p "movl"))
      ((=	b0 0x8b	    )	(r32-rm32 d p "movl"))
      ((=	b0 0x90	    )	(port-write p "nop"))
      ((between b0 0x91 0x97)	(port-write p "xchgl\t%eax,"(array-at r32 (& 0x7 b0))))
      ((between b0 0xb8 0xbf)	(port-write p "movl\t"(long->string (getL d))","(array-at r32 (& 0x7 b0))))
      ((=       b0 0xc3     )	(port-write p "ret"))
      ((=       b0 0xc7     )	(r32-imm32 d p "movl"))
      ((=       b0 0xc9     )	(port-write p "leave"))
      ((=       b0 0xe8     )	(jv d p "call"))
      ((=       b0 0xe9     )	(jv d p "jmp"))
      (else			(port-write p NEGATIVE FG-RED"   "(format "%02x" b0)"   "RESET)))))