;;; -*- Mode:LISP; Package:SYSTEM-INTERNALS; Base:10; Readtable:ZL -*-

;;; Copyright LISP Machine, Inc. 1984, 1985, 1986
;;;   See filename "Copyright.Text" for
;;; licensing and release information.

;;; this abstracted (i.e. no debugging specify information contained) DEVICE-DRIVER
;;; for the BURR-BROWN parallel port is not yet used by LAMBDA-DIAG.

;;; Abstracting this is a good way to make it practical to give this
;;;  device driver this microcode support.

(DEFFLAVOR BURR-BROWN-DEBUG-MASTER
	 (MULTIBUS-ADDRESS SHARED-DEVICE (CABLE-LENGTH 0))
	 ()
  (:INITABLE-INSTANCE-VARIABLES MULTIBUS-ADDRESS SHARED-DEVICE)
  (:GETTABLE-INSTANCE-VARIABLES MULTIBUS-ADDRESS SHARED-DEVICE))

(DEFVAR *BURR-BROWN-DEVICE-NAME-AND-ADDRESS* NIL)

(defun add-burr-brown-device (name address config-slot)
  (delq (ass #'string-equal name *BURR-BROWN-DEVICE-NAME-AND-ADDRESS*)
	*BURR-BROWN-DEVICE-NAME-AND-ADDRESS*)
  (setq *BURR-BROWN-DEVICE-NAME-AND-ADDRESS*
	(append *BURR-BROWN-DEVICE-NAME-AND-ADDRESS* (list (list name address))))
  (add-shared-device :name name
		   :shared-device-flavor 'shared-device
		   :sys-conf-owner-index config-slot
		   :default-flavor-and-init-options '(burr-brown-debug-master))
  name)

(ADD-BURR-BROWN-DEVICE "BURR-BROWN-DEBUG-MASTER-1" #X2FF00 %SYSTEM-CONFIGURATION-BURR-BROWN-OWNER)

(ADD-BURR-BROWN-DEVICE "BURR-BROWN-DEBUG-MASTER-2" #X2FE00 %SYSTEM-CONFIGURATION-SECOND-BURR-BROWN-OWNER)

(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :AFTER :INIT) (&REST IGNORED)
  (LET* ((NAME (SEND (SEND SHARED-DEVICE :HOST) :NAME))
	 (ADDR (CADR (ASS #'STRING-EQUAL NAME *BURR-BROWN-DEVICE-NAME-AND-ADDRESS*))))
    (WHEN (AND ADDR (NOT (VARIABLE-BOUNDP MULTIBUS-ADDRESS)))
      (SETQ MULTIBUS-ADDRESS ADDR))))

(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :CLOSE) (&OPTIONAL ABORT-P)
  (SEND SHARED-DEVICE :CLOSE ABORT-P))


(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :PRINT-SELF) (STREAM &REST IGNORED)
  (FORMAT STREAM "#<~A>" (SEND (SEND SHARED-DEVICE :HOST) :NAME)))

(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :DRIVE-DATA) ()
  (%NUBUS-WRITE-8 SDU-QUAD-SLOT (+ MULTIBUS-ADDRESS 2) 7))  

(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :DONT-DRIVE-DATA) ()
  (%NUBUS-WRITE-8 SDU-QUAD-SLOT (+ MULTIBUS-ADDRESS 2) 4))


(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :READ-CSR) ()
  (%NUBUS-READ-8 SDU-QUAD-SLOT (+ MULTIBUS-ADDRESS 2)))

(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :DELAY) ()
  (DOTIMES (J CABLE-LENGTH)
    NIL))

(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :READ) (REG)
  (SEND SELF :DELAY)
  (SEND SELF :DONT-DRIVE-DATA)
  ;;send the address down
  (%NUBUS-WRITE-8 SDU-QUAD-SLOT
		  (+ MULTIBUS-ADDRESS 6)
		  (+ 0				;NOT REQ.L
		     4
		     (LOGXOR 3 REG)))
  (SEND SELF :DELAY)
  ;;strobe it
  (%NUBUS-WRITE-8 SDU-QUAD-SLOT
		  (+ MULTIBUS-ADDRESS 6)
		  (+ 8				;REQ.L
		     4
		     (LOGXOR 3 REG)))
  (SEND SELF :DELAY)
  (PROG1
    ;;GET DATA
    (LDB (BYTE 16 0) (%NUBUS-READ SDU-QUAD-SLOT (+ MULTIBUS-ADDRESS 4)))
    ;;turn off strobe
    (%NUBUS-WRITE-8 SDU-QUAD-SLOT
		    (+ MULTIBUS-ADDRESS 6)
		    (+ 0
		       4
		       (LOGXOR 3 REG)))))


