;;; -*- Mode:ZETALISP; Package:COMPILER2; Base:8 -*-

;;;	** (c) Copyright 1985 Texas Instruments Incorporated **
;;; This file contains the definition of the machine instruction set

;;; ***** DO NOT CHANGE THE NUMBER FOR ANY ENTRY OR REUSE ANY NUMBER ******
;;; ***** WITHOUT CONSULTING A UCODE WIZZARD!!			     ******

;;; QMI symbols define the instruction fields
;;; The instruction fields are:

(Defsysconst %%QMI-FULL-OPCODE   1107)
(Defsysconst %%QMI-DEST-OPCODE   1206)
(Defsysconst %%QMI-PUSH          1101)
  (Defsysconst %QMI-PUSH 1)				;push result on stack
  (Defsysconst %QMI-TEST 0)				;just set inds with res
(Defsysconst %%QMI-REGISTER      0603)  
  (Defsysconst %QMI-REG-LEX      3)			;lexical superiors
;;;  (Defsysconst %QMI-REG-CONST    4)	;PUNT CONSTANTS
  (Defsysconst %QMI-REG-IVAR     4)			;instance variables
  (Defsysconst %QMI-REG-LOCAL    5)
  (Defsysconst %QMI-REG-ARG      6)
  (Defsysconst %QMI-REG-PDL      7)			;offset ignored.
;;;  (Defsysconst %QMI-REG-IVAR     7)  ;NOW HAS OWN BASE REGISTER
(Defsysconst %%QMI-OFFSET        0006)
(Defsysconst %%QMI-INST-ADR      0011)
(Defsysconst %%QMI-MISC-OP       0011)
(Defsysconst %%QMI-AUX-OP        0011)
(Defsysconst %%QMI-BR-OFFSET     0011)
(Defsysconst %%QMI-CALL-DEST     1102)
  (Defsysconst %QMI-CALLDEST-INDS     0)		;result only sets indicators
  (Defsysconst %QMI-CALLDEST-PUSH     1)		;result pushed
  (Defsysconst %QMI-CALLDEST-RETURN   2)		;tail recursive, don't flush frame
  (Defsysconst %QMI-CALLDEST-TAIL-REC 3)		;tail recursive, do flush frame
(Defsysconst %%QMI-CALL-NUMARGS  1303)

(Defsysconst %%QMI-LEX-LEVEL     0402)
  (Defsysconst %QMI-LEX-PARENT0     0)
  (Defsysconst %QMI-LEX-PARENT1     1)
  (Defsysconst %QMI-LEX-Grandparent 2)
  (Defsysconst %QMI-LEX-Great-Grandparent 3)
(Defsysconst %%QMI-LEX-PARENT-OFFSET 0005)
(Defsysconst %%QMI-LEX-OTHER-OFFSET  0004)

(Defsysconst %%QMI-IVAR-MAPPED       0501)
(Defsysconst %%QMI-IVAR-INDEX        0005)

;;; Descriptors for the instructions.  Each descriptor is:
;;; (DEFOP <name or names> <opcode> <result-disposition> <arglist>
;;;        &Optional &Keyword :Documentation :Lisp-Function-P :No-Reg)
;;;
;;; Where:
;;;   <name or names> is the name of the instruction or a list of names.  If there are one
;;;             or more Lisp functions that compile directly to this instruction, then this
;;;             is a list whose CAR is the instruction name and remaining elements are the
;;;             names of lisp functions that compile directly to this.
;;;   <opcode> is the number which should be in the %%QMI-FULL-OPCODE field to represent this
;;;            instruction.
;;;   <result-disposition> is the "old style" destination symbol for what this instruction
;;;            does with its result:  D-PDL, D-INDS, or D-RETURN
;;;            Also D-VARIES if depends on subordinate op
;;;             and D-STORE  stores somewhere and also does D-INDS
;;;            Also D-NONE, does not affect the indicators
;;;   <arglist> is a list argument names.  This resembles a lambda-list for a Lisp function.
;;;             No lambda-list keywords are allowed.  Defaults to NIL if unsupplied.
;;;   :Lisp-Function-P  If present should be either T or NIL.  If T, then there
;;;             will be a Lisp function defined and which does this instruction.
;;;   :Documentation    If present is the documentation for this instruction.  Should be present
;;;             if Lisp-Function-P is Non-NIL.
;;;   :NO-REG   Default is NIL.  If non-NIL, there is no register field in this instruction.
;;;             It can not be arg prefetched.  The value of NO-REG is the name of the decode
;;;             template that decodes this instruction's reg field.

;; no reg and no push
(DEFOP AUX-GROUP          0 D-NONE () :No-Reg AUX)	;non-result ops
(DEFOP TEST-MISC-GROUP    1 D-INDS   () :No-Reg MISC)
(DEFOP TEST-MODULE-GROUP  2 D-INDS   () :No-Reg Nothing)
(DefOp EQ-IMMED           3 D-INDS (x immed-y) :No-Reg Immed )	;(EQ x y)
(DefOp =-IMMED            4 D-INDS (x immed-y) :No-Reg Immed )	;(= x y)
(DefOp >-IMMED            5 D-INDS (x immed-y) :No-Reg Immed )	;(> x y)
(DefOp <-IMMED            6 D-INDS (x immed-y) :No-Reg Immed )	;(< x y)
(DefOp Test-AREFI         7 D-INDS    () :No-Reg AREFI)

;; have reg and push
(DEFOP TEST               10 D-INDS   (obj))
(DEFOP (TEST-CAR CAR)     11 D-INDS   (list))
(DEFOP (TEST-CDR CDR)     12 D-INDS   (list))
(DEFOP (TEST-CADR CADR)   13 D-INDS   (list))
(DEFOP (TEST-CDDR CDDR)   14 D-INDS   (list))
(DEFOP (TEST-CAAR CAAR)   15 D-INDS   (list))
(DEFOP (TEST-CDAR CDAR)   16 D-INDS   (list))
(DEFOP RETURN             17 D-RETURN   (val))	;<---- NOTE:  TRANSFER OF CONTROL

;;; Comparison
(DefOp (= INTERNAL-=)    20 D-INDS (x y))
(DefOp (> INTERNAL->)    21 D-INDS (x y))
(DefOp (< INTERNAL-<)    22 D-INDS (x y))
(DefOp EQ                23 D-INDS (x y) :Lisp-Function-P T)
(DefOp EQL               24 D-INDS (x y) :Lisp-Function-P T)
(DefOp EQUAL             25 D-INDS (x y) :Lisp-Function-P T)
(DefOp EQUALP            26 D-INDS (x y) :Lisp-Function-P T)


;;; Other predicates
(DefOp Numberp           30 D-INDS (x) :Lisp-Function-P T)
(DefOp Arrayp            31 D-INDS (x) :Lisp-Function-P T)
(DefOp CLI:Listp         32 D-INDS (x) :Lisp-Function-P T)	;common-lisp listp   <--- NOTE  CLI:
(DefOp Stringp           33 D-INDS (x) :Lisp-Function-P T)
(DefOp Fixnump           34 D-INDS (x) :Lisp-Function-P T)
(DefOp (Integerp Fixp Integerp) 35 D-INDS (x) :Lisp-FUnction-P T)
(DefOp Plusp             36 D-INDS (x) :Lisp-FUnction-P T)
(DefOp Minusp            37 D-INDS (x) :Lisp-FUnction-P T)

;; have no reg but push
;; 40
(DEFOP PUSH-MISC-GROUP   41 D-PDL    () :No-Reg MISC)
(DEFOP PUSH-MODULE-GROUP 42 D-PDL    () :No-Reg Nothing)
(DEFOP ADD-IMMED         43 D-PDL    (x immed-y) :No-Reg Immed)
(DEFOP LDB-IMMED         44 D-PDL    (x immed-PPSS) :No-Reg Nothing)	;immed<8:4> is 5-bit pos immed<3:0> is 4-bit len
(DefOp Push-Number       45 D-PDL    () :No-Reg Nothing)
(DefOp Push-Neg-Number   46 D-PDL () :No-Reg Nothing)
;;; AREFI
(DefOp Push-ArefI        47 D-PDL     () :No-Reg AREFI)

;; have reg and push
(DEFOP PUSH              50 D-PDL    (obj))
(DEFOP (PUSH-CAR CAR)    51 D-PDL    (list))
(DEFOP (PUSH-CDR CDR)    52 D-PDL    (list))
(DEFOP (PUSH-CADR CADR)  53 D-PDL    (list))
(DEFOP (PUSH-CDDR CDDR)  54 D-PDL    (list))
(DEFOP (PUSH-CADDR CADDR) 55 D-PDL   (list))
(DEFOP (PUSH-CONS CONS)  56 D-PDL    (car cdr))
(DEFOP (PUSH-GET INTERNAL-GET-2) 57 D-PDL    (sym ind))

