;;;
;;; raven-cpu-nubus.lisp
;;;
;;; CPU NuBus slot space handlers.
;;;

(in-package :nevermore)

(declaim (fixnum *interrupt-sources*))
(defvar *interrupt-sources* 0
  "A bitmask of enabled interrupt sources")

(declaim (type (integer 0 15) *current-interrupt-level*))
(defvar *current-interrupt-level* 0
  "Highest-priority active interrupt source or 0")

(defun check-interrupt-status ()
  (setf *current-interrupt-level* 0)
  (dotimes (i 16)
    (unless (zerop (ldb (byte 1 (- 15 i)) *interrupt-sources*))
      (setf *current-interrupt-level* (- 15 i))))
  (if (or (zerop *current-interrupt-level*)
	  (zerop (logand #x8000 *machine-control-register*)))
      (setf *interrupt-pending* nil)
    (setf *interrupt-pending* t)))

(defun cpu-nubus-read (slot address width)
  (declare (type (unsigned-byte 8) slot)
	   (type (unsigned-byte 24) address)
	   (ignorable slot width))
  (cond ((= address #xc00000)
	 (if (= #x80 (logand #x80 *machine-control-register*))
	     (setf (aref *memory-data*) #x3)
	   (setf (aref *memory-data*) #x7)))))

(defun cpu-nubus-write (slot address width)
  (declare (type (unsigned-byte 8) slot)
	   (type (unsigned-byte 24) address)
	   (ignorable slot width))
  (cond ((= (logand address #xffffc3) #xe00000)
	 ;; Interrupt control
	 (let ((interrupt-number (ldb (byte 4 2) address)))
	   (if (zerop (logand 1 (aref *memory-data*)))
	       (setf *interrupt-sources* (logand *interrupt-sources* (dpb 0 (byte 1 interrupt-number) #xffff)))
	     (setf *interrupt-sources* (logior *interrupt-sources* (dpb 1 (byte 1 interrupt-number) 0)))))
	 (check-interrupt-status))))


;;; EOF