;;; -*- MODE:LISP; PACKAGE:CADR -*-

;; This stuff is to help locating errors relative to IC chips.

(DEFUN (PCHECK CC-COLON-CMD) (IGNORE)
  (LET ((QUAN (CC-REGISTER-EXAMINE CC-LAST-OPEN-REGISTER)))
    (SELECTQ (CC-FIND-REG-ADR-RANGE CC-LAST-OPEN-REGISTER)
      (C (SETQ QUAN (CC-READ-C-MEM-WITH-PARITY (- CC-LAST-OPEN-REGISTER RACMO)))
	 (FORMAT T "~%=~O  -> " QUAN)
	 (CC-PRINT-BITS QUAN)
	 (LET ((P0 (PARITY (LDB (BITS 12.  0.) QUAN)))
	       (P1 (PARITY (LDB (BITS 12. 12.) QUAN)))
	       (P2 (PARITY (LDB (BITS 12. 24.) QUAN)))
	       (P3 (PARITY (LDB (BITS 12. 36.) QUAN)))
	       (P (PARITY QUAN)))
	   (LET ((P3SIG (LOGIC-LEVEL (NOT (ZEROP P3))))
		 (P2SIG (LOGIC-LEVEL (NOT (ZEROP P2))))
		 (P1SIG (LOGIC-LEVEL (NOT (ZEROP P1))))
		 (P0SIG (LOGIC-LEVEL (NOT (ZEROP P0))))
		 (PSIG (LOGIC-LEVEL (NOT (ZEROP P)))))
	     (FORMAT T "
IPAR3[3E02(11)]=~S
IPAR2[3E21(11)]=~S
IPAR1[3F24(11)]=~S 
IPAR0[3E04(11)]=~S
IPARITY[3F22(11)]=~S" P3SIG P2SIG P1SIG P0SIG PSIG))))
      )))

(DEFUN BITS (NBITS OVER)
  "Make a byte pointer" 
  (DPB OVER 0609 NBITS))

(DEFUN LOGIC-LEVEL (BOOL)
  (COND ((NULL BOOL) 'LOW)
	(T 'HIGH)))

(DEFUN PARITY (NUM)
  (DO ((PARITY 0)
       (N NUM (ASH N -1)))
      ((<= N 0) PARITY)
    (SETQ PARITY (LOGXOR (LOGAND 1 N) PARITY))))

(DECLARE (SPECIAL CADR:CC-C-MEM-BIT-TO-PACKAGE-MAP))

(SETQ CADR:CC-C-MEM-BIT-TO-PACKAGE-MAP '(

  (0 1F21 1F22 1f23 1F24 1F25 1E21 1E22 1E23 1E24 1E25 1D21 1D22 2F11 2F12 2F13
     2F14 2F15 2E11 2E12 2E13 2E14 2E15 2D11 2D12 1C24 1C25 1B21 1B22 1B23 1B24
     1B25 1A21 1A22 1A23 1A24 1A25 2C13 2C14 2C15 2B11 2B12 2B13 2B14 2B15 2A11
     2A12 2A13 2A14 2A15)

  (1 1F26 1F27 1F28 1F29 1F30 1E26 1E27 1E28 1E29 1E30 1D26 1D27 2F16 2F17 2F18
     2F19 2F20 2E16 2E17 2E18 2E19 2E20 2D16 2D17 1C29 1C30 1B26 1B27 1B28 1B29
     1B30 1A26 1A27 1A28 1A29 1A30 2C18 2C19 2C20 2B16 2B17 2B18 2B19 2B20 2A16
     2A17 2A18 2A19 2A20)

  (2 2F01 2F02 2F03 2F04 2F05 2E01 2E02 2E03 2E04 2E05 2D01 2D02 2F21 2F22 2F23
     2F24 2F25 2E21 2E22 2E23 2E24 2E25 2D21 2D22 2C04 2C05 2B01 2B02 2B03 2B04 
     2B05 2A01 2A02 2A03 2A04 2A05 2C23 2C24 2C25 2B21 2B22 2B23 2B24 2B25 2A21
     2A22 2A23 2A24 2A25)

  (3 2F06 2F07 2F08 2F09 2F10 2E06 2E07 2E08 2E09 2E10 2D06 2D07 2F26 2F27 2F28
     2F29 2F30 2E26 2E27 2E28 2E29 2E30 2D26 2D27 2C09 2C10 2B06 2B07 2B08 2B09
     2B10 2A06 2A07 2A08 2A09 2A10 2C28 2C29 2C30 2B26 2B27 2B28 2B29 2B30 2A26
     2A27 2A28 2A29 2A30)
   ))

(DEFUN CC-LOOKUP-C-MEM-BIT-PACKAGE (BANK BIT)
  (NTH BIT (CDR (ASSQ BANK CC-C-MEM-BIT-TO-PACKAGE-MAP))))