,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.
`(MATCH-RESULT)))))
(ill-formed-syntax form)))))
\f
+(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) ())))
+\f
(define (parse-instruction opcode tail early? environment)
(process-fields (cons opcode tail) early? environment))
(error "Bad clause size:" size))
`(,code ,size ,@(car clause))))
clauses)))))
-\f
+
(define (expand-fields fields early? environment)
(if (pair? fields)
(receive (tail tail-size) (expand-fields (cdr fields) early? environment)
(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))
(else
(error "Unknown field kind:" (caar fields)))))
(values `(,(close-syntax 'QUOTE environment) ()) 0)))
-
+\f
(define (collect-bits components tail environment)
(let loop ((components components))
(if (pair? components)
;;;; 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)))
\f
-;;;; 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)))
-\f
-;;;; 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)))
-\f
-;;;; 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)))
\f
-;;;; 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)))
-\f
- ((@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)))
-\f
- ((@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))))
\f
(define-ea-transformer r/m-ea)
(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)
(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)
((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)
(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))
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))))
\f
(define (rtl:simple-offset? expression)
(and (rtl:offset? expression)
(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))))
((= 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)
(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)
(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))))))))
(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)))))
\f
(define (generate/closure-header internal-label nentries)
(let* ((rtl-proc (label->object internal-label))
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)
;; 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))
;; 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)
projects / mit-scheme.git / commitdiff