;;; -*- Mode:LISP; Package:LAMBDA; Base:8; Readtable:ZL -*-
;;;
;;; (c) Copyright 1984,1985,1986 - Lisp Machine, Inc.
;;;

;;this file (which may be integrated with some other stuff later) does parity
;;checking of the memories which need us to write good parity

(defconst default-parity-enable-list '(cm dp rg mi))
(defconst warn-about-parity-version t)

(defun lam-parity-off nil
  (setq check-parity nil
	lam-running-check-parity nil))

(defun enable-parity (&optional (parity-enable-list default-parity-enable-list))
  (write-parity-enable-vector parity-enable-list))

(defun write-parity-enable-vector (parity-enable-list)
  (dolist (element parity-enable-list)
    (selectq element
      (TREG (change-pmr-and-check '(enable-TREG-parity 1)))
      (MID (change-pmr-and-check '(enable-MID-parity 1)))
      (DP (change-pmr-and-check '(enable-DP-parity 1)))
      (CM (change-pmr-and-check '(enable-CM-parity 1)))
      (MI (change-pmr-and-check '(enable-MI-parity 1)))
      (TRAM (change-pmr-and-check '(enable-TREG-parity 1)))
      (RG (change-pmr-and-check '(enable-TREG-parity 1
				  enable-mid-parity 1)))
      (OTHERWISE
       (FERROR T "Invalid codeword for ENABLE-PARITY"))
      )))

(COMMENT
  (DEFUN SET-LAMBDA-PARITY (&OPTIONAL PARITY-LIST)
  (COND ((NULL PARITY-LIST)
	 (TV:CHOOSE-VARIABLE-VALUES
	   '((DP-PAR "DP Parity" :ASSOC (("ENABLE" . 'DP)
					 ("DISABLE" . NIL)))
	     )
	   ':LABEL " LAMBDA PARITY ENABLES ")
	 ())
  
  (SETQ DEFAULT-PARITY-LIST PARITY-LIST))))



(defun disable-parity ()
  (change-pmr-and-check '(parity-enable-field 0)))

(DEFCONST PARITY-WORD-TREG 3401)
(DEFCONST PARITY-WORD-MID 3301)
(DEFCONST PARITY-WORD-IREG 1004)


(defun check-treg-parity (&optional (data 0))
  (dotimes (error-mask 17)
    (write-treg-via-tram (COMPUTE-PARITY-32 data error-mask))
    (LET ((PARITY (READ-PARITY)))
      (cond ((and (= error-mask 0)
		  (= 1 (ldb PARITY-WORD-TREG PARITY)))
	     (format t "~% parity error when good parity written"))
	    ((and (> 0 error-mask)
		  (= 0 (ldb PARITY-WORD-TREG PARITY)))
	     (format t "~% no parity error when error mask = ~o" error-mask))))))

(defun check-ireg-parity (&optional (data 0))
  (NOOP-UINST-CLOCKS)
  (dotimes (error-mask 17)
    (write-ireg (COMPUTE-PARITY-64 data error-mask))
    (LET ((PARITY (READ-PARITY)))
      (cond ((and (= error-mask 0)
		  (NOT (= 0 (ldb PARITY-WORD-IREG PARITY))))
	     (format t "~% parity error when good parity written"))
	    ((and (NOT (= 0 error-mask))
		  (= 0 (ldb PARITY-WORD-IREG PARITY)))
	     (format t "~% no parity error when error mask = ~o" error-mask))))))
      

(DEFMACRO PARSE-PARITY-BITS (PARITY-VECTOR BYTE-SPEC FORMAT NO-ERROR-MASK)
  "test the bits of parity-vector specified by byte-spec to see if any of them
 are hi (or low depending on the value of hi-or-lo-p).  call format on the format
 string and the extracted byte if test is successful"
  `(LET ((BYTE (LDB ,BYTE-SPEC ,PARITY-VECTOR)))
     (IF (NOT (ZEROP (LOGXOR BYTE ,NO-ERROR-MASK)))
	 (FORMAT T ,FORMAT BYTE)
       )))


(DEFUN PRINT-PARITY (&OPTIONAL
		     (VECTOR (READ-PARITY))
		     (PMR (READ-PMR)))
  
  (FORMAT T "~%............................................................~
  ~%       PARITY VECTOR = ~O~%~
              .............................................................~
  ~%" VECTOR)
  
  (FORMAT T "~%DP parity ~[disabled~;enabled~]"
	  (ldb enable-dp-parity pmr))
  (PARSE-PARITY-BITS VECTOR 3101 "~%   DP parity error ~35,5t ~o~%" 0)
  (PARSE-PARITY-BITS VECTOR 0004 "   ____A parity error ~35,5t ~o~%" 0)
  (PARSE-PARITY-BITS VECTOR 0404 "   ____M parity error ~35,5t ~o~%" 0)
  
  (FORMAT T "~%CM parity ~[disabled~;enabled~]"
	  (ldb enable-cm-parity pmr))
  (PARSE-PARITY-BITS VECTOR 3201 "~%   CM parity error ~35,5t ~o~%" 0)
  (PARSE-PARITY-BITS VECTOR 1004 "   ___IREG parity error ~35,5t ~o~%" 0)
  (PARSE-PARITY-BITS VECTOR 1401 "   ___real stack parity error L ~35,5t ~o~%" 1)
  (PARSE-PARITY-BITS VECTOR 1503 "   ___micro-stack parity error ~35,5t ~o~%" 0)
  
  (FORMAT T "~%MI parity ~[disabled~;enabled~]"
	  (ldb enable-mi-parity pmr))
  (PARSE-PARITY-BITS VECTOR 3001 "~%   MI parity error ~35,5t ~o~%" 0)
  (PARSE-PARITY-BITS VECTOR 2001
		     "   ___valid L1 map parity error last L ~35,5t ~o~%" 1)
  (PARSE-PARITY-BITS VECTOR 2101 "   ___valid L2 map control parity error ~
  							last L ~35,5t ~o~%" 1)
  (PARSE-PARITY-BITS VECTOR 2201 "   ___valid L2 map phys page parity error ~
							last L ~35,5t ~o~%" 1)
  (PARSE-PARITY-BITS VECTOR 2301 "   ___any csm parity error L ~35,5t ~o~%" 1)
  (PARSE-PARITY-BITS VECTOR 2401 "   ___valid cache parity error last L ~35,5t ~o~%" 1)
  (COND (( 7 (LDB 2003 VECTOR))
	 (PARSE-PARITY-BITS VECTOR 2501
			    "   ___map parity valid last ~35,5T ~O~%" 0)))
  (PARSE-PARITY-BITS VECTOR 2601
		     "   ___lambda address parity error last ~35,5t ~o~%" 0)
  (PARSE-PARITY-BITS VECTOR 2701 "   ___NU data parity error last ~35,5t ~o~%" 0)
  
  (FORMAT T "~%MID parity ~[disabled~;enabled~]"
	  (ldb enable-mid-parity pmr))
  (PARSE-PARITY-BITS VECTOR 3301 "   ___valid MID parity error ~35,5t ~o~%" 0)
  (FORMAT T "~%TREG parity ~[disabled~;enabled~]"
	  (ldb enable-treg-parity pmr))
  (PARSE-PARITY-BITS VECTOR 3401 "   ___any TREG parity error ~35,5t ~o~%" 1)
  (FORMAT T "~%............................................................")
  )


  
(defun read-treg-parity ()
 (ferror nil "can't work")
 (comment
  (ldb treg-parity-error-L-bit (read-parity))
  ))



(DEFUN SCAN-CRAM-FOR-BAD-PARITY ()
  (SCAN-CRAM-PARITY 0 40000))

(DEFUN SCAN-CRAM-PARITY (&OPTIONAL (START (READ-PC)) (RANGE 64.))
  (WRITE-PC START)
  (DO* ((ADR START (1+ ADR))
	(DATA (READ-CRAM NIL) (READ-CRAM NIL))
	(END (+ START RANGE)))
       ((>= ADR END))
    (IF ( DATA (COMPUTE-PARITY-64 DATA))
	(FORMAT T "~% BAD PARITY AT CRAM ~O: GOT ~O, EXPECTED ~O"
		ADR DATA (COMPUTE-PARITY-64 DATA)))
    (LAM-EXECUTE-UINST-CLOCK-PLUS-UINST-CLOCK-LOW IZERO-GOOD-PARITY T)))