;; have reg and push
;;; Arith
(DefOp *PLUS             60 D-PDL    (x y))
(DefOp *DIF              61 D-PDL    (x y))
(DefOp *TIMES            62 D-PDL    (x y))
(DefOp *LOGAND           63 D-PDL    (x y))
(DefOp *LOGXOR           64 D-PDL    (x y))
(DefOp 1+                65 D-PDL    (x) :Lisp-FUnction-P T)
(DefOp 1-                66 D-PDL    (x) :Lisp-FUnction-P T)
(DefOp PUSH-AR-1         67 D-PDL    (idx array))	;this is common-lisp-ar1

;;Random
;;; 70-77 use arg in funny ways
(DefOp Push-Long-FEF   70 D-PDL    (x) :No-Reg Nothing)		;9-bit FEF offset
(DefOp Select          71 D-INDS (x seltable) :No-Reg Nothing)	;table at 9-bit FEF offset
(DefOp Dispatch        72 D-INDS (index disptable) :No-Reg Nothing)   ;table at 9-bit FEF offset
;; 73 reserved for CASE
(DefOp (Make-Stack-Closure)             74 D-PDL     () :No-Reg Nothing)	;9-bit local slot num
(DefOp (Stack-Closure-Disconnect)       75 D-PDL () :No-Reg Nothing)	;9-bit local slot num
(DefOp (Stack-Closure-Unshare)          76 D-PDL   () :No-Reg Nothing)	;9-bit local slot num
(DefOp (Stack-Closure-Disconnect-First) 77 D-PDL () :No-Reg Nothing)	;9-bit local slot num

;; Calling Ops:  Reg and Transfer of Control
(Def-CallOp CALL-0    100 (func))
(Def-CallOp CALL-1    104 (func))
(Def-CallOP CALL-2    110 (func))
(Def-CallOp CALL-3    114 (func))
(Def-CallOp CALL-4    120 (func))
(Def-CallOp CALL-5    124 (func))
(Def-CallOp CALL-6    130 (func))
(Def-CallOp CALL-N    134 (n func))		;punted CALL-7
;;; (Def-CallOp CALL-COMPLEX 134 (n call-type-code func)) ;;; make it an AUX op

;;; Storing
(DefOp POP               140 D-STORE  (obj loc))
(DefOp MOVEM             141 D-STORE  (obj loc))	;movem pdl-push is eqv DUP
(DefOp SETE-CDR          142 D-STORE  (loc))
(DefOp SETE-CDDR         143 D-STORE  (loc))
(DefOp SETE-1+           144 D-STORE  (loc))
(DefOp SETE-1-           145 D-STORE  (loc))
;; 146
(DefOp (PUSH-CDR-Store-CAR-IF-CONS) 147 D-STORE (x dest))	;flush this??? reluctantly no!!

(DefOp PUSH-LOC          150 D-PDL    (loc))	;don't store but return address
;;; Binding
(DefOp BIND-NIL          151 D-STORE  (loc))
(DefOp BIND-T            152 D-STORE  (loc)) 
(DefOp BIND-POP          153 D-STORE  (newval loc))
(DefOp BIND-CURRENT      154 D-STORE  (loc))
;; Setting
(DefOp SET-NIL           155 D-STORE (loc))
(DefOp SET-T             156 D-STORE (loc))
(DefOp SET-ZERO          157 D-STORE (loc))

;; Branching Ops: No Reg but transfer of control
;;; simple BR ops
(Def-Branch-Op NULL TRUE   T   160)		;BR-NIL-ELSE-POP
(Def-Branch-Op NULL FALSE  T   161)		;BR-NOT-NIL-ELSE-POP
(Def-Branch-Op NULL TRUE   NIL 162)		;BR-NIL tests indicators
(Def-Branch-Op NULL FALSE  NIL 163)		;BR-NOT-NIL tests indicators
(Def-Branch-Op ATOM TRUE   NIL 164)		;BR-ATOM tests indicators
(Def-Branch-Op ATOM FALSE  NIL 165)		;BR-NOT-ATOM tests indicators
(Def-Branch-Op ZEROP TRUE  NIL 166)		;BR-ZEROP tests indicators
(Def-Branch-Op ZEROP FALSE NIL 167)		;BR-NOT-ZEROP tests indicators


(Def-Branch-Op SYMBOLP TRUE  NIL 170)
(Def-Branch-Op SYMBOLP FALSE NIL 171)
;; 172-173
;;; 174-177 are special BRANCH-LIKELY instructions
;;; Hummingbird hardware will follow these branches in the macro-pipeline
;;; 
(Def-Branch-Op NULL TRUE NIL  174 LIKELY)	;BR-NIL-LIKELY will almost always branch 
(Def-Branch-Op NULL FALSE NIL  175 LIKELY)	;BR-NOT-NIL-LIKELY will almost always branch
(Def-Branch-Op ALWAYS NIL NIL 176)		;Branches always, very likely to branch
;;; 177 is illegal

;;; AUX instructions
;;; These are instructions that don't produce a result that are
;;; extensions to the main instruction set like MISC and MODULE instructions.

;;; 0-67 Random instructions
;; 0 is reserved as an illegal instruction so that the unused halfword at the end of some FEF's 
;;   can contain a known invalid instruction.
;; these are sort of invalid too.
(Def-Aux-Op BREAKPOINT        1)
(Def-Aux-Op (HALT %HALT)      2)
(Def-Aux-Op (CRASH %CRASH)    3)
;; 4-7

;; 10 starts stack hacking instructions
(Def-Aux-Op EXCHANGE           10)		;swaps top two items on stack
(Def-Aux-Op %SPREAD            11 (list))	;would always return NIL
(Def-Aux-Op %ASSURE-PDL-ROOM   12 (room))	;Trap if not ROOM more words in PDL frame
(Def-Aux-Op POP-M-FROM-UNDER-N 13 (NUM-POPS NUM-TO-KEEP))  ; was miscop 374
(Def-Aux-Op POPJ               14 (return-PC))	;or call it RETURN-SUBR, will bounds-check PC
;; 15
(Def-Aux-Op %USING-BINDING-INSTANCES 16 (BINDING-INSTANCES))	;525
(Def-Aux-Op UNBIND-TO-INDEX    17 (SPECIAL-PDL-INDEX))	;was 645

;; 20-21
(Def-Aux-Op %SET-SELF-MAPPING-TABLE  22 (MAPPING-TABLE))	;i??, 336
;; 23-25
(Def-Aux-Op STACK-GROUP-RETURN 26 (X) :Lisp-FUnction-P T)	;537
(Def-Aux-Op STACK-GROUP-RESUME 27 (SG X) :Lisp-FUnction-P T)	;542

;; Complex Funcall - 100
(Def-Aux-Op Complex-Call 100) ; uses call-info word
(Def-Aux-Op APPLY 104)
;(Def-Aux-Op FUNCALL-WITH-MAPPING-TABLE 110)
(Def-Aux-Op LEXPR-FUNCALL-WITH-MAPPING-TABLE 114)

(Def-Aux-Op Complex-Call-to-Inds     100  (callinfo function))
(Def-Aux-Op Complex-Call-to-Push     101  (callinfo function))
(Def-Aux-Op Complex-Call-to-Return   102  (callinfo function))
(Def-Aux-Op Complex-Call-to-Tail-Rec 103  (callinfo function))

(Def-Aux-Op Apply-to-Inds            104  (fn arglist))
(Def-Aux-Op Apply-to-Push            105  (fn arglist))
(Def-Aux-Op Apply-to-Return          106  (fn arglist))
(Def-Aux-Op Apply-to-Tail-Rec        107  (fn arglist))

(Def-Aux-Op Return-N                 120 (numvals))	;returns top NUMVALS things on stack
(Def-Aux-Op Return-List              121 (VALUES))	;404
(Def-Aux-Op Return-NIL		     122 ())
(Def-Aux-Op Return-T                 123 ())

(Def-Aux-Op %Open-Catch              124 (catch-tag restart-pc))
(Def-Aux-Op %Open-Catch-Multiple-Value 125 (catch-tag restart-pc number-of-values))
(Def-Aux-Op %Open-Catch-Tail-Recursive 126 (catch-tag restart-pc))	;why need?  Lose the name.
;; 127

;; 130 throw and friends
(Def-Aux-Op %THROW             130 (TAG VALUE))	;was 470
(Def-Aux-Op %THROW-N           131 (TAG &REST VALUES-AND-COUNT))	;was 447
;;;(DEF-AUX-OP THROW-SPREAD       132 (TAG VALUE-LIST))	;was 554
(Def-Aux-Op *Unwind-Stack      133 (TAG VALUE FRAME-COUNT ACTION))	;was 636
(Def-Aux-Op %Close-Catch       134 ())
(Def-Aux-Op %Close-Catch-Return 135 ())		;return all values above catch block

