;;; -*- Mode:Lisp; Base:8 -*-
;;;
;;; This is the instruction mnemonic and field definition file
;;; for the microcode assembler for the Raven processor.
;;;

(Defconst *Symbol-File-Type* "Raven")

;;(Declare (Special **Indicator**))
;;(Defun AllRemProp (**indicator**)
;;  (Mapatoms #'(Lambda (X) (Remprop X **indicator**))))

;(defun allremprop (prop)
;   (do-local-symbols (s *package*)
;     (remprop s prop)))

(AllRemProp 'Micasm-SYM)			; Clear predef symbol table

;;; Enter SYMBOL into the assembler predefined table with VALUE.
;;;
(DefMacro PreDef (symbol value)
  `(PutProp ',symbol ,value 'Micasm-Sym))



;;; Field Definitions and predefined values

(PreDef A-Source-Multiplier (Byte-Position-Multiplier %%MInst-A-Source-Address))
(PreDef M-Source-Multiplier (Byte-Position-Multiplier %%MInst-M-Source-Address))
(PreDef A-Destination-Multiplier
        (Byte-Position-Multiplier %%MInst-Destination-Address))
(PreDef M-Destination-Multiplier
        (Byte-Position-Multiplier %%MInst-Destination-M-Memory-Address))
(PreDef Jump-Address-Multiplier (Byte-Position-Multiplier %%MInst-New-Micro-PC))
(PreDef Dispatch-Address-Multiplier (Byte-Position-Multiplier %%MInst-Dispatch-Address))
(PreDef Condition (Byte-Position-Multiplier %%MInst-Condition))
(PreDef T-Ref-Multiplier (Byte-Position-Multiplier %%MInst-Condition))

;;; Abbreviated jump field for any instruction.
(PreDef ABJ (Byte-Position-Multiplier %%MInst-Abbrv-Jump))
;;; Abbreviated jump field for ALU and BYTE instructions.
(PreDef ABJ-Byte-or-ALU
	'(Force-ALU-or-Byte ABJ))

(PreDef Function-Source '(Field M-Source-Multiplier 1))
(PreDef Function-Destination
        (Byte-Position-Multiplier %%MInst-Destination-Functional-Destination))
(PreDef ALU-Output-Bus-Selector-Multiplier
	(Byte-Position-Multiplier %%MInst-Output-Bus-Control))


;;; Miscellaneous functions
(PreDef Halt (Byte-Value 1 %%MInst-Halt))
;;; This feature is No-op in Raven
(PreDef Instruction-Stream
	'(Warning "Use of Instruction-Stream is obselete."))


;;; Abbreviated jump field specifiers.

;;; Abbreviated jump specifiers for all instructions.
(PreDef And-Popj-Xct-Next `(Field ABJ ,%A-Jump-Field-Popj-After-Next))

;;; Abbreviated jump specifiers for ALU and BYTE instructions.
(PreDef And-Skip `(Field ABJ-Byte-or-ALU ,%A-Jump-Field-Skip))
(Predef And-Call-Illop `(Field ABJ-Byte-or-ALU ,%A-Jump-Field-Call-Illop))
(PreDef And-Call-Trap `(Field ABJ-Byte-or-ALU ,%A-Jump-Field-Call-Trap))
(PreDef And-Call-Bus-Error `(Field ABJ-Byte-or-ALU ,%A-Jump-Field-Call-Buserr))
(PreDef And-Popj `(Field ABJ-Byte-or-ALU ,%A-Jump-Field-Popj))


;;; ALU instruction definitions

(PreDef ALU-Inst '(Force-ALU 0))
(PreDef ALU-Op `(Force-ALU ,(Byte-Position-Multiplier %%MInst-ALU-Opcode)))
(PreDef ALU-Output-Bus-Selector-Multiplier
        `(Force-ALU ,(Byte-Position-Multiplier %%MInst-Output-Bus-Control)))
(PreDef Write-M-Tag-Classifier
        `(Force-ALU (Plus ,(Byte-Value 1 %%MInst-Write-Classifier-Ram)
                          (Field Condition ,%Condition-Tag-Classify))))

;;; Q control values
(PreDef Shift-Q-Left
        `(Force-ALU ,(Byte-Value %Q-Control-Shift-Left
                                 %%MInst-Q-Control)))
(PreDef Shift-Q-Right
        `(Force-ALU ,(Byte-Value %Q-Control-Shift-Right
                                 %%MInst-Q-Control)))
(PreDef Load-Q
        `(Force-ALU ,(Byte-Value %Q-Control-Load
                                 %%MInst-Q-Control)))

;;; ALU carry values
(PreDef ALU-Carry-in-Zero
        `(Force-ALU ,(Byte-Value 0 %%MInst-ALU-Carry-In)))
(PreDef ALU-Carry-in-One
        `(Force-ALU ,(Byte-Value 1 %%MInst-ALU-Carry-In)))

;;; ALU output bus selector
(PreDef Output-Selector-Normal
        `(Field ALU-Output-Bus-Selector-Multiplier ,%Output-Bus-Normal))

(PreDef Output-Selector-RightShift-1
        `(Field  ALU-Output-Bus-Selector-Multiplier ,%Output-Bus-RightShift-1))

(PreDef Output-Selector-LeftShift-1
        `(Field  ALU-Output-Bus-Selector-Multiplier ,%Output-Bus-LeftShift-1))

(PreDef Output-Selector-Mirror
        `(Field  ALU-Output-Bus-Selector-Multiplier ,%Output-Bus-Mirror))

(PreDef Output-Selector-Sign-Extend
       `(Field ALU-Output-Bus-Selector-Multiplier ,%Output-Bus-Pointer-Extend))

(PreDef Output-Selector-R-Bus
        `(Field ALU-Output-Bus-Selector-Multiplier ,%Output-Bus-R-Bus))

(PreDef Output-Selector-A-Bus
        `(Field ALU-Output-Bus-Selector-Multiplier ,%Output-Bus-A-Bus))

(PreDef Shift-ALU-Right 'Output-Selector-RightShift-1)

(PreDef Shift-ALU-Left 'Output-Selector-LeftShift-1)


;;; ALU operation codes
(PreDef No-Op 'ALU-Inst)
(PreDef SETZ  `(Field ALU-Op ,%ALU-Opcode-SETZ))
(PreDef AND   `(Field ALU-Op ,%ALU-Opcode-AND))
(PreDef ANDCA `(Field ALU-Op ,%ALU-Opcode-ANDCA))
(PreDef SETM  `(Field ALU-Op ,%ALU-Opcode-SETM))
(PreDef ANDCM `(Field ALU-Op ,%ALU-Opcode-ANDCM))
(PreDef SETA  `(Field ALU-Op ,%ALU-Opcode-SETA))
(PreDef XOR   `(Field ALU-Op ,%ALU-Opcode-XOR))
(PreDef IOR   `(Field ALU-Op ,%ALU-Opcode-IOR))
(PreDef ANDCB `(Field ALU-Op ,%ALU-Opcode-ANDCB))
(PreDef EQV   `(Field ALU-Op ,%ALU-Opcode-EQV))
(PreDef SETCA `(Field ALU-Op ,%ALU-Opcode-SETCA))
(PreDef ORCA  `(Field ALU-Op ,%ALU-Opcode-ORCA))
(PreDef SETCM `(Field ALU-Op ,%ALU-Opcode-SETCM))
(PreDef ORCM  `(Field ALU-Op ,%ALU-Opcode-ORCM))
(PreDef ORCB  `(Field ALU-Op ,%ALU-Opcode-ORCB))
(PreDef SETO  `(Field ALU-Op ,%ALU-Opcode-SETO))

(PreDef ADD   `(Field ALU-Op ,%ALU-Opcode-ADD))
(PreDef SUB   `(Plus (Field ALU-Op ,%ALU-Opcode-SUB) ALU-Carry-in-One))
(PreDef SUB-M+1 `(Field ALU-Op ,%ALU-Opcode-SUB))
(PreDef M+M   `(Field ALU-Op ,%ALU-Opcode-M+M))
(PreDef M+1   `(Plus (Field ALU-Op 34) ALU-Carry-in-One))
(PreDef M-A-1 `(Field ALU-Op ,%ALU-Opcode-SUB))
(PreDef M+A+1 `(Plus (Field ALU-Op ,%ALU-Opcode-ADD) ALU-Carry-in-One))
(PreDef M+M+1 `(Plus (Field ALU-Op ,%ALU-Opcode-M+M) ALU-Carry-in-One))

(PreDef Typed-ALU-Op
        `(Force-ALU (Plus ,(Byte-Value 1 %%MInst-ALU-Tagged)
                           Output-Selector-Normal)))
                    

(PreDef Multiply-Step
        `(Plus (Field ALU-Op ,%ALU-Opcode-MUL)
               Shift-Q-Right Output-Selector-RightShift-1))
(PreDef Multiply-Step-Last
        `(Field ALU-Op ,%ALU-Opcode-MUL-Last))
(PreDef Divide-First-Step
        `(Plus (Field ALU-Op ,%ALU-Opcode-DIV-First)
               Shift-Q-Left Output-Selector-LeftShift-1))
(PreDef Divide-Step
        `(Plus (Field ALU-Op ,%ALU-Opcode-DIV)
               Shift-Q-Left Output-Selector-LeftShift-1))
(PreDef Divide-Last-Step
        `(Plus (Field ALU-Op ,%ALU-Opcode-DIV-Last) Shift-Q-Left))
(PreDef Divide-Remainder-Correction-Step `(Field ALU-Op ,%ALU-Opcode-DIV-Corr))


;;; BYTE instruction definitions
(PreDef Byte-Inst '(Force-Byte 0))
(PreDef Byte-Opcode `(Force-Byte ,(Byte-Position-Multiplier %%MInst-Byte-Op)))
(PreDef LDB `(Field Byte-Opcode ,%Byte-Op-LDB))
(PreDef DPB `(Field Byte-Opcode ,%Byte-Op-Deposit-Byte))
(PreDef Selective-Deposit `(Field Byte-Opcode ,%Byte-Op-Selective-Deposit))
;; This def impacts the assembler, it should put the twos complement of the
;; rotation count in the count field. It also should force Byte, Dispatch or
;; Jump
(PreDef Rotate-Right
        `(Plus ,(Byte-Value 1 %%MInst-Rotation-Direction)
               (Notification "Rotate-Right only sets the Rotation Direction Bit")))


;;; Jump related fields and values
(PreDef Jump-Inst '(Force-Jump 0))
(PreDef N-Bit (Byte-Value 1 %%MInst-Inhibit-Bit))
(PreDef Inhibit-Xct-Next-Bit (Byte-Value 1 %%MInst-Inhibit-Bit))
(PreDef P-Bit (Byte-Value 1 %%MInst-Call-Bit))
(PreDef R-Bit (Byte-Value 1 %%MInst-Return-Bit))
(PreDef Invert-Jump-Sense
        (Byte-Position-Multiplier %%MInst-Condition-Invert-Sense-Bit))

;;; Jump Instruction Code Mnemonic Definitions

(PreDef Jump-Op-Xct-Next 'Jump-Inst)
(PreDef Jump-Op '(Plus Jump-Inst N-Bit))

(PreDef Jump-Xct-Next 'Jump-Op-Xct-Next)
(PreDef Jump 'Jump-Op)

(PreDef Call-Xct-Next '(Plus Jump-Xct-Next P-Bit))
(PreDef Call '(Plus Jump P-Bit))

(PreDef Popj-Xct-Next '(Plus Jump-Xct-Next R-Bit))
(PreDef Popj '(Plus Jump R-Bit))

(PreDef Skip '(Error "SKIP is not valid."))

(PreDef Jump2 '(Plus Jump-Inst R-Bit P-Bit N-Bit))      ;duplicates JUMP
(PreDef Jump2-Xct-Next '(Plus Jump-Inst R-Bit P-Bit))

;;; Special case jump instruction: Read/Write with Instruction memory
(PreDef Access-I-Mem '(Plus Call-Xct-Next Always))
(PreDef Write-I-Mem
        `(Plus Popj Always ,(Byte-Value 1 %%MInst-Write-Control-Store)))
(PreDef Read-I-Mem
        `(Plus Popj Always ,(Byte-Value 1 %%MInst-Read-Control-Store)))


;;; Jump conditions
(PreDef If-Bit-Set `(Field Condition ,%Condition-Bit-Set))
(PreDef If-Bit-Clear '(Plus Invert-Jump-Sense If-Bit-Set))
(PreDef If-Less-Than `(Field Condition ,%Condition-Less))
(PreDef If-Less `(Field Condition ,%Condition-Less))
(PreDef If-Less-Or-Equal `(Field Condition ,%Condition-Less-or-Equal))
(PreDef If-Not-Equal `(Field Condition ,%Condition-Not-Equal))
(PreDef If-Equal '(Plus Invert-Jump-Sense If-Not-Equal))
(PreDef If-Greater '(Plus Invert-Jump-Sense If-Less-Or-Equal))
(PreDef If-Greater-Than '(Plus Invert-Jump-Sense If-Less-Or-Equal))
(PreDef If-Greater-Or-Equal '(Plus Invert-Jump-Sense If-Less))
(PreDef If-Page-Fault `(Field Condition ,%Condition-Page-Fault))
(PreDef If-Not-Page-Fault '(Plus Invert-Jump-Sense If-Page-Fault))
(PreDef If-Interrupt-Pending '(Plus Invert-Jump-Sense If-No-Interrupt-Pending))
(PreDef If-No-Interrupt-Pending `(Field Condition ,%Condition-No-Interrupt))
(PreDef If-Page-Fault-or-Interrupt-Pending
        `(Field Condition ,%Condition-Page-Fault-or-Interrupt))
(PreDef If-Not-Page-Fault-or-Interrupt-Pending
        '(Plus Invert-Jump-Sense If-Page-Fault-or-Interrupt-Pending))
(PreDef If-Page-Fault-or-Interrupt-Pending-or-Sequence-Break
      `(Field Condition ,%Condition-Page-Fault-or-Interrupt-or-Sequence-Break))
(PreDef If-Not-Page-Fault-or-Interrupt-Pending-or-Sequence-Break
        '(Plus Invert-Jump-Sense If-Page-Fault-or-Interrupt-Pending-or-Sequence-Break))
(PreDef If-Tag-Not-Equal `(Field Condition ,%Condition-Tag-Not-Equal))
(PreDef If-Tag-Equal '(Plus Invert-Jump-Sense If-Tag-Not-Equal))
(PreDef If-Not-Memory-Busy `(Field Condition ,%Condition-Not-Memory-Busy))
(PreDef If-Memory-Busy '(Plus Invert-Jump-Sense If-Not-Memory-Busy))
(PreDef If-Negative `(Field Condition ,%Condition-Boxed-Sign-Bit))
(PreDef If-Positive '(Plus Invert-Jump-Sense If-Negative))
(PreDef If-Q0 `(Field Condition ,%Condition-Q0))
(PreDef If-Not-Q0 '(Plus Invert-Jump-Sense If-Q0))
(PreDef If-NuBus-Error `(Field Condition ,%Condition-NU-Bus-Error))
(PreDef If-Not-NuBus-Error '(Plus Invert-Jump-Sense If-NuBus-Error))
(PreDef If-Not-Fixnum-Overflow `(Field Condition ,%Condition-Not-Fixnum-Overflow))
(PreDef If-Fixnum-Overflow '(Plus Invert-Jump-Sense If-Not-Fixnum-Overflow))
(PreDef If-In-Class `(Field Condition ,%Condition-Tag-Classify))
(PreDef If-Not-In-Class '(Plus Invert-Jump-Sense If-in-Class))
(PreDef Always `(Field Condition ,%Condition-True))
(PreDef Never '(Plus Invert-Jump-Sense Always))


;;; Dispatch instruction definitions
(PreDef Dispatch '(Force-Dispatch 0))
;;; The following are for notational convenience
(PreDef Dispatch-Xct-Next '(Force-Dispatch 0))
(PreDef Dispatch-Call '(Force-Dispatch 0))
(PreDef Dispatch-Call-Xct-Next '(Force-Dispatch 0))
(PreDef Dispatch-Popj-Xct-Next '(Force-Dispatch 0))

;;; Special dispatch operations
(PreDef Dispatch-Advance-Instruction-Stream
        `(Force-Dispatch ,(Byte-Value 1 %%MInst-Enable-Instruction-Stream)))
(PreDef Dispatch-Push-Own-Address
        `(Force-Dispatch ,(Byte-Value 1 %%MInst-Alter-Return-Address)))

;;;(PreDef Dispatch-Load-VMA
;;;        `(Force-Dispatch ,(Byte-Value 1 %%MInst-Write-VMA-Register)))

;;; Dispatch options
(PreDef Dispatch-Source
        `(Force-Dispatch ,(Byte-Position-Multiplier %%MInst-Dispatch-Source)))
(PreDef Use-MIR `(Field Dispatch-Source ,%Dispatch-Source-MIR))
(PreDef Use-M-Tag `(Field Dispatch-Source ,%Dispatch-Source-M-Tag))
(PreDef Use-Old-Space-Bit
        `(Force-Dispatch ,(Byte-Value 1 %%MInst-Map-Old-Space-Bit)))
(PreDef Use-GC-Volatility-Bit
        `(Force-Dispatch ,(Byte-Value 1 %%MInst-Map-GC-Volatility-Bit)))

(PreDef Write-Dispatch-Ram
        `(Force-Dispatch ,(Byte-Value 1 %%MInst-Write-Dispatch-Memory)))
(PreDef Read-Dispatch-Ram
        `(Force-Dispatch ,(Byte-Value 1 %%MInst-Read-Dispatch-Memory)))


;;; Functional sources and destinations, run time eval

(PreDef Read-I-Arg
        `(Or (Source-P (Field Function-Source ,%MBS-Read-I-Arg))
             (Error "Read-I-Arg must be a source")))

(PreDef Micro-Stack-Pointer
        `(Or (Source-P (Field Function-Source ,%MBS-Micro-Stack-Pointer))
             (Field Function-Destination ,%MBD-Micro-Stack-Pointer)))

(PreDef Micro-Stack-Data
        `(Or (Source-P (Field Function-Source ,%MBS-Micro-Stack-Data))
             (Field Function-Destination ,%MBD-Micro-Stack-Data)))

(PreDef Micro-Stack-Data-Push
	`(Or (Source-P (Error "Micro-Stack-Data-Push must be a destination"))
	     (Field Function-Destination ,%MBD-Micro-Stack-Data-Push)))

(PreDef Micro-Stack-Data-Pop
	`(Or (Source-P (Field Function-Source ,%MBS-Micro-Stack-Data-Pop))
             (Error "Micro-Stack-Data-Pop must be a source")))

(PreDef Q-R
        `(Or (Source-P (Field Function-Source ,%MBS-Q-R))
             Load-Q))

(PreDef PDL-Buffer-Pointer
        `(Or (Source-P (Field Function-Source ,%MBS-PDL-Buffer-Pointer))
             (Field Function-Destination ,%MBD-PDL-Buffer-Pointer)))

(PreDef PDL-Buffer-Pointer-Pop
        `(Or (Source-P (Field Function-Source ,%MBS-PDL-Buffer-Pointer-Pop))
             (Error "PDL-Buffer-Pointer-Pop must be a source")))

(PreDef PDL-Buffer-Index
        `(Or (Source-P (Field Function-Source ,%MBS-PDL-Buffer-Index))
             (Field Function-Destination ,%MBD-PDL-Buffer-Index)))


(PreDef PDL-Buffer-Index-Decrement
        `(Or (Source-P
              (Field Function-Source ,%MBS-PDL-Buffer-Index-Decrement))
             (Error "PDL-Buffer-Index-Decrement must be a source")))

(PreDef C-PDL-Buffer-Index-Decrement
        `(Or (Source-P
              (Field Function-Source ,%MBS-C-PDL-Buffer-Index-Decrement))
             (Error "C-PDL-Buffer-Index-Decrement must be a source")))

(PreDef C-PDL-Buffer-Index
        `(Or (Source-P (Field Function-Source ,%MBS-C-PDL-Buffer-Index))
             (Field Function-Destination ,%MBD-C-PDL-Buffer-Index)))

(PreDef C-PDL-Buffer-Index-Increment
        `(Or (Source-P
              (Error "PDL-Buffer-Index-Increment must be a destination"))
             (Field Function-Destination ,%MBD-C-PDL-Buffer-Index-Increment)))

(PreDef C-PDL-Buffer-Pointer
        `(Or (Source-P (Field Function-Source ,%MBS-C-PDL-Buffer-Pointer))
             (Field Function-Destination ,%MBD-C-PDL-Buffer-Pointer)))

(PreDef C-PDL-Buffer-Pointer-Pop
        `(Or (Source-P (Field Function-Source ,%MBS-C-PDL-Buffer-Pointer-Pop))
             (Error "C-PDL-Buffer-Pointer-Pop must be a source")))

(PreDef C-PDL-Buffer-Pointer-Push
    `(Or (Source-P (Error "C-PDL-Buffer-Pointer-Push must be a destination"))
         (Field Function-Destination ,%MBD-C-PDL-Buffer-Pointer-Push)))


(PreDef VMA
        `(Or (Source-P (Field Function-Source ,%MBS-VMA))
             (Field Function-Destination ,%MBD-VMA)))

(PreDef VMA-Start-Read
        `(Or (Source-P (Error "VMA-Start-Read must be a destination"))
             (Field Function-Destination ,%MBD-VMA-Start-Read)))

(PreDef VMA-Start-Write 
      `(Or (Source-P (Error "VMA-Start-Write must be a destination"))
           (Field Function-Destination ,%MBD-VMA-Start-Write)))

(PreDef VMA-Write-Map-Level-1 
       `(Or (Source-P (Error "VMA-Write-Map-Level-1 must be a destination"))
             (Field Function-Destination ,%MBD-VMA-Write-Map-Level-1)))

(PreDef VMA-Write-Map-Level-2-Control
        `(Or (Source-P
              (Error "VMA-Write-Map-Level-2-Control must be a destination"))
             (Field Function-Destination ,%MBD-VMA-Write-Map-Level-2-Control)))

(PreDef VMA-Write-Map-Level-2-Address
        `(Or (Source-P
              (Error "VMA-Write-Map-Level-2-Address must be a destination"))
             (Field Function-Destination ,%MBD-VMA-Write-Map-Level-2-Address)))

(PreDef VMA-Start-Unmapped-Read
        `(Or (Source-P (Error "VMA-Start-Read-Unmapped must be a destination"))
             (Field Function-Destination ,%MBD-VMA-Start-Read-Unmapped)))
        
(PreDef VMA-Start-Unmapped-Write
        `(Or (Source-P
              (Error "VMA-Start-Write-Unmapped must be a destination"))
             (Field Function-Destination ,%MBD-VMA-Start-Write-Unmapped)))
        
(PreDef VMA-Start-Unmapped-Byte-Read
        `(Or (Source-P
              (Error "VMA-Start-Read-Unmapped-NU must be a destination"))
             (Field Function-Destination ,%MBD-VMA-Start-Read-Unmapped-NU)))
        
(PreDef VMA-Start-Unmapped-Byte-Write
        `(Or (Source-P
              (Error "VMA-Start-Write-Unmapped-NU must be a destination"))
             (Field Function-Destination ,%MBD-VMA-Start-Write-Unmapped-NU)))

(PreDef MD
        `(Or (Source-P (Field Function-Source ,%MBS-MD))
             (Field Function-Destination ,%MBD-MD)))

(PreDef MD-Start-Read
        `(Or (Source-P (Error "MD-Start-Read must be a destination"))
             (Field Function-Destination ,%MBD-MD-Start-Read)))

(PreDef MD-Start-Write
        `(Or (Source-P (Error "MD-Start-Write must be a destination"))
             (Field Function-Destination ,%MBD-MD-Start-Write)))

(PreDef MD-Start-Unmapped-Read
        `(Or (Source-P (Error "MD-Start-Read-Unmapped must be a destination"))
             (Field Function-Destination ,%MBD-MD-Start-Read-Unmapped)))

(PreDef MD-Start-Unmapped-Write
        `(Or (Source-P (Error "MD-Start-Write-Unmapped must be a destination"))
             (Field Function-Destination ,%MBD-MD-Start-Write-Unmapped)))

(PreDef MD-Start-Unmapped-Byte-Read
        `(Or (Source-P
              (Error "MD-Start-Read-Unmapped-NU must be a destination"))
             (Field Function-Destination ,%MBD-MD-Start-Read-Unmapped-NU)))

(PreDef MD-Start-Unmapped-Byte-Write
        `(Or (Source-P
              (Error "MD-Start-Write-Unmapped-NU must be a destination"))
             (Field Function-Destination ,%MBD-MD-Start-Write-Unmapped-NU)))

(PreDef MD-Write-Map-Level-1
        `(Or (Source-P (Error "MD-Write-Map-Level-1 must be a destination"))
             (Field Function-Destination ,%MBD-MD-Write-Map-Level-1)))

(PreDef MD-Write-Map-Level-2-Control
        `(Or (Source-P
              (Error "MD-Write-Map-Level-2-Control must be a destination"))
            (Field Function-Destination ,%MBD-MD-Write-Map-Level-2-Control)))

(PreDef MD-Write-Map-Level-2-Address
        `(Or (Source-P
              (Error "MD-Write-Map-Level-2-Address must be a destination"))
             (Field Function-Destination ,%MBD-MD-Write-Map-Level-2-Address)))

(PreDef Memory-Map-Level-1
        `(Or (Source-P (Field Function-Source ,%MBS-Memory-Map-Level-1))
             (Error "Memory-Map-Level-1 must be a source")))

(PreDef Memory-Map-Level-2-Control
        `(Or (Source-p
              (Field Function-Source ,%MBS-Memory-Map-Level-2-Control))
             (Error "Memory-Map-Level-2-Control must be a source")))

(PreDef Memory-Map-Level-2-Address
        `(Or (Source-p
              (Field Function-Source ,%MBS-Memory-Map-Level-2-Address))
             (Error "Memory-Map-Level-2-Address must be a source")))

(PreDef IMOD-Low
        `(Or (Source-P (Error "OA-Reg-Low must be a destination"))
             (Field Function-Destination ,%MBD-OA-Reg-Low)))

(PreDef IMOD-High
        `(Or (Source-P (Error "OA-Reg-High must be a destination"))
             (Field Function-Destination ,%MBD-OA-Reg-High)))

(PreDef Location-Counter
	`(Or (Source-P (Field Function-Source ,%MBS-Location-Counter))
	     (Field Function-Destination ,%MBD-Location-Counter)))

(PreDef MCR
	`(Or (Source-P (Field Function-Source ,%MBS-MCR))
	     (Field Function-Destination ,%MBD-MCR)))
        
(PreDef I-Arg
	`(Or (Source-P (Field Function-Source ,%MBS-Read-I-Arg))
	     (Error "I-Arg must be a source")))

(PreDef Test-Synch
        `(Or (Source-P (Error "Test-Synch must be a destination"))
             (Field Function-Destination ,%MBD-Test-Synch)))

(PreDef MIB
        `(Or (Source-P (Field Function-Source ,%MBS-Macro-Instruction-Buffer))
             (Field Function-Destination ,%MBD-Macro-Instruction-Buffer)))

(PreDef MIB-Branch-Offset-Field
        `(Or (Source-P
              (Field Function-Source ,%MBS-Macro-Instruction-Branch-Field))
             (Error "MIB-Branch-Offset-Field must be a source")))

(PreDef MIB-Argument-Offset-Field
        `(Or (Source-P
              (Field Function-Source ,%MBS-Macro-Instruction-Argument-Field))
             (Error "MIB-Argument-Offset-Field must be a source")))