ikarus/scheme/ikarus.intel-assembler.ss

1146 lines
37 KiB
Scheme
Raw Permalink Normal View History

;;; Ikarus Scheme -- A compiler for R6RS Scheme.
;;; Copyright (C) 2006,2007,2008 Abdulaziz Ghuloum
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License version 3 as
;;; published by the Free Software Foundation.
;;;
;;; This program is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
2006-11-23 19:44:29 -05:00
2008-02-14 17:45:15 -05:00
(library (ikarus.intel-assembler)
(export assemble-sources code-entry-adjustment)
2007-05-06 18:24:25 -04:00
(import
(ikarus)
2007-10-12 00:33:19 -04:00
(rnrs bytevectors)
2008-02-14 17:45:15 -05:00
(except (ikarus.code-objects) procedure-annotation)
2007-05-06 18:24:25 -04:00
(ikarus system $pairs))
2006-11-23 19:44:29 -05:00
(module (wordsize)
(import (ikarus include))
(include "ikarus.config.ss"))
2006-11-23 19:44:29 -05:00
(define fold
(lambda (f init ls)
(cond
[(null? ls) init]
[else
(f (car ls) (fold f init (cdr ls)))])))
2006-11-23 19:44:29 -05:00
(define convert-instructions
(lambda (ls)
(parameterize ([local-labels (uncover-local-labels ls)])
(fold convert-instruction '() ls))))
2006-11-23 19:44:29 -05:00
(define register-mapping
;;; reg cls idx REX.R
'([%eax 32 0 #f]
[%ecx 32 1 #f]
[%edx 32 2 #f]
[%ebx 32 3 #f]
[%esp 32 4 #f]
[%ebp 32 5 #f]
[%esi 32 6 #f]
[%edi 32 7 #f]
[%r8 32 0 #t]
[%r9 32 1 #t]
[%r10 32 2 #t]
[%r11 32 3 #t]
[%r12 32 4 #t]
[%r13 32 5 #t]
[%r14 32 6 #t]
[%r15 32 7 #t]
[%al 8 0 #f]
[%cl 8 1 #f]
[%dl 8 2 #f]
[%bl 8 3 #f]
[%ah 8 4 #f]
[%ch 8 5 #f]
[%dh 8 6 #f]
[%bh 8 7 #f]
[/0 0 0 #f]
[/1 0 1 #f]
[/2 0 2 #f]
[/3 0 3 #f]
[/4 0 4 #f]
[/5 0 5 #f]
[/6 0 6 #f]
[/7 0 7 #f]
[xmm0 xmm 0 #f]
[xmm1 xmm 1 #f]
[xmm2 xmm 2 #f]
[xmm3 xmm 3 #f]
[xmm4 xmm 4 #f]
[xmm5 xmm 5 #f]
[xmm6 xmm 6 #f]
[xmm7 xmm 7 #f]
[%r8l 8 0 #t]
[%r9l 8 1 #t]
[%r10l 8 2 #t]
[%r11l 8 3 #t]
[%r12l 8 4 #t]
[%r13l 8 5 #t]
[%r14l 8 6 #t]
[%r15l 8 7 #t]
2006-11-23 19:44:29 -05:00
))
(define register-index
(lambda (x)
(cond
[(assq x register-mapping) => caddr]
[else (die 'register-index "not a register" x)])))
2006-11-23 19:44:29 -05:00
(define reg32?
(lambda (x)
(cond
[(assq x register-mapping) =>
(lambda (x) (eqv? (cadr x) 32))]
2006-11-23 19:44:29 -05:00
[else #f])))
(define reg8?
(lambda (x)
(cond
[(assq x register-mapping) =>
(lambda (x) (eqv? (cadr x) 8))]
[else #f])))
(define xmmreg?
(lambda (x)
(cond
[(assq x register-mapping) =>
(lambda (x) (eqv? (cadr x) 'xmm))]
2006-11-23 19:44:29 -05:00
[else #f])))
(define reg?
(lambda (x)
(assq x register-mapping)))
(define reg-requires-REX?
(lambda (x)
(cond
[(assq x register-mapping) => cadddr]
[else (error 'reg-required-REX? "not a reg" x)])))
2006-11-23 19:44:29 -05:00
(define-syntax with-args
(syntax-rules (lambda)
[(_ x (lambda (a0 a1) b b* ...))
(let ([t x])
(if (pair? t)
(let ([t ($cdr t)])
(if (pair? t)
(let ([a0 ($car t)] [t ($cdr t)])
(if (pair? t)
(let ([a1 ($car t)])
(if (null? ($cdr t))
(let () b b* ...)
(die 'with-args "too many args")))
(die 'with-args "too few args")))
(die 'with-args "too few args")))
(die 'with-args "too few args")))]))
2006-11-23 19:44:29 -05:00
(define-syntax byte
(syntax-rules ()
2008-01-04 03:49:27 -05:00
[(_ x)
(let ([t x])
(if (integer? t)
(bitwise-and t 255)
(error 'byte "invalid" t '(byte x))))]))
2006-11-23 19:44:29 -05:00
(define word
(lambda (x)
(cons 'word x)))
(define reloc-word
(lambda (x)
(cons 'reloc-word x)))
(define reloc-word+
(lambda (x d)
(cons* 'reloc-word+ x d)))
2006-11-23 19:44:29 -05:00
(define byte?
(lambda (x)
(and (fixnum? x)
(fx<= x 127)
(fx<= -128 x))))
(define mem?
(lambda (x)
(and (pair? x)
(eq? (car x) 'disp))))
2006-11-23 19:44:29 -05:00
(define small-disp?
(lambda (x)
(and (mem? x)
(byte? (cadr x)))))
(define CODE
(lambda (n ac)
(cons (byte n) ac)))
(define CODE+r
(lambda (n r ac)
(cons (byte (fxlogor n (register-index r))) ac)))
(define ModRM
(lambda (mod reg r/m ac)
(cons (byte (fxlogor
(register-index r/m)
(fxlogor
(fxsll (register-index reg) 3)
(fxsll mod 6))))
(if (and (not (fx= mod 3)) (eq? r/m '%esp))
(cons (byte #x24) ac)
ac))))
2008-01-04 03:49:27 -05:00
(define IMM32
(lambda (n ac)
(cond
[(= wordsize 4) (IMM n ac)]
[(imm32? n)
(cons*
(byte n)
(byte (sra n 8))
(byte (sra n 16))
(byte (sra n 24))
ac)]
[(label? n)
(cond
[(local-label? (label-name n))
(cons (cons 'local-relative (label-name n)) ac)]
[else
(cons (cons 'relative (label-name n)) ac)])]
2008-01-04 03:49:27 -05:00
[else (die 'IMM32 "invalid" n)])))
2006-11-23 19:44:29 -05:00
(define IMM
2006-11-23 19:44:29 -05:00
(lambda (n ac)
(cond
[(int? n)
(case wordsize
[(4)
(cons*
(byte n)
(byte (sra n 8))
(byte (sra n 16))
(byte (sra n 24))
ac)]
[else
(cons*
(byte n)
(byte (sra n 8))
(byte (sra n 16))
(byte (sra n 24))
(byte (sra n 32))
(byte (sra n 40))
(byte (sra n 48))
(byte (sra n 56))
ac)])]
2006-11-23 19:44:29 -05:00
[(obj? n)
(let ([v (cadr n)])
(if (immediate? v)
(cons (word v) ac)
(cons (reloc-word v) ac)))]
[(obj+? n)
(let ([v (cadr n)] [d (caddr n)])
(cons (reloc-word+ v d) ac))]
[(label-address? n)
(cons (cons 'label-addr (label-name n)) ac)]
[(foreign? n)
(cons (cons 'foreign-label (label-name n)) ac)]
[(label? n)
(cond
[(local-label? (label-name n))
(cons (cons 'local-relative (label-name n)) ac)]
[else
(cons (cons 'relative (label-name n)) ac)])]
;(cons (cons 'relative (label-name n)) ac)]
[else (die 'IMM "invalid" n)])))
2006-11-23 19:44:29 -05:00
(define IMM8
(lambda (n ac)
(cond
[(int? n)
(cons* (byte n) ac)]
[else (die 'IMM8 "invalid" n)])))
2006-11-23 19:44:29 -05:00
(define imm?
(lambda (x)
(or (int? x)
(obj? x)
(obj+? x)
(label-address? x)
2007-12-31 04:00:46 -05:00
(foreign? x)
(label? x))))
2006-11-23 19:44:29 -05:00
(define foreign?
(lambda (x)
(and (pair? x) (eq? (car x) 'foreign-label))))
(define imm8?
(lambda (x)
(and (int? x) (byte? x))))
2006-11-23 19:44:29 -05:00
(define label?
(lambda (x)
2007-12-31 04:00:46 -05:00
(and (pair? x) (eq? (car x) 'label))))
2006-11-23 19:44:29 -05:00
(define label-address?
(lambda (x)
2007-12-31 04:00:46 -05:00
(and (pair? x) (eq? (car x) 'label-address))))
2006-11-23 19:44:29 -05:00
(define label-name
(lambda (x) (cadr x)))
(define int? integer?)
2006-11-23 19:44:29 -05:00
(define obj?
(lambda (x)
(and (pair? x) (eq? (car x) 'obj))))
(define obj+?
(lambda (x)
(and (pair? x) (eq? (car x) 'obj+))))
(define CODErri
(lambda (c d s i ac)
(cond
[(imm8? i)
(CODE c (ModRM 1 d s (IMM8 i ac)))]
[(imm? i)
(CODE c (ModRM 2 d s (IMM i ac)))]
[else (die 'CODErri "invalid i" i)])))
2006-11-23 19:44:29 -05:00
(define CODErr
2007-12-31 02:42:53 -05:00
(lambda (c r1 r2 ac)
(CODE c (ModRM 3 r1 r2 ac))))
2006-11-23 19:44:29 -05:00
(define RegReg
(lambda (r1 r2 r3 ac)
(cond
[(eq? r3 '%esp) (die 'assembler "BUG: invalid src %esp")]
[(eq? r1 '%ebp) (die 'assembler "BUG: invalid src %ebp")]
2006-11-23 19:44:29 -05:00
[else
(cons*
2006-11-23 19:44:29 -05:00
(byte (fxlogor 4 (fxsll (register-index r1) 3)))
(byte (fxlogor (register-index r2)
2006-11-23 19:44:29 -05:00
(fxsll (register-index r3) 3)))
ac)])))
(define IMM*2
2006-11-23 19:44:29 -05:00
(lambda (i1 i2 ac)
(cond
[(and (int? i1) (obj? i2))
(let ([d i1] [v (cadr i2)])
2006-11-23 19:44:29 -05:00
(cons (reloc-word+ v d) ac))]
[(and (int? i2) (obj? i1)) (IMM*2 i2 i1 ac)]
2008-01-19 09:47:15 -05:00
[(and (int? i1) (int? i2))
(IMM (bitwise-and (+ i1 i2)
(- (expt 2 (* wordsize 8)) 1))
ac)]
[else (die 'assemble "invalid IMM*2" i1 i2)])))
2006-11-23 19:44:29 -05:00
2007-12-31 02:42:53 -05:00
(define (SIB s i b ac)
(cons (byte
(fxlogor
(register-index b)
(fxlogor
(fxsll (register-index i) 3)
(fxsll s 6))))
ac))
(define (imm32? x)
(case wordsize
[(4) (imm? x)]
2008-01-04 03:49:27 -05:00
[(8)
(and (integer? x)
(<= (- (expt 2 31)) x (- (expt 2 31) 1)))]
[else (error 'imm32? "invalid wordsize" wordsize)]))
2006-11-23 19:44:29 -05:00
(define *cogen* (gensym "*cogen*"))
(define-syntax add-instruction
(syntax-rules ()
[(_ (name instr ac args ...) b b* ...)
(putprop 'name *cogen*
(cons (length '(args ...))
(lambda (instr ac args ...) b b* ...)))]))
(define-syntax add-instructions
(syntax-rules ()
[(_ instr ac [(name* arg** ...) b* b** ...] ...)
(begin
(add-instruction (name* instr ac arg** ...) b* b** ...) ...)]))
2006-11-23 19:44:29 -05:00
(define (convert-instruction a ac)
(cond
[(getprop (car a) *cogen*) =>
(lambda (p)
(let ([n (car p)] [proc (cdr p)] [args (cdr a)])
(cond
[(fx= n 2)
(if (fx= (length args) 2)
(proc a ac (car args) (cadr args))
(die 'convert-instruction "incorrect args" a))]
2006-11-23 19:44:29 -05:00
[(fx= n 1)
(if (fx= (length args) 1)
(proc a ac (car args))
(die 'convert-instruction "incorrect args" a))]
2006-11-23 19:44:29 -05:00
[(fx= n 0)
(if (fx= (length args) 0)
(proc a ac)
(die 'convert-instruction "incorrect args" a))]
2006-11-23 19:44:29 -05:00
[else
(if (fx= (length args) n)
(apply proc a ac args)
(die 'convert-instruction "incorrect args" a))])))]
[(eq? (car a) 'seq)
(fold convert-instruction ac (cdr a))]
[(eq? (car a) 'pad)
(let ()
(define (find-prefix x ls)
(let f ([ls ls])
(cond
[(eq? ls x) '()]
[else
(let ([a (car ls)])
(if (and (pair? a) (eq? (car a) 'bottom-code))
(f (cdr ls))
(cons a (f (cdr ls)))))])))
(let ([n (cadr a)] [code (cddr a)])
(let ([ls (fold convert-instruction ac code)])
(let ([m (compute-code-size (find-prefix ac ls))])
(append (make-list (- n m) 0) ls)))))]
[else (die 'convert-instruction "unknown instruction" a)]))
2006-11-23 19:44:29 -05:00
(define (RM /d dst ac)
(cond
[(mem? dst)
(with-args dst
(lambda (a0 a1)
(cond
[(and (imm8? a0) (reg32? a1))
(ModRM 1 /d a1 (IMM8 a0 ac))]
[(and (imm? a0) (reg32? a1))
2008-04-09 05:34:36 -04:00
(ModRM 2 /d a1 (IMM32 a0 ac))]
[(and (imm8? a1) (reg32? a0))
(ModRM 1 /d a0 (IMM8 a1 ac))]
[(and (imm? a1) (reg32? a0))
2008-04-09 05:34:36 -04:00
(ModRM 2 /d a0 (IMM32 a1 ac))]
[(and (reg32? a0) (reg32? a1))
(RegReg /d a0 a1 ac)]
[(and (imm? a0) (imm? a1))
(ModRM 0 /d '/5 (IMM*2 a0 a1 ac))]
[else (die 'RM "unhandled" a0 a1)])))]
[(reg? dst) (ModRM 3 /d dst ac)]
[else (die 'RM "unhandled" dst)]))
2006-11-23 19:44:29 -05:00
(module ()
(define who 'assembler)
2008-01-04 03:49:27 -05:00
(define (REX.R bits ac)
(when (eqv? wordsize 4)
(error 'ikarus "BUG: REX.R invalid in 32-bit mode"))
(cons (fxlogor #b01001000 bits) ac))
(define (REX+r r ac)
(cond
[(eqv? wordsize 4) ac]
[(reg-requires-REX? r) (REX.R #b001 ac)]
[else (REX.R #b000 ac)]))
(define (REX+RM r rm ac)
(define (C n ac)
ac)
2008-01-04 03:49:27 -05:00
;;;(printf "CASE ~s\n" n)
;;;(let f ([ac ac] [i 30])
;;; (unless (or (null? ac) (= i 0))
;;; (if (number? (car ac))
;;; (printf " #x~x" (car ac))
;;; (printf " ~s" (car ac)))
;;; (f (cdr ac) (- i 1))))
;;;(newline)
;;;ac)
(cond
2008-01-04 03:49:27 -05:00
[(eqv? wordsize 4) ac]
[(mem? rm)
(if (reg-requires-REX? r)
(with-args rm
(lambda (a0 a1)
(cond
[(and (imm? a0) (reg32? a1))
(if (reg-requires-REX? a1)
2008-04-09 03:05:19 -04:00
(REX.R #b101 ac)
(REX.R #b100 ac))]
[(and (imm? a1) (reg32? a0))
(if (reg-requires-REX? a0)
2008-04-09 03:05:19 -04:00
(REX.R #b101 ac)
(REX.R #b100 ac))]
[(and (reg32? a0) (reg32? a1))
(if (reg-requires-REX? a0)
(if (reg-requires-REX? a1)
(REX.R #b111 ac)
(REX.R #b110 ac))
(if (reg-requires-REX? a1)
(REX.R #b101 ac)
(REX.R #b100 ac)))]
[(and (imm? a0) (imm? a1))
2008-01-04 03:49:27 -05:00
(error 'REC+RM "not here 4")
(error 'REX+RM "unhandledb" a1)]
[else (die 'REX+RM "unhandled" a0 a1)])))
(with-args rm
(lambda (a0 a1)
(cond
[(and (imm? a0) (reg32? a1))
2008-04-07 10:20:05 -04:00
(if (reg-requires-REX? a1)
(REX.R #b001 ac)
(REX.R 0 ac))]
[(and (imm? a1) (reg32? a0))
(if (reg-requires-REX? a0)
2008-04-07 10:20:05 -04:00
(REX.R #b001 ac)
(REX.R 0 ac))]
[(and (reg32? a0) (reg32? a1))
(if (reg-requires-REX? a0)
(if (reg-requires-REX? a1)
(error 'REX+RM "unhandled x1" a0 a1)
2008-04-09 03:05:19 -04:00
(REX.R #b010 ac))
(if (reg-requires-REX? a1)
(error 'REX+RM "unhandled x3" a0 a1)
2008-04-07 10:20:05 -04:00
(REX.R 0 ac)))]
2008-01-04 03:49:27 -05:00
[(and (imm? a0) (imm? a1))
2008-04-07 10:20:05 -04:00
;(error 'REC+RM "not here 8")
(REX.R 0 ac)]
[else (die 'REX+RM "unhandled" a0 a1)]))))]
[(reg? rm)
2008-01-04 03:49:27 -05:00
(let* ([bits 0]
[bits
(if (reg-requires-REX? r)
(fxlogor bits #b100)
bits)]
[bits
(if (reg-requires-REX? rm)
(fxlogor bits #b001)
bits)])
(REX.R bits ac))]
[else (die 'REX+RM "unhandled" rm)]))
2008-01-04 03:49:27 -05:00
(define (C c ac)
(case wordsize
[(4) (CODE c ac)]
[else (REX.R 0 (CODE c ac))]))
(define trace-ac
(let ([cache '()])
(lambda (ac1 what ac2)
(when (assembler-output)
(let ([diff
(let f ([ls ac2])
(cond
[(eq? ls ac1) '()]
[else (cons (car ls) (f (cdr ls)))]))])
(unless (member diff cache)
(set! cache (cons diff cache))
(printf "~s => ~s\n" what diff))))
ac2)))
2008-04-07 10:20:05 -04:00
2007-12-31 04:00:46 -05:00
(define (CR c r ac)
(REX+r r (CODE+r c r ac)))
(define (CR* c r rm ac)
2008-01-04 03:49:27 -05:00
(REX+RM r rm (CODE c (RM r rm ac))))
2008-04-09 03:05:19 -04:00
(define (CR*-no-rex c r rm ac)
(CODE c (RM r rm ac)))
(define (CCR* c0 c1 r rm ac)
2008-04-09 03:05:19 -04:00
;(CODE c0 (CODE c1 (RM r rm ac))))
(REX+RM r rm (CODE c0 (CODE c1 (RM r rm ac)))))
2007-12-31 02:42:53 -05:00
(define (CCR c0 c1 r ac)
2008-07-19 17:41:06 -04:00
;(CODE c0 (CODE+r c1 r ac)))
(REX+r r (CODE c0 (CODE+r c1 r ac))))
(define (CCCR* c0 c1 c2 r rm ac)
;(CODE c0 (CODE c1 (CODE c2 (RM r rm ac)))))
(REX+RM r rm (CODE c0 (CODE c1 (CODE c2 (RM r rm ac))))))
2007-12-31 04:00:46 -05:00
(define (CCI32 c0 c1 i32 ac)
(CODE c0 (CODE c1 (IMM32 i32 ac))))
2008-04-09 05:34:36 -04:00
(define (dotrace instr orig ls)
(printf "TRACE: ~s ~s\n" instr
(let f ([ls ls])
2008-01-04 03:49:27 -05:00
(if (eq? ls orig)
'()
(cons (car ls) (f (cdr ls))))))
ls)
(define (jmp-pc-relative code0 code1 dst ac)
(when (= wordsize 4)
(error 'intel-assembler "no pc-relative jumps in 32-bit mode"))
(let ([g (gensym)])
(CODE code0
(CODE code1
(cons*
`(local-relative . ,g)
`(bottom-code
(label . ,g)
(label-addr . ,(label-name dst)))
ac)))))
2006-11-23 19:44:29 -05:00
(add-instructions instr ac
2007-12-31 02:42:53 -05:00
[(ret) (CODE #xC3 ac)]
[(cltd) (C #x99 ac)]
2007-12-31 02:42:53 -05:00
[(movl src dst)
(cond
2008-04-07 10:20:05 -04:00
[(and (imm? src) (reg? dst)) (CR #xB8 dst (IMM src ac))]
[(and (imm? src) (mem? dst)) (CR* #xC7 '/0 dst (IMM32 src ac))]
[(and (reg? src) (reg? dst)) (CR* #x89 src dst ac)]
2008-01-04 03:49:27 -05:00
[(and (reg? src) (mem? dst)) (CR* #x89 src dst ac)]
[(and (mem? src) (reg? dst)) (CR* #x8B dst src ac)]
[else (die who "invalid" instr)])]
2008-04-09 03:05:19 -04:00
[(mov32 src dst)
;;; FIXME
(cond
[(and (imm? src) (reg? dst))
(error 'mov32 "here1")
(CR #xB8 dst (IMM32 src ac))]
[(and (imm? src) (mem? dst)) (CR*-no-rex #xC7 '/0 dst (IMM32 src ac))]
[(and (reg? src) (reg? dst))
(error 'mov32 "here3")
(CR* #x89 src dst ac)]
[(and (reg? src) (mem? dst)) (CR*-no-rex #x89 src dst ac)]
[(and (mem? src) (reg? dst))
(if (= wordsize 4)
(CR* #x8B dst src ac)
(CR*-no-rex #x8B dst src ac))]
2008-04-09 03:05:19 -04:00
[else (die who "invalid" instr)])]
2006-11-23 19:44:29 -05:00
[(movb src dst)
(cond
[(and (imm8? src) (mem? dst)) (CR* #xC6 '/0 dst (IMM8 src ac))]
[(and (reg8? src) (mem? dst)) (CR* #x88 src dst ac)]
[(and (mem? src) (reg8? dst)) (CR* #x8A dst src ac)]
2007-12-31 02:42:53 -05:00
[else (die who "invalid" instr)])]
[(addl src dst)
(cond
2008-01-04 03:49:27 -05:00
[(and (imm8? src) (reg? dst)) (CR* #x83 '/0 dst (IMM8 src ac))]
2008-04-09 05:34:36 -04:00
[(and (imm32? src) (eq? dst '%eax)) (C #x05 (IMM32 src ac))]
2008-01-04 03:49:27 -05:00
[(and (imm32? src) (reg? dst)) (CR* #x81 '/0 dst (IMM32 src ac))]
[(and (reg? src) (reg? dst)) (CR* #x01 src dst ac)]
2008-01-04 03:49:27 -05:00
[(and (mem? src) (reg? dst)) (CR* #x03 dst src ac)]
[(and (imm32? src) (mem? dst)) (CR* #x81 '/0 dst (IMM32 src ac))]
[(and (reg? src) (mem? dst)) (CR* #x01 src dst ac)]
[else (die who "invalid" instr)])]
2007-12-31 02:42:53 -05:00
[(subl src dst)
(cond
2008-01-04 03:49:27 -05:00
[(and (imm8? src) (reg? dst)) (CR* #x83 '/5 dst (IMM8 src ac))]
2008-04-09 05:34:36 -04:00
[(and (imm32? src) (eq? dst '%eax)) (C #x2D (IMM32 src ac))]
2008-01-04 03:49:27 -05:00
[(and (imm32? src) (reg? dst)) (CR* #x81 '/5 dst (IMM32 src ac))]
[(and (reg? src) (reg? dst)) (CR* #x29 src dst ac)]
[(and (mem? src) (reg? dst)) (CR* #x2B dst src ac)]
[(and (imm32? src) (mem? dst)) (CR* #x81 '/5 dst (IMM32 src ac))]
[(and (reg? src) (mem? dst)) (CR* #x29 src dst ac)]
2007-12-31 02:42:53 -05:00
[else (die who "invalid" instr)])]
[(sall src dst)
(cond
2008-01-04 03:49:27 -05:00
[(and (equal? 1 src) (reg? dst)) (CR* #xD1 '/4 dst ac)]
[(and (imm8? src) (reg? dst)) (CR* #xC1 '/4 dst (IMM8 src ac))]
[(and (imm8? src) (mem? dst)) (CR* #xC1 '/4 dst (IMM8 src ac))]
2008-01-04 03:49:27 -05:00
[(and (eq? src '%cl) (reg? dst)) (CR* #xD3 '/4 dst ac)]
[(and (eq? src '%cl) (mem? dst)) (CR* #xD3 '/4 dst ac)]
2007-12-31 02:42:53 -05:00
[else (die who "invalid" instr)])]
[(shrl src dst)
(cond
2008-01-04 03:49:27 -05:00
[(and (equal? 1 src) (reg? dst)) (CR* #xD1 '/5 dst ac)]
[(and (imm8? src) (reg? dst)) (CR* #xC1 '/5 dst (IMM8 src ac))]
[(and (eq? src '%cl) (reg? dst)) (CR* #xD3 '/5 dst ac)]
[(and (imm8? src) (mem? dst)) (CR* #xC1 '/5 dst (IMM8 src ac))]
[(and (eq? src '%cl) (mem? dst)) (CR* #xD3 '/5 dst ac)]
2007-12-31 02:42:53 -05:00
[else (die who "invalid" instr)])]
[(sarl src dst)
(cond
2008-01-04 03:49:27 -05:00
[(and (equal? 1 src) (reg? dst)) (CR* #xD1 '/7 dst ac)]
[(and (imm8? src) (reg? dst)) (CR* #xC1 '/7 dst (IMM8 src ac))]
[(and (imm8? src) (mem? dst)) (CR* #xC1 '/7 dst (IMM8 src ac))]
2008-01-04 03:49:27 -05:00
[(and (eq? src '%cl) (reg? dst)) (CR* #xD3 '/7 dst ac)]
[(and (eq? src '%cl) (mem? dst)) (CR* #xD3 '/7 dst ac)]
[else (die who "invalid" instr)])]
2007-12-31 02:42:53 -05:00
[(andl src dst)
(cond
2008-01-04 03:49:27 -05:00
[(and (imm32? src) (mem? dst)) (CR* #x81 '/4 dst (IMM32 src ac))]
[(and (imm8? src) (reg? dst)) (CR* #x83 '/4 dst (IMM8 src ac))]
[(and (imm32? src) (eq? dst '%eax)) (C #x25 (IMM32 src ac))]
[(and (imm32? src) (reg? dst)) (CR* #x81 '/4 dst (IMM32 src ac))]
[(and (reg? src) (reg? dst)) (CR* #x21 src dst ac)]
[(and (reg? src) (mem? dst)) (CR* #x21 src dst ac)]
[(and (mem? src) (reg? dst)) (CR* #x23 dst src ac)]
[else (die who "invalid" instr)])]
2007-12-31 02:42:53 -05:00
[(orl src dst)
(cond
2008-01-04 03:49:27 -05:00
[(and (imm32? src) (mem? dst)) (CR* #x81 '/1 dst (IMM32 src ac))]
[(and (reg? src) (mem? dst)) (CR* #x09 src dst ac)]
[(and (imm8? src) (reg? dst)) (CR* #x83 '/1 dst (IMM8 src ac))]
[(and (imm32? src) (eq? dst '%eax)) (C #x0D (IMM32 src ac))]
2008-01-04 03:49:27 -05:00
[(and (imm32? src) (reg? dst)) (CR* #x81 '/1 dst (IMM32 src ac))]
[(and (reg? src) (reg? dst)) (CR* #x09 src dst ac)]
[(and (mem? src) (reg? dst)) (CR* #x0B dst src ac)]
2007-12-31 02:42:53 -05:00
[else (die who "invalid" instr)])]
[(xorl src dst)
(cond
[(and (imm8? src) (reg? dst)) (CR* #x83 '/6 dst (IMM8 src ac))]
[(and (imm8? src) (mem? dst)) (CR* #x83 '/6 dst (IMM8 src ac))]
[(and (imm32? src) (eq? dst '%eax)) (C #x35 (IMM32 src ac))]
[(and (reg? src) (reg? dst)) (CR* #x31 src dst ac)]
[(and (mem? src) (reg? dst)) (CR* #x33 dst src ac)]
[(and (reg? src) (mem? dst)) (CR* #x31 src dst ac)]
2007-12-31 02:42:53 -05:00
[else (die who "invalid" instr)])]
[(leal src dst)
(cond
2008-01-04 03:49:27 -05:00
[(and (mem? src) (reg? dst)) (CR* #x8D dst src ac)]
2007-12-31 02:42:53 -05:00
[else (die who "invalid" instr)])]
[(cmpl src dst)
(cond
[(and (imm8? src) (reg? dst)) (CR* #x83 '/7 dst (IMM8 src ac))]
[(and (imm32? src) (eq? dst '%eax)) (C #x3D (IMM32 src ac))]
2008-01-04 03:49:27 -05:00
[(and (imm32? src) (reg? dst)) (CR* #x81 '/7 dst (IMM32 src ac))]
[(and (reg? src) (reg? dst)) (CR* #x39 src dst ac)]
[(and (mem? src) (reg? dst)) (CR* #x3B dst src ac)]
[(and (imm8? src) (mem? dst)) (CR* #x83 '/7 dst (IMM8 src ac))]
[(and (imm32? src) (mem? dst)) (CR* #x81 '/7 dst (IMM32 src ac))]
[else (die who "invalid" instr)])]
2007-12-31 02:42:53 -05:00
[(imull src dst)
(cond
2008-01-04 03:49:27 -05:00
[(and (imm8? src) (reg? dst)) (CR* #x6B dst dst (IMM8 src ac))]
2008-01-19 16:11:00 -05:00
[(and (imm32? src) (reg? dst)) (CR* #x69 dst dst (IMM32 src ac))]
[(and (reg? src) (reg? dst)) (CCR* #x0F #xAF dst src ac)]
2008-01-04 03:49:27 -05:00
[(and (mem? src) (reg? dst)) (CCR* #x0F #xAF dst src ac)]
2007-12-31 02:42:53 -05:00
[else (die who "invalid" instr)])]
[(idivl dst)
(cond
2008-01-04 03:49:27 -05:00
[(reg? dst) (CR* #xF7 '/7 dst ac)]
[(mem? dst) (CR* #xF7 '/7 dst ac)]
2007-12-31 02:42:53 -05:00
[else (die who "invalid" instr)])]
[(pushl dst)
(cond
[(imm8? dst) (CODE #x6A (IMM8 dst ac))]
2008-01-04 03:49:27 -05:00
[(imm32? dst) (CODE #x68 (IMM32 dst ac))]
[(reg? dst) (CR #x50 dst ac)]
[(mem? dst) (CR* #xFF '/6 dst ac)]
2007-12-31 02:42:53 -05:00
[else (die who "invalid" instr)])]
[(popl dst)
(cond
2008-01-04 03:49:27 -05:00
[(reg? dst) (CR #x58 dst ac)]
[(mem? dst) (CR* #x8F '/0 dst ac)]
2007-12-31 02:42:53 -05:00
[else (die who "invalid" instr)])]
[(notl dst)
(cond
2008-01-04 03:49:27 -05:00
[(reg? dst) (CR* #xF7 '/2 dst ac)]
[(mem? dst) (CR* #xF7 '/7 dst ac)]
2007-12-31 02:42:53 -05:00
[else (die who "invalid" instr)])]
[(bswap dst)
(cond
2008-01-04 03:49:27 -05:00
[(reg? dst) (CCR #x0F #xC8 dst ac)]
2007-12-31 02:42:53 -05:00
[else (die who "invalid" instr)])]
[(negl dst)
(cond
[(reg? dst) (CR* #xF7 '/3 dst ac)]
2007-12-31 02:42:53 -05:00
[else (die who "invalid" instr)])]
[(jmp dst)
(cond
[(and (label? dst) (local-label? (label-name dst)))
(CODE #xE9 (cons `(local-relative . ,(label-name dst)) ac))]