(Def-Aux-Op Return-Pred              136 ())	;returns NIL iff (null inds) else returns T
(Def-Aux-Op Return-Not-Inds          137 ())	;returns T iff (null inds) else returns NIL


;; Paging - 140
(Def-Aux-Op %CHANGE-PAGE-STATUS   140 (VIRT-ADDR SWAP-STATUS ACCESS-AND-META))
;; 141-142
(Def-Aux-Op %PAGE-IN              143 (PFN VPN))
(Def-Aux-Op %RETURN-PAGE-CLUSTER  144 (page-device-number cluster-offset-number))
(Def-Aux-Op %ADD-PAGE-DEVICE      145 (unit-number starting-block size))	;may don't have
(Def-Aux-Op %CREATE-PHYSICAL-PAGE 146 (PHYS-ADDR))
(Def-Aux-Op %DELETE-PHYSICAL-PAGE 147 (PHYS-ADDR))

;; GC - 150
(Def-Aux-Op %GC-FREE-REGION  150 (REGION))
(Def-Aux-Op %GC-FLIP         151 (REGION))
(Def-Aux-Op %GC-SCAVENGE     152 (WORK-UNITS))
(Def-Aux-Op %GC-CONS-WORK    153 (NQS))
;; 154-155
;; disk save/restore
(Def-Aux-Op %DISK-RESTORE    156 (PARTITION-HIGH-16-BITS LOW-16-BITS PHYSICAL-UNIT))	;530
;;;(Def-Aux-Op %DISK-SAVE       157 (MAIN-MEMORY-SIZE PARTITION-HIGH-16-BITS LOW-16-BITS PHYSICAL-UNIT) T)	;531

;; Long Branch 160-177
;; same AUX OP as main branch op
;; these should be absolute rather than relative PC's
(Def-Aux-Op Long-BR-NULL-ELSE-POP     160)
(Def-Aux-Op Long-BR-NOT-NULL-ELSE-POP 161)
(Def-Aux-Op Long-BR-NULL              162)
(Def-Aux-Op Long-BR-NOT-NULL          163)
(Def-Aux-Op Long-BR-ATOM              164)
(Def-Aux-Op Long-BR-Not-ATOM          165)
(Def-Aux-Op Long-BR-ZeroP             166)
(Def-Aux-Op Long-BR-Not-ZeroP         167)
(Def-Aux-Op Long-BR-SYMBOLP           170)
(Def-Aux-Op Long-BR-NOT-SYMBOLP       171)
;; 172-173
(Def-Aux-Op Long-BR-NULL-LIKELY       174)
(Def-Aux-Op Long-BR-NOT-NULL-LIKELY   175)
(Def-Aux-Op Long-BR                   176)
(Def-Aux-Op Long-PUSHJ                177)	;or call it BR-Subr

;;;200-377 unused.  Reserved for future expansion

;;;400-477 UNBIND
;; block decode low 6-bits of op is number of unbinds to do.
(Def-Aux-Op Unbind-1         400)
(Def-Aux-Op Unbind-2         401)
(Def-Aux-Op Unbind-3         402)
(Def-Aux-Op Unbind-4         403)
(Def-Aux-Op Unbind-5         404)
(Def-Aux-Op Unbind-6         405)
(Def-Aux-Op Unbind-7         406)
(Def-Aux-Op Unbind-8         407)
(Def-Aux-Op Unbind-9         410)
(Def-Aux-Op Unbind-10        411)
(Def-Aux-Op Unbind-11        412)
(Def-Aux-Op Unbind-12        413)
(Def-Aux-Op Unbind-13        414)
(Def-Aux-Op Unbind-14        415)
(Def-Aux-Op Unbind-15        416)
(Def-Aux-Op Unbind-16        417)
;; on to (Def-Aux-Op Unbind-64  477)??

;;; 500-577 POP-PDL
(Def-Aux-Op Pop-PDL-1        500)
(Def-Aux-Op Pop-PDL-2        501)
(Def-Aux-Op Pop-PDL-3        502)
(Def-Aux-Op Pop-PDL-4        503)
(Def-Aux-Op Pop-PDL-5        504)
(Def-Aux-Op Pop-PDL-6        505)
(Def-Aux-Op Pop-PDL-7        506)
(Def-Aux-Op Pop-PDL-8        507)
(Def-Aux-Op Pop-PDL-9        510)
(Def-Aux-Op Pop-PDL-10       511)
(Def-Aux-Op Pop-PDL-11       512)
(Def-Aux-Op Pop-PDL-12       513)
(Def-Aux-Op Pop-PDL-13       514)
(Def-Aux-Op Pop-PDL-14       515)
(Def-Aux-Op Pop-PDL-15       516)
(Def-Aux-Op Pop-PDL-16       517)
;; on to (Def-Aux-Op Pop-PDL-64   577)??

;;; 600-677 Return-N
(Def-Aux-Op Return-0         600)
(Def-Aux-Op Return-1         601)		;redundant.  Not needed.
(Def-Aux-Op Return-2         602)
(Def-Aux-Op Return-3         603)
(Def-Aux-Op Return-4         604)
(Def-Aux-Op Return-5         605)
(Def-Aux-Op Return-6         606)
(Def-Aux-Op Return-7         607)
(Def-Aux-Op Return-8         610)
(Def-Aux-Op Return-9         611)
(Def-Aux-Op Return-10        612)
(Def-Aux-Op Return-11        613)
(Def-Aux-Op Return-12        614)
(Def-Aux-Op Return-13        615)
(Def-Aux-Op Return-14        616)
(Def-Aux-Op Return-15        617)
(Def-Aux-Op Return-16        620)
(Def-Aux-Op Return-17        621)
(Def-Aux-Op Return-18        622)
(Def-Aux-Op Return-19        623)
(Def-Aux-Op Return-20        624)
(Def-Aux-Op Return-21        625)
(Def-Aux-Op Return-22        626)
(Def-Aux-Op Return-23        627)
(Def-Aux-Op Return-24        630)
(Def-Aux-Op Return-25        631)
(Def-Aux-Op Return-26        632)
(Def-Aux-Op Return-27        633)
(Def-Aux-Op Return-28        634)
(Def-Aux-Op Return-29        635)
(Def-Aux-Op Return-30        636)
(Def-Aux-Op Return-31        637)
;;; on to (Def-Aux-Op Return-63        677)??

;; 700-777

;;; MODULE instructions
;;; have module name and instruction name.
;;; There may be up to 16 instructions in a module
;;; These are for "optional" instructions.

(Def-Module TV 0)
;;;(Def-Module TV)
(Def-Module-Op %DRAW-CHAR TV      0 (FONT-ARRAY CHAR-CODE X-BITPOS Y-BITPOS ALU-FUNCTION SHEET))
(Def-Module-Op %DRAW-RECTANGLE TV 1 (WIDTH HEIGHT X-BITPOS Y-BITPOS ALU-FUNCTION SHEET))
(Def-Module-Op %DRAW-LINE TV      2 (X0 Y0 X Y ALU DRAW-END-POINT SHEET))
(Def-Module-Op %DRAW-FILLED-TRIANGLE TV 4 (X1 Y1 X2 Y2 X3 Y3 
   LEFT-EDGE TOP-EDGE RIGHT-EDGE BOTTOM-EDGE
   ALU DRAW-THIRD-EDGE DRAW-SECOND-EDGE DRAW-FIRST-EDGE FILL-COLOR DESTINATION))
(Def-Module-Op %DRAW-FILLED-RASTER-LINE TV 5 (X1 X2 Y LEFT-EDGE TOP-EDGE RIGHT-EDGE BOTTOM-EDGE 
   ALU DRAW-LAST-POINT FILL-COLOR DESTINATION))
;(Def-Module-Op %Draw-String TV   6 (font-array string x-bitpos y-bitpos alu-function sheet))
;(Def-Module-Op %Draw-Ellipse TV  7 ())
;(Def-Module-Op %Draw-Filled-Ellipse 10 ())
;;  11-17

(Def-Module MOUSE 1)
;;;(Def-Module MOUSE)
(Def-Module-Op %SET-MOUSE-SCREEN MOUSE  0 (SHEET))
(Def-Module-Op %OPEN-MOUSE-CURSOR MOUSE 1 ())

;;; MISC instructions
;;; These are extended instructions
;;; Each is potentially available in either D-INDS or D-PDL but many are available
;;; only in one form.  These are grouped together to decrease the decoding tables
;;; required.

;;; 0-200 both D-PDL and D-INDS, hard to tell which is usual
;;; These are accessors
(Def-MISC-Op (M-CAR CAR) 2 (X) :Lisp-FUnction-P T)
(Def-MISC-OP (M-CDR CDR) 3 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CAAR 4 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP (M-CADR CADR) 5 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CDAR 6 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP (M-CDDR CDDR) 7 (X)  :Lisp-FUnction-P T)

