;;; -*- Mode:LISP; Package:TAPE; Readtable:CL; Base:10 -*-
;;
;; Copyright LISP Machine, Inc. 1986
;;   See filename "Copyright" for
;; licensing and release information.
;;;
;;; Error handling support for tape software
;;;
;;; -dg 10/04/85
;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Base flavor for all tape-related errors
;;;

(defflavor tape-error () (error)
  :abstract-flavor)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Hardware errors - Errors that are internal hardware errors and cannot
;;; be reasonably handled by other software (fatal hardware lossage)
;;;

(defflavor hardware-error (device-type error-code error-message)
	   (tape-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device-type :error-code :error-message))

(defmethod (hardware-error :report) (stream)
  (format stream "Tape hardware error: ~A"
	  error-message))

(compile-flavor-methods hardware-error)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Driver errors - Internal errors in the driver software.
;;; This is for internal error checking, which for the most part
;;; probably won't be common, but those who like to setup internal
;;; error checking, will have this available (rather than "(ferror nil ...)")
;;; It is also used to catch internal conditions.

(defflavor driver-error (device-type error-code error-message)
	   (tape-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device-type :error-code :error-message))


(defmethod (driver-error :report) (stream)
  (format stream "Tape device driver error: ~A"
	  error-message))

(compile-flavor-methods driver-error)
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Device Error - Typical (sometimes expected) errors that the device may
;;; encounter, such as the physical end of the tape, device not on ready, etc.
;;;
;;;

(defflavor device-error () (tape-error)
  :abstract-flavor)

;;; Device not found

(defflavor device-not-found () (device-error)
  (:required-init-keywords :format-string))

;;; Device unavailable 

(defflavor device-unavailable (device-type current-owner)
	   (device-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device-type :current-owner))

(defmethod (device-unavailable :report) (stream)
  (etypecase current-owner
    (integer
     (format stream "The ~A device is currently being used by slot #d~d"
	     device-type current-owner))
    (cons
     (format stream "The ~a device is currently being used by the device object: ~S~%~
	             ~9Tin the process: ~S"
	     device-type
	     (cdr current-owner)
	     (car current-owner)))))

(defmethod (device-unavailable :case :proceed-asking-user :steal-device-internally)
	   (cont read-func)
  "Steal the device from another process.  *** Be careful ***"
  read-func
  (funcall cont :steal-device-internally))

(defmethod (device-unavailable :case :proceed-asking-user :steal-device-from-other-processor)
	   (cont read-func)
  "Steal the device from another processor."
  read-func
  (funcall cont :steal-device-from-other-processor))

(defmethod (device-unavailable :case :proceed-asking-user :wait-for-device-free)
	   (cont read-func)
  "Wait for the device to become free, then lock it."
  read-func
  (funcall cont :wait-for-device-free))

(compile-flavor-methods device-unavailable)

;;; Wait timeout

(defflavor wait-timeout (device-type unit seconds-waited wait-string)
	   (device-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device-type :seconds-waited :wait-string :unit))

(defmethod (wait-timeout :report) (stream)
  (format stream "The ~a device (unit ~D) timed out after ~A ~A"
	  device-type
	  unit
	  (time:print-interval-or-never seconds-waited nil)
	  wait-string))

(compile-flavor-methods wait-timeout)
  
;;; Bad tape

(defflavor bad-tape (device-type unit)
	   (device-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device-type :unit))

(defmethod (bad-tape :report) (stream)
  (format stream "A hard error has been found on the media on unit ~D the ~A device."
	  device-type unit))

(defmethod (bad-tape :case :proceed-asking-user :replace-bad-tape)
	   (cont read-func)
  "Replace the tape and start again from some point."
  read-func
  (funcall cont :replace-bad-tape))

(compile-flavor-methods bad-tape)
 
;;; Blank tape

(defflavor blank-tape (device-type unit)
	   (device-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device-type))

(defmethod (blank-tape :report) (stream)
  (format stream "The tape on ~A device (unit 0) seems to be blank."
	  device-type unit))

(compile-flavor-methods blank-tape)

;;; Physical end of tape

