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


;;; TESTING OF INSTRUCTION-MODIFICATON PATHS. The IMOD is an additional path
;;; to the micro-IR which is a fuctional destination.  It IORs the data (from the
;;; MFO bus) into the micro-instruction coming from the CRAM (the "current" one) and
;;; loads the result into the micro-instruction-register (IR).  Writing to the
;;; destination IMOD thus really writes a new current micro-instruction.

;;; There are two destinations, IMOD-LOW and IMOD-HIGH for modifying the
;;; whole 64 bit IR. The write can be checked by writing  data into a
;;; location of the CRAM, pointing to it with the PC, and then writing to the IMOD
;;; destination with a zero.  Reading back the IR should contain the data.
;;; Alternately, one could write a zero into the CRAM, point to it with the PC,
;;; and then write to the IMOD with some data (from some source - say, the MD).

;;; CAUTION!  This modifies location ADDR (default 0) of the CRAM, after storing.
;;; It restores it at the end, but it might attract dragons...

(DEFUN TEST-IMOD-DATA-PATH () "IMOD LOGIC"
       (format LAMBDA-DIAG-STREAM "~%TESTING IMOD LOGIC")
  (TEST-IMOD "IMOD-LOW IREG-BITS ARE 1'S AND MFO-BITS ARE 0'S"
	     LAM-FUNC-DEST-IMOD-LOW 0 32. 1 0)
  (TEST-IMOD "IMOD-LOW IREG-BITS ARE 0'S AND MFO-BITS ARE 1'S"
	     LAM-FUNC-DEST-IMOD-LOW 0 32. 0 1)
  (TEST-IMOD "IMOD-HIGH IREG-BITS ARE 1'S AND MFO-BITS ARE 0'S"
	     LAM-FUNC-DEST-IMOD-HIGH 32. 28. 1 0)
  (TEST-IMOD "IMOD-HIGH IREG-BITS ARE 0'S AND MFO-BITS ARE 1'S"
	     LAM-FUNC-DEST-IMOD-HIGH 32. 28. 0 1))

;;; Float a 1 bit through and complain about wrong 1's or 0's
;;; Conceivably could float 0's also.

(DEFUN TEST-IMOD (MESSAGE DEST FIRST-IR-BIT N-BITS IR-BIT MFO-BIT &OPTIONAL (ADDR 0))
  (FORMAT LAMBDA-DIAG-STREAM "~% ....~A" MESSAGE)
  (DO ((OLD-CRAM (READ-CRAM 0))
       (N N-BITS (1- N))
       (IR-BIT (ASH IR-BIT FIRST-IR-BIT) (ASH IR-BIT 1))
       (MFO-BIT MFO-BIT (ASH MFO-BIT 1))
       (BITNO 0 (1+ BITNO))
       (GOOD) (BAD)
       (SUSPECT-BIT-LIST NIL))
      ((OR (ZEROP N) (AND (send terminal-io :tyi-no-hang)
			  (OR (FORMAT LAMBDA-DIAG-STREAM "...ABORTING TEST") T)))
       (WRITE-CRAM ADDR OLD-CRAM))
    (WRITE-CRAM ADDR IR-BIT)
    (WRITE-PC ADDR 0)
    (WRITE-SPY-REG-AND-CHECK MFO-BIT)
    (LAM-EXECUTE (UINST-CLOCK-PLUS-UINST-CLOCK-LOW)
	LAM-IR-OP         LAM-OP-ALU
	LAM-IR-M-SRC      LAM-M-SRC-SPY-REG
	LAM-IR-OB         LAM-OB-ALU
	LAM-IR-ALUF       LAM-ALU-SETM
	LAM-IR-FUNC-DEST  DEST)
    ;; IR should now have OR of MFO-BIT and IR-BIT
    (SETQ GOOD (LOGIOR IR-BIT (ASH MFO-BIT FIRST-IR-BIT))
	  BAD (READ-IREG))
    (COND ((NOT (= GOOD BAD))
	   (FORMAT T "~&~4T~A failure: IR-BIT is ~O, MFO-BIT is ~O " MESSAGE IR-BIT MFO-BIT)
	   (COND ((ZEROP IR-BIT)
		  (FORMAT T "MFO-path has 1 in bit ~D, CRAM-path" BITNO)
		  (IF (NOT (ZEROP FIRST-IR-BIT))
		      (FORMAT T " (= ~D)" (+ BITNO FIRST-IR-BIT))))
		 (T (FORMAT T "CRAM-path has 1 in bit ~D, MFO-path" (+ BITNO FIRST-IR-BIT))))
	   (IF (ZEROP BAD)
	       (SEND TERMINAL-IO ':LINE-OUT " has zero.  IR got zero")
	     (PRINT-BIT-LIST (WRONG-BITS-LIST 0 BAD 48.) NIL
			     "has zero.  1-bits in IR:"))))))

;;; TWIDDLE in the next two functions determines whether they write a 0 in the MFO-path
;;; or in the CRAM-path, with the data entering the other path.  Twiddle defaults to NIL,
;;; checking the latter.  Put a extra T at the end to check the MFO-path 0, data in CRAM-path

(defun write-imod-high-and-check (data &OPTIONAL (twiddle nil) &AUX old-cram this that ireg)
  (setq old-cram (read-cram 0))
  (if (null twiddle)
      (setq this 0 that data)
    (setq this data that 0))
  (write-cram 0 this)
  (write-pc 0 0)
  (WRITE-SPY-REG-AND-CHECK that)
  (LAM-EXECUTE (UINST-CLOCK-PLUS-UINST-CLOCK-LOW)
        LAM-IR-OP         LAM-OP-ALU
	LAM-IR-M-SRC      LAM-M-SRC-SPY-REG
	LAM-IR-OB         LAM-OB-ALU
	LAM-IR-ALUF       LAM-ALU-SETM
	LAM-IR-FUNC-DEST  LAM-FUNC-DEST-IMOD-HIGH)
  (cond ((not (= (logand 1777777777 data)
		 (setq ireg (logand 1777777777 (ash (read-ireg) -32.)))))
	 (format T "IREG read ~O~%" ireg)
	 T NIL))
  (write-cram 0 old-cram))

(defun write-imod-low-and-check (data &OPTIONAL (twiddle nil) &AUX old-cram this that ireg)
  (setq old-cram (read-cram 0))
  (if (null twiddle)
      (setq this 0 that data)
    (setq this data that 0))
  (write-cram 0 this)
  (write-pc 0 0)
  (WRITE-SPY-REG-AND-CHECK that)
  (LAM-EXECUTE (UINST-CLOCK-PLUS-UINST-CLOCK-LOW)
	LAM-IR-OP         LAM-OP-ALU
	LAM-IR-M-SRC      LAM-M-SRC-SPY-REG
	LAM-IR-OB         LAM-OB-ALU
	LAM-IR-ALUF       LAM-ALU-SETM
	LAM-IR-FUNC-DEST  LAM-FUNC-DEST-IMOD-LOW)
  (cond ((not (= (logand 37777777777 data)
		 (setq ireg (logand 37777777777 (read-ireg)))))
	 (format T "IREG read ~O~%" ireg)
	 T NIL))
  (write-cram 0 old-cram))