;;; These could work on bit pattern
;;; of the low 3 bits  1=CDR and 0=CAR
(Def-MISC-OP CAAAR 10 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CAADR 11 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CADAR 12 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CADDR 13 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CDAAR 14 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CDADR 15 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CDDAR 16 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CDDDR 17 (X)  :Lisp-FUnction-P T)

;;; These could work on bit pattern
;;; of the low 4 bits 1=CDR and 0=CAR
(Def-MISC-OP CAAAAR 20 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CAAADR 21 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CAADAR 22 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CAADDR 23 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CADAAR 24 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CADADR 25 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CADDAR 26 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CADDDR 27 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CDAAAR 30 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CDAADR 31 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CDADAR 32 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CDADDR 33 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CDDAAR 34 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CDDADR 35 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CDDDAR 36 (X)  :Lisp-FUnction-P T)
(Def-MISC-OP CDDDDR 37 (X)  :Lisp-FUnction-P T)


;; 40 - stack hacking
(Def-Misc-Op PDL-WORD     40 (N))			;337
(Def-Misc-Op SHRINK-PDL-SAVE-TOP 41 (VALUE-TO-MOVE N-SLOTS))	;643
;;i (Def-Misc-Op *CATCH       42 (TAG &REST FORMS))		;466
;;i (Def-Misc-Op %UNWIND-PROTECT-CONTINUE 43 (VALUE TAG COUNT ACTION))	;655
;; 44-47

;; TI IO instruction
;; %-functions
(DEF-MISC-OP %P-DPB           50 (VALUE PPSS POINTER) :Lisp-FUnction-P T)
(DEF-MISC-OP %P-DEPOSIT-FIELD 51 (VALUE PPSS POINTER) :Lisp-FUnction-P T)
(DEF-MISC-OP %P-DPB-OFFSET    52 (VALUE PPSS POINTER OFFSET) :Lisp-FUnction-P T)
(DEF-MISC-OP %P-DEPOSIT-FIELD-OFFSET 53 (VALUE PPSS POINTER OFFSET) :Lisp-FUnction-P T)
;; 54-56
;; GC
(Def-Misc-Op %GC-SCAV-RESET   57 (REGION))

;; %-functions
;; 60
(Def-Misc-Op %STORE-IN-HIGHER-CONTEXT   61 (VALUE ENVPTR))
(Def-Misc-Op %P-STORE-CONTENTS          62 (POINTER VALUE) :Lisp-FUnction-P T)
(Def-Misc-Op %P-STORE-TAG-AND-POINTER   63 (POINTER MISC-FIELDS POINTER-FIELD) :Lisp-FUnction-P T)
(Def-Misc-Op %P-STORE-CDR-CODE          64 (POINTER CDR-CODE) :Lisp-FUnction-P T)
(Def-Misc-Op %P-STORE-DATA-TYPE         65 (POINTER DATA-TYPE) :Lisp-FUnction-P T)
(Def-Misc-Op %P-STORE-POINTER           66 (POINTER POINTER-TO-STORE) :Lisp-FUnction-P T)
(Def-Misc-Op %P-STORE-CONTENTS-OFFSET   67 (VALUE POINTER OFFSET) :Lisp-FUnction-P T)

;;; Symbols both dests
(Def-Misc-Op INTERNAL-GET-2  70 (SYMBOL PROPERTY))	;320
(Def-Misc-Op GETL            71 (SYMBOL PROPERTY-NAME-LIST) :Lisp-FUnction-P T)	;321
(Def-Misc-Op GET-LOCATION-OR-NIL 72 (SYMBOL PROPERTY) :Lisp-FUnction-P T)
(Def-Misc-Op INTERNAL-GET-3  73 (SYMBOL PROPERTY DEFAULT))	;1022
;; 74-75
(Def-Misc-Op Predicate       76 ())		;result is NIL iff (null inds) else T
(Def-Misc-Op Not-Indicators  77 ())		;result is T   iff (null inds) else NIL

;;; 200-377 usually D-INDS
(Def-Misc-Op BIND      200 (loc val))


;; I/O -- mostly writes
(Def-Misc-Op %IO                     210 (RQB DEVICE-DESC) :Lisp-FUnction-P T)	;returns NIL, 1023
(DEF-Misc-OP %ADD-INTERRUPT     211 (DEVICE-DESC LEVEL))	;1024
;; 212-213
(DEF-Misc-OP %MULTIBUS-WRITE-16 214  (MULTIBUS-BYTE-ADR WORD) :Lisp-Function-P T)	;733
(DEF-Misc-OP %MULTIBUS-WRITE-8  215  (MULTIBUS-BYTE-ADR WORD) :Lisp-Function-P T)	;735
(DEF-Misc-OP %MULTIBUS-WRITE-32 216  (MULTIBUS-BYTE-ADR WORD) :Lisp-Function-P T)	;737

;;NuBus IO instructions
;;  SLOT is really the high 8 bits.
;;  the "top F" can be supplied via slot, avoiding bignums.
(DEF-Misc-OP %NUBUS-WRITE       217 (NUBUS-SLOT SLOT-BYTE-ADR WORD) :Lisp-FUnction-P T)	;762

;; NEW NuBus Instructions
(Def-Misc-Op %NuBus-Write-8B    220 (Hi-Address Low-Address Data) :Lisp-FUnction-P T)	;1031
(Def-Misc-Op %NuBus-Write-16B   221 (Hi-Address Low-Address Data) :Lisp-FUnction-P T)	;1033
;;; Next opcode is reserved for when (and if) implemented.
;;;(Def-Misc-OP %NuBus-Write-32B   222 (Hi-Address Low-Address Data) T)
(Def-Misc-Op %blt-to-physical   223		;1045
	(source-address destination-address number-of-words increment) :Lisp-FUnction-P T)
(Def-Misc-Op %blt-from-physical 224		;1046
	(source-address destination-address number-of-words increment) :Lisp-FUnction-P T)
;; 225-226
(Def-Misc-Op %TEST&SET-68K      227 (Hi-Address Low-Address))

;;; Predicates usually D-INDS
(Def-Misc-Op FLOATP          230 (X) :Lisp-FUnction-P T)		;334
(Def-Misc-Op LENGTH-GREATERP 231 (LIST-OR-ARRAY VALUE) :Lisp-FUnction-P T)	;407
(Def-Misc-Op INTERNAL-CHAR-EQUAL 232 (CH1 CH2))	;414
(Def-Misc-Op %STRING-EQUAL   233 (STRING1 INDEX1 STRING2 INDEX2 COUNT) :Lisp-FUnction-P T)	;416
(Def-Misc-Op ARRAY-HAS-LEADER-P 234 (ARRAY) :Lisp-FUnction-P T)	;503
(Def-Misc-Op NLISTP          235 (X) :Lisp-FUnction-P T)		;570
(Def-Misc-Op NSYMBOLP        236 (X) :Lisp-FUnction-P T)		;572
(Def-Misc-Op FBOUNDP         237 (SYMBOL) :Lisp-FUnction-P T)	;574

(Def-Misc-Op BOUNDP            240 (SYMBOL) :Lisp-FUnction-P T)	;576
(Def-Misc-Op ARRAY-HAS-FILL-POINTER-P 241 (ARRAY) :Lisp-FUnction-P T)	;750, d??
;;; 242
(Def-Misc-Op COMMON-LISP-LISTP 243 (OBJECT) :Lisp-FUnction-P T)	;760
(Def-Misc-Op VECTORP           244 (OBJECT) :Lisp-FUnction-P T)	;770
(Def-Misc-Op SIMPLE-VECTOR-P   245 (OBJECT) :Lisp-FUnction-P T)	;771
(Def-Misc-Op SIMPLE-ARRAY-P    246 (OBJECT) :Lisp-FUnction-P T)	;772
(Def-Misc-Op SIMPLE-STRING-P   247 (OBJECT) :Lisp-FUnction-P T)	;773

(Def-Misc-Op BIT-VECTOR-P      250 (OBJECT) :Lisp-FUnction-P T)	;774
(Def-Misc-Op SIMPLE-BIT-VECTOR-P 251 (OBJECT) :Lisp-FUnction-P T)	;775
(Def-Misc-Op TYPEP-STRUCTURE-OR-FLAVOR 252 (OBJECT TYPE) :Lisp-FUnction-P T)	;777
(DEF-MISC-OP SMALL-FLOATP      253 (OBJECT) :Lisp-FUnction-P T)	;1001
(DEF-MISC-OP CHARACTERP        254 (OBJECT) :Lisp-FUnction-P T)	;1002
(DEF-MISC-OP ENDP              255 (LIST) :Lisp-FUnction-P T)	;1013
(DEF-MISC-OP Rationalp         256 (X) :Lisp-FUnction-P T)	;1040
(DEF-MISC-OP Ratiop            257 (X) :Lisp-FUnction-P T)	;1041

