From: Taylor R Campbell <campbell@mumble.net>
Date: Fri, 30 Oct 2009 21:40:44 +0000 (-0400)
Subject: Write instruction rules for the general AMD x86-64 instruction set.
X-Git-Tag: 20100708-Gtk~290
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=36958ba272bbe38f8bb7a192966324a09617738d;p=mit-scheme.git

Write instruction rules for the general AMD x86-64 instruction set.

(No floating-point instructions yet.)
---

diff --git a/src/compiler/machines/x86-64/instr1.scm b/src/compiler/machines/x86-64/instr1.scm
index b9a9fb7c1..294572171 100644
--- a/src/compiler/machines/x86-64/instr1.scm
+++ b/src/compiler/machines/x86-64/instr1.scm
@@ -34,29 +34,30 @@ USA.
 ;;;; Pseudo ops
 
 (define-instruction BYTE
-  ((S (? value))
-   (BYTE (8 value SIGNED)))
-  ((U (? value))
-   (BYTE (8 value UNSIGNED))))
+  ((S (? value signed-byte))
+   (BITS (8 value SIGNED)))
+  ((U (? value unsigned-byte))
+   (BITS (8 value UNSIGNED))))
 
 (define-instruction WORD
-  ((S (? value))
-   (BYTE (16 value SIGNED)))
-  ((U (? value))
-   (BYTE (16 value UNSIGNED))))
+  ((S (? value signed-word))
+   (BITS (16 value SIGNED)))
+  ((U (? value unsigned-word))
+   (BITS (16 value UNSIGNED))))
 
 (define-instruction LONG
-  ((S (? value))
-   (BYTE (32 value SIGNED)))
-  ((U (? value))
-   (BYTE (32 value UNSIGNED))))
+  ((S (? value signed-long))
+   (BITS (32 value SIGNED)))
+  ((U (? value unsigned-long))
+   (BITS (32 value UNSIGNED))))
 
-;;;; Actual instructions
+(define-instruction QUAD
+  ((S (? value signed-quad))
+   (BITS (64 value SIGNED)))
+  ((U (? value unsigned-quad))
+   (BITS (64 value UNSIGNED))))
 