(defflavor physical-end-of-tape (device-type unit data-transferred)
	   (device-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device-type :unit :data-transferred))

(defmethod (physical-end-of-tape :report) (stream)
  (format stream "Physical end of tape on unit ~d of ~A device"
	  unit device-type))

(compile-flavor-methods physical-end-of-tape)

;;; Physical beginning of tape

(defflavor physical-beginning-of-tape (device-type unit data-transferred)
	   (device-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device-type :unit :data-transferred))

(defmethod (physical-beginning-of-tape :report) (stream)
  (format stream "Physical beginning of tape on unit ~d of ~A device"
	  unit device-type))

(compile-flavor-methods physical-beginning-of-tape)

;;; Filemark encountered during read

(defflavor filemark-encountered (device-type unit data-transferred)
	   (device-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device-type :unit :data-transferred))

(defmethod (filemark-encountered :report) (stream)
  (format stream "Filemark encountered during read on unit ~D of the ~A device"
	  unit device-type))

(compile-flavor-methods filemark-encountered)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Format errors - Errors in the format of information on the tape with repect
;;; to the specific format standard (bad file headers, etc)
;;;

(defflavor format-error () (tape-error)
  :abstract-flavor)

;;; Bad tape header

(defflavor bad-tape-header (format-type header)
	   (format-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :format-type :header))

(defmethod (bad-tape-header :report) (stream)
  (format stream "Bad data in tape header for ~A format." format-type))

(compile-flavor-methods bad-tape-header)

;;; Bad file headers

(defflavor bad-file-header (format-type header)
	   (format-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :format-type :header))

(defmethod (bad-file-header :report) (stream)
  (format stream "Bad data in file header for ~A format." format-type))

(compile-flavor-methods bad-file-header)

;;; Logical end of tape

(defflavor logical-end-of-tape (device-object)
	   (format-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device-object))

(defmethod (logical-end-of-tape :report) (stream)
  (format stream "Logical end of tape on ~S" device-object))

(compile-flavor-methods logical-end-of-tape)

;;; End of tape writing header

(defflavor end-of-tape-writing-header (file-plist device)
	   (format-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :file-plist))

(defmethod (end-of-tape-writing-header  :report) (stream)
  (format stream "End of tape encountered while writing header for file: ~A~&~
                  ~9Ton device ~A"
	  (car file-plist)
	  device))

(compile-flavor-methods end-of-tape-writing-header)

;;; End of tape reading header

(defflavor end-of-tape-reading-header (device)
	   (format-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device))

(defmethod (end-of-tape-reading-header :report) (stream)
  (format stream "End of tape encountered while reading header on device: ~S"
	  device))

(compile-flavor-methods end-of-tape-reading-header)
	  
;;; End of tape writing file

(defflavor end-of-tape-writing-file (file-plist device bytes-transferred)
	   (format-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :file-plist :device :bytes-transferred))

(defmethod (end-of-tape-writing-file :report) (stream)
  (format stream "End of tape writing file ~A on device: ~S"
	  (car file-plist)
	  device))

(compile-flavor-methods end-of-tape-writing-file)

;;; End of tape reading file

(defflavor end-of-tape-reading-file (file-plist device bytes-transferred)
	   (format-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :file-plist :device :bytes-transferred))
	   
(defmethod (end-of-tape-reading-file :report) (stream)
  (format stream "End of tape reading file ~A on device: ~S"
	  (car file-plist)
	  device))

(compile-flavor-methods end-of-tape-reading-file)

(defflavor compare-error (source-file file-plist) (format-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :source-file :file-plist))

(defmethod (compare-error :report) (stream)
  (format stream "File comparison error for file: \"~A\"" source-file))

(compile-flavor-methods compare-error)

(defflavor compare-source-not-found (source-file) (format-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :source-file))

(defmethod (compare-source-not-found :report) (stream)
  (format stream "File \"~A\" not found for comparison." source-file))

(compile-flavor-methods compare-source-not-found)

(defflavor compare-source-changed (source-plist file-plist) (format-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :source-plist :file-plist))

(defmethod (compare-source-changed :source-file) ()
  (car source-plist))