(DEF-MISC-OP Complexp          260 (X) :Lisp-FUnction-P T)	;1042
(Def-Misc-Op EQ-T              261 (OBJECT) NIL)
;;262-267

;; List functions to INDS
(Def-Misc-Op RPLACA   300 (CONS NEW-CAR) :Lisp-FUnction-P T)	;327
(Def-Misc-Op RPLACD   301 (CONS NEW-CDR) :Lisp-FUnction-P T)	;330
(Def-Misc-Op SETCAR   302 (CONS NEWCAR) :Lisp-FUnction-P T)	;724
(Def-Misc-Op SETCDR   303 (CONS NEWCDR) :Lisp-FUnction-P T)	;725
(Def-Misc-Op CONSP-OR-POP 304 (OBJECT))	;1014
;; 305-306
;;; Sequence fns D-INDS
(Def-Misc-Op SETELT   307 (SEQUENCE INDEX VALUE) :Lisp-FUnction-P T)	;711

;;; Symbols D-INDS
(Def-Misc-Op SET           310 (SYMBOL VALUE) :Lisp-FUnction-P T)	;332
;; 311-317

;; Array to Inds 
(Def-Misc-Op STORE-ARRAY-LEADER 320 (VALUE ARRAY INDEX) :Lisp-FUnction-P T)	;431
(Def-Misc-Op AS-1         321 (VALUE ARRAY SUB) :Lisp-FUnction-P T)	;515
(Def-Misc-Op AS-2         322 (VALUE ARRAY SUB1 SUB2) :Lisp-FUnction-P T)	;516
(Def-Misc-Op AS-3         323 (VALUE ARRAY SUB1 SUB2 SUB3) :Lisp-FUnction-P T)	;517
(Def-Misc-Op AS-1-FORCE   324 (VALUE ARRAY INDEX) :Lisp-FUnction-P T)	;715
(Def-Misc-Op AS-2-REVERSE 325 (VALUE ARRAY INDEX2 INDEX1) :Lisp-FUnction-P T)	;540
;; 326-327

(Def-Misc-Op SET-ARRAY-LEADER 330 (ARRAY INDEX VALUE) :Lisp-FUnction-P T)	;745
(Def-Misc-Op SET-AR-1     331 (ARRAY SUBSCRIPT VALUE) :Lisp-FUnction-P T)	;740
(Def-Misc-Op SET-AR-2     332 (ARRAY SUBSCRIPT1 SUBSCRIPT2 VALUE) :Lisp-FUnction-P T)	;741
(Def-Misc-Op SET-AR-3     334 (ARRAY SUBSCRIPT1 SUBSCRIPT2 SUBSCRIPT3 VALUE) :Lisp-FUnction-P T)	;742
(Def-Misc-Op SET-AR-1-FORCE 335 (ARRAY SUBSCRIPT VALUE) :Lisp-FUnction-P T)	;743
;; 336-337

(Def-Misc-Op ARRAY-PUSH   340 (ARRAY VALUE) :Lisp-FUnction-P T)	;433
(Def-Misc-Op VECTOR-PUSH  341 (NEW-ELEMENT VECTOR) :Lisp-FUnction-P T)	;747
(Def-Misc-Op COPY-ARRAY-CONTENTS 342 (FROM TO) :Lisp-FUnction-P T)	;500
(Def-Misc-Op COPY-ARRAY-CONTENTS-AND-LEADER 343 (FROM TO) :Lisp-FUnction-P T)	;501
(Def-Misc-Op COPY-ARRAY-PORTION 344 (FROM-ARRAY FROM-START FROM-END TO-ARRAY TO-START TO-END) :Lisp-FUnction-P T)	;504
(Def-Misc-Op BITBLT 345 (ALU WIDTH HEIGHT FROM-ARRAY FROM-X FROM-Y TO-ARRAY TO-X TO-Y) :Lisp-FUnction-P T)	;665
(Def-Misc-Op %BLT              346 (FROM-ADDRESS TO-ADDRESS COUNT INCREMENT) :Lisp-FUnction-P T)	;467
(Def-Misc-Op %BLT-TYPED        347 (FROM-ADDRESS TO-ADDRESS COUNT INCREMENT) :Lisp-FUnction-P T)	;712

;;; Instance support to stack
;; 350-353
(Def-Misc-Op SET-%INSTANCE-REF 354 (INSTANCE INDEX VALUE))	;746
;; 355-357

;; 360-367

;; Random %-fns
(Def-Misc-Op %WRITE-INTERNAL-PROCESSOR-MEMORIES 370 (CODE ADR D-HI D-LOW))	;656
(Def-Misc-Op %PAGE-TRACE   371 (TABLE))	;446
(Def-Misc-Op %RECORD-EVENT      372 (DATA-4 DATA-3 DATA-2 DATA-1 STACK-LEVEL EVENT MUST-BE-4))	;705
;; 373-377

;;; 400-777 usually D-PDL
;; Stack
(Def-Misc-Op %MAKE-STACK-LIST 400 (N))	;541
(Def-Misc-Op %MAKE-EXPLICIT-STACK-LIST 401 (LENGTH))	;677
(Def-Misc-Op %MAKE-EXPLICIT-STACK-LIST* 402 (LENGTH))	;723
;; 403
(Def-Misc-Op %STACK-FRAME-POINTER 404 ())	;635
(Def-Misc-Op SPECIAL-PDL-INDEX 405 NIL)	;644
(Def-Misc-Op UNBIND-TO-INDEX-MOVE 406 (SPECIAL-PDL-INDEX VALUE-TO-MOVE))	;646
;; 407

;; Consing
(Def-Misc-Op NCONS         410 (CAR) :Lisp-FUnction-P T)		;364
(Def-Misc-Op NCONS-IN-AREA 411 (CAR AREA) :Lisp-FUnction-P T)	;365
(Def-Misc-Op CONS          412 (CAR CDR) :Lisp-FUnction-P T)	;366
(Def-Misc-Op CONS-IN-AREA  413 (CAR CDR AREA) :Lisp-FUnction-P T)	;367
(Def-Misc-Op %MAKE-LIST    414 (INITIAL-VALUE AREA LENGTH) :Lisp-FUnction-P T)	;435
(Def-Misc-Op %ALLOCATE-AND-INITIALIZE 415 (RETURN-DTP HEADER-DTP HEADER WORD2 AREA NQS) :Lisp-FUnction-P T)	;615
(Def-Misc-Op %ALLOCATE-AND-INITIALIZE-ARRAY 416 (HEADER INDEX-LENGTH LEADER-LENGTH AREA NQS) :Lisp-FUnction-P T)	;616
(DEF-MISC-OP %Ratio-Cons        417 (Numerator Denominator) :Lisp-FUnction-P T)	;not in use but should be!!  ,  1037

;; 420-427

;; I/O
(Def-Misc-Op %PHYSICAL-ADDRESS 430 (PTR) :Lisp-FUnction-P T)	;667
(Def-Misc-Op %MULTIBUS-READ-16 431 (MULTIBUS-BYTE-ADR) :Lisp-FUnction-P T)	;732
(Def-Misc-Op %MULTIBUS-READ-8  432 (MULTIBUS-BYTE-ADR) :Lisp-FUnction-P T)	;734
(Def-Misc-Op %MULTIBUS-READ-32 433 (MULTIBUS-BYTE-ADR) :Lisp-FUnction-P T)	;736
(Def-Misc-Op %NUBUS-READ       434 (NUBUS-SLOT SLOT-BYTE-ADR) :Lisp-FUnction-P T)	;761
(Def-Misc-Op %NuBus-Read-8B    435 (Hi-Address Low-Address) :Lisp-FUnction-P T)	;1030
(Def-Misc-Op %NuBus-Read-16B   436 (Hi-Address Low-Address) :Lisp-FUnction-P T)	;1032
;;; Next opcode is reserved for when (and if) implemented.
;;;(Def-Misc-Op %NuBus-Read-32B 437 (Hi-Address Low-Address) T) ;1034

(Def-Misc-Op %NuBus-Read-8B-Careful 440 (Hi-Address Low-Address) :Lisp-FUnction-P T)	;1036
;; 441-443

;;; %-functions
;; 444
(Def-Misc-Op %POINTER      445 (X) :Lisp-FUnction-P T)
(Def-Misc-Op %MAKE-POINTER 446 (DTP ADDRESS) :Lisp-FUnction-P T)
(Def-Misc-Op %MAKE-POINTER-OFFSET 447 (NEW-DTP POINTER OFFSET) :Lisp-FUnction-P T)

