From d350f9f3d63ca3a3750c9110ebf961b49b0467ba Mon Sep 17 00:00:00 2001
From: Taylor R Campbell <campbell@mumble.net>
Date: Mon, 2 Nov 2009 22:58:38 -0500
Subject: [PATCH] Simplify x86-64 addressing mode syntax.

*** NOTE:  Since this changes machines/x86-64/insmac.scm, you must
resyntax the compiler afresh, e.g. by running

scheme --band runtime.com <<EOF
(for-each load-option '(SF CREF))
(load "compiler.sf")
EOF

Otherwise, the compiler will expand machines/x86-64/insutl.scm using
the old macro definitions, not the new ones, and grow very confused.
Using the host compiler's macros is pretty bogus.
---
 src/compiler/machines/x86-64/insmac.scm |  90 +++-
 src/compiler/machines/x86-64/insutl.scm | 560 ++++++------------------
 src/compiler/machines/x86-64/lapgen.scm |  26 +-
 src/compiler/machines/x86-64/rules1.scm |   2 +-
 src/compiler/machines/x86-64/rules3.scm |  28 +-
 5 files changed, 235 insertions(+), 471 deletions(-)

diff --git a/src/compiler/machines/x86-64/insmac.scm b/src/compiler/machines/x86-64/insmac.scm
index 90302a524..9f8dede03 100644
--- a/src/compiler/machines/x86-64/insmac.scm
+++ b/src/compiler/machines/x86-64/insmac.scm
@@ -51,21 +51,22 @@ USA.
        ,ea-database-name
        ,(compile-database (cdr form) environment
 	  (lambda (pattern actions)
+	    (if (not (and (list? actions)
+			  (<= 4 (length actions))))
+		(error "Malformed effective address rule:" pattern actions))
 	    (let ((keyword (car pattern))
 		  (categories (list-ref actions 0))
-		  (rex-prefix (list-ref actions 1))
+		  (rex (list-ref actions 1))
 		  (mode (list-ref actions 2))
-		  (register (list-ref actions 3))
-		  (tail (list-tail actions 4)))
+		  (r/m (list-ref actions 3))
+		  (extra (list-tail actions 4)))
 	      `(,(close-syntax 'MAKE-EFFECTIVE-ADDRESS environment)
-		',keyword
-		',categories
-		',rex-prefix
-		,(integer-syntaxer mode environment 'UNSIGNED 2)
-		,(integer-syntaxer register environment 'UNSIGNED 3)
-		,(if (null? tail)
-		     `(,(close-syntax 'QUOTE environment) ())
-		     (process-fields tail #f environment))))))))))
+		(,(close-syntax 'QUOTE environment) ,keyword)
+		,(parse-categories categories environment pattern)
+		,(parse-rex rex environment pattern)
+		,(parse-mode mode environment pattern)
+		,(parse-r/m r/m environment pattern)
+		,(parse-extra extra environment pattern)))))))))
 
 ;; This one is necessary to distinguish between r/m-ea, m-ea, etc.
 
