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


;;this file contains the diagnostics for the pdl index, pdl pointer, and the m memory
;;as addressed by them

(DEFUN WRITE-INTERRUPT-CONTROL (NUM)		;write miscellaneous
  (WRITE-SPY-REG-AND-CHECK NUM)  				;register called the
  (LAM-EXECUTE (WRITE)				;interrupt control register which contains
	       LAM-IR-OP LAM-OP-ALU		;the bit controlling the high pdl address
	       LAM-IR-OB LAM-OB-ALU		;(bit 2)
	       LAM-IR-M-SRC LAM-M-SRC-SPY-REG
	       LAM-IR-ALUF LAM-ALU-SETM
	       LAM-IR-FUNC-DEST LAM-FUNC-DEST-INT-CONTROL))


(DEFUN READ-PI ()				;read pdl index register
  (LAM-EXECUTE (READ)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-M-SRC LAM-M-SRC-PI
	       LAM-IR-ALUF LAM-ALU-SETM)
  (READ-MFO))

(DEFUN WRITE-PI (NUM &OPTIONAL MAKE-SURE &AUX TEMP)		;write pdl index register
  (WRITE-SPY-REG-AND-CHECK NUM)
  (LAM-EXECUTE (WRITE)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-M-SRC LAM-M-SRC-SPY-REG
	       LAM-IR-ALUF LAM-ALU-SETM
	       LAM-IR-FUNC-DEST LAM-FUNC-DEST-PI)
  (COND ((AND MAKE-SURE (NOT (= (SETQ TEMP (READ-PI)) num)))
	 (FORMAT T "~%write-pi: Wrote ~O, Read back ~O, trying again " num TEMP))))

(DEFUN WRITE-PI-STEPPING (NUM)
  (WRITE-SPY-REG-AND-CHECK NUM)
  (LAM-EXECUTE (EXECUTOR LAM-EXECUTE-NOCLOCKS)
		      LAM-IR-OP LAM-OP-ALU
		      LAM-IR-OB LAM-OB-ALU
		      LAM-IR-M-SRC LAM-M-SRC-SPY-REG
		      LAM-IR-ALUF LAM-ALU-SETM
		      LAM-IR-FUNC-DEST LAM-FUNC-DEST-PI)
  (SM-STEP-LOOP))

(DEFUN WRITE-C-PP-STEPPING (NUM)
  (WRITE-SPY-REG-AND-CHECK NUM)
  (LAM-EXECUTE (EXECUTOR LAM-EXECUTE-NOCLOCKS)
		      LAM-IR-OP LAM-OP-ALU
		      LAM-IR-OB LAM-OB-ALU
		      LAM-IR-M-SRC LAM-M-SRC-SPY-REG
		      LAM-IR-ALUF LAM-ALU-SETM
		      LAM-IR-FUNC-DEST LAM-FUNC-DEST-C-PP)
  (SM-STEP-LOOP))

(DEFUN SEARCH-PDL-BUFFER (QUAN)
  (DOTIMES (ADR 4000)
    (COND ((= (WRITE-PI-AND-READ-C-PI ADR) QUAN)
	   (FORMAT T "~%ADR ~S" ADR)))))

(DEFUN SEARCH-PDL-BUFFER-DOWN (QUAN &OPTIONAL (ADR 3777))
  (DO ()
      ((< ADR 0))
    (COND ((= (WRITE-PI-AND-READ-C-PI ADR) QUAN)
	   (FORMAT T "~%ADR ~S" ADR)))
    (SETQ ADR (1- ADR))))

(DEFUN WRITE-AND-INCREMENT-PI (NUM)		;write and increment pdl index register
  (WRITE-SPY-REG-AND-CHECK NUM)
  (LAM-EXECUTE (WRITE)
		      LAM-IR-OP LAM-OP-ALU
		      LAM-IR-OB LAM-OB-ALU
		      LAM-IR-M-SRC LAM-M-SRC-SPY-REG
		      LAM-IR-ALUF LAM-ALU-SETM
		      LAM-IR-FUNC-DEST LAM-FUNC-DEST-PI)
  (LAM-EXECUTE (WRITE)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-M-SRC LAM-M-SRC-C-PI
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-FUNC-DEST LAM-FUNC-DEST-C-PDL-INDEX-INC
	       LAM-IR-ALUF LAM-ALU-SETM))