(Def-Misc-Op %DATA-TYPE    450 (X) :Lisp-FUnction-P T)
(Def-Misc-Op %P-CDR-CODE   451 (POINTER) :Lisp-FUnction-P T)
(Def-Misc-Op %P-DATA-TYPE  452 (POINTER) :Lisp-FUnction-P T)
(Def-Misc-Op %P-POINTER    453 (POINTER) :Lisp-FUnction-P T)
(Def-Misc-Op %P-LDB        454 (PPSS POINTER) :Lisp-FUnction-P T)
(Def-Misc-Op %P-MASK-FIELD 455  (PPSS POINTER) :Lisp-FUnction-P T)
(Def-Misc-Op %P-CONTENTS-OFFSET 456 (POINTER OFFSET) :Lisp-FUnction-P T)
(Def-Misc-Op %P-LDB-OFFSET 457 (PPSS POINTER OFFSET) :Lisp-FUnction-P T)
(Def-Misc-Op %P-MASK-FIELD-OFFSET 460 (PPSS POINTER OFFSET) :Lisp-FUnction-P T)
(Def-Misc-Op %P-CONTENTS-AS-LOCATIVE 461 (POINTER) :Lisp-FUnction-P T)
(Def-Misc-Op %P-CONTENTS-AS-LOCATIVE-OFFSET 462 (POINTER OFFSET) :Lisp-FUnction-P T)
(Def-Misc-Op %POINTER-DIFFERENCE 463 (PTR1 PTR2) :Lisp-FUnction-P T)
;;; Random %-fns
(Def-Misc-Op %STORE-CONDITIONAL 464 (POINTER OLD NEW) :Lisp-FUnction-P T)	;634
;; 465-467

;;; Time
(Def-Misc-Op %MICROSECOND-TIME        470 () :Lisp-FUnction-P T) ; Returns 32 bits maybe as a bignum, 763
(Def-Misc-Op %FIXNUM-MICROSECOND-TIME 471 () :Lisp-FUnction-P T)	;764
(Def-Misc-Op TIME-IN-60ths            472 () :Lisp-FUnction-P T)	;1051
;; 473

;;; Paging
(Def-Misc-Op %PAGE-STATUS       474 (PTR))	;657
(Def-Misc-Op %COMPUTE-PAGE-HASH 475 (ADDR))	;553
(Def-Misc-Op %FINDCORE          476 ())	;674
(Def-Misc-Op FREE-PAGE-CLUSTER-COUNT 477 (page-device-number))	;1053

;; GC
(Def-Misc-Op %AREA-NUMBER 500 (X) :Lisp-FUnction-P T)		;561
(Def-Misc-Op %REGION-NUMBER 501 (PTR) :Lisp-FUnction-P T)	;660
(Def-Misc-Op %FIND-STRUCTURE-HEADER 502 (PTR) :Lisp-FUnction-P T)	;661
(Def-Misc-Op %STRUCTURE-BOXED-SIZE 503 (PTR) :Lisp-FUnction-P T)	;662
(Def-Misc-Op %STRUCTURE-TOTAL-SIZE 504 (PTR) :Lisp-FUnction-P T)	;663
(Def-Misc-Op %MAKE-REGION 505 (BITS SIZE))	;664
(Def-Misc-Op %FIND-STRUCTURE-LEADER 506 (PTR) :Lisp-FUnction-P T)	;672
;; 507

;;
;;; Arithmetic
(Def-Misc-Op FIX            510 (NUMBER) :Lisp-FUnction-P T)	;647
(Def-Misc-Op SMALL-FLOAT    511 (NUMBER) :Lisp-FUnction-P T)	;651
(Def-Misc-Op INTERNAL-FLOAT 512 (NUMBER))	;307
(Def-Misc-Op ABS            513 (NUMBER) :Lisp-FUnction-P T)	;627
(Def-Misc-Op MINUS          514 (NUMBER) :Lisp-FUnction-P T)	;357
(Def-Misc-Op HAULONG        515 (INTEGER) :Lisp-FUnction-P T)	;614
(Def-Misc-Op FLOAT-EXPONENT 516 (FLONUM) :Lisp-FUnction-P T)	;435
(Def-Misc-Op FLOAT-FRACTION 517 (FLONUM) :Lisp-FUnction-P T)	;454

(Def-Misc-Op LDB           520 (PPSS WORD) :Lisp-FUnction-P T)	;315
(Def-Misc-Op %LOGLDB       521 (PPSS WORD) :Lisp-FUnction-P T)	;THESE DONT COMPLAIN ABOUT LOADING/CLOBBERING SIGN, 313
(Def-Misc-Op MASK-FIELD    522 (PPSS FIXNUM) :Lisp-FUnction-P T)	;474
;; 523
(Def-Misc-Op DPB           524 (VALUE PPSS WORD) :Lisp-FUnction-P T)	;316
(Def-Misc-Op %LOGDPB       525 (VALUE PPSS WORD) :Lisp-FUnction-P T)	;RESULT IS ALWAYS A FIXNUM, 314
(Def-Misc-Op DEPOSIT-FIELD 526 (VALUE PPSS FIXNUM) :Lisp-FUnction-P T)	;476
;; 527

(Def-Misc-Op LSH    530 (N NBITS) :Lisp-FUnction-P T)		;350
(Def-Misc-Op ASH    531 (N NBITS) :Lisp-FUnction-P T)		;676
(Def-Misc-Op ROT    532 (N NBITS) :Lisp-FUnction-P T)		;351
(Def-Misc-Op *BOOLE 533 (FN ARG1 ARG2))		;352
(Def-Misc-Op *MAX   534 (NUM1 NUM2))		;562
(Def-Misc-Op *MIN   535 (NUM1 NUM2))		;563
(Def-Misc-Op ^      536 (Base Exponent) :Lisp-FUnction-P T)
;; 537

(Def-Misc-Op \           540 (X Y) :Lisp-FUnction-P T)		;356
(Def-Misc-Op *QUO        541 (NUM1 NUM2))	;424
(Def-Misc-Op *LOGIOR     542 (NUM1 NUM2))	;427
(Def-Misc-Op INTERNAL-\\ 543 (NUM1 NUM2))	;577
(Def-Misc-Op %DIV        544 (DIVIDEND DIVISOR) :Lisp-Function-P T)	;461
(Def-Misc-Op SCALE-FLOAT 545 (FLONUM INTEGER) :Lisp-FUnction-P T)	;455
;; 546-547

(Def-Misc-Op FLOOR-1    550 (DIVIDEND DIVISOR)) ; one value to stack
(Def-Misc-Op CEILING-1  551 (DIVIDEND DIVISOR))
(Def-Misc-Op TRUNCATE-1 552 (DIVIDEND DIVISOR))
(Def-Misc-Op ROUND-1    553 (DIVIDEND DIVISOR))
(Def-Misc-Op FLOOR-2    554 (DIVIDEND DIVISOR)) ; two values to stack
(Def-Misc-Op CEILING-2  555 (DIVIDEND DIVISOR))
(Def-Misc-Op TRUNCATE-2 556 (DIVIDEND DIVISOR))
(Def-Misc-Op ROUND-2    557 (DIVIDEND DIVISOR))


;;; Predicates usually D-PDL
(Def-Misc-Op ZEROP       560 (NUMBER) :Lisp-FUnction-P T)	;331, D-INDS mostly by BR-ZEROP
(Def-Misc-Op (M-FIXP FIXP) 561 (X))		;333, D-INDS by FIXP
(Def-Misc-Op (M-EQUAL EQUAL) 562 (X Y))		;335, D-INDS by EQUAL
(Def-Misc-Op NOT         563 (X) :Lisp-FUnction-P T)		;342
(Def-Misc-Op (NOT NULL)  563 (X))		;342, D-INDS by flipping BR sense
(Def-Misc-Op ATOM        564 (X) :Lisp-FUnction-P T)		;343, D-INDS mostly by BR-ATOM
(Def-Misc-Op (M-NUMBERP NUMBERP) 565 (X))	;353, D-INDS by NUMBERP
(Def-Misc-Op (M-PLUSP PLUSP) 566 (NUMBER))	;354, D-INDS by PLUSP
(Def-Misc-Op (M-MINUSP MINUSP) 567 (NUMBER))	;355, D-INDS by MINUSP

(Def-Misc-Op (M-<  INTERNAL-<) 570 (NUM1 NUM2))	;411, D-INDS by <
(Def-Misc-Op (M->  INTERNAL->) 571 (NUM1 NUM2))	;412, D-INDS by >
(Def-Misc-Op (M-=  INTERNAL-=) 572 (NUM1 NUM2))	;413, D-INDS by =
(Def-Misc-Op EQL         573 (X Y) :Lisp-FUnction-P T)		;511, D-INDS by EQL
(Def-Misc-Op (M-EQ  EQ)  574 (X Y))		;633, D-INDS by EQ
(Def-Misc-Op (M-EQUALP EQUALP) 575 (X Y))	;722, D-INDS by EQUALP
(Def-Misc-Op (M-LISTP LISTP) 576 (X))		;567, D-INDS by LISTP
(Def-Misc-Op SYMBOLP     577 (X) :Lisp-FUnction-P T)		;571, D-INDS mostly by BR-SYMBOLP

