#| -*-Scheme-*-
-$Id: instr2.scm,v 1.20 2001/12/20 21:45:24 cph Exp $
+$Id: instr2.scm,v 1.21 2002/02/22 03:21:43 cph Exp $
-Copyright (c) 1987-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1987-1999, 2001, 2002 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
((UL (? expression))
(WORD (32 expression UNSIGNED))))
-\f
+
;;;; BCD Arithmetic
(let-syntax ((define-BCD-addition
- (lambda (keyword opcode)
- `(define-instruction ,keyword
- (((D (? ry)) (D (? rx)))
- (WORD (4 ,opcode)
- (3 rx)
- (6 #b100000)
- (3 ry)))
-
- (((@-A (? ry)) (@-A (? rx)))
- (WORD (4 ,opcode)
- (3 rx)
- (6 #b100001)
- (3 ry)))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (((D (? ry)) (D (? rx)))
+ (WORD (4 ,(caddr form))
+ (3 rx)
+ (6 #b100000)
+ (3 ry)))
+
+ (((@-A (? ry)) (@-A (? rx)))
+ (WORD (4 ,(caddr form))
+ (3 rx)
+ (6 #b100001)
+ (3 ry))))))))
(define-BCD-addition ABCD #b1100)
(define-BCD-addition SBCD #b1000))
;;;; Binary Arithmetic
(let-syntax ((define-binary-addition
- (lambda (keyword Qkeyword Xkeyword opcode Qbit Iopcode)
- `(BEGIN
- (define-instruction ,Qkeyword ;ADDQ/SUBQ
- ((B (& (? data)) (? ea ea-all-A))
- (WORD (4 #b0101)
- (3 data QUICK)
- (1 ,Qbit)
- (2 #b00)
- (6 ea DESTINATION-EA)))
-
- (((? s bwl-b) (& (? data)) (? ea ea-all))
- (WORD (4 #b0101)
- (3 data QUICK)
- (1 ,Qbit)
- (2 s)
- (6 ea DESTINATION-EA))))
-
- (define-instruction ,keyword
- (((? s bwl ssym) (& (? data)) (? ea ea-d&a)) ;ADDI/SUBI
- (WORD (4 #b0000)
- (4 ,Iopcode)
- (2 s)
- (6 ea DESTINATION-EA))
- (immediate-words data ssym))
-
- ((B (? ea ea-all-A) (D (? rx)))
- (WORD (4 ,opcode)
- (3 rx)
- (1 #b0)
- (2 #b00)
- (6 ea SOURCE-EA 'B)))
-
- (((? s bwl-b ssym) (? ea ea-all) (D (? rx)))
- (WORD (4 ,opcode)
- (3 rx)
- (1 #b0)
- (2 s)
- (6 ea SOURCE-EA ssym)))
-
- (((? s bwl) (D (? rx)) (? ea ea-m&a))
- (WORD (4 ,opcode)
- (3 rx)
- (1 #b1)
- (2 s)
-\f (6 ea DESTINATION-EA)))
-
- (((? s wl ssym) (? ea ea-all) (A (? rx))) ;ADDA/SUBA
- (WORD (4 ,opcode)
- (3 rx)
- (1 s)
- (2 #b11)
- (6 ea SOURCE-EA ssym))))
-
- (define-instruction ,Xkeyword
- (((? s bwl) (D (? ry)) (D (? rx)))
- (WORD (4 ,opcode)
- (3 rx)
- (1 #b1)
- (2 s)
- (3 #b000)
- (3 ry)))
-
- (((? s bwl) (@-A (? ry)) (@-A (? rx)))
- (WORD (4 ,opcode)
- (3 rx)
- (1 #b1)
- (2 s)
- (3 #b001)
- (3 ry))))))))
+ (sc-macro-transformer
+ (lambda (keyword Qkeyword Xkeyword opcode Qbit Iopcode)
+ `(BEGIN
+ (DEFINE-INSTRUCTION ,(caddr form) ;ADDQ/SUBQ
+ ((B (& (? data)) (? ea ea-all-A))
+ (WORD (4 #b0101)
+ (3 data QUICK)
+ (1 ,(list-ref form 5))
+ (2 #b00)
+ (6 ea DESTINATION-EA)))
+
+ (((? s bwl-b) (& (? data)) (? ea ea-all))
+ (WORD (4 #b0101)
+ (3 data QUICK)
+ (1 ,(list-ref form 5))
+ (2 s)
+ (6 ea DESTINATION-EA))))
+
+ (DEFINE-INSTRUCTION ,(cadr form)
+ (((? s bwl ssym) (& (? data)) (? ea ea-d&a)) ;ADDI/SUBI
+ (WORD (4 #b0000)
+ (4 ,(list-ref form 6))
+ (2 s)
+ (6 ea DESTINATION-EA))
+ (immediate-words data ssym))
+
+ ((B (? ea ea-all-A) (D (? rx)))
+ (WORD (4 ,(list-ref form 4))
+ (3 rx)
+ (1 #b0)
+ (2 #b00)
+ (6 ea SOURCE-EA 'B)))
+
+ (((? s bwl-b ssym) (? ea ea-all) (D (? rx)))
+ (WORD (4 ,(list-ref form 4))
+ (3 rx)
+ (1 #b0)
+ (2 s)
+ (6 ea SOURCE-EA ssym)))
+
+ (((? s bwl) (D (? rx)) (? ea ea-m&a))
+ (WORD (4 ,(list-ref form 4))
+ (3 rx)
+ (1 #b1)
+ (2 s)
+ (6 ea DESTINATION-EA)))
+
+ (((? s wl ssym) (? ea ea-all) (A (? rx))) ;ADDA/SUBA
+ (WORD (4 ,(list-ref form 4))
+ (3 rx)
+ (1 s)
+ (2 #b11)
+ (6 ea SOURCE-EA ssym))))
+
+ (DEFINE-INSTRUCTION ,(cadddr form)
+ (((? s bwl) (D (? ry)) (D (? rx)))
+ (WORD (4 ,(list-ref form 4))
+ (3 rx)
+ (1 #b1)
+ (2 s)
+ (3 #b000)
+ (3 ry)))
+
+ (((? s bwl) (@-A (? ry)) (@-A (? rx)))
+ (WORD (4 ,(list-ref form 4))
+ (3 rx)
+ (1 #b1)
+ (2 s)
+ (3 #b001)
+ (3 ry)))))))))
(define-binary-addition ADD ADDQ ADDX #b1101 #b0 #b0110)
(define-binary-addition SUB SUBQ SUBX #b1001 #b1 #b0100))
\f
;; These are the 68020 versions
(let-syntax ((define-mul-and-div
- (lambda (keyword word-form-bit long-form-bit)
- `(define-instruction ,keyword
- (((? sgn us) W (? ea ea-d) (D (? n)))
- (WORD (1 #b1)
- (1 ,word-form-bit)
- (2 #b00)
- (3 n)
- (1 sgn)
- (2 #b11)
- (6 ea SOURCE-EA 'W)))
-
- (((? sgn us) L (? ea ea-d) (D (? q)))
- (WORD (9 #b010011000)
- (1 ,long-form-bit)
- (6 ea SOURCE-EA 'L))
- (EXTENSION-WORD (1 #b0)
- (3 q)
- (1 sgn)
- (8 #b00000000)
- (3 q)))
-
- (((? sgn us) L (? ea ea-d) (D (? r)) (D (? q)))
- (WORD (9 #b010011000)
- (1 ,long-form-bit)
- (6 ea SOURCE-EA 'L))
- (EXTENSION-WORD (1 #b0)
- (3 q)
- (1 sgn)
- (8 #b10000000)
- (3 r)))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (((? sgn us) W (? ea ea-d) (D (? n)))
+ (WORD (1 #b1)
+ (1 ,(caddr form))
+ (2 #b00)
+ (3 n)
+ (1 sgn)
+ (2 #b11)
+ (6 ea SOURCE-EA 'W)))
+
+ (((? sgn us) L (? ea ea-d) (D (? q)))
+ (WORD (9 #b010011000)
+ (1 ,(cadddr form))
+ (6 ea SOURCE-EA 'L))
+ (EXTENSION-WORD (1 #b0)
+ (3 q)
+ (1 sgn)
+ (8 #b00000000)
+ (3 q)))
+
+ (((? sgn us) L (? ea ea-d) (D (? r)) (D (? q)))
+ (WORD (9 #b010011000)
+ (1 ,(cadddr form))
+ (6 ea SOURCE-EA 'L))
+ (EXTENSION-WORD (1 #b0)
+ (3 q)
+ (1 sgn)
+ (8 #b10000000)
+ (3 r))))))))
(define-mul-and-div MUL #b1 #b0)
(define-mul-and-div DIV #b0 #b1))
;;;; Bitwise Logical
(let-syntax ((define-bitwise-logical
- (lambda (keyword opcode Iopcode)
- `(define-instruction ,keyword
- (((? s bwl ssym) (? ea ea-d) (D (? rx)))
- (WORD (4 ,opcode)
- (3 rx)
- (1 #b0)
- (2 s)
- (6 ea SOURCE-EA ssym)))
-
- (((? s bwl) (D (? rx)) (? ea ea-m&a))
- (WORD (4 ,opcode)
- (3 rx)
- (1 #b1)
- (2 s)
- (6 ea DESTINATION-EA)))
-
- (((? s bwl ssym) (& (? data)) (? ea ea-d&a)) ;fooI
- (WORD (4 #b0000)
- (4 ,Iopcode)
- (2 s)
- (6 ea DESTINATION-EA))
- (immediate-unsigned-words data ssym))
-
- (((? s bwl ssym) (& (? data)) (SR)) ;fooI to CCR/SR
- (WORD (4 #b0000)
- (4 ,Iopcode)
- (2 s)
- (6 #b111100))
- (immediate-unsigned-words data ssym))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (((? s bwl ssym) (? ea ea-d) (D (? rx)))
+ (WORD (4 ,(caddr form))
+ (3 rx)
+ (1 #b0)
+ (2 s)
+ (6 ea SOURCE-EA ssym)))
+
+ (((? s bwl) (D (? rx)) (? ea ea-m&a))
+ (WORD (4 ,(caddr form))
+ (3 rx)
+ (1 #b1)
+ (2 s)
+ (6 ea DESTINATION-EA)))
+
+ (((? s bwl ssym) (& (? data)) (? ea ea-d&a)) ;fooI
+ (WORD (4 #b0000)
+ (4 ,(cadddr form))
+ (2 s)
+ (6 ea DESTINATION-EA))
+ (immediate-unsigned-words data ssym))
+
+ (((? s bwl ssym) (& (? data)) (SR)) ;fooI to CCR/SR
+ (WORD (4 #b0000)
+ (4 ,(cadddr form))
+ (2 s)
+ (6 #b111100))
+ (immediate-unsigned-words data ssym)))))))
(define-bitwise-logical AND #b1100 #b0010) ; and ANDI
(define-bitwise-logical OR #b1000 #b0000)) ; and ORI
;;;; Shift
(let-syntax ((define-shift-instruction
- (lambda (keyword bits)
- `(define-instruction ,keyword
- (((? d rl) (? s bwl) (D (? rx)) (D (? ry)))
- (WORD (4 #b1110)
- (3 rx)
- (1 d)
- (2 s)
- (1 #b1)
- (2 ,bits)
- (3 ry)))
-
- (((? d rl) (? s bwl) (& (? data)) (D (? ry)))
- (WORD (4 #b1110)
- (3 data SHIFT-NUMBER)
- (1 d)
- (2 s)
- (1 #b0)
- (2 ,bits)
- (3 ry)))
-
- (((? d rl) (? ea ea-m&a))
- (WORD (5 #b11100)
- (2 ,bits)
- (1 d)
- (2 #b11)
- (6 ea DESTINATION-EA)))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (((? d rl) (? s bwl) (D (? rx)) (D (? ry)))
+ (WORD (4 #b1110)
+ (3 rx)
+ (1 d)
+ (2 s)
+ (1 #b1)
+ (2 ,(caddr form))
+ (3 ry)))
+
+ (((? d rl) (? s bwl) (& (? data)) (D (? ry)))
+ (WORD (4 #b1110)
+ (3 data SHIFT-NUMBER)
+ (1 d)
+ (2 s)
+ (1 #b0)
+ (2 ,(caddr form))
+ (3 ry)))
+
+ (((? d rl) (? ea ea-m&a))
+ (WORD (5 #b11100)
+ (2 ,(caddr form))
+ (1 d)
+ (2 #b11)
+ (6 ea DESTINATION-EA))))))))
(define-shift-instruction AS #b00)
(define-shift-instruction LS #b01)
(define-shift-instruction ROX #b10)
(define-shift-instruction RO #b11))
-\f
+
;;;; Bit Manipulation
(let-syntax ((define-bit-manipulation
- (lambda (keyword bits ea-register-target ea-immediate-target)
- `(define-instruction ,keyword
- (((D (? rx)) (? ea ,ea-register-target))
- (WORD (4 #b0000)
- (3 rx)
- (1 #b1)
- (2 ,bits)
- (6 ea DESTINATION-EA)))
-
- (((& (? bitnum)) (? ea ,ea-immediate-target))
- (WORD (8 #b00001000)
- (2 ,bits)
- (6 ea DESTINATION-EA))
- (immediate-byte bitnum))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (((D (? rx)) (? ea ,(cadddr form)))
+ (WORD (4 #b0000)
+ (3 rx)
+ (1 #b1)
+ (2 ,(caddr form))
+ (6 ea DESTINATION-EA)))
+
+ (((& (? bitnum)) (? ea ,(list-ref form 4)))
+ (WORD (8 #b00001000)
+ (2 ,(caddr form))
+ (6 ea DESTINATION-EA))
+ (immediate-byte bitnum)))))))
(define-bit-manipulation BTST #b00 ea-d ea-d&-&)
(define-bit-manipulation BCHG #b01 ea-d&a ea-d&a)
(define-bit-manipulation BCLR #b10 ea-d&a ea-d&a)
- (define-bit-manipulation BSET #b11 ea-d&a ea-d&a))
+ (define-bit-manipulation BSET #b11 ea-d&a ea-d&a))
\ No newline at end of file
projects / mit-scheme.git / commitdiff