;;;;;-*- Mode:LISP; Package:LAMBDA; Base:8; Readtable:ZL -*- ;;; ;;; (c) Copyright 1984,1985,1986 - Lisp Machine, Inc. ;;; ;;this file contains diagnostics for the masker,shifter. it may be combined ;;with some other file later. ;;if the m source is all ones and the a source is all zeroes, then the output should ;;be identical to the contents of the masker prom ;;first we need a function to perform a byte operation on given a-mem and m-mem locations (DEFUN BYTE-DEPOSIT (A-MEM-LOC M-MEM-LOC BITS-OVER BITS-WIDE) (LAM-EXECUTE (READ) LAM-IR-OP LAM-OP-BYTE LAM-IR-A-SRC A-MEM-LOC LAM-IR-M-SRC M-MEM-LOC LAM-IR-OB LAM-OB-MSK LAM-IR-BYTE-FUNC LAM-BYTE-FUNC-SELECTIVE-DEPOSIT ;masked bits of m replace a LAM-IR-BYTL-1 (1- BITS-WIDE) LAM-IR-MROT BITS-OVER) (READ-MFO)) (DEFUN BYTE-DPB (A-MEM-LOC M-MEM-LOC BITS-OVER BITS-WIDE) (LAM-EXECUTE (READ) LAM-IR-OP LAM-OP-BYTE LAM-IR-A-SRC A-MEM-LOC LAM-IR-M-SRC M-MEM-LOC LAM-IR-OB LAM-OB-MSK LAM-IR-BYTE-FUNC LAM-BYTE-FUNC-DPB LAM-IR-BYTL-1 (1- BITS-WIDE) LAM-IR-MROT BITS-OVER) (READ-MFO)) (DEFUN BYTE-LDB (A-MEM-LOC M-MEM-LOC BITS-OVER BITS-WIDE) (LAM-EXECUTE (READ) LAM-IR-OP LAM-OP-BYTE LAM-IR-A-SRC A-MEM-LOC LAM-IR-M-SRC M-MEM-LOC LAM-IR-OB LAM-OB-MSK LAM-IR-BYTE-FUNC LAM-BYTE-FUNC-LDB LAM-IR-BYTL-1 (1- BITS-WIDE) LAM-IR-MROT (- 40 BITS-OVER)) (READ-MFO)) ;; a somewhat simple-minded algorithm is to make the masker select all M ;; and make sure no bits from A get OR'ed in, then select all A and make sure ;; no bits from M get OR'ed in.(for constant zeroes and ones) (DEFUN TEST-MASKER-SIMPLE () (WRITE-A-MEM 1 37777777777) (WRITE-M-MEM 2 0) (LET ((OUTPUT (BYTE-DEPOSIT 1 2 0 40))) (COND ((= OUTPUT 0)) (T (FORMAT T "~%bits not zero from m through masker") (PRINT-BITS OUTPUT)))) ; (LET ((OUTPUT (LOGXOR 37777777777 (BYTE-DEPOSIT 1 2 0 0)))) ; (COND ((= OUTPUT 0)) ; (T (FORMAT T "~%bits not one from a through masker") ; (PRINT-BITS OUTPUT)))) (WRITE-M-MEM 2 37777777777) (WRITE-A-MEM 1 0) (LET ((OUTPUT (LOGXOR 37777777777 (BYTE-DEPOSIT 1 2 0 40)))) (COND ((= OUTPUT 0)) (T (FORMAT T "~%bits not one from m through masker") (PRINT-BITS OUTPUT)))) ; (LET ((OUTPUT (BYTE-DEPOSIT 1 2 0 0))) ; (COND ((= OUTPUT 0)) ; (T (FORMAT T "~%bits not zero from a through masker") ; (PRINT-BITS OUTPUT)))) ) ;;this is the first draft of the prom tester, gives little help ;; for the moment, we use it taking only the low 8 bits, as only those proms are in (DEFUN TEST-MASKER-PROM (VERBOSE-P) (WRITE-A-MEM 1 0) (WRITE-M-MEM 2 37777777777) (DO* ((MASK 0) (OUTPUT 0) ;(BITS-NOT-ONE) ;(BITS-NOT-ZERO) (ADDRESS 0 (1+ ADDRESS)) (BITS-OVER 0 (LDB 0005 ADDRESS)) (BITS-WIDE 1 (1+ (LDB 0505 ADDRESS)))) (( ADDRESS 1024.)) (SETQ MASK (LOGAND 37777777777 (LOGXOR (ASH 37777777777 (+ BITS-OVER BITS-WIDE)) (ASH 37777777777 BITS-OVER)))) (COND ((AND VERBOSE-P ( MASK (SETQ OUTPUT (BYTE-DEPOSIT 1 2 BITS-OVER BITS-WIDE)))) (FORMAT T "~%masker prom fails to read back properly, got ~o , expecting ~o" OUTPUT MASK))))) ;;this is the partially hacked cc version of a shifter test. ;; dexter: this function has already been converted see test-shifter in wr-rd.lisp (comment (defun CC-TEST-SHIFTER () ;;"Shifter" ;; "Algorithm is to shift floating ones and zeros with all possible shifts. ;;Record bits that failed at shifter input, at shifter output, between ;;the two shifter stages, and also which shift counts fail. ;;Prom problems will show up as failure ;;of particular bits at the shifter output, you can try replacing the ;;offending prom. To reduce randomness we bring 0 in ;;on the A-source. This is now written so that it works whether or ;;not proms are present, it addresses 0 in the right mask which is all 1's ;;and 37 in the left mask which is also all 1's." (CC-WRITE-A-MEM 2 0) (DO ((INPUT-ERRONEOUS-ZEROS NIL) (MIDDLE-ERRONEOUS-ZEROS NIL) (OUTPUT-ERRONEOUS-ZEROS NIL) (INPUT-ERRONEOUS-ONES NIL) (MIDDLE-ERRONEOUS-ONES NIL) (OUTPUT-ERRONEOUS-ONES NIL) (ERRONEOUS-SHIFT-COUNTS NIL) (SUSPECT-BIT-LIST NIL) (BITNO 0 (1+ BITNO))) ;THE FLOATING BIT ((= BITNO 32.) (TERPRI) (PRINT-BIT-LIST "Shift counts with erroneous bits: " ERRONEOUS-SHIFT-COUNTS) (PRINT-BIT-LIST "M bits with erroneous zeros: " INPUT-ERRONEOUS-ZEROS) (PRINT-BIT-LIST "SA bits with erroneous zeros: " MIDDLE-ERRONEOUS-ZEROS) (PRINT-BIT-LIST "R bits with erroneous zeros: " OUTPUT-ERRONEOUS-ZEROS) (PRINT-BIT-LIST "M bits with erroneous ones: " INPUT-ERRONEOUS-ONES) (PRINT-BIT-LIST "SA bits with erroneous ones: " MIDDLE-ERRONEOUS-ONES) (PRINT-BIT-LIST "R bits with erroneous ones: " OUTPUT-ERRONEOUS-ONES)) (DO ((BACKGROUND 37777777777 0)) ;FIRST FLOATING ZEROS, THEN FLOATING ONES (()) (DECLARE (FIXNUM BACKGROUND)) (WRITE-M-MEM 3 (setq good (LOGXOR BACKGROUND (ASH 1 BITNO)))) ;SHIFTER INPUT (do ((shift-count (byte-ldb 2 3 bitno 1) (CC-EXECUTE CONS-IR-OP CONS-OP-BYTE ;INST TO SHIFT BY 0 INTO IR CONS-IR-A-SRC 2 CONS-IR-M-SRC CONS-M-SRC-MD CONS-IR-BYTL-1 37 CONS-IR-MROT 0 CONS-IR-BYTE-FUNC CONS-BYTE-FUNC-LDB) ;LDB = SR, NOT MR (DO ((MROT 0 (1+ MROT)) (BAD) (CORRECT-IR (SPY-READ SPY-IR-LOW) (1+ CORRECT-IR)) (GOOD (LOGXOR BACKGROUND (ASH 1 BITNO)) ;EXPECTED OUTPUT (ROT32 GOOD 1))) ((= MROT 32.)) (DECLARE (FIXNUM MROT GOOD BAD)) (COND ((NOT (= (SETQ BAD (CC-READ-OBUS)) GOOD)) ;HA! AN ERROR, STASH STUFF AWAY (IF-FOR-LISPM (COND (CC-DIAG-TRACE (FORMAT T "~&Rot: ~O, Bit: ~O, Good: ~O, Bad: ~O, Reread: ~O" MROT (ASH 1 BITNO) GOOD BAD (CC-READ-OBUS))) )) (ADD2L MROT ERRONEOUS-SHIFT-COUNTS) (DO ((J 0 (1+ J)) ;BITS OF OUTPUT (GOOD GOOD (ASH GOOD -1)) (BAD BAD (ASH BAD -1))) ((= J 32.)) (OR (= (LOGAND 1 GOOD) (LOGAND 1 BAD)) (COND ((ZEROP (LOGAND 1 GOOD)) ;AN ERRONEOUS ONE (ADD2L J OUTPUT-ERRONEOUS-ONES) (ADD2L (LOGAND (- J MROT) 37) INPUT-ERRONEOUS-ONES) (ADD2L (LOGAND (- J (LOGAND MROT -4)) 37) MIDDLE-ERRONEOUS-ONES)) (T (ADD2L J OUTPUT-ERRONEOUS-ZEROS) (ADD2L (LOGAND (- J MROT) 37) INPUT-ERRONEOUS-ZEROS) (ADD2L (LOGAND (- J (LOGAND MROT -4)) 37) MIDDLE-ERRONEOUS-ZEROS) )))))) (SPY-WRITE SPY-IR-LOW (1+ (SPY-READ SPY-IR-LOW))) ;INCREMENT MROT FIELD (CC-NOOP-DEBUG-CLOCK) (LET ((ACTUAL-IR (SPY-READ SPY-IR-LOW))) ;Did the IR get written correctly? (COND ((NOT (= (1+ CORRECT-IR) ACTUAL-IR)) (FORMAT T "~&Debug IR - Correct: ~O, Read back: ~O" (1+ CORRECT-IR) ACTUAL-IR))))) (AND (ZEROP BACKGROUND) (RETURN NIL)))))))))