(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :WRITE-STROBE) (REG)
  (LET ((INV-REG (LOGXOR 3 REG)))
    (%NUBUS-WRITE-8 #XFF (+ MULTIBUS-ADDRESS 6) (+ 8 INV-REG))	;REQ.L
    (%NUBUS-WRITE-8 #XFF (+ MULTIBUS-ADDRESS 6) INV-REG)))
	    
(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :WRITE-LO-DATA-WIRED) (DATA)
  (%NUBUS-WRITE-8 #XFF (+ MULTIBUS-ADDRESS 4) DATA))

(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :WRITE-HI-DATA-WIRES) (DATA)
  (%NUBUS-WRITE-8 #XFF (+ MULTIBUS-ADDRESS 5) data))


(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :WRITE) (REG DATA)
  (let ((ireg (logxor 3 reg)))
    ;;send address
    (%nubus-write-8 sdu-quad-slot
		    (+ MULTIBUS-ADDRESS 6)
		    (+ 0
		       ireg))
    (%nubus-write-8 sdu-quad-slot (+ MULTIBUS-ADDRESS 4) data)
    (%nubus-write-8 sdu-quad-slot (+ MULTIBUS-ADDRESS 5) (ldb (byte 8 8) data))
    ;;assert data
    (SEND SELF :DRIVE-DATA)
    (SEND SELF :DELAY)
    (SEND SELF :WRITE-STROBE REG)
;    ;do strobe
;    (%nubus-write-8 sdu-quad-slot
;		       (+ MULTIBUS-ADDRESS 6)
;		       (+ 8			;reg.l
;			  ireg))
;    (SEND SELF :DELAY)
;    (%nubus-write-8 sdu-quad-slot
;		       (+ MULTIBUS-ADDRESS 6)
;		       (+ 0
;			  ireg))
;    (SEND SELF :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


;;; SOME DIAGNOSTICS

(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :INC-DIAG) ()
  (SEND SELF :WRITE 0 0)
  (DO-FOREVER
    (DOTIMES (I (EXPT 2 16))
      (SEND SELF :WRITE 1 I))))

(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :DIFF-DIAG) ()
  (SEND SELF :write 0 0)
  (do-forever
    (SEND SELF :write 1 #o4000)
    (SEND SELF :write 1 #o5000)
    (SEND SELF :write 1 #o1000)
    (SEND SELF :write 1 #o0000)))


(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :DIFF1-DIAG) ()
  (SEND SELF :write 0 0)
  (do-forever
    (SEND SELF :write 1 #o0400)
    (SEND SELF :write 1 #o2400)
    (SEND SELF :write 1 #o2000)
    (SEND SELF :write 1 #o0000)))


(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :WRITE-DATA) (DATA)
  (SEND SELF :write 0 0)
  (SEND SELF :write 1 (ldb (byte 16. 0) data))
  (SEND SELF :write 2 (ldb (byte 16. 16.) data)))


(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :READ-DATA) ()
  (SEND SELF :write 0 1)
  (dpb (SEND SELF :read 3) (byte 16. 16.) (SEND SELF :read 2)))


(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :WRITE-ADDR) (ADR)
  (SEND SELF :write 0 1)
  (SEND SELF :write 2 (ldb (byte 16. 0) adr))
  (SEND SELF :write 3 (ldb (byte 16. 16.) adr)))


(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :START-WRITE) ()
  (SEND SELF :write 0 5)
  (SEND SELF :write 1 0))

(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :START-WRITE-BYTE) ()
  (SEND SELF :write 0 1)
  (SEND SELF :write 1 0))

(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :START-READ) ()
  (SEND SELF :write 0 5)
  (SEND SELF :read 1))

(DEFMETHOD (BURR-BROWN-DEBUG-MASTER :START-READ-BYTE) ()
  (SEND SELF :write 0 1)
  (SEND SELF :read 1))

(COMPILE-FLAVOR-METHODS BURR-BROWN-DEBUG-MASTER)