;;; -*- Mode: Common-LISP; Package: SYSTEM-INTERNALS; Base:10.; COLD-LOAD: T -*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1985-1989 Texas Instruments Incorporated. All rights reserved.
;;; Functions needed to monitor requests.

;;;
;;; Edit History
;;;
;;;                   Patch
;;;   Date    Author  Number   Description
;;;---------------------------------------------------------------------------
;;; 04-20-89 DAB               Added support for NP2.
;;; 01-30-86   ab       --     Common Lisp conversion for VM2.
;;;                            This file was formerly called DISKDEFS.
;;;                            ASET => (setf (aref .. ) ..)
;;;                            DefConst => DefParameter
;;;                            Integrated Austin changes to Error-Status-List
;;; 10-15-86   ab       --     Changes for 2K page-size.
;;;                            Added new RQB accessors. 
;;; 02-17-87   DAB      --     Change to base 10.
;;; 01-13-87   ab              Additions for MX.
;;; 08/29/88   ab    D-IO 5-1  Additions for mX dynamic partition support.

;;; Return true if the request busy bit is set.
(PROCLAIM '(inline %io-busy))
(DEFUN %IO-BUSY (RQB)
  (LDB-TEST %%IO-RQ-BUSY (AREF RQB %IO-RQ-INFORMATION))) 

;;; Return true if the request complete bit is set.
(PROCLAIM '(inline %io-done))
(DEFUN %IO-DONE (RQB)
  (LDB-TEST %%IO-RQ-DONE (AREF RQB %IO-RQ-INFORMATION)))


(PROCLAIM '(inline wait-io-done))
(DEFUN WAIT-IO-DONE (RQB &OPTIONAL WHOSTATE (IF-TYPE :NPI))
  (OR WHOSTATE (SETF WHOSTATE
                     (case IF-TYPE
		       (:NPI "Nupi")
		       (:NPE "NupE")
		       (:MSC "MSC ")
		       (:NP2 "Nup2")  ; DAB 04-19-89
		       (T "Nupi"))))
  (PROCESS-WAIT WHOSTATE (FUNCTION %IO-DONE) RQB))

(PROCLAIM '(inline wait-io-done-with-timeout))
(DEFUN WAIT-IO-DONE-WITH-TIMEOUT (RQB INTERVAL-IN-60THS &OPTIONAL WHOSTATE (IF-TYPE :NPI))
  (OR WHOSTATE (SETF WHOSTATE
                     (case IF-TYPE
		       (:NPI "Nupi")
		       (:NPE "NupE")
		       (:MSC "MSC ")
		       (:NP2 "Nup2")  ; DAB 04-19-89
		       (T "Nupi"))))
  (PROCESS-WAIT-WITH-TIMEOUT WHOSTATE INTERVAL-IN-60THS (FUNCTION %IO-DONE) RQB)) 

(DEFSUBST MSC-IO-DONE (RQB)
  (LDB-TEST %%IO-RQ-DONE-MSC (AREF RQB %IO-RQ-INFORMATION-MSC)))

(DEFUN WAIT-MSC-IO-DONE (RQB &OPTIONAL WHOSTATE)
  (PROCESS-WAIT (OR WHOSTATE "MSC")
                (FUNCTION MSC-IO-DONE)
                RQB))

(DEFMACRO WITH-RQB ((VAR FORM) &BODY BODY)
  `(LET (,VAR)
     (UNWIND-PROTECT (PROGN
		      (SETQ ,VAR ,FORM)
		      ,@BODY)
       (RETURN-DISK-RQB ,VAR)))) 

(PROCLAIM '(inline get-disk-fixnum))
(DEFUN GET-DISK-FIXNUM (RQB WORD-ADDRESS)
  "Return the contents of data word WORD-ADDRESS in RQB, as a number."
  (DPB (AREF (RQB-BUFFER RQB) (1+ (* 2. WORD-ADDRESS)))
       %%Q-HIGH-HALF
       (AREF (RQB-BUFFER RQB) (* 2. WORD-ADDRESS)))) 

(PROCLAIM '(inline put-disk-fixnum))
(DEFUN PUT-DISK-FIXNUM (RQB VAL WORD-ADDRESS)
  "Store VAL into data word WORD-ADDRESS of RQB."
  (SETF (AREF (RQB-BUFFER RQB) (* 2. WORD-ADDRESS))
	(LDB %%Q-LOW-HALF VAL))
  (SETF (AREF (RQB-BUFFER RQB) (1+ (* 2. WORD-ADDRESS)))
	(LDB %%Q-HIGH-HALF VAL))) 

;; Added doc strings for new errors. 8/30/85, -ab
(DEFPARAMETER ERROR-STATUS-LIST
   `((,%%NUPI-ERROR-STATUS-NUBUS-ERROR
      "Unrecoverable NuBus error on fetching the command block.")
     (,%%NUPI-ERROR-STATUS-OVERTEMPERATURE
      "Over temperature detected in a mass storage chassis.")
     (,%%NUPI-ERROR-STATUS-ILLEGAL-ACCESS "Illegal access to NuPI control space from the NuBus.")
     (,%%NUPI-ERROR-STATUS-MULTIPLE-COMMANDS
      "Multiple commands issued to a specific device, formatter, or NuPI.")
     (,%%NUPI-ERROR-STATUS-ILLEGAL-COMMAND "Illegal command or command block.")
     (,%%NUPI-ERROR-STATUS-UNUSED "Unused.")
     (,%%NUPI-ERROR-STATUS-COMMAND-ABORTED
      "Command aborted with no NuBus command block updates.")
     (,%%NUPI-ERROR-STATUS-ILLEGAL-INTERRUPT "Illegal NuBus Interrupt.")
     (,%%NUPI-ERROR-STATUS-BAD-EVENT-ADDRESS "Bad Special Event posting address.")
     (,%%NUPI-ERROR-STATUS-HARDWARE-ERROR "NuPI internal hardware error.")
     (,%%NUPI-ERROR-STATUS-BAD-SCSI-COMMAND "Bad SCSI command.")
     (,%%NUPI-ERROR-STATUS-RESERVED-BUFFER "Buffer reserved for Swap Command.")))



;;;  
;;; RQB Leader Accessors
;;;

;; Here are the leader fields (from QDEV):
;;(DefEnum IO-RQ-Leader-Qs (Q-CORRESPONDING-VARIABLE-LISTS
;;			   System-Constant-Lists)
;;    (%IO-RQ-Leader-N-Half-Words
;;     %IO-RQ-Leader-N-Pages 
;;     %IO-RQ-Leader-Buffer
;;     %IO-RQ-Leader-8-Bit-Buffer
;;     %IO-RQ-LEADER-N-PAGES-WIRED)
;;  )


(PROCLAIM '(inline rqb-n-half-words))
(DEFUN RQB-N-HALF-WORDS (RQB)
  (ARRAY-LEADER RQB %IO-RQ-LEADER-N-HALF-WORDS))  

(PROCLAIM '(inline set-rqb-n-half-words))
(DEFUN set-rqb-n-half-words (rqb value)
  (SETF (ARRAY-LEADER rqb %IO-RQ-Leader-N-Half-Words) value))

(DEFSETF rqb-n-half-words set-rqb-n-half-words)


(PROCLAIM '(inline rqb-n-blocks))
(DEFUN RQB-N-BLOCKS (RQB)
  "Returns the data length of RQB, in blocks."
  (ARRAY-LEADER RQB %IO-RQ-LEADER-N-BLOCKS))  

(PROCLAIM '(inline set-rqb-n-blocks))
(DEFUN set-rqb-n-blocks (rqb value)
  (SETF (ARRAY-LEADER rqb %IO-RQ-Leader-N-Blocks) value))

(DEFSETF rqb-n-blocks set-rqb-n-blocks)

(DEFF rqb-npages 'rqb-n-blocks)
(DEFF rqb-nblocks 'rqb-n-blocks)
;;(make-obsolete rqb-npages rqb-nblocks)


(PROCLAIM '(inline rqb-buffer))
(DEFUN RQB-BUFFER (RQB)
  "Returns a 16-bit array whose contents are the data in RQB.
This is an indirect array which overlaps the appropriate portion of RQB."
  (ARRAY-LEADER RQB %IO-RQ-LEADER-BUFFER))  

(PROCLAIM '(inline set-rqb-buffer))
(DEFUN set-rqb-buffer (rqb value)
  (SETF (ARRAY-LEADER rqb %IO-RQ-Leader-Buffer) value))

(DEFSETF rqb-buffer set-rqb-buffer)


(PROCLAIM '(inline rqb-8-bit-buffer))
(DEFUN RQB-8-BIT-BUFFER (RQB)
  "Returns an 8-bit array whose contents are the data in RQB.
This is an indirect array which overlaps the appropriate portion of RQB."
  (ARRAY-LEADER RQB %IO-RQ-LEADER-8-BIT-BUFFER))  

(PROCLAIM '(inline set-rqb-8-bit-buffer))
(DEFUN set-rqb-8-bit-buffer (rqb value)
  (SETF (ARRAY-LEADER rqb %IO-RQ-Leader-8-Bit-Buffer) value))

(DEFSETF rqb-8-bit-buffer set-rqb-8-bit-buffer)


(PROCLAIM '(inline rqb-n-blocks-wired))
(DEFUN RQB-N-BLOCKS-WIRED (RQB)
  (ARRAY-LEADER RQB %IO-RQ-LEADER-N-BLOCKS-WIRED))

(PROCLAIM '(inline set-rqb-n-blocks-wired))
(DEFUN set-rqb-n-blocks-wired (rqb value)
  (SETF (ARRAY-LEADER rqb %IO-RQ-Leader-n-blocks-wired) value))

(DEFSETF rqb-n-blocks-wired set-rqb-n-blocks-wired)


;;;
;;; RQB Command Block Accessors
;;;

;; Here are the Command block fields (from QDEV):
;;(DefEnum IO-RQ-WDS (Q-CORRESPONDING-VARIABLE-LISTS
;;		     System-Constant-Lists)
;;    (%IO-RQ-Link-Word
;;     %IO-RQ-Information-Word
;;     %IO-RQ-Command-Word
;;     %IO-RQ-Status-Word
;;     %IO-RQ-Buffer-Word
;;     %IO-RQ-Transfer-Length-Word
;;     %IO-RQ-Device-Address-Word
;;     %IO-RQ-Event-Address-Word
;;     %IO-RQ-Spare-1-Word
;;     %IO-RQ-Spare-2-Word
;;     %IO-RQ-Parameter-List-Word)
;;  )

(PROCLAIM '(inline rq-link))
(DEFUN rq-link (rqb)
  (get-16b-array-word rqb %IO-RQ-Link-Word))

(PROCLAIM '(inline set-rq-link))
(DEFUN set-rq-link (rqb value)
  (SETF (get-16b-array-word rqb %IO-RQ-Link-Word) value))

(DEFSETF rq-link set-rq-link)


(PROCLAIM '(inline rq-information))
(DEFUN rq-information (rqb)
  (get-16b-array-word rqb %IO-RQ-Information-Word))

(PROCLAIM '(inline set-rq-information))
(DEFUN set-rq-information (rqb value)
  (SETF (get-16b-array-word rqb  %IO-RQ-Information-Word) value))

(DEFSETF rq-information set-rq-information)

(PROCLAIM '(inline rq-command))
(DEFUN rq-command (rqb)
  (get-16b-array-word rqb %IO-RQ-Command-Word))

(PROCLAIM '(inline set-rq-command))
(DEFUN set-rq-command (rqb value)
  (SETF (get-16b-array-word rqb %IO-RQ-Command-Word) value))

(DEFSETF rq-command set-rq-command)


(PROCLAIM '(inline rq-status))
(DEFUN rq-status (rqb)
  (get-16b-array-word rqb %IO-RQ-Status-Word))

(PROCLAIM '(inline set-rq-status))
(DEFUN set-rq-status (rqb value)
  (SETF (get-16b-array-word rqb %IO-RQ-Status-Word) value))

(DEFSETF rq-status set-rq-status)


(PROCLAIM '(inline rq-buffer))
(DEFUN rq-buffer (rqb)
  (get-16b-array-word rqb %IO-RQ-Buffer-Word))

(PROCLAIM '(inline set-rq-buffer))
(DEFUN set-rq-buffer (rqb value)
  (SETF (get-16b-array-word rqb %IO-RQ-Buffer-Word) value))

(DEFSETF rq-buffer set-rq-buffer) 


(PROCLAIM '(inline rq-transfer-length))
(DEFUN rq-transfer-length (rqb)
  (get-16b-array-word rqb %IO-RQ-Transfer-Length-Word))

(PROCLAIM '(inline set-rq-transfer-length))
(DEFUN set-rq-transfer-length (rqb value)
  (SETF (get-16b-array-word rqb %IO-RQ-Transfer-length-Word) value))

(DEFSETF rq-transfer-length set-rq-transfer-length)


(PROCLAIM '(inline rq-device-address))
(DEFUN rq-device-address (rqb)
  (get-16b-array-word rqb %IO-RQ-Device-Address-Word))

(PROCLAIM '(inline set-rq-device-address))
(DEFUN set-rq-device-address (rqb value)
  (SETF (get-16b-array-word rqb %IO-RQ-Device-address-Word) value))

(DEFSETF rq-device-address set-rq-device-address)


(PROCLAIM '(inline rq-event-address))
(DEFUN rq-event-address (rqb)
  (get-16b-array-word rqb %IO-RQ-Event-Address-Word))

(PROCLAIM '(inline set-rq-event-address))
(DEFUN set-rq-event-address (rqb value)
  (SETF (get-16b-array-word rqb %IO-RQ-Event-address-Word) value))

(DEFSETF rq-event-address set-rq-event-address)


(PROCLAIM '(inline rq-scatter-entry-address))
(DEFUN rq-scatter-entry-address (rqb entry)
  (get-16b-array-word rqb (+ %IO-RQ-Parameter-List-Word (* 2 entry))))

(PROCLAIM '(inline set-rq-scatter-entry-address))
(DEFUN set-rq-scatter-entry-address (rqb entry value)
  (SETF (get-16b-array-word rqb (+ %IO-RQ-Parameter-List-Word (* 2 entry)))
	value))

(DEFSETF rq-scatter-entry-address set-rq-scatter-entry-address)


(PROCLAIM '(inline rq-scatter-entry-bytes))
(DEFUN rq-scatter-entry-bytes (rqb entry)
  (get-16b-array-word rqb (+ %IO-RQ-Parameter-List-Word (1+ (* 2 entry)))))

(PROCLAIM '(inline set-rq-scatter-entry-bytes))
(DEFUN set-rq-scatter-entry-bytes (rqb entry value)
  (SETF (get-16b-array-word rqb (+ %IO-RQ-Parameter-List-Word (1+ (* 2 entry))))
	value))

(DEFSETF rq-scatter-entry-bytes set-rq-scatter-entry-bytes)


(PROCLAIM '(inline set-rq-scatter-bit))
(DEFUN set-rq-scatter-bit (rqb)
  (SETF (rq-command rqb)
	(DPB 
	  (DPB 1 %%Io-Rq-Command-Scatter-Bit 0)
	  %%Q-High-Half
	  0)))

(PROCLAIM '(inline clear-rq-scatter-bit))
(DEFUN clear-rq-scatter-bit (rqb)
  (SETF (rq-command rqb) 0))
	


;;
;; For MX
;;

(define-unless :DISK
  
(DefAlternate Disk-SubOps (Q-corresponding-variable-lists      ;moved here from MICRONET; ADDIN-QCOM
			    System-Constant-Lists)
  (%DC-Get-Partition-List 1
   %DC-Get-Number-Partition-List-Entries 2
   %DC-Get-Volume-Name 3
   %DC-Get-Booted-Load-Band-Info 4
   %DC-Get-Booted-Mcr-Band-Info 5
   %DC-Get-Startup-Default-Device-Info 6		;1.18.88 MBC
   %DC-Get-Startup-Host-Name-Info 7
   %DC-Display-Partition-File-Map 8.		       ;ab 8/29/88 added 8-20.
   %DC-Get-Volume-Space-Info 9.
   %DC-Add-Partition 10.
   %DC-Modify-Partition 11.
   %DC-Delete-Partition 12.
   ;; Unused range.
   %DC-Flush-Volume 18.
   %DC-Flush-File 19.
   %DC-Get-Volume-Name-New 20.
   )
  )

;;ab 8/29/88.
(DEFPARAMETER Small-Disk-Command-Size 150.)
(DEFCONSTANT medium-disk-command-size  700.)
(DEFCONSTANT max-volume-name-bytes 28. )
(DEFCONSTANT max-whole-file-name-bytes 256.)
(DEFCONSTANT max-file-name-bytes 32.)

(DEFPARAMETER Disk-Channel %Chan-Type-Misc)
(DEFPARAMETER Addin-Partition-Descriptor-Size 52.)

(DefAlternate Addin-Partition-Descriptor-Byte-Offsets (Q-corresponding-variable-lists
							System-Constant-Lists)
  (%APD-Physical-Unit 0				;16b #0
   %APD-Type 2					;16b #1
   %APD-Start-Block 4				;32b #1
   %APD-Size 8.					;32b #1
   %APD-Name 12.				;8b for 5 bytes
   %APD-Comment 17.				;8b for 17 bytes
   %APD-Long-Name 34.				;8b for 17 bytes (short-name.EXPLORER)
   %APD-Reserved-1 51.
   )
  )

(DefAlternate Get-Partition-List-Byte-Offsets (Q-corresponding-variable-lists
						System-Constant-Lists)
  (%GPL-Physical-Unit 0
   %GPL-Partition-Type 2
   %GPL-Number-Partition-Entries 4
   %GPL-Partition-Descriptor-Start 8.
   )
  )


(DefAlternate Get-Volume-Info-Byte-Offsets (Q-corresponding-variable-lists     ;ab 8/29/88
						System-Constant-Lists)
  (%GVI-Physical-Unit 0			        ;16b #0
   %GVI-Volume-Index  2				;16b #1
   %GVI-Access-Volume 2				;16b #1
   %GVI-Total-Blocks 4.				;16b #2
   %GVI-Blocks-Free 6. 			        ;16b #3
   %GVI-Block-Size 12.				;32b #3
   %GVI-Volume-Name 16.				;8b for up to 28 bytes.
   )
  )

(DefAlternate Modify-Partition-Byte-Offsets (Q-corresponding-variable-lists    ;ab 8/29/88
					      System-Constant-Lists)
  (%MP-Physical-Unit 0			        ;16b #0
   %MP-Partition-Type 2				;16b #1
   %MP-Partition-Start 4			;32b #1
   %MP-Partition-Length 8.			;32b #2
   %MP-Volume-Name  16.				;8b for up to 28 bytes
   %MP-Part-Name 44.				;8b for 5 bytes
   %MP-File-Name 52.				;8b for up to 32 bytes
   %MP-Whole-File-Name 84.			;8b for up to 256 bytes
   %MP-New-Part-Name 344.			;8b for 5 bytes
   %MP-New-File-Name 352.			;8b for up to 32 bytes
   %MP-New-Partition-Type 388.                  ;16b #194
   %MP-Flags 390.                               ;16b #195
   %MP-New-Whole-File-Name 400.			;8b for up to 256 bytes
   )
  )

;; End of DEFINE-UNLESS
)