;;; -*- Mode:LISP; Package:FILE-SYSTEM; Base:8; Readtable:ZL -*-
;;;
;;;Copyright LISP Machine, Inc. 1985
;;;   See filename "Copyright.Text" for
;;;licensing and release information.
;;;
;;; This file has been hacked to contain only those functions
;;; specific to the new lambda lambda tape software       -dg 2/3/86

;;; Now this file is used for both the cadr and lambda.
;;; Most of the functions in the file should not be called
;;; on the lambda.  When they do direct unibus operations,
;;; I just left them alone, and they will get illegal instruction
;;; traps.  In a few cases, I've made a function work on both
;;; machines (e.g. mt-rewind)

;;; MagTape definitions.  Mostly copied from RG;MT.
;internal functions:
; MT-PRINT-STATUS  prints current status from hardware.
; EXECUTE-MT-RQB actually does it.  This normally done by microcode for DISK-RQBs.
; MT-WAIT-READY, MT-WAIT-UNIT-READY
; UNIBUS-MAP-MT-RQB,  UNIBUS-UNMAP-MT-RQB.
; MT-RUN rqb command &optional minus-byte-count unit density ibm-mode
; MT-RUN-SIMPLE command unit &optional count.  For commands that dont transfer data.
; MT-SPACE, MT-SPACE-TO-EOF, MT-SPACE-REV, MT-SPACE-REV-TO-BOF, MT-SPACE-TO-APPEND
; MT-REWIND, MT-WRITE-EOF, MT-OFFLINE.

; Normal RQBs are now used for magtape, but
; PRINT-MT-RQB, WIRE-MT-RQB, UNWIRE-MT-RQB, UNIBUS-MAP-MT-RQB and UNIBUS-UNMAP-MT-RQB
; must be used with magtape RQBs.

(DEFVAR *DEFAULT-RECORD-SIZE* #o10000
  "The default number of bytes in a magtape record.")

(DEFVAR *MT-EOT-HANDLER* ()
  "Called on EOT by SOME functions. You should use something like CONDITION-BIND.")

(DEFVAR FILE-SYSTEM-PACKAGE (PKG-FIND-PACKAGE "FS"))

(DEFVAR PAGE-SIZE-IN-BYTES (* PAGE-SIZE 4.))	;8 bit bytes.

(DEFMACRO LAMBDA-ONLY ()
  `(WHEN ( SI:PROCESSOR-TYPE-CODE SI:LAMBDA-TYPE-CODE)
     (FERROR NIL "this function is LAMBDA-specific")))


;; Low-level command execution.
;; Initialize the various header words of an RQB, such as %MT-RQ-COMMAND,
;; then call EXECUTE-MT-RQB.

;; This must be used rather than SI:WIRE-DISK-RQB so not to hack the CCW list.
(defun wire-mt-rqb (rqb &optional (wire-p t) set-modofied)
  (let* ((lo (%pointer-plus (%pointer rqb)
			    (si:array-data-offset rqb)))
	 (hi (%pointer-plus lo
			    (ceiling (array-length rqb) 2))))
    (do ((loc (logand lo (- page-size)) (%pointer-plus loc page-size)))
	((>= (%pointer-difference loc hi) 0))
      (si:%wire-page loc wire-p set-modofied))))


;(DEFUN WIRE-MT-RQB (RQB &OPTIONAL (WIRE-P T) SET-MODIFIED
;		    &AUX (LONG-ARRAY-FLAG (%P-LDB %%ARRAY-LONG-LENGTH-FLAG RQB))
;			 (LOW (%POINTER-DIFFERENCE (%POINTER RQB)
;						  (%POINTER-PLUS (ARRAY-DIMENSION RQB 0) 2)))
;			 (HIGH (%POINTER-PLUS (%POINTER RQB)
;				(%POINTER-PLUS 1
;				 (%POINTER-PLUS LONG-ARRAY-FLAG
;						(FLOOR (ARRAY-LENGTH RQB) 2))))))
;  (DO LOC (LOGAND LOW (- PAGE-SIZE)) (%POINTER-PLUS LOC PAGE-SIZE)
;      (>= (%POINTER-DIFFERENCE HIGH LOC) 0)
;    (SI:%WIRE-PAGE LOC WIRE-P SET-MODIFIED)))

(DEFUN UNWIRE-MT-RQB (RQB)
  (WIRE-MT-RQB RQB NIL))

(DEFUN SIGN-EXTEND-16 (X)
  (IF (ZEROP (LOGAND 100000 X)) X (LOGIOR X -100000)))

(defflavor tape-error ()	;This should be used as the canonical error type
	   (ferror))            ;for all types of device specific tape error flavors.
                                ;See SYS:TAPE;LQUART for details of use (DEFFLAVOR QUART-ERROR...

(defsignal no-tape tape-error ()
  "The tape is not mounted in the tape drive")

(defsignal write-protected tape-error ()
  "The tape in the tape drive is write protected.")

(defsignal no-drive tape-error ()
  "The selected tape drive does not seem to exist or is powered down." )

(defsignal end-of-tape tape-error (unit command byte-count density ibm-mode rqb)
  "Mag tape runs off end of tape.")

(defsignal beginning-of-tape tape-error ()
  "Tape drive encountered the logical beginning-of-tape (BOT).")

(DEFVAR MT-RETRY-COUNT 5)
(DEFVAR MT-ATTEMPT-TO-WRITE-WITH-EXTENDED-GAP-COUNT 3)


;; Convenient spacing operations.

;; Note: NTIMES fed thru to hardware.  NTIMES of 0 means moby many.
(DEFUN MT-SPACE (&OPTIONAL (NTIMES 1) (UNIT 0))
  (tape:using-device (dev tape:*selected-device* `(:unit ,unit))
    (tape:with-device-locked dev
      (send dev :space ntimes))))