;;;(DEFUN TEST-PI-DATA-PATH NIL (TEST-DATA-PATH "PDL INDEX" 'PI-ACTOR 11.))
;;;  Replaced by TEST-PDL-INDEX


(DEFUN write-and-decrement-pi (num)
  (write-spy-reg-and-check num)
  (lam-execute (write)
	       lam-ir-op lam-op-alu
	       lam-ir-ob lam-ob-alu
	       lam-ir-m-src lam-m-src-spy-reg
	       lam-ir-func-dest lam-func-dest-pi
	       lam-ir-aluf lam-alu-setm)
  (lam-execute (write)
	       lam-ir-op lam-op-alu
	       lam-ir-ob lam-ob-alu
	       lam-ir-m-src lam-m-src-pi
	       lam-ir-func-dest lam-func-dest-c-pdl-index-dec
	       lam-ir-aluf lam-alu-setm))


(DEFSELECT (PI-ACTOR)
  (READ (ADDRESS) ADDRESS
   (READ-PI))
  (WRITE (ADDRESS DATA) ADDRESS
   (WRITE-PI DATA)))

(DEFUN READ-PP ()				;read pdl pointer register
  (LAM-EXECUTE (READ)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-M-SRC LAM-M-SRC-PP
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-ALUF LAM-ALU-SETM)
  (READ-MFO))

(DEFUN WRITE-PP (NUM &OPTIONAL MAKE-SURE &AUX TEMP)	;write pdl pointer register
  (WRITE-SPY-REG-AND-CHECK NUM)
  (PROG NIL
     TOP (LAM-EXECUTE (WRITE)
		      LAM-IR-OP LAM-OP-ALU
		      LAM-IR-OB LAM-OB-ALU
		      LAM-IR-M-SRC LAM-M-SRC-SPY-REG
		      LAM-IR-ALUF LAM-ALU-SETM
		      LAM-IR-FUNC-DEST LAM-FUNC-DEST-PP)
	(COND ((AND MAKE-SURE (NOT (= (SETQ TEMP (READ-PP)) num)))
	       (FORMAT T "~%Wrote ~O, Read back ~O, trying again " num TEMP)
	       (GO TOP)))))

(DEFUN WRITE-AND-INCREMENT-PP (NUM)		;write and increment pdl index register
  (WRITE-SPY-REG-AND-CHECK NUM)
  (LAM-EXECUTE (WRITE)
		      LAM-IR-OP LAM-OP-ALU
		      LAM-IR-OB LAM-OB-ALU
		      LAM-IR-M-SRC LAM-M-SRC-SPY-REG
		      LAM-IR-ALUF LAM-ALU-SETM
		      LAM-IR-FUNC-DEST LAM-FUNC-DEST-PP)
  (LAM-EXECUTE (WRITE)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-M-SRC LAM-M-SRC-C-PP
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-FUNC-DEST LAM-FUNC-DEST-C-PP-PUSH
	       LAM-IR-ALUF LAM-ALU-SETM))

;;;(DEFUN TEST-PP-DATA-PATH NIL (TEST-DATA-PATH "PDL POINTER" 'PP-ACTOR 11.))
;;;  Replaced by TEST-PDL-POINTER



(defun write-and-decrement-pp (num)
  (write-spy-reg-and-check num)
  (lam-execute (write)
	       lam-ir-op lam-op-alu
	       lam-ir-ob lam-ob-alu
	       lam-ir-m-src lam-m-src-spy-reg
	       lam-ir-func-dest lam-func-dest-pp
	       lam-ir-aluf lam-alu-setm)
  (lam-execute (write)
	       lam-ir-op lam-op-alu
	       lam-ir-ob lam-ob-alu
	       lam-ir-m-src lam-m-src-c-pp-pop
	       lam-ir-m-mem-dest 1
	       lam-ir-aluf lam-alu-setm))

(DEFSELECT (PP-ACTOR)
  (READ (ADDRESS) ADDRESS
   (READ-PP))
  (WRITE (ADDRESS DATA) ADDRESS
   (WRITE-PP DATA)))

(DEFUN READ-C-PI ()			;read pdl addressed by index register
  (LAM-EXECUTE (READ)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-M-SRC LAM-M-SRC-C-PI
	       LAM-IR-ALUF LAM-ALU-SETM)
  (READ-MFO))

(DEFUN READ-C-PP ()				;read pdl addressed by pointer register
  (LAM-EXECUTE (READ)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-M-SRC LAM-M-SRC-C-PP
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-ALUF LAM-ALU-SETM)
  (READ-MFO))

(DEFUN WRITE-C-PI (NUM)				;write pdl addressed by index register
  (WRITE-SPY-REG-AND-CHECK NUM)
  (LAM-EXECUTE (WRITE)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-M-SRC LAM-M-SRC-spy-reg
	       LAM-IR-ALUF LAM-ALU-SETM
	       LAM-IR-FUNC-DEST LAM-FUNC-DEST-C-PI))

(DEFUN WRITE-C-PP (NUM)				;write pdl addressed by pointer register
  (WRITE-SPY-REG-AND-CHECK NUM)
  (LAM-EXECUTE (WRITE)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-M-SRC LAM-M-SRC-spy-reg
	       LAM-IR-ALUF LAM-ALU-SETM
	       LAM-IR-FUNC-DEST LAM-FUNC-DEST-C-PP))


(DEFUN WRITE-PI-AND-READ-C-PI (ADR)		;write pdl index register and read
  (write-pi adr 'make-sure)		;the contents of the PDL memory at
  (read-c-pi))					;the address indexed by the new pdl
		  				;index register

(DEFUN WRITE-PI-AND-WRITE-C-PI (ADR NUM)		;write pdl index register and writes
  (write-pi adr 'make-sure)			;the contents of the PDL memory at
  (write-c-pi num))					;the address indexed by the new pdl
							;index register

(defun test-pdl-buffer-data-path nil
  (test-data-path "PDL BUFFER" 'pdl-buffer-actor 32.))

(defselect (pdl-buffer-actor)
  (:read (address)
    (write-pi-and-read-c-pi address))
  (:write (address data)
    (write-pi-and-write-c-pi address data)))


(DEFUN TEST-WRITE-VIA-M-READ-VIA-PDL NIL
  (TEST-DATA-PATH "WRITE-VIA-M-READ-VIA-PI" 'WRITE-VIA-M-READ-VIA-PI-ACTOR 32.))

(DEFSELECT (WRITE-VIA-M-READ-VIA-PI-ACTOR)
  (:WRITE (ADDRESS DATA) 
    (WRITE-M-MEM ADDRESS DATA))
  (:READ (ADDRESS) 
    (LET ((OLD-MODE (READ-DP-MODE)))
      (WRITE-DP-MODE 0)
      (PROG1 (WRITE-PI-AND-READ-C-PI ADDRESS)
	     (WRITE-DP-MODE OLD-MODE)))))

;THIS WILL WRITE ANYWHERE IN THE 4K M/PDL-BUFFER MEMORY.
(DEFUN WRITE-M-MEM-VIA-PDL-POINTER (ADDRESS DATA)
  (LET ((OLD-MODE (READ-DP-MODE)))
    (WRITE-DP-MODE (LDB 1301 ADDRESS))
    (WRITE-PP-AND-WRITE-C-PP (LDB 0013 ADDRESS) DATA)
    (WRITE-DP-MODE OLD-MODE)))

;NOTE M-MEM LOCN 0 DOESNT "WORK" SO WE CAN ONLY DO COMPLEMENTED PHASES
(DEFUN FAST-ADDRESS-TEST-PDL-C-PI NIL
  (NOOP-UINST-CLOCKS)			;MAKE SURE NO CARRYOVER WRITES TO SCREW UP
  (write-dp-mode 0)			;Test out the low bits of the PDL
  (LET ((OFFSET 0)
	(N-DATA-BITS 32.)	
	(READ-FCTN 'WRITE-PI-AND-READ-C-PI)
	(WRITE-FCTN 'WRITE-PI-AND-WRITE-C-PI)
	(N-ADDRESS-BITS 11.))
    (FAST-ADDRESS-TEST-KERNAL WRITE-FCTN READ-FCTN
			      OFFSET N-DATA-BITS N-ADDRESS-BITS
			      "FAST-ADDRESS-TEST of PDL addressed by PDL index; low bits" 2)
    (write-dp-mode 1.)		;Test out the high bits of the PDL
    (FAST-ADDRESS-TEST-KERNAL WRITE-FCTN READ-FCTN
			      OFFSET N-DATA-BITS N-ADDRESS-BITS
			      "FAST-ADDRESS-TEST of PDL addressed by PDL index; hi bits" 0)))


(DEFUN WRITE-PP-AND-READ-C-PP (adr)		;write pdl index register and read
  (write-pp adr 'make-sure)	         	;the contents of the PDL memory at
  (read-c-pp))					;the address indexed by the new pdl
						;index register

(DEFUN WRITE-PP-AND-WRITE-C-PP (ADR NUM)	;write pdl index register and writes
  (write-pp adr 'make-sure)		        ;the contents of the PDL memory at
  (write-c-pp num))				;the address indexed by the new pdl
	       					;index 

;NOTE M-MEM LOCN 0 DOESNT "WORK" SO WE CAN ONLY DO COMPLEMENTED PHASES
(DEFUN FAST-ADDRESS-TEST-PDL-C-PP NIL
  (NOOP-UINST-CLOCKS)			;MAKE SURE NO CARRYOVER WRITES TO SCREW UP
  (write-dp-mode 0)			;Test out the low bits of the PDL
  (LET ((OFFSET 0)
	(N-DATA-BITS 32.)	
	(READ-FCTN 'WRITE-PP-AND-READ-C-PP)
	(WRITE-FCTN 'WRITE-PP-AND-WRITE-C-PP)
	(N-ADDRESS-BITS 11.))
    (FAST-ADDRESS-TEST-KERNAL WRITE-FCTN READ-FCTN
			      OFFSET N-DATA-BITS N-ADDRESS-BITS
			      "FAST-ADDRESS-TEST of PDL addressed by PDL Pointer; low bits" 2)
    (write-dp-mode 1.)		;Test out the high bits of the PDL
    (FAST-ADDRESS-TEST-KERNAL WRITE-FCTN READ-FCTN
			      OFFSET N-DATA-BITS N-ADDRESS-BITS
			      "FAST-ADDRESS-TEST of PDL addressed by PDL Pointer; hi bites"
			      0)))