;*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