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

;**All addresses to these frobs are to be NUBUS BYTE ADDRESSes.  There is/was great
; confusion on this, so some things may get broken...

;bus-read	byte-address &optional ignore-bus-errors byte-mode
;bus-read-byte  byte-address &optional ignore-bus-errors
;bus-slot-read      slot < 16 byte-address
;bus-slot-read-byte slot < 16
;bus-quad-slot-read  quad-slot word-address &optional ignore-bus-errors
;bus-quad-slot-read-byte  quad-slot byte-address &optional ignore-bus-errors

;bus-write
;bus-write-byte
;bus-slot-write      slot < 16
;bus-slot-write-byte slot < 16
;bus-quad-slot-write
;bus-quad-slot-write-byte

;frobs with -unsafe tagged on end bypass slot safety test in 2x2 mode.
;  only a few of these exist now.

;bit in here is 1 if safe to do %nubus-read on a board with that index
;(defvar safe-local-indexes (make-array 32. :type :art-1b))

;this reads ADDRESS interpreted as a physical address relative to the SDU
(defun bus-read (byte-address &optional ignore-bus-errors byte-mode)
  (send *proc* :bus-read byte-address ignore-bus-errors byte-mode))

(defun nd-bus-read (byte-address &optional ignore-bus-errors byte-mode)
  (bus-read byte-address ignore-bus-errors byte-mode))
(compiler:make-obsolete nd-bus-read "use bus-read")

(defun bus-read-byte (byte-address &optional ignore-bus-errors)
  (send *proc* :bus-read-byte byte-address ignore-bus-errors))

;this reads ADDRESS interpreted as a physical address relative to the SDU
(defun bus-write (byte-address data &optional ignore-bus-errors byte-mode)
  (send *proc* :bus-write byte-address data ignore-bus-errors byte-mode))

(defun nd-bus-write (byte-address data &optional ignore-bus-errors byte-mode)
  (bus-write byte-address data ignore-bus-errors byte-mode))
(compiler:make-obsolete nd-bus-write "use bus-write")

(defun bus-write-byte (byte-address data &optional ignore-bus-errors)
  (send *proc* :bus-write-byte byte-address data ignore-bus-errors))

