;;;
;;; sib-keyboard.lisp
;;;
;;; Keyboard emulation on the SIB board.
;;;

(in-package :nevermore)

(declaim (fixnum *sib-keyboard-mode* *sib-keyboard-command* *sib-keyboard-status*))
(defvar *sib-keyboard-mode* 0)
(defvar *sib-keyboard-command* 0)
(defvar *sib-keyboard-status* #x81)
(defvar *sib-keyboard-recv-fifo* ())

(declaim (fixnum *sib-keyboard-poll-interval*))
(defvar *sib-keyboard-poll-interval* 0)

(declaim (fixnum *sib-keyboard-poll-count*))
(defvar *sib-keyboard-poll-count* 0)

(defun sib-keyboard-microcycle-handler ()
  (setf *sib-keyboard-poll-interval* (logand #xffffff (1+ *sib-keyboard-poll-interval*))))

(add-microcycle-hook #'sib-keyboard-microcycle-handler)

(defun sib-keyboard-read-status ()
  #+nil  (format t "Polling interval: ~D~%" *sib-keyboard-poll-interval*)
  (if (< *sib-keyboard-poll-interval* 2000)
      (when (< 4 (incf *sib-keyboard-poll-count*))
	(setf *sib-keyboard-poll-count* 0)
	(format t "Probable keyboard busy-loop.~%")
	(break))
      (setf *sib-keyboard-poll-count* 0))
  (setf *sib-keyboard-poll-interval* 0)
  (logior (logand #x7d *sib-keyboard-status*)
	  (if *sib-keyboard-recv-fifo* 2 0)
	  (if (zerop (logand 8 *sib-keyboard-command*)) 0 #x80)))

(defun sib-keyboard-write-control (data)
  (if (not (zerop (logand #x40 *sib-keyboard-command*)))
      (progn
	(setf *sib-keyboard-recv-fifo* ())
	(setf *sib-keyboard-command* (logand #xbf *sib-keyboard-command*))
	(setf *sib-keyboard-mode* data))
      (setf *sib-keyboard-command* data)))

(defun sib-keyboard-read-data ()
  (if *sib-keyboard-recv-fifo*
      (pop *sib-keyboard-recv-fifo*)
      0))

(defun sib-keyboard-write-data (data)
  (if (/= 0 (logand 8 *sib-diagnostic-control*))
      (push data *sib-keyboard-recv-fifo*)
      (progn
	;; NOTE: Hack to cover keyboard initialization only.
	;; FIXME: Should probably add data bytes to the other end of the fifo.
	(push 0 *sib-keyboard-recv-fifo*)
	;; NOTE: Should be #x70 in order to pass the keyboard tests.
	(push #x70 *sib-keyboard-recv-fifo*))))

(defun sib-keyboard-reset ()
  (setf *sib-keyboard-command* #x40))

;;; EOF