(Def-Misc-Op ARRAYP      600 (X) :Lisp-FUnction-P T)		;573, D-INDS by ARRAYP
(Def-Misc-Op STRINGP     601 (X) :Lisp-FUnction-P T)		;575, D-INDS by STRINGP
(Def-Misc-Op FIXNUMP     602 (OBJECT) :Lisp-FUnction-P T)	;1000, D-INDS by FIXNUMP
(Def-Misc-Op NAMED-STRUCTURE-P 603 (OBJECT) :Lisp-FUnction-P T)	;776
(Def-Misc-Op NAMED-STRUCTURE-SYMBOL 603 (OBJECT) :Lisp-FUnction-P T)	;776
;; 604-607

;;; List functions usually to PDL
(Def-Misc-Op ASSQ   610 (X ALIST) :Lisp-FUnction-P T)		;322
(Def-Misc-Op LAST   611 (LIST) :Lisp-FUnction-P T)		;323
(Def-Misc-Op LENGTH 612 (LIST-OR-ARRAY) :Lisp-FUnction-P T)	;324
(Def-Misc-Op MEMQ   613 (X LIST) :Lisp-FUnction-P T)		;410
(Def-Misc-Op NTH    614 (N LIST) :Lisp-FUnction-P T)		;417
(Def-Misc-Op NTHCDR 615 (N LIST) :Lisp-FUnction-P T)		;420
(Def-Misc-Op FIND-POSITION-IN-LIST 616 (ELEMENT LIST) :Lisp-FUnction-P T)	;505
;; 617

(Def-Misc-Op CAR-SAFE 620 (OBJECT) :Lisp-FUnction-P T)		;1003
(Def-Misc-Op CDR-SAFE 621 (OBJECT) :Lisp-FUnction-P T)		;1004
(Def-Misc-Op CARCDR   622 (LIST))		;1012, two vals to stack
;; 623-624
;;; Sequence fns D-PDL
(Def-Misc-Op ELT      625 (SEQUENCE INDEX) :Lisp-Function-P T)	;641
(Def-Misc-Op COMMON-LISP-ELT 626 (SEQUENCE INDEX) :Lisp-Function-P T)	;1054

(Def-Misc-Op FSYMEVAL 627 (SYMBOL))		;600
(Def-Misc-Op (SYMBOL-FUNCTION FSYMEVAL Symbol-Function) 627 (SYMBOL) :Lisp-Function-P T)	;600

;;; Symbols D-PDL
(Def-Misc-Op GET-PNAME               630 (SYMBOL) T)	;347
(Def-Misc-Op (SYMBOL-NAME GET-PNAME Symbol-Name) 631 (SYMBOL) :Lisp-Function-P T)	;347
(Def-Misc-Op VALUE-CELL-LOCATION     632 (SYMBOL) :Lisp-Function-P T)	;361
(Def-Misc-Op FUNCTION-CELL-LOCATION  633 (SYMBOL) :Lisp-Function-P T)	;362
(Def-Misc-Op PROPERTY-CELL-LOCATION  634 (SYMBOL) :Lisp-Function-P T)	;363
;;;  635 
(Def-Misc-Op SYMEVAL                 636 (SYMBOL) T)	;373
(Def-Misc-Op (SYMBOL-VALUE SYMEVAL Symbol-Value)  636 (SYMBOL) :Lisp-Function-P T)	;373
(Def-Misc-Op %EXTERNAL-VALUE-CELL    637 (SYMBOL) :Lisp-Function-P T)	;524

;;; Array usually to PDL
(Def-Misc-Op ARRAY-LEADER 640 (ARRAY INDEX) :Lisp-Function-P T)	;430
(Def-Misc-Op AR-1         641 (ARRAY SUB) :Lisp-Function-P T)	;512
(Def-Misc-Op AR-2         642 (ARRAY SUB1 SUB2) :Lisp-Function-P T)	;513
(Def-Misc-Op AR-3         643 (ARRAY SUB1 SUB2 SUB3) :Lisp-Function-P T)	;514
(Def-Misc-Op AP-LEADER    644 (ARRAY INDEX) :Lisp-Function-P T)	;604
(Def-Misc-Op AP-1         645 (ARRAY SUB) :Lisp-Function-P T)	;601
(Def-Misc-Op AP-2         646 (ARRAY SUB1 SUB2) :Lisp-Function-P T)	;602
(Def-Misc-Op AP-3         647 (ARRAY SUB1 SUB2 SUB3) :Lisp-Function-P T)	;603

(Def-Misc-Op AR-2-REVERSE 650 (ARRAY INDEX2 INDEX1) :Lisp-Function-P T)	;566
(Def-Misc-Op AR-1-FORCE   651 (ARRAY INDEX) :Lisp-Function-P T)	;714
(Def-Misc-Op AP-1-FORCE   652 (ARRAY INDEX) :Lisp-Function-P T)	;716
(Def-Misc-Op G-L-P        653 (ARRAY) :Lisp-Function-P T)	;507
(Def-Misc-Op BIGNUM-TO-ARRAY 654 (BIGNUM BASE) :Lisp-Function-P T)	;653
;; 655-657

;; info on arrays
(Def-Misc-Op ARRAY-LENGTH  660 (ARRAY) :Lisp-Function-P T)	;551
(Def-Misc-Op ARRAY-TOTAL-SIZE 661 (ARRAY) :Lisp-Function-P T)	;551
(Def-Misc-Op ARRAY-ACTIVE-LENGTH 662 (ARRAY) :Lisp-Function-P T)	;552
(Def-Misc-Op ARRAY-LEADER-LENGTH 663 (ARRAY) :Lisp-Function-P T)	;751
(Def-Misc-Op ARRAY-RANK    664 (ARRAY) :Lisp-Function-P T)	;752
(Def-Misc-Op ARRAY-DIMENSION 665 (ARRAY DIMENSION) :Lisp-Function-P T)	;753
;; 676-677

;; common-lisp
(Def-Misc-Op COMMON-LISP-AR-1 670 (ARRAY INDEX) :Lisp-Function-P T)	;1020
(Def-Misc-Op COMMON-LISP-AR-2 671 (array sub1 sub2) :Lisp-Function-P T)	;1047
(Def-Misc-Op COMMON-LISP-AR-3 672 (array sub1 sub2 sub3) :Lisp-Function-P T)	;1050
(Def-Misc-Op COMMON-LISP-AR-1-FORCE 673 (ARRAY INDEX) :Lisp-Function-P T)	;1021
;; 674-677

;;; String and Char fns to stack
(Def-Misc-Op %SXHASH-STRING 700 (STRING CHARACTER-MASK) :Lisp-Function-P T)	;360
(Def-Misc-Op %STRING-SEARCH-CHAR 701 (CHAR STRING START END) :Lisp-Function-P T)	;415
(Def-Misc-Op %STRING-WIDTH  702 (TABLE OFFSET STRING START END STOP-WIDTH))	;727
(Def-Misc-Op INT-CHAR       703 (fixnum) :Lisp-Function-P T)	;1043
(Def-Misc-Op CHAR-INT       704 (character) :Lisp-Function-P T)	;1044
;; 705-707

;;; Instance support to stack
(Def-Misc-Op LOCATE-IN-INSTANCE 710 (INSTANCE SYMBOL) :Lisp-Function-P T)	;442
(Def-Misc-Op %GET-SELF-MAPPING-TABLE 711 (METHOD-FLAVOR-NAME) :Lisp-Function-P T)	;506
(Def-Misc-Op %INSTANCE-REF      712 (INSTANCE INDEX) :Lisp-Function-P T)	;520
(Def-Misc-Op %INSTANCE-LOC      713 (INSTANCE INDEX) :Lisp-Function-P T)	;521
;; 714-716
(Def-Misc-Op CLOSURE            717 (SYMBOL-LIST FUNCTION) :Lisp-Function-P T)	;565

;; Lexical-Support
(Def-Misc-Op %LOAD-FROM-HIGHER-CONTEXT 720 (ENVPTR))
(Def-Misc-Op %LOCATE-IN-HIGHER-CONTEXT 721 (ENVPTR))
(Def-Misc-Op GET-LEXICAL-VALUE-CELL         722 (ENV-LIST SYMBOL-CELL-LOCATION) :Lisp-Function-P T)	;375