@@ -84,6 +85,67 @@ USA.
 			`(MATCH-RESULT)))))
 	 (ill-formed-syntax form)))))
 
+(define (parse-categories categories environment context)
+  ;; At the moment only one category at a time is supported.
+  (if (not (and (pair? categories)
+		(eq? 'CATEGORIES (car categories))
+		(pair? (cdr categories))
+		(memq (cadr categories) '(REGISTER MEMORY))
+		(null? (cddr categories))))
+      (error "Malformed CATEGORIES for effective address rule:"
+	     categories
+	     context))
+  `(,(close-syntax 'QUOTE environment) ,(cdr categories)))
+
+(define (parse-rex rex environment context)
+  (define (expression:ior a b)
+    (if (and (integer? a) (integer? b))
+	(fix:or a b)
+	`(,(close-syntax 'FIX:OR environment) ,a ,b)))
+  (define (rex-bits name)
+    (case name
+      ((W) #x48) ((R) #x44) ((X) #x42) ((B) #x41)
+      (else (error "Malformed REX bit name:" name context))))
+  (if (not (and (pair? rex) (eq? 'REX (car rex)) (list? (cdr rex))))
+      (error "Malformed REX prefix for effective address rule:" rex context))
+  (let loop ((terms (cdr rex)) (expression 0))
+    (if (not (pair? terms))
+	expression
+	(loop (cdr terms)
+	      (expression:ior
+	       expression
+	       (let ((term (car terms)))
+		 (if (pair? term)
+		     (begin
+		       (if (not (and (pair? (cdr term)) (null? (cddr term))))
+			   (error "Malformed REX prefix term:" term context))
+		       `(,(close-syntax 'REGISTER-REX environment)
+			 ,(cadr term)
+			 ,(rex-bits (car term))))
+		     (rex-bits term))))))))
+
+(define (parse-mode mode environment context)
+  (if (not (and (pair? mode)
+		(eq? 'MODE (car mode))
+		(pair? (cdr mode))
+		(null? (cddr mode))))
+      (error "Malformed MODE for effective address rule:" mode context))
+  (integer-syntaxer (cadr mode) environment 'UNSIGNED 2))
+
+(define (parse-r/m r/m environment context)
+  (if (not (and (pair? r/m)
+		(eq? 'R/M (car r/m))
+		(pair? (cdr r/m))
+		(null? (cddr r/m))))
+      (error "Malformed R/M for effective address rule:" r/m context))
+  (integer-syntaxer (cadr r/m) environment 'UNSIGNED 3))
+
+(define (parse-extra extra environment context)
+  context				;ignore
+  (if (pair? extra)
+      (process-fields extra #f environment)
+      `(,(close-syntax 'QUOTE environment) ())))
+
 (define (parse-instruction opcode tail early? environment)
   (process-fields (cons opcode tail) early? environment))
 
@@ -111,7 +173,7 @@ USA.
 		     (error "Bad clause size:" size))
 		 `(,code ,size ,@(car clause))))
 	     clauses)))))
-
+
 (define (expand-fields fields early? environment)
   (if (pair? fields)
       (receive (tail tail-size) (expand-fields (cdr fields) early? environment)
@@ -123,7 +185,7 @@ USA.
 	   (receive (code size) (collect-bits (cdar fields) tail environment)
 	     (values code (+ size tail-size))))
 	  ((PREFIX)
-	   ;; (PREFIX (OPERAND size) (REGISTER [reg]) (EA ea))
+	   ;; (PREFIX (OPERAND size) (REGISTER [reg]) (ModR/M [reg] r/m))
 	   (if early?
 	       (error "No early support for PREFIX -- Fix x86-64/insmac.scm"))
 	   (values (collect-prefix (cdar fields) tail environment) -1))
@@ -136,7 +198,7 @@ USA.
 	  (else
 	   (error "Unknown field kind:" (caar fields)))))
       (values `(,(close-syntax 'QUOTE environment) ()) 0)))
-
+
 (define (collect-bits components tail environment)
   (let loop ((components components))
     (if (pair? components)
diff --git a/src/compiler/machines/x86-64/insutl.scm b/src/compiler/machines/x86-64/insutl.scm
index 99379a9d5..752816b21 100644
--- a/src/compiler/machines/x86-64/insutl.scm
+++ b/src/compiler/machines/x86-64/insutl.scm
@@ -36,450 +36,149 @@ USA.
 
 ;;;; Register
 
-  ((R (? r extended-reg))
-   (REGISTER)
-   #x41 #b11 r)
-
   ((R (? r))
-   (REGISTER)
-   0 #b11 r)
+   (CATEGORIES REGISTER)
+   (REX (B r))
+   (MODE #b11)
+   (R/M (register-bits r)))
 
 ;;;; Register-indirect
 
-  ((@R (? r extended-indirect-reg))
-   (MEMORY)
-   #x41 #b00 r)
-
   ((@R (? r indirect-reg))
-   (MEMORY)
-   0 #b00 r)
-
-  ;; Mode of 0 with R/M of 4 means that what follows is a SIB format,
-  ;; and R/M of 5 means that what follows is a PC-relative immediate
-  ;; offset (in 64-bit mode), so we must have special cases for rsp,
-  ;; rbp, r12, and r13.
-
-  ;; SIB format, with no scale.
-  ((@R 4)				; rsp
-   (MEMORY)
-   0 #b00 4
+   (CATEGORIES MEMORY)
+   (REX (B r))
+   (MODE #b00)
+   (R/M (register-bits r)))
+
+  ;; Mode #b00, r/m 4 means SIB, so put the register in a SIB base and
+  ;; use no index (i.e. index of 4).
+
+  ((@R (? r indirect-reg=4mod8))
+   (CATEGORIES MEMORY)
+   (REX (B r))
+   (MODE #b00)
+   (R/M 4)
    (BITS (3 4)
 	 (3 4)
 	 (2 0)))
 
-  ;; rbp plus offset, with zero offset.
-  ((@R 5)				; rbp
-   (MEMORY)
-   0 #b01 5
-   (BITS (8 0)))
-
-  ;; SIB format, with no scale.
-  ((@R 12)
-   (MEMORY)
-   #x41 #b00 4
-   (BITS (3 4)
-	 (3 4)
-	 (2 0)))
+  ;; Mode #b00, r/m 5 means RIP-relative 32-bit offset, so use mode
+  ;; #b01, r/m 5, which means the register plus 8-bit offset, and
+  ;; specify a zero offset.
 
-  ;; r13 plus offset, with zero offset.
-  ((@R 13)
-   (MEMORY)
-   #x41 #b01 5
+  ((@R (? r indirect-reg=5mod8))
+   (CATEGORIES MEMORY)
+   (REX (B r))
+   (MODE #b01)
+   (R/M 5)
    (BITS (8 0)))
 
-;;;; Register-indirect with 8-bit Offset
+;;;; Register-indirect with 8-bit offset
 
-  ;; Mode of #b01 with R/M of 13 means SIB plus offset, so we must
-  ;; have special cases for rsp and r12.
-
-  ((@RO B (? r extended-index-reg) (? offset))
-   (MEMORY)
-   #x41 #b01 r
-   (BITS (8 offset SIGNED)))
-
-  ((@RO B (? r index-reg) (? offset))
-   (MEMORY)
-   0 #b01 r
+  ((@RO (? r offset-indirect-reg) (? offset sign-extended-byte))
+   (CATEGORIES MEMORY)
+   (REX (B r))
+   (MODE #b01)
+   (R/M (register-bits r))
    (BITS (8 offset SIGNED)))
 
-  ((@RO UB (? r extended-index-reg) (? offset))
-   (MEMORY)
-   #x41 #b01 r
-   (BITS (8 offset UNSIGNED)))
-
-  ((@RO UB (? r index-reg) (? offset))
-   (MEMORY)
-   0 #b01 r
-   (BITS (8 offset UNSIGNED)))
-
-  ((@RO B 4 (? offset))			; rsp
-   (MEMORY)
-   0 #b01 4
-   (BITS (3 4)
-	 (3 4)
-	 (2 0)
-	 (8 offset SIGNED)))
+  ;; Mode #b01, r/m 4 means SIB plus 8-bit offset, so use the SIB base
+  ;; for the register with no index (i.e. index of 4).
 
-  ((@RO B 12 (? offset))
-   (MEMORY)
-   #x41 #b01 4
+  ((@RO (? r offset-indirect-reg=4mod8) (? offset sign-extended-byte))
+   (CATEGORIES MEMORY)
+   (REX (B r))
+   (MODE #b01)
+   (R/M 4)
    (BITS (3 4)
 	 (3 4)
 	 (2 0)
 	 (8 offset SIGNED)))
 
-  ((@RO UB 4 (? offset))
-   (MEMORY)
-   0 #b01 4
-   (BITS (3 4)
-	 (3 4)
-	 (2 0)
-	 (8 offset UNSIGNED)))
+;;;; Register-indirect with 32-bit offset
 
-  ((@RO UB 12 (? offset))
-   (MEMORY)
-   #x41 #b01 4
-   (BITS (3 4)
-	 (3 4)
-	 (2 0)
-	 (8 offset UNSIGNED)))
-
-;;;; Register-indirect with 32-bit Offset
-
-  ((@RO L (? r extended-index-reg) (? offset signed-long))
-   (MEMORY)
-   #x41 #b10 r
+  ((@RO (? r offset-indirect-reg) (? offset sign-extended-long))
+   (CATEGORIES MEMORY)
+   (REX (B r))
+   (MODE #b10)
+   (R/M (register-bits r))
    (BITS (32 offset SIGNED)))
 
-  ((@RO L (? r index-reg) (? offset signed-long))
-   (MEMORY)
-   0 #b10 r
-   (BITS (32 offset SIGNED)))
+  ;; Same special case as above, but with 32-bit offsets.
 
-  ((@RO L 4 (? offset signed-long))	; rsp
-   (MEMORY)
-   0 #b10 #b100
+  ((@RO (? r offset-indirect-reg=4mod8) (? offset sign-extended-long))
+   (CATEGORIES MEMORY)
+   (REX (B r))
+   (MODE #b10)
+   (R/M 4)
    (BITS (3 4)
 	 (3 4)
 	 (2 0)
 	 (32 offset SIGNED)))
 
-  ((@RO L 12 (? offset signed-long))
-   (MEMORY)
-   #x41 #b10 #b100
-   (BITS (3 4)
-	 (3 4)
-	 (2 0)
-	 (32 offset SIGNED)))
-
-  ((@RO UL (? r extended-index-reg) (? offset unsigned-long))
-   (MEMORY)
-   #x41 #b10 r
-   (BITS (32 offset UNSIGNED)))
+;;;; Register-indirect with index
 
-  ((@RO UL (? r index-reg) (? offset unsigned-long))
-   (MEMORY)
-   0 #b10 r
-   (BITS (32 offset UNSIGNED)))
-
-  ((@RO UL 4 (? offset unsigned-long))	; rsp
-   (MEMORY)
-   0 #b10 #b100
-   (BITS (3 4)
-	 (3 4)
-	 (2 0)
-	 (32 offset UNSIGNED)))
-
-  ((@RO UL 12 (? offset unsigned-long))
-   (MEMORY)
-   #x41 #b10 #b100
-   (BITS (3 4)
-	 (3 4)
-	 (2 0)
-	 (32 offset UNSIGNED)))
-   
-;;;; Register-indirect Indexed
-
-  ((@RI (? b extended-base-reg) (? i extended-index-reg) (? s index-scale))
-   (MEMORY)
-   #x43 #b00 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)))
-   
-  ((@RI (? b extended-base-reg) (? i index-reg) (? s index-scale))
-   (MEMORY)
-   #x41 #b00 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)))
-   
-  ((@RI (? b base-reg) (? i extended-index-reg) (? s index-scale))
-   (MEMORY)
-   #x42 #b00 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)))
-   
   ((@RI (? b base-reg) (? i index-reg) (? s index-scale))
-   (MEMORY)
-   0 #b00 #b100
-   (BITS (3 b)
-	 (3 i)
+   (CATEGORIES MEMORY)
+   (REX (B b) (X i))
+   (MODE #b00)
+   (R/M 4)
+   (BITS (3 (register-bits b))
+	 (3 (register-bits i))
 	 (2 s)))
 
-  ((@RI 5 (? i extended-index-reg) (? s index-scale)) ; rbp
-   (MEMORY)
-   #x42 #b01 #b100
-   (BITS (3 5)
-	 (3 i)
-	 (2 s)
-	 (8 0)))
-
-  ((@RI 5 (? i index-reg) (? s index-scale)) ; rbp
-   (MEMORY)
-   0 #b01 #b100
-   (BITS (3 5)
-	 (3 i)
-	 (2 s)
-	 (8 0)))
-
-  ((@RI 13 (? i extended-index-reg) (? s index-scale))
-   (MEMORY)
-   #x43 #b01 #b100
-   (BITS (3 5)
-	 (3 i)
-	 (2 s)
-	 (8 0)))
+  ;; Mode 0, r/m 4, SIB base 5 mean the register plus 32-bit offset,
+  ;; so specify a zero offset.
 
-  ((@RI 13 (? i index-reg) (? s index-scale))
-   (MEMORY)
-   #x41 #b01 #b100
+  ((@RI (? b base-reg=5mod8) (? i index-reg) (? s index-scale))
+   (CATEGORIES MEMORY)
+   (REX (B b) (X i))
+   (MODE #b01)
+   (R/M 4)
    (BITS (3 5)
-	 (3 i)
+	 (3 (register-bits i))
 	 (2 s)
 	 (8 0)))
 
-;;;; Register-indirect with Offset, Indexed
-
-  ((@ROI B (? b extended-reg) (? offset signed-byte) (? i extended-index-reg)
-	 (? s index-scale))
-   (MEMORY)
-   #x43 #b01 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (8 offset SIGNED)))
-
-  ((@ROI B (? b extended-reg) (? offset signed-byte) (? i index-reg)
-	 (? s index-scale))
-   (MEMORY)
-   #x41 #b01 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (8 offset SIGNED)))
-
-  ((@ROI B (? b) (? offset signed-byte) (? i extended-index-reg)
-	 (? s index-scale))
-   (MEMORY)
-   #x42 #b01 #b100
-   (BITS (3 b)
-	 (3 i)
+;;;; Register-indirect with offset and scaled index
+
+  ;; No more special cases -- except that rsp can't be the index
+  ;; register at all here.
+
+  ((@ROI (? b) (? offset sign-extended-byte) (? i index-reg) (? s index-scale))
+   (CATEGORIES MEMORY)
+   (REX (B b) (X i))
+   (MODE #b01)
+   (R/M 4)
+   (BITS (3 (register-bits b))
+	 (3 (register-bits i))
 	 (2 s)
 	 (8 offset SIGNED)))
 
-  ((@ROI B (? b) (? offset signed-byte) (? i index-reg) (? s index-scale))
-   (MEMORY)
-   0 #b01 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (8 offset SIGNED)))
-
-  ((@ROI UB (? b extended-reg) (? offset unsigned-byte)
-	 (? i extended-index-reg) (? s index-scale))
-   (MEMORY)
-   #x43 #b01 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (8 offset UNSIGNED)))
-
-  ((@ROI UB (? b extended-reg) (? offset unsigned-byte) (? i index-reg)
-	 (? s index-scale))
-   (MEMORY)
-   #x41 #b01 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (8 offset UNSIGNED)))
-
-  ((@ROI UB (? b) (? offset unsigned-byte) (? i extended-index-reg)
-	 (? s index-scale))
-   (MEMORY)
-   #x42 #b01 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (8 offset UNSIGNED)))
-
-  ((@ROI UB (? b) (? offset unsigned-byte) (? i index-reg) (? s index-scale))
-   (MEMORY)
-   0 #b01 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (8 offset UNSIGNED)))
-
-  ((@ROI W (? b extended-reg) (? offset signed-word) (? i extended-index-reg)
-	 (? s index-scale))
-   (MEMORY)
-   #x43 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (16 offset SIGNED)))
-
-  ((@ROI W (? b extended-reg) (? offset signed-word) (? i index-reg)
-	 (? s index-scale))
-   (MEMORY)
-   #x41 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (16 offset SIGNED)))
-
-  ((@ROI W (? b) (? offset signed-word) (? i extended-index-reg)
-	 (? s index-scale))
-   (MEMORY)
-   #x42 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (16 offset SIGNED)))
-
-  ((@ROI W (? b) (? offset signed-word) (? i index-reg) (? s index-scale))
-   (MEMORY)
-   0 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (16 offset SIGNED)))
-
-  ((@ROI UW (? b extended-reg) (? offset unsigned-word)
-	 (? i extended-index-reg) (? s index-scale))
-   (MEMORY)
-   #x43 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (16 offset UNSIGNED)))
-
-  ((@ROI UW (? b extended-reg) (? offset unsigned-word) (? i index-reg)
-	 (? s index-scale))
-   (MEMORY)
-   #x41 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (16 offset UNSIGNED)))
-
-  ((@ROI UW (? b) (? offset unsigned-word) (? i extended-index-reg)
-	 (? s index-scale))
-   (MEMORY)
-   #x42 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (16 offset UNSIGNED)))
-
-  ((@ROI UW (? b) (? offset unsigned-word) (? i index-reg) (? s index-scale))
-   (MEMORY)
-   0 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (16 offset UNSIGNED)))
-
-  ((@ROI L (? b extended-reg) (? offset signed-long) (? i extended-index-reg)
-	 (? s index-scale))
-   (MEMORY)
-   #x43 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (32 offset SIGNED)))
-
-  ((@ROI L (? b extended-reg) (? offset signed-long) (? i index-reg)
-	 (? s index-scale))
-   (MEMORY)
-   #x41 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (32 offset SIGNED)))
-
-  ((@ROI L (? b) (? offset signed-long) (? i extended-index-reg)
-	 (? s index-scale))
-   (MEMORY)
-   #x42 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
+  ((@ROI (? b) (? offset sign-extended-long) (? i index-reg) (? s index-scale))
+   (CATEGORIES MEMORY)
+   (REX (B b) (X i))
+   (MODE #b10)
+   (R/M 4)
+   (BITS (3 (register-bits b))
+	 (3 (register-bits i))
 	 (2 s)
 	 (32 offset SIGNED)))
 
-  ((@ROI L (? b) (? offset signed-long) (? i index-reg) (? s index-scale))
-   (MEMORY)
-   0 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (32 offset SIGNED)))
-
-  ((@ROI UL (? b extended-reg) (? offset unsigned-long)
-	 (? i extended-index-reg) (? s index-scale))
-   (MEMORY)
-   #x43 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (32 offset UNSIGNED)))
-
-  ((@ROI UL (? b extended-reg) (? offset unsigned-long) (? i index-reg)
-	 (? s index-scale))
-   (MEMORY)
-   #x41 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (32 offset UNSIGNED)))
-
-  ((@ROI UL (? b) (? offset unsigned-long) (? i extended-index-reg)
-	 (? s index-scale))
-   (MEMORY)
-   #x42 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (32 offset UNSIGNED)))
-
-  ((@ROI UL (? b) (? offset unsigned-long) (? i index-reg) (? s index-scale))
-   (MEMORY)
-   0 #b10 #b100
-   (BITS (3 b)
-	 (3 i)
-	 (2 s)
-	 (32 offset UNSIGNED)))
+;;;; RIP-relative (PC-relative)
 
   ((@PCR (? label))
-   (MEMORY)
-   0 #b00 #b101
+   (CATEGORIES MEMORY)
+   (REX)
+   (MODE #b00)
+   (R/M 5)
    (BITS (32 `(- ,label (+ *PC* 4)) SIGNED)))
 