(DEFUN MT-SPACE-TO-EOF (&OPTIONAL (N-FILES 1) (UNIT 0))
  (tape:using-device (dev tape:*selected-device* `(:unit ,unit))
    (tape:with-device-locked dev
      (dotimes (c n-files)
	(send dev :search-filemark 1)))))
  
(DEFUN MT-SPACE-REV (&OPTIONAL (NTIMES 1) (UNIT 0))
  (tape:using-device (dev tape:*selected-device* `(:unit ,unit))
    (tape:with-device-locked dev
      (send dev :space-reverse ntimes))))

;; Reverse through the tape, positioning the tape at the beginning of a file.
;; If SKIP-N-BLOCKS is 0, this positions the tape at the beginning of this file.
;; If SKIP-N-BLOCKS is 1, this positions the tape at the beginning of the previous file, etc.
;; If this reaches the beginning of the tape prematurely, it stops there and returns NIL.
(DEFUN MT-SPACE-REV-TO-BOF (&OPTIONAL (SKIP-N-FILES 0) (UNIT 0))
  (tape:using-device (dev tape:*selected-device* `(:unit ,unit))
    (tape:with-device-locked dev
      (condition-case ()
	  (send tape:*selected-device* :search-filemark-reverse 1)
	(tape:physical-beginning-of-tape))
      (unless (zerop skip-n-files)
	(send tape:*selected-device* :previous-file)))))

;; This function attempts to bypass all files on the tape until two
;; consecutive EOFs are found, then positions the tape over the last EOF.
;; The tape is now in a configuration allowing one to append new files.
(DEFUN MT-SPACE-TO-APPEND (&OPTIONAL (UNIT 0))
  (tape:using-device (dev tape:*selected-device* `(:unit ,unit))
    (tape:with-device-locked dev
      (send tape:*selected-device* :search-filemark 2))))

(DEFUN MT-REWIND (&OPTIONAL (UNIT 0))
  (tape:using-device (dev tape:*selected-device* `(:unit ,unit))
    (tape:with-device-locked dev
      (send tape:*selected-device* :rewind))))

(DEFUN MT-RESET ()
  (tape:with-device-locked tape:*selected-device*
    (send tape:*selected-device* :reset)))

(defun tm-init ()
  (tv:beep)
  (format t "~&This function is obsolete.  Read the new tape documentation.")
  (mt-reset))

(compiler:make-obsolete
  tm-init
  "Read the new tape documentation")

(defun tm-rewind ()
  (tv:beep)
  (format t "~&This function is obsolete.  Read the new tape documentation.")
  (mt-rewind))

(compiler:make-obsolete
  tm-rewind
  "Read the new tape documentation")

(defun tm-unload ()
  (tv:beep)
  (format t "~&This function is obsolete.  Read the new tape documentation.")
  (mt-unload))

(compiler:make-obsolete
  tm-unload
  "Read the new tape documentation")

(DEFUN MT-WRITE-EOF (&OPTIONAL (UNIT 0))
  (tape:using-device (dev tape:*selected-device* `(:unit ,unit))
    (tape:with-device-locked dev
      (send tape:*selected-format* :finish-tape dev))))

(DEFUN MT-UNLOAD (&OPTIONAL (UNIT 0))
  (tape:using-device (dev tape:*selected-device* `(:unit ,unit))
    (tape:with-device-locked dev
      (send tape:*selected-device* :unload))))

(deff MT-OFFLINE 'mt-unload)

;; Standard End of Tape handlers

;; This one is useful when you have transporting things which are bigger than
;; a tape.  it just rewinds, lets you reload, and continues.
;; Install it as a handler for END-OF-TAPE, using CONDITION-BIND.
(DEFUN CONTINUING-MT-EOT-HANDLER (CONDITION &AUX (UNIT (SEND CONDITION ':UNIT)))
  (PROG ((STREAM ERROR-OUTPUT))
	(MT-REWIND UNIT)
	(FUNCALL STREAM ':BEEP)
	(FORMAT STREAM "~%>>> MagTape unit ~D reached end of tape <<<~%" UNIT)
	(MT-OFFLINE UNIT)			;This will wait...
     L  (FORMAT STREAM "Please type [Resume] to continue tape operation: ")
	(FUNCALL STREAM ':CLEAR-INPUT)
	(COND ((NOT (CHAR-EQUAL (FUNCALL STREAM ':TYI) #\RESUME))
	       (FUNCALL STREAM ':BEEP)
	       (FUNCALL STREAM ':TYO #\CR)
	       (GO L)))
	(FORMAT STREAM "[Resuming tape operation]~%")
	(RETURN ':NO-ACTION)))