;; Array var num subscripts to INDS
(Def-Ucode-Entry ASET              0 (VALUE ARRAY &REST SUBSCRIPTS))	;720 <========== uentry
;; Array var num subscripts to PDL
(Def-Ucode-Entry AREF              1 (ARRAY &REST SUBSCRIPTS))	;717
(Def-Ucode-Entry ALOC              2 (ARRAY &REST SUBSCRIPTS))	;721
;; Array var num subscripts to PDL
(Def-Ucode-Entry COMMON-LISP-AREF  3 (ARRAY &REST INDICES))	;1017
;; Array var num subscripts to INDS
(Def-Ucode-Entry SET-AREF          4 (ARRAY &REST SUBSCRIPTS-AND-VALUE))	;744

(Def-Ucode-Entry ARRAY-IN-BOUNDS-P 5 (ARRAY &REST SUBSCRIPTS))	;754, d??
;;; 6-7

;;; these are funny, they can't be called as misc-op's but only as uentry functions
(Def-Ucode-Entry LIST          10 (&REST ELEMENTS))	;436  <================================== uentry
(Def-Ucode-Entry LIST*         11 (FIRST &REST ELEMENTS))	;437  "(&REST ELEMENTS LAST)" <== uentry
(Def-Ucode-Entry LIST-IN-AREA  12 (AREA &REST ELEMENTS))	;440   <========================= uentry
(Def-Ucode-Entry LIST*-IN-AREA 13 (AREA FIRST &REST ELEMENTS))	;441  "(AREA &REST ELEMENTS LAST)" <= uentry

;;; -------

(SETF (LAP-VALUE 'FEF) 0) 

(SETF (LAP-VALUE 'CONST-PAGE) NIL) ; don't have a constants page anymore.

(SETF (LAP-VALUE 'LOCBLOCK) (DPB %QMI-REG-LOCAL %%QMI-REGISTER 0))

(SETF (LAP-VALUE 'ARG) (DPB %QMI-REG-ARG %%QMI-REGISTER 0))

(SETF (LAP-VALUE 'SELF-UNMAPPED) (DPB %QMI-REG-IVAR %%QMI-REGISTER 0))
(SETF (LAP-VALUE 'SELF-MAP)      (DPB %QMI-REG-IVAR %%QMI-REGISTER
				      (DPB 1 %%QMI-IVAR-MAPPED 0)))

(SETF (LAP-VALUE 'PDL-POP) (DPB %QMI-REG-PDL %%QMI-REGISTER (LDB %%QMI-OFFSET -1)))
(SETF (LAP-VALUE 'PDL-PUSH) (LAP-VALUE 'PDL-POP))

;;; Destinations

(SETF (LAP-VALUE 'D-IGNORE) (GET-DEFINED-VALUE %QMI-CALLDEST-INDS)    )

(SETF (LAP-VALUE 'D-INDS)   (GET-DEFINED-VALUE %QMI-CALLDEST-INDS)    ) 

(SETF (LAP-VALUE 'D-PDL)    (GET-DEFINED-VALUE %QMI-CALLDEST-PUSH)    )

(SETF (LAP-VALUE 'D-RETURN) (GET-DEFINED-VALUE %QMI-CALLDEST-RETURN)  ) 

(SETF (LAP-VALUE 'D-TAIL)   (GET-DEFINED-VALUE %QMI-CALLDEST-TAIL-REC))

;; AREFI

(DEFPROP GLOBAL:AR-1       000 AREFI)
(DEFPROP ARRAY-LEADER      100 AREFI)
(DEFPROP %INSTANCE-REF     200 AREFI)
(DEFPROP COMMON-LISP-AR-1  300 AREFI)
(DEFPROP SET-AR-1          400 AREFI)
(DEFPROP SET-ARRAY-LEADER  500 AREFI)
(DEFPROP SET-%INSTANCE-REF 600 AREFI)
;; One unused code         700



;;;; refuse

;;; d (DEF-MISC-OP %SPREAD-N 372 (LIST N) NIL)

;;;; I/O and non-virtual address spaces
;;i (DEFMIC %UNIBUS-READ 555 (UNIBUS-ADDR) T)
;;i (DEFMIC %UNIBUS-WRITE 556 (UNIBUS-ADDR WORD) T)
;;i (DEFMIC %XBUS-READ 637 (IO-ADDR) T)
;;i (DEFMIC %XBUS-WRITE 640 (IO-ADDR WORD) T)
;;i (DEFMIC %IO-SPACE-READ 765 (IO-ADDR) T)
  ;;32 bit read from HARDWARE-VIRTUAL-ADDRESS space.
  ;;actual microcode is identical to that used for %XBUS-READ on CADR.
;;i (DEFMIC %IO-SPACE-WRITE 766 (IO-ADDR WORD) T)
  ;;actual microcode is identical to %XBUS-WRITE
  ;;on CADR.
;;d (DEFMIC %NUBUS-PHYSICAL-ADDRESS 767 (APPARENT-PHYSICAL-PAGE) T)
  ;;arg is "apparent" physical
  ;;page number (gotten, for example, by shifting value from
  ;;%PHYSICAL-ADDRESS).  value is 22 bit NUBUS page number.

;;i (DEFMIC %XBUS-WRITE-SYNC 471 (IO-ADDR WORD DELAY SYNC-LOC SYNC-MASK SYNC-VAL) T)

;;; CONSing
;;d (DEFMIC XCONS 370 (CDR CAR) T)
;;d (DEFMIC XCONS-IN-AREA 371 (CDR CAR AREA) T)

;;; Stack hacking
;; dumb -- only need flag to compiler (DEFMIC %PUSH 534 (X) NIL)	;why not PUSH???
;;d (DEFMIC MOVE-PDL-TOP 642 NIL NIL T)
;;i (DEFMIC POP-OPEN-CALL 670 NIL NIL T)
;; wierd!! -- can be done other ways (DEFMIC UNBIND-TO-INDEX-UNDER-N 405 (N) NIL)

;;; Random %-fns
;; soon (hopefully) gone too


;;d (DEFMIC (*PLUS . M-+) 421 (NUM1 NUM2) T)
;;d (DEFMIC (*DIF . M--) 422 (NUM1 NUM2) T)
;;d (DEFMIC (*TIMES . M-*) 423 (NUM1 NUM2) T)
;;d (DEFMIC (*LOGAND . M-LOGAND) 425 (NUM1 NUM2) T)
;;d (DEFMIC (*LOGXOR . M-LOGXOR) 426 (NUM1 NUM2) T)
;;r (DEFMIC 1+ 325 (N) T)
;;r (DEFMIC 1- 326 (N) T)
;??(DEFMIC %MULTIPLY-FRACTIONS 611 (NUM1 NUM2) T)
;??(DEFMIC %DIVIDE-DOUBLE 612 (HIGH-DIVIDEND LOW-DIVIDEND DIVISOR) T)
;;d (DEFMIC %REMAINDER-DOUBLE 613 (HIGH-DIVIDEND LOW-DIVIDEND DIVISOR) T)
;;d (DEFMIC %24-BIT-PLUS 624 (NUM1 NUM2) T)
;;d (DEFMIC %24-BIT-DIFFERENCE 625 (NUM1 NUM2) T)
;;d (DEFMIC %24-BIT-TIMES 626 (NUM1 NUM2) T)
;; Changed in 95 to exist only for old code.
;;d (DEFMIC FLOAT 650 (NUMBER) NIL T)
;??(DEFMIC %FLOAT-DOUBLE 652 (NUMBER NUMBER) T)
;;d (DEFMIC ARRAY-TO-BIGNUM 654 (ARRAY BASE SIGN) T)
;;Next two should not be microcoded; should compile into BIT-TESTs.
;;(DEFMIC ODDP 344 (NUMBER) NIL)
;;(DEFMIC EVENP 345 (NUMBER) NIL)

;;;d (DEFMIC GET-LIST-POINTER-INTO-ARRAY 432 (ARRAY) T)
;;d (DEFMIC AR-1-CACHED-1 730 (ARRAY SUBSCRIPT) T)
;;d (DEFMIC AR-1-CACHED-2 731 (ARRAY SUBSCRIPT) T)
;;d (DEFMIC ARRAY-ROW-MAJOR-INDEX 755 (ARRAY &REST SUBSCRIPTS) T T)

;;d (DEFMIC CADR-SAFE 1005 (OBJECT) T)
;;d (DEFMIC CDDR-SAFE 1006 (OBJECT) T)
;;d (DEFMIC CDDDDR-SAFE 1007 (OBJECT) T)
;;d (DEFMIC NTHCDR-SAFE 1010 (N OBJECT) T)
;;d (DEFMIC NTH-SAFE 1011 (N OBJECT) T)

;; d (DEFMIC %INSTANCE-SET 522 (VAL INSTANCE INDEX) T)

;;d (DEFMIC %BINDING-INSTANCES 523 (LIST-OF-SYMBOLS) T)

;;;;?? declared incompatible.
;;i (DEFMIC %ARGS-INFO 532 (FUNCTION) T)