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


(defun write-hram-via-pc (hptr pc)
  ; this is to write the hram via the pc
  ; at address hptr which is loaded in the
  ; h-pointer 
  (write-pc pc)
  (write-hptr hptr)
  (LAM-EXECUTE (UINST-CLOCK)			;THIS IS A "SIMPLE" WAY TO TICK THE
	       LAM-IR-OP LAM-OP-ALU		;UINST CLOCK SAFELY - THIS IS A NOOPISH
	       LAM-IR-OB LAM-OB-ALU		;INSTRUCTION
	       LAM-IR-ALUF LAM-ALU-SETM))	;the hram gets written automatically


(DEFUN write-hptr-via-uinst-clock (hptr)
  ; this code is here to test that the h-pointer is incremented at the execution of
  ; an instruction so that the pc to that location is properly stored in the hram
  (write-ireg 0) ; no-op the current instruction
  (write-hptr (1- hptr)) ; h-pointer has now proper initial value
  (LAM-EXECUTE (UINST-CLOCK-PLUS-UINST-CLOCK-LOW)	; after this clock tick the h-pointer
	       LAM-IR-OP LAM-OP-ALU))		;should have hptr value



(DEFUN TEST-HRAM-VIA-PC-DATA-PATH NIL (TEST-DATA-PATH "hram via pc" 'HRAM-VIA-PC-ACTOR 16.))

(defun test-hram-data-path nil
  (FORCE-UINST-CLOCK-LOW)
  (test-data-path "hram" 'hram-actor 16.))

(defun test-hptr-data-path ()
  (FORCE-UINST-CLOCK-LOW)
  (COND ((UINST-CLOCK-LOW-P)
	 (test-data-path "hptr" 'hptr-actor 12.))
	(T (FERROR T "~%UNABLE TO FORCE UINST CLOCK LOW BEFORE TESTING~%~
			THE HPTR DATA PATH.  SORRY."))))

(defun test-hptr-via-inc-data-path ()
  (FORCE-UINST-CLOCK-LOW)
  (test-data-path "HPTR VIA INCREMENT" 'HPTR-VIA-INC-ACTOR 12.))

(defun write-and-increment-hptr (data)
  (write-hptr data)
  (LAM-EXECUTE (UINST-CLOCK-PLUS-UINST-CLOCK-LOW)
	       LAM-IR-OP LAM-OP-ALU))


(DEFSELECT (HRAM-VIA-PC-ACTOR)
  (:READ (ADDRESS)
    (READ-HRAM ADDRESS))
  (:WRITE (ADDRESS DATA)
    (WRITE-HRAM-VIA-PC ADDRESS DATA)))

(DEFSELECT (HPTR-via-inc-ACTOR)
  (:READ (ADDRESS) ADDRESS
    (READ-HPTR))
  (:WRITE (ADDRESS DATA) ADDRESS
    (WRITE-HPTR-via-uinst-clock DATA)))


(DEFSELECT (HPTR-ACTOR)
  (:READ (ADDRESS) ADDRESS
    (READ-HPTR))
  (:WRITE (ADDRESS DATA) ADDRESS
    (WRITE-HPTR DATA))
  (:WRITE-AND-INCREMENT (ADDRESS DATA) ADDRESS
    (WRITE-AND-INCREMENT-HPTR DATA)))

(DEFSELECT (HRAM-ACTOR)
  (:READ (ADDRESS)
    (READ-HRAM ADDRESS))
  (:WRITE (ADDRESS DATA)
    (WRITE-HRAM ADDRESS DATA)))


(defun print-old-pc ()
  (print-old-pc-values 1))

(defun print-old-pc-values (num &AUX old-hptr)
  (cond ((<= num 1000)
	 (setq old-hptr (read-hptr))
	 (change-pmr-and-check '(allow-uinst-clocks 0))
	  				;need to turn off ALLOW.UINST.CLOCKS
	 (do ((pointer (1- old-hptr) (1- pointer))
	      (mask (1- (expt 2 10.)))
	      (i 0 (1+ i)))
	     ((>= i num))
	   (FORMAT T "~&~4T~O~%"(read-hram-unsafely (logand mask pointer))))
	 (write-hptr old-hptr)
	 (change-pmr-and-check '(allow-uinst-clocks 1)))
	 				;enable ALLOW.UINST.CLOCKS
	(T (FORMAT T "~&~4THRAM is only 1000 locations, can't print ~O~%locations" num))))



(defun fast-address-test-hram ()
  (force-uinst-clock-low)
  (LET ((old-hptr (read-hptr))
	(offset 0)
	(n-data-bits 16.)
	(read-fctn 'read-hram-unsafely)
	(write-fctn 'write-hram-unsafely)
	(n-address-bits 12.)
	(message "FAST-ADDRESS-TEST of History RAM"))
    (change-pmr-and-check '(allow-uinst-clocks 0));need to turn off ALLOW.UINST.CLOCKS
    (fast-address-test-kernal write-fctn read-fctn
			      offset n-data-bits n-address-bits message 2)
    (write-hptr old-hptr)
    (change-pmr-and-check '(allow-uinst-clocks 1))))	;enable ALLOW.UINST.CLOCKS


(defun fast-address-test-hram-via-pc ()
  (NOOP-UINST-CLOCKS)
  (let ((old-hptr (read-hptr))
	(offset 0)
	(n-data-bits 16.)
	(read-fctn 'read-hram)
	(write-fctn 'write-hram-via-pc)
	(n-address-bits 12.)
	(message "FAST-ADDRESS-TEST of History RAM via PC"))
    (fast-address-test-kernal write-fctn read-fctn
			      offset n-data-bits n-address-bits message 2)
    (write-hptr old-hptr)))