From cd56dd97336bf4347710c1c8be35dd131802bc7d Mon Sep 17 00:00:00 2001
From: "Guillermo J. Rozas" <edu/mit/csail/zurich/gjr>
Date: Fri, 14 Aug 1987 05:05:26 +0000
Subject: [PATCH] Initial revision

---
 v7/src/compiler/machines/vax/instr1.scm | 297 +++++++++++
 v7/src/compiler/machines/vax/instr2.scm | 581 +++++++++++++++++++++
 v7/src/compiler/machines/vax/instr3.scm | 661 ++++++++++++++++++++++++
 3 files changed, 1539 insertions(+)
 create mode 100644 v7/src/compiler/machines/vax/instr1.scm
 create mode 100644 v7/src/compiler/machines/vax/instr2.scm
 create mode 100644 v7/src/compiler/machines/vax/instr3.scm

diff --git a/v7/src/compiler/machines/vax/instr1.scm b/v7/src/compiler/machines/vax/instr1.scm
new file mode 100644
index 000000000..ff9efd2a9
--- /dev/null
+++ b/v7/src/compiler/machines/vax/instr1.scm
@@ -0,0 +1,297 @@
+#| -*-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))
+
+;;;; 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.
+
+|#
+
+;; 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)
+
+(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)
+
+;;;; 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)))
+
+(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)))
+
+(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)))
diff --git a/v7/src/compiler/machines/vax/instr2.scm b/v7/src/compiler/machines/vax/instr2.scm
new file mode 100644
index 000000000..b3c91f4cf
--- /dev/null
+++ b/v7/src/compiler/machines/vax/instr2.scm
@@ -0,0 +1,581 @@
+#| -*-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))
+
+(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))
+
+  ((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))
+
+  ((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))
+
+  ((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))
+
+  ((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)))
+
+(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)))
+
+(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))
+
+	    ((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)))
+
+(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)))
+
+(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)))
+
+(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))
diff --git a/v7/src/compiler/machines/vax/instr3.scm b/v7/src/compiler/machines/vax/instr3.scm
new file mode 100644
index 000000000..34b1a7deb
--- /dev/null
+++ b/v7/src/compiler/machines/vax/instr3.scm
@@ -0,0 +1,661 @@
+#| -*-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))
+
+(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)))
+
+;;;; 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)))
+
+(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)))
+
+(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)))
+
+;;; 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)))
+
+;;; 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)))
+
+;;;; 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))))))
+
+(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))
+
+(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))))
+
+(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))))
+
+(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))))
+
+(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)))
+
+;;;; 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))
+
+(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)))   
+
+(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
-- 
2.25.1