;;;
;;; raven-nubus.lisp
;;;
;;; NuBus interface emulation.
;;;

(in-package :nevermore)

(defun nubus-read (slot address width)
  "Read from NuBus space at ADDRESS with WIDTH either :BYTE or :WORD. Sets *nubus-error* to T if memory not mapped, otherwise sets (aref *memory-data*) to the requisite value."
  (declare (type (unsigned-byte 8) slot)
	   (type (unsigned-byte 24) address))

  (setf *page-fault* nil)
  (setf *nubus-error* nil)
  (when (zerop (logand #x100 *machine-control-register*))
    ;; Memory cycle disabled.
    (setf *memory-busy* 0)
    (return-from nubus-read))
  ;; Memory busy should remain high for three cycles after this one.
  ;; Memory busy counter is decremented at the end of the cycle, so we
  ;; have to account for this one as well.
  (setf *memory-busy* 4)

  (let ((*inhibit-nubus-trace* *inhibit-nubus-trace*))
    (if (= (ldb (byte 4 4) slot) #xf)
	(let ((slot-id (ldb (byte 4 0) slot)))
	  (cond ((= slot-id *cpu-nubus-slot*) (cpu-nubus-read slot address width))
		((= slot-id *sib-nubus-slot*) (sib-nubus-read slot address width))
		((= slot-id *mem-nubus-slot*) (memory-nubus-read slot address width))
		(t (setf *nubus-error* t))))
	(setf *nubus-error* t))
    (when (or *nubus-error* (not *inhibit-nubus-trace*))
      (format t "~AReading NuBus Address ~X ~X~%" (if (eq width :byte) "Byte " "") slot address)))
  (values))

(defun nubus-write (slot address width)
  "Write (aref *memory-data*) to NuBus space at ADDRESS with WIDTH either :BYTE or :WORD. Sets *nubus-error* to T if memory not mapped."
  (declare (type (unsigned-byte 8) slot)
	   (type (unsigned-byte 24) address))

  (setf *page-fault* nil)
  (setf *nubus-error* nil)
  (when (zerop (logand #x100 *machine-control-register*))
    ;; Memory cycle disabled.
    (setf *memory-busy* 0)
    (return-from nubus-write))
  ;; Memory busy should remain high for three cycles after this one.
  ;; Memory busy counter is decremented at the end of the cycle, so we
  ;; have to account for this one as well.
  (setf *memory-busy* 4)

  (let ((*inhibit-nubus-trace* *inhibit-nubus-trace*))
    (if (= (ldb (byte 4 4) slot) #xf)
	(let ((slot-id (ldb (byte 4 0) slot)))
	  (cond ((= slot-id *cpu-nubus-slot*) (cpu-nubus-write slot address width))
		((= slot-id *sib-nubus-slot*) (sib-nubus-write slot address width))
		((= slot-id *mem-nubus-slot*) (memory-nubus-write slot address width))
		(t (setf *nubus-error* t))))
	(setf *nubus-error* t))
    (when (or *nubus-error* (not *inhibit-nubus-trace*))
      (format t "~AWriting NuBus Address ~X ~X: ~X~%" (if (eq width :byte) "Byte " "") slot address (aref *memory-data*))))
  (values))

(declaim (inline start-unmapped-read))
(defun start-unmapped-read (address)
  (nubus-read (ldb (byte 8 24) address) (ldb (byte 24 0) address) :word))

(declaim (inline start-unmapped-write))
(defun start-unmapped-write (address)
  (nubus-write (ldb (byte 8 24) address) (ldb (byte 24 0) address) :word))

(declaim (inline start-unmapped-byte-read))
(defun start-unmapped-byte-read (address)
  (nubus-read (ldb (byte 8 24) address) (ldb (byte 24 0) address) :byte))

(declaim (inline start-unmapped-byte-write))
(defun start-unmapped-byte-write (address)
  (nubus-write (ldb (byte 8 24) address) (ldb (byte 24 0) address) :byte))


;;; EOF
