;;; -*- Mode: Lisp; Package: System-Internals -*-

;;; This file contains functions for interrupt-driven input from
;;; simple Unibus devices.  Note that the keyboard uses the same
;;; mechanism, but does not use these functions, so that this file
;;; need not be in the cold load and to avoid the expense of an
;;; extra wired page all the time for the keyboard buffer.

;;; SI:GET-UNIBUS-CHANNEL interrupt-vector CSR-address CSR-bits data-address n-data-words
;;;	n-data-words can be 1 or 2 (the number of 16-bit words at the data-address)
;;; SI:RETURN-UNIBUS-CHANNEL chan
;;; SI:READ-UNIBUS-CHANNEL chan -> returns 2 values in case n-data-words was 2
;;; SI:UNIBUS-CHANNEL-NOT-EMPTY chan -> T or NIL

;;; The UNIBUS-CHANNEL-QS in QCOM are known about by the microcode.
;;; They are offsets within a wired Unibus-channel data structure.
;;; This code stores such inside wired-down 1-page-long ART-16B arrays.
;;; These indices start at 1 to allow for the presence of an array header.

(DECLARE (SPECIAL UNIBUS-CHANNEL-FREE-LIST))
(OR (BOUNDP 'UNIBUS-CHANNEL-FREE-LIST)
    (SETQ UNIBUS-CHANNEL-FREE-LIST NIL))

;This function is in KBD
;(DEFUN VIRTUAL-UNIBUS-ADDRESS (ADR)
;  (%24-BIT-PLUS (LSH 7740 12.) (LSH ADR -1)))

(DEFUN GET-UNIBUS-CHANNEL (INTERRUPT-VECTOR CSR-ADDRESS CSR-BITS DATA-ADDRESS N-DATA-WORDS
			   &AUX CHAN)
  (CHECK-ARG N-DATA-WORDS (OR (= N-DATA-WORDS 1) (= N-DATA-WORDS 2)) "1 or 2")
  (SETQ CHAN (WITHOUT-INTERRUPTS
	          (OR (POP UNIBUS-CHANNEL-FREE-LIST)
		      (MAKE-ARRAY DISK-BUFFER-AREA ART-16B (* (1- PAGE-SIZE) 2)))))
  (FILLARRAY CHAN '(0))
  (%P-DPB-OFFSET INTERRUPT-VECTOR %%Q-POINTER CHAN %UNIBUS-CHANNEL-VECTOR-ADDRESS)
  (%P-DPB-OFFSET (VIRTUAL-UNIBUS-ADDRESS CSR-ADDRESS) %%Q-POINTER
		 CHAN %UNIBUS-CHANNEL-CSR-ADDRESS)
  (%P-DPB-OFFSET CSR-BITS %%Q-POINTER CHAN %UNIBUS-CHANNEL-CSR-BITS)
  (%P-DPB-OFFSET (VIRTUAL-UNIBUS-ADDRESS DATA-ADDRESS) %%Q-POINTER
		 CHAN %UNIBUS-CHANNEL-DATA-ADDRESS)
  (AND (= N-DATA-WORDS 2)
       (%P-DPB-OFFSET 1 %%Q-FLAG-BIT CHAN %UNIBUS-CHANNEL-DATA-ADDRESS))
  (LET ((BUFFER-START (+ (%POINTER CHAN) 20)) ;leave room for expansion
	(BUFFER-END (+ (%POINTER CHAN) PAGE-SIZE)))
    (%P-DPB-OFFSET BUFFER-START %%Q-POINTER CHAN %UNIBUS-CHANNEL-BUFFER-START)
    (%P-DPB-OFFSET BUFFER-END %%Q-POINTER CHAN %UNIBUS-CHANNEL-BUFFER-END)
    (%P-DPB-OFFSET BUFFER-START %%Q-POINTER CHAN %UNIBUS-CHANNEL-BUFFER-IN-PTR)
    (%P-DPB-OFFSET BUFFER-START %%Q-POINTER CHAN %UNIBUS-CHANNEL-BUFFER-OUT-PTR))
  (WIRE-PAGE CHAN)
  (WITHOUT-INTERRUPTS
       (%P-DPB-OFFSET (SYSTEM-COMMUNICATION-AREA %SYS-COM-UNIBUS-INTERRUPT-LIST)
		      %%Q-POINTER CHAN %UNIBUS-CHANNEL-LINK)
       (STORE (SYSTEM-COMMUNICATION-AREA %SYS-COM-UNIBUS-INTERRUPT-LIST) CHAN))
  CHAN)

(DEFUN RETURN-UNIBUS-CHANNEL (CHAN)
  (AND CHAN
       (WITHOUT-INTERRUPTS
	    (UNWIRE-PAGE CHAN)
	    (DO ((X (%POINTER (SYSTEM-COMMUNICATION-AREA %SYS-COM-UNIBUS-INTERRUPT-LIST))
		    (%P-LDB %%Q-POINTER (+ X %UNIBUS-CHANNEL-LINK)))
		 (P NIL X))
		((ZEROP X))
	      (COND ((= (%POINTER CHAN) X)
		     (COND ((NULL P)
			    (STORE (SYSTEM-COMMUNICATION-AREA %SYS-COM-UNIBUS-INTERRUPT-LIST)
				   (%P-LDB %%Q-POINTER (+ X %UNIBUS-CHANNEL-LINK))))
			   ((%P-DPB (%P-LDB %%Q-POINTER (+ X %UNIBUS-CHANNEL-LINK))
				    %%Q-POINTER (+ P %UNIBUS-CHANNEL-LINK))))
		     (RETURN NIL))))
	    (PUSH CHAN UNIBUS-CHANNEL-FREE-LIST)
	    NIL)))

(DEFUN UNIBUS-CHANNEL-NOT-EMPTY (CHAN)
  (CHECK-ARG CHAN ARRAYP "an array")
  (NEQ (%P-LDB-OFFSET %%Q-POINTER CHAN %UNIBUS-CHANNEL-BUFFER-IN-PTR)
       (%P-LDB-OFFSET %%Q-POINTER CHAN %UNIBUS-CHANNEL-BUFFER-OUT-PTR)))

(DEFUN READ-UNIBUS-CHANNEL (CHAN)
  (AND (UNIBUS-CHANNEL-NOT-EMPTY CHAN)
       (PROG (OUT-PTR VAL1 VAL2)
	 (SETQ OUT-PTR (%P-LDB-OFFSET %%Q-POINTER CHAN %UNIBUS-CHANNEL-BUFFER-OUT-PTR))
	 (SETQ VAL1 (%P-LDB 0020 OUT-PTR) VAL2 (%P-LDB 2020 OUT-PTR))
	 (AND (= (SETQ OUT-PTR (1+ OUT-PTR))
		 (%P-LDB-OFFSET %%Q-POINTER CHAN %UNIBUS-CHANNEL-BUFFER-END))
	      (SETQ OUT-PTR (%P-LDB-OFFSET %%Q-POINTER CHAN %UNIBUS-CHANNEL-BUFFER-START)))
	 (%P-DPB-OFFSET OUT-PTR %%Q-POINTER CHAN %UNIBUS-CHANNEL-BUFFER-OUT-PTR)
	 (RETURN VAL1 VAL2))))