(if (not (boundp 'si:cadr-type-code))
    (setq si:cadr-type-code 1))
(if (not (boundp 'si:lambda-type-code))
    (setq si:lambda-type-code 2))
(declare (special si:cadr-type-code si:lambda-type-code))

(defvar sdu-slot-base-nubus-address #xff000000)
(defvar sdu-quad-slot #xff)

;;this file contains the low level functions for manipulating the nubus from
;;a cadr via the nu-debug board. That board is designed to be driven by the cadr
;;debug cable, a decision which eliminates incompatible cables and hardware mods
;;but which does complexify the protocol.

;;in addition, we wish to adapt the diagnostic software for use with other means
;;of accessing the nubus under test.  The variable *bus-communication-instance*
;;is set to an appropriate object which is sent communication messages, initially
;;read and write, later high level diagnostic commands.  The object then performs
;;the operation in a manner appropriate to the communication mode between the busses

;;for the moment, a value of nil defaults to the nu-debug card operated from a cadr

(defvar *bus-communication-instance* nil) 

;;the design of the debug board is basically 3 pairs of register:read-data,
;;write-data, address. The cadr debug cable has 16 data bits; the nubus has
;;32 address/data bits.
;;			So, to do a read:	1.load address (two loads,
;;							high bits and low bits)
;;						2.start nubus read cycle
;;						3.read the contents of the
;;							read-data register
;;
;;			for a write:		1.load address
;;						2.load write-data register
;;						3.start write cycle


;;There are only two address bits on the
;;cadr debug cable, and three were required for operation of the nu-debug board
;;(given that simplicity of design was important).  So one bit of the boards mode
;;register is used to select address spaces. (it is important to remember
;;that the signal that actually does the mode switch is inverted, if you are
;;probing on this board.  worse yet, on the first set of prints, its called
;;*debug.mode.0  ...a supposedly positive signal) to wit:

;;	mode		address		read		write
;;	0		0		mode reg	mode reg
;;	0		1		nc		low data
;;	0		2		nc		high data
;;	0		3		nc		nc

;;	1		0		mode reg	mode reg
;;	1		1		start read	start write
;;	1		2		low data	low address
;;	1		3		high data	high address
;
;;the unibus address of the cadr's debug out port is 766100 - 766114 (bits 3-2
;;of the unibus address map into bits 1-0 of the debug address)

(defmacro nd-read (address)
  (cond ((numberp address)
	 `(%unibus-read ,(+ 766100 (ash address 2))))
	(t
	 `(%unibus-read (+ 766100 (ash ,address 2))))))

(defmacro nd-write (address data)
  (cond ((numberp address)
	 `(%unibus-write ,(+ 766100 (ash address 2)) ,data))
	(t
	 `(%unibus-write (+ 766100 (ash ,address 2)) ,data))))

;;the simplest operation is the read and write of the board's mode register
;;which can happen in either mode

(DEFUN PRINT-ND-MODE ()
  (cond ((= si:processor-type-code si:cadr-type-code)
	 (LET ((MODE (logand 377 (nd-read 0))))
	   (FORMAT T "~%nu-debug board is ~[enabled~;disabled~]~%~[byte mode~;word or ~
halfword mode~]~%~[low~;high~] address mode"
		   (LDB 0101 MODE)
		   (LDB 0001 MODE)
		   (LDB 0201 MODE))))
	(t (bc-print-status))))

(defmacro read-nd-status ()
  `(ldb 1010 (nd-read 0)))

(defmacro read-nd-mode ()
  `(logand 377 (nd-read 0)))


(defmacro write-nd-mode (value)
  "be careful that value is less than 400"
  `(nd-write 0 ,value))

;;we then want to be able to set the mode,preserving the state of the other
;;seven bits in the mode register.  The mode is switched by *debug.mode.0
;;byte mode was added as an afterthought - asserts appropriate TM bit

(defun disable-nd ()
  (cond ((= si:processor-type-code si:cadr-type-code)
	 (write-nd-mode (logior 2 (nd-read 0))))))

(defun enable-nd ()
  (cond ((= si:processor-type-code si:cadr-type-code)
	 (write-nd-mode (logand 375 (nd-read 0))))))
	
(DEFUN INIT-ND ()
  (DISABLE-ND)
  (ENABLE-ND))

(defmacro disable-nd-byte-mode ()
  `(write-nd-mode (logior 4 (nd-read 0))))

(defmacro enable-nd-byte-mode ()
  `(write-nd-mode (logand 373 (nd-read 0))))

(defmacro set-nd-address-mode-high ()
  `(write-nd-mode (logior 1 (nd-read 0))))

(defmacro set-nd-address-mode-low ()
  `(write-nd-mode (logand 376 (nd-read 0))))

;;now, some convenient functions to load the registers with 32 bit numbers.


(defmacro low-16-bits (value)
	`(ldb 0020 ,value))

(defmacro high-16-bits (value)
	`(ldb 2020 ,value))

(defmacro write-nd-address (address)
  `(progn
     (set-nd-address-mode-high)
     (nd-write 2 (low-16-bits ,address))
     (nd-write 3 (high-16-bits ,address))))

(defmacro write-nd-data (value)
  `(progn
     (set-nd-address-mode-low)
     (nd-write 1 (low-16-bits ,value))
     (nd-write 2 (high-16-bits ,value))))

(defmacro read-nd-data ()
  `(progn
     (set-nd-address-mode-high)
     (dpb (nd-read 3) 2020 (nd-read 2))))

;;to start a nubus cycle

(defmacro start-nubus-read ()
  `(progn
     (set-nd-address-mode-high)
     (nd-read 1)))

(defmacro start-nubus-write ()
  `(progn
     (set-nd-address-mode-high)
     (nd-write 1 0)))



(defflavor debug-nubus-error () (error))

(defmethod (debug-nubus-error :case :proceed-asking-user :retry-bus-cycle) (cont read-func)
  "Retry the bus cycle."
  read-func
  (funcall cont ':retry-bus-cycle))

(defmethod (debug-nubus-error :case :proceed-asking-user :ignore-bus-error) (cont read-func)
  "Ignore the bus error."
  read-func
  (funcall cont ':ignore-bus-error))

(defmethod (debug-nubus-error :case :proceed-asking-user :ignore-bus-error-read)
							 (cont read-func)
  "Ignore the bus error, and return -1 as the value of the read."
  read-func
  (funcall cont ':ignore-bus-error-read))

(defmethod (debug-nubus-error :case :proceed-asking-user :loop-until-it-works)
	   						(cont read-func)
  "Keep executing this bus cycle until it works."
  read-func
  (funcall cont ':loop-until-it-works))

(defmethod (debug-nubus-error :case :proceed-asking-user :write-good-parity)
							(cont read-func)
  "Proceeds, reading a value to store."
  (funcall cont ':write-good-parity
	   (funcall read-func ':eval-read "~&Type a value to store: ")))

(compile-flavor-methods debug-nubus-error)

(defsignal nubus-timeout debug-nubus-error (address type)
	   "This is signaled when the nu-debug board detects a nubus error.")

(defvar check-for-nubus-timeouts t)


(defun nu-debug-bus-read (byte-address &optional ignore-bus-errors byte-mode
			  &aux (start-time (time)))
  (prog (loop-until-it-works)
     retry
	(set-nd-address-mode-high)
	(nd-write 2 (low-16-bits byte-address))
	(nd-write 3 (high-16-bits byte-address))
	(if byte-mode
	    (enable-nd-byte-mode))
	(nd-read 1)				;start nubus read
	(dotimes (i 3.))			;delay 25 microsecs (on cadr)
	(if byte-mode
	    (disable-nd-byte-mode))
	
	(select (ldb 1002 (nd-read 0))
	  (0					; try again later
	   (cond ((and (null loop-until-it-works)
		       (time-lessp 30. (time-difference (time) start-time)))
		  (if ignore-bus-errors
		      (return -1))
		  (signal-proceed-case
		    (() 'nubus-timeout
			"nubus try-again-later too many times: address = ~o~:* (#x~16r)"
			byte-address 'try-again-later)
		    (:retry-bus-cycle
		     (setq start-time (time))
		     (go retry))
		    (:loop-until-it-works
		     (setq loop-until-it-works t)
		     (go retry))
		    (:ignore-bus-error-read (return -1))
		    ))
		 (t
		  (go retry))))
	  (1					; bus timeout
	   (cond ((not (null loop-until-it-works))
		  (go retry))
		 ((and check-for-nubus-timeouts
		       (not ignore-bus-errors))
		  (signal-proceed-case
		    (() 'nubus-timeout
			"nubus timeout: byte address = ~o~:* (#x~16r)"
			byte-address 'nubus-timeout)
		    (:retry-bus-cycle (go retry))
		    (:loop-until-it-works
		     (setq loop-until-it-works t)
		     (go retry))
		    (:ignore-bus-error-read (return -1))
		    ))
		 (t
		  (return -1))))
	  (2					; other bus error - maybe parity
	   (cond ((not (null loop-until-it-works))
		  (go retry))
		 ((and check-for-nubus-timeouts
		       (not ignore-bus-errors))
		  (signal-proceed-case
		    ((new-value) 'nubus-timeout
				 "other nubus error (parity?): byte address = ~o~:* (#x~16r)"
				 byte-address 'parity-error)
		    (:retry-bus-cycle (go retry))
		    (:loop-until-it-works
		     (setq loop-until-it-works t)
		     (go retry))
		    (:write-good-parity
	   (ferror nil "foo")
		     (bus-write byte-address new-value)
		     (return new-value))
		    (:ignore-bus-error-read (return -1))))
		 (t
		  (return -1))))
	  (3					; normal
	   (return (dpb (nd-read 3) 2020 (nd-read 2)))))))

;old function to read via bus coupler.  not called now.
(defun lambda-direct-bus-read (byte-address &optional ignore-bus-errors byte-mode
			      &aux (start-time (time))) ignore-bus-errors
  (let ((quad-slot (ldb (byte 8 24.) byte-address)))
    ;(if (zerop (aref safe-local-indexes (quad-slot-to-configuration-index quad-slot)))
    ;	(ferror nil "that would get a timeout"))
    (cond ((= #xf (ldb (byte 4 4) quad-slot))
	   (cond ((null byte-mode)
		  (%nubus-read quad-slot (ash (ldb (byte 22. 2) byte-address) 2)))
		 (t
		  (compiler:%nubus-read-8 quad-slot byte-address))))
	  (t
	   (prog (data)
	      retry
		 (setq data
		       (cond ((null byte-mode)
			      (%nubus-read quad-slot (ash (ldb (byte 22. 2) byte-address) 2)))
			     (t
			      (compiler:%nubus-read-8 quad-slot byte-address))))
		 (cond ((zerop (logand 1_11. (bc-read-far-status)))
			(return data))
		       ((time-lessp 30. (time-difference (time) start-time))
			(signal-proceed-case
			  (() 'nubus-timeout
			      "got try-again-later too many times: adress = ~o (~:*~16r)"
			      byte-address)
			  (:retry-bus-cycle
			   (setq start-time (time))
			   (go retry))
			  (:ignore-bus-error (return -1))))))))))

;old function to read via LMI dribble.  not called now.
;(defun old-lambda-dribble-bus-read (byte-address &optional ignore-bus-errors byte-mode)
;  (cond ((null byte-mode)
;	 (format *proc* "~O,~OP"
;		 (quad-slot-to-configuration-index (ldb (byte 8 24.) byte-address))
;		 (ldb (byte 22. 2) byte-address))
;	 (send *proc* :read-32))
;	(t
;	 (send *proc* "~O,~Op~%"
;	       (quad-slot-to-configuration-index (ldb (byte 8 24.) byte-address))
;	       byte-address)
;	 (send *proc* ':read-32))))



(defun nu-debug-bus-write (byte-address data &optional ignore-bus-errors byte-mode
		     &aux (start-time (time)))
  (prog (loop-until-it-works)
     retry
	(set-nd-address-mode-low)
	(nd-write 1 (low-16-bits data))
	(nd-write 2 (high-16-bits data))
	(set-nd-address-mode-high)
	(nd-write 2 (low-16-bits byte-address))
	(nd-write 3 (high-16-bits byte-address))
	(if byte-mode
	    (enable-nd-byte-mode))
	(nd-write 1 0)				;start nubus write
	(dotimes (i 3.))			;delay 25 microsecs (on cadr)
	(if byte-mode
	    (disable-nd-byte-mode))
	(select (ldb 1002 (nd-read 0))		;look at the read-only bits of the nd-mode
	  (0
	   (cond ((and (null loop-until-it-works)
		       (time-lessp 30. (time-difference (time) start-time)))
		  (signal-proceed-case
		    (() 'nubus-timeout
			"try-again-later too many times: address=~o ~:*(#x~16r)"
			byte-address 'try-again-later)
		    (:retry-bus-cycle
		     (setq start-time (time))
		     (go retry))
		    (:loop-until-it-works
		     (setq loop-until-it-works t)
		     (go retry))
		    (:ignore-bus-error (return -1))
		    ))
		 (t
		  (go retry))))
	  (1					; bus timeout
	   (cond ((not (null loop-until-it-works))
		  (go retry))
		 ((and check-for-nubus-timeouts
		       (not ignore-bus-errors))
		  (signal-proceed-case
		    (() 'nubus-timeout
			"nubus timeout: byte address = ~o~:* (#x~16r)"
			byte-address 'nubus-timeout)
		    (:retry-bus-cycle (go retry))
		    (:loop-until-it-works
		     (setq loop-until-it-works t)
		     (go retry))
		    (:ignore-bus-error (return nil))))
		 (t
		  (return nil))))
	  (2					; other bus error - maybe parity
	   (cond ((not (null loop-until-it-works))
		  (go retry))
		 ((and check-for-nubus-timeouts
		       (not ignore-bus-errors))
		  (signal-proceed-case
		    (() 'nubus-timeout
			"other nubus error (parity?): byte address = ~o~:* (#x~16r)"
			byte-address 'parity-error)
		    (:retry-bus-cycle (go retry))
		    (:loop-until-it-works
		     (setq loop-until-it-works t)
		     (go retry)
		     (:ignore-bus-error (return nil)))))
		 (t
		  (return nil))))
	  (3					; normal
	   (return nil)))))

(defun lambda-direct-bus-write (byte-address data &optional ignore-bus-errors byte-mode
			      &aux (start-time (time))) ignore-bus-errors
  (let ((quad-slot (ldb (byte 8 24.) byte-address)))
    ;(if (zerop (aref safe-local-indexes (quad-slot-to-configuration-index quad-slot)))
    ;	(ferror nil "that would get a timeout"))
    (cond ((= #xf (ldb (byte 4 4) quad-slot))
	   (cond ((null byte-mode)
		  (%nubus-write quad-slot (ash (ldb (byte 22. 2) byte-address) 2) data))
		 (t
		  (compiler:%nubus-write-8 quad-slot byte-address
				     (ldb (byte 8 (* 8 (ldb (byte 2 0) byte-address)))
					  data)))))
	  (t
	   (prog (data)
	      retry
		 (setq data
		       (cond ((null byte-mode)
			      (%nubus-write quad-slot (ash (ldb (byte 22. 2) byte-address) 2)
					    data))
			     (t
			      (compiler:%nubus-write-8 quad-slot byte-address
					      (ldb (byte 8 (* 8 (ldb (byte 2 0) byte-address)))
						   data)))))
		 (cond ((zerop (logand 1_11. (bc-read-far-status)))
			(return data))
		       ((time-lessp 30. (time-difference (time) start-time))
			(signal-proceed-case
			  (() 'nubus-timeout
			      "got try-again-later too many times: adress = ~o (~:*~16r)"
			      byte-address)
			  (:retry-bus-cycle
			   (setq start-time (time))
			   (go retry))
			  (:ignore-bus-error (return -1))))))))))



;(defun old-lambda-dribble-bus-write (byte-address data &optional ignore-bus-errors byte-mode)
;  (cond ((null byte-mode)
;	 (format *proc* "~OL ~O,~OW"
;		 data
;		 (quad-slot-to-configuration-index (ldb (byte 8 24.) byte-address))
;		 (ldb (byte 22. 2) byte-address))
;	 (process-sleep 10))
;	(t
;	 (send *proc* "~OL ~O,~Ow~%"
;	       data
;	       (quad-slot-to-configuration-index (ldb (byte 8 24.) byte-address))
;	       byte-address)
;	 (process-sleep 10))))

(defun nd-bus-write-non-aligned (byte-address data &optional ignore-bus-errors)
  (cond ((zerop (ldb 0002 byte-address))
	 (bus-write byte-address data ignore-bus-errors))
	(t
	 (bus-write-byte byte-address data ignore-bus-errors)
	 (bus-write-byte (+ byte-address 1) (ldb (byte 8 8) data) ignore-bus-errors)
	 (bus-write-byte (+ byte-address 2) (ldb (byte 8 16.) data) ignore-bus-errors)
	 (bus-write-byte (+ byte-address 3) (ldb (byte 8 24.) data) ignore-bus-errors))))

;convert an index into the configuration array to a quad (i.e. high 4 bits of NUBUS address).
(defun configuration-index-to-quad (index)
  (- #xF (ldb 404 index)))

(defun configuration-index-to-quad-slot (index)
  (dpb (- #xF (ldb 0404 index)) 0404 index))

(defun quad-slot-to-configuration-index (quad-slot)
  (let ((quad (ldb 0404 quad-slot))
	(slot (ldb 0004 quad-slot)))
    (+ (* 20 (- #xF quad)) slot)))

(defun nd-slot-write-halfword (quad-slot byte-address data &optional ignore-bus-errors)
  (bus-write
    (dpb quad-slot
	 3010
	 (dpb (if (bit-test 2 byte-address) 3 1) 0002	;deposit halfword code
	      (logand (lognot 2) byte-address)))	;shift left one & flush hw bit
    (if (bit-test 2 byte-address) (ash data 20) data)	;align halfword data
    ignore-bus-errors))

(defun multibus-write-16 (multibus-byte-address data)
  (nd-slot-write-halfword sdu-quad-slot multibus-byte-address data)

;  (ferror nil "this does not work!")
;  (bus-write (+ (ash sdu-quad-slot 24.)
;		multibus-byte-adr)
;		(cond ((zerop (ldb 0101 multibus-byte-adr))
;		       data)
;		      (t
;		       (dpb data 2020 0))))
  )

(defun multibus-read-16 (multibus-byte-adr)
  (let ((ans (bus-read (+ (ash sdu-quad-slot 24.) multibus-byte-adr))))
    (cond ((zerop (ldb 0101 multibus-byte-adr))
	   (ldb 0020 ans))
	  (t
	   (ldb 2020 ans)))))

(defun multibus-write-32 (multibus-byte-address data)
  (bus-write (dpb sdu-quad-slot 3010 multibus-byte-address) data))

(defun multibus-read-32 (multibus-byte-address)
  (bus-read (dpb sdu-quad-slot 3010 multibus-byte-address)))

;(defun mp-bus-read (nubus-byte-address)
;  "like nd-bus-read, but in serial mode recognizes quad-slot #xFF and tries to win"
;  (cond ((access-path-lmi-serial-protocol *proc*)
;	 (cond ((= (ldb (byte 8 24.) nubus-byte-address) #xFF)
;		(multibus-read-32 (logand 77777777 (ash nubus-byte-address -2))))
;	       (t (nnd-slot-read (ldb (byte 8 24.) nubus-byte-address)
;				 (logand 77777777 nubus-byte-address)))))
;	(t (nd-bus-read nubus-byte-address))))

;(defun mp-bus-read-byte (nubus-byte-address)
;  "like nd-bus-read-byte, but in serial mode recognizes quad-slot #xFF and tries to win"
;  (cond ((access-path-lmi-serial-protocol *proc*)
;	 (cond ((= (ldb (byte 8 24.) nubus-byte-address) #xFF)
;		(multibus-byte-read (logand 77777777 (ash nubus-byte-address -2))))
;	       (t (nnd-slot-read-byte (ldb (byte 8 24.) nubus-byte-address)
;				      (logand 77777777 nubus-byte-address)))))
;	(t (nd-bus-read-byte nubus-byte-address))))

(defconst byte-memory-offset-in-sdu-mode 20000)

(defun multibus-real-address (multibus-address)
  (+ multibus-address byte-memory-offset-in-sdu-mode))

(defun multibus-byte-read (multibus-byte-address &optional (offset-p ()) ignore-bus-errors)
 "Uses byte-memory-offset-in-sdu-mode if offset-p t"
  (COND ((ACCESS-PATH-LMI-SERIAL-PROTOCOL *PROC*)
	 (FORMAT *PROC*
		 "~on" (+ MULTIBUS-BYTE-ADDRESS
			  (if offset-p
			      byte-memory-offset-in-sdu-mode
			    0)))
	 (FUNCALL *PROC*
		  ':READ-32))
	(T 
	 (bus-read-byte (+ sdu-slot-base-nubus-address
			   multibus-byte-address	;multibus bytes
			   (if offset-p
			       byte-memory-offset-in-sdu-mode
			     0))
			ignore-bus-errors))))

(defun multibus-byte-write (multibus-byte-address data &optional (offset-p ())
			    ignore-bus-errors)
 "Uses byte-memory-offset-in-sdu-mode if offset-p t"
  (COND ((ACCESS-PATH-LMI-SERIAL-PROTOCOL *PROC*)
	 (FORMAT *PROC*
		 "~oL~oo"
		 (LOGAND DATA 377)
		 (+ MULTIBUS-BYTE-ADDRESS
		    (if offset-p
			byte-memory-offset-in-sdu-mode
		      0)))
	 (PROCESS-SLEEP 10))
	(T
	 (bus-write-byte (+ sdu-slot-base-nubus-address
			    multibus-byte-address	;multibus bytes
			    (if offset-p
				byte-memory-offset-in-sdu-mode
			      0))
			 data
			 ignore-bus-errors))))

;;for control of multibus peripherals, we have I/O space 16-bit transactions
;;The multibus io space maps into the low order bytes of the nubus addresses
;;F_id_100000 through F_id_104FFC hex (4000000 - 4037775 low bits in octal)
;; The SDU uses F.<id>.100000 - F.<id>.13FFFF (1000000 - 1777777 octal word addresses) instead

;this is somewhat confused.  It probably should really be called MULTIBUS-IO-WRITE-8.
(defun multibus-IO-write-8 (&optional (port-adr 0) (data 0) ignore-bus-errors)  ignore-bus-errors
  (cond ((ACCESS-PATH-LMI-SERIAL-PROTOCOL *PROC*)
	 (FORMAT *PROC*
		 "~oL~oj"
		 (LOGAND DATA 377)
		 PORT-ADR)
	 (PROCESS-SLEEP 10))
	(t (bus-write-byte (dpb sdu-quad-slot 3010 (+ 1_20. (ash port-adr 2))) data ignore-bus-errors))
;	(t (multibus-write-16 (+ 1_20. port-adr) data))
;	(t (nd-slot-write 17 (+ 1000000 port-adr) data ignore-bus-errors))
	))

(defun multibus-IO-read-8 (&optional (port-adr 0) ignore-bus-errors)
  ignore-bus-errors
  (cond ((ACCESS-PATH-LMI-SERIAL-PROTOCOL *PROC*)
	 (FORMAT *PROC*
		 "~ok" PORT-ADR)
	 (FUNCALL *PROC* ':READ-32))
	(t (bus-read-byte (dpb sdu-quad-slot 3010 (+ 1_20. (ash port-adr 2))) ignore-bus-errors))
	;(t (multibus-read-16 (+ 1_20. port-adr)))
	;(t (logand 177777 (nd-slot-read 17 (+ 1000000 port-adr))))
	))



(defun read-multibus-mapping-register (page-number)
  (if (not (< page-number 2000))
      (break "page number too big"))
  (let ((ans 0))
    (dotimes (c 3)
      (setq ans (dpb (funcall *proc* :multibus-byte-read (+ #16r18000 (* 4 page-number) c))
		     (dpb c 1102 10)
		     ans)))
    ans))

(defun write-multibus-mapping-register (page-number data)
  (if (not (< page-number 2000))
      (break "page number too big"))
  (dotimes (c 3)
    (funcall *proc* :multibus-byte-write
	     (+ #16r18000 (* 4 page-number) c)
	     (ldb (dpb c 1102 10) data)))
  data)


(defun print-multibus-mapping-register (page-number)
  (cond ((< page-number 2000)
	 (let ((data (READ-MULTIBUS-MAPPING-REGISTER PAGE-NUMBER)))
	   (FORMAT T "~%MAPPING REGISTER ~S, ~S, Valid ~s, quad-slot ~s, page number ~s, adr #x~16r"
		   page-number
		   data
		   (ldb (byte 1 23.) data)
		   (ldb (byte 8 14.) data)
		   (ldb (byte 14. 0) data)
		   (ash (ldb (byte 22. 0) data) 10.))))
	(t (format t "~%Mapping register ~s too big" page-number))))

(defun print-lambda-mapping-registers ()
  (format t "~%INTMAP-MULTIBUS-MAP:")
  (print-multibus-mapping-register (send *proc* :intmap-multibus-map))
  (format t "~%Mapping register block:")
  (do ((reg (send *proc* :base-multibus-mapping-register) (1+ reg))
       (lim (send *proc* :number-of-multibus-maps))
       (c 0 (1+ c)))
      ((= c lim))
    (print-multibus-mapping-register reg)))

(defun mapping-registers-used (&optional (from 700))
  (do ((to from (1+ to)))
      ((zerop (funcall *proc* :multibus-byte-read (+ #x18000 (* 4 to))))
       (format t "~&~o-~o (= ~o~:* ~d.)" from to (- to from)))))


(defun unmap-multibus-mapping-registers-pointing-to-slot (slot)
  (dotimes (reg 1024.)
    (let ((mapped-to (read-multibus-mapping-register reg)))
      (cond ((= (ash mapped-to -14.) (dpb slot 0004 #x2f0))
	     (format t "~&reg ~o mapped to #x~16r" reg (ash mapped-to 10.))
	     (write-multibus-mapping-register reg 0))))))



;;a useful function to see that the nubus is working	
(defun nd-setup NIL
  (send *proc* :interface-reset))

;cadr code
;	 (disable-nd)
;	 (enable-nd)
;	 (disable-nd-byte-mode)
;	 (DISABLE-ND-BYTE-MODE)
;	 (PRINT-ND-MODE)

(defmethod (nubus-via-burr-brown-and-nu-debug :interface-reset) ()
  (bb-nd-reset))

(defmethod (local-access-path :interface-reset) ()
  )

(defun nd-setup-1 NIL
  (nd-setup))

(defun bc-print-status (&optional (status (bc-read-local-status)))
  (format t "~%bc status= ~o" status)
  (format t "~%enable = ~o" (ldb (byte 1 1) status))
  (format t "~%maps quad ~16r (hex) " (ldb (byte 4 4) status))
  (format t "~%secondary = ~o" (ldb (byte 1 8) status))
  (format t "~%cable OK = ~o" (ldb (byte 1 9) status))
  (format t "~%Acting as SDU = ~o" (ldb (byte 1 10.) status))
  (format t "~%timeout = ~o" (ldb (byte 1 11.) status)))

(defun bc-setup nil
  (bc-write-local-status (dpb *bc-local-quad* 404 13))	;init on.
  (bc-write-local-status (dpb *bc-local-quad* 404 12))	;init off.
  (setq *look-across-bus-couplers* nil)   ;chained bus couplers dont win.
  )

(defun bc-read-local-status ()
  (compiler:%nubus-read (dpb 17 0404 *bc-local-slot*) #xFFFF7FC))

(defun bc-write-local-status (data)
  (compiler:%nubus-write (dpb 17 0404 *bc-local-slot*) #xFFFF7FC data))

(defun bc-read-far-status ()
  (compiler:%nubus-read (dpb *bc-local-quad* 0404 *bc-far-slot*) #xFFFF7FC))

(defun bc-write-far-status (data)
  (compiler:%nubus-write (dpb *bc-local-quad* 0404 *bc-far-slot*) #xFFFF7FC data))

(defun nd-setup-2 ()
  (cond ((= si:processor-type-code si:cadr-type-code)
	 (TEST-ND-MODE-DATA-PATH)
	 (nd-setup))
	(t
	 (bc-setup)))
  (cond ((null (SEND *PROC* :MEM-SLOT))
	 (ferror nil "no memory board has been selected")))
  (memory-setup (SEND *PROC* :MEM-SLOT))
  )





;-----
;Stuff for debugging with cadrs

(defun nd-bus-write-simple (address data) "used to make diagnostic loops"
       (cond ((= si:processor-type-code si:lambda-type-code)
	      (bus-write address data))
	     (t
	      (set-nd-address-mode-low)
	      (nd-write 1 (low-16-bits data))
	      (nd-write 2 (high-16-bits data))
	      (set-nd-address-mode-high)
	      (nd-write 2 (low-16-bits address))
	      (nd-write 3 (high-16-bits address))
	      (nd-write 1 0)			;start nubus write
	      (dotimes (i 3.)))))		;add a delay to make sure we dont trash
						;the cycle

(defun nd-bus-write-and-repeat-and-wait-for-halt (address data)
  (do-forever
    (set-nd-address-mode-low)
    (nd-write 1 (low-16-bits data))
    (nd-write 2 (high-16-bits data))
    (set-nd-address-mode-high)
    (nd-write 2 (low-16-bits address))
    (nd-write 3 (high-16-bits address))
    (dotimes (x 1000.)
      (nd-write 1 0)
      (dotimes (i 100.)))
    (cond ((or (ldb-test halt-request-bit (read-con-reg))
	       (not (ldb-test enable-sm-clock-bit (read-con-reg))))
	   (return "Halted"))
	  ((send terminal-io :tyi-no-hang)
	   (return "KBD")))
    ))

;********
;defflavor for local-access-path moved to diag-system.

(defmethod (access-path :bus-read-unsafe)
	   (byte-address &optional ignore-bus-errors)
  (send self :bus-quad-slot-read-unsafe
	(ldb (byte 8 24.) byte-address) (logand 77777777 byte-address) ignore-bus-errors))

(defmethod (access-path :bus-read-byte-unsafe)
	   (byte-address &optional ignore-bus-errors)
  (send self :bus-read-byte byte-address ignore-bus-errors))

(defmethod (access-path :bus-quad-slot-read-unsafe)
	   (quad-slot byte-address &optional ignore-bus-errors byte-mode)
  (send self :bus-quad-slot-read quad-slot byte-address ignore-bus-errors byte-mode))

(defmethod (access-path :bus-write-unsafe)
	   (byte-address data &optional ignore-bus-errors)
  (send self :bus-quad-slot-write-unsafe
	(ldb (byte 8 24.) byte-address) (logand 77777777 byte-address) data ignore-bus-errors))

(defmethod (access-path :bus-write-byte-unsafe)
	   (byte-address data &optional ignore-bus-errors)
  (send self :bus-write-byte byte-address data ignore-bus-errors))

(defmethod (access-path :bus-quad-slot-write-unsafe)
	   (quad-slot byte-address data &optional ignore-bus-errors byte-mode)
  (send self :bus-quad-slot-write quad-slot byte-address data ignore-bus-errors byte-mode))

(defmethod (local-access-path :before :init) (&rest ignore)
  (setq safe-local-indexes (make-array 32. :type :art-1b)))

(defmethod (local-access-path :after :init) (&rest ignore)
  (aset 1 safe-local-indexes (send self :slot))
  (dolist (ent (send self :memory-configuration-list))
    (if (not (= (ldb 2204 (cadr ent)) #xF))
	(break "memory not on local bus"))
    (aset 1 safe-local-indexes (ldb 1604 (cadr ent))))
  (aset 1 safe-local-indexes #xF))	;hopefully, SDU ok.

(defmethod (local-access-path :bus-read) (byte-address &optional ignore-bus-errors byte-mode)
  (send self :bus-quad-slot-read (ldb (byte 8 24.) byte-address) (logand 77777777 byte-address)
	ignore-bus-errors byte-mode))

(defmethod (local-access-path :bus-read-byte) (byte-address &optional ignore-bus-errors)
  (send self :bus-quad-slot-read (ldb (byte 8 24.) byte-address) (logand 77777777 byte-address)
	ignore-bus-errors t))

(defmethod (local-access-path :bus-read-byte-unsafe) (byte-address &optional ignore-bus-errors)
  (send self :bus-quad-slot-read-unsafe
	(ldb (byte 8 24.) byte-address)
	(logand 77777777 byte-address)
	ignore-bus-errors t))

(defmethod (local-access-path :bus-slot-read) (slot byte-address &optional ignore-bus-errors byte-mode)
  (send self :bus-quad-slot-read (dpb #xF (byte 4 4.) slot) byte-address
	ignore-bus-errors byte-mode))

(defmethod (local-access-path :bus-slot-read-byte) (slot byte-address &optional ignore-bus-errors)
  (send self :bus-quad-slot-read (dpb #xF (byte 4 4.) slot) byte-address
	ignore-bus-errors t))

(defmethod (local-access-path :bus-slot-read-byte-unsafe)
	   (slot byte-address &optional ignore-bus-errors)
  (send self :bus-quad-slot-read-unsafe (dpb #xF (byte 4 4.) slot) byte-address
	ignore-bus-errors t))

(defmethod (local-access-path :bus-quad-slot-read-byte)
	   (quad-slot byte-address &optional ignore-bus-errors)
  (send self :bus-quad-slot-read quad-slot byte-address	ignore-bus-errors t))

(defmethod (local-access-path :bus-quad-slot-read)
	   (quad-slot byte-address &optional ignore-bus-errors byte-mode)
  ignore-bus-errors
  (cond ((not (= (ldb (byte 4 4) quad-slot) #xF))
	 (ferror nil "not to local bus")))
  (cond ((zerop (aref safe-local-indexes (ldb (byte 4 0) quad-slot)))
	 (ferror nil "The slot ~s (~x) has not been marked as safe"
		 (ldb (byte 4 0) quad-slot)
		 (ldb (byte 4 0) quad-slot))))
  (cond ((null byte-mode)
	 (%nubus-read quad-slot byte-address))
	(t
	 (compiler:%nubus-read-8 quad-slot byte-address))))

(defmethod (local-access-path :bus-quad-slot-read-unsafe)
	   (quad-slot byte-address &optional ignore-bus-errors byte-mode)
  ignore-bus-errors
  (cond ((not (= (ldb (byte 4 4) quad-slot) #xF))
	 (ferror nil "not to local bus")))
  (cond ((null byte-mode)
	 (%nubus-read quad-slot byte-address))
	(t
	 (compiler:%nubus-read-8 quad-slot byte-address))))

(defmethod (local-access-path :bus-write)
   (byte-address data &optional ignore-bus-errors byte-mode)
  (send self :bus-quad-slot-write (ldb (byte 8 24.) byte-address) (logand 77777777 byte-address)
	data ignore-bus-errors byte-mode))

(defmethod (local-access-path :bus-write-byte)
   (byte-address data &optional ignore-bus-errors)
  (send self :bus-quad-slot-write (ldb (byte 8 24.) byte-address) (logand 77777777 byte-address)
	data ignore-bus-errors t))

(defmethod (local-access-path :bus-slot-write)
   (slot byte-address data &optional ignore-bus-errors byte-mode)
  (send self :bus-quad-slot-write (dpb #xF (byte 4 4) slot) byte-address
	data ignore-bus-errors byte-mode))

(defmethod (local-access-path :bus-slot-write-byte)
   (slot byte-address data &optional ignore-bus-errors)
  (send self :bus-quad-slot-write (dpb #xF (byte 4 4) slot) byte-address
	data ignore-bus-errors t))

(defmethod (local-access-path :bus-quad-slot-write-byte)
   (quad-slot byte-address data &optional ignore-bus-errors)
  (send self :bus-quad-slot-write quad-slot byte-address data ignore-bus-errors t))

(defmethod (local-access-path :bus-quad-slot-write)
   (quad-slot byte-address data &optional ignore-bus-errors byte-mode)
  ignore-bus-errors
  (cond ((not (= (ldb (byte 4 4) quad-slot) #xF))
	 (ferror nil "not to local bus")))
  (cond ((zerop (aref safe-local-indexes (ldb (byte 4 0) quad-slot)))
	 (ferror nil "The slot ~s (~x) has not been marked as safe"
		 (ldb (byte 4 0) quad-slot)
		 (ldb (byte 4 0) quad-slot))))
  (cond ((null byte-mode)
	 (%nubus-write quad-slot byte-address data))
	(t
	 (compiler:%nubus-write-8 quad-slot byte-address
			    (ldb (byte 8 (* 8 (ldb (byte 2 0) byte-address)))
				 data)))))

(defmethod (local-access-path :bus-write-byte-unsafe)
   (byte-address data &optional ignore-bus-errors)
  (send self :bus-quad-slot-write-unsafe (ldb (byte 8 24.) byte-address) (logand 77777777 byte-address)
	data ignore-bus-errors t))

(defmethod (local-access-path :bus-slot-write-unsafe)
   (slot byte-address data &optional ignore-bus-errors byte-mode)
  (send self :bus-quad-slot-write-unsafe (dpb #xF (byte 4 4) slot) byte-address
	data ignore-bus-errors byte-mode))

(defmethod (local-access-path :bus-slot-write-byte-unsafe)
   (slot byte-address data &optional ignore-bus-errors)
  (send self :bus-quad-slot-write-unsafe (dpb #xF (byte 4 4) slot) byte-address
	data ignore-bus-errors t))

(defmethod (local-access-path :bus-quad-slot-write-byte-unsafe)
   (quad-slot byte-address data &optional ignore-bus-errors)
  (send self :bus-quad-slot-write-unsafe quad-slot byte-address data ignore-bus-errors t))

(defmethod (local-access-path :bus-quad-slot-write-unsafe)
   (quad-slot byte-address data &optional ignore-bus-errors byte-mode)
  ignore-bus-errors
  (cond ((not (= (ldb (byte 4 4) quad-slot) #xF))
	 (ferror nil "not to local bus")))
  (cond ((null byte-mode)
	 (%nubus-write quad-slot byte-address data))
	(t
	 (compiler:%nubus-write-8 quad-slot byte-address
			    (ldb (byte 8 (* 8 (ldb (byte 2 0) byte-address)))
				 data)))))
	   

(defmethod (local-access-path :multibus-byte-read) (multibus-byte-addr)
  (compiler:%multibus-read-8 multibus-byte-addr))

(defmethod (local-access-path :multibus-byte-write) (multibus-byte-addr data)
  (compiler:%multibus-write-8 multibus-byte-addr data))

(defmethod (local-access-path :multibus-word-read) (multibus-byte-addr)
  (dpb (compiler:%multibus-read-16 (+ multibus-byte-addr 2))
       2020
       (compiler:%multibus-read-16 multibus-byte-addr)))

(defmethod (local-access-path :multibus-word-write) (multibus-byte-addr data)
  (compiler:%multibus-write-16 multibus-byte-addr (ldb 0020 data))
  (compiler:%multibus-write-16 (+ multibus-byte-addr 2) (ldb 2020 data)))

(defmethod (local-access-path :multibus-io-read-16) (port-adr)
  (compiler:%multibus-read-16 (+ 4000000 (ash port-adr 2))))

(defmethod (local-access-path :multibus-io-write-16) (port-adr data)
  (compiler:%multibus-write-16 (+ 4000000 (ash port-adr 2)) data))

;-----
;stuff for lambda with burr-brown to nu-debug  5/22/85  -pace

;2ff00 for first board (currently lam9)  - also for Ken Ks machine
;2fe00 for second board (currently exp1)
;this is set in the function SETUP
(defvar bb-address)


(defsubst bb-drive-data ()
  (si:%nubus-write-8 si:sdu-quad-slot (+ bb-address 2) 7))

(defsubst bb-dont-drive-data ()
  (si:%nubus-write-8 si:sdu-quad-slot (+ bb-address 2) 4))

(defun bb-read-csr ()
  (si:%nubus-read-8 si:sdu-quad-slot (+ bb-address 2)))

(defvar *delay-loops* 0)

(defmacro delay ()
;  `(process-sleep 1 "Nubus delay"))

  `(dotimes (x *delay-loops*)))

;(defmacro delay () ())

(defsubst bb-nd-read (reg)
  (delay)
  (bb-dont-drive-data)
  ;;send the address down
  (si:%nubus-write-8 si:sdu-quad-slot
		     (+ bb-address 6)
		     (+ 0			;not req.l
			4
			(logxor 3 reg)))
  (delay)
  ;;strobe it
  (si:%nubus-write-8 si:sdu-quad-slot
		     (+ bb-address 6)
		     (+ 8			;req.l
			4
			(logxor 3 reg)))
  (delay)
  (prog1
    ;;get data
    (ldb (byte 16. 0) (%nubus-read si:sdu-quad-slot (+ bb-address 4)))
    ;;turn off strobe
    (si:%nubus-write-8 si:sdu-quad-slot
		       (+ bb-address 6)
		       (+ 0
			  4
			  (logxor 3 reg)))
	 ))

(defmacro bb-nd-write-strobe (reg)
  (cond ((numberp reg)
	 `(progn 
	    (si:%nubus-write-8 #xff bb-address-plus-6 ,(+ 8 (logxor 3 reg)))
	    (si:%nubus-write-8 #xff bb-address-plus-6 ,(logxor 3 reg))))
	(t
	 `(let ((inv-reg (logxor 3 ,reg)))
	    (si:%nubus-write-8 #xff bb-address-plus-6 (+ 8 inv-reg))	;req.l
	    (si:%nubus-write-8 #xff bb-address-plus-6 inv-reg)))))
	    
(defmacro bb-nd-write-lo-data-wires (data)
  `(si:%nubus-write-8 #xff bb-address-plus-4 ,data))

(defmacro bb-nd-write-hi-data-wires (data)
  `(si:%nubus-write-8 #xff bb-address-plus-5 ,data))


(defsubst bb-nd-write (reg data)
  (let ((ireg (logxor 3 reg)))
    ;;send address
    (si:%nubus-write-8 si:sdu-quad-slot
		       (+ bb-address 6)
		       (+ 0
			  ireg))
    (si:%nubus-write-8 si:sdu-quad-slot (+ bb-address 4) data)
    (si:%nubus-write-8 si:sdu-quad-slot (+ bb-address 5) (ldb (byte 8 8) data))
    ;;assert data
    (bb-drive-data)

    (delay)

    (let ((bb-address-plus-6 (+ bb-address 6)))
      (bb-nd-write-strobe reg))
;    ;do strobe
;    (si:%nubus-write-8 si:sdu-quad-slot
;		       (+ bb-address 6)
;		       (+ 8			;reg.l
;			  ireg))
;    (delay)
;    (si:%nubus-write-8 si:sdu-quad-slot
;		       (+ bb-address 6)
;		       (+ 0
;			  ireg))
;    (delay)
    ))



;mode reg bits
;
;  0 hi or lo mode
;  1 reset
;  2 byte

;;	mode		address		read		write
;;	0		0		mode reg	mode reg
;;	0		1		nc		low data
;;	0		2		nc		high data
;;	0		3		nc		nc

;;	1		0		mode reg	mode reg
;;	1		1		start read	start write
;;	1		2		low data	low address
;;	1		3		high data	high address

(defun inc ()
  (bb-nd-write 0 0)
  (do-forever
    (dotimes (i 65536.)
      (bb-nd-write 1 i))))

(defun diff ()
  (bb-nd-write 0 0)
  (do-forever
    (bb-nd-write 1 #o4000)
    (bb-nd-write 1 #o5000)
    (bb-nd-write 1 #o1000)
    (bb-nd-write 1 #o0000)))


(defun diff1 ()
  (bb-nd-write 0 0)
  (do-forever
    (bb-nd-write 1 #o0400)
    (bb-nd-write 1 #o2400)
    (bb-nd-write 1 #o2000)
    (bb-nd-write 1 #o0000)))

(defsubst bb-nd-write-data (data)
  (bb-nd-write 0 0)
  (bb-nd-write 1 (ldb (byte 16. 0) data))
  (bb-nd-write 2 (ldb (byte 16. 16.) data)))

(defsubst bb-nd-read-data ()
  (bb-nd-write 0 1)
  (dpb (bb-nd-read 3) (byte 16. 16.) (bb-nd-read 2)))

(defsubst bb-nd-write-adr (adr)
  (bb-nd-write 0 1)
  (bb-nd-write 2 (ldb (byte 16. 0) adr))
  (bb-nd-write 3 (ldb (byte 16. 16.) adr)))

(defsubst bb-nd-start-write ()
  (bb-nd-write 0 5)
  (bb-nd-write 1 0))

(defsubst bb-nd-start-write-byte ()
  (bb-nd-write 0 1)
  (bb-nd-write 1 0))

(defsubst bb-nd-start-read ()
  (bb-nd-write 0 5)
  (bb-nd-read 1))

(defsubst bb-nd-start-read-byte ()
  (bb-nd-write 0 1)
  (bb-nd-read 1))

(defun bb-nd-read-fast-loop (adr)
  (bb-nd-reset)
  (bb-nd-write-adr adr)
  (do-forever
    (bb-nd-start-read)
    (dotimes (i 5.))
    (let ((response (ldb (byte 2 8) (bb-nd-read 0))))
      (case response
	(0 (tyo #/g))
	(1 (tyo #/t))
	(2 (tyo #/p))
	(3)))))

(defun bb-nd-read-fastest-loop (adr)
  (bb-nd-reset)
  (bb-nd-write-adr adr)
  (bb-nd-write 0 5)
  (do-forever
;    (bb-nd-write-adr adr)
;    (bb-nd-start-read)
    (bb-nd-read 1)
 ))

(defun bb-nd-write-fastest-loop (adr data)
  (do-forever 
    (bb-nd-reset)
    (bb-nd-write-data data)
    (bb-nd-write-adr adr)
    (bb-nd-write 0 5)
    (dotimes (i 100000)
      ;    (bb-nd-write-adr adr)
      ;    (bb-nd-start-read)
      (bb-nd-write 1 0)
      )))



(defun bb-nd-write-then-read-fastest-loop (adr data)
  (bb-nd-reset)
  (bb-nd-write-data data)
  (bb-nd-write-adr adr)
  (bb-nd-write 0 5)
  (do-forever
    (bb-nd-write 1 0)
    (bb-nd-read 1)))

(defun fastest-sm-tick-loop ()
  (fastest-tick-loop 4))

(defun fastest-advance-uinst-loop ()
  (fastest-tick-loop 5))

(defun fastest-tick-loop (bit-number)
  (let* ((pmr-adr (dpb (send *proc* :rg-slot) (byte 4 24.) #xf0000040))
	 (pmr-bits (ash (read-pmr) 8.))
	 (byte-one-of-pmr-for-lo-clock (dpb 0 (byte 1 bit-number) (ldb (byte 8 8) pmr-bits)))
	 (byte-one-of-pmr-for-hi-clock (dpb 1 (byte 1 bit-number) (ldb (byte 8 8) pmr-bits)))
	 ;byte 0 of pmr doesn't matter
	 )
    (bb-nd-reset)
    (bb-nd-write-data pmr-bits)
    (bb-nd-write-adr pmr-adr)
    (bb-drive-data)
    (let ((bb-address-plus-4 (+ bb-address 4))
	  (bb-address-plus-5 (+ bb-address 5))
	  (bb-address-plus-6 (+ bb-address 6)))
      (bb-nd-write-lo-data-wires (ldb (byte 8 0) pmr-bits))
      (do-forever
	;;select mode 0
	(bb-nd-write-lo-data-wires 0)
	(bb-nd-write-strobe 0)
	
	;;write into low data 16. bits

	(bb-nd-write-hi-data-wires byte-one-of-pmr-for-lo-clock)
	(bb-nd-write-strobe 1)
	
	;;select mode 1, word mode
	(bb-nd-write-lo-data-wires 5)
	(bb-nd-write-strobe 0)
	
	;;do start write
	(bb-nd-write-strobe 1)
	
	;;select mode 0
	(bb-nd-write-lo-data-wires 0)
	(bb-nd-write-strobe 0)
	
	;;write into low data 16. bits
	(bb-nd-write-hi-data-wires byte-one-of-pmr-for-hi-clock)
	(bb-nd-write-strobe 1)
	
	;;select mode 1, word mode
	(bb-nd-write-lo-data-wires 5)
	(bb-nd-write-strobe 0)
	
	;;do start write
	(bb-nd-write-strobe 1)
	
	))))

(defun bb-nd-bus-read (adr &optional ignore-bus-errors byte-mode
		       &aux loop-until-it-works (start-time (time)))
  ;ignore-bus-errors ->
  ;  NIL  dont ignore anything.
  ;  :IGNORE-TIMEOUT
  ;  :IGNORE-PARITY
  ;  :IGNORE-EXCESSIVE-TRY-AGAIN-LATERS
  ;  T    ignore all
  (prog ()
   retry
      (bb-nd-write-adr adr)
      (if byte-mode
	  (bb-nd-start-read-byte)
	(bb-nd-start-read))
      (dotimes (i 10.))
      (case (ldb (byte 2 8) (bb-nd-read 0))
	(0 ;try again later
	 (cond ((and (null loop-until-it-works)
		     (time-lessp 30. (time-difference (time) start-time)))
		(cond ((memq ignore-bus-errors '(T :IGNORE-EXCESSIVE-TRY-AGAIN-LATERS))
		       (return -1))
		      (t
		       (signal-proceed-case
			 (() 'nubus-timeout
			     "nubus try-again-later too many times: adr #x~16r"
			     adr 'try-again-later)
			 (:retry-bus-cycle
			  (setq start-time (time))
			  (go retry))
			 (:loop-until-it-works
			  (setq loop-until-it-works t)
			  (go retry))
			 (:ignore-bus-error-read (return -1))
			 ))))
	       (t
		(go retry))))
	(1					;bus timeout
	 (cond ((not (null loop-until-it-works))
		(go retry))
	       ((memq ignore-bus-errors '(T :IGNORE-TIMEOUT))
		(return -1))
	       (check-for-nubus-timeouts
		(signal-proceed-case
		  (() 'nubus-timeout
		      "nubus timeout: adr = #x~16r" adr 'nubus-timeout)
		  (:retry-bus-cycle (go retry))
		  (:loop-until-it-works
		   (setq loop-until-it-works t)
		   (go retry))
		  (:ignore-bus-error-read (return -1))
		  ))
	       (t
		(return -1))))
	(2					;parity error
	 (cond ((not (null loop-until-it-works))
		(go retry))
	       ((memq ignore-bus-errors '(T :IGNORE-PARITY))
		(return -1))
	       (check-for-nubus-timeouts
		(signal-proceed-case
		  (() 'nubus-timeout
			       "parity or other nubus error: adr = #x~x" adr 'parity-error)
		  (:retry-bus-cycle (go retry))
		  (:loop-until-it-works
		   (setq loop-until-it-works t)
		   (go retry))
		  (:ignore-bus-error-read (return -1))
		  ))
	       (t
		(return -1))))
	(3					;normal
	 (return (bb-nd-read-data))))))

(defun bb-nd-bus-write (adr data &optional ignore-bus-errors byte-mode
			&aux loop-until-it-works (start-time (time)))
  ;ignore-bus-errors ->
  ;  NIL  dont ignore anything.
  ;  :IGNORE-TIMEOUT
  ;  :IGNORE-PARITY
  ;  :IGNORE-EXCESSIVE-TRY-AGAIN-LATERS
  ;  T    ignore all
  (prog ()
     retry
	(bb-nd-write-adr adr)
	(bb-nd-write-data data)
	(if byte-mode
	    (bb-nd-start-write-byte)
	  (bb-nd-start-write))
	(dotimes (i 10.))
	(case (ldb (byte 2 8) (bb-nd-read 0))
	  (0
	   (cond ((and (null loop-until-it-works)
		       (time-lessp 30. (time-difference (time) start-time)))
		  (cond ((memq ignore-bus-errors '(T :IGNORE-EXCESSIVE-TRY-AGAIN-LATERS))
			 (return -1))
			(t 
			 (signal-proceed-case
			   (() 'nubus-timeout
			       "try-again-later too many times: adr=#x~x)"
			       adr 'try-again-later)
			   (:retry-bus-cycle
			    (setq start-time (time))
			    (go retry))
			   (:loop-until-it-works
			    (setq loop-until-it-works t)
			    (go retry))
			   (:ignore-bus-error (return -1))
			   ))))
		 (t
		  (go retry))))
	  (1					; bus timeout
	   (cond ((not (null loop-until-it-works))
		  (go retry))
		 ((memq ignore-bus-errors '(T :IGNORE-TIMEOUT))
		  (return -1))
		 (check-for-nubus-timeouts
		  (signal-proceed-case
		    (() 'nubus-timeout
			"nubus timeout: adr = #x~x)"
			adr 'nubus-timeout)
		    (:retry-bus-cycle (go retry))
		    (:loop-until-it-works
		     (setq loop-until-it-works t)
		     (go retry))
		    (:ignore-bus-error (return nil))))
		 (t
		  (return nil))))
	  (2					; other bus error - maybe parity
	   (cond ((not (null loop-until-it-works))
		  (go retry))
		 ((memq ignore-bus-errors '(T :IGNORE-PARITY))
		  (return -1))
		 (check-for-nubus-timeouts
		  (signal-proceed-case
		    (() 'nubus-timeout
			"other nubus error (parity?): adr = #x~x)"
			adr 'parity-error)
		    (:retry-bus-cycle (go retry))
		    (:loop-until-it-works
		     (setq loop-until-it-works t)
		     (go retry))
		    (:ignore-bus-error (return nil))))
		 (t
		  (return nil))))
	  (3					; normal
	   (return nil)))))


(defun bb-nd-reset ()
  (bb-nd-write 0 2) ;reset
  (bb-nd-write 0 0)
  (bb-nd-write 0 4)
  (bb-nd-read 0)
  )

(defmethod (nubus-via-burr-brown-and-nu-debug :bus-read)
	   (byte-address &optional ignore-bus-errors byte-mode)
  byte-mode
  (bb-nd-bus-read byte-address ignore-bus-errors))

(defmethod (nubus-via-burr-brown-and-nu-debug :bus-read-byte)
	   (byte-address &optional ignore-bus-errors)
  (let ((data (bb-nd-bus-read byte-address ignore-bus-errors t)))
    (ldb (byte 8 (* (ldb (byte 2 0) byte-address) 8)) data)))


(defmethod (nubus-via-burr-brown-and-nu-debug :bus-slot-read)
	   (slot byte-address &optional ignore-bus-errors byte-mode)
  (bb-nd-bus-read (+ #xf0000000 (ash slot 24.) byte-address) ignore-bus-errors byte-mode))

(defmethod (nubus-via-burr-brown-and-nu-debug :bus-slot-read-byte)
	   (slot byte-address &optional ignore-bus-errors)
  (let ((data (bb-nd-bus-read (+ #xf0000000
				 (ash slot 24.)
				 byte-address)
			      ignore-bus-errors t)))
    (ldb (byte 8 (* (ldb (byte 2 0) byte-address) 8)) data)))

;; Copied from LAD: RELEASE-3.LAMBDA-DIAG; NU-DEBUG.LISP#71 on 2-Oct-86 05:23:25
(defmethod (nubus-via-burr-brown-and-nu-debug :bus-quad-slot-read)
	   (quad-slot byte-address &optional ignore-bus-errors byte-mode)
  (bb-nd-bus-read (dpb quad-slot (byte 8 24.) byte-address) ignore-bus-errors byte-mode))

(defmethod (nubus-via-burr-brown-and-nu-debug :bus-quad-slot-read-byte)
	   (quad-slot byte-address &optional ignore-bus-errors)
  (let ((data (bb-nd-bus-read (dpb quad-slot (byte 8 24.) byte-address)
			      ignore-bus-errors t)))
    (ldb (byte 8 (* (ldb (byte 2 0) byte-address) 8)) data)))    

(defmethod (nubus-via-burr-brown-and-nu-debug :bus-write)
	   (byte-address data &optional ignore-bus-errors byte-mode)
  (bb-nd-bus-write byte-address data ignore-bus-errors byte-mode))

(defmethod (nubus-via-burr-brown-and-nu-debug :bus-write-byte)
	   (byte-address data &optional ignore-bus-errors)
  (bb-nd-bus-write byte-address
		   (dpb data (byte 8 (* (ldb (byte 2 0) byte-address) 8)) 0)
		   ignore-bus-errors t))

(defmethod (nubus-via-burr-brown-and-nu-debug :bus-slot-write)
	   (slot byte-address data &optional ignore-bus-errors byte-mode)
  ignore-bus-errors byte-mode
  (bb-nd-bus-write (+ #xf0000000 (ash slot 24.) byte-address) data))

(defmethod (nubus-via-burr-brown-and-nu-debug :bus-slot-write-byte)
	   (slot byte-address data &optional ignore-bus-errors)
  (bb-nd-bus-write (+ #xf0000000 (ash slot 24.) byte-address)
		   (dpb data (byte 8 (* (ldb (byte 2 0) byte-address) 8)) 0)
		   ignore-bus-errors t))

(defmethod (nubus-via-burr-brown-and-nu-debug :bus-quad-slot-write)
	   (quad-slot byte-address data &optional ignore-bus-errors byte-mode)
  ignore-bus-errors byte-mode
  (bb-nd-bus-write (dpb quad-slot (byte 8 24.) byte-address) data))

(defmethod (nubus-via-burr-brown-and-nu-debug :bus-quad-slot-write-byte)
	   (quad-slot byte-address data &optional ignore-bus-errors)
  (bb-nd-bus-write (dpb quad-slot (byte 8 24.) byte-address)
		   (dpb data (byte 8 (* (ldb (byte 2 0) byte-address) 8)) 0)
		   ignore-bus-errors t))

(defmethod (nubus-via-burr-brown-and-nu-debug :multibus-byte-read) (adr)
  (send self :bus-read-byte (+ adr #xff000000)))

(defmethod (nubus-via-burr-brown-and-nu-debug :multibus-byte-write) (adr data)
  (send self :bus-write-byte (+ adr #xff000000) data))


;**new serial stuff
(defmethod (lmi-serial-access-path :bus-read)
	   (byte-address &optional ignore-bus-errors byte-mode)
  byte-mode
  (bb-nd-bus-read byte-address ignore-bus-errors))

(defmethod (lmi-serial-access-path :bus-read-byte)
	   (byte-address &optional ignore-bus-errors)
  (let ((data (bb-nd-bus-read byte-address ignore-bus-errors t)))
    (ldb (byte 8 (* (ldb (byte 2 0) byte-address) 8)) data)))


(defmethod (lmi-serial-access-path :bus-slot-read)
	   (slot byte-address &optional ignore-bus-errors byte-mode)
  (bb-nd-bus-read (+ #xf0000000 (ash slot 24.) byte-address) ignore-bus-errors byte-mode))

(defmethod (lmi-serial-access-path :bus-slot-read-byte)
	   (slot byte-address &optional ignore-bus-errors)
  (let ((data (bb-nd-bus-read (+ #xf0000000
				 (ash slot 24.)
				 byte-address)
			      ignore-bus-errors t)))
    (ldb (byte 8 (* (ldb (byte 2 0) byte-address) 8)) data)))

(defmethod (lmi-serial-access-path :bus-quad-slot-read)
	   (quad-slot byte-address &optional ignore-bus-errors byte-mode)
  (bb-nd-bus-read (dpb quad-slot (byte 8 24.) byte-address) ignore-bus-errors byte-mode))

(defmethod (lmi-serial-access-path :bus-quad-slot-read-byte)
	   (quad-slot byte-address &optional ignore-bus-errors)
  (let ((data (bb-nd-bus-read (dpb quad-slot (byte 8 24.) byte-address)
			      ignore-bus-errors t)))
    (ldb (byte 8 (* (ldb (byte 2 0) byte-address) 8)) data)))    

(defmethod (lmi-serial-access-path :bus-write)
	   (byte-address data &optional ignore-bus-errors byte-mode)
  ignore-bus-errors byte-mode
  (bb-nd-bus-write byte-address data))

(defmethod (lmi-serial-access-path :bus-write-byte)
	   (byte-address data &optional ignore-bus-errors)
  (bb-nd-bus-write byte-address
		   (dpb data (byte 8 (* (ldb (byte 2 0) byte-address) 8)) 0)
		   ignore-bus-errors t))

(defmethod (lmi-serial-access-path :bus-slot-write)
	   (slot byte-address data &optional ignore-bus-errors byte-mode)
  ignore-bus-errors byte-mode
  (bb-nd-bus-write (+ #xf0000000 (ash slot 24.) byte-address) data))

(defmethod (lmi-serial-access-path :bus-slot-write-byte)
	   (slot byte-address data &optional ignore-bus-errors)
  (bb-nd-bus-write (+ #xf0000000 (ash slot 24.) byte-address)
		   (dpb data (byte 8 (* (ldb (byte 2 0) byte-address) 8)) 0)
		   ignore-bus-errors t))

(defmethod (lmi-serial-access-path :bus-quad-slot-write)
	   (quad-slot byte-address data &optional ignore-bus-errors byte-mode)
  ignore-bus-errors byte-mode
  (bb-nd-bus-write (dpb quad-slot (byte 8 24.) byte-address) data))

(defmethod (lmi-serial-access-path :bus-quad-slot-write-byte)
	   (quad-slot byte-address data &optional ignore-bus-errors)
  (bb-nd-bus-write (dpb quad-slot (byte 8 24.) byte-address)
		   (dpb data (byte 8 (* (ldb (byte 2 0) byte-address) 8)) 0)
		   ignore-bus-errors t))

(defmethod (lmi-serial-access-path :multibus-byte-read) (adr)
  (send self :bus-read-byte (+ adr #xff000000)))

(defmethod (lmi-serial-access-path :multibus-byte-write) (adr data)
  (send self :bus-write-byte (+ adr #xff000000) data))