(defmethod (compare-source-changed :report) (stream)
  (format stream
	  "File \"~A\" for comparing seems to have changed since writing."
	  (send self :source-file)))

(compile-flavor-methods compare-source-changed)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; User error - Errors that the user can correct and retry, or that the user
;;; must have caused by not following the conventions.
;;; (i.e. tape not mounted, :read-array arguments specify too much data for the 
;;;       array, etc.)
;;;

(defflavor user-error () (tape-error)
  :abstract-flavor)

;;; Tape write protected

(defflavor write-protected (device-type unit)
	   (user-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device-type :unit))

(defmethod (write-protected :report) (stream)
  (format stream "The tape in unit ~D of the ~A device is write protected."
	  unit device-type))

(compile-flavor-methods write-protected)

;;; Tape not ready

(defflavor tape-not-ready (device-type unit)
	   (user-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device-type :unit))

(defmethod (tape-not-ready :report) (stream)
  (format stream "Unit ~D of the ~A device is not ready."
	  unit device-type))

(compile-flavor-methods tape-not-ready)

(defflavor unknown-format (device unit header-string)
	   (user-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device :unit :header-string))

(defmethod (unknown-format :report) (stream)
  (format stream "Tape on unit ~d of device ~S is of unknown format."
	  unit device))

(compile-flavor-methods unknown-format)

(defflavor file-stream-exists (format-object file-stream)
	   (user-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :format-object :file-stream))

(defmethod (file-stream-exists :report) (report-stream)
  (format report-stream 
	  "A file stream is currenly open for format: ~S" format-object))

(compile-flavor-methods file-stream-exists)

(defflavor no-such-partition (partition host disk-unit)
	   (user-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :partition :disk-unit :host))

(defmethod (no-such-partition :report) (report-stream)
  (format report-stream 
	  "There is no partition named ~A on unit ~D of host ~A"
	  partition
	  disk-unit
	  host))

(compile-flavor-methods no-such-partition)

(defflavor invalid-option (object option value)
	   (user-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :option :value :object))

(defmethod (invalid-option :report) (stream)
  (format stream "Invalid option ~A (with value ~S) for object ~S"
	  option value object))

(compile-flavor-methods invalid-option)

(defflavor invalid-option-value (object option value)
	   (user-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :option :value :object))

(defmethod (invalid-option-value :report) (stream)
  (format stream "Invalid value ~s for option ~a, for object ~S"
	  value option object))

(compile-flavor-methods invalid-option-value)

(defflavor write-in-middle-of-tape (device-object)
	   (user-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device-object))

(defmethod (write-in-middle-of-tape :report) (stream)
  (format stream "User tried to write data in the middle of the tape on ~A."
	  device-object))

(compile-flavor-methods write-in-middle-of-tape)

(defflavor read-during-write (device-object)
	   (sys:no-action-mixin user-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device-object))

(defmethod (read-during-write :report) (stream)
  (format stream "User tried to examine the tape on ~a before completely writing it."
	  device-object))

(compile-flavor-methods read-during-write)

(defflavor not-supported (device-object operation)
	   (user-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :device-object :operation))

(defmethod (not-supported :report) (stream)
  (format stream "Sorry, but ~s does not support the operation ~S.~%"
	  device-object operation))

(compile-flavor-methods not-supported)

;;; protocol violation - note: this is not necessarily the fault of
;;; the user specified values, but in some cases the fault of the format
;;; software.  It is assumed however that format software is checked and
;;; adheres to the protocols of the tape system, leaving user mistakes
;;; when using the device directly the most likely case.

(defflavor protocol-violation ()
	   (user-error)
  :gettable-instance-variables
  :initable-instance-variables
  (:required-init-keywords :format-string))

(defmethod (protocol-violation :report) (stream)
  (format stream "Protocol violation: ~A"
	  (lexpr-funcall 'format nil
			 eh:format-string
			 eh:format-args)))

(compile-flavor-methods protocol-violation)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Higher level software errors - (i.e. in filesystem backup software)
;;;

(defflavor higher-level-sofware-error () (tape-error)
  :abstract-flavor)