root/tags/system-46/lmcons/cadrd.lisp

;*CAUTION** THIS FILE ONLY FOR MACLISP!!  LCADR;LCADRD FOR LISPM!! -*-LISP-*-
;       ** (c) Copyright 1980 Massachusetts Institute of Technology **
;LOW-LEVEL CADR-MUNGING ROUTINES FOR CC
; FOR TEMPORARY DIAG INTERFACE, NO DIRECT PATH TO MD
; FOR NOW, MEMORY MAPPING ETC. STUFF NOT YET CONVERTED.
; DOESN'T TRY TO WIN WITH LPC, OPCS, INTERRUPT CONTROL REGISTER, LC, HAIR LIKE THAT.  LATER.
; ^ DOES NOW, NO?
; NO STATISTICS COUNTER STUFF
;CC-CLEAR-CORE AND CL-LOAD-STRAIGHT-MAP ARE NOT GOING TO WIN!

(DECLARE (EVAL (READ)))
(PROGN (LOAD '(MACROS > DSK LISPM))
       (LOAD '(DEFMAC FASL DSK LISPM2))
       (LOAD '(LMMAC > DSK LISPM2)))

(DECLARE (EVAL (READ)))
       (DEFUN **STRING** MACRO (X) `',(CADR X)) ;Bubbles in my brain

(DECLARE (EVAL (READ)))
(SETQ CC-GENERATE-CONS-SYMBOLS-SETQ-FLAG T) ;IN THIS FILE, SEND CONS SYMBOLS OVER

(INCLUDE ((LMCONS)CADMAC >))

(COMMENT DIAGNOSTIC INTERFACE DEFINITION)

;SEE LMDOC;CADR > FOR CADR DIAGNOSTIC INTERFACE.

;THIS CODE OPERATES ON THE THINGS ACCESSIBLE THROUGH THE SPY BUS.
;THE SPY BUS CAN BE GOTTEN AT IN ONE OF 3 WAYS:
;  THROUGH THE TEMPORARY DEBUGGING KLUDGE, WITH NO BUS INTERFACE
;  THROUGH THE BUS INTERFACE, VIA THE TEMPORARY DEBUGGING KLUDGE IN ITS OTHER MODE
;  DIRECTLY VIA A 10-11 INTERFACE
;MORE WAYS MAY EXIST IN THE FUTURE.

;THE FUNCTIONS SPY-READ AND SPY-WRITE TAKE A SPY-ADDRESS (0 TO 17) AND
;DEPENDING ON THE VALUE OF THE SYMBOL SPY-ACCESS-PATH (NO-BUSINT, BUSINT, TEN11)
;THEY WILL DO THE APPROPRIATE THING.

;HERE ARE SYMBOLS FOR THE DIAGNOSTIC (SPY) REGISTERS
(DECLARE (LET ((SQ (READ)))
            (DO L (CDR SQ) (CDDR L) (NULL L)
                (APPLY 'SPECIAL (LIST (CAR L)))
                (APPLY 'FIXNUM (LIST (CAR L))))
            (COUTPUT SQ)))
(SETQ   ;READING
        SPY-IR-LOW      0
        SPY-IR-MED      1
        SPY-IR-HIGH     2
        SPY-OPC         4
        SPY-PC          5
        SPY-OB-LOW      6
        SPY-OB-HIGH     7
        SPY-FLAG-1      10
        SPY-FLAG-2      11
        SPY-M-LOW       12
        SPY-M-HIGH      13
        SPY-A-LOW       14
        SPY-A-HIGH      15
        SPY-STAT-LOW    16
        SPY-STAT-HIGH   17
        ;WRITING
        ;SPY-IR-LOW     0
        ;SPY-IR-MED     1
        ;SPY-IR-HIGH    2
        SPY-CLK         3
        SPY-OPC-CONTROL 4
        SPY-MODE        5
)

(COMMENT DECLARATIONS)

(DECLARE (SPECIAL CC-NOOP-FLAG CC-MODE-REG CC-RUNNING CC-LOW-LEVEL-FLAG 
                  CC-PASSIVE-SAVE-VALID CC-FULL-SAVE-VALID
                  CC-PDL-BUFFER-INDEX-CHANGED-FLAG ;NIL IF NOT SAVED YET
                  CC-SAVED-PDL-BUFFER-INDEX  ;SAVED HERE WHEN IT IS SAVED
                  CC-MICRO-STACK-SAVED-FLAG  ;NIL IF POINTER AND STACK NOT SAVED YET
                  CC-SAVED-MICRO-STACK-PTR      ;SAVED HERE WHEN IT IS SAVED
                  CC-SAVED-DISPATCH-CONSTANT    ;NIL IF NOT SAVED, ELSE ASSUMED CHANGED
                  CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG     ;NIL IF NOT SAVED YET
                  CC-SAVED-LEVEL-1-MAP-LOC-0
                  CC-ERROR-STATUS CC-SAVED-PC CC-SAVED-IR CC-SAVED-OBUS CC-SAVED-NOOP-FLAG
                  CC-SAVED-A-MEM-LOC-1 CC-SAVED-M-MEM-LOC-0
                  CC-SAVED-VMA CC-SAVED-MD CC-SAVED-MAP-AND-FAULT-STATUS
                  CC-VMA-CHANGED-FLAG CC-UPDATE-DISPLAY-FLAG CC-UNIBUS-MAP-TO-MD-OK-FLAG
                  CC-REG-ADR-PHYS-MEM-OFFSET CTALK-BARF-AT-WRITE-ERRORS
))

(SETQ CC-PASSIVE-SAVE-VALID NIL CC-FULL-SAVE-VALID NIL CC-RUNNING NIL
      CC-UNIBUS-MAP-TO-MD-OK-FLAG NIL)

(ARRAY CC-SAVED-OPCS FIXNUM 8)
(ARRAY CC-MICRO-STACK FIXNUM 32.)
;COMPILER APPARENTLY DOES THE FOLLOWING ITSELF
;(DECLARE (ARRAY* (FIXNUM CC-SAVED-OPCS 8) (FIXNUM CC-MICRO-STACK 32.)))

;THESE CAN BE REF'ED IF SWITCH BETWEEN TEN MODE AND 11 MODE.  TRY TO MINIMIZE RESULTING
; CONFUSION.
         (SETQ   CC-NOOP-FLAG NIL 
                 CC-PDL-BUFFER-INDEX-CHANGED-FLAG NIL 
                 CC-MICRO-STACK-SAVED-FLAG NIL 
                 CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG NIL 
                 CC-ERROR-STATUS 0 
                 CC-SAVED-IR 0
                 CC-SAVED-NOOP-FLAG NIL 
                 CC-VMA-CHANGED-FLAG NIL
                 CC-MODE-REG 46 ;NORMAL SPEED, ERROR TRAPS ENABLED, PROM DISABLED
                 CC-SAVED-PC 0
                 CC-SAVED-OBUS 0
                 CC-SAVED-PDL-BUFFER-INDEX 0
                 CC-SAVED-MICRO-STACK-PTR 0
                 CC-SAVED-DISPATCH-CONSTANT NIL 
                 CC-SAVED-A-MEM-LOC-1 0
                 CC-SAVED-M-MEM-LOC-0 0
                 CC-SAVED-LEVEL-1-MAP-LOC-0 0
                 CC-SAVED-VMA 0
                 CC-SAVED-MD 0
                 CC-SAVED-MAP-AND-FAULT-STATUS 0)

(COMMENT BASIC SPY I&O ROUTINES)

(DECLARE (FIXNUM (SPY-READ FIXNUM) (DBG-READ FIXNUM) (DBG-READ-XBUS FIXNUM)
                 (DBG-READ-UNIBUS-MAP FIXNUM))
         (NOTYPE (SPY-WRITE FIXNUM FIXNUM) (DBG-WRITE FIXNUM) (DBG-WRITE-XBUS FIXNUM FIXNUM)
                 (DBG-WRITE-UNIBUS-MAP FIXNUM FIXNUM))
         (SPECIAL SPY-ACCESS-PATH))

(DEFUN SPY-NO-BUSINT NIL        ;SWITCH TO NO-BUSINT FLAVOR ACCESS
  (SETQ SPY-ACCESS-PATH 'NO-BUSINT)
  (CNSUSP)
  (FASLOAD CTALK FASL DSK LMCONS)  ;LOAD THE FLAVOR THAT TALKS VIA CONS
  (CNSINI)
  T)

;(SETQ SPY-ACCESS-PATH 'BUSINT)

(DEFUN SPY-READ (REGN)
  (COND ((EQ SPY-ACCESS-PATH 'NO-BUSINT)
         (CNSUBR (+ 764500 (LSH REGN 1))))
        ((EQ SPY-ACCESS-PATH 'BUSINT)
         (DBG-READ (+ 766000 (LSH REGN 1))))
        ((EQ SPY-ACCESS-PATH 'TEN11)
         (CNSUBR (+ 766000 (LSH REGN 1))))
        (T (ERROR '|bad value for SPY-ACCESS-PATH| SPY-ACCESS-PATH))))

(DEFUN SPY-WRITE (REGN VAL)
  (COND ((EQ SPY-ACCESS-PATH 'NO-BUSINT)
         (CNSUBW (+ 764500 (LSH REGN 1)) VAL))
        ((EQ SPY-ACCESS-PATH 'BUSINT)
         (DBG-WRITE (+ 766000 (LSH REGN 1)) VAL))
        ((EQ SPY-ACCESS-PATH 'TEN11)
         (CNSUBW (+ 766000 (LSH REGN 1)) VAL))
        (T (ERROR '|bad value for SPY-ACCESS-PATH| SPY-ACCESS-PATH)))
  T) ;Don't number cons result of CNSUBW!!

(COMMENT ROUTINES WHICH MANIPULATE THE MACHINE DIRECTLY)

;READ OBUS AS A FIXNUM
(DEFUN CC-READ-OBUS ()
  (LET ((LOW (SPY-READ SPY-OB-LOW))
        (HIGH (SPY-READ SPY-OB-HIGH)))
     (DECLARE (FIXNUM LOW HIGH))
     (+ (LSH HIGH 16.) LOW)))

;READ A-BUS AS A FIXNUM
(DEFUN CC-READ-A-BUS ()
  (LET ((LOW (SPY-READ SPY-A-LOW))
        (HIGH (SPY-READ SPY-A-HIGH)))
     (DECLARE (FIXNUM LOW HIGH))
     (+ (LSH HIGH 16.) LOW)))

;READ M-BUS AS A FIXNUM
(DEFUN CC-READ-M-BUS ()
  (LET ((LOW (SPY-READ SPY-M-LOW))
        (HIGH (SPY-READ SPY-M-HIGH)))
     (DECLARE (FIXNUM LOW HIGH))
     (+ (LSH HIGH 16.) LOW)))

;READ IR AS A BIGNUM
(DEFUN CC-READ-IR ()
  (LET ((LOW (SPY-READ SPY-IR-LOW))
        (MIDDLE (SPY-READ SPY-IR-MED))
        (HIGH (SPY-READ SPY-IR-HIGH)))
     (DECLARE (FIXNUM LOW MIDDLE HIGH))
     (LOGDPB HIGH 4020 (+ (LSH MIDDLE 16.) LOW))))

;READ PC AS A FIXNUM
(DEFUN CC-READ-PC ()
 (SPY-READ SPY-PC)))

;GET 32-BIT ERROR STATUS WORD
;THIS IS FLAG1_16.+FLAG2
(DEFUN CC-READ-STATUS ()
  (LET ((FLAG1 (SPY-READ SPY-FLAG-1))
        (FLAG2 (SPY-READ SPY-FLAG-2)))
     (DECLARE (FIXNUM FLAG1 FLAG2))
     (AND (BIT-TEST 100 (SPY-READ SPY-IR-LOW))
          (SETQ FLAG2 (LOGXOR 4 FLAG2))) ;Hardware reads JC-TRUE incorrectly
     (+ FLAG2 (LSH FLAG1 16.))))

;WRITE DIAG IR FROM A BIGNUM
(DEFUN CC-WRITE-DIAG-IR (IR)
  (SPY-WRITE SPY-IR-LOW (LOGLDB 0020 IR))
  (SPY-WRITE SPY-IR-MED (LOGLDB 2020 IR))
  (SPY-WRITE SPY-IR-HIGH (LOGLDB 4020 IR))
  T)

(DEFUN CC-WRITE-IR (IR)
  (CC-WRITE-DIAG-IR IR)
  (CC-NOOP-DEBUG-CLOCK)
  T)

;THIS FUNCTION WRITES INTO THE MD.  IF SPY-ACCESS-PATH IS NO-BUSINT, IT HAS TO
;SHIFT IT IN A BIT AT A TIME.  OTHERWISE IT IS BROUGHT IN THROUGH THE BUS INTERFACE,
;USING MAPPING REGISTER 7.
(DEFUN CC-WRITE-MD (NUM)
  (COND ((EQ SPY-ACCESS-PATH 'BUSINT)
         (COND ((NOT CC-UNIBUS-MAP-TO-MD-OK-FLAG)
                (DBG-WRITE-UNIBUS-MAP 7 177000) ;MR7 := VALID + WR-ENB 
                                                ; + MAGIC HIGH 5 1'S TO ADDRESS MD
                (SETQ CC-UNIBUS-MAP-TO-MD-OK-FLAG T)))
         (DBG-WRITE 156000 NUM)  ;WRITE LOW HALF-WORD
         (DBG-WRITE 156002 (LSH NUM -16.))) ;THEN HIGH HALF-WORD
        ((EQ SPY-ACCESS-PATH 'NO-BUSINT)
         (CC-WRITE-MD-SHIFTING NUM)
         NIL)
        ((EQ SPY-ACCESS-PATH 'TEN11)
         (LET ((CTALK-BARF-AT-WRITE-ERRORS NIL))  ;CAN'T READ IT BACK VIA THIS KLUDGE
           (CNSPMW 17400000 NUM)))        ;THIS IS UNIBUS SPACE ON THE XBUS, 
                                          ; SO IT JUST LOADS THE MD
        (T (ERROR '|SPY-ACCESS-PATH NOT KNOWN ABOUT IN CC-WRITE-MD| SPY-ACCESS-PATH))))

(DEFUN CC-WRITE-MD-SHIFTING (NUM)
       (SETQ NUM (LOGAND 37777777777 NUM))              ;MAKE SURE ONLY 32 BITS
       (COND ((ZEROP (LOGAND 1_31. NUM))
              (CC-EXECUTE (WRITE)
                          CONS-IR-OB CONS-OB-ALU
                          CONS-IR-ALUF CONS-ALU-SETZ
                          CONS-IR-FUNC-DEST CONS-FUNC-DEST-MD))
             (T
              (CC-EXECUTE (WRITE)
                          CONS-IR-OB CONS-OB-ALU
                          CONS-IR-ALUF CONS-ALU-SETO
                          CONS-IR-FUNC-DEST CONS-FUNC-DEST-MD)))
       (COND ((ZEROP NUM))                              ;ALREADY THERE
             ((= NUM 37777777777))
             ((DO ((I 31. (1- I))                       ;SHIFT IN REMAINING 31 BITS
                   (N NUM (LSH N 1)))
                  ((ZEROP I))
                  (DECLARE (FIXNUM I N))
                  (COND ((ZEROP (LOGAND 1_30. N))
                         (CC-EXECUTE (WRITE)
                                     CONS-IR-OB CONS-OB-ALU
                                     CONS-IR-ALUF CONS-ALU-M+M
                                     CONS-IR-M-SRC CONS-M-SRC-MD
                                     CONS-IR-FUNC-DEST CONS-FUNC-DEST-MD))
                        (T
                         (CC-EXECUTE (WRITE)
                                     CONS-IR-OB CONS-OB-ALU
                                     CONS-IR-ALUF CONS-ALU-M+M+1
                                     CONS-IR-M-SRC CONS-M-SRC-MD
                                     CONS-IR-FUNC-DEST CONS-FUNC-DEST-MD)))))))

;TICK CLOCK IN DEBUG MODE (EXECUTE IR, LOAD IR FROM DIAG IR)
(DEFUN CC-DEBUG-CLOCK ()
  (SPY-WRITE SPY-CLK 12) ;DEBUG ON, STEP
  (SPY-WRITE SPY-CLK 0)  ;STEP OFF, PRESUMABLY MACHINE HAS EXECUTED IT BY NOW
  T)

;TICK CLOCK IN NOOP-DEBUG MODE, WHICH FINISHES WRITES
(DEFUN CC-NOOP-DEBUG-CLOCK ()
  (SPY-WRITE SPY-CLK 16) ;DEBUG, NOOP, STEP
  (SPY-WRITE SPY-CLK 0)  ;CLEAR STEP, PRESUMABLY MACHINE HAS EXECUTED IT BY NOW
  T)

;NORMAL-MODE CLOCK
(DEFUN CC-CLOCK ()
  (SPY-WRITE SPY-CLK 2) ;STEP
  (SPY-WRITE SPY-CLK 0) ;CLEAR STEP
  T)

;TICK CLOCK IN NORMAL-NOOP MODE
(DEFUN CC-NOOP-CLOCK ()
  (SPY-WRITE SPY-CLK 6)  ;NOOP, STEP
  (SPY-WRITE SPY-CLK 0)  ;CLEAR STEP
  T)

;SINGLE-STEP THE MACHINE (USES CC-NOOP-FLAG)
(DEFUN CC-SINGLE-STEP ()
  (COND (CC-NOOP-FLAG
           (CC-NOOP-CLOCK))
        (T (CC-CLOCK)))
  (SETQ CC-ERROR-STATUS (CC-READ-STATUS)
        CC-NOOP-FLAG (BIT-TEST 20 CC-ERROR-STATUS)))

(COMMENT ROUTINE TO EXECUTE A SYMBOLIC INSTRUCTION)

;CALL THESE VIA THE CC-EXECUTE MACRO

;FOR READING.  WILL LEAVE THE DESIRED DATA ON THE OBUS
(DEFUN CC-EXECUTE-R (LOW MIDDLE HIGH)
  (SPY-WRITE SPY-IR-LOW LOW)    ;PUT INSTRUCTION INTO MACHINE
  (SPY-WRITE SPY-IR-MED MIDDLE)
  (SPY-WRITE SPY-IR-HIGH HIGH)
  (CC-NOOP-DEBUG-CLOCK))        ;PUT IT INTO IR, IT WILL THEN ROUTE PROPER STUFF TO OBUS

;FOR WRITING.  WILL CLOCK THE MACHINE IN NON-DEBUG MODE WHICH IS
;GOOD FOR READING AND WRITING CONTROL MEMORY.
(DEFUN CC-EXECUTE-W (LOW MIDDLE HIGH)
  (SPY-WRITE SPY-IR-LOW LOW)    ;PUT INSTRUCTION INTO MACHINE
  (SPY-WRITE SPY-IR-MED MIDDLE)
  (SPY-WRITE SPY-IR-HIGH HIGH)
  (CC-NOOP-DEBUG-CLOCK)         ;PUT IT INTO IR, IT WILL START EXECUTING
  (CC-CLOCK)                    ;CLOCK THAT INSTRUCTION, GARBAGE TO IR
  (CC-NOOP-CLOCK)               ;CLOCK MACHINE AGAIN TO CLEAR PASS AROUND PATH, LOAD IR
  T)                            ; WITH INSTRUCTION JUMPED TO, ETC.

(COMMENT READ AND WRITE RAMS)

;READ M-MEMORY DIRECTLY OUT OF MACHINE
;WE USE THIS FOR READING FUNCTIONAL SOURCES ALSO
(DEFUN CC-READ-M-MEM (ADR)
  (CC-EXECUTE CONS-IR-M-SRC ADR ;PUT IT ONTO THE OBUS
              CONS-IR-ALUF CONS-ALU-SETM
              CONS-IR-OB CONS-OB-ALU)
  (CC-READ-OBUS))

;WRITE INTO M-MEMORY
(DEFUN CC-WRITE-M-MEM
 (LOC VAL)
  (CC-WRITE-MD VAL)             ;PUT VALUE INTO THE MRD REGISTER
  (CC-EXECUTE (WRITE)
              CONS-IR-M-SRC CONS-M-SRC-MD       ;MOVE IT TO DESIRED PLACE
              CONS-IR-ALUF CONS-ALU-SETM 
              CONS-IR-OB CONS-OB-ALU
              CONS-IR-M-MEM-DEST LOC))

;READ A-MEMORY
(DEFUN CC-READ-A-MEM (ADR)
  (CC-EXECUTE CONS-IR-A-SRC ADR ;PUT IT ONTO THE OBUS
              CONS-IR-ALUF CONS-ALU-SETA
              CONS-IR-OB CONS-OB-ALU)
  (CC-READ-OBUS))

;WRITE INTO A-MEMORY
(DEFUN CC-WRITE-A-MEM (LOC VAL)
  (CC-WRITE-MD VAL)             ;PUT VALUE INTO THE MRD REGISTER
  (CC-EXECUTE (WRITE)
              CONS-IR-M-SRC CONS-M-SRC-MD       ;MOVE IT TO DESIRED PLACE
              CONS-IR-ALUF CONS-ALU-SETM 
              CONS-IR-OB CONS-OB-ALU
              CONS-IR-A-MEM-DEST (+ CONS-A-MEM-DEST-INDICATOR LOC)))

;READ CONTROL-MEMORY
(DEFUN CC-READ-C-MEM (ADR)
  (CC-EXECUTE (WRITE)
              CONS-IR-OP CONS-OP-JUMP   ;DO JUMP INSTRUCTION TO DESIRED PLACE
              CONS-IR-JUMP-ADDR ADR
              CONS-IR-JUMP-COND CONS-JUMP-COND-UNC)
  (CC-READ-IR))                 ;RETURN CONTENTS

;WRITE CONTROL-MEMORY
(DEFUN CC-WRITE-C-MEM (ADR VAL)
  (CC-WRITE-A-MEM 1 (LOGLDB 4020 VAL))  ;1@A GETS HIGH 16 BITS
  (CC-WRITE-M-MEM 0 (LOGLDB 0040 VAL))  ;0@M GETS LOW 32 BITS
  (CC-EXECUTE (WRITE)
              CONS-IR-OP CONS-OP-JUMP   ;EXECUTE MAGIC FLAVOR OF JUMP INSTRUCTION
              CONS-IR-JUMP-ADDR ADR
              CONS-IR-P 1               ;R+P=WRITE C MEM
              CONS-IR-R 1
              CONS-IR-A-SRC 1
              ;CONS-IR-M-SRC 0
              CONS-IR-JUMP-COND CONS-JUMP-COND-UNC))

;THIS ONE IS DIFFERENT FROM EVERYTHING ELSE.  IT AGREES WITH THE ULOAD FORMAT.
;NOTE THAT THE CC-EXECUTE MACRO CAN CALL THIS WITH VALUES WITH BITS
;ON IN OTHER THAN THE LOW 16 BITS.  THE LOGIOR CAUSES THE RIGHT THING TO HAPPEN.
(DEFUN CC-WRITE-C-MEM-3-16BIT-WORDS (ADR HIGH MIDDLE LOW)
  (CC-WRITE-A-MEM 1 HIGH)               ;1@A GETS HIGH 16 BITS
  (CC-WRITE-MD (LOGIOR (LSH MIDDLE 16.) LOW))  ;MD GETS LOW 32 BITS
  (CC-EXECUTE (WRITE)
              CONS-IR-OP CONS-OP-JUMP   ;EXECUTE MAGIC FLAVOR OF JUMP INSTRUCTION
              CONS-IR-JUMP-ADDR ADR
              CONS-IR-P 1               ;R+P=WRITE C MEM
              CONS-IR-R 1
              CONS-IR-A-SRC 1
              CONS-IR-M-SRC CONS-M-SRC-MD
              CONS-IR-JUMP-COND CONS-JUMP-COND-UNC))

;WRITE INTO MACHINE'S PC
(DEFUN CC-WRITE-PC (PC)
  (LET ((TEM NIL))
    (SETQ PC (LOGAND 37777 PC)) ;14 BITS
    (CC-EXECUTE CONS-IR-OP CONS-OP-JUMP ;JUMP INSTRUCTION TO IR
                CONS-IR-JUMP-ADDR PC
                CONS-IR-JUMP-COND CONS-JUMP-COND-UNC)
    (CC-DEBUG-CLOCK)            ;CLOCK INTO PC
    (OR (= PC (SETQ TEM (CC-READ-PC)))  ;CHECK?
        (ERROR '|CORRECT . ACTUAL - LOSSAGE - CC-WRITE-PC| (CONS PC TEM) 'FAIL-ACT))
    T))

(DEFUN CC-WRITE-FUNC-DEST (ADR VAL)
  (CC-WRITE-MD VAL)
  (CC-EXECUTE (WRITE)
        CONS-IR-M-SRC CONS-M-SRC-MD
        CONS-IR-ALUF CONS-ALU-SETM
        CONS-IR-OB CONS-OB-ALU
        CONS-IR-FUNC-DEST ADR))

(DEFUN CC-WRITE-Q (VAL)
  (CC-WRITE-MD VAL)
  (CC-EXECUTE (WRITE)
        CONS-IR-M-SRC CONS-M-SRC-MD
        CONS-IR-ALUF CONS-ALU-SETM
        CONS-IR-OB CONS-OB-ALU
        CONS-IR-Q CONS-Q-LOAD))

(DEFUN CC-WRITE-STAT-COUNTER (VAL)
  (CC-WRITE-MD VAL)     ;GET VALUE ON M-SIDE
  (CC-EXECUTE
        CONS-IR-M-SRC CONS-M-SRC-MD)
  (CC-NOOP-CLOCK)       ;IWR GETS M
  (SPY-WRITE SPY-CLK 26)        ;CLOCK MACHINE WITH LDSTAT SET
  (SPY-WRITE SPY-CLK 0))        ;CLEAR STEP, LDSTAT

;SAVE THE PDL-BUFFER-INDEX INTO CC-SAVED-PDL-BUFFER-INDEX
(DEFUN CC-SAVE-PDL-BUFFER-INDEX ()
  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-PDL-BUFFER-INDEX ;PUT PDL INDEX ONTO OBUS BITS 9-0
              CONS-IR-ALUF CONS-ALU-SETM
              CONS-IR-OB CONS-OB-ALU)
  (SETQ CC-PDL-BUFFER-INDEX-CHANGED-FLAG T
        CC-SAVED-PDL-BUFFER-INDEX (CC-READ-OBUS)))

;WRITE INTO PDL-BUFFER-INDEX
(DEFUN CC-WRITE-PDL-BUFFER-INDEX (VAL)
  (CC-WRITE-MD VAL)                                     ;PUT VALUE INTO MD
  (CC-EXECUTE (WRITE)
              CONS-IR-M-SRC CONS-M-SRC-MD               ;MOVE INTO PDL INDEX
              CONS-IR-ALUF CONS-ALU-SETM
              CONS-IR-OB CONS-OB-ALU
              CONS-IR-FUNC-DEST CONS-FUNC-DEST-PDL-BUFFER-INDEX))

;READ THE PDL BUFFER
(DEFUN CC-READ-PDL-BUFFER (ADR)
  (OR CC-PDL-BUFFER-INDEX-CHANGED-FLAG
      (CC-SAVE-PDL-BUFFER-INDEX))                       ;SAVE PDL INDEX IF NECESSARY
  (CC-WRITE-PDL-BUFFER-INDEX ADR)                       ;ADDRESS THE PDL
  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-C-PDL-BUFFER-INDEX       ;READ IT OUT
              CONS-IR-ALUF CONS-ALU-SETM
              CONS-IR-OB CONS-OB-ALU)
  (CC-READ-OBUS))                                       ;RETURN CONTENTS

;WRITE THE PDL BUFFER
(DEFUN CC-WRITE-PDL-BUFFER (ADR VAL)
  (OR CC-PDL-BUFFER-INDEX-CHANGED-FLAG (CC-SAVE-PDL-BUFFER-INDEX)) ;SAVE PDL INDEX IF NECESSARY
  (CC-WRITE-PDL-BUFFER-INDEX ADR)                       ;ADDRESS THE PDL
  (CC-WRITE-MD VAL)                                     ;PUT VALUE INTO MRD
  (CC-EXECUTE (WRITE)
              CONS-IR-M-SRC CONS-M-SRC-MD               ;STORE INTO PDL BUFFER
              CONS-IR-ALUF CONS-ALU-SETM
              CONS-IR-OB CONS-OB-ALU
              CONS-IR-FUNC-DEST CONS-FUNC-DEST-C-PI))

;READ OUT THE MICRO STACK POINTER
(DEFUN CC-READ-MICRO-STACK-PTR ()
  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-MICRO-STACK      ;READ OUT THE MICRO STACK PTR
              CONS-IR-ALUF CONS-ALU-SETM
              CONS-IR-OB CONS-OB-ALU)
  (LOGLDB-FROM-FIXNUM CONS-US-POINTER-BYTE (CC-READ-OBUS)))

;SAVE THE ENTIRE MICRO STACK (AND THE POINTER)
(DEFUN CC-SAVE-MICRO-STACK ()
  (COND ((NOT CC-MICRO-STACK-SAVED-FLAG)        ;DON'T DO IF DID ALREADY
         (SETQ CC-MICRO-STACK-SAVED-FLAG T)
         (SETQ CC-SAVED-MICRO-STACK-PTR (CC-READ-MICRO-STACK-PTR))
         (DO ((COUNT 32. (1- COUNT))    ;NOW READ OUT THE WHOLE STACK
              (IDX CC-SAVED-MICRO-STACK-PTR (LOGAND 37 (1- IDX))))
             ((= 0 COUNT))
           (DECLARE (FIXNUM COUNT IDX))
           (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-MICRO-STACK-POP
                       CONS-IR-ALUF CONS-ALU-SETM
                       CONS-IR-OB CONS-OB-ALU)
           (STORE (CC-MICRO-STACK IDX)
                  (LOGLDB-FROM-FIXNUM CONS-US-DATA-BYTE (CC-READ-OBUS)))
           (CC-CLOCK)))))               ;NOW DECREMENT USP


;RESTORE THE MICRO STACK AND THE POINTER
(DEFUN CC-RESTORE-MICRO-STACK ()
  (COND (CC-MICRO-STACK-SAVED-FLAG 
         (DO ()                                         ;UNTIL USP EQUALS THE DESIRED VALUE,
             ((= CC-SAVED-MICRO-STACK-PTR (CC-READ-MICRO-STACK-PTR)))
             (CC-EXECUTE (WRITE) CONS-IR-M-SRC CONS-M-SRC-MICRO-STACK-POP)) ;KEEP POPPING IT
         (DO ((COUNT 32. (1- COUNT))                    ;NOW RESTORE THE WHOLE STACK
              (IDX CC-SAVED-MICRO-STACK-PTR))
             ((= COUNT 0))
             (DECLARE (FIXNUM COUNT IDX))
             (SETQ IDX (LOGAND 37 (1+ IDX)))            ;SIMULATE HARDWARE PUSH OPERATION
             (CC-WRITE-MD (CC-MICRO-STACK IDX)) ;GET DATA INTO MRD
             (CC-EXECUTE (WRITE)
                         CONS-IR-M-SRC CONS-M-SRC-MD    ;PUSH IT
                         CONS-IR-ALUF CONS-ALU-SETM
                         CONS-IR-OB CONS-OB-ALU
                         CONS-IR-FUNC-DEST CONS-FUNC-DEST-MICRO-STACK-PUSH))
         (SETQ CC-MICRO-STACK-SAVED-FLAG NIL))))

;SAVE THE DISPATCH CONSTANT IF NOT SAVED ALREADY
;RETURNS THE VALUE
(DEFUN CC-SAVE-DISPATCH-CONSTANT ()
  (COND (CC-SAVED-DISPATCH-CONSTANT)
        (T
         (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-DISP-CONST
                     CONS-IR-ALUF CONS-ALU-SETM
                     CONS-IR-OB CONS-OB-ALU)
         (SETQ CC-SAVED-DISPATCH-CONSTANT (CC-READ-OBUS)))))

;RESTORE DISPATCH CONSTANT IF IT WAS SAVED.  BASHES PC, POSSIBLY MICRO-STACK.
(DEFUN CC-RESTORE-DISPATCH-CONSTANT ()
  (COND (CC-SAVED-DISPATCH-CONSTANT
         (CC-SAVE-MICRO-STACK)
         (CC-EXECUTE (WRITE)
                     CONS-IR-OP CONS-OP-DISPATCH
                     CONS-IR-DISP-CONST CC-SAVED-DISPATCH-CONSTANT)
         (SETQ CC-SAVED-DISPATCH-CONSTANT NIL))))

;READ OUT DISPATCH MEMORY
;(IF R BIT IS ON, DPC CONTAINS RANDOMNESS, SO WE WILL CLEAR IT.)
(DEFUN CC-READ-D-MEM (ADR)
  (LET ((PCS 0)
        (FLAG2 0)
        (RPN 0))
     (DECLARE (FIXNUM DC PCS RPN FLAG2))
     (CC-SAVE-MICRO-STACK)              ;AVOID SMASHING MICRO STACK
     (CC-SAVE-DISPATCH-CONSTANT)        ;AVOID SMASHING DISPATCH CONSTANT
     (CC-EXECUTE CONS-IR-OP CONS-OP-DISPATCH    ;EXECUTE A DISPATCH WITH BYTE SIZE ZERO
                 CONS-IR-DISP-ADDR ADR)
             ;AT THIS POINT THE DISP IS IN IR BUT HAS NOT YET BEEN EXECUTED.
             ;WE'LL EXECUTE IT IN A MOMENT, BUT FIRST CHECK OUT THE PC SELECT BITS.
     (SETQ PCS (LOGLDB-FROM-FIXNUM 0002 (SPY-READ SPY-FLAG-2))) ;GET PC SELECT BITS
     (SETQ RPN (NTH PCS '(4             ;R (POPJ)
                          0             ;(JUMP VIA IR??)
                          0             ;(JUMP VIA D-MEM)
                          6)))          ;R+P, DROP THROUGH
     (CC-CLOCK)                         ;CLOCK IT SO PC LOADS FROM DISP MEM
     (SETQ FLAG2 (SPY-READ SPY-FLAG-2)) ; THEN PICK UP NOOP AND SPUSHD FLAGS
     (AND (BIT-TEST 20 FLAG2)           ;SEE IF NOOP FLAG ON
          (SETQ RPN (LOGIOR RPN 1)))    ;TURN ON N BIT
     (AND (BIT-TEST 400 FLAG2)          ;SEE IF SPUSHD IS ON
          (SETQ RPN (LOGIOR RPN 2)))
     (LOGDPB-INTO-FIXNUM RPN            ;RETURN R,P,N BITS MERGED WITH PC
                 CONS-DISP-RPN-BITS
                 (COND ((OR (= PCS 0) (= PCS 3)) 0) ;IF R OR R+P, DPC IS MEANINGLESS, USE 0
                       ((CC-READ-PC))))))

;WRITE INTO DISPATCH MEMORY
(DEFUN CC-WRITE-D-MEM (ADR VAL)
     (CC-SAVE-MICRO-STACK)              ;DON'T SMASH MICRO STACK
     (CC-SAVE-DISPATCH-CONSTANT)        ;DON'T SMASH DISPATCH CONSTANT
     (SETQ VAL                          ;COMPUTE PARITY
           (LOGDPB-INTO-FIXNUM (DO ((COUNT 17. (1- COUNT))
                                    (X VAL (LOGXOR VAL (LSH X -1))))
                                   ((= COUNT 0)
                                    (LOGXOR 1 X)))      ;ODD PARITY
                               CONS-DISP-PARITY-BIT
                               VAL))
     (CC-WRITE-A-MEM 0 VAL)             ;DATA TO BE WRITTEN TO A-LOC 0
     ;PUT INSTRUCTION IN DIB AND IR
     (CC-EXECUTE CONS-IR-OP CONS-OP-DISPATCH
                 CONS-IR-A-SRC 0
                 CONS-IR-DISP-ADDR ADR
                 CONS-IR-MF 2)  ;MF2 IS WRITE D-MEM
     ;GENERATE A CLOCK FOLLOWED BY A WRITE PULSE, WITHOUT CHANGING IR
     ;NOTE THAT WRITING D MEM IS DIFFERENT FROM WRITING ANYTHING ELSE
     ;BECAUSE THE WRITE IS NOT DELAYED, BUT DOES USE WP.
     (CC-DEBUG-CLOCK))

(COMMENT RESET START AND STOP)

;RESET THE MACHINE
(DEFUN CC-RESET-MACH ()
  (SPY-WRITE SPY-MODE 100) ;RESET HIGH
  (CC-WRITE-MODE-REG CC-MODE-REG)
  (COND ((NOT (EQ SPY-ACCESS-PATH 'NO-BUSINT))
         (DBG-RESET-STATUS))))          ;ALSO RESET UNIBUS, XBUS  PARERRS AND NXMS

;STORE MODE-REG VALUE INTO THE MACHINE
;CADR MODE REGS ARE THOROUGHLY INCOMPATIBLE WITH CONS MODE REGS
(DEFUN CC-WRITE-MODE-REG (MODE)
  (SPY-WRITE SPY-MODE MODE))

;STOP THE MACHINE
(DEFUN CC-STOP-MACH ()
  (SPY-WRITE SPY-CLK 0)         ;STOP CLOCK
  (SETQ CC-RUNNING NIL))        ;NOT RUNNING NOW

;START THE MACHINE.
(DEFUN CC-START-MACH ()
  (CC-FULL-RESTORE)             ;RESTORE MACHINE IF TRYING TO RUN
  (CC-SINGLE-STEP)              ;CLOCK ONCE, OBEYING SAVED NOOP FLAG
  (CC-CLOCK)                    ;CLOCK AGAIN
  (SPY-WRITE SPY-CLK 1)         ;TAKE OFF
  (SETQ CC-RUNNING T))))

;ARG IF SMALL IS A COUNT OTHERWISE IT IS THE REGISTER ADDRESS OF PC TO STOP AT.
;LATER ON THIS SHOULD USE THE STAT COUNTER?
(DEFUN CC-STEP-MACH (ARG)
  (COND ((< ARG RAORG)
         (DO N (MAX ARG 1) (1- N) (= N 0)
           (CC-SINGLE-STEP)))
        (T (SETQ ARG (- ARG RACMO))     ;STOP PC
           (PROG NIL    ;ALWAYS EXECUTE AT LEAST ONCE
            LP (CC-SINGLE-STEP)
               (AND (CC-HALTED)
                    (RETURN NIL))       ;MACHINE LOSSAGE, STOP
               (OR (= (CC-READ-PC) ARG)
                   (GO LP))
               (CC-SINGLE-STEP)         ;CLOCK ONCE MORE TO FETCH DESIRED INSTR
               (AND CC-NOOP-FLAG
                    (GO LP))            ;NOOP FLAG SET, NOT REALLY EXECUTING IT
               (RETURN T)))))           ;REACHED DESIRED PC, STOP

(DEFUN CC-HALTED ()
  (BIT-TEST 6000 (LOGXOR 4000 (SPY-READ SPY-FLAG-1))))

(COMMENT VIRTUAL MEMORY MAP MANIPULATION)

;READ OUT CONTENTS OF LEVEL 1 MAP
(DEFUN CC-READ-LEVEL-1-MAP (ADR)
  (CC-WRITE-MD (LOGDPB-INTO-FIXNUM ADR CONS-VMA-LEVEL-1-BYTE 0))        ;ADDRESS VIA MD
  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-MAP      ;READ OUT MAP DATA
              CONS-IR-ALUF CONS-ALU-SETM
              CONS-IR-OB CONS-OB-ALU)
  (LOGLDB-FROM-FIXNUM CONS-MAP-LEVEL-1-BYTE (CC-READ-OBUS)))

;WRITE INTO LEVEL 1 MAP
(DEFUN CC-WRITE-LEVEL-1-MAP (ADR VAL)
  (CC-WRITE-MD (LOGDPB-INTO-FIXNUM VAL          ;DATA TO WRITE
                                   CONS-MAP-LEVEL-1-BYTE-FOR-WRITING
                                   CONS-VMA-WRITE-LEVEL-1-MAP-BIT))
  (SETQ CC-VMA-CHANGED-FLAG T)
  (CC-EXECUTE (WRITE)                           ;MOVE WRITE DATA FROM MD TO VMA
              CONS-IR-M-SRC CONS-M-SRC-MD
              CONS-IR-ALUF CONS-ALU-SETM
              CONS-IR-OB CONS-OB-ALU
              CONS-IR-FUNC-DEST CONS-FUNC-DEST-VMA)
  (CC-WRITE-MD (LOGDPB-INTO-FIXNUM ADR CONS-VMA-LEVEL-1-BYTE 0))        ;ADDRESS VIA MD
  (CC-EXECUTE (WRITE)
              CONS-IR-M-SRC CONS-M-SRC-MD       ;DO A MD-WRITE-MAP
              CONS-IR-ALUF CONS-ALU-SETM
              CONS-IR-OB CONS-OB-ALU
              CONS-IR-FUNC-DEST CONS-FUNC-DEST-MD-WRITE-MAP))

;SUBROUTINE TO SET UP ADDRESS FOR LEVEL 2 MAP (USING LEVEL 1 MAP LOCATION 0)
;RETURNS VALUE TO GO INTO MD AS ADDRESS SOURCE
(DEFUN CC-ADDRESS-LEVEL-2-MAP (ADR)
  (COND ((NOT CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG)        ;SAVE AND SET CLOBBERED FLAG
         (SETQ CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG T)
         (SETQ CC-SAVED-LEVEL-1-MAP-LOC-0 (CC-READ-LEVEL-1-MAP 0))))
  (CC-WRITE-LEVEL-1-MAP 0 (LSH ADR -5)) ;HIGH 5 BITS OF ADDRESS TO LEVEL 1 MAP ENTRY 0
  (LOGDPB-INTO-FIXNUM ADR CONS-VMA-LEVEL-2-BYTE 0))     ;LOW 5 BITS OF ADDRESS TO RETURN VALUE

;READ OUT CONTENTS OF LEVEL 2 MAP
(DEFUN CC-READ-LEVEL-2-MAP (ADR)
  (CC-WRITE-MD (CC-ADDRESS-LEVEL-2-MAP ADR))    ;SET UP MD
  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-MAP      ;READ OUT MAP
              CONS-IR-ALUF CONS-ALU-SETM
              CONS-IR-OB CONS-OB-ALU)
  (LOGLDB-FROM-FIXNUM CONS-MAP-LEVEL-2-BYTE (CC-READ-OBUS)))

;WRITE INTO LEVEL 2 MAP
(DEFUN CC-WRITE-LEVEL-2-MAP (ADR VAL)
  (LET ((MAPADR (CC-ADDRESS-LEVEL-2-MAP ADR)))  ;SET UP ADDRESS (DON'T STORE IN HARDW YET)
     (DECLARE (FIXNUM MAPADR))
     (CC-WRITE-MD (LOGDPB-INTO-FIXNUM VAL       ;DATA TO WRITE
                                      CONS-MAP-LEVEL-2-BYTE
                                      CONS-VMA-WRITE-LEVEL-2-MAP-BIT))
     (SETQ CC-VMA-CHANGED-FLAG T)               ;MOVE WRITE-DATA INTO VMA
     (CC-EXECUTE (WRITE)
                 CONS-IR-M-SRC CONS-M-SRC-MD
                 CONS-IR-ALUF CONS-ALU-SETM
                 CONS-IR-OB CONS-OB-ALU
                 CONS-IR-FUNC-DEST CONS-FUNC-DEST-VMA)
     (CC-WRITE-MD MAPADR)                       ;NOW SET UP MD
     (CC-EXECUTE (WRITE)
                 CONS-IR-M-SRC CONS-M-SRC-MD    ;DO A MD-WRITE-MAP
                 CONS-IR-ALUF CONS-ALU-SETM
                 CONS-IR-OB CONS-OB-ALU
                 CONS-IR-FUNC-DEST CONS-FUNC-DEST-MD-WRITE-MAP)))

(COMMENT SAVE AND RESTORE THE STATE OF THE MACHINE)

;SAVE THINGS WHICH CAN BE SAVED WITHOUT MODIFYING THE STATE OF THE MACHINE
(DEFUN CC-PASSIVE-SAVE ()
  (COND ((NOT CC-PASSIVE-SAVE-VALID)
         (CNSPMI)  ;FLUSH UNIBUS MAP LOOKBEHIND
         (SETQ CC-PDL-BUFFER-INDEX-CHANGED-FLAG NIL     ;FIRST OF ALL, CLEAR FLAGS
               CC-MICRO-STACK-SAVED-FLAG NIL            ; WHICH MARK AUXILIARY PORTIONS
               CC-SAVED-DISPATCH-CONSTANT NIL           ; OF THE MACHINE NEED RESTORATION
               CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG NIL
               CC-VMA-CHANGED-FLAG NIL ;MRD ALMOST ALWAYS CHANGED, ALWAYS RESTORE IT
               CC-UNIBUS-MAP-TO-MD-OK-FLAG NIL)
         (SETQ CC-ERROR-STATUS (CC-READ-STATUS)
               CC-SAVED-PC (CC-READ-PC)
               CC-SAVED-IR (CC-READ-IR)
               CC-SAVED-OBUS (CC-READ-OBUS)
               CC-SAVED-NOOP-FLAG (BIT-TEST 20 CC-ERROR-STATUS))
         (SETQ CC-PASSIVE-SAVE-VALID T))))

;FULL SAVE
(DEFUN CC-FULL-SAVE ()
  (COND ((NOT CC-FULL-SAVE-VALID)
         (CC-STOP-MACH)
         (CC-PASSIVE-SAVE)
         (CC-SAVE-OPCS)
         (SETQ CC-SAVED-A-MEM-LOC-1 (CC-READ-A-MEM 1))
         (SETQ CC-SAVED-M-MEM-LOC-0 (CC-READ-M-MEM 0))
         (CC-SAVE-MEM-STATUS)
         (SETQ CC-FULL-SAVE-VALID T))))

(DEFUN CC-ENTER ()
  (COND ((EQ CC-LOW-LEVEL-FLAG 'VERY)
         (CC-STOP-MACH)
         (CC-PASSIVE-SAVE))
        ((NULL CC-FULL-SAVE-VALID)
         (CC-FULL-SAVE))))

;Put everything back in the real machine, but dont completely forget
; about it.
(DEFUN CC-REPLACE-STATE NIL
  (LET ((CC-FULL-SAVE-VALID CC-FULL-SAVE-VALID)
        (CC-PASSIVE-SAVE-VALID CC-PASSIVE-SAVE-VALID))
    (CC-FULL-RESTORE)))

;RESTORE THAT
(DEFUN CC-FULL-RESTORE ()
  (COND (CC-FULL-SAVE-VALID
         (AND CC-SAVED-DISPATCH-CONSTANT
              (CC-RESTORE-DISPATCH-CONSTANT))
         (AND CC-MICRO-STACK-SAVED-FLAG
              (CC-RESTORE-MICRO-STACK))
         (AND CC-PDL-BUFFER-INDEX-CHANGED-FLAG
              (CC-WRITE-PDL-BUFFER-INDEX CC-SAVED-PDL-BUFFER-INDEX))
         (SETQ CC-PDL-BUFFER-INDEX-CHANGED-FLAG NIL)
         (CC-WRITE-A-MEM 1 CC-SAVED-A-MEM-LOC-1) ;ON NEXT MACHINE, THIS LINE HAS TO CHANGE?
         (CC-WRITE-M-MEM 0 CC-SAVED-M-MEM-LOC-0)
         (CC-RESTORE-MEM-STATUS)
         (SETQ CC-FULL-SAVE-VALID NIL)))
  (COND (CC-PASSIVE-SAVE-VALID
         (CC-WRITE-PC (1- CC-SAVED-PC)) ;GETS INCREMENTED WHEN IR IS LOADED
         (CC-EXECUTE-R (LOGLDB 0020 CC-SAVED-IR)        ;RESTORE IR
                       (LOGLDB 2020 CC-SAVED-IR)
                       (LOGLDB 4020 CC-SAVED-IR))
         (SETQ CC-NOOP-FLAG CC-SAVED-NOOP-FLAG
               CC-PASSIVE-SAVE-VALID NIL
               CC-UNIBUS-MAP-TO-MD-OK-FLAG NIL))))

(DEFUN CC-SAVE-OPCS ()
  (DO I 0 (1+ I) (= I 8)
    (DECLARE (FIXNUM I))
    (STORE (CC-SAVED-OPCS I) (SPY-READ SPY-OPC))
    (SPY-WRITE SPY-OPC-CONTROL 2)       ;CLOCK OPCS
    (SPY-WRITE SPY-OPC-CONTROL 0)))

(DEFUN CC-SAVE-MEM-STATUS ()
  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-VMA
              CONS-IR-ALUF CONS-ALU-SETM
              CONS-IR-OB CONS-OB-ALU)
  (SETQ CC-SAVED-VMA (CC-READ-OBUS))
  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-MAP
              CONS-IR-ALUF CONS-ALU-SETM
              CONS-IR-OB CONS-OB-ALU)
  (SETQ CC-SAVED-MAP-AND-FAULT-STATUS (CC-READ-OBUS))
  (CC-EXECUTE CONS-IR-M-SRC CONS-M-SRC-MD
              CONS-IR-ALUF CONS-ALU-SETM
              CONS-IR-OB CONS-OB-ALU)
  (SETQ CC-SAVED-MD (CC-READ-OBUS)))

(DEFUN CC-RESTORE-MEM-STATUS ()
  (AND CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG
       (CC-WRITE-LEVEL-1-MAP 0 CC-SAVED-LEVEL-1-MAP-LOC-0))
  (SETQ CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG NIL)
  (COND (CC-VMA-CHANGED-FLAG
         (CC-WRITE-MD CC-SAVED-VMA)
         (CC-EXECUTE (WRITE)
                     CONS-IR-M-SRC CONS-M-SRC-MD
                     CONS-IR-ALUF CONS-ALU-SETM
                     CONS-IR-OB CONS-OB-ALU
                     CONS-IR-FUNC-DEST CONS-FUNC-DEST-VMA)))
  (SETQ CC-VMA-CHANGED-FLAG NIL)
  (CC-WRITE-MD CC-SAVED-MD)
  ;If we haven't executed any memory cycles via the processor, the page fault
  ;status bits will still be good.  If we have, tough noogies.  Attempting to
  ;restore them will bash the MD register and probably isn't needed anyway.
)

(COMMENT REGISTER ADDRESS INTERFACE)

;CC-REGISTER-EXAMINE
(DEFUN CC-R-E (ADR)
  (COND ((< ADR RAORG)
         (PRINT ADR) (PRINC "excessively small register address.")
         0)
        ((< ADR RAFSO)  ;RAMS
         (COND ((< ADR RAM2O)
                (COND ((< ADR RACME)
                       (CC-READ-C-MEM (- ADR RACMO)))
                      ((< ADR RADME)
                       (CC-READ-D-MEM (- ADR RADMO)))
                      ((< ADR RAPBE)
                       (CC-READ-PDL-BUFFER (- ADR RAPBO)))
                      ((CC-READ-LEVEL-1-MAP (- ADR RAM1O)))))
               ((< ADR RAM2E)
                (CC-READ-LEVEL-2-MAP (- ADR RAM2O)))
               ((< ADR RAAME)
                (COND ((AND (= (SETQ ADR (- ADR RAAMO)) 0) (NOT CC-LOW-LEVEL-FLAG))
                       CC-SAVED-M-MEM-LOC-0) ;M=A
                      ((AND (NOT CC-LOW-LEVEL-FLAG) (= ADR 1))
                       CC-SAVED-A-MEM-LOC-1)
                      ((CC-READ-A-MEM ADR))))
               ((< ADR RAUSE)
                (CC-SAVE-MICRO-STACK)
                (CC-MICRO-STACK (- ADR RAUSO)))
               ((AND (= (SETQ ADR (- ADR RAMMO)) 0) (NOT CC-LOW-LEVEL-FLAG))
                CC-SAVED-M-MEM-LOC-0)
               ((CC-READ-M-MEM ADR))))
        ((< ADR RAFSE)  ;FUNCTIONAL SOURCES
         (SETQ ADR (- ADR RAFSO))
         (COND (CC-LOW-LEVEL-FLAG (CC-READ-M-MEM (+ ADR CONS-FUNC-SRC-INDICATOR)))
               ((= ADR CONS-M-SRC-MD) CC-SAVED-MD)
               ((= ADR CONS-M-SRC-VMA) CC-SAVED-VMA)
               ((= ADR CONS-M-SRC-MAP) CC-SAVED-MAP-AND-FAULT-STATUS)
               ((AND (= ADR CONS-M-SRC-PDL-BUFFER-INDEX)
                     CC-PDL-BUFFER-INDEX-CHANGED-FLAG)
                CC-SAVED-PDL-BUFFER-INDEX)
               ((AND (OR (= ADR CONS-M-SRC-MICRO-STACK)
                         (= ADR CONS-M-SRC-MICRO-STACK-POP))
                     CC-MICRO-STACK-SAVED-FLAG)
                (PROG1 (LOGDPB-INTO-FIXNUM CC-SAVED-MICRO-STACK-PTR CONS-US-POINTER-BYTE
                                           (CC-MICRO-STACK CC-SAVED-MICRO-STACK-PTR))
                       (AND (= ADR CONS-M-SRC-MICRO-STACK-POP)
                            (SETQ CC-SAVED-MICRO-STACK-PTR
                                  (LOGAND 37 (1- CC-SAVED-MICRO-STACK-PTR))))))
               ((AND (= ADR CONS-M-SRC-C-PDL-BUFFER-INDEX)
                     CC-PDL-BUFFER-INDEX-CHANGED-FLAG)
                (CC-READ-PDL-BUFFER CC-SAVED-PDL-BUFFER-INDEX))
               (T (CC-READ-M-MEM (+ ADR CONS-FUNC-SRC-INDICATOR)))))
        ((< ADR RAFDE)  ;FUNCTIONAL DESTINATIONS
         (SETQ ADR (- ADR RAFDO))
         (COND (CC-LOW-LEVEL-FLAG
                (CC-READ-M-MEM
                        (COND ((= ADR CONS-FUNC-DEST-MD) CONS-M-SRC-MD)
                              ((= ADR CONS-FUNC-DEST-VMA) CONS-M-SRC-VMA)
                              ((= ADR CONS-FUNC-DEST-PDL-BUFFER-POINTER)
                               CONS-M-SRC-PDL-BUFFER-POINTER)
                              ((= ADR CONS-FUNC-DEST-PDL-BUFFER-INDEX)
                               CONS-M-SRC-PDL-BUFFER-INDEX)
                              ((= ADR CONS-FUNC-DEST-LC) CONS-M-SRC-LC)
                              (T (PRINT 'LOSE) 0))))
               ((= ADR CONS-FUNC-DEST-MD) CC-SAVED-MD)
               ((= ADR CONS-FUNC-DEST-VMA) CC-SAVED-VMA)
               ((= ADR CONS-FUNC-DEST-PDL-BUFFER-POINTER)
                (CC-READ-M-MEM CONS-M-SRC-PDL-BUFFER-POINTER))
               ((= ADR CONS-FUNC-DEST-PDL-BUFFER-INDEX)
                (OR CC-PDL-BUFFER-INDEX-CHANGED-FLAG (CC-SAVE-PDL-BUFFER-INDEX))
                CC-SAVED-PDL-BUFFER-INDEX)
               (T (PRINT (+ ADR RAFDO)) (PRINC "attempt to examine functional destination")
                  0)))
        ((< ADR RARGE)  ;INDIVIDUAL REGISTERS
         (COND ((= ADR RAPC)
                (COND ;(CC-LOW-LEVEL-FLAG (CC-READ-PC))
                      (T CC-SAVED-PC)))
               ((= ADR RAUSP)
                (COND (CC-MICRO-STACK-SAVED-FLAG
                       CC-SAVED-MICRO-STACK-PTR)
                      ((CC-READ-MICRO-STACK-PTR))))
               ((= ADR RAIR)
                (CC-READ-IR))  ;HARDWARE IR
               ((= ADR RASIR)
                (COND ;(CC-LOW-LEVEL-FLAG (CC-READ-IR))
                      (T CC-SAVED-IR)))   ;PROGRAM IR
               ((= ADR RAQ)
                (CC-READ-M-MEM CONS-M-SRC-Q))
               ((= ADR RALC)
                (CC-READ-M-MEM CONS-M-SRC-LC))
               ((= ADR RADC)
                (CC-SAVE-DISPATCH-CONSTANT))
               ((= ADR RASTS) CC-ERROR-STATUS)
               ((= ADR RAOBS)
                (COND ;(CC-LOW-LEVEL-FLAG (CC-READ-OBUS))
                      (T CC-SAVED-OBUS)))
               ((= ADR RAREALOBUS) (CC-READ-OBUS))
               ((= ADR RAABUS) (CC-READ-A-BUS))
               ((= ADR RAMBUS) (CC-READ-M-BUS))
               ((= ADR RASTAT) (+ (LSH (SPY-READ SPY-STAT-HIGH) 16.) (SPY-READ SPY-STAT-LOW)))
               ((= ADR RAGO)  ;Determine whether the machine is currently running
                (COND ((AND CC-RUNNING (NOT (CC-HALTED))) 1)
                      (T 0)))
               ((= ADR RAMOD) CC-MODE-REG)
               ((AND (>= ADR RAUBMO) (< ADR RAUBME))
                (COND ((EQ SPY-ACCESS-PATH 'BUSINT)
                       (DBG-READ-UNIBUS-MAP (- ADR RAUBMO)))
                      ((EQ SPY-ACCESS-PATH 'TEN11)
                       (CNSUBR (+ 766140 (* 2 (- ADR RAUBMO)))))
                      (T (ERROR '|UNKNOWN SPY-ACCESS-PATH EXAMINING UNIBUS MAP|
                                SPY-ACCESS-PATH))))
               (T (PRINT 'LOSE) 0)))
        ((< ADR RAOPCO)
         (PRINT ADR) (PRINC "is among the unimplemented registers.")
         0)
        ((< ADR RAOPCE)
         (CC-SAVED-OPCS (- ADR RAOPCO)))
        ((>= ADR CC-REG-ADR-PHYS-MEM-OFFSET)  ;REFERENCING XBUS FROM TEST PROGRAM
         (COND ((EQ SPY-ACCESS-PATH 'BUSINT)
                (DBG-READ-XBUS (- ADR CC-REG-ADR-PHYS-MEM-OFFSET)))
               ((EQ SPY-ACCESS-PATH 'TEN11)
                (CNSPMR (- ADR CC-REG-ADR-PHYS-MEM-OFFSET)))
               (T 
                (ERROR '|UNKNOWN SPY-ACCESS-PATH EXAMINING XBUS| SPY-ACCESS-PATH))))
        (T (PRINT ADR) (PRINC "is an excessively large register address")
           0)))

;CC-REGISTER-DEPOSIT
;WHEN TO SAVE & RESTORE STATE OF MACHINE IS FUZZY IN THIS FUNCTION
(DEFUN CC-R-D (ADR VAL)
  (COND ((< ADR RAORG)
         (PRINT ADR) (PRINC "excessively small register address.  Depositing ") (PRIN1 VAL))
        ((< ADR RAFSO)  ;RAMS
         (COND ((< ADR RAM2O)
                (COND ((< ADR RACME)
                       (CC-WRITE-C-MEM (- ADR RACMO) VAL))
                      ((< ADR RADME)
                       (CC-WRITE-D-MEM (- ADR RADMO) VAL))
                      ((< ADR RAPBE)
                       (CC-WRITE-PDL-BUFFER (- ADR RAPBO) VAL))
                      ((CC-WRITE-LEVEL-1-MAP (- ADR RAM1O) VAL))))
               ((< ADR RAM2E)
                (CC-WRITE-LEVEL-2-MAP (- ADR RAM2O) VAL))
               ((< ADR RAAME)
                (COND ((AND (= (SETQ ADR (- ADR RAAMO)) 1)
                            (NOT CC-LOW-LEVEL-FLAG))
                       (SETQ CC-SAVED-A-MEM-LOC-1 VAL))
                      ((CC-WRITE-A-MEM ADR VAL))))
               ((< ADR RAUSE)
                (CC-SAVE-MICRO-STACK)
                (STORE (CC-MICRO-STACK (- ADR RAUSO)) VAL)
                (AND CC-LOW-LEVEL-FLAG (CC-RESTORE-MICRO-STACK)))
               (T
                (SETQ ADR (- ADR RAMMO))
                (COND ((AND (= ADR 0) (NOT CC-LOW-LEVEL-FLAG))
                       (SETQ CC-SAVED-M-MEM-LOC-0 VAL))
                      (T (AND (= ADR 1) (SETQ CC-SAVED-A-MEM-LOC-1 VAL))
                         (CC-WRITE-M-MEM ADR VAL))))))
        ((< ADR RAFSE)  ;FUNCTIONAL SOURCES
         (PRINT ADR) (PRINC "attempt to deposit in functional source ignored"))
        ((< ADR RAFDE)  ;FUNCTIONAL DESTINATIONS
         (SETQ ADR (- ADR RAFDO))
         (COND ((AND (NOT CC-LOW-LEVEL-FLAG) (= ADR CONS-FUNC-DEST-MD))
                (SETQ CC-SAVED-MD VAL))
               ((AND (NOT CC-LOW-LEVEL-FLAG) (= ADR CONS-FUNC-DEST-VMA))
                (SETQ CC-SAVED-VMA VAL))
               ((AND (NOT CC-LOW-LEVEL-FLAG) (= ADR CONS-FUNC-DEST-PDL-BUFFER-INDEX))
                (SETQ CC-PDL-BUFFER-INDEX-CHANGED-FLAG T
                      CC-SAVED-PDL-BUFFER-INDEX VAL))
               (T
                (CC-WRITE-MD VAL)
                (CC-EXECUTE (WRITE)
                            CONS-IR-M-SRC CONS-M-SRC-MD
                            CONS-IR-ALUF CONS-ALU-SETM
                            CONS-IR-OB CONS-OB-ALU
                            CONS-IR-FUNC-DEST ADR)) ))
        ((< ADR RARGE)  ;INDIVIDUAL REGISTERS
         (COND ((= ADR RAPC)
                (COND (CC-LOW-LEVEL-FLAG (CC-WRITE-PC (LOGAND 37777 VAL)))
                      (T (SETQ CC-SAVED-PC (LOGAND 37777 VAL)))))
               ((= ADR RAUSP)
                (CC-SAVE-MICRO-STACK)
                (SETQ CC-SAVED-MICRO-STACK-PTR (LOGAND 37 VAL)))
               ((= ADR RAIR)
                (CC-WRITE-DIAG-IR VAL)
                (CC-NOOP-DEBUG-CLOCK))
               ((= ADR RAQ)
                (CC-WRITE-Q VAL))
               ((= ADR RALC)
                (CC-WRITE-FUNC-DEST CONS-FUNC-DEST-LC VAL))
               ((= ADR RADC)
                (SETQ CC-SAVED-DISPATCH-CONSTANT VAL)
                (AND CC-LOW-LEVEL-FLAG (CC-RESTORE-DISPATCH-CONSTANT)))
               ((= ADR RARSET)
                (CC-ZERO-ENTIRE-MACHINE))
               ((= ADR RARS)
                (CC-RESET-MACH)
                (SETQ CC-PASSIVE-SAVE-VALID NIL CC-FULL-SAVE-VALID NIL
                      CC-UNIBUS-MAP-TO-MD-OK-FLAG NIL)
                (CC-FULL-SAVE))
               ((= ADR RASTEP)
                (CC-FULL-RESTORE)
                (CC-STEP-MACH VAL)
                (CC-FULL-SAVE))
               ((= ADR RASTOP)
                (CC-FULL-SAVE)) ;STOP & SAVE
               ((= ADR RASA)  ;SET START ADDR
                (SETQ CC-SAVED-NOOP-FLAG T
                      CC-ERROR-STATUS (LOGIOR 20 CC-ERROR-STATUS) ;SET NOP BIT
                      CC-SAVED-PC (LOGAND 37777 VAL)))
               ((= ADR RAGO)
                (CC-START-MACH))
               ((= ADR RASTAT) (CC-WRITE-STAT-COUNTER VAL))
               ((= ADR RAMOD)
                (CC-WRITE-MODE-REG (SETQ CC-MODE-REG VAL)))
               ((AND (>= ADR RAUBMO) (< ADR RAUBME))
                (COND ((EQ SPY-ACCESS-PATH 'BUSINT)
                       (DBG-WRITE-UNIBUS-MAP (- ADR RAUBMO) VAL))
                      ((EQ SPY-ACCESS-PATH 'TEN11)
                       (CNSUBW (+ 766140 (* 2 (- ADR RAUBMO))) VAL))
                      (T (ERROR '|UNKNOWN SPY-ACCESS-PATH DEPOSITING UNIBUS MAP|
                                SPY-ACCESS-PATH))))
               (T (PRINT ADR) (PRINC "is an unimplemented register - deposit."))))
        ((>= ADR CC-REG-ADR-PHYS-MEM-OFFSET)  ;REFERENCING XBUS FROM TEST PROGRAM
         (COND ((EQ SPY-ACCESS-PATH 'BUSINT)
                (DBG-WRITE-XBUS (- ADR CC-REG-ADR-PHYS-MEM-OFFSET) VAL))
               ((EQ SPY-ACCESS-PATH 'TEN11)
                (CNSPMW (- ADR CC-REG-ADR-PHYS-MEM-OFFSET) VAL))
               (T (ERROR '|UNKNOWN SPY-ACCESS-PATH DEPOSITING XBUS| SPY-ACCESS-PATH))))
        (T (PRINT ADR)
           (PRINC "is an excessively large or unimplemented register address - deposit."))))

(COMMENT *** PATCHES TO CC)

;NEW REGISTERS:
; .A, .M, .OBUS (EXAMINE ONLY)
; .IR MAY BE DEPOSITED
;NEW COMMANDS:
; :EX CLOCK THE MACHINE, EXECUTING WHAT'S IN .IR
; :SCOPE RUN MACHINE AT FULL SPEED, REPEATING INSTRUCTION IN .IR
; adr :START   START MACHINE, LET IT RUN
; :LOWLEVEL T TURNS ON LOW-LEVEL MODE, IN WHICH READING MOST REGISTERS
;  GETS WHAT IS CURRENTLY IN THE MACHINE RATHER THAN WHAT IS SAVED,
;  WRITING IS UNAFFACTED.  MAKES THE DISPLAY AT THE BOTTOM OF THE SCREEN USEFUL WITH :EX
; :MODE DISPLAY THE CURRENT MODE-REGISTER (DECODED)
; :CHMODE APPLIES THE BIT-FIELD-EDITOR TO THE MODE-REGISTER.
; :RESTORE DOES A FULL-RESTORE, GETTING SOFTWARE STATE INTO HARDWARE
;UPDATES THE ERROR STATUS BITS AND MICROINSTRUCTION FORMAT FOR THE NEW MACHINE.
;NOTE THAT THE OFFSET FOR PHYSICAL MEMORY IS NOW 200000 INSTEAD OF 100000
;PERHAPS THE PHYSICAL MEMORY AND REGISTER-ADDRESS SPACE SHOULD BE MOVED
;TO HUGE ADDRESSES AND THE VIRTUAL-MEMORY OFFSET MOVED TO 0?

(DEFPROP START CC-COLON-START CC-COLON-CMD)

(DEFUN CC-COLON-START (PC) 
  (CC-RESET-MACH)
  (CC-WRITE-PC PC)
  (CC-NOOP-CLOCK)
  (CC-CLOCK)
  (SPY-WRITE SPY-CLK 1))

;EXECUTE .IR (I.E. CLOCK MACHINE ONCE)
(DEFPROP EX CC-EXECUTE-DOT-IR CC-COLON-CMD)

(DEFUN CC-EXECUTE-DOT-IR (ARG)
  (CC-CLOCK))

;******* THE FOLLOWING WILL HAVE TO BE CHANGED FOR NEW CC SYMBOL TABLE FORMAT *******
(SETQ CC-INITIAL-SYMS '( (RESET .  RARSET) (VMA . RAVMA) (MD . RAMD) (RAIDR . RARDRO)
                ;(PSV . RAPSVAL) (FSV . RAFSVAL) (LLMOD . RALLMOD)
                ;(RUNNING . RARUN) (TRYING-TO-RUN . RATRUN) (NOOPF . RANOOPF)
                (OPC . RAOPCO) (/.IR . RAIR) (IR . RASIR)
                (/.OBUS . RAREALOBUS) (/.A . RAABUS) (/.M . RAMBUS) (STATC . RASTAT)
                (FDEST . RAFDO) (FSRC . RAFSO)
                (PC . RAPC) (USP . RAUSP) (Q . RAQ) (DC . RADC) 
                (PP . RAPP) (PI . RAPI) (CIB . RACIBO) (MODE . RAMOD) 
                (LC . RALC) (UBM . RAUBMO)
;FUNCTIONAL SOURCE SYMS FOR TYPOUT
        (FS-DC . (+ RAFSO 0)) (FS-US . (+ RAFSO 1)) (FS-PP . (+ RAFSO 2)) (FS-PI . (+ RAFSO 3))
        (FS-C-PI . (+ RAFSO 5)) (FS-C-PP . (+ RAFSO 25)) (FS-C-PP-POP . (+ RAFSO 24))
        (FS-OPC . (+ RAFSO 6)) (FS-Q . (+ RAFSO 7))
        (FS-VMA . (+ RAFSO 10)) (FS-MAP . (+ RAFSO 11)) (FS-MD . (+ RAFSO 12))
        (FS-LC . (+ RAFSO 13)) (FS-US-POP . (+ RAFSO 14))
;FUNCTIONAL DESTINATIONS FOR TYPEOUT
        (FD-LC . (+ RAFDO 1)) (FD-INT-CTL . (+ RAFDO 2))
        (FD-C-PP . (+ RAFDO 10)) (FD-C-PP-PUSH . (+ RAFDO 11))
        (FD-C-PI . (+ RAFDO 12)) (FD-PI . (+ RAFDO 13)) (FD-PP . (+ RAFDO 14))
        (FD-US-PUSH . (+ RAFDO 15)) (FD-OA-LOW . (+ RAFDO 16)) (FD-OA-HIGH . (+ RAFDO 17))
        (FD-VMA . (+ RAFDO 20)) (FD-VMA-RD . (+ RAFDO 21)) (FD-VMA-WRT . (+ RAFDO 22))
        (FD-VMA-WRT-MAP . (+ RAFDO 23)) (FD-MD . (+ RAFDO 30)) (FD-MD-RD . (+ RAFDO 31))
        (FD-MD-WRT . (+ RAFDO 32)) (FD-MD-WRT-MAP . (+ RAFDO 33))
))

(CC-INITIALIZE-SYMBOL-TABLE NIL)

(SETQ CC-LOW-LEVEL-FLAG NIL)

(DEFPROP LOWLEVEL CC-SET-LOW-LEVEL-MODE CC-COLON-CMD)

(DEFUN CC-SET-LOW-LEVEL-MODE (ARG)
  (PRIN1 '(T OR NIL))
  (SETQ CC-LOW-LEVEL-FLAG (READ)))

(SETQ PDP11-DISABLE T) ;CLEARLY

(DEFUN CC-PRINT-ERROR-STATUS (ERR-STS)
       (COND (CC-LOW-LEVEL-FLAG
              (PRIN1-THEN-SPACE 'LOW-LEVEL-MODE)
             ;(SETQ ERR-STS (CC-READ-STATUS))
              )) ;GET LATEST WORD, IN LOW-LEVEL MODE
       (CC-PRINT-SET-BITS ERR-STS '(
        ;FLAG2
        NIL NIL ;PCS0, PCS1
        JC-TRUE P-FLT NO-OP IR48 NIL NIL ;NC NC
        SPUSHD PDLWRITED IMODD IWRITED DESTSPCD WMAPD NIL NIL ;NC NC
        ;FLAG1
;NOTE THAT THE BUS DRIVER WHICH DRIVES THE LOW ORDER 8 BITS IS AN INVERTING BUS FRYER.
         A-MEM-PAR M-MEM-PAR PDL-BUF-PAR SPC-PAR
         DISP-PAR C-MEM-PAR MN-MEM-PAR HIGH-ERR 
        S-RUN SSDONE ANY-ERR (NOT STAT-HALT)
        (NOT PROM-ENABLE) (NOT LVL-1-MAP-PAR) (NOT LVL-2-MAP-PAR) (NOT CLOCK-WAIT))))

(DECLARE (SPECIAL CC-MODE-REG-DESC))

(SETQ CC-MODE-REG-DESC
      '( (SELECT-FIELD SPEED 0002 (ULTRA-SLOW SLOW NORMAL FAST))
         (SELECT-FIELD ERROR-STOP-ENABLE 0201 (NIL ERROR-STOP-ENABLE))
         (SELECT-FIELD STAT-STOP-ENABLE 0301 (NIL STAT-STOP-ENABLE))
         (SELECT-FIELD PARITY-TRAP-ENABLE 0401 (NIL PARITY-TRAP-ENABLE))
         (SELECT-FIELD PROM-DISABLE 0501 (PROM-ENABLE PROM-DISABLE))
         (SELECT-FIELD RESET-BIT 0601 (NIL RESET-BIT)) ;HA
         (SELECT-FIELD BOOT-BIT 0701 (NIL BOOT-BIT)) ;HA
         ))

(DEFPROP MODE CC-SHOW-MODE CC-COLON-CMD)

(DEFUN CC-SHOW-MODE (ARG)
  (AND CC-LOW-LEVEL-FLAG (PRIN1-THEN-SPACE 'LOW-LEVEL-MODE))
  (CC-TYPE-OUT (OR ARG CC-MODE-REG) CC-MODE-REG-DESC NIL))

(DEFPROP CHMODE CC-EDIT-MODE CC-COLON-CMD)

(DEFUN CC-EDIT-MODE (ARG)
  (SPY-WRITE SPY-MODE (SETQ CC-MODE-REG (CC-TYPE-IN CC-MODE-REG-DESC CC-MODE-REG T))))

(DEFPROP RESTORE CC-RESTORE-CMD CC-COLON-CMD)

(DEFUN CC-RESTORE-CMD (ARG)
  (CC-FULL-RESTORE))

;PATCH MICRO-INSTRUCTION FORMAT TABLES FOR NEW MACHINE

(SETQ CC-O-UINST-DESC '( (SELECT-FIELD POPJ-AFTER-NEXT 5201 (NIL PJ))
                       (COND OPCD 5302 (CC-O-ALU-DESC
                                   CC-O-JMP-DESC 
                                   CC-O-DSP-DESC 
                                   CC-O-BYT-DESC))
                       (SELECT-FIELD ILONG 5501 (NIL ILONG))
                       (SELECT-FIELD STAT-BIT 5601 (NIL STAT-BIT))
                       (SELECT-FIELD BIT-47 5701 (NIL BIT-47)) ))
        
(SETQ CC-O-ALU-DESC '((TYPE ALU)
                      (TYPE-FIELD A 4012 RAAMO)
                      (TYPE-FIELD M 3206 RAMMO)
                      (SELECT-FIELD OB 1402 (MSK NIL ALUR1 ALUL1))
                      (SUB-FIELD CC-O-DEST-DESC)
                      (SELECT-FIELD ALUF 0306
                                (SETZ AND ANDCA SETM ANDCM SETA XOR IOR
                                 ANDCB EQV SETCA ORCA SETCM ORCM ORCB SETO
                                 T T T T T T SUB T
                                 T ADD T T INCM T T LSHM
                                 MUL DIV T T T DIVRC T T
                                 T DIVFS T T T T T T
                                 T T T T T T T T T T T T T T T T))
                      (SELECT-FIELD CARRY 0201 (C0 C1))
                      (SELECT-FIELD Q 0002 (NIL QLEFT QRIGHT LOADQ))
                      (SELECT-FIELD MF 1202 (NIL T T T))
))

(SETQ CC-O-DSP-DESC '((TYPE DSP)
                      (TYPE-FIELD DC 4012 NIL)
                      (TYPE-FIELD M 3206 RAMMO)
                      (TYPE-FIELD DO 1413 RADMO)
                      (TYPE-FIELD BYTL 0503 NIL)
                      (TYPE-FIELD MROT 0005 NIL)
                      (SELECT-FIELD LPC 3101 (NIL LPC))
                      (SELECT-FIELD IFETCH 3001 (NIL IFETCH))
                      (SELECT-FIELD MAP 1002 (NIL MAP-14 MAP-15 MAP-BOTH-14-AND-15))
                      (SELECT-FIELD MF 1202 (NIL T D-MEM-WRITE LOW-PC-BIT-SEL-HW))
))

(SETQ CC-O-JMP-DESC '((TYPE JMP)
                      (TYPE-FIELD A 4012 RAAMO)
                      (TYPE-FIELD M 3206 RAMMO)
                      (TYPE-FIELD J-ADR 1416 RACMO)
                      (SELECT-FIELD R 1101 (NIL R))
                      (SELECT-FIELD P 1001 (NIL P))
                      (SELECT-FIELD N 0701 (NIL N))
                      (SELECT-FIELD INV 0601 (NIL INV))
                      (COND TC 0501 (CC-O-JMP-BIT-DESC CC-O-JMP-ALU-DESC))
                      (SELECT-FIELD MF 1202 (NIL T T LOW-PC-BIT-SEL-HW))
))

(SETQ CC-O-JMP-BIT-DESC '( (TYPE MROT) (NUM 0005)       ;CAN'T USE TYPE-FIELD DUE TO TYPEIN BUG
))

(SETQ CC-O-JMP-ALU-DESC '( (SELECT-FIELD CONDITION 0003
                                (T M<A M<=A M=A PF INT-OR-PF SB-OR-INT-OR-PF UNC))
))

(SETQ CC-O-BYT-DESC '((TYPE BYT)
                      (TYPE-FIELD A 4012 RAAMO)
                      (TYPE-FIELD M 3206 RAMMO)
                      (SUB-FIELD CC-O-DEST-DESC)
                      (SELECT-FIELD BYTM 1402 (NIL LDB SSUB DPB))
                      (TYPE-FIELD BYTL 0505 NIL)
                      (TYPE-FIELD MROT 0005 NIL)
                      (SELECT-FIELD MF 1202 (NIL T T LOW-PC-BIT-SEL-HW))
))

(SETQ CC-O-DEST-DESC '( (COND DEST 3101 (CC-O-M-DEST-DESC CC-O-A-DEST-DESC))))

(SETQ CC-O-M-DEST-DESC '( (TYPE-FIELD DM 1605 RAMMO)
                        (TYPE-FIELD FD 2305 RAFDO)
))

(SETQ CC-O-A-DEST-DESC '( (TYPE-FIELD DA 1612 RAAMO)
))

;New assembler-style micro-instruction type-out and type-in.
(SETQ CC-UINST-DESC '( (CTYPE | (|)
                       (SELECT-FIELD POPJ-AFTER-NEXT? 5201 (NIL (POPJ-AFTER-NEXT YES)))
                       (COND OPCLASS 5302 (CC-ALU-DESC
                                           CC-JMP-DESC 
                                           CC-DSP-DESC 
                                           CC-BYT-DESC))
                       (SELECT-FIELD STAT-BIT 5601 (NIL (STAT-BIT YES)))
                       (SELECT-FIELD BIT-47 5701 (NIL (BIT-47 YES)))
                       (CTYPE |) |) ))

(SETQ CC-ALU-DESC '(  (INPUT (TYPE ALU))
                      (OUTPUT (SUB-FIELD CC-DEST-DESC))
                      (SELECT-FIELD ALU-FUNCTION 0306
                                (SETZ AND ANDCA SETM ANDCM (SETA NIL) XOR IOR
                                 ANDCB EQV SETCA ORCA SETCM ORCM ORCB SETO
                                 T T T T T T SUB T
                                 T ADD T T INCM T T LSHM
                                 MUL DIV T T T DIVRC T T
                                 T DIVFS T T T T T T
                                 T T T T T T T T T T T T T T T T))
                      (INPUT (SUB-FIELD CC-DEST-DESC))
                      (IF-EQUAL ALU 0306 26 CC-SUB-CARRY-DESC CC-NORMAL-CARRY-DESC)
                      (SELECT-FIELD OUTPUT-SELECTOR 1402
                                    (T NIL OUTPUT-SELECTOR-RIGHTSHIFT-1
                                       OUTPUT-SELECTOR-LEFTSHIFT-1))
                      (OUTPUT (SELECT-FIELD Q 0002 (NIL SHIFT-Q-LEFT SHIFT-Q-RIGHT NIL)))
                      (INPUT (SELECT-FIELD Q 0002 (NIL SHIFT-Q-LEFT SHIFT-Q-RIGHT LOAD-Q)))
                      (SUB-FIELD CC-M-SOURCE-DESC)
                      (TYPE-FIELD A 4012 RAAMO)
                      (SELECT-FIELD MF 1202 (NIL T T T))
                      (SELECT-FIELD ILONG 5501 ((NIL NO-ILONG) (ILONG YES)))
))

(SETQ CC-SUB-CARRY-DESC '((SELECT-FIELD CARRY 0201 (ALU-CARRY-IN-ZERO
                                                    (ALU-CARRY-IN-ONE NIL)))))

(SETQ CC-NORMAL-CARRY-DESC '((SELECT-FIELD CARRY 0201 ((NIL ALU-CARRY-IN-ZERO)
                                                       ALU-CARRY-IN-ONE))))

(SETQ CC-DSP-DESC '(  (TYPE DISPATCH)
                      (IF-EQUAL DISP-CONST 4012 0 NIL CC-DSP-CONST-DESC)
                      (CALL CC-BYTE-FIELD-OUT 0010 T NIL)
                      (SUB-FIELD CC-M-SOURCE-DESC)
                      (TYPE-FIELD D 1413 RADMO)
                      (SELECT-FIELD PUSH-OWN-ADDRESS? 3101 (NIL (PUSH-OWN-ADDRESS YES)))
                      (SELECT-FIELD IFETCH? 3001 (NIL (IFETCH YES)))
                      (SELECT-FIELD MAP 1002 (NIL MAP-14 MAP-15 MAP-BOTH-14-AND-15))
                      (SELECT-FIELD MF 1202 (NIL T D-MEM-WRITE LOW-PC-BIT-SEL-HW))
                      (SELECT-FIELD ILONG 5501 (NO-ILONG (ILONG NIL YES)))))

(SETQ CC-DSP-CONST-DESC '((CTYPE | (|)
                          (TYPE-FIELD I-ARG 4012 NIL)
                          (CTYPE |) |)))

(SETQ CC-JMP-DESC '(  (INPUT (TYPE JUMP)
                             (SELECT-FIELD CALL-RETURN 1002
                                           ((JUMP NIL) CALL RETURN T))
                             (COND COND 0501 (((SELECT-FIELD SENSE 0601 (BIT-SET BIT-CLEAR))
                                               (CALL CC-BYTE-FIELD-OUT 0005 T T))
                                              ((COND COND 0601
                                                  (((SELECT-FIELD COND 0003
                                                      (T LESS-THAN LESS-OR-EQUAL EQUAL
                                                       PAGE-FAULT PAGE-FAULT-OR-INTERRUPT
                                                       |SEQUENCE-BREAK-OR-...|
                                                       (ALWAYS NIL))))
                                                   ((SELECT-FIELD COND 0003
                                                      (T GREATER-OR-EQUAL
                                                       GREATER-THAN NOT-EQUAL
                                                       NO-PAGE-FAULT NO-PAGE-FAULT-OR-INTERRUPT
                                                       |NO-SEQUENCE-BREAK-OR-...|
                                                       NEVER))))))))
                             (SELECT-FIELD DONT-XCT-NEXT 0701 (XCT-NEXT (DONT-XCT-NEXT NIL))))
                      (OUTPUT (CALL CC-TYPE-JUMP-CONDITION 0012))
                      (SUB-FIELD CC-M-SOURCE-DESC)
                      (TYPE-FIELD A 4012 RAAMO)
                      (TYPE-FIELD J 1416 RACMO)
                      (SELECT-FIELD MF 1202 (NIL T T LOW-PC-BIT-SEL-HW))
                      (SELECT-FIELD ILONG 5501 ((NIL NO-ILONG) (ILONG YES)))
))

(SETQ CC-BYT-DESC '((INPUT (TYPE BYTE))
                    (OUTPUT (SUB-FIELD CC-DEST-DESC))
                    (SELECT-FIELD BYTE-OPERATION 1402 (T LDB SELECTIVE-DEPOSIT DPB))
                    (INPUT (SUB-FIELD CC-DEST-DESC))
                    (CALL CC-BYTE-FIELD-OUT 0012 NIL T)
                    (SUB-FIELD CC-M-SOURCE-DESC)
                    (TYPE-FIELD A 4012 RAAMO)
                    (SELECT-FIELD MF 1202 (NIL T T LOW-PC-BIT-SEL-HW))
                    (SELECT-FIELD ILONG 5501 ((NIL NO-ILONG) ILONG))
))

(SETQ CC-DEST-DESC '((OUTPUT (IF-EQUAL DEST 1613 0 CC-Q-DEST-DESC CC-DEST-DESC-1))
                     (INPUT (IF-EQUAL DEST 1613 0 NIL CC-DEST-DESC-1))))
(SETQ CC-DEST-DESC-1 '((CTYPE | (|)
                       (COND DEST 3101 (CC-M-DEST-DESC CC-A-DEST-DESC))
                       (OUTPUT (IF-EQUAL ALU 5302 0
                                         ((IF-EQUAL DEST 0002 3 ((TYPE Q-R)) NIL))
                                         NIL))
                       (CTYPE |) |)))

(SETQ CC-Q-DEST-DESC '((IF-EQUAL ALU 5302 0
                                 ((IF-EQUAL DEST 0002 3 ((CTYPE | (Q-R) |)) NIL))
                                 NIL)))

(SETQ CC-M-DEST-DESC '((TYPE-FIELD M 1605 RAMMO)
                       (SELECT-FIELD FDEST 2305
                            (NIL LOCATION-COUNTER INTERRUPT-CONTROL T T T T T   ;0 - 7
                             C-PDL-BUFFER-POINTER C-PDL-BUFFER-POINTER-PUSH     ;10, 11
                             C-PDL-BUFFER-INDEX PDL-BUFFER-INDEX                ;12, 13
                             PDL-BUFFER-POINTER MICRO-STACK-DATA-PUSH           ;14, 15
                             OA-REG-LOW OA-REG-HI                               ;16, 17
                             VMA VMA-START-READ VMA-START-WRITE VMA-WRITE-MAP T T T T ;20 - 27
                             MD T MD-START-WRITE MD-WRITE-MAP T T T T))))       ;30 - 37

(SETQ CC-A-DEST-DESC '((TYPE-FIELD A 1612 RAAMO)))

(SETQ CC-M-SOURCE-DESC '((COND M 3701
                               (((TYPE-FIELD M 3206 RAMMO))
                                ((SELECT-FIELD FSOURCE 3205
                                      (READ-I-ARG MICRO-STACK-PNTR-AND-DATA     ;0, 1
                                       PDL-BUFFER-POINTER PDL-BUFFER-INDEX
                                       T C-PDL-BUFFER-INDEX
                                       C-OPC-BUFFER Q-R
                                       VMA MEMORY-MAP-DATA                      ;10, 11
                                       MD LOCATION-COUNTER
                                       MICRO-STACK-PNTR-AND-DATA-POP T
                                       T T
                                       T T                                      ;20, 21
                                       T T
                                       C-PDL-BUFFER-POINTER-POP C-PDL-BUFFER-POINTER
                                       T T
                                       T T T T T T T T)))))))                   ;30 - 37

; :SCOPE causes the machine to execute whatever is in DEBUG-IR
; repeatedly at full speed.  Deposit in .IR just before doing this.

(DEFPROP SCOPE CC-SCOPE-LOOP CC-COLON-CMD)

(DEFUN CC-SCOPE-LOOP (ARG)
  (CC-NOOP-DEBUG-CLOCK) ;LOAD IR FROM DEBUG-IR JUST OUT OF SUPERSTITION
  (SPY-WRITE SPY-CLK 11)        ;SET RUN AND DEBUG
  (TERPRI)
  (PRINC '|--RUN--|)
  (TYI)                 ;WAIT FOR INPUT, EVEN IF MACHINE GETS ERROR
  (SPY-WRITE SPY-CLK 10)        ;CLEAR RUN, BUT LEAVE DEBUG SET
  (TERPRI)
  (SETQ CC-UPDATE-DISPLAY-FLAG T)
  NIL)

; General purpose looping construct which is faster than interpreted
; PROG.  We also try to avoid number consing.
; The function to be looped may have up to 3 args, we always pass all 3
; knowing that the subr calling sequence doesn't care if there are too many.

(DEFUN LOOP (FORM)
  (LET ((FCN (CAR FORM))
        (SUBR NIL)
        (ARG1 (EVAL (CADR FORM)))
        (ARG2 (EVAL (CADDR FORM)))
        (ARG3 (EVAL (CADDDR FORM))))
    (OR (SETQ SUBR (GET FCN 'SUBR))
        (ERROR '|not a SUBR| FCN))
    (COND ((= (EXAMINE (MAKNUM SUBR)) (+ 261600_18. (GETDDTSYM 'CFIX1)))
           (PROG NIL A (SUBRCALL FIXNUM SUBR ARG1 ARG2 ARG3) (GO A)))
          ((PROG NIL A (SUBRCALL T SUBR ARG1 ARG2 ARG3) (GO A))))))