-(define-trivial-instruction AAA #x37)
-(define-trivial-instruction AAD #xd5 #x0a)
-(define-trivial-instruction AAM #xd4 #x0a)
-(define-trivial-instruction AAS #x3f)
+;;;; Actual instructions
 
 (let-syntax
     ((define-arithmetic-instruction
@@ -65,105 +66,146 @@ USA.
 	 environment
 	 (let ((mnemonic (cadr form))
 	       (opcode (caddr form))
-	       (digit (cadddr form)))
+	       (digit (cadddr form))
+	       (signed-prefix (car (cddddr form)))
+	       (unsigned-prefix (cadr (cddddr form))))
+	   (define (signed suffix)
+	     (symbol signed-prefix '- suffix))
+	   (define (unsigned suffix)
+	     (symbol unsigned-prefix '- suffix))
 	   `(define-instruction ,mnemonic
-	      ((W (? target r/mW) (R (? source)))
-	       (BYTE (8 ,(+ opcode 1)))
+	      ((B (? target r/m-ea) (R (? source)))
+	       (PREFIX (ModR/M source target))
+	       (BITS (8 ,opcode))
 	       (ModR/M source target))
 
-	      ((W (R (? target)) (? source r/mW))
-	       (BYTE (8 ,(+ opcode 3)))
+	      ((B (R (? target)) (? source r/m-ea))
+	       (PREFIX (ModR/M source target))
+	       (BITS (8 ,(+ opcode 2)))
 	       (ModR/M target source))
 
-	      ((W (? target r/mW) (& (? value sign-extended-byte)))
-	       (BYTE (8 #x83))
-	       (ModR/M ,digit target)
-	       (BYTE (8 value SIGNED)))
-
-	      ((W (R 0) (& (? value)))	; AX/EAX
-	       (BYTE (8 ,(+ opcode 5)))
-	       (IMMEDIATE value))
+	      ((B (R 0) (& (? value ,(signed 'BYTE))))		;AL
+	       (BITS (8 ,(+ opcode 4))
+		     (8 value SIGNED)))
 
-	      ((W (? target r/mW) (& (? value)))
-	       (BYTE (8 #x81))
-	       (ModR/M ,digit target)
-	       (IMMEDIATE value))
+	      ((B (R 0) (&U (? value ,(unsigned 'BYTE))))	;AL
+	       (BITS (8 ,(+ opcode 4))
+		     (8 value SIGNED)))
 
-	      ((W (? target r/mW) (&U (? value zero-extended-byte)))
-	       (BYTE (8 #x83))
+	      ((B (? target r/m-ea) (& (? value ,(signed 'BYTE))))
+	       (PREFIX (ModR/M target))
+	       (BITS (8 #x80))
 	       (ModR/M ,digit target)
-	       (BYTE (8 value UNSIGNED)))
-
-	      ((W (R 0) (&U (? value)))	; AX/EAX
-	       (BYTE (8 ,(+ opcode 5)))
-	       (IMMEDIATE value OPERAND UNSIGNED))
+	       (BITS (8 value SIGNED)))
 
-	      ((W (? target r/mW) (&U (? value)))
-	       (BYTE (8 #x81))
+	      ((B (? target r/m-ea) (&U (? value ,(unsigned 'BYTE))))
+	       (PREFIX (ModR/M target))
+	       (BITS (8 #x80))
 	       (ModR/M ,digit target)
-	       (IMMEDIATE value OPERAND UNSIGNED))
-
-	      ((B (? target r/mB) (R (? source)))
-	       (BYTE (8 ,opcode))
+	       (BITS (8 value SIGNED)))
+
+	      ((W (R 0) (& (? value ,(signed 'WORD))))
+	       (PREFIX (OPERAND 'W))
+	       (BITS (8 ,(+ opcode 5))
+		     (16 value SIGNED)))
+
+	      ((W (R 0) (&U (? value ,(unsigned 'WORD))))
+	       (PREFIX (OPERAND 'W))
+	       (BITS (8 ,(+ opcode 5))
+		     (16 value SIGNED)))
+
+	      (((? size operand-size) (R 0) (& (? value ,(signed 'LONG))))
+	       (PREFIX (OPERAND size))
+	       (BITS (8 ,(+ opcode 5))
+		     (32 value SIGNED)))
+
+	      (((? size operand-size) (R 0) (&U (? value ,(unsigned 'LONG))))
+	       (PREFIX (OPERAND size))
+	       (BITS (8 ,(+ opcode 5))
+		     (32 value SIGNED)))
+
+	      (((? size operand-size) (? target r/m-ea) (R (? source)))
+	       (PREFIX (OPERAND size) (ModR/M source target))
+	       (BITS (8 ,(+ opcode 1)))
 	       (ModR/M source target))
 
-	      ((B (R (? target)) (? source r/mB))
-	       (BYTE (8 ,(+ opcode 2)))
+	      (((? size operand-size) (R (? target)) (? source r/m-ea))
+	       (PREFIX (OPERAND size) (ModR/M target source))
+	       (BITS (8 ,(+ opcode 3)))
 	       (ModR/M target source))
 
-	      ((B (R 0) (& (? value)))	; AL
-	       (BYTE (8 ,(+ opcode 4))
-		     (8 value SIGNED)))
+	      (((? size operand-size)
+		(? target r/m-ea)
+		(& (? value ,(signed 'BYTE))))
+	       (PREFIX (OPERAND size) (ModR/M target))
+	       (BITS (8 #x83))
+	       (ModR/M ,digit target)
+	       (BITS (8 value SIGNED)))
 
-	      ((B (R 0) (&U (? value)))	; AL
-	       (BYTE (8 ,(+ opcode 4))
-		     (8 value UNSIGNED)))
+	      (((? size operand-size)
+		(? target r/m-ea)
+		(&U (? value ,(unsigned 'BYTE))))
+	       (PREFIX (OPERAND size) (ModR/M target))
+	       (BITS (8 #x83))
+	       (ModR/M ,digit target)
+	       (BITS (8 value SIGNED)))
 
-	      ((B (? target r/mB) (& (? value)))
-	       (BYTE (8 #x80))
+	      ((W (? target r/m-ea) (& (? value ,(signed 'WORD))))
+	       (PREFIX (OPERAND 'W) (ModR/M target))
+	       (BITS (8 #x81))
 	       (ModR/M ,digit target)
-	       (BYTE (8 value SIGNED)))
+	       (BITS (16 value SIGNED)))
 
-	      ((B (? target r/mB) (&U (? value)))
-	       (BYTE (8 #x80))
+	      ((W (? target r/m-ea) (&U (? value ,(unsigned 'WORD))))
+	       (PREFIX (OPERAND 'W) (ModR/M target))
+	       (BITS (8 #x81))
 	       (ModR/M ,digit target)
-	       (BYTE (8 value UNSIGNED)))))))))
-
-  (define-arithmetic-instruction ADC #x10 2)
-  (define-arithmetic-instruction ADD #x00 0)
-  (define-arithmetic-instruction AND #x20 4)
-  (define-arithmetic-instruction CMP #x38 7)
-  (define-arithmetic-instruction OR  #x08 1)
-  (define-arithmetic-instruction SBB #x18 3)
-  (define-arithmetic-instruction SUB #x28 5)
-  (define-arithmetic-instruction XOR #x30 6))
-
-(define-instruction ARPL
-  (((? target r/mW) (R (? source)))
-   (BYTE (8 #x63))
-   (ModR/M source target)))
+	       (BITS (16 value SIGNED)))
 
-(define-instruction BOUND
-  (((R (? source)) (? bounds mW))
-   (BYTE (8 #x62))
-   (ModR/M source bounds)))
+	      (((? size operand-size)
+		(? target r/m-ea)
+		(& (? value ,(signed 'LONG))))
+	       (PREFIX (OPERAND size) (ModR/M target))
+	       (BITS (8 #x81))
+	       (ModR/M ,digit target)
+	       (BITS (32 value SIGNED)))
 
+	      (((? size operand-size)
+		(? target r/m-ea)
+		(&U (? value ,(unsigned 'LONG))))
+	       (PREFIX (OPERAND size) (ModR/M target))
+	       (BITS (8 #x81))
+	       (ModR/M ,digit target)
+	       (BITS (32 value SIGNED)))))))))
+
+  (define-arithmetic-instruction ADC #x10 2 SIGN-EXTENDED ZERO-EXTENDED)
+  (define-arithmetic-instruction ADD #x00 0 SIGN-EXTENDED ZERO-EXTENDED)
+  (define-arithmetic-instruction AND #x20 4 SIGNED UNSIGNED)
+  (define-arithmetic-instruction CMP #x38 7 SIGN-EXTENDED ZERO-EXTENDED)
+  (define-arithmetic-instruction OR  #x08 1 SIGNED UNSIGNED)
+  (define-arithmetic-instruction SBB #x18 3 SIGN-EXTENDED ZERO-EXTENDED)
+  (define-arithmetic-instruction SUB #x28 5 SIGN-EXTENDED ZERO-EXTENDED)
+  (define-arithmetic-instruction XOR #x30 6 SIGNED UNSIGNED))
+
 (define-instruction BSF
-  (((R (? target)) (? source r/mW))
-   (BYTE (8 #x0f)
+  (((? size operand-size) (R (? target)) (? source r/m-ea))
+   (PREFIX (OPERAND size) (ModR/M target source))
+   (BITS (8 #x0f)
 	 (8 #xbc))
    (ModR/M target source)))
 
 (define-instruction BSR
-  (((R (? target)) (? source r/mW))
-   (BYTE (8 #x0f)
+  (((? size operand-size) (R (? target)) (? source r/m-ea))
+   (PREFIX (OPERAND size) (ModR/M target source))
+   (BITS (8 #x0f)
 	 (8 #xbd))
    (ModR/M target source)))
 
-(define-instruction BSWAP			; 486 only
-  (((R (? reg)))
-   (BYTE (8 #x0f)
-	 (8 (+ #xc8 reg)))))
+(define-instruction BSWAP
+  (((? size operand-size) (R (? reg)))
+   (PREFIX (OPERAND size) (OPCODE-REGISTER reg))
+   (BITS (8 #x0f)
+	 (8 (opcode-register #xc8 reg)))))
 
 (let-syntax
     ((define-bit-test-instruction
@@ -175,14 +217,17 @@ USA.
 	       (digit (cadddr form)))
 	   `(define-instruction ,mnemonic
 
-	      (((? target r/mW) (& (? posn)))
-	       (BYTE (8 #x0f)
+	      (((? size operand-size) (? target r/m-ea)
+				      (& (? posn unsigned-byte)))
+	       (PREFIX (OPERAND size) (ModR/M target))
+	       (BITS (8 #x0f)
 		     (8 #xba))
 	       (ModR/M ,digit target)
-	       (BYTE (8 posn UNSIGNED)))
+	       (BITS (8 posn)))
 
-	      (((? target r/mW) (R (? posn)))
-	       (BYTE (8 #x0f)
+	      (((? target r/m-ea) (R (? posn)))
+	       (PREFIX (ModR/M posn target))
+	       (BITS (8 #x0f)
 		     (8 ,opcode))
 	       (ModR/M posn target))))))))
 
@@ -193,38 +238,43 @@ USA.
   
 (define-instruction CALL
   (((@PCR (? dest)))
-   (BYTE (8 #xe8))
-   (IMMEDIATE `(- ,dest (+ *PC* 4)) ADDRESS)) ; fcn(*ADDRESS-SIZE*)
+   (BITS (8 #xe8)
+	 (32 `(- ,dest (+ *PC* 4)))))
 
   (((@PCRO (? dest) (? offset)))
-   (BYTE (8 #xe8))
-   (IMMEDIATE `(- (+ ,dest ,offset) (+ *PC* 4)) ADDRESS)); fcn(*ADDRESS-SIZE*)
+   (BITS (8 #xe8)
+	 (32 `(- (+ ,dest ,offset) (+ *PC* 4)))))
 
-  (((@PCO (? displ)))
-   (BYTE (8 #xe8))
-   (IMMEDIATE displ ADDRESS))
+  (((@PCO (? offset)))
+   (BITS (8 #xe8)
+	 (32 offset)))
 
-  (((? dest r/mW))
-   (BYTE (8 #xff))
-   (ModR/M 2 dest))
+  (((? dest r/m-ea))
+   (PREFIX (ModR/M dest))
+   (BITS (8 #xff))
+   (ModR/M 2 dest)))
 
-  ((F (? dest mW))
-   (BYTE (8 #xff))
-   (ModR/M 3 dest))
+;;; Convert to Sign-Extended, in other assemblers identified by the
+;;; six mnemonics CBW, CWDE, CDQE, CWD, CDQ, and CDO.  The operand
+;;; size in this rendition means the size of the final result; thus,
+;;; (CSE L (R 0)) sign-extends AX (word) to EAX (long), and (CSE Q (R
+;;; 2) (R 0)) fills all sixty-four bits of RDX with the sign of RAX.
 
-  ((F (SEGMENT (? seg)) (OFFSET (? off)))
-   (BYTE (8 #x9a))
-   (BYTE (16 seg))
-   (IMMEDIATE off ADDRESS)))
+(define-instruction CSE
+  (((? size operand-size) (R 0))
+   (PREFIX (OPERAND (case size ((W) 'B) ((L) 'W) ((Q) 'L))))
+   (BITS (8 #x98)))
+
+  (((? size operand-size) (R 2) (R 0))
+   (PREFIX (OPERAND size))
+   (BITS (8 #x99))))
 
-(define-trivial-instruction CBW #x98)
-(define-trivial-instruction CWDE #x98)
 (define-trivial-instruction CLC #xf8)
 (define-trivial-instruction CLD #xfc)
 (define-trivial-instruction CLI #xfa)
 (define-trivial-instruction CLTS #x0f #x06)
 (define-trivial-instruction CMC #xf5)
-
+
 (let-syntax
     ((define-string-instruction
       (sc-macro-transformer
@@ -234,11 +284,12 @@ USA.
 	       (opcode (caddr form)))
 	   `(define-instruction ,mnemonic
 
-	      ((W)
-	       (BYTE (8 ,(+ opcode 1))))
-
 	      ((B)
-	       (BYTE (8 ,opcode)))))))))
+	       (BITS (8 ,opcode)))
+
+	      (((? size operand-size))
+	       (PREFIX (OPERAND size))
+	       (BITS (8 ,(+ opcode 1))))))))))
 
   (define-string-instruction CMPS #xa6)
   (define-string-instruction LODS #xac)
@@ -248,23 +299,23 @@ USA.
   (define-string-instruction SCAS #xae)
   (define-string-instruction STOS #xaa))
 
-(define-instruction CMPXCHG			; 486 only
-  ((W (? target r/mW) (R (? reg)))
-   (BYTE (8 #x0f)
-	 (8 #xa7))
+(define-instruction CMPXCHG
+  ((B (? target r/m-ea) (R (? reg)))
+   (PREFIX (ModR/M reg target))
+   (BITS (8 #x0f)
+	 (8 #xb1))
    (ModR/M reg target))
 
-  ((B (? target r/mB) (R (? reg)))
-   (BYTE (8 #x0f)
-	 (8 #xa6))
+  (((? size operand-size) (? target r/m-ea) (R (? reg)))
+   (PREFIX (OPERAND size) (ModR/M reg target))
+   (BITS (8 #x0f)
+	 (8 #xb0))
    (ModR/M reg target)))
 
 (define-trivial-instruction CPUID #x0F #xA2)
 
 (define-trivial-instruction CWD #x99)
 (define-trivial-instruction CDQ #x99)
-(define-trivial-instruction DAA #x27)
-(define-trivial-instruction DAS #x2f)
 
 (let-syntax
     ((define-inc/dec
@@ -275,15 +326,24 @@ USA.
 	       (digit (caddr form))
 	       (opcode (cadddr form)))
 	   `(define-instruction ,mnemonic
-	      ((W (R (? reg)))
-	       (BYTE (8 (+ ,opcode reg))))
-
-	      ((W (? target r/mW))
-	       (BYTE (8 #xff))
+	      ;; There is no 64-bit analogue of these: the opcodes
+	      ;; have been repurposed for REX prefixes!
+	      ;;
+	      ;; ((W (R (? reg)))
+	      ;;  (PREFIX (OPERAND 'W))
+	      ;;  (BITS (8 (+ ,opcode reg))))
+	      ;;
+	      ;; ((L (R (? reg)))
+	      ;;  (BITS (8 (+ ,opcode reg))))
+
+	      ((B (? target r/m-ea))
+	       (PREFIX (ModR/M target))
+	       (BITS (8 #xfe))
 	       (ModR/M ,digit target))
 
-	      ((B (? target r/mB))
-	       (BYTE (8 #xfe))
+	      (((? size operand-size) (? target r/m-ea))
+	       (PREFIX (OPERAND size) (ModR/M target))
+	       (BITS (8 #xff))
 	       (ModR/M ,digit target))))))))
 
   (define-inc/dec DEC 1 #x48)
@@ -297,12 +357,14 @@ USA.
 	 (let ((mnemonic (cadr form))
 	       (digit (caddr form)))
 	   `(define-instruction ,mnemonic
-	      ((W (R 0) (? operand r/mW))
-	       (BYTE (8 #xf7))
+	      ((B ((R 2) : (R 0)) (? operand r/m-ea))
+	       (PREFIX (ModR/M operand))
+	       (BITS (8 #xf6))
 	       (ModR/M ,digit operand))
 
-	      ((B (R 0) (? operand r/mB))
-	       (BYTE (8 #xf6))
+	      (((? size operand-size) ((R 2) : (R 0)) (? operand r/m-ea))
+	       (PREFIX (OPERAND size) (ModR/M operand))
+	       (BITS (8 #xf7))
 	       (ModR/M ,digit operand))))))))
 
   (define-mul/div DIV 6)
@@ -310,71 +372,110 @@ USA.
   (define-mul/div MUL 4))
 
 (define-instruction ENTER
-  (((& (? frame-size)) (& (? lexical-level)))
-   (BYTE (8 #xc8)
+  (((& (? frame-size unsigned-word)) (& (? lexical-level unsigned-byte)))
+   (BITS (8 #xc8)
 	 (16 frame-size)
 	 (8 lexical-level))))
 
 (define-trivial-instruction HLT #xf4)
-
+
 (define-instruction IMUL
-  ((W (R (? target)) (? source r/mW))
-   (BYTE (8 #x0f)
+  ((B (R 0) (? source r/m-ea))
+   (PREFIX (ModR/M source))
+   (BITS (8 #xf6))
+   (ModR/M 5 source))
+
+  (((? size operand-size) ((R 2) : (R 0)) (? source r/m-ea))
+   (PREFIX (OPERAND size) (ModR/M source))
+   (BITS (8 #xf7))
+   (ModR/M 5 source))
+
+  (((? size operand-size) (R (? target)) (? source r/m-ea))
+   (PREFIX (OPERAND size) (ModR/M target source))
+   (BITS (8 #x0f)
 	 (8 #xaf))
    (ModR/M target source))
 
-  ((W (R (? target)) (? source r/mW) (& (? value sign-extended-byte)))
-   (BYTE (8 #x6b))
+  (((? size operand-size) (R (? target))
+			  (? source r/m-ea)
+			  (& (? multiplier sign-extended-byte)))
+   (PREFIX (OPERAND size) (ModR/M target source))
+   (BITS (8 #x6b))
    (ModR/M target source)
-   (BYTE (8 value SIGNED)))
+   (BITS (8 multiplier SIGNED)))
 
-  ((W (R (? target)) (? source r/mW) (& (? value)))
-   (BYTE (8 #x69))
+  (((? size operand-size) (R (? target))
+			  (? source r/m-ea)
+			  (&U (? multiplier zero-extended-byte)))
+   (PREFIX (OPERAND size) (ModR/M target source))
+   (BITS (8 #x6b))
    (ModR/M target source)
-   (IMMEDIATE value))
+   (BITS (8 multiplier SIGNED)))
 
-  ((W (R (? target)) (? source r/mW) (&U (? value zero-extended-byte)))
-   (BYTE (8 #x6b))
+  ((W (R (? target))
+      (? source r/m-ea)
+      (& (? multiplier sign-extended-word)))
+   (PREFIX (OPERAND 'W) (ModR/M target source))
+   (BITS (8 #x69))
    (ModR/M target source)
-   (BYTE (8 value UNSIGNED)))
+   (BITS (16 multiplier SIGNED)))
 
-  ((W (R (? target)) (? source r/mW) (&U (? value)))
-   (BYTE (8 #x69))
+  ((W (R (? target))
+      (? source r/m-ea)
+      (&U (? multiplier zero-extended-word)))
+   (PREFIX (OPERAND 'W) (ModR/M target source))
+   (BITS (8 #x69))
    (ModR/M target source)
-   (IMMEDIATE value OPERAND UNSIGNED))
-
-  ((W ((R 2) : (R 0)) (? source r/mW))
-   (BYTE (8 #xf7))
-   (ModR/M 5 source))
+   (BITS (16 multiplier SIGNED)))
 
-  ((B (R 0) (? source r/mB))
-   (BYTE (8 #xf6))
-   (ModR/M 5 source)))
+  (((? size operand-size) (R (? target))
+			  (? source r/m-ea)
+			  (& (? multiplier sign-extended-word)))
+   (PREFIX (OPERAND size) (ModR/M target source))
+   (BITS (8 #x6b))
+   (ModR/M target source)
+   (BITS (32 multiplier SIGNED)))
 
+  (((? size operand-size) (R (? target))
+			  (? source r/m-ea)
+			  (&U (? multiplier zero-extended-word)))
+   (PREFIX (OPERAND size) (ModR/M target source))
+   (BITS (8 #x6b))
+   (ModR/M target source)
+   (BITS (32 multiplier SIGNED))))
+
 (define-instruction IN
-  ((W (R 0) (& (? port)))
-   (BYTE (8 #xe5)
+  ((B (R 0) (& (? port unsigned-byte)))
+   (BITS (8 #xe4)
+	 (8 port)))
+
+  ((B (R 0) (R 2))
+   (BITS (8 #xec)))
+
+  ((W (R 0) (& (? port unsigned-byte)))
+   (PREFIX (OPERAND 'W))
+   (BITS (8 #xe5)
 	 (8 port)))
 
   ((W (R 0) (R 2))
-   (BYTE (8 #xed)))
+   (PREFIX (OPERAND 'W))
+   (BITS (8 #xed)))
 
-  ((B (R 0) (& (? port)))
-   (BYTE (8 #xe4)
+  ((L (R 0) (& (? port unsigned-byte)))
+   (BITS (8 #xe5)
 	 (8 port)))
 
-  ((B (R 0) (R 2))
-   (BYTE (8 #xec))))
+  ((L (R 0) (R 2))
+   (BITS (8 #xed))))
 
 (define-instruction INT
   ((3)
-   (BYTE (8 #xcc)))
+   (BITS (8 #xcc)))
 
-  (((& (? vector)))
-   (BYTE (8 #xcd)
+  (((& (? vector unsigned-byte)))
+   (BITS (8 #xcd)
 	 (8 vector))))
 
-(define-trivial-instruction INTO #xce)
 (define-trivial-instruction INVD #x0f #x08)	; 486 only
 (define-trivial-instruction IRET #xcf)
 
@@ -384,38 +485,36 @@ USA.
        (lambda (form environment)
 	 environment
 	 (let ((mnemonic (cadr form))
-	       (opcode1 (caddr form))
-	       (opcode2 (cadddr form)))
+	       (short-opcode (caddr form))
+	       (near-opcode (cadddr form)))
 	   `(define-instruction ,mnemonic
-	      ;; This assumes that *ADDRESS-SIZE* is 4 (32-bit mode)
 	      (((@PCR (? dest)))
-	       (VARIABLE-WIDTH
-		(disp `(- ,dest (+ *PC* 2)))
-		((-128 127)
-		 (BYTE (8 ,opcode1)
-		       (8 disp SIGNED)))
-		((() ())
-		 (BYTE (8 #x0f)
-		       (8 ,opcode2)
-		       (32 (- disp 4) SIGNED)))))
+	       (VARIABLE-WIDTH (disp `(- ,dest (+ *PC* 2)))
+		 ((#x-80 #x7f)
+		  (BITS (8 ,short-opcode)
+			(8 disp SIGNED)))
+		 ((() ())
+		  (BITS (8 #x0f)
+			(8 ,near-opcode)
+			(32 (- disp 4) SIGNED)))))
 
 	      ((B (@PCR (? dest)))
-	       (BYTE (8 ,opcode1)
+	       (BITS (8 ,short-opcode)
 		     (8 `(- ,dest (+ *PC* 1)) SIGNED)))
 
-	      ((W (@PCR (? dest)))
-	       (BYTE (8 #x0f)
-		     (8 ,opcode2))
-	       (IMMEDIATE `(- ,dest (+ *PC* 4)) ADDRESS)) ; fcn(*ADDRESS-SIZE*)
+	      ((L (@PCR (? dest)))
+	       (BITS (8 #x0f)
+		     (8 ,near-opcode)
+		     (32 `(- ,dest (+ *PC* 4)) SIGNED)))
 
 	      ((B (@PCO (? displ)))
-	       (BYTE (8 ,opcode1)
+	       (BITS (8 ,short-opcode)
 		     (8 displ SIGNED)))
 
-	      ((W (@PCO (? displ)))
-	       (BYTE (8 #x0f)
-		     (8 ,opcode2))
-	       (IMMEDIATE displ ADDRESS))))))))
+	      ((L (@PCO (? displ)))
+	       (BITS (8 #x0f)
+		     (8 ,near-opcode)
+		     (32 displ SIGNED)))))))))
 
   (define-jump-instruction JA   #x77 #x87)
   (define-jump-instruction JAE  #x73 #x83)
@@ -457,11 +556,11 @@ USA.
 	       (opcode (caddr form)))
 	   `(define-instruction ,mnemonic
 	      ((B (@PCR (? dest)))
-	       (BYTE (8 ,opcode)
+	       (BITS (8 ,opcode)
 		     (8 `(- ,dest (+ *PC* 1)) SIGNED)))
 
-	      ((B (@PCO (? displ)))
-	       (BYTE (8 ,opcode)
+	      ((B (@PCO (? displ signed-byte)))
+	       (BITS (8 ,opcode)
 		     (8 displ SIGNED)))))))))
 
   (define-loop-instruction JCXZ   #xe3)
@@ -473,67 +572,51 @@ USA.
   (define-loop-instruction LOOPNZ #xe0))
 
 (define-instruction JMP
-  ;; This assumes that *ADDRESS-SIZE* is 4 (32-bit mode)
   (((@PCR (? dest)))
-   (VARIABLE-WIDTH
-    (disp `(- ,dest (+ *PC* 2)))
-    ((-128 127)
-     (BYTE (8 #xeb)
-	   (8 disp SIGNED)))
-    ((() ())
-     (BYTE (8 #xe9)
-	   (32 (- disp 3) SIGNED)))))
+   (VARIABLE-WIDTH (disp `(- ,dest (+ *PC* 2)))
+     ((#x-80 #x7f)
+      (BITS (8 #xeb)
+	    (8 disp SIGNED)))
+     ((() ())
+      (BITS (8 #xe9)
+	    (32 (- disp 3) SIGNED)))))
 
   (((@PCRO (? dest) (? offset)))
-   (VARIABLE-WIDTH
-    (disp `(- (+ ,dest ,offset) (+ *PC* 2)))
-    ((-128 127)
-     (BYTE (8 #xeb)
-	   (8 disp SIGNED)))
-    ((() ())
-     (BYTE (8 #xe9)
-	   (32 (- disp 3) SIGNED)))))
-
-  (((? dest r/mW))
-   (BYTE (8 #xff))
+   (VARIABLE-WIDTH (disp `(- (+ ,dest ,offset) (+ *PC* 2)))
+     ((#x-80 #x7f)
+      (BITS (8 #xeb)
+	    (8 disp SIGNED)))
+     ((() ())
+      (BITS (8 #xe9)
+	    (32 (- disp 3) SIGNED)))))
+
+  (((? dest r/m-ea))
+   (PREFIX (ModR/M dest))
+   (BITS (8 #xff))
    (ModR/M 4 dest))
 
   ((B (@PCR (? dest)))
-   (BYTE (8 #xeb)
+   (BITS (8 #xeb)
 	 (8 `(- ,dest (+ *PC* 1)) SIGNED)))
 
-  ((W (@PCR (? dest)))
-   (BYTE (8 #xe9))
-   (IMMEDIATE `(- ,dest (+ *PC* 4)) ADDRESS)) ; fcn(*ADDRESS-SIZE*)
+  ((L (@PCR (? dest)))
+   (BITS (8 #xe9)
+	 (32 `(- ,dest (+ *PC* 4)) SIGNED)))
 
   ((B (@PCO (? displ)))
-   (BYTE (8 #xeb)
+   (BITS (8 #xeb)
 	 (8 displ SIGNED)))
 
-  ((W (@PCO (? displ)))
-   (BYTE (8 #xe9))
-   (IMMEDIATE displ ADDRESS))
-
-  ((F (? dest mW))
-   (BYTE (8 #xff))
-   (ModR/M 5 dest))
-
-  ((F (SEGMENT (? seg)) (OFFSET (? off)))
-   (BYTE (8 #xea))
-   (BYTE (16 seg))
-   (IMMEDIATE off ADDRESS)))
+  ((L (@PCO (? displ)))
+   (BITS (8 #xe9)
+	 (32 displ SIGNED))))
 
 (define-trivial-instruction LAHF #x9f)
 
-(define-instruction LAR
-  (((R (? target)) (? source r/mW))
-   (BYTE (8 #x0f)
-	 (8 #x02))
-   (ModR/M target source)))
-
 (define-instruction LEA
-  (((R (? target)) (? source mW))
-   (BYTE (8 #x8d))
+  (((? size operand-size) (R (? target)) (? source m-ea))
+   (PREFIX (OPERAND size) (ModR/M target source))
+   (BITS (8 #x8d))
    (ModR/M target source)))
 
 (define-trivial-instruction LEAVE #xc9)
@@ -547,8 +630,8 @@ USA.
 	       (opcode (caddr form))
 	       (digit (cadddr form)))
 	   `(define-instruction ,mnemonic
-	      (((? operand mW))
-	       (BYTE (8 #x0f)
+	      (((? operand m-ea))
+	       (BITS (8 #x0f)
 		     (8 ,opcode))
 	       (ModR/M ,digit operand))))))))
 
diff --git a/src/compiler/machines/x86-64/instr2.scm b/src/compiler/machines/x86-64/instr2.scm
index a2e19f6bf..3c07456c8 100644
--- a/src/compiler/machines/x86-64/instr2.scm
+++ b/src/compiler/machines/x86-64/instr2.scm
@@ -39,23 +39,23 @@ USA.
        (lambda (form environment)
 	 environment
 	 (let ((mnemonic (cadr form))
-	       (bytes (cddr form)))
+	       (byte1 (caddr form))
+	       (byte2 (cadddr form)))
 	   `(define-instruction ,mnemonic
-	      (((R (? reg)) (? pointer mW))
-	       (BYTE ,@(map (lambda (byte)
-			      `(8 ,byte))
-			    bytes))
+	      (((? size operand-size) (R (? reg)) (? pointer m-ea))
+	       (PREFIX (OPERAND size) (ModR/M reg pointer))
+	       (BITS (8 ,byte1)
+		     (8 ,byte2))
 	       (ModR/M reg pointer))))))))
 
-  (define-load-segment LDS #xc5)
   (define-load-segment LSS #x0f #xb2)
-  (define-load-segment LES #xc4)
   (define-load-segment LFS #x0f #xb4)
   (define-load-segment LGS #x0f #xb5))
 
 (define-instruction LSL
-  (((R (? reg)) (? source r/mW))
-   (BYTE (8 #x0f)
+  (((? size operand-size) (R (? reg)) (? source r/m-ea))
+   (PREFIX (OPERAND size) (ModR/M reg source))
+   (BITS (8 #x0f)
 	 (8 #x03))
    (ModR/M reg source)))
 
@@ -67,14 +67,16 @@ USA.
 	 (let ((mnemonic (cadr form))
 	       (opcode (caddr form)))
 	   `(define-instruction ,mnemonic
-	      ((B (R (? target)) (? source r/mB))
-	       (BYTE (8 #x0f)
+	      (((? size operand-size) (R (? target)) B (? source r/m-ea))
+	       (PREFIX (OPERAND size) (ModR/M target source))
+	       (BITS (8 #x0f)
 		     (8 ,opcode))
 	       (ModR/M target source))
 
-	      ((H (R (? target)) (? source r/mW))
-	       (BYTE (8 #x0f)
-		     (8 ,(1+ opcode)))
+	      (((? size operand-size) (R (? target)) H (? source r/m-ea))
+	       (PREFIX (OPERAND size) (ModR/M target source))
+	       (BITS (8 #x0f)
+		     (8 ,(+ opcode 1)))
 	       (ModR/M target source))))))))
 
   (define-data-extension MOVSX #xbe)
@@ -88,256 +90,314 @@ USA.
 	 (let ((mnemonic (cadr form))
 	       (digit (caddr form)))
 	   `(define-instruction ,mnemonic
-	      ((W (? operand r/mW))
-	       (BYTE (8 #xf7))
+	      ((B (? operand r/m-ea))
+	       (PREFIX (ModR/M operand))
+	       (BITS (8 #xf6))
 	       (ModR/M ,digit operand))
 
-	      ((B (? operand r/mB))
-	       (BYTE (8 #xf6))
+	      (((? size operand-size) (? operand r/m-ea))
+	       (PREFIX (OPERAND size) (ModR/M operand))
+	       (BITS (8 #xf7))
 	       (ModR/M ,digit operand))))))))
 
   (define-unary NEG 3)
   (define-unary NOT 2))
 
 (define-instruction MOV
-  ((W (R (? target)) (? source r/mW))
-   (BYTE (8 #x8b))
-   (ModR/M target source))
-
-  ((W (? target r/mW) (R (? source)))
-   (BYTE (8 #x89))
+  ((B (? target r/m-ea) (R (? source)))
+   (PREFIX (ModR/M source target))
+   (BITS (8 #x88))
    (ModR/M source target))
 
-  ((W (R (? reg)) (& (? value)))
-   (BYTE (8 (+ #xb8 reg)))
-   (IMMEDIATE value))
-
-  ((W (? target r/mW) (& (? value)))
-   (BYTE (8 #xc7))
-   (ModR/M 0 target)
-   (IMMEDIATE value))
-
-  ((W (R (? reg)) (&U (? value)))
-   (BYTE (8 (+ #xb8 reg)))
-   (IMMEDIATE value OPERAND UNSIGNED))
-
-  ((W (? target r/mW) (&U (? value)))
-   (BYTE (8 #xc7))
-   (ModR/M 0 target)
-   (IMMEDIATE value OPERAND UNSIGNED))
+  (((? size operand-size) (? target r/m-ea) (R (? source)))
+   (PREFIX (OPERAND size) (ModR/M source target))
+   (BITS (8 #x89))
+   (ModR/M source target))
 
-  ((B (R (? target)) (? source r/mB))
-   (BYTE (8 #x8a))
+  ((B (R (? target)) (? source r/m-ea))
+   (PREFIX (ModR/M target source))
+   (BITS (8 #x8a))
    (ModR/M target source))
 
-  ((B (? target r/mB) (R (? source)))
-   (BYTE (8 #x88))
-   (ModR/M source target))
+  (((? size operand-size) (R (? target)) (? source r/m-ea))
+   (PREFIX (OPERAND size) (ModR/M target source))
+   (BITS (8 #x8b))
+   (ModR/M target source))
 
-  ((B (R (? reg)) (& (? value)))
-   (BYTE (8 (+ #xb0 reg))
+  ((B (R 0) (@ (? moffset unsigned-byte)))
+   (BITS (8 #xa0)
+	 (8 moffset UNSIGNED)))
+
+  ((W (R 0) (@ (? moffset unsigned-word)))
+   (PREFIX (OPERAND 'W))
+   (BITS (8 #xa1)
+	 (16 moffset UNSIGNED)))
+
+  ((L (R 0) (@ (? moffset unsigned-long)))
+   (PREFIX (OPERAND 'L))
+   (BITS (8 #xa1)
+	 (32 moffset UNSIGNED)))
+
+  ((Q (R 0) (@ (? moffset unsigned-quad)))
+   (PREFIX (OPERAND 'Q))
+   (BITS (8 #xa1)
+	 (64 moffset UNSIGNED)))
+
+  ((B (@ (? moffset unsigned-byte)) (R 0))
+   (BITS (8 #xa2)
+	 (8 moffset UNSIGNED)))
+
+  ((W (@ (? moffset unsigned-word)) (R 0))
+   (PREFIX (OPERAND 'W))
+   (BITS (8 #xa3)
+	 (16 moffset UNSIGNED)))
+
+  ((L (@ (? moffset unsigned-long)) (R 0))
+   (PREFIX (OPERAND 'L))
+   (BITS (8 #xa3)
+	 (32 moffset UNSIGNED)))
+
+  ((Q (@ (? moffset unsigned-quad)) (R 0))
+   (PREFIX (OPERAND 'Q))
+   (BITS (8 #xa3)
+	 (64 moffset UNSIGNED)))
+
+  ((B (R (? target)) (& (? value signed-byte)))
+   (PREFIX (OPCODE-REGISTER target))
+   (BITS (8 (opcode-register #xb0 target))
 	 (8 value SIGNED)))
 
-  ((B (? target r/mB) (& (? value)))
-   (BYTE (8 #xc6))
-   (ModR/M 0 target)
-   (BYTE (8 value SIGNED)))
-
-  ((B (R (? reg)) (&U (? value)))
-   (BYTE (8 (+ #xb0 reg))
+  ((B (R (? target)) (&U (? value unsigned-byte)))
+   (PREFIX (OPCODE-REGISTER target))
+   (BITS (8 (opcode-register #xb0 target))
 	 (8 value UNSIGNED)))
 
-  ((B (? target r/mB) (&U (? value)))
-   (BYTE (8 #xc6))
+  ((W (R (? target)) (& (? value signed-word)))
+   (PREFIX (OPERAND 'W) (OPCODE-REGISTER target))
+   (BITS (8 (opcode-register #xb8 target))
+	 (16 value SIGNED)))
+
+  ((W (R (? target)) (&U (? value unsigned-word)))
+   (PREFIX (OPERAND 'W) (OPCODE-REGISTER target))
+   (BITS (8 (opcode-register #xb8 target))
+	 (16 value UNSIGNED)))
+
+  ((L (R (? target)) (& (? value signed-long)))
+   (PREFIX (OPERAND 'L) (OPCODE-REGISTER target))
+   (BITS (8 (opcode-register #xb8 target))
+	 (32 value SIGNED)))
+
+  ((L (R (? target)) (&U (? value unsigned-long)))
+   (PREFIX (OPERAND 'L) (OPCODE-REGISTER target))
+   (BITS (8 (opcode-register #xb8 target))
+	 (32 value UNSIGNED)))
+
+  ((Q (R (? target)) (& (? value signed-quad)))
+   (PREFIX (OPERAND 'Q) (OPCODE-REGISTER target))
+   (BITS (8 (opcode-register #xb8 target))
+	 (64 value SIGNED)))
+
+  ((Q (R (? target)) (&U (? value unsigned-quad)))
+   (PREFIX (OPERAND 'Q) (OPCODE-REGISTER target))
+   (BITS (8 (opcode-register #xb8 target))
+	 (64 value UNSIGNED)))
+
+  ((B (? target r/m-ea) (& (? value signed-byte)))
+   (PREFIX (ModR/M target))
+   (BITS (8 #xc6))
    (ModR/M 0 target)
-   (BYTE (8 value UNSIGNED)))
-
-  ((W (R 0) (@ (? offset)))
-   (BYTE (8 #xa1))
-   (IMMEDIATE offset))
+   (BITS (8 value SIGNED)))
 
-  ((W (@ (? offset)) (R 0))
-   (BYTE (8 #xa3))
-   (IMMEDIATE offset))
+  ((B (? target r/m-ea) (&U (? value unsigned-byte)))
+   (PREFIX (ModR/M target))
+   (BITS (8 #xc6))
+   (ModR/M 0 target)
+   (BITS (8 value UNSIGNED)))
 
-  ((B (R 0) (@ (? offset)))
-   (BYTE (8 #xa0)
-	 (8 offset SIGNED)))
+  ((W (? target r/m-ea) (& (? value signed-word)))
+   (PREFIX (OPERAND 'W) (ModR/M target))
+   (BITS (8 #xc7))
+   (ModR/M 0 target)
+   (BITS (16 value SIGNED)))
 
-  ((B (@ (? offset)) (R 0))
-   (BYTE (8 #xa2)
-	 (8 offset SIGNED)))
-
-  (((? target r/mW) (SR (? source)))
-   (BYTE (8 #x8c))
-   (ModR/M source target))
+  ((W (? target r/m-ea) (&U (? value unsigned-word)))
+   (PREFIX (OPERAND 'W) (ModR/M target))
+   (BITS (8 #xc7))
+   (ModR/M 0 target)
+   (BITS (16 value UNSIGNED)))
 
-  (((SR (? target)) (? source r/mW))
-   (BYTE (8 #x8e))
-   (ModR/M target source))
+  (((? size operand-size) (? target r/m-ea) (& (? value signed-long)))
+   (PREFIX (OPERAND size) (ModR/M target))
+   (BITS (8 #xc7))
+   (ModR/M 0 target)
+   (BITS (32 value SIGNED)))
 
-  (((CR (? creg)) (R (? reg)))
-   (BYTE (8 #x0f)
-	 (8 #x22))
-   (ModR/M creg `(R ,reg)))
-
-  (((R (? reg)) (CR (? creg)))
-   (BYTE (8 #x0f)
-	 (8 #x20))
-   (ModR/M creg `(R ,reg)))
-
-  (((DR (? dreg)) (R (? reg)))
-   (BYTE (8 #x0f)
-	 (8 #x23))
-   (ModR/M dreg `(R ,reg)))
-
-  (((R (? reg)) (DR (? dreg)))
-   (BYTE (8 #x0f)
-	 (8 #x21))
-   (ModR/M dreg `(R ,reg)))
-
-  (((TR (? treg)) (R (? reg)))
-   (BYTE (8 #x0f)
-	 (8 #x26))
-   (ModR/M treg `(R ,reg)))
-
-  (((R (? reg)) (TR (? treg)))
-   (BYTE (8 #x0f)
-	 (8 #x24))
-   (ModR/M treg `(R ,reg))))
+  (((? size operand-size) (? target r/m-ea) (&U (? value unsigned-long)))
+   (PREFIX (OPERAND size) (ModR/M target))
+   (BITS (8 #xc7))
+   (ModR/M 0 target)
+   (BITS (32 value UNSIGNED))))
 
 (define-trivial-instruction NOP #x90)
 
 (define-instruction OUT
-  ((W (& (? port)) (R 0))
-   (BYTE (8 #xe7)
+  ((B (& (? port unsigned-byte)) (R 0))
+   (BITS (8 #xe6)
 	 (8 port)))
 
-  ((W (R 2) (R 0))
-   (BYTE (8 #xef)))
+  ((B (R 2) (R 0))
+   (BITS (8 #xee)))
 
-  ((B (& (? port)) (R 0))
-   (BYTE (8 #xe6)
+  (((? size operand-size) (& (? port unsigned-byte)) (R 0))
+   (PREFIX (OPERAND size))
+   (BITS (8 #xe7)
 	 (8 port)))
 
-  ((B (R 2) (R 0))
-   (BYTE (8 #xee))))
-
+  (((PREFIX (OPERAND size)) (R 2) (R 0))
+   (BITS (8 #xef))))
+
+(define-instruction POPCNT
+  (((? size operand-size) (R (? target)) (? source r/m-ea))
+   (PREFIX (OPERAND size) (ModR/M target source))
+   (BITS (8 #xf3)
+	 (8 #x0f)
+	 (8 #xb8))
+   (ModR/M target source)))
+
+(define-instruction POPF
+  ;; No 8-bit or 32-bit operand sizes available.
+  ((W)
+   (PREFIX (OPERAND 'W))
+   (BITS (8 #x9d)))
+  ((Q)
+   (BITS (8 #x9d))))
+
+(define-instruction PUSHF
+  ;; No 8-bit or 32-bit operand size available.
+  ((W)
+   (PREFIX (OPERAND 'W))
+   (BITS (8 #x9c)))
+  ((Q)
+   (BITS (8 #x9c))))
+
 (define-instruction POP
-  (((R (? target)))
-   (BYTE (8 (+ #x58 target))))
+  ;; No 8-bit or 32-bit register operand size available.
 
-  (((? target mW))
-   (BYTE (8 #x8f))
-   (ModR/M 0 target))
+  ((W (R (? target)))
+   (PREFIX (OPERAND 'W) (OPCODE-REGISTER target))
+   (BITS (8 (opcode-register #x58 target))))
+
+  ((Q (R (? target)))
+   (PREFIX (OPCODE-REGISTER target))	;No operand prefix.
+   (BITS (8 (opcode-register #x58 target))))
 
-  ((ES)
-   (BYTE (8 #x07)))
+  ;; No 8-bit or 32-bit memory operand size available.
 
-  ((SS)
-   (BYTE (8 #x17)))
+  ((W (? target m-ea))
+   (PREFIX (OPERAND 'W) (ModR/M target))
+   (BITS (8 #x8f))
+   (ModR/M 0 target))
 
-  ((DS)
-   (BYTE (8 #x1f)))
+  ((Q (? target m-ea))
+   (PREFIX (ModR/M target))		;No operand prefix.
+   (BITS (8 #x8f))
+   (ModR/M 0 target))
 
   ((FS)
-   (BYTE (8 #x0f)
+   (BITS (8 #x0f)
 	 (8 #xa1)))
 
   ((GS)
-   (BYTE (8 #x0f)
+   (BITS (8 #x0f)
 	 (8 #xa9)))
 
-  (((SR 0))
-   (BYTE (8 #x07)))
-
-  (((SR 2))
-   (BYTE (8 #x17)))
-
-  (((SR 3))
-   (BYTE (8 #x1f)))
-
   (((SR 4))
-   (BYTE (8 #x0f)
+   (BITS (8 #x0f)
 	 (8 #xa1)))
 
   (((SR 5))
-   (BYTE (8 #x0f)
+   (BITS (8 #x0f)
 	 (8 #xa9))))
-
-(define-trivial-instruction POPA #x61)
-(define-trivial-instruction POPAD #x61)
-(define-trivial-instruction POPF #x9d)
-(define-trivial-instruction POPFD #x9d)
 
+;;; The PUSH instruction is capable of pushing 16-bit or 64-bit
+;;; operands onto the stack.  For 16-bit pushes, an immediate operand
+;;; can have eight or sixteen bits, and if it has eight bits then it
+;;; is sign-extended to sixteen; for 64-bit pushes, an immediate
+;;; operand can have eight or thirty-two bits, and in both cases it is
+;;; sign-extended to sixty-four.  Unfortunately, this means that to
+;;; push 64-bit constants we need to use a temporary register, which
+;;; is pretty silly.
+
 (define-instruction PUSH
-  (((R (? source)))
-   (BYTE (8 (+ #x50 source))))
+  ((W (R (? source)))
+   (PREFIX (OPERAND 'W) (OPCODE-REGISTER source))
+   (BITS (8 (opcode-register #x50 source))))
 
-  (((? source mW))
-   (BYTE (8 #xff))
-   (ModR/M 6 source))
+  ((Q (R (? source)))
+   (PREFIX (OPCODE-REGISTER source))	;No operand prefix.
+   (BITS (8 (opcode-register #x50 source))))
 
-  ((W (& (? value)))
-   (BYTE (8 #x68))
-   (IMMEDIATE value))
+  ((W (& (? value sign-extended-byte)))
+   (PREFIX (OPERAND 'W))
+   (BITS (8 #x6a)
+	 (8 value SIGNED)))
+
+  ((W (&U (? value zero-extended-byte)))
+   (PREFIX (OPERAND 'W))
+   (BITS (8 #x6a)
+	 (8 value SIGNED)))
 
-  ((W (&U (? value)))
-   (BYTE (8 #x68))
-   (IMMEDIATE value OPERAND UNSIGNED))
+  ((W (& (? value signed-word)))
+   (PREFIX (OPERAND 'W))
+   (BITS (8 #x68)
+	 (16 value SIGNED)))
 
-  ((B (& (? value)))
-   (BYTE (8 #x6a)
-	 (8 value)))
+  ((W (&U (? value unsigned-word)))
+   (PREFIX (OPERAND 'W))
+   (BITS (8 #x68)
+	 (16 value UNSIGNED)))
+
+  ((Q (& (? value sign-extended-byte)))	;No operand prefix.
+   (BITS (8 #x6a)
+	 (8 value SIGNED)))
 
-  ((B (&U (? value)))
-   (BYTE (8 #x6a)
+  ((Q (&U (? value zero-extended-byte))) ;No operand prefix.
+   (BITS (8 #x6a)
 	 (8 value UNSIGNED)))
 
-  ((ES)
-   (BYTE (8 #x06)))
+  ((Q (& (? value sign-extended-long)))	;No operand prefix.
+   (BITS (8 #x68)
+	 (32 value SIGNED)))
 
-  ((CS)
-   (BYTE (8 #x0e)))
+  ((Q (&U (? value zero-extended-long))) ;No operand prefix.
+   (BITS (8 #x68)
+	 (32 value UNSIGNED)))
 
-  ((SS)
-   (BYTE (8 #x16)))
+  ((W (? source m-ea))
+   (PREFIX (OPERAND 'W) (ModR/M source))
+   (BITS (8 #xff))
+   (ModR/M 6 source))
 
-  ((DS)
-   (BYTE (8 #x1e)))
+  ((Q (? source m-ea))
+   (PREFIX (ModR/M source))		;No operand prefix.
+   (BITS (8 #xff))
+   (ModR/M 6 source))
 
   ((FS)
-   (BYTE (8 #x0f)
+   (BITS (8 #x0f)
 	 (8 #xa0)))
 
   ((GS)
-   (BYTE (8 #x0f)
+   (BITS (8 #x0f)
 	 (8 #xa8)))
 
-  (((SR 0))
-   (BYTE (8 #x06)))
-
-  (((SR 1))
-   (BYTE (8 #x0e)))
-
-  (((SR 2))
-   (BYTE (8 #x16)))
-
-  (((SR 3))
-   (BYTE (8 #x1e)))
-
   (((SR 4))
-   (BYTE (8 #x0f)
+   (BITS (8 #x0f)
 	 (8 #xa0)))
 
   (((SR 5))
-   (BYTE (8 #x0f)
+   (BITS (8 #x0f)
 	 (8 #xa8))))
-
-(define-trivial-instruction PUSHA  #x60)
-(define-trivial-instruction PUSHAD #x60)
-(define-trivial-instruction PUSHF  #x9c)
-(define-trivial-instruction PUSHFD #x9c)
 
 (let-syntax
     ((define-rotate/shift
@@ -347,31 +407,38 @@ USA.
 	 (let ((mnemonic (cadr form))
 	       (digit (caddr form)))
 	   `(define-instruction ,mnemonic
-	     ((W (? operand r/mW) (& 1))
-	      (BYTE (8 #xd1))
-	      (ModR/M ,digit operand))
+	      ((B (? operand r/m-ea) (&U 1))
+	       (PREFIX (ModR/M operand))
+	       (BITS (8 #xd0))
+	       (ModR/M ,digit operand))
 
-	     ((W (? operand r/mW) (& (? value)))
-	      (BYTE (8 #xc1))
-	      (ModR/M ,digit operand)
-	      (BYTE (8 value)))
+	      ((B (? operand r/m-ea) (&U (? value unsigned-byte)))
+	       (PREFIX (ModR/M operand))
+	       (BITS (8 #xc0))
+	       (ModR/M ,digit operand)
+	       (BITS (8 value UNSIGNED)))
 
-	     ((W (? operand r/mW) (R 1))
-	      (BYTE (8 #xd3))
-	      (ModR/M ,digit operand))
+	      ((B (? operand r/m-ea) (R 1))
+	       (PREFIX (ModR/M operand))
+	       (BITS (8 #xd2))
+	       (ModR/M ,digit operand))
 
-	     ((B (? operand r/mB) (& 1))
-	      (BYTE (8 #xd0))
-	      (ModR/M ,digit operand))
+	      (((? size operand-size) (? operand r/m-ea) (&U 1))
+	       (PREFIX (OPERAND size) (ModR/M operand))
+	       (BITS (8 #xd1))
+	       (ModR/M ,digit operand))
 
-	     ((B (? operand r/mB) (& (? value)))
-	      (BYTE (8 #xc0))
-	      (ModR/M ,digit operand)
-	      (BYTE (8 value)))
+	      (((? size operand-size) (? operand r/m-ea)
+				      (&U (? value unsigned-byte)))
+	       (PREFIX (OPERAND size) (ModR/M operand))
+	       (BITS (8 #xc1))
+	       (ModR/M ,digit operand)
+	       (BITS (8 value UNSIGNED)))
 
-	     ((B (? operand r/mB) (R 1))
-	      (BYTE (8 #xd2))
-	      (ModR/M ,digit operand))))))))
+	      (((? size operand-size) (? operand r/m-ea) (R 1))
+	       (PREFIX (OPERAND size) (ModR/M operand))
+	       (BITS (8 #xd3))
+	       (ModR/M ,digit operand))))))))
 
   (define-rotate/shift RCL 2)
   (define-rotate/shift RCR 3)
@@ -389,33 +456,39 @@ USA.
 	 (let ((mnemonic (cadr form))
 	       (opcode (caddr form)))
 	   `(define-instruction ,mnemonic
-	      ((W (? target r/mW) (R (? source)) (& (? count)))
-	       (BYTE (8 #x0f)
+	      (((? size operand-size) (? target r/m-ea)
+				      (R (? source))
+				      (&U (? count unsigned-byte)))
+	       (PREFIX (OPERAND size) (ModR/M target source))
+	       (BITS (8 #x0f)
 		     (8 ,opcode))
 	       (ModR/M target source)
-	       (BYTE (8 count)))
+	       (BITS (8 count)))
 
-	      ((W (? target r/mW) (R (? source)) (R 1))
-	       (BYTE (8 #x0f)
-		     (8 ,(1+ opcode)))
-	       (ModR/M target source))))))))
+	      (((? size operand-size) (? target r/m-ea)
+				      (R (? source))
+				      (R 1))
+	       (PREFIX (OPERAND size) (ModR/M source target))
+	       (BITS (8 #x0f)
+		     (8 ,(+ opcode 1)))
+	       (ModR/M source target))))))))
 
   (define-double-shift SHLD #xa4)
   (define-double-shift SHRD #xac))
 
 (define-instruction RET
   (()
-   (BYTE (8 #xc3)))
+   (BITS (8 #xc3)))
 
   ((F)
-   (BYTE (8 #xcb)))
+   (BITS (8 #xcb)))
 
-  (((& (? frame-size)))
-   (BYTE (8 #xc2)
+  (((&U (? frame-size unsigned-word)))
+   (BITS (8 #xc2)
 	 (16 frame-size)))
 
-  ((F (& (? frame-size)))
-   (BYTE (8 #xca)
+  ((F (&U (? frame-size unsigned-word)))
+   (BITS (8 #xca)
 	 (16 frame-size))))
 
 (define-trivial-instruction SAHF #x9e)
@@ -428,10 +501,11 @@ USA.
 	 (let ((mnemonic (cadr form))
 	       (opcode (caddr form)))
 	   `(define-instruction ,mnemonic
-	      (((? target r/mB))
-	       (BYTE (8 #x0f)
+	      (((? target r/m-ea))
+	       (PREFIX (ModR/M target))
+	       (BITS (8 #x0f)
 		     (8 ,opcode))
-	       (ModR/M 0 target))))))))	; 0?
+	       (ModR/M 0 target))))))))
 
   (define-setcc-instruction SETA   #x97)
   (define-setcc-instruction SETAE  #x93)
@@ -469,86 +543,127 @@ USA.
 (define-trivial-instruction STI #xfb)
 
 (define-instruction TEST
-  ((W (? op1 r/mW) (R (? op2)))
-   (BYTE (8 #x85))
-   (ModR/M op2 op1))
-
-  ((W (R 0) (& (? value)))
-   (BYTE (8 #xa9))
-   (IMMEDIATE value))
-
-  ((W (R 0) (&U (? value)))
-   (BYTE (8 #xa9))
-   (IMMEDIATE value OPERAND UNSIGNED))
-
-  ((W (? op1 r/mW) (& (? value)))
-   (BYTE (8 #xf7))
-   (ModR/M 0 op1)
-   (IMMEDIATE value))
-
-  ((W (? op1 r/mW) (&U (? value)))
-   (BYTE (8 #xf7))
-   (ModR/M 0 op1)
-   (IMMEDIATE value OPERAND UNSIGNED))
-
-  ((B (? op1 r/mB) (R (? op2)))
-   (BYTE (8 #x84))
-   (ModR/M op2 op1))
-
-  ((B (R 0) (& (? value)))
-   (BYTE (8 #xa8)
+  ((B (R 0) (& (? value signed-byte)))
+   (BITS (8 #xa8)
 	 (8 value SIGNED)))
 
-  ((B (R 0) (&U (? value)))
-   (BYTE (8 #xa8)
-	 (8 value UNSIGNED)))
+  ((W (R 0) (& (? value signed-word)))
+   (PREFIX (OPERAND 'W))
+   (BITS (8 #xa9)
+	 (16 value SIGNED)))
 
-  ((B (? op1 r/mB) (& (? value)))
-   (BYTE (8 #xf6))
-   (ModR/M 0 op1)
-   (BYTE (8 value SIGNED)))
+  (((? size operand-size) (R 0) (& (? value signed-long)))
+   (PREFIX (OPERAND size))
+   (BITS (8 #xa9)
+	 (32 value SIGNED)))
+
+  ((B (R 0) (&U (? value unsigned-byte)))
+   (BITS (8 #xa8)
+	 (8 value UNSIGNED)))
 
-  ((B (? op1 r/mB) (&U (? value)))
-   (BYTE (8 #xf6))
-   (ModR/M 0 op1)
-   (BYTE (8 value UNSIGNED))))
+  ((W (R 0) (&U (? value unsigned-word)))
+   (PREFIX (OPERAND 'W))
+   (BITS (8 #xa9)
+	 (16 value UNSIGNED)))
+
+  (((? size operand-size) (R 0) (&U (? value unsigned-long)))
+   (PREFIX (OPERAND size))
+   (BITS (8 #xa9)
+	 (32 value UNSIGNED)))
+
+  ((B (? operand r/m-ea) (& (? value signed-byte)))
+   (PREFIX (ModR/M operand))
+   (BITS (8 #xf6))
+   (ModR/M 0 operand)
+   (BITS (8 value SIGNED)))
+
+  ((W (? operand r/m-ea) (& (? value signed-word)))
+   (PREFIX (OPERAND 'W) (ModR/M operand))
+   (BITS (8 #xf7))
+   (ModR/M 0 operand)
+   (BITS (16 value SIGNED)))
+
+  (((? size operand-size) (? operand r/m-ea) (& (? value signed-long)))
+   (PREFIX (OPERAND size) (ModR/M operand))
+   (BITS (8 #xf7))
+   (ModR/M 0 operand)
+   (BITS (32 value SIGNED)))
+
+  ((B (? operand r/m-ea) (&U (? value unsigned-byte)))
+   (PREFIX (ModR/M operand))
+   (BITS (8 #xf6))
+   (ModR/M 0 operand)
+   (BITS (8 value UNSIGNED)))
+
+  ((W (? operand r/m-ea) (&U (? value unsigned-word)))
+   (PREFIX (OPERAND 'W) (ModR/M operand))
+   (BITS (8 #xf7))
+   (ModR/M 0 operand)
+   (BITS (16 value UNSIGNED)))
+
+  (((? size operand-size) (? operand r/m-ea) (&U (? value unsigned-long)))
+   (PREFIX (OPERAND size) (ModR/M operand))
+   (BITS (8 #xf7))
+   (ModR/M 0 operand)
+   (BITS (32 value UNSIGNED)))
+
+  ((B (? r/m r/m-ea) (R (? reg)))
+   (PREFIX (ModR/M reg r/m))
+   (BITS (8 #x84))
+   (ModR/M reg r/m))
+
+  (((? size operand-size) (? r/m r/m-ea) (R (? reg)))
+   (PREFIX (OPERAND size) (ModR/M reg r/m))
+   (BITS (8 #x85))
+   (ModR/M reg r/m)))
 
 (define-trivial-instruction WAIT #x9b)		; = (FWAIT)
 (define-trivial-instruction WBINVD #x0f #x09)	; 486 only
 
 (define-instruction XADD			; 486 only
-  ((W (? target r/mW) (R (? source)))
-   (BYTE (8 #x0f)
-	 (8 #xc1))
+  ((B (? target r/m-ea) (R (? source)))
+   (PREFIX (ModR/M source target))
+   (BITS (8 #x0f)
+	 (8 #xc0))
    (ModR/M source target))
 
-  ((B (? target r/mB) (R (? source)))
-   (BYTE (8 #x0f)
-	 (8 #xc0))
+  (((? size operand-size) (? target r/m-ea) (R (? source)))
+   (PREFIX (OPERAND size) (ModR/M source target))
+   (BITS (8 #x0f)
+	 (8 #xc1))
    (ModR/M source target)))
 
 (define-instruction XCHG
-  ((W (R 0) (R (? reg)))
-   (BYTE (8 (+ #x90 reg))))
+  ;; Register->register exchanges are symmetrical, but can be done
+  ;; only if one if the registers is AX/EAX/RAX.
 
-  ((W (R (? reg)) (R 0))
-   (BYTE (8 (+ #x90 reg))))
+  (((? size operand-size) (R 0) (R (? reg)))
+   (PREFIX (OPERAND size) (OPCODE-REGISTER reg))
+   (BITS (8 (opcode-register #x90 reg))))
 
-  ((W (R (? reg)) (? op r/mW))
-   (BYTE (8 #x87))
-   (ModR/M reg op))
+  (((? size operand-size) (R (? reg)) (R 0))
+   (PREFIX (OPERAND size) (OPCODE-REGISTER reg))
+   (BITS (8 (opcode-register #x90 reg))))
 
-  ((W (? op r/mW) (R (? reg)))
-   (BYTE (8 #x87))
-   (ModR/M reg op))
+  ((B (? r/m r/m-ea) (R (? reg)))
+   (PREFIX (ModR/M reg r/m))
+   (BITS (8 #x86))
+   (ModR/M reg r/m))
 
-  ((B (R (? reg)) (? op r/mB))
-   (BYTE (8 #x86))
-   (ModR/M reg op))
+  ((B (R (? reg)) (? r/m r/m-ea))
+   (PREFIX (ModR/M reg r/m))
+   (BITS (8 #x86))
+   (ModR/M reg r/m))
 
-  ((B (? op r/mB) (R (? reg)))
-   (BYTE (8 #x86))
-   (ModR/M reg op)))
+  (((? size operand-size) (? r/m r/m-ea) (R (? reg)))
+   (PREFIX (OPERAND size) (ModR/M reg r/m))
+   (BITS (8 #x87))
+   (ModR/M reg r/m))
+
+  (((? size operand-size) (R (? reg)) (? r/m r/m-ea))
+   (PREFIX (OPERAND size) (ModR/M reg r/m))
+   (BITS (8 #x87))
+   (ModR/M reg r/m)))
 
 (define-trivial-instruction XLAT #xd7)
 
@@ -569,10 +684,4 @@ USA.
 (define-trivial-instruction FSSEG #x64)
 (define-trivial-instruction GSSEG #x65)
 
-;; **** These are broken.  The assembler needs to change state, i.e.
-;; fluid-let *OPERAND-SIZE* or *ADDRESS-SIZE*. ****
-
-(define-trivial-instruction OPSIZE #x66)
-(define-trivial-instruction ADSIZE #x67)
-
 ;; **** Missing MOV instruction to/from special registers. ****
\ No newline at end of file