; LOW-LEVEL CADR-MUNGING ROUTINES FOR CC -*-LISP-*- ;**NOTE** THIS FILE IS FORKED!! THIS VERSION RUNS ON CADR. LMCONS;CADRD RUNS ON PDP-10 ; NO STATISTICS COUNTER STUFF ;CC-CLEAR-CORE ARE NOT GOING TO WIN! ;CC-LOW-LEVEL-FLAG can have the following values: ; NIL -> Usual mode with CC. Assumes machine works and things can be saved ; and restored at will. ; T -> State of physical hardware is of interest (you are scoping it or something). ; Before waiting for input, prgm will "put back" all buffered state into ; physical hardware. ; VERY ->All buffering, saving and restoring is disabled. Used by diagnostics in ; LCADR;DIAGS >, etc. All operations talk ; "directly" to the hardware. Note that even examine operations can cause ; state to be destroyed. (until CC is fixed, it is worse that that. ; CC should be fixed to depend only on the passive state save in this case, ; with all further operations directly under control of the user). (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 (MACRO SPECINIT (X) (DO ((L (CDR X) (CDDR L))) ((NULL L)) (APPLY 'SPECIAL (NCONS (CAR L)))) `(SETQ . ,(CDR X))) (SPECINIT ;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) (DECLARE (SPECIAL CC-SAVED-OPCS CC-MICRO-STACK)) (SETQ CC-SAVED-OPCS #M (ARRAY NIL FIXNUM 8) #Q (MAKE-ARRAY NIL 'ART-Q '(8)) CC-MICRO-STACK #M (ARRAY NIL FIXNUM 32.) #Q (MAKE-ARRAY NIL 'ART-Q '(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 (SPECIAL SPY-ACCESS-PATH)) (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)))) (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)) (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) (DECLARE (SPECIAL BIGNUM-CONS-ARRAY)) (SETQ BIGNUM-CONS-ARRAY (MAKE-ARRAY NIL 'ART-Q '(3))) (DEFUN 32-BIT-WORD (HIGH LOW) (ASET (LDB 0020 LOW) BIGNUM-CONS-ARRAY 0) (ASET (LDB 0020 HIGH) BIGNUM-CONS-ARRAY 1) (ASET 0 BIGNUM-CONS-ARRAY 2) (SYS:ARRAY-TO-BIGNUM BIGNUM-CONS-ARRAY 1_20 0)) ;READ OBUS AS A FIXNUM (DEFUN CC-READ-OBUS () (32-BIT-WORD (SPY-READ SPY-OB-HIGH) (SPY-READ SPY-OB-LOW))) ;READ A-BUS AS A FIXNUM (DEFUN CC-READ-A-BUS () (32-BIT-WORD (SPY-READ SPY-A-HIGH) (SPY-READ SPY-A-LOW))) ;READ M-BUS AS A FIXNUM (DEFUN CC-READ-M-BUS () (32-BIT-WORD (SPY-READ SPY-M-HIGH) (SPY-READ SPY-M-LOW))) ;READ IR AS A BIGNUM (DEFUN CC-READ-IR () (ASET (SPY-READ SPY-IR-LOW) BIGNUM-CONS-ARRAY 0) (ASET (SPY-READ SPY-IR-MED) BIGNUM-CONS-ARRAY 1) (ASET (SPY-READ SPY-IR-HIGH) BIGNUM-CONS-ARRAY 2) (SYS:ARRAY-TO-BIGNUM BIGNUM-CONS-ARRAY 1_20 0)) ;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 () (32-BIT-WORD (SPY-READ SPY-FLAG-1) (LET ((F2 (SPY-READ SPY-FLAG-2))) (IF (BIT-TEST 100 (SPY-READ SPY-IR-LOW)) (LOGXOR 4 F2) ;Hardware reads JC-TRUE incorrectly F2)))) ;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 16 (DEFUN CC-WRITE-MD (NUM) (COND ((EQ SPY-ACCESS-PATH 'BUSINT) (COND ((NOT CC-UNIBUS-MAP-TO-MD-OK-FLAG) (DBG-WRITE-UNIBUS-MAP 16 177000) ;MR16 := VALID + WR-ENB ; + MAGIC HIGH 5 1'S TO ADDRESS MD (SETQ CC-UNIBUS-MAP-TO-MD-OK-FLAG T))) (DBG-WRITE 174000 (LOGLDB 0020 NUM)) ;WRITE LOW HALF-WORD (DBG-WRITE 174002 (LOGLDB 2020 NUM))) ;THEN HIGH HALF-WORD ((EQ SPY-ACCESS-PATH 'NO-BUSINT) (CC-WRITE-MD-SHIFTING NUM) NIL) (T (ERROR '|SPY-ACCESS-PATH NOT KNOWN ABOUT IN CC-WRITE-MD| SPY-ACCESS-PATH)))) (DEFUN CC-WRITE-MD-SHIFTING (NUM) (SETQ NUM (\ NUM (1+ 37777777777))) ;MAKE SURE ONLY 32 BITS (COND ((ZEROP (LOGLDB 3701 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 (ASH N 1))) ((ZEROP I)) (DECLARE (FIXNUM I N)) (COND ((ZEROP (LOGLDB 3601 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))))))) (DEFUN CC-READ-MD () (CC-READ-M-MEM CONS-M-SRC-MD)) (DEFUN CC-WRITE-VMA (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 CONS-FUNC-DEST-VMA)) (DEFUN CC-READ-VMA () (CC-READ-M-MEM CONS-M-SRC-VMA)) ;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 (NOT (ZEROP (LOGLDB 0401 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. (DEFUN CC-EXECUTE-LOAD-DEBUG-IR (LOW MIDDLE HIGH) (SPY-WRITE SPY-IR-LOW LOW) (SPY-WRITE SPY-IR-MED MIDDLE) (SPY-WRITE SPY-IR-HIGH HIGH)) (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)) (DEFUN CC-SCAN-M-MEM-FOR-BAD-PARITY (&OPTIONAL (PRINT-RUNNING-LOGAND-AND-LOGIOR NIL)) (DO ((ADR 0 (1+ ADR)) (AND 7777777777777777) (IOR 0) (ERRS 0)) ((= ADR 40) (COND ((NOT (ZEROP ERRS)) (FORMAT T "~%AND ~O IOR ~O" AND IOR)))) (MULTIPLE-VALUE-BIND (DATA ERROR-P) (CC-READ-M-MEM-AND-CHECK-PARITY ADR) (COND (ERROR-P (SETQ AND (LOGAND AND DATA) IOR (LOGIOR IOR DATA)) (SETQ ERRS (1+ ERRS)) (COND (PRINT-RUNNING-LOGAND-AND-LOGIOR (FORMAT T "~%AND ~O IOR ~O" AND IOR)))))))) (DEFUN CC-READ-M-MEM-AND-CHECK-PARITY (ADR &AUX DATA ERROR-P) (CC-EXECUTE CONS-IR-M-SRC ADR ;PUT IT ONTO THE OBUS CONS-IR-ALUF CONS-ALU-SETM CONS-IR-OB CONS-OB-ALU) (SETQ DATA (CC-READ-OBUS)) (CC-NOOP-CLOCK) (COND ((SETQ ERROR-P (NOT (ZEROP (LOGLDB 101 (SPY-READ SPY-FLAG-1))))) (FORMAT T "~%BAD M-MEM PARITY, ADR ~S" ADR))) (PROG NIL (RETURN DATA ERROR-P))) (DEFUN CC-SWEEP-M-MEM NIL (DOTIMES (ADR 32.) (CC-READ-M-MEM-AND-CHECK-PARITY ADR))) ;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)) (DEFUN CC-SCAN-A-MEM-FOR-BAD-PARITY (&OPTIONAL (PRINT-RUNNING-LOGAND-AND-LOGIOR NIL)) (DO ((ADR 0 (1+ ADR)) (AND 7777777777777777) (IOR 0) (ERRS 0)) ((= ADR 2000) (COND ((NOT (ZEROP ERRS)) (FORMAT T "~%AND ~O IOR ~O" AND IOR)))) (MULTIPLE-VALUE-BIND (DATA ERROR-P) (CC-READ-A-MEM-AND-CHECK-PARITY ADR) (COND (ERROR-P (SETQ AND (LOGAND AND DATA) IOR (LOGIOR IOR DATA)) (SETQ ERRS (1+ ERRS)) (COND (PRINT-RUNNING-LOGAND-AND-LOGIOR (FORMAT T "~%AND ~O IOR ~O" AND IOR)))))))) (DEFUN CC-READ-A-MEM-AND-CHECK-PARITY (ADR) (PROG (VAL ERROR-P) (CC-EXECUTE CONS-IR-A-SRC ADR ;PUT IT ONTO THE OBUS CONS-IR-ALUF CONS-ALU-SETA CONS-IR-OB CONS-OB-ALU) (SETQ VAL (CC-READ-OBUS)) (CC-NOOP-CLOCK) (SETQ ERROR-P (NOT (ZEROP (LOGLDB 0001 (SPY-READ SPY-FLAG-1))))) (COND (ERROR-P (FORMAT T " BAD A-MEM PARITY, ADR=~S " ADR))) (RETURN VAL ERROR-P))) ;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 (DEFUN CC-READ-C-MEM-WITH-PARITY (ADR) (LET ((TEM (CC-READ-C-MEM ADR))) (DPB (LDB 0501 (SPY-READ SPY-FLAG-2)) CONS-IR-PARITY-BIT TEM))) ;USED FOR SAVING & RESTORING ;OTHERWISE MICRO-DIAGNOSTICS WHICH RUN IN FOREIGN MACHINE BASH EACH OTHER (DEFUN CC-MULTIPLE-READ-C-MEM (LOCATION NUMBER-OF-WORDS) (DO ((LOCATION-COUNTER LOCATION (1+ LOCATION-COUNTER)) (C-DATA NIL (CONS (CC-READ-C-MEM LOCATION-COUNTER) C-DATA)) (STOP (+ LOCATION NUMBER-OF-WORDS))) ((>= LOCATION-COUNTER STOP) (NREVERSE C-DATA)))) (DEFUN CC-SCAN-C-MEM-FOR-BAD-PARITY (&OPTIONAL (PRINT-RUNNING-LOGAND-AND-LOGIOR NIL)) (DO ((ADR 0 (1+ ADR)) (AND 7777777777777777) (IOR 0) (ERRS 0)) ((= ADR 40000) (COND ((NOT (ZEROP ERRS)) (FORMAT T "~%AND ~O IOR ~O" AND IOR)))) (MULTIPLE-VALUE-BIND (DATA ERROR-P) (CC-READ-C-MEM-AND-CHECK-PARITY ADR) (COND (ERROR-P (SETQ AND (LOGAND AND DATA) IOR (LOGIOR IOR DATA)) (SETQ ERRS (1+ ERRS)) (COND (PRINT-RUNNING-LOGAND-AND-LOGIOR (FORMAT T "~%AND ~O IOR ~O" AND IOR)))))))) (DEFUN CC-READ-C-MEM-AND-CHECK-PARITY (ADR) (PROG (VAL ERROR-P) (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) (SETQ VAL (CC-READ-IR)) (CC-NOOP-CLOCK) (SETQ ERROR-P (NOT (ZEROP (LOGLDB 501 (SPY-READ SPY-FLAG-1))))) (COND (ERROR-P (FORMAT T " BAD C-MEM PARITY, ADR=~S " ADR))) (RETURN VAL ERROR-P))) ;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 2020 VAL) 1_20) (LOGLDB 0020 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)) ; RESTORE AFTER MULTIPLE SAVE. (see CC-MULTIPLE-READ-C-MEM) (DEFUN CC-MULTIPLE-WRITE-C-MEM (STARTING-LOCATION DATA-LIST) ;WILL WRITE UNTIL (DO ((LOCATION STARTING-LOCATION (1+ LOCATION)) ;NO MORE DATA. (C-DATA DATA-LIST (CDR C-DATA))) ((NULL C-DATA) DATA-LIST) (CC-WRITE-C-MEM LOCATION (CAR C-DATA)))) ;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 (32-BIT-WORD MIDDLE 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) (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 T) (DEFUN CC-WRITE-LC (VAL) (CC-WRITE-FUNC-DEST CONS-FUNC-DEST-LC VAL)) (DEFUN CC-READ-LC () (CC-READ-M-MEM CONS-M-SRC-LC)) (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)) (DEFUN CC-READ-PDL-BUFFER-POINTER () (CC-READ-M-MEM CONS-M-SRC-PDL-BUFFER-POINTER)) (DEFUN CC-WRITE-PDL-BUFFER-POINTER (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 CONS-FUNC-DEST-PDL-BUFFER-POINTER) VAL) ;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)) (DEFUN CC-SCAN-P-MEM-FOR-BAD-PARITY (&OPTIONAL (PRINT-RUNNING-LOGAND-AND-LOGIOR NIL)) (DO ((ADR 0 (1+ ADR)) (AND 7777777777777777) (IOR 0) (ERRS 0)) ((= ADR 2000) (COND ((NOT (ZEROP ERRS)) (FORMAT T "~%AND ~O IOR ~O" AND IOR)))) (MULTIPLE-VALUE-BIND (DATA ERROR-P) (CC-READ-P-MEM-AND-CHECK-PARITY ADR) (COND (ERROR-P (SETQ AND (LOGAND AND DATA) IOR (LOGIOR IOR DATA)) (SETQ ERRS (1+ ERRS)) (COND (PRINT-RUNNING-LOGAND-AND-LOGIOR (FORMAT T "~%AND ~O IOR ~O" AND IOR)))))))) (DEFUN CC-READ-P-MEM-AND-CHECK-PARITY (ADR &AUX DATA ERROR-P) (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) (SETQ DATA (CC-READ-OBUS)) (CC-NOOP-CLOCK) (COND ((SETQ ERROR-P (NOT (ZEROP (LOGLDB 201 (SPY-READ SPY-FLAG-1))))) (FORMAT T "~%BAD P-MEM PARITY, ADR ~S" ADR))) (PROG NIL (RETURN DATA ERROR-P))) ;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)) (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 (ARRAYCALL FIXNUM 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 ((COUNT 32. (1- COUNT))) ;UNTIL USP EQUALS THE DESIRED VALUE, ((OR (= CC-SAVED-MICRO-STACK-PTR (CC-READ-MICRO-STACK-PTR)) (< COUNT 0)) (COND ((< COUNT 0) (FORMAT T "~%USP FAILED TO REACH DESIRED VALUE AFTER 32 POPS")))) (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)) (SETQ IDX (LOGAND 37 (1+ IDX))) ;SIMULATE HARDWARE PUSH OPERATION (CC-WRITE-MD (ARRAYCALL FIXNUM 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)) (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)))))) (DEFUN CC-SCAN-D-MEM-FOR-BAD-PARITY (&OPTIONAL (PRINT-RUNNING-LOGAND-AND-LOGIOR NIL) (START-ADR 0)) (DO ((ADR START-ADR (1+ ADR)) (AND 7777777777777777) (IOR 0) (ERRS 0)) ((= ADR 4000) (COND ((NOT (ZEROP ERRS)) (FORMAT T "~%AND ~O IOR ~O" AND IOR)))) (MULTIPLE-VALUE-BIND (DATA ERROR-P) (CC-READ-D-MEM-AND-CHECK-PARITY ADR) (COND (ERROR-P (SETQ AND (LOGAND AND DATA) IOR (LOGIOR IOR DATA)) (SETQ ERRS (1+ ERRS)) (COND (PRINT-RUNNING-LOGAND-AND-LOGIOR (FORMAT T "~%AND ~O IOR ~O" AND IOR)))))))) (DEFUN CC-SWEEP-D-MEM NIL (DOTIMES (ADR 4000) (CC-READ-D-MEM-AND-CHECK-PARITY ADR))) (DEFUN CC-READ-D-MEM-AND-CHECK-PARITY (ADR) (LET ((PCS 0) (FLAG2 0) (RPN 0) ERRORP) (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))) (COND ((NOT (ZEROP (LOGLDB 401 (SPY-READ SPY-FLAG-1)))) (SETQ ERRORP T) (FORMAT T " BAD D-MEM PARITY ADR ~S" ADR))) (PROG NIL (RETURN (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)))) ERRORP)))) ;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 () (DBG-RESET) ;This frobs the reset directly over the debugging cable. (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)))) ;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 (OR (CC-HALTED-BY-PROG-OR-ERROR) (KBD-TYI-NO-HANG)) (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 () (LET ((FLAG1 (SPY-READ SPY-FLAG-1))) (OR (BIT-TEST 600 (LOGXOR 400 FLAG1)) (AND (BIT-TEST 1_10. FLAG1) ;ERR CONDITION PRESENT (BIT-TEST CC-MODE-REG 4))))) ;ERROR-STOP-ENABLE (DEFUN CC-HALTED-BY-PROG-OR-ERROR () (LET ((FLAG1 (SPY-READ SPY-FLAG-1))) (OR (BIT-TEST 200 FLAG1) (AND (BIT-TEST 1_10. FLAG1) ;ERR CONDITION PRESENT (BIT-TEST CC-MODE-REG 4))))) ;ERROR-STOP-ENABLE (COMMENT VIRTUAL MEMORY MAP MANIPULATION) ;READ OUT CONTENTS OF LEVEL 1 MAP (DEFUN CC-READ-LEVEL-1-MAP (ADR) (CC-WRITE-MD (#M LOGDPB-INTO-FIXNUM #Q DPB 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))) (DEFUN CC-READ-LEVEL-1-MAP-AND-CHECK-PARITY (ADR) (PROG NIL (CC-WRITE-MD (#M LOGDPB-INTO-FIXNUM #Q DPB 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) (RETURN (LOGLDB-FROM-FIXNUM CONS-MAP-LEVEL-1-BYTE (CC-READ-OBUS)) (PROGN (CC-NOOP-CLOCK) (COND ((ZEROP (LOGLDB 1501 (SPY-READ SPY-FLAG-1))) (FORMAT T "~%BAD LEVEL-1-MAP PARITY, ADR ~S" ADR) T)))))) (DEFUN CC-SCAN-LEVEL-1-MAP-FOR-BAD-PARITY (&AUX (ADR-AND 7777) (ADR-IOR 0) (DATA-AND 37) (DATA-IOR 0) DAT LOSEP (LOSES 0)) (DOTIMES (ADR 10000) (MULTIPLE-VALUE (DAT LOSEP) (CC-READ-LEVEL-1-MAP-AND-CHECK-PARITY ADR)) (COND (LOSEP (SETQ ADR-AND (LOGAND ADR-AND ADR) ADR-IOR (LOGIOR ADR-IOR ADR) DATA-AND (LOGAND DATA-AND DAT) DATA-IOR (LOGIOR DATA-IOR DAT) LOSES (1+ LOSES))))) (COND ((NOT (ZEROP LOSES)) (FORMAT T "~%~D loses: ADRAND=~O, ADRIOR=~O, DATAAND=~O, DATAIOR=~O" LOSES ADR-AND ADR-IOR DATA-AND DATA-IOR)))) ;WRITE INTO LEVEL 1 MAP (DEFUN CC-WRITE-LEVEL-1-MAP (ADR VAL) (CC-WRITE-MD (#M LOGDPB-INTO-FIXNUM #Q LOGDPB 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 (#M LOGDPB-INTO-FIXNUM #Q LOGDPB 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) #M (LOGLDB CONS-MAP-LEVEL-2-BYTE (CC-READ-OBUS)) #Q (LET ((OBUS (CC-READ-OBUS))) (DPB (LDB 2701 OBUS) 2701 (LDB 0027 OBUS)))) (DEFUN CC-READ-LEVEL-2-MAP-AND-CHECK-PARITY (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) (LET ((OBUS (CC-READ-OBUS))) (PROG1 (DPB (LDB 2701 OBUS) 2701 (LDB 0027 OBUS)) (PROGN (CC-NOOP-CLOCK) (COND ((ZEROP (LOGLDB 1601 (SPY-READ SPY-FLAG-1))) (FORMAT T "~%BAD LEVEL-2-MAP PARITY, ADR ~S" ADR) T)))))) (DEFUN CC-SCAN-LEVEL-2-MAP-FOR-BAD-PARITY (&AUX (ADR-AND 1777) (ADR-IOR 0) (DATA-AND 77777777) (DATA-IOR 0) DAT LOSEP (LOSES 0)) (DOTIMES (ADR 2000) (MULTIPLE-VALUE (DAT LOSEP) (CC-READ-LEVEL-2-MAP-AND-CHECK-PARITY ADR)) (COND (LOSEP (SETQ ADR-AND (LOGAND ADR-AND ADR) ADR-IOR (LOGIOR ADR-IOR ADR) DATA-AND (LOGAND DATA-AND DAT) DATA-IOR (LOGIOR DATA-IOR DAT) LOSES (1+ LOSES))))) (COND ((NOT (ZEROP LOSES)) (FORMAT T "~%~D loses: ADRAND=~O, ADRIOR=~O, DATAAND=~O, DATAIOR=~O" LOSES ADR-AND ADR-IOR DATA-AND DATA-IOR)))) ;find level 2 map entries which are non-zero but do not have access bit set. (DEFUN CC-SCAN-LEVEL-2-MAP-FOR-GARBAGE (&OPTIONAL RUNNING-PRINTOUT &AUX (ADR-AND 1777) (ADR-IOR 0) (DATA-AND 77777777) (DATA-IOR 0) DAT LOSEP (LOSES 0)) (DOTIMES (ADR 2000) (SETQ DAT (CC-READ-LEVEL-2-MAP-AND-CHECK-PARITY ADR)) (SETQ LOSEP (AND (NOT (ZEROP DAT)) (ZEROP (LOGAND DAT 1_23.)))) (COND (LOSEP (SETQ ADR-AND (LOGAND ADR-AND ADR) ADR-IOR (LOGIOR ADR-IOR ADR) DATA-AND (LOGAND DATA-AND DAT) DATA-IOR (LOGIOR DATA-IOR DAT) LOSES (1+ LOSES)) (IF RUNNING-PRINTOUT (FORMAT T "~%adr ~s, data ~s" ADR DAT))))) (COND ((NOT (ZEROP LOSES)) (FORMAT T "~%~D loses: ADRAND=~O, ADRIOR=~O, DATAAND=~O, DATAIOR=~O" LOSES ADR-AND ADR-IOR DATA-AND DATA-IOR)))) ;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) (CC-WRITE-MD #M (LOGDPB-INTO-FIXNUM VAL ;DATA TO WRITE CONS-MAP-LEVEL-2-BYTE CONS-VMA-WRITE-LEVEL-2-MAP-BIT) #Q (+ (LOGDPB (LDB 2701 VAL) 2701 (LOGLDB 0027 VAL)) 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) (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 #M (BIT-TEST 20 CC-ERROR-STATUS) #Q (NOT (ZEROP (LDB 0401 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) (STORE (ARRAYCALL FIXNUM 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))) ((AND (= ADR RAM1O) CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG) CC-SAVED-LEVEL-1-MAP-LOC-0) ((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 (EQ CC-LOW-LEVEL-FLAG 'VERY))) CC-SAVED-M-MEM-LOC-0) ;M=A ((AND (NOT (EQ CC-LOW-LEVEL-FLAG 'VERY)) (= ADR 1)) CC-SAVED-A-MEM-LOC-1) ((CC-READ-A-MEM ADR)))) ((< ADR RAUSE) (CC-SAVE-MICRO-STACK) (ARRAYCALL FIXNUM CC-MICRO-STACK (- ADR RAUSO))) ((AND (= (SETQ ADR (- ADR RAMMO)) 0) (NOT (EQ CC-LOW-LEVEL-FLAG 'VERY))) CC-SAVED-M-MEM-LOC-0) ((CC-READ-M-MEM ADR)))) ((< ADR RAFSE) ;FUNCTIONAL SOURCES (SETQ ADR (- ADR RAFSO)) (COND ((EQ CC-LOW-LEVEL-FLAG 'VERY) (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 (ARRAYCALL FIXNUM 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 ((EQ CC-LOW-LEVEL-FLAG 'VERY) (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 ((EQ CC-LOW-LEVEL-FLAG 'VERY) (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 ((EQ CC-LOW-LEVEL-FLAG 'VERY) (CC-READ-IR)) (T CC-SAVED-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 ((EQ CC-LOW-LEVEL-FLAG 'VERY) (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) (32-BIT-WORD (SPY-READ SPY-STAT-HIGH) (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))) (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) (ARRAYCALL FIXNUM 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))) (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)) ((AND (= ADR RAM1O) CC-LEVEL-1-MAP-LOC-0-CHANGED-FLAG) (SETQ CC-SAVED-LEVEL-1-MAP-LOC-0 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 (EQ CC-LOW-LEVEL-FLAG 'VERY))) (SETQ CC-SAVED-A-MEM-LOC-1 VAL)) ((CC-WRITE-A-MEM ADR VAL)))) ((< ADR RAUSE) (CC-SAVE-MICRO-STACK) (STORE (ARRAYCALL FIXNUM CC-MICRO-STACK (- ADR RAUSO)) VAL) (AND (EQ CC-LOW-LEVEL-FLAG 'VERY) (CC-RESTORE-MICRO-STACK))) (T (SETQ ADR (- ADR RAMMO)) (COND ((AND (= ADR 0) (NOT (EQ CC-LOW-LEVEL-FLAG 'VERY))) (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 (EQ CC-LOW-LEVEL-FLAG 'VERY)) (= ADR CONS-FUNC-DEST-MD)) (SETQ CC-SAVED-MD VAL)) ((AND (NOT (EQ CC-LOW-LEVEL-FLAG 'VERY)) (= ADR CONS-FUNC-DEST-VMA)) (SETQ CC-VMA-CHANGED-FLAG T CC-SAVED-VMA VAL)) ((AND (NOT (EQ CC-LOW-LEVEL-FLAG 'VERY)) (= ADR CONS-FUNC-DEST-PDL-BUFFER-INDEX)) (SETQ CC-PDL-BUFFER-INDEX-CHANGED-FLAG T CC-SAVED-PDL-BUFFER-INDEX VAL)) ((= ADR CONS-FUNC-DEST-MD) (CC-WRITE-MD 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 ((EQ CC-LOW-LEVEL-FLAG 'VERY) (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 (EQ CC-LOW-LEVEL-FLAG 'VERY) (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 (LOGDPB 1 0401 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)) (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)) (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 (IGNORE) (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 (IGNORE) (PRIN1 '(NIL OR T OR VERY)) (SETQ CC-LOW-LEVEL-FLAG (READ))) (DEFUN CC-PRINT-ERROR-STATUS (ERR-STS) (COND ((EQ CC-LOW-LEVEL-FLAG 'VERY) (PRIN1-THEN-SPACE 'VERY-LOW-LEVEL-MODE) (SETQ ERR-STS (CC-READ-STATUS))) ;GET LATEST WORD, IN LOW-LEVEL MODE (CC-LOW-LEVEL-FLAG (PRIN1-THEN-SPACE '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 (SETQ ERR-STS (CC-READ-STATUS)) ;GET LATEST WORD, IN LOW-LEVEL MODE --LOSES-- ;NOTE THAT THE BUS DRIVER WHICH DRIVES THE LOW ORDER 8 BITS IS AN INVERTING BUS FRYER. ;This starts with bit 0 and goes up. 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 T)) (DEFPROP CHMODE CC-EDIT-MODE CC-COLON-CMD) (DEFUN CC-EDIT-MODE (IGNORE) (SPY-WRITE SPY-MODE (SETQ CC-MODE-REG (CC-TYPE-IN CC-MODE-REG-DESC CC-MODE-REG T)))) (DEFUN CC-SET-SPEED (SPD) (SPY-WRITE SPY-MODE (SETQ CC-MODE-REG (DPB SPD 0002 CC-MODE-REG)))) (DEFPROP RESTORE CC-RESTORE-CMD CC-COLON-CMD) (DEFUN CC-RESTORE-CMD (IGNORE) (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