--- /dev/null
+#| -*-Scheme-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/instr1.scm,v 1.1 1987/08/14 05:04:50 jinx Exp $
+
+Copyright (c) 1987 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science. Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. |#
+
+;;;; VAX Instruction Set Description, Part 1
+
+;;; The ordering is essentially that in "Vax Architecture Handbook" 1981.
+
+(declare (usual-integrations))
+\f
+;;;; REMARKS
+
+#|
+
+A) There are three types of operand specifiers:
+
+ - General addressing mode operand specifier, with matching pattern syntax
+
+ (? foo ea-<access-type>-<operand-type>)
+
+ Access types and operand types are described on the "Vax Architecture
+ Handbook", on Appendix E.
+ They are implemented in insutl.scm
+
+ - Displacement for branch instructions. The matching pattern syntax is
+
+ (? value displacement)
+
+ This matches either (@PCO offset) or (@PCR label).
+
+ - Immediate operand. Only the BUG instruction uses this. The
+ matching syntax is (? value).
+
+B) The instruction set is currently incomplete. In particular, none
+of the instructions in chapters 14 or 16 are below. The missing
+opcodes are
+
+- Chap. 14: MOVC, MOVTC, MOVTUC, CMPC, SCANC, SPANC, LOCC, SKPC,
+ MATCHC, CRC.
+
+- Chap. 16: EDITPC.
+
+|#
+\f
+;; Utility
+
+(define-macro (define-trivial-instruction mnemonic opcode)
+ `(define-instruction ,mnemonic
+ (()
+ (BYTE (8 ,opcode)))))
+
+;; Pseudo-op
+
+(define-instruction DC
+ ((B (? value))
+ (BYTE (8 value SIGNED)))
+
+ ((W (? value))
+ (BYTE (16 value SIGNED)))
+
+ ((L (? value))
+ (BYTE (32 value SIGNED))))
+
+;;; Privilleged and miscellaneous (Chap. 10)
+
+(define-instruction CHM
+ ((K (? code ea-r-w)) ; kernel
+ (BYTE (8 #xBC))
+ (OPERAND code))
+
+ ((E (? code ea-r-w)) ; executive
+ (BYTE (8 #xBD))
+ (OPERAND code))
+
+ ((S (? code ea-r-w)) ; supervisor
+ (BYTE (8 #xBE))
+ (OPERAND code))
+
+ ((U (? code ea-r-w)) ; user
+ (BYTE (8 #xBF))
+ (OPERAND code)))
+
+(define-instruction PROBE
+ ((R (? mode ea-r-b) (? len ea-r-w) (? base ea-a-b))
+ (BYTE (8 #xOC))
+ (OPERAND mode)
+ (OPERAND len)
+ (OPERAND base))
+
+ ((W (? mode ea-r-b) (? len ea-r-w) (? base ea-a-b))
+ (BYTE (8 #xOD))
+ (OPERAND mode)
+ (OPERAND len)
+ (OPERAND base)))
+
+(define-trivial-instruction REI #x02)
+(define-trivial-instruction LDPCTX #x06)
+(define-trivial-instruction SVPCTX #x07)
+\f
+(define-instruction MTPR
+ (((? src ea-r-l) (? procreg ea-r-l))
+ (BYTE (8 #xDA))
+ (OPERAND src)
+ (OPERAND procreg)))
+
+(define-instruction MFPR
+ (((? procreg ea-r-l) (? dst ea-w-l))
+ (BYTE (8 #xDB))
+ (OPERAND procreg)
+ (OPERAND dst)))
+
+(define-trivial-instruction XFC #xFC)
+
+(define-trivial-instruction BPT #x03)
+
+(define-instruction BUG
+ ((W (? message))
+ (BYTE (16 #xFEFF)
+ (16 message)))
+
+ ((L (? message))
+ (BYTE (16 #xFDFF)
+ (32 message))))
+
+(define-trivial-instruction HALT #x00)
+\f
+;;;; Integer and floating point instructions (Chap. 11)
+
+(define-instruction MOV
+ ((B (? src ea-r-b) (? dst ea-w-b))
+ (BYTE (8 #x90))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((W (? src ea-r-w) (? dst ea-w-w))
+ (BYTE (8 #xB0))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((L (? src ea-r-l) (? dst ea-w-l))
+ (BYTE (8 #xD0))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((Q (? src ea-r-q) (? dst ea-w-q))
+ (BYTE (8 #x7D))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((O (? src ea-r-o) (? dst ea-w-o))
+ (BYTE (16 #x7DFD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((F (? src ea-r-f) (? dst ea-w-f))
+ (BYTE (8 #x50))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((D (? src ea-r-d) (? dst ea-w-d))
+ (BYTE (8 #x70))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((G (? src ea-r-g) (? dst ea-w-g))
+ (BYTE (16 #x50FD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((H (? src ea-r-h) (? dst ea-w-h))
+ (BYTE (16 #x70FD))
+ (OPERAND src)
+ (OPERAND dst)))
+
+(define-instruction PUSHL
+ (((? src ea-r-l))
+ (BYTE (8 #XDD))
+ (OPERAND src)))
+\f
+(define-instruction CLR
+ ((B (? dst ea-w-b))
+ (BYTE (8 #x94))
+ (OPERAND dst))
+
+ ((W (? dst ea-w-w))
+ (BYTE (8 #xB4))
+ (OPERAND dst))
+
+ ((L (? dst ea-w-l))
+ (BYTE (8 #xD4))
+ (OPERAND dst))
+
+ ((F (? dst ea-w-f))
+ (BYTE (8 #xD4))
+ (OPERAND dst))
+
+ ((Q (? dst ea-w-q))
+ (BYTE (8 #x7C))
+ (OPERAND dst))
+
+ ((D (? dst ea-w-d))
+ (BYTE (8 #x7C))
+ (OPERAND dst))
+
+ ((G (? dst ea-w-g))
+ (BYTE (8 #x7C))
+ (OPERAND dst))
+
+ ((O (? dst ea-w-o))
+ (BYTE (16 #x7CFD))
+ (OPERAND dst))
+
+ ((H (? dst ea-w-h))
+ (BYTE (16 #x7CFD))
+ (OPERAND dst)))
+\f
+(define-instruction MNEG
+ ((B (? src ea-r-b) (? dst ea-w-b))
+ (BYTE (8 #x8E))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((W (? src ea-r-w) (? dst ea-w-w))
+ (BYTE (8 #xAE))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((L (? src ea-r-l) (? dst ea-w-l))
+ (BYTE (8 #xCE))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((F (? src ea-r-f) (? dst ea-w-f))
+ (BYTE (8 #x52))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((D (? src ea-r-d) (? dst ea-w-d))
+ (BYTE (8 #x72))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((G (? src ea-r-g) (? dst ea-w-g))
+ (BYTE (16 #x52FD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((H (? src ea-r-h) (? dst ea-w-h))
+ (BYTE (16 #x72FD))
+ (OPERAND src)
+ (OPERAND dst)))
+
+(define-instruction MCOM
+ ((B (? src ea-r-b) (? dst ea-w-b))
+ (BYTE (8 #x92))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((W (? src ea-r-w) (? dst ea-w-w))
+ (BYTE (8 #xB2))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((L (? src ea-r-l) (? dst ea-w-l))
+ (BYTE (8 #xD2))
+ (OPERAND src)
+ (OPERAND dst)))
--- /dev/null
+#| -*-Scheme-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/instr2.scm,v 1.1 1987/08/14 05:05:08 jinx Exp $
+
+Copyright (c) 1987 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science. Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. |#
+
+;;;; VAX Instruction Set Description, Part 2
+
+;;; The ordering is essentially that in "Vax Architecture Handbook" 1981.
+
+(declare (usual-integrations))
+\f
+(define-instruction CVT
+ ((B W (? src ea-r-b) (? dst ea-w-w))
+ (BYTE (8 #x99))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((B L (? src ea-r-b) (? dst ea-w-l))
+ (BYTE (8 #x98))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((W B (? src ea-r-w) (? dst ea-w-b))
+ (BYTE (8 #x33))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((W L (? src ea-r-w) (? dst ea-w-l))
+ (BYTE (8 #x32))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((L B (? src ea-r-l) (? dst ea-w-b))
+ (BYTE (8 #xF6))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((L W (? src ea-r-l) (? dst ea-w-w))
+ (BYTE (8 #xF7))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((B F (? src ea-r-b) (? dst ea-w-f))
+ (BYTE (8 #x4C))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((B D (? src ea-r-b) (? dst ea-w-d))
+ (BYTE (8 #x6C))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((B G (? src ea-r-b) (? dst ea-w-g))
+ (BYTE (16 #x4CFD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((B H (? src ea-r-b) (? dst ea-w-h))
+ (BYTE (16 #x6CFD))
+ (OPERAND src)
+ (OPERAND dst))
+\f
+ ((W F (? src ea-r-w) (? dst ea-w-f))
+ (BYTE (8 #x4D))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((W D (? src ea-r-w) (? dst ea-w-d))
+ (BYTE (8 #x6D))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((W G (? src ea-r-w) (? dst ea-w-g))
+ (BYTE (16 #x4DFD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((W H (? src ea-r-w) (? dst ea-w-h))
+ (BYTE (16 #x6DFD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((L F (? src ea-r-l) (? dst ea-w-f))
+ (BYTE (8 #x4E))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((L D (? src ea-r-l) (? dst ea-w-d))
+ (BYTE (8 #x6E))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((L G (? src ea-r-l) (? dst ea-w-g))
+ (BYTE (16 #x4EFD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((L H (? src ea-r-l) (? dst ea-w-h))
+ (BYTE (16 #x6EFD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((F B (? src ea-r-f) (? dst ea-w-b))
+ (BYTE (8 #x48))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((D B (? src ea-r-d) (? dst ea-w-b))
+ (BYTE (8 #x68))
+ (OPERAND src)
+ (OPERAND dst))
+\f
+ ((G B (? src ea-r-g) (? dst ea-w-b))
+ (BYTE (16 #x48FD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((H B (? src ea-r-h) (? dst ea-w-b))
+ (BYTE (16 #x68FD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((F W (? src ea-r-f) (? dst ea-w-w))
+ (BYTE (8 #x49))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((D W (? src ea-r-d) (? dst ea-w-w))
+ (BYTE (8 #x69))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((G W (? src ea-r-g) (? dst ea-w-w))
+ (BYTE (16 #x49FD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((H W (? src ea-r-h) (? dst ea-w-w))
+ (BYTE (16 #x69FD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((F L T (? src ea-r-f) (? dst ea-w-l))
+ (BYTE (8 #x4A))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((F L R (? src ea-r-f) (? dst ea-w-l))
+ (BYTE (8 #x4B))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((D L T (? src ea-r-d) (? dst ea-w-l))
+ (BYTE (8 #x6A))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((D L R (? src ea-r-d) (? dst ea-w-l))
+ (BYTE (8 #x6B))
+ (OPERAND src)
+ (OPERAND dst))
+\f
+ ((G L T (? src ea-r-g) (? dst ea-w-l))
+ (BYTE (16 #x4AFD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((G L R (? src ea-r-g) (? dst ea-w-l))
+ (BYTE (16 #x48FD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((H L T (? src ea-r-h) (? dst ea-w-l))
+ (BYTE (16 #x6AFD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((H L R (? src ea-r-h) (? dst ea-w-l))
+ (BYTE (16 #x6BFD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((F D (? src ea-r-f) (? dst ea-w-d))
+ (BYTE (8 #x56))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((F G (? src ea-r-f) (? dst ea-w-g))
+ (BYTE (16 #x99FD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((F H (? src ea-r-f) (? dst ea-w-h))
+ (BYTE (16 #x98FD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((D F (? src ea-r-d) (? dst ea-w-f))
+ (BYTE (16 #x76))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((D H (? src ea-r-d) (? dst ea-w-h))
+ (BYTE (16 #x32FD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((G F (? src ea-r-g) (? dst ea-w-f))
+ (BYTE (16 #x33FD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((G H (? src ea-r-g) (? dst ea-w-h))
+ (BYTE (16 #x56FD))
+ (OPERAND src)
+ (OPERAND dst))
+\f
+ ((H F (? src ea-r-h) (? dst ea-w-f))
+ (BYTE (16 #xF6FD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((H D (? src ea-r-h) (? dst ea-w-d))
+ (BYTE (16 #xF7FD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((H G (? src ea-r-h) (? dst ea-w-g))
+ (BYTE (16 #x76FD))
+ (OPERAND src)
+ (OPERAND dst)))
+
+(define-instruction CMP
+ ((B (? src1 ea-r-b) (? src2 ea-r-b))
+ (BYTE (8 #x91))
+ (OPERAND src1)
+ (OPERAND src2))
+
+ ((W (? src1 ea-r-w) (? src2 ea-r-w))
+ (BYTE (8 #xB1))
+ (OPERAND src1)
+ (OPERAND src2))
+
+ ((L (? src1 ea-r-l) (? src2 ea-r-l))
+ (BYTE (8 #xD1))
+ (OPERAND src1)
+ (OPERAND src2))
+
+ ((F (? src1 ea-r-f) (? src2 ea-r-f))
+ (BYTE (8 #x51))
+ (OPERAND src1)
+ (OPERAND src2))
+
+ ((D (? src1 ea-r-d) (? src2 ea-r-d))
+ (BYTE (8 #x71))
+ (OPERAND src1)
+ (OPERAND src2))
+
+ ((G (? src1 ea-r-g) (? src2 ea-r-g))
+ (BYTE (16 #x51FD))
+ (OPERAND src1)
+ (OPERAND src2))
+
+ ((H (? src1 ea-r-h) (? src2 ea-r-h))
+ (BYTE (16 #x71FD))
+ (OPERAND src1)
+ (OPERAND src2)))
+\f
+(define-instruction MOVZ
+ ((B W (? src ea-r-b) (? dst ea-w-w))
+ (BYTE (8 #x9B))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((B L (? src ea-r-b) (? dst ea-w-l))
+ (BYTE (8 #x9A))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((W L (? src ea-r-w) (? dst ea-w-l))
+ (BYTE (8 #x3C))
+ (OPERAND src)
+ (OPERAND dst)))
+
+(define-instruction TST
+ ((B (? src ea-r-b))
+ (BYTE (8 #x95))
+ (OPERAND src))
+
+ ((W (? src ea-r-w))
+ (BYTE (8 #xB5))
+ (OPERAND src))
+
+ ((L (? src ea-r-l))
+ (BYTE (8 #xD5))
+ (OPERAND src))
+
+ ((F (? src ea-r-f))
+ (BYTE (8 #x53))
+ (OPERAND src))
+
+ ((D (? src ea-r-d))
+ (BYTE (8 #x73))
+ (OPERAND src))
+
+ ((G (? src ea-r-g))
+ (BYTE (16 #x53FD))
+ (OPERAND src))
+
+ ((H (? src ea-r-h))
+ (BYTE (16 #x73FD))
+ (OPERAND src)))
+\f
+(let-syntax
+ ((define-arithmetic
+ (macro (name digit)
+ `(define-instruction ,name
+ ((B (? op ea-r-b) (? res ea-m-b))
+ (BYTE (8 ,(+ #x80 digit)))
+ (OPERAND op)
+ (OPERAND res))
+
+ ((B (? op1 ea-r-b) (? op2 ea-r-b) (? res ea-w-b))
+ (BYTE (8 ,(+ #x81 digit)))
+ (OPERAND op1)
+ (OPERAND op2)
+ (OPERAND res))
+
+ ((W (? op ea-r-w) (? res ea-m-w))
+ (BYTE (8 ,(+ #xA0 digit)))
+ (OPERAND op)
+ (OPERAND res))
+
+ ((W (? op1 ea-r-w) (? op2 ea-r-w) (? res ea-w-w))
+ (BYTE (8 ,(+ #xA1 digit)))
+ (OPERAND op1)
+ (OPERAND op2)
+ (OPERAND res))
+
+ ((L (? op ea-r-l) (? res ea-m-l))
+ (BYTE (8 ,(+ #xC0 digit)))
+ (OPERAND op)
+ (OPERAND res))
+
+ ((L (? op1 ea-r-l) (? op2 ea-r-l) (? res ea-w-l))
+ (BYTE (8 ,(+ #xC1 digit)))
+ (OPERAND op1)
+ (OPERAND op2)
+ (OPERAND res))
+
+ ((F (? op ea-r-f) (? res ea-m-f))
+ (BYTE (8 ,(+ #x40 digit)))
+ (OPERAND op)
+ (OPERAND res))
+
+ ((F (? op1 ea-r-f) (? op2 ea-r-f) (? res ea-w-f))
+ (BYTE (8 ,(+ #x41 digit)))
+ (OPERAND op1)
+ (OPERAND op2)
+ (OPERAND res))
+\f
+ ((D (? op ea-r-d) (? res ea-m-d))
+ (BYTE (8 ,(+ #x60 digit)))
+ (OPERAND op)
+ (OPERAND res))
+
+ ((D (? op1 ea-r-d) (? op2 ea-r-d) (? res ea-w-d))
+ (BYTE (8 ,(+ #x61 digit)))
+ (OPERAND op1)
+ (OPERAND op2)
+ (OPERAND res))
+
+ ((G (? op ea-r-g) (? res ea-m-g))
+ (BYTE (16 ,(+ #x40FD (* digit #x100))))
+ (OPERAND op)
+ (OPERAND res))
+
+ ((G (? op1 ea-r-g) (? op2 ea-r-g) (? res ea-w-g))
+ (BYTE (16 ,(+ #x41FD (* digit #x100))))
+ (OPERAND op1)
+ (OPERAND op2)
+ (OPERAND res))
+
+ ((H (? op ea-r-h) (? res ea-m-h))
+ (BYTE (16 ,(+ #x60FD (* digit #x100))))
+ (OPERAND op)
+ (OPERAND res))
+
+ ((H (? op1 ea-r-h) (? op2 ea-r-h) (? res ea-w-h))
+ (BYTE (16 ,(+ #x61FD (* digit #x100))))
+ (OPERAND op1)
+ (OPERAND op2)
+ (OPERAND res))))))
+
+ (define-arithmetic ADD #x0)
+ (define-arithmetic SUB #x2)
+ (define-arithmetic MUL #x4)
+ (define-arithmetic DIV #x6))
+
+(define-instruction ADAWI
+ (((? add ea-r-w) (? sum m w))
+ (BYTE (8 #x58))
+ (OPERAND add)
+ (OPERAND sum)))
+\f
+(define-instruction INC
+ ((B (? sum ea-m-b))
+ (BYTE (8 #x96))
+ (OPERAND sum))
+
+ ((W (? sum ea-m-w))
+ (BYTE (8 #xB6))
+ (OPERAND sum))
+
+ ((L (? sum ea-m-l))
+ (BYTE (8 #xD6))
+ (OPERAND sum)))
+
+(define-instruction DEC
+ ((B (? dif ea-m-b))
+ (BYTE (8 #x97))
+ (OPERAND dif))
+
+ ((W (? dif ea-m-w))
+ (BYTE (8 #xB7))
+ (OPERAND dif))
+
+ ((L (? dif ea-m-l))
+ (BYTE (8 #xD7))
+ (OPERAND dif)))
+
+(define-instruction ADWC
+ (((? add ea-r-l) (? sum m l))
+ (BYTE (8 #xD8))
+ (OPERAND add)
+ (OPERAND sum)))
+
+(define-instruction SBWC
+ (((? sub ea-r-l) (? dif m l))
+ (BYTE (8 #xD9))
+ (OPERAND sub)
+ (OPERAND dif)))
+
+(define-instruction EMUL
+ (((? mul1 ea-r-l) (? mul2 ea-r-l) (? add ea-r-l) (? prod ea-w-q))
+ (BYTE (8 #x7A))
+ (OPERAND mul1)
+ (OPERAND mul2)
+ (OPERAND add)
+ (OPERAND prod)))
+
+(define-instruction EDIV
+ (((? divr ea-r-l) (? divd ea-r-q) (? quo ea-w-l) (? rem ea-w-l))
+ (BYTE (8 #x7B))
+ (OPERAND divr)
+ (OPERAND divd)
+ (OPERAND quo)
+ (OPERAND rem)))
+\f
+(define-instruction EMOD
+ ((F (? mulr ea-r-f) (? mulrx ea-r-b) (? muld ea-r-f)
+ (? int ea-w-l) (? fract ea-w-f))
+ (BYTE (8 #x54))
+ (OPERAND mulr)
+ (OPERAND mulrx)
+ (OPERAND muld)
+ (OPERAND int)
+ (OPERAND fract))
+
+ ((D (? mulr ea-r-d) (? mulrx ea-r-b) (? muld ea-r-d)
+ (? int ea-w-l) (? fract ea-w-d))
+ (BYTE (8 #x74))
+ (OPERAND mulr)
+ (OPERAND mulrx)
+ (OPERAND muld)
+ (OPERAND int)
+ (OPERAND fract))
+
+ ((G (? mulr ea-r-g) (? mulrx ea-r-w) (? muld ea-r-g)
+ (? int ea-w-l) (? fract ea-w-g))
+ (BYTE (16 #x54FD))
+ (OPERAND mulr)
+ (OPERAND mulrx)
+ (OPERAND muld)
+ (OPERAND int)
+ (OPERAND fract))
+
+ ((H (? mulr ea-r-h) (? mulrx ea-r-w) (? muld ea-r-h)
+ (? int ea-w-l) (? fract ea-w-h))
+ (BYTE (16 #x74FD))
+ (OPERAND mulr)
+ (OPERAND mulrx)
+ (OPERAND muld)
+ (OPERAND int)
+ (OPERAND fract)))
+
+(define-instruction BIT
+ ((B (? mask ea-r-b) (? src ea-r-b))
+ (BYTE (8 #x93))
+ (OPERAND mask)
+ (OPERAND src))
+
+ ((W (? mask ea-r-w) (? src ea-r-w))
+ (BYTE (8 #xB3))
+ (OPERAND mask)
+ (OPERAND src))
+
+ ((L (? mask ea-r-l) (? src ea-r-l))
+ (BYTE (8 #xD3))
+ (OPERAND mask)
+ (OPERAND src)))
+\f
+(let-syntax
+ ((define-bitwise
+ (macro (name opcode)
+ `(define-instruction ,name
+ ((B (? mask ea-r-b) (? dst ea-m-b))
+ (BYTE (8 ,(+ #x80 opcode)))
+ (OPERAND mask)
+ (OPERAND dst))
+
+ ((B (? mask ea-r-b) (? src ea-r-b) (? dst ea-w-b))
+ (BYTE (8 ,(+ #x81 opcode)))
+ (OPERAND mask)
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((W (? mask ea-r-w) (? dst ea-m-w))
+ (BYTE (8 ,(+ #xA0 opcode)))
+ (OPERAND mask)
+ (OPERAND dst))
+
+ ((W (? mask ea-r-w) (? src ea-r-w) (? dst ea-w-w))
+ (BYTE (8 ,(+ #xA1 opcode)))
+ (OPERAND mask)
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((L (? mask ea-r-l) (? dst ea-m-l))
+ (BYTE (8 ,(+ #xC0 opcode)))
+ (OPERAND mask)
+ (OPERAND dst))
+
+ ((L (? mask ea-r-l) (? src ea-r-l) (? dst ea-w-l))
+ (BYTE (8 ,(+ #xC1 opcode)))
+ (OPERAND mask)
+ (OPERAND src)
+ (OPERAND dst))))))
+
+ (define-bitwise BIS #x8)
+ (define-bitwise BIC #xA)
+ (define-bitwise XOR #xC))
--- /dev/null
+#| -*-Scheme-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/instr3.scm,v 1.1 1987/08/14 05:05:26 jinx Exp $
+
+Copyright (c) 1987 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science. Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. |#
+
+;;;; VAX Instruction Set Description, Part 3
+
+;;; The ordering is essentially that in "Vax Architecture Handbook" 1981.
+
+(declare (usual-integrations))
+\f
+(define-instruction ASH
+ ((L (? cnt ea-r-b) (? src ea-r-l) (? dst ea-w-l))
+ (BYTE (8 #x78))
+ (OPERAND cnt)
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((Q (? cnt ea-r-b) (? src ea-r-q) (? dst ea-w-q))
+ (BYTE (8 #x79))
+ (OPERAND cnt)
+ (OPERAND src)
+ (OPERAND dst)))
+
+(define-instruction ROTL
+ (((? cnt ea-r-b) (? src ea-r-l) (? dst ea-w-l))
+ (BYTE (8 #x9C))
+ (OPERAND cnt)
+ (OPERAND src)
+ (OPERAND dst)))
+
+(define-instruction POLY
+ ((F (? arg ea-r-f) (? degree ea-r-w) (? tbladdr ea-a-b))
+ (BYTE (8 #x55))
+ (OPERAND arg)
+ (OPERAND degree)
+ (OPERAND tbladdr))
+
+ ((D (? arg ea-r-d) (? degree ea-r-w) (? tbladdr ea-a-b))
+ (BYTE (8 #x75))
+ (OPERAND arg)
+ (OPERAND degree)
+ (OPERAND tbladdr))
+
+ ((G (? arg ea-r-g) (? degree ea-r-w) (? tbladdr ea-a-b))
+ (BYTE (16 #x55FD))
+ (OPERAND arg)
+ (OPERAND degree)
+ (OPERAND tbladdr))
+
+ ((H (? arg ea-r-h) (? degree ea-r-w) (? tbladdr ea-a-b))
+ (BYTE (16 #x75FD))
+ (OPERAND arg)
+ (OPERAND degree)
+ (OPERAND tbladdr)))
+\f
+;;;; Special instructions (Chap. 12)
+
+(define-instruction PUSHR
+ (((? mask ea-r-w))
+ (BYTE (8 #xBB))
+ (OPERAND mask)))
+
+(define-instruction POPR
+ (((? mask ea-r-w))
+ (BYTE (8 #xBA))
+ (OPERAND mask)))
+
+(define-instruction MOVPSL
+ (((? dst ea-w-l))
+ (BYTE (8 #xDC))
+ (OPERAND dst)))
+
+(define-instruction BISPSW
+ (((? mask ea-r-w))
+ (BYTE (8 #xB8))
+ (OPERAND mask)))
+
+(define-instruction BICPSW
+ (((? mask ea-r-w))
+ (BYTE (8 #xB9))
+ (OPERAND mask)))
+\f
+(define-instruction MOVA
+ ((B (? src ea-a-b) (? dst ea-w-l))
+ (BYTE (8 #x9E))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((W (? src ea-a-w) (? dst ea-w-l))
+ (BYTE (8 #x3E))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((L (? src ea-a-l) (? dst ea-w-l))
+ (BYTE (8 #xDE))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((F (? src ea-a-f) (? dst ea-w-l))
+ (BYTE (8 #xDE))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((Q (? src ea-a-q) (? dst ea-w-l))
+ (BYTE (8 #x7E))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((D (? src ea-a-d) (? dst ea-w-l))
+ (BYTE (8 #x7E))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((G (? src ea-a-g) (? dst ea-w-l))
+ (BYTE (8 #x7E))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((H (? src ea-a-h) (? dst ea-w-l))
+ (BYTE (16 #x7EFD))
+ (OPERAND src)
+ (OPERAND dst))
+
+ ((O (? src ea-a-o) (? dst ea-w-l))
+ (BYTE (16 #x7EFD))
+ (OPERAND src)
+ (OPERAND dst)))
+\f
+(define-instruction PUSHA
+ ((B (? src ea-a-b))
+ (BYTE (8 #x9E))
+ (OPERAND src))
+
+ ((W (? src ea-a-w))
+ (BYTE (8 #x3E))
+ (OPERAND src))
+
+ ((L (? src ea-a-l))
+ (BYTE (8 #xDE))
+ (OPERAND src))
+
+ ((F (? src ea-a-f))
+ (BYTE (8 #xDE))
+ (OPERAND src))
+
+ ((Q (? src ea-a-q))
+ (BYTE (8 #x7E))
+ (OPERAND src))
+
+ ((D (? src ea-a-d))
+ (BYTE (8 #x7E))
+ (OPERAND src))
+
+ ((G (? src ea-a-g))
+ (BYTE (8 #x7E))
+ (OPERAND src))
+
+ ((H (? src ea-a-h))
+ (BYTE (16 #x7EFD))
+ (OPERAND src))
+
+ ((O (? src ea-a-o))
+ (BYTE (16 #x7EFD))
+ (OPERAND src)))
+\f
+;;; Array indeces and queues
+
+(define-instruction INDEX
+ (((? subscript ea-r-l) (? low ea-r-l) (? high ea-r-l)
+ (? size ea-r-l) (? indexin ea-r-l) (? indexout ea-w-l))
+ (BYTE (8 #x0A))
+ (OPERAND subscript)
+ (OPERAND low)
+ (OPERAND high)
+ (OPERAND size)
+ (OPERAND indexin)
+ (OPERAND indexout)))
+
+(define-instruction INSQUE
+ (((? entry ea-a-b) (? pred ea-a-b))
+ (BYTE (8 #x0E))
+ (OPERAND entry)
+ (OPERAND pred)))
+
+(define-instruction REMQUE
+ (((? entry ea-a-b) (? addr ea-w-l))
+ (BYTE (8 #x0F))
+ (OPERAND entry)
+ (OPERAND addr)))
+
+(define-instruction INSQHI
+ (((? entry ea-a-b) (? header ea-a-q))
+ (BYTE (8 #x5C))
+ (OPERAND entry)
+ (OPERAND header)))
+
+(define-instruction INSQTI
+ (((? entry ea-a-b) (? header ea-a-q))
+ (BYTE (8 #x5D))
+ (OPERAND entry)
+ (OPERAND header)))
+
+(define-instruction REMQHI
+ (((? header ea-a-q) (? addr ea-w-l))
+ (BYTE (8 #x5E))
+ (OPERAND header)
+ (OPERAND addr)))
+
+(define-instruction REMQTI
+ (((? header ea-a-q) (? addr ea-w-l))
+ (BYTE (8 #x5F))
+ (OPERAND header)
+ (OPERAND addr)))
+\f
+;;; Bit field instructions
+
+(let-syntax
+ ((define-field-instruction
+ (macro (name suffix1 suffix2 opcode mode)
+ `(define-instruction ,name
+ ((,suffix1 (? pos ea-r-l) (? size ea-r-b) (? base ea-v-b) (? dst ,mode))
+ (BYTE (8 ,opcode))
+ (OPERAND pos)
+ (OPERAND size)
+ (OPERAND base)
+ (OPERAND dst))
+
+ ((,suffix2 (? pos ea-r-l) (? size ea-r-b) (? base ea-v-b) (? dst ,mode))
+ (BYTE (8 ,(1+ opcode2)))
+ (OPERAND pos)
+ (OPERAND size)
+ (OPERAND base)
+ (OPERAND dst))))))
+
+ (define-field-instruction FF S C #xEA ea-w-l)
+ (define-field-instruction EXTV S Z #xEE ea-w-l)
+ (define-field-instruction CMPV S Z #xEC ea-r-l))
+
+(define-instruction INSV
+ (((? src ea-r-l) (? pos ea-r-l) (? size ea-r-b) (? base ea-v-b))
+ (BYTE (8 #xF0))
+ (OPERAND src)
+ (OPERAND pos)
+ (OPERAND size)
+ (OPERAND base)))
+\f
+;;;; Control instructions (Chap. 13)
+
+;; The VAX only has byte offset conditional branch instructions.
+;; Longer displacements are obtained by negating the condition and
+;; branching over an unconditional instruction.
+
+(define-instruction B
+ ((B (? c cc) (? dest displacement))
+ (BYTE (4 c)
+ (4 #x1))
+ (DISPLACEMENT (8 dest)))
+
+ ((W (? c inverse-cc) (? dest displacement))
+ (BYTE (4 c) ; (B B (~ cc) (+ *PC* 3))
+ (4 #x1))
+ (DISPLACEMENT (8 3))
+ (BYTE (8 #x31)) ; (BR W dest)
+ (DISPLACEMENT (16 dest)))
+
+ ;; Self adjusting version. It does not handle @PCO
+ (((? c cc cs) (@PCR (? label)))
+ (VARIABLE-WIDTH
+ (disp `(- ,label (+ *PC* 2)))
+ ((-128 127)
+ (BYTE (4 c)
+ (4 #x1))
+ (BYTE (8 disp SIGNED)))
+ ;; The following range is correct. Think about it.
+ ((-32765 32770)
+ (BYTE (4 (inverse-cc cs)) ; (B B (~ cc) (+ *PC* 3))
+ (4 #x1))
+ (BYTE (8 #x03))
+ (BYTE (8 #x31)) ; (BR W label)
+ (BYTE (16 (- disp 3) SIGNED)))
+ ((() ())
+ (BYTE (4 (inverse-cc cs)) ; (B B (~ cc) (+ *PC* 6))
+ (4 #x1))
+ (BYTE (8 #x06))
+ (BYTE (8 #x17)) ; (JMP (@PCO L label))
+ (BYTE (4 15)
+ (4 14))
+ (BYTE (32 (- disp 6) SIGNED))))))
+\f
+(let-syntax
+ ((define-unconditional-transfer
+ (macro (nameb namej bit)
+ `(begin
+ (define-instruction ,nameb
+ ((B (? dest displacement))
+ (BYTE (8 ,(+ #x10 bit)))
+ (DISPLACEMENT (8 dest)))
+
+ ((W (? dest displacement))
+ (BYTE (8 ,(+ #x30 bit)))
+ (DISPLACEMENT (16 dest)))
+
+ ;; Self tensioned version. @PCO not handled.
+ (((@PCR (? label)))
+ (VARIABLE-WIDTH
+ (disp `(- ,label (+ *PC* 2)))
+ ((-128 127) ; (BR/BSB B label)
+ (BYTE (8 ,(+ #x10 bit)))
+ (BYTE (8 disp SIGNED)))
+ ;; The following range is correct. Think about it.
+ ((-32767 32768) ; (BR/BSB W label)
+ (BYTE (8 ,(+ #x30 bit)))
+ (BYTE (16 (- disp 1) SIGNED)))
+ ((() ()) ; (JMP/JSB (@PCO L label))
+ (BYTE (8 ,(+ #x16 bit)))
+ (BYTE (4 15)
+ (4 14))
+ (BYTE (32 (- disp 4) SIGNED))))))
+
+ (define-instruction ,namej
+ (((? dst ea-a-b))
+ (BYTE (8 ,(+ #x16 bit)))
+ (OPERAND dst)))))))
+
+ (define-unconditional-transfer BR JMP #x1)
+ (define-unconditional-transfer BSB JSB #x0))
+\f
+(define-trivial-instruction RSB #x05)
+
+(define-instruction CALLG
+ (((? arglist ea-a-b) (? dst ea-a-b))
+ (BYTE (8 #xFA))
+ (OPERAND arglist)
+ (OPERAND dst)))
+
+(define-instruction CALLS
+ (((? narg ea-r-l) (? dst ea-a-b))
+ (BYTE (8 #xFB))
+ (OPERAND narg)
+ (OPERAND dst)))
+
+(define-trivial-instruction RET #x04)
+
+(define-instruction BLB
+ ((S (? src ea-r-l) (? dest displacement))
+ (BYTE (8 #xE8))
+ (OPERAND src)
+ (DISPLACEMENT (8 dest)))
+
+ ((C (? src ea-r-l) (? dest displacement))
+ (BYTE (8 #xE9))
+ (OPERAND src)
+ (DISPLACEMENT (8 dest))))
+\f
+(define-instruction BB
+ ((S (? pos ea-r-l) (? base ea-v-b) (? dest displacement))
+ (BYTE (8 #xE0))
+ (OPERAND pos)
+ (OPERAND base)
+ (DISPLACEMENT (8 dest)))
+
+ ((C (? pos ea-r-l) (? base ea-v-b) (? dest displacement))
+ (BYTE (8 #xE1))
+ (OPERAND pos)
+ (OPERAND base)
+ (DISPLACEMENT (8 dest)))
+
+ ((S S (? pos ea-r-l) (? base ea-v-b) (? dest displacement))
+ (BYTE (8 #xE2))
+ (OPERAND pos)
+ (OPERAND base)
+ (DISPLACEMENT (8 dest)))
+
+ ((C S (? pos ea-r-l) (? base ea-v-b) (? dest displacement))
+ (BYTE (8 #xE3))
+ (OPERAND pos)
+ (OPERAND base)
+ (DISPLACEMENT (8 dest)))
+
+ ((S C (? pos ea-r-l) (? base ea-v-b) (? dest displacement))
+ (BYTE (8 #xE4))
+ (OPERAND pos)
+ (OPERAND base)
+ (DISPLACEMENT (8 dest)))
+
+ ((C C (? pos ea-r-l) (? base ea-v-b) (? dest displacement))
+ (BYTE (8 #xE5))
+ (OPERAND pos)
+ (OPERAND base)
+ (DISPLACEMENT (8 dest)))
+
+ ((S S I (? pos ea-r-l) (? base ea-v-b) (? dest displacement))
+ (BYTE (8 #xE6))
+ (OPERAND pos)
+ (OPERAND base)
+ (DISPLACEMENT (8 dest)))
+
+ ((C C I (? pos ea-r-l) (? base ea-v-b) (? dest displacement))
+ (BYTE (8 #xE7))
+ (OPERAND pos)
+ (OPERAND base)
+ (DISPLACEMENT (8 dest))))
+\f
+(define-instruction ACB
+ ((B (? limit ea-r-b) (? add ea-r-b) (? index ea-m-b) (? dest displacement))
+ (BYTE (8 #x9D))
+ (OPERAND limit)
+ (OPERAND add)
+ (OPERAND index)
+ (DISPLACEMENT (8 dest)))
+
+ ((W (? limit ea-r-w) (? add ea-r-w) (? index ea-m-w) (? dest displacement))
+ (BYTE (8 #x3D))
+ (OPERAND limit)
+ (OPERAND add)
+ (OPERAND index)
+ (DISPLACEMENT (8 dest)))
+
+ ((L (? limit ea-r-l) (? add ea-r-l) (? index ea-m-l) (? dest displacement))
+ (BYTE (8 #xF1))
+ (OPERAND limit)
+ (OPERAND add)
+ (OPERAND index)
+ (DISPLACEMENT (8 dest)))
+
+ ((F (? limit ea-r-f) (? add ea-r-f) (? index ea-m-f) (? dest displacement))
+ (BYTE (8 #x4F))
+ (OPERAND limit)
+ (OPERAND add)
+ (OPERAND index)
+ (DISPLACEMENT (8 dest)))
+
+ ((D (? limit ea-r-d) (? add ea-r-d) (? index ea-m-d) (? dest displacement))
+ (BYTE (8 #x6F))
+ (OPERAND limit)
+ (OPERAND add)
+ (OPERAND index)
+ (DISPLACEMENT (8 dest)))
+
+ ((G (? limit ea-r-g) (? add ea-r-g) (? index ea-m-g) (? dest displacement))
+ (BYTE (16 #x4FFD))
+ (OPERAND limit)
+ (OPERAND add)
+ (OPERAND index)
+ (DISPLACEMENT (8 dest)))
+
+ ((H (? limit ea-r-h) (? add ea-r-h) (? index ea-m-h) (? dest displacement))
+ (BYTE (16 #x6FFD))
+ (OPERAND limit)
+ (OPERAND add)
+ (OPERAND index)
+ (DISPLACEMENT (8 dest))))
+\f
+(define-instruction AOB
+ ((LSS (? limit ea-r-l) (? index ea-m-l) (? dest displacement))
+ (BYTE (8 #xF2))
+ (OPERAND limit)
+ (OPERAND index)
+ (DISPLACEMENT (8 dest)))
+
+ ((LEQ (? limit ea-r-l) (? index ea-m-l) (? dest displacement))
+ (BYTE (8 #xF3))
+ (OPERAND limit)
+ (OPERAND index)
+ (DISPLACEMENT (8 dest))))
+
+(define-instruction SOB
+ ((GEQ (? index ea-m-l) (? dest displacement))
+ (BYTE (8 #xF4))
+ (OPERAND index)
+ (DISPLACEMENT (8 dest)))
+
+ ((GTR (? index ea-m-l) (? dest displacement))
+ (BYTE (8 #xF5))
+ (OPERAND index)
+ (DISPLACEMENT (8 dest))))
+
+;; NOTE: The displacements must be placed separately on the
+;; instruction stream after the instruction.
+;;
+;; For example:
+;;
+;; (CASE B (R 0) (& 5) (& 2))
+;; (LABEL case-begin)
+;; (DC W `(- case-5 case-begin))
+;; (DC W `(- case-6 case-begin))
+;; (DC W `(- case-7 case-begin))
+;; <fall through if out of range>
+
+(define-instruction CASE
+ ((B (? selector ea-r-b) (? base ea-r-b) (? limit ea-r-b))
+ (BYTE (8 #x8F))
+ (OPERAND selector)
+ (OPERAND base)
+ (OPERAND limit))
+
+ ((W (? selector ea-r-w) (? base ea-r-w) (? limit ea-r-w))
+ (BYTE (8 #xAF))
+ (OPERAND selector)
+ (OPERAND base)
+ (OPERAND limit))
+
+ ((L (? selector ea-r-l) (? base ea-r-l) (? limit ea-r-l))
+ (BYTE (8 #xCF))
+ (OPERAND selector)
+ (OPERAND base)
+ (OPERAND limit)))
+\f
+;;;; BCD instructions (Chap 15.)
+
+(let-syntax
+ ((define-add/sub-bcd-instruction
+ (macro (name opcode4)
+ `(define-instruction ,name
+ (((? oplen ea-r-w) (? op ea-a-b)
+ (? reslen ea-r-w) (? res ea-a-b))
+ (BYTE (8 ,opcode4))
+ (OPERAND oplen)
+ (OPERAND op)
+ (OPERAND reslen)
+ (OPERAND res))
+
+ (((? op1len ea-r-w) (? op1 ea-a-b)
+ (? op2len ea-r-w) (? op2 ea-a-b)
+ (? reslen ea-r-w) (? res ea-a-b))
+ (BYTE (8 ,(1+ opcode4)))
+ (OPERAND op1len)
+ (OPERAND op1)
+ (OPERAND op2len)
+ (OPERAND op2)
+ (OPERAND reslen)
+ (OPERAND res))))))
+
+ (define-add/sub-bcd-instruction ADDP #x20)
+ (define-add/sub-bcd-instruction SUBP #x22))
+
+(let-syntax
+ ((define-add/sub-bcd-instruction
+ (macro (name opcode)
+ `(define-instruction ,name
+ (((? op1len ea-r-w) (? op1 ea-a-b)
+ (? op2len ea-r-w) (? op2 ea-a-b)
+ (? reslen ea-r-w) (? res ea-a-b))
+ (BYTE (8 ,opcode))
+ (OPERAND op1len)
+ (OPERAND op1)
+ (OPERAND op2len)
+ (OPERAND op2)
+ (OPERAND reslen)
+ (OPERAND res))))))
+
+ (define-add/sub-bcd-instruction MULP #x25)
+ (define-add/sub-bcd-instruction DIVP #x27))
+\f
+(define-instruction CMPP
+ (((? len ea-r-w) (? src1 ea-a-b) (? src2 ea-a-b))
+ (BYTE (8 #x35))
+ (OPERAND len)
+ (OPERAND src1)
+ (OPERAND src2))
+
+ (((? len1 ea-r-w) (? src1 ea-a-b) (? len2 ea-r-w) (? src2 ea-a-b))
+ (BYTE (8 #x37))
+ (OPERAND len1)
+ (OPERAND src1)
+ (OPERAND len2)
+ (OPERAND src2)))
+
+(define-instruction ASHP
+ (((? srclen ea-r-w) (? src ea-a-b)
+ (? round ea-r-b)
+ (? dstlen ea-r-w) (? dst ea-a-b))
+ (BYTE (8 #xF8))
+ (OPERAND srclen)
+ (OPERAND src)
+ (OPERAND round)
+ (OPERAND dstlen)
+ (OPERAND dst)))
+
+(define-instruction MOVP
+ (((? len ea-r-w) (? src ea-a-b) (? dst ea-a-b))
+ (BYTE (8 #x34))
+ (OPERAND len)
+ (OPERAND src)
+ (OPERAND dst)))
+\f
+(define-instruction CVTLP
+ (((? src ea-r-l) (? len ea-r-w) (? dst ea-a-b))
+ (BYTE (8 #xF9))
+ (OPERAND src)
+ (OPERAND len)
+ (OPERAND dst)))
+
+(define-instruction CVTPL
+ (((? len ea-r-w) (? src ea-a-b) (? dst ea-w-l))
+ (BYTE (8 #x36))
+ (OPERAND len)
+ (OPERAND src)
+ (OPERAND dst)))
+
+(let-syntax
+ ((define-cvt-trailing-instruction
+ (macro (name opcode)
+ `(define-instruction ,name
+ (((? srclen ea-r-w) (? src ea-a-b)
+ (? tbl ea-a-b)
+ (? dstlen ea-r-w) (? dst ea-a-b))
+ (BYTE (8 ,opcode))
+ (OPERAND srclen)
+ (OPERAND src)
+ (OPERAND tbl)
+ (OPERAND dstlen)
+ (OPERAND dst))))))
+
+ (define-cvt-trailing-instruction CVTPT #x24)
+ (define-cvt-trailing-instruction CVTTT #x26))
+
+(let-syntax
+ ((define-cvt-separate-instruction
+ (macro (name opcode)
+ `(define-instruction ,name
+ (((? srclen ea-r-w) (? src ea-a-b)
+ (? dstlen ea-r-w) (? dst ea-a-b))
+ (BYTE (8 ,opcode))
+ (OPERAND srclen)
+ (OPERAND src)
+ (OPERAND dstlen)
+ (OPERAND dst))))))
+
+ (define-cvt-separate-instruction CVTPS #x08)
+ (define-cvt-separate-instruction CVTSP #x09))
\ No newline at end of file
projects / mit-scheme.git / commitdiff