-  ((@PCO (? offset))
-   (MEMORY)
-   0 #b00 #b101
+  ((@PCO (? offset signed-long))
+   (CATEGORIES MEMORY)
+   (REX)
+   (MODE #b00)
+   (R/M 5)
    (BITS (32 offset SIGNED))))
 
 (define-ea-transformer r/m-ea)
@@ -495,7 +194,14 @@ USA.
   (register #f read-only #t)
   (extra '() read-only #t))
 
-(define (cons-prefix operand-size register r/m tail)
+(declare (integrate-operator register-rex))
+(define-integrable (register-rex register rex)
+  (declare (integrate register))
+  (if (>= register r8)
+      rex
+      0))
+
+(define (cons-prefix operand-size register ea tail)
   (let ((tail
 	 (if (eq? operand-size 'W)
 	     (cons-syntax (syntax-evaluation #x66 coerce-8-bit-unsigned)
@@ -517,11 +223,11 @@ USA.
       (let ((extended-register?
 	     (or (eqv? register #t)
 		 (and register (>= register r8)))))
-	(if r/m
-	    (fix:or (if extended-register? #x44 0) (ea/rex-prefix r/m))
+	(if ea
+	    (fix:or (if extended-register? #x44 0) (ea/rex-prefix ea))
 	    (if extended-register? #x41 0)))))))
 
-(define (cons-modr/m digit ea tail)
+(define (cons-ModR/M digit ea tail)
   (cons-syntax (ea/register ea)
     (cons-syntax digit
       (cons-syntax (ea/mode ea)
@@ -538,40 +244,52 @@ USA.
     ((W L Q) s)
     (else #f)))
 
-(define (extended-reg r)
-  (and (>= r r8)
-       (- r r8)))
+(define-integrable (register-bits r)
+  (fix:and r #b111))
 
+(declare (integrate-operator indirect-reg))
 (define (indirect-reg r)
-  (and (< r r8)
-       (not (= r rsp))
-       (not (= r rbp))
+  (and (not (let ((bits (register-bits r)))
+	      (or (= bits 4)
+		  (= bits 5))))
+       r))
+
+(declare (integrate-operator indirect-reg=4mod8))
+(define (indirect-reg=4mod8 r)
+  (and (= (register-bits r) 4)
+       r))
+
+(declare (integrate-operator indirect-reg=5mod8))
+(define (indirect-reg=5mod8 r)
+  (and (= (register-bits r) 5)
+       r))
+
+(declare (integrate-operator offset-indirect-reg))
+(define (offset-indirect-reg r)
+  (and (not (= (register-bits r) 4))
        r))
 
-(define (extended-indirect-reg r)
-  (and (not (= r r12))
-       (not (= r r13))
-       (extended-reg r)))
+(declare (integrate-operator offset-indirect-reg=4mod8))
+(define (offset-indirect-reg=4mod8 r)
+  (and (= (register-bits r) 4)
+       r))
 
+(declare (integrate-operator base-reg))
 (define (base-reg r)
-  (and (< r r8)
-       (not (= r rbp))
+  (and (not (= (register-bits r) 5))
        r))
 
-(define (extended-base-reg r)
-  (and (not (= r r13))
-       (extended-reg r)))
+(declare (integrate-operator base-reg=5mod8))
+(define (base-reg=5mod8 r)
+  (and (= (register-bits r) 5)
+       r))
 
+(declare (integrate-operator index-reg))
 (define (index-reg r)
-  (and (< r r8)
-       (not (= r rsp))
+  (and (not (= r 4))
        r))
 
-(define (extended-index-reg r)
-  (and (not (= r r12))
-       (extended-reg r)))
-
-(define (index-scale scale-value)
+(define-integrable (index-scale scale-value)
   (case scale-value
     ((1) #b00)
     ((2) #b01)
diff --git a/src/compiler/machines/x86-64/lapgen.scm b/src/compiler/machines/x86-64/lapgen.scm
index 84cfbf320..2d504ed61 100644
--- a/src/compiler/machines/x86-64/lapgen.scm
+++ b/src/compiler/machines/x86-64/lapgen.scm
@@ -201,18 +201,9 @@ USA.
   (fits-in-signed-long? offset))
 
 (define (byte-offset-reference register offset)
-  (cond ((zero? offset)
-	 (INST-EA (@R ,register)))
-	((fits-in-signed-byte? offset)
-	 (INST-EA (@RO B ,register ,offset)))
-	;; Assume that we are in 32-bit mode or in 64-bit mode, in
-	;; which case (@RO W ...) doesn't work.
-	;; ((fits-in-signed-word? offset)
-	;;  (INST-EA (@RO W ,register ,offset)))
-	((fits-in-signed-long? offset)
-	 (INST-EA (@RO L ,register ,offset)))
-	(else
-	 (error "Offset too large:" offset))))
+  (if (zero? offset)
+      (INST-EA (@R ,register))
+      (INST-EA (@RO ,register ,offset))))
 
 (define-integrable (byte-unsigned-offset-referenceable? offset)
   (byte-offset-referenceable? offset))
@@ -511,14 +502,9 @@ USA.
 		   offset))
 
 (define (indexed-ea-mode base index scale offset)
-  (cond ((zero? offset)
-	 (INST-EA (@RI ,base ,index ,scale)))
-	((fits-in-signed-byte? offset)
-	 (INST-EA (@ROI B ,base ,offset ,index ,scale)))
-	((fits-in-signed-long? offset)
-	 (INST-EA (@ROI L ,base ,offset ,index ,scale)))
-	(else
-	 (error "Offset too large:" offset))))
+  (if (zero? offset)
+      (INST-EA (@RI ,base ,index ,scale))
+      (INST-EA (@ROI ,base ,offset ,index ,scale))))
 
 (define (rtl:simple-offset? expression)
   (and (rtl:offset? expression)
diff --git a/src/compiler/machines/x86-64/rules1.scm b/src/compiler/machines/x86-64/rules1.scm
index bb1eccbca..d65fa052e 100644
--- a/src/compiler/machines/x86-64/rules1.scm
+++ b/src/compiler/machines/x86-64/rules1.scm
@@ -125,7 +125,7 @@ USA.
       (let ((literal (make-non-pointer-literal type 0)))
 	(define (three-arg source)
 	  (let ((target (target-register-reference target)))
-	    (LAP (LEA Q ,target (@RO UL ,source ,literal)))))
+	    (LAP (LEA Q ,target (@RO ,source ,literal)))))
 
 	(define (two-arg target)
 	  (LAP (OR Q ,target (&U ,literal))))
diff --git a/src/compiler/machines/x86-64/rules3.scm b/src/compiler/machines/x86-64/rules3.scm
index 54c101e86..1295ea959 100644
--- a/src/compiler/machines/x86-64/rules3.scm
+++ b/src/compiler/machines/x86-64/rules3.scm
@@ -269,7 +269,7 @@ USA.
 	  ((= frame-size 2)
 	   (let ((temp1 (temporary-register-reference))
 		 (temp2 (temporary-register-reference)))
-	     (LAP (MOV Q ,temp2 (@RO B ,rsp ,address-units-per-object))
+	     (LAP (MOV Q ,temp2 (@RO ,rsp ,address-units-per-object))
 		  (MOV Q ,temp1 (@R ,rsp))
 		  ,@(with-signed-immediate-operand
 			(* address-units-per-object offset)
@@ -465,10 +465,10 @@ USA.
     (LAP (MOV Q ,temp (&U ,(make-closure-manifest size)))
 	 (MOV Q (@R ,regnum:free-pointer) ,temp)
 	 ;; There's only one entry point here.
-	 (MOV L (@RO B ,regnum:free-pointer ,data-offset) (&U 1))
+	 (MOV L (@RO ,regnum:free-pointer ,data-offset) (&U 1))
 	 ,@(generate-closure-entry procedure-label min max format-offset temp)
 	 ;; Load the address of the entry instruction into TARGET.
-	 (LEA Q ,target (@RO B ,regnum:free-pointer ,pc-offset))
+	 (LEA Q ,target (@RO ,regnum:free-pointer ,pc-offset))
 	 ;; Bump FREE.
 	 ,@(with-signed-immediate-operand free-offset
 	     (lambda (addend)
@@ -499,7 +499,7 @@ USA.
 	   (MOV Q (@R ,regnum:free-pointer) ,temp)
 	   (MOV L (@RO ,regnum:free-pointer ,data-offset) (&U ,nentries))
 	   ,@(generate-entries entries first-format-offset)
-	   (LEA Q ,target (@RO B ,regnum:free-pointer ,first-pc-offset))
+	   (LEA Q ,target (@RO ,regnum:free-pointer ,first-pc-offset))
 	   ,@(with-signed-immediate-operand free-offset
 	       (lambda (addend)
 		 (LAP (ADD Q (R ,regnum:free-pointer) ,addend))))))))
@@ -509,17 +509,17 @@ USA.
 	 (MOV-offset (+ offset address-units-per-entry-format-code))
 	 (imm64-offset (+ MOV-offset 2))
 	 (CALL-offset (+ imm64-offset 8)))
-    (LAP (MOV L (@RO B ,regnum:free-pointer ,offset)
+    (LAP (MOV L (@RO ,regnum:free-pointer ,offset)
 	      (&U ,(make-closure-code-longword min max MOV-offset)))
 	 (LEA Q ,temp (@PCR ,procedure-label))
 	 ;; (MOV Q (R ,rax) (&U <procedure-label>))
 	 ;; The instruction sequence is really `48 b8', but this is a
 	 ;; stupid little-endian architecture.  I want my afternoon
 	 ;; back.
-	 (MOV W (@RO B ,regnum:free-pointer ,MOV-offset) (&U #xB848))
-	 (MOV Q (@RO B ,regnum:free-pointer ,imm64-offset) ,temp)
+	 (MOV W (@RO ,regnum:free-pointer ,MOV-offset) (&U #xB848))
+	 (MOV Q (@RO ,regnum:free-pointer ,imm64-offset) ,temp)
 	 ;; (CALL (R ,rax))
-	 (MOV W (@RO B ,regnum:free-pointer ,CALL-offset) (&U #xD0FF)))))
+	 (MOV W (@RO ,regnum:free-pointer ,CALL-offset) (&U #xD0FF)))))
 
 (define (generate/closure-header internal-label nentries)
   (let* ((rtl-proc (label->object internal-label))
@@ -639,9 +639,9 @@ USA.
 			      n-sections)
   (LAP (MOV Q (R ,rdx) (@PCR ,code-block-label))
        (AND Q (R ,rdx) (R ,regnum:datum-mask))
-       (LEA Q (R ,rbx) (@RO L ,rdx ,free-ref-offset))
+       (LEA Q (R ,rbx) (@RO ,rdx ,free-ref-offset))
        (MOV Q (R ,rcx) ,reg:environment)
-       (MOV Q (@RO L ,rdx ,environment-offset) (R ,rcx))
+       (MOV Q (@RO ,rdx ,environment-offset) (R ,rcx))
        (MOV Q ,reg:utility-arg-4 (&U ,n-sections))
        #|
        ,@(invoke-interface/call code:compiler-link)
@@ -675,8 +675,7 @@ USA.
 	 ;; vector-ref -> cc block
 	 (MOV Q
 	      (R ,rdx)
-	      (@ROI B
-		    ,rdx ,address-units-per-object
+	      (@ROI ,rdx ,address-units-per-object
 		    ,rcx ,address-units-per-object))
 	 ;; address of cc-block
 	 (AND Q (R ,rdx) (R ,regnum:datum-mask))
@@ -689,14 +688,13 @@ USA.
 	 ;; Store environment
 	 (MOV Q (@RI ,rdx ,rbx ,address-units-per-object) (R ,rcx))
 	 ;; Get NMV header
-	 (MOV Q (R ,rcx) (@RO B ,rdx ,address-units-per-object))
+	 (MOV Q (R ,rcx) (@RO ,rdx ,address-units-per-object))
 	 ;; Eliminate NMV tag
 	 (AND Q (R ,rcx) (R ,regnum:datum-mask))
 	 ;; Address of first free reference
 	 (LEA Q
 	      (R ,rbx)
-	      (@ROI B
-		    ,rdx ,(* 2 address-units-per-object)
+	      (@ROI ,rdx ,(* 2 address-units-per-object)
 		    ,rcx ,address-units-per-object))
 	 ;; Invoke linker
 	 ,@(invoke-hook/call entry:compiler-link)
-- 
2.25.1