;;; -*- Mode:LISP; Package:LAMBDA; Base:8; Readtable:ZL -*-


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


(defvar nupi-quad-slot #xf2)
(defvar nupi-debug-command-block-address (+ #xf4000000 (* 440 4)))
(defvar nupi-debug-special-event-location (+ nupi-debug-command-block-address (* 4 8)))
(defvar nupi-debug-data-scratch-block #xf4000000)

(defun read-nupi-config-reg ()
  (bus-read (dpb nupi-quad-slot (byte 8 24.) #xe0000b)))

(defun write-nupi-config-reg (data)
  (bus-write (dpb nupi-quad-slot (byte 8 24.) #xe0000b) data))

(defun print-nupi-config (&optional (data (read-nupi-config-reg)))
  (format t "~&RESET ~s" (ldb (byte 1 0) data))
  (format t "~&Enable Bus Master ~s" (ldb (byte 1 1) data))
  (format t "~&Fault LED ~s" (ldb (byte 1 2) data))
  (format t "~&System bus test ~s" (ldb (byte 1 3) data))
  (format t "~&Reserved ~s" (ldb (byte 4 4) data))
  (format t "~&Failure Override ~s" (ldb (byte 1 8) data))
  (format t "~&Undefined ~s" (ldb (byte 7 9) data)))

(defun enable-nupi-bus-master ()
  (write-nupi-config-reg (dpb 1 (byte 1 1) (read-nupi-config-reg))))

;NUPI command block
;
;   off in words  n-bytes
;       0           1       unit-select
;       0           1       spare
;       0           1       options
;       0           1       command
;       1           4       returned status
;       2           4       buffer pointer or param list pointer
;       3           4       transfer count (in bytes) (must be multiple of 4)
;       4           4       device block address
;       5           4       interrupt address
;       6           4       reserved
;       7           4       reserved

(defconst nupi-commands
	  '((#x00 "illegal")
	    (#x41 "formatter set up")
	    (#x81 "NUPI set up")
	    (#x02 "Request device status")
	    (#x42 "Request Formatter Status")
	    (#x82 "Request NUPI Status")
	    (#x10 "Restore Device")
	    (#x11 "Seek")
	    (#x12 "Read")
	    (#x13 "Write")
	    (#x14 "Format")
	    (#x15 "Read to NUPI Buffer")
	    (#x16 "NUPI Buffer to Nubus Transfer")
	    (#x17 "Swap NUPI Buffer and Write")
	    (#x20 "Rewind (tape)")
	    (#x21 "Unload (tape)")
	    (#x22 "Erase (tape)")
	    (#x23 "Space forward (tape)")
	    (#x25 "Write Filemark (tape)")
	    (#x26 "Tape retension")
	    (#x27 "Space forward by filemarks")
	    (#x29 "Skip forward to end of data")
	    (#x2a "Load")
	    (#x2b "Load/unload cmd with bit params")
	    (#x30 "Device selftest")
	    (#x70 "Formatter selftest")
	    (#xb0 "NUPI selftest")
	    (#x71 "SCSI pass through read")
	    (#x72 "SCSI pass through write")
	    ))

(defconst nupi-error-classes '("no error"
			       "self test error"
			       "attention error"
			       "bus related error"
			       "command error"
			       "hardware error"
			       "media error"
			       "reserved error"))

(defconst nupi-controller-errors
	  '((#x61 "nubus time out")
	    (#x62 "nubus bus error")
	    (#x63 "scsi bus parity error")
	    (#x64 "formatter busy")
	    (#x65 "rate error")
	    (#x66 "bus error trap")
	    (#x81 "command aborted")
	    (#x82 "invalid command")
	    (#x83 "invalid parameter")
	    (#x84 "scsi command completed without data transfer")
	    (#x8c "attempted read-and-hold with one pending")
	    (#x8d "attempeted write-and-swap without valid buffer")
	    (#xa1 "illegal interrupt")
	    (#xa2 "scsi function complete without cause")
	    (#xa3 "timeout on NCR 5385 data register full wait")
	    (#xa4 "scsi invalid command interrupt")
	    (#xa6 "hardware error trap")
	    (#xa7 "queue overflow")
	    (#xa8 "address error trap")
	    (#xa9 "illegal instruction error trap")
	    (#xaa "nubus dma locked up")
	    ))

(defconst nupi-device-errors
	  '((#x41 "no selected unit")
	    (#x42 "media not loaded")
	    (#x43 "write protected")
	    (#x44 "offline device now online or media change")
	    (#x46 "temperature fault")
	    (#x47 "invalid media type")
	    (#x48 "status: scsi sense data available")
	    (#x49 "status: tape incorrect length indicate")
	    (#x4a "tape end of media")
	    (#x4b "status: tape incorrect length indicate and end of media")
	    (#x4c "status: tape file mark detected")
	    (#x4d "status: tape incorrect length indicate and file mark detected")
	    (#x4e "status: tape end of media and file mark detected")
	    (#x4f "status: tape incorrect length indicate, end of media, and file mark detected")
	    (#x50 "scsi bus hung needs hardware reset")
	    (#x61 "scsi bus parity error")
	    (#x62 "drive not ready")
	    (#x63 "rate error")
	    (#x64 "invalid scsi interrupt: selected")
	    (#x65 "device offline")
	    (#x66 "invalid scsi testability interrupt")
	    (#x67 "invalid scsi disconnect")
	    (#x68 "invalid mode for scsi status")
	    (#x69 "invalid mode for scsi command byte request")
	    (#x6a "sequence error: scsi completion address")
	    (#x6b "sequence error: scsi requested data")
	    (#x6c "sequence error: dma start/stop address")
	    (#x70 "unknown message received from formatter")
	    (#x71 "invalid mode on scsi message in")
	    (#x72 "excess scsi status")
	    (#x73 "excess scsi command bytes requested")
	    (#x74 "expected scsi restore message but note received")
	    (#x75 "reconnected to unit not waiting for it")
	    (#x76 "expected scsi cmd complete msg; did not receive it")
	    (#x77 "illegal scsi message for reconnected state")
	    (#x78 "reselected without valid scsi id")
	    (#x79 "invalid mode on scsi message out")
	    (#x7a "invalid mode on scsi data transfer")
	    (#x81 "command aborted")
	    (#x82 "invalid command")
	    (#x83 "invalid parameter")
	    (#x84 "illegal block address")
	    (#x85 "volume overflow")
	    (#x8a "formatter failed to connect to scsi bus")
	    (#x8e "unknown error code feturned from the formatter")
	    (#xa1 "missing index signal")
	    (#xa2 "no seek complete")
	    (#xa3 "write fault")
	    (#xa4 "track 0 not found")
	    (#xa5 "multiple units selected")
	    (#xa6 "seek error")
	    (#xa7 "formatter hardware error")
	    (#xc1 "id error")
	    (#xc2 "uncorrectable data error")
	    (#xc3 "id address mark not found")
	    (#xc4 "data address mark not found")
	    (#xc5 "block not found (sector address)")
	    (#xc6 "bad block not found")
	    (#xc7 "format error")
	    (#xc8 "corrrectable data check")
	    (#xc9 "interleave error")
	    (#xca "media error")))

(defun print-exp-command-block ()
  (print-nupi-command-block #xf4000680))

(defun print-nupi-command-block (&optional (adr nupi-debug-command-block-address))
  (let ((command-word (bus-read adr))
	(status (bus-read (+ adr 4)))
	(parameter-list (bus-read (+ adr 8)))
	(transfer-count (bus-read (+ adr 12.)))
	(device-address (bus-read (+ adr 16.)))
	(interrupt-address (bus-read (+ adr 20.)))
	(reserved-1 (bus-read (+ adr 24.)))
	(reserved-2 (bus-read (+ adr 28.)))
	)
    (format t "~&Unit ~s" (ldb (byte 8 0) command-word))
    (format t "~&Spare ~s" (ldb (byte 8 8) command-word))
    (format t "~&Options ~s" (ldb (byte 8 16.) command-word))
    (if (ldb-test (byte 1 20.) command-word) (format t " Swap-partial-completion-interrupt"))
    (if (ldb-test (byte 1 21.) command-word) (format t " device-address-is-physical"))
    (if (ldb-test (byte 1 22.) command-word) (format t " SCATTER"))
    (if (ldb-test (byte 1 23.) command-word) (format t " Interrupt-enable"))
    (format t "~&Command #x~16r ~a" (ldb (byte 8 24.) command-word)
	    (cadr (assq (ldb (byte 8 24.) command-word) nupi-commands)))

    (format t "~&Status ~s" status)
    (format t "~&  Busy ~s" (ldb (byte 1 31.) status))
    (format t "~&  Complete ~s" (ldb (byte 1 30.) status))
    (format t "~&  Error ~s" (ldb (byte 1 29.) status))
    (format t "~&  Retries required ~s" (ldb (byte 1 28.) status))
    (format t "~&  Aux status available ~s" (ldb (byte 1 27.) status))
    (format t "~&  Paging partial completion ~s" (ldb (byte 1 26.) status))
    (format t "~&  spare ~s" (ldb (byte 2 24.) status))
    (let ((error (ldb (byte 8 16.) status)))
      (format t "~&  controller error #x~x" error)
      (when (not (zerop error))
	(format t "  Class: /"~a/"" (nth (ldb (byte 3 21.) status) nupi-error-classes))
	(format t "  ~a" (cadr (assq error nupi-controller-errors)))
	))

    (let ((error (ldb (byte 8 8) status)))
      (format t "~&  device error ~s" error)
      (when (not (zerop error))
	(format t "  Class /"~a/"" (nth (ldb (byte 3 13.) status) nupi-error-classes))
	(format t "  ~a " (cadr (assq error nupi-device-errors)))
	))
    (format t "~&  spare ~s" (ldb (byte 3 5) status))
    (format t "~&  ECC applied ~s" (ldb (byte 1 4) status))
    (format t "~&  n-retries ~s" (ldb (byte 3 0) status))

    (format t "~&parameter-list #x~16r" parameter-list)

    (format t "~&Transfer count ~d." transfer-count)
    (format t "~&Device block address ~s" device-address)
    (format t "~&Interrupt address #x~16r" interrupt-address)
    (format t "~&Reserved ~s ~s" reserved-1 reserved-2)))

(defun make-nupi-command-block (nubus-address
				command
				options
				unit-select
				parameter-list-pointer
				transfer-count
				device-block-address
				interrupt-address
				)
  (bus-write nubus-address (+ unit-select
				 (ash options 16.)
				 (ash command 24.)))
  (bus-write (+ nubus-address 4) 0)		;status
  (bus-write (+ nubus-address 8) parameter-list-pointer)
  (bus-write (+ nubus-address 12.) transfer-count)
  (bus-write (+ nubus-address 16.) device-block-address)
  (bus-write (+ nubus-address 20.) interrupt-address)
  (bus-write (+ nubus-address 24.) 0)
  (bus-write (+ nubus-address 28.) 0))


(defun read-nupi-extended-status ()
  (make-nupi-command-block nupi-debug-command-block-address
			   #x82
			   0
			   0
			   nupi-debug-data-scratch-block
			   (* (+ 21. 2) 4)
			   0
			   0)
  (execute-nupi-command nupi-debug-command-block-address)
  (wait-for-nupi-command-complete))

(defun print-nupi-extended-status (&optional verbose)
  (read-nupi-extended-status)
  (let ((data (bus-read nupi-debug-data-scratch-block)))
    (format t "~&NUPI flags ~s " data)
    (if (ldb-test (byte 1 0) data) (format t "~&  nubus error fetching command block"))
    (if (ldb-test (byte 1 1) data) (format t "~&  overtemperature in brick"))
    (if (ldb-test (byte 1 2) data) (format t "~&  illegal nubus access to NUPI"))
    (if (ldb-test (byte 1 3) data) (format t "~&  Multiple commands sent illegally"))
    (if (ldb-test (byte 1 4) data) (format t "~&  Illegal command or command block"))
    (if (ldb-test (byte 1 5) data) (format t "~&  power fail"))
    (if (ldb-test (byte 1 6) data)
	(format t "~&  command aborted with no nubus command block updates"))
    (if (ldb-test (byte 1 7) data) (format t "~&  Nubus interrupt taken without cause"))
    (if (ldb-test (byte 1 8) data) (format t "~&  invalid special event interrupt address"))
    (if (ldb-test (byte 1 9) data) (format t "~&  NUPI hardware or software error"))
    (if (ldb-test (byte 1 10.) data) (format t "~&  invalid scsi bus operation"))
    (if (not (zerop (ldb (byte 20. 11.) data)))
	(format t "~&  Spares: ~s" (ldb (byte 5 11.) data)))
    (if (ldb-test (byte 1 31.) data) (format t "~&  NUPI has buffer")))
  
  (when verbose
    (format t "~&Last self test data ~s" (bus-read (+ nupi-debug-data-scratch-block 4)))
    
    (flet ((convert (n) (if (< n 5) n (1+ n))))
      (dotimes (n 21.)
	(if (< n 7)
	    (format t "~&Formatter ~d" (convert n))
	  (format t "~&Formatter ~d Unit ~d"
		  (convert (truncate (- n 7) 2)) (ldb (byte 1 0) (- n 7))))
	(describe-scsi-extended-status (bus-read (+ nupi-debug-data-scratch-block
						       8
						       (* n 4))))))
    
    ))

(deff nupi-status 'print-nupi-extended-status)

(defun describe-scsi-extended-status (data)
  (format t "~&    Device type ~a" (nth (ldb (byte 3 29.) data)
					'("unknown" "quarter inch tape"
					  "disk" "printer" "write once optical disk"
					  "read only optical disk" "floppy" "undefined")))
  (format t "~&    Offline ~s" (ldb (byte 1 28.) data))
  (format t "~&    error status available ~s" (ldb (byte 1 27.) data))
  (format t "~&    self test failed ~s" (ldb (byte 1 26.) data))
  (format t "~&    overtemperature ~s" (ldb (byte 1 25.) data))
  (format t "~&    write protected ~s" (ldb (byte 1 24.) data))
  (format t "~&    indeterminate device status ~s" (ldb (byte 1 23.) data))
  (format t "~&    unit attention (newly online or media change) ~s" (ldb (byte 1 22.) data))
  (format t "~&    not ready ~s" (ldb (byte 1 21.) data))
  (format t "~&    reserved ~s" (ldb (byte 5 16.) data))
  (format t "~&    last command ~16r ~a" (ldb (byte 8 8) data)
	  (cadr (assq (ldb (byte 8 8) data) nupi-commands)))
  (format t "~&    last options ~s" (ldb (byte 8 0) data)))

(defun execute-nupi-command (&optional (nubus-address nupi-debug-command-block-address))
  (bus-write nupi-debug-special-event-location 0)
  (bus-write (dpb nupi-quad-slot (byte 8 24.) #xe00004) nubus-address))

(defun wait-for-nupi-command-complete (&optional
				       (adr nupi-debug-command-block-address)
				       (check-for-error t))
  (let ((status 0)
	(special-event 0))
    (do ((end-time (%pointer-plus (time) (* 60. 5))))
	((or (ldb-test (byte 1 30.) status)
	     (not (zerop special-event))))
      (if (time-lessp end-time (time))
	  (ferror nil "disk timeout"))
      (setq status (bus-read (+ adr 4)))
      (setq special-event (bus-read nupi-debug-special-event-location))
      )
    (when check-for-error
      (cond ((ldb-test (byte 1 29.) status)
	     (cerror :no-action nil nil "error in command block"))
	    ((not (zerop special-event))
	     (cerror :no-action nil nil "error in command block (special status available)"))))
    )
  )

;returns a list of fixnums suitable as unit arguments
;  (byte 3 0) is unit number (only 0 and 1 supported)
;  (byte 3 3) is formatter number (0 - 7 except 5)
;  (byte 2 6) unused
(defun find-nupi-disks (&aux result)
  ;skip first word - just status stuff
  ;skip second word - self test stuff
  ;skip next 7 - formatter status
  (read-nupi-extended-status)
  (dotimes (i 14.)
    (flet ((convert (n) (if (< n 5) n (1+ n))))
      (let ((status (bus-read (+ nupi-debug-data-scratch-block
				    (* 9 4)
				    (* i 4)))))
	(cond ((and (= (ldb (byte 3 29.) status) 2)	;type disk
		    (= (ldb (byte 1 28.) status) 0))	;offline = false
	       (push (dpb (convert (floor i 2))
			  (byte 3 3)
			  (ldb (byte 1 0) i))
		     result))))))
  (reverse result))

(defun nupi-read (unit logical-block phys-page n-blocks)
  (make-nupi-command-block nupi-debug-command-block-address
			   #x12
			   0
			   unit
			   (ash (cadr-page-to-nubus-page phys-page) 10.)
			   (* n-blocks 1024.)
			   logical-block
			   0)
  (execute-nupi-command)
  (wait-for-nupi-command-complete)
  )

(defun nupi-write (unit logical-block phys-page n-blocks)
  (make-nupi-command-block nupi-debug-command-block-address
			   #x13
			   0
			   unit
			   (ash (cadr-page-to-nubus-page phys-page) 10.)
			   (* n-blocks 1024.)
			   logical-block
			   0)
  (execute-nupi-command)
  (wait-for-nupi-command-complete)
  )

(defun nupi-reset ()
  (bus-write nupi-quad-slot #xe0000b 1))

(defun nupi-setup ()
  (bus-write nupi-debug-special-event-location 0)
  (bus-write nupi-debug-data-scratch-block nupi-debug-special-event-location)
  (make-nupi-command-block nupi-debug-command-block-address
			   #x81
			   0
			   0
			   nupi-debug-data-scratch-block
			   4
			   0
			   0)
  (execute-nupi-command)
  (wait-for-nupi-command-complete))

;---
;(defun exp-disk-init ()
;  ;this usually figures out the disk parameters, but we can only use
;  ;logical block numbers with the NUPI anyway...
; ;  (setq lam-disk-type t)
;  )

;(defun exp-disk-write (&rest ignore)
;  (ferror nil "this has never been tested")
;  nil)

;(defun exp-disk-read (logical-block phys-page n-blocks)
;  (declare (special si:lam-disk-unit))
;  (nupi-read si:lam-disk-unit logical-block phys-page n-blocks))