;;; -*- Mode:Zetalisp; Package:SYSTEM-INTERNALS; Base:8 -*-

(defconst nu-ether-quad-slot #xf0)

(defun nu-ether-read (adr)
  (cond ((> adr 32768.)
	 (ferror nil "bad adr")))
  (cond ((ldb-test (byte 1 1) adr)
	 (ldb (byte 16. 16.) (%nubus-read nu-ether-quad-slot adr)))
	(t
	 (ldb (byte 16. 0) (%nubus-read nu-ether-quad-slot adr)))))

(defun nu-ether-write (adr data)
  (cond ((> adr 32768.)
	 (ferror nil "bad adr")))
  (cond ((ldb-test (byte 1 1) adr)
	 (%nubus-write nu-ether-quad-slot adr
		       (dpb data
			    (byte 16. 16.)
			    (%nubus-read nu-ether-quad-slot adr))))
	(t
	 (%nubus-write nu-ether-quad-slot adr
		       (dpb data
			    (byte 16. 0)
			    (%nubus-read nu-ether-quad-slot adr))))))

(defun print-starting-pointer ()
  (format t "~&#x7ff6 bus width (0 = 16bits) ~16r" (nu-ether-read #x7ff6))
  (format t "~&#x7ff8 ?? ~16r" (nu-ether-read #x7ff8))
  (format t "~&#x7ffa ?? ~16r" (nu-ether-read #x7ffa))
  (format t "~&#x7ffc pointer to ROOT ~16r" (dpb (nu-ether-read #x7ffe) (byte 8 16.) (nu-ether-read #x7ffc)))
  (format t "~&#x7ffe, hi byte ?? ~16r" (ldb (byte 8 8) (nu-ether-read #x7ffe))))

(defun clear-starting-pointer ()
  (dotimes (i 5)
    (nu-ether-write (+ #x7ff6 (* i 2)) 0)))

(defun clear-scb ()
  (dotimes (i 30) (nu-ether-write (* i 2) 0)))

(defun print-init-root ()
  (format t "~&0 ?? ~16r" (nu-ether-read 0))
  (format t "~&2 scb offset ~16r" (nu-ether-read 2))
  (format t "~&4 base ~16r" (dpb (nu-ether-read 6) (byte 8 16.) (nu-ether-read 4)))
  (format t "~&6 hi byte ?? ~16r" (ldb (byte 8 0) (nu-ether-read 6))))

(defun check-for-normal-setup ()
  (cond ((or (not (= 0 (ldb (byte 8 0) (nu-ether-read #x7ff6))))
	     (not (= 0 (nu-ether-read #x7ffc)))
	     (not (= 0 (ldb (byte 8 0) (nu-ether-read #x7ffe))))
	     (not (= 8 (nu-ether-read 2)))
	     (not (= 0 (nu-ether-read 4)))
	     (not (= 0 (ldb (byte 8 0) (nu-ether-read 6)))))
	 (ferror nil "config pointers wrong"))))

(defun print-scb ()
  (format t "~&