;;; -*- Mode: Common-Lisp; Package: MT; Base: 10.; Patch-File: T -*- ;;; Reason: Added support for the CT2000 tape unit. The CT2000 tape unit is a high capacity tape unit, up to 2048 Mbytes, depending on the cartridge. It uses the 8MM type data cartridge. ;;; 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, M/S 2151 ;;; AUSTIN, TEXAS 78769 ;;; ;;; Copyright (C) 1989 Texas Instruments Incorporated. ;;; All rights reserved. ;;; Patch file for STREAMER-TAPE version 6.5 ;;; Written 11/22/89 07:05:34 by BERGER, ;;; while running on ARIES from band LODX ;;; With SYSTEM 6.23, VIRTUAL-MEMORY 6.2, EH 6.5, MAKE-SYSTEM 6.2, MICRONET 6.0, LOCAL-FILE 6.1, ;;; BASIC-PATHNAME 6.2, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.6, NETWORK-NAMESPACE 6.0, ;;; DISK-IO 6.1, DISK-LABEL 6.0, BASIC-FILE 6.6, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0, ;;; COMPILER 6.14, TV 6.19, DATALINK 6.0, CHAOSNET 6.5, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.2, ;;; SYSLOG 6.2, STREAMER-TAPE 6.4, UCL 6.0, INPUT-EDITOR 6.0, METER 6.1, ZWEI 6.8, ;;; DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.2, DATALINK-DISPLAYS 6.0, ;;; FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.3, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.2, ;;; IMAGEN 6.1, SUGGESTIONS 6.1, MAIL-DAEMON 6.3, MAIL-READER 6.6, TELNET 6.0, VT100 6.0, ;;; NAMESPACE-EDITOR 6.4, PROFILE 6.2, VISIDOC 6.5, TI-CLOS 6.26, CLEH 6.5, IP 3.56, ;;; Experimental CLX 6.7, CLUE 6.32, X11M 6.16, Experimental BUG 11.17, DECNET 1.70, ;;; microcode 429, Band Name: rel6.0 10/23 #!C ; From file DISPLAY.LISP#> STREAMER-TAPE; sys: #10R MT#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "MT")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "sys: STREAMER-TAPE; DISPLAY.#" (defparameter ct2000-command-menu-list ; Miscellaneous operations '(("Prepare Tape" :VALUE :prepare-tape :DOCUMENTATION "Prepare the tape device by looking for an online tape and making it the current tape unit. Selection of tape format (density) is required.") ("Prepare Remote Tape" :VALUE :prepare-remote-tape :DOCUMENTATION "Prepare a remote tape device by specifing a remote host name. Selection of tape format (density) is required.") ;; Kenny Tung for remote ("Unload Tape" :VALUE :unload :DOCUMENTATION "Unload the tape cartridge. This leaves the tape offline until a Load Tape is performed.") ("Load Tape" :VALUE :load-tape :DOCUMENTATION "Load the tape cartridge, making it available and leaving it rewound to its physical beginning. This resets the tape formatter and drive.") ("" :no-select nil) ("Erase Entire Tape" :VALUE :erase :DOCUMENTATION "Erase the entire tape, after confirmation.") ("Re-Tension" :VALUE :tension :DOCUMENTATION "Tension tape by unwinding and rewinding.") ("" :no-select nil) ("Rewind" :VALUE :rewind :DOCUMENTATION "Position the tape to its physical beginning, ready to read or write.") ("Position Past File (EOF)" :VALUE :space-to-eof :DOCUMENTATION "Position the tape past the next end of file (moves tape past next file) or multiple files or partitions.") ("Space Reverse (EOF)" :value :space-reverse-by-filemarks :documentation "Moves the tape header back by one or multiple filemarks.") ("Position Past Blocks" :VALUE :space-blocks :DOCUMENTATION "Position the tape forward a number of blocks. Generally, this is not recommended.") ("" :no-select nil) ("List Contents" :VALUE :list-contents :DOCUMENTATION "Read the rest of the entire tape, displaying all file and partition headers until the end of recorded media is encountered.") ("List Directory" :VALUE :list-directory :DOCUMENTATION "Read the next directory, displaying headers from tape until a double EOF is encountered. Files and partitions backed up without an extra EOF will be treated as a directory. If there are sub-directories written by a single Backup Directory command, they will also be listed.") ; Data movement operations ("" :no-select nil) ("Backup File" :VALUE :backup-file :DOCUMENTATION "Copy a file to tape. Wildcarding is not allowed.") ("Backup Directory" :VALUE :backup-directory :DOCUMENTATION "Copy a directory, its sub directories, and all their files to tape.") ;6.19.87 ("Backup Partition" :VALUE :backup-partition :DOCUMENTATION "Copy a partition to tape.") ("Make Bootable Tape" :VALUE :make-bootable-tape :DOCUMENTATION "Make a bootable tape by creating a label and copying the label and one or more partitions to a tape.") ("" :no-select nil) ("Restore File" :VALUE :restore-file :DOCUMENTATION "Restore the next file on tape to some filename.") ("Restore Directory" :VALUE :restore-directory :DOCUMENTATION "Restore the next directory from the tape until its delimiting extra EOF is encountered.") ("Restore Partition" :VALUE :restore-partition :DOCUMENTATION "Restore the next partition on the tape to disk.") ("Restore Bootable Tape" :VALUE :restore-bootable-tape :DOCUMENTATION "Restore one or more partitions from a bootable tape.") ("" :no-select nil) ("" :no-select nil) ("Verify File" :VALUE :verify-file :DOCUMENTATION "Verify the next file on the tape with some filename.") ("Verify Directory" :VALUE :verify-directory :DOCUMENTATION "Verify the next directory from the tape until its delimiting extra EOF is encountered.") ("Verify Partition" :VALUE :verify-partition :DOCUMENTATION "Verify the next partition on the tape.") ("Verify Bootable Tape" :VALUE :verify-bootable-tape :DOCUMENTATION "Verify one or more partitions on a bootable tape.") ("" :no-select nil) ("Load Distribution Tape" :VALUE :load-distribution-tape :DOCUMENTATION "Load software from a distribution tape on to the local file system.") ("" :no-select nil) ("Write EOF" :VALUE :write-eof :DOCUMENTATION "Write an EOF marker on tape. This should only be done to seperate groups of backups for convenience. It does not mark the end of tape.") ("" :no-select nil) ("Help" :VALUE :help :DOCUMENTATION "Menu of help subtopics. Subjects include Read-Write Mode, Streaming, Errors, and Partitions.") ("Exit" :VALUE :exit :DOCUMENTATION "Exit this window and return to the previous window."))) (DEFPARAMETER INITIALIZE-FORMAT-ALIST (LIST '("1/4 inch Cartridge Tape" SETUP-QUARTER-INCH-TAPE) '("1/2 inch Reel Tape" SETUP-HALF-INCH-TAPE) '("CT2000 Cartridge Tape" SETUP-CT2000-TAPE) ; DAB 11-16-89 '("1/4 inch Cartridge Tape - Carry format" Carry-tape) '("1/4 inch Cartridge Tape - TAR format" QUARTER-INCH-TAR-TAPE) '("1/2 inch Reel Tape - TAR format" HALF-INCH-TAR-TAPE) '("CT2000 Cartridge Tape - TAR format" SETUP-CT2000-TAR-TAPE) ; DAB 11-16-89 )) (defconstant CT2000-density "Select DEFAULT to use QIC-24 bpi or select QIC-11.") (defun get-CT2000-parameters () (declare (Values BLOCK-SIZE DENSITY)) (unless (member *temp-density* '(:default :qic-11)) (setf *temp-density* :default)) (unless (member *temp-block-mode* '(:Fixed)) (setf *temp-block-mode* :FIXED)) ; DAB 11-27-89 (let (DENSITY) (SETQ DOIT ()) (catch 'ghi-abort (eval `(tv:choose-variable-values '((*temp-block-mode* "Block Mode" :choose (:Fixed)) (*temp-density* "Density" :documentation ,CT2000-density :choose (:default :QIC-11))) :MARGIN-CHOICES '(("Do it" (AND (SETQ DOIT T) (THROW 'ghi-abort ()))) "Abort") :LABEL "Select block mode and density" :EXTRA-WIDTH 25))) (when doit ;End pressed or doit clicked (if (eq *temp-density* :default) (setq density 0.) (setq density 4.)) ; DAB 11-16-89 The CT2000 currently supports only single density. (if (eq *temp-block-mode* :variable) (setq *temp-block-size* 0.) ; DAB 11-27-89 Currently VARIABLE MODE is not supported. (progn (setq *temp-block-size* 1024.) (setf doit nil) ;reuse doit flag (catch 'ghi1-abort (tv:choose-variable-values '((*temp-block-size* "Block size" :documentation "Block size in bytes. Should be a mulitiple of 1024." :number )) :MARGIN-CHOICES '(("Do it" (AND (SETQ DOIT T) (THROW 'ghi1-abort ()))) "Abort") :LABEL "Enter a value for the block size")) ))) (if DOIT ;detect ABORTs (values *TEMP-BLOCK-SIZE* *TEMP-BLOCK-MODE* DENSITY) NIL))) (DEFMETHOD (tape-mixin :prepare-tape) () ;; tung done "Prepare tape." (let ((fini :ABORTED) doit (unit (pick-drive)) (tape-type :quarter-inch)) (when unit (let ((fun (w:menu-choose initialize-format-alist :label "Choose format" :default-item (first initialize-format-alist)))) (setf *current-unit* unit) (selector fun equal (('setup-half-inch-tape ) (setq tape-type :half-inch) (multiple-value-bind (block-size block-mode density) ;8.11.87 MBC (get-half-inch-parameters) (when block-size (prepare-tape-drive unit :block-size block-size :block-mode block-mode :tape-type tape-type :density density) (setq fini :COMPLETE) (send (send self :get-pane 'command-pane) :set-label `(:FONT ,*LABEL-FONT* :STRING "Half Inch Tape Menu" :background ,w:66%-gray-color)) (send (send self :get-pane 'command-pane) :set-item-list half-inch-command-menu-list))) ) (('setup-quarter-inch-tape) (prepare-tape-drive unit) ;hw (setq fini :COMPLETE) (send (send self :get-pane 'command-pane) :set-label `(:FONT ,*LABEL-FONT* :STRING "Quarter Inch Tape Menu" :background ,w:66%-gray-color)) (send (send self :get-pane 'command-pane) :set-item-list quarter-inch-command-menu-list) ) (('setup-ct2000-tape ) (setq tape-type :CT2000) (multiple-value-bind (block-size block-mode density) (get-ct2000-parameters) (when block-size (prepare-tape-drive unit :block-size block-size :block-mode block-mode :tape-type tape-type :density density ) (setq fini :COMPLETE) (send (send self :get-pane 'command-pane) :set-label `(:FONT ,*LABEL-FONT* :STRING "CT2000 Tape Menu" :background ,w:66%-gray-color)) (send (send self :get-pane 'command-pane) :set-item-list ct2000-command-menu-list))) ) (('carry-tape) (prepare-tape-drive unit) ;hw (setq fini :COMPLETE) (send (send self :get-pane 'command-pane) :set-label `(:FONT ,*LABEL-FONT* :STRING "Carry Tape Menu" :background ,w:66%-gray-color)) (send (send self :get-pane 'command-pane) :set-item-list carry-tape-command-menu-list) ) (('QUARTER-INCH-TAR-TAPE) (multiple-value-bind (tape-mode) ;8.11.87 MBC (get-quarter-inch-mode) (when tape-mode (INITIALIZE-TAPE-DRIVE :UNIT *CURRENT-UNIT* :BUFFERED T :SPEED 0 :BLOCK-SIZE 1024. :DENSITY (CASE tape-mode (QIC-11 4) (QIC-24 5) (6250 132.))) (setq fini :COMPLETE) (send (send self :get-pane 'command-pane) :set-label `(:FONT ,*LABEL-FONT* :STRING "TAR Tape Menu" :background ,w:66%-gray-color)) (send (send self :get-pane 'command-pane) :set-item-list tar-tape-command-menu-list))) ) (('HALF-INCH-TAR-TAPE) (setq tape-type :half-inch) (multiple-value-bind (block-size block-mode density) ;8.11.87 MBC (get-half-inch-parameters) (when block-size (prepare-tape-drive unit :block-size block-size :block-mode block-mode :tape-type tape-type :density density) (setq fini :COMPLETE) (send (send self :get-pane 'command-pane) :set-label `(:FONT ,*LABEL-FONT* :STRING "TAR Tape Menu")) (send (send self :get-pane 'command-pane) :set-item-list Tar-tape-command-menu-list)))) )) ) ;; when unit (when (eq fini :COMPLETE) (setf *tape-unit* SI:LOCAL-HOST-NAME) ;; this is server side command -- TUNG (setf (get 'mt:*current-unit* 'tape-type) tape-type)) ;8.11.87 Remember type fini)) )) #!C ; From file nu-mtdefs.LISP#> STREAMER-TAPE; sys: #10R MT#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "MT")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "sys: STREAMER-TAPE; nu-mtdefs.#" (DEFUN GET-MODE-SELECT-RQB (UNIT &OPTIONAL &KEY (BUFFERED T) (SPEED 0) (DENSITY 6) (BLOCK-SIZE 512) (LONG-ERASE T) (UNLOAD-RETENSION NIL) (LOAD-RETENSION NIL) exb-ct2000-vendor-parms ; DAB 11-16-89 Vendor info &AUX RQB) "Return an RQB stuffed with parameters ready for issuing mode-select operation.";Issue with execute-mt-rqb, then return rqb. ; ;BUFFERED - set mode to stream (tells formatter to use buffered vs. unbuffered mode). ;SPEED - 1 = low, 0 & 2 = high, 3 = auto-adjust ;DENSITY - 0 formatter defaults (Explorer default), 4 QIC-11 (Symbolics & NuMachine) ; 6 1/2 inch 3200 bpi, 1-3 variations of 1/2 inch ;BLOCK-SIZE - Size in bytes of blocks on tape, (24 bit field). (LET ((PARMS SYSTEM:%IO-RQ-PARAMETER-LIST) (parameter-list-length (if exb-ct2000-vendor-parms 14 12))) (SETQ RQB (SYSTEM:GET-DISK-RQB)) (SI::WIRE-NUPI-RQB RQB) (NUPI-CMD-SETUP RQB SYSTEM:%NUPI-COMMAND-FMTR-SETUP 0 UNIT (if exb-ct2000-vendor-parms 20 16)) (SETF (AREF RQB PARMS) parameter-list-length );tells NUPI length of parm block ;;; This next word in the parameter block is RESERVED in SCSI spec but NUPI uses it!! (LET ((HALF-WORD (DPB (IF LONG-ERASE 0 1) (BYTE 1 15);Info for NUPI only. Not part of (DPB (IF UNLOAD-RETENSION 1 0) (BYTE 1 14);this SCSI command!!! (DPB (IF LOAD-RETENSION 1 0) (BYTE 1 13) 0))))) (SETF (AREF RQB (+ PARMS 1)) HALF-WORD)) ;;; From here down we're stuffing params strictly according to SCSI ;;; halfword - SCSI bytes in parameter list ;;; 3 2,3 ;;; halfword - SCSI bytes in descriptor block ;;; 4 0,1 density, number-of-blocks MSB ;;; 5 2,3 number-of-blocks (middle, LSB) ;;; 6 4,5 reserved, Block Size MSB ;;; 7 6,7 Block Size (middle, LSB) ;;; 8 8 Vendor Unique Parameters (CT2000) (SETF (AREF RQB (+ PARMS 2)) 0);foramtter params start here (LET ((HALF (DPB (IF BUFFERED 1 0) (BYTE 1 4) 2048)));8 is constant=bytes left (block descriptor) (SETF HALF (DPB SPEED (BYTE 2 0) HALF)) (SETF (AREF RQB (+ PARMS 3)) HALF)) (SETF (AREF RQB (+ PARMS 4)) (DPB DENSITY (BYTE 8 0) 0)) (SETF (AREF RQB (+ PARMS 6)) (DPB (LDB (BYTE 8 16) BLOCK-SIZE) (BYTE 8 8) 0));MSB (SETF (AREF RQB (+ PARMS 7)) (DPB (LDB (BYTE 8 0) BLOCK-SIZE) (BYTE 8 8);middle & LSB (DPB (LDB (BYTE 8 8) BLOCK-SIZE) (BYTE 8 0) 0))) (when exb-ct2000-vendor-parms (SETF (AREF RQB (+ PARMS 8)) (DPB exb-ct2000-vendor-parms (BYTE 8 0) 0))) RQB)) (DEFUN INITIALIZE-TAPE-DRIVE (&OPTIONAL &KEY UNIT (DENSITY 0) (BUFFERED T) (SPEED 0) (BLOCK-SIZE 512) (LONG-ERASE T) (UNLOAD-RETENSION NIL) (LOAD-RETENSION NIL) (LOAD-P NIL) (exb-ct2000-vendor-parms nil)) "Prepare tape by initializing logical unit. Issue formatter mode select to setup Explorer 14 inch streaming tape drive. Density defines what tape encoding to use: 0 - default of formatter 1 - 12 inch 800 bpi NRZI 2 - 12 inch 1600 bpi PE 3 - 12 inch 6250 bpi GRC 4 - 14 inch QIC-11 (NuMachine, Symbolics) 5 - 14 inch QIC-24 10000 bpi (Explorer) 6 - 12 inch 3200 bpi" (UNLESS UNIT (SETF UNIT (PICK-DRIVE))) (when UNIT (IF LOAD-P (LOAD-TAPE)) (INIT-UNIT-VAR UNIT) (si:with-rqb (rqb (GET-MODE-SELECT-RQB UNIT :BUFFERED BUFFERED :SPEED SPEED :DENSITY DENSITY :BLOCK-SIZE BLOCK-SIZE :LONG-ERASE LONG-ERASE :UNLOAD-RETENSION UNLOAD-RETENSION :LOAD-RETENSION LOAD-RETENSION :exb-ct2000-vendor-parms exb-ct2000-vendor-parms)) (EXECUTE-MT-RQB RQB)) (setf (get 'mt:*current-unit* 'block-size) BLOCK-SIZE) ;8.3.87 record params ;tape mode not known here; should be recorded elsewhere (setf (get 'mt:*current-unit* 'block-mode) (if (zerop block-size) :variable :fixed)) (setf (get 'mt:*current-unit* 'density) density))) (defun prepare-tape (unit &optional (streamp t) (normal-encoding t) (long-erase T) (unload-retension nil) (load-retension nil) exb-ct2000-vendor-parms ) "Just calls Initialize-Tape-Drive; emulates old prepare tape." (initialize-tape-drive :unit unit :buffered streamp :long-erase long-erase :density (if normal-encoding 0 4) :unload-retension unload-retension :load-retension load-retension :exb-ct2000-vendor-parms exb-ct2000-vendor-parms ) ) (DEFUN SETUP-CT2000-TAPE (&REST OPTIONS &KEY (UNIT *CURRENT-UNIT*) (BLOCK-SIZE 0) (density 0) &ALLOW-OTHER-KEYS) "Issue formatter mode select to setup Explorer CT2000 cartridge tape drive." (APPLY 'INITIALIZE-TAPE-DRIVE :UNIT UNIT :BUFFERED T :SPEED 0 :density density :BLOCK-SIZE BLOCK-SIZE :exb-ct2000-vendor-parms #x8E OPTIONS)) (DEFUN PREPARE-TAPE-DRIVE (UNIT &OPTIONAL &key (block-mode :fixed) (block-size 512.) ;hw (tape-type :quarter-inch) (density 0.0)) "Prepares the tape for the specified unit. BLOCK-MODE -- It can be either :fixed or :variable. Variable length block size is supported on half inch tape or the CT2000 tape. BLOCK-SIZE -- For variable length block mode, the block size should be 0. TAPE-TYPE -- It can be either :quarter-inch or :half-inch. DENSITY -- It should be 0 for quarter-inch. For half-inch, it can be either: 2 for 1600 bpi or 6 for 3200 bpi (default) " (let ((out-stream *standard-output*)) (INIT-UNIT-VAR UNIT) (cond ((and (or (zerop block-size) (eq block-mode :variable)) (eq tape-type :half-inch)) (setq tape-type :half-inch) (setq block-size 0.) (setq block-mode :variable) (if (not (or (eq density 2.) (eq density 6.))) (setq density 6.)) (setup-half-inch-tape :density density) (Format out-stream "~&Preparing the tape for a half inch tape drive with variable length block size.") ) ((and (eq tape-type :half-inch) (or (eq block-size 512.) (eq block-size 1024.))) (setq block-mode :fixed) (if (not (or (eq density 2.) (eq density 6.))) (setq density 6.)) (setup-half-inch-tape :block-size block-size :density density) (Format out-stream "~&Preparing the tape for a half inch tape drive with fixed length block size.") ) ((and (or (zerop block-size) (eq block-mode :variable)) (eq tape-type :CT2000)) (ferror () "VARIABLE BLOCK MODE is currently not supporet for the CT2000 tape drive.") ; DAB 11-27-89 ;(setq tape-type :CT2000) ;(setq block-size 0.) ;(setq block-mode :variable) ;(setup-CT2000-tape :density density) ;(Format out-stream "~&Preparing the tape for a CT2000 tape drive with variable length block size.") ) ((eq tape-type :CT2000) (setq block-mode :fixed) (setup-CT2000-tape :block-size block-size :density density) (Format out-stream "~&Preparing the tape for a CT2000 tape drive with fixed length block size.") ) ((AND (EQ BLOCK-SIZE 512.) (EQ TAPE-TYPE :QUARTER-INCH)) (setq block-mode :fixed) (setq density 0.0) (setup-quarter-inch-tape) ) (t (ferror 'si:tape-error "~&Invalid arguments in the prepare-tape function.")) ) (setf (get 'mt:*current-unit* 'block-size) BLOCK-SIZE) (setf (get 'mt:*current-unit* 'tape-type) TAPE-TYPE) (setf (get 'mt:*current-unit* 'block-mode) BLOCK-MODE) (setf (get 'mt:*current-unit* 'density) density) ) ) )) #!C ; From file mtstr.LISP#> STREAMER-TAPE; sys: #10R MT#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "MT")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "sys: STREAMER-TAPE; mtstr.#" (DEFUN MAKE-MT-STREAM (&OPTIONAL &KEY (DIRECTION :INPUT) (BYTE-SIZE 8) (CHARACTERS T) (UNIT *NUPI-DEFAULT-UNIT*) (RECORD-SIZE *DEFAULT-RECORD-SIZE*) (DENSITY 0) (IBM-MODE NIL) &ALLOW-OTHER-KEYS) (CHECK-ARG DIRECTION (MEMBER DIRECTION '(:INPUT :OUTPUT) :TEST #'EQ) ":INPUT or :OUTPUT") (CHECK-TYPE BYTE-SIZE :NUMBER) (CHECK-ARG CHARACTERS (MEMBER CHARACTERS '(T NIL) :TEST #'EQ) "T or NIL") (MAKE-INSTANCE (IF (EQ DIRECTION :INPUT) (IF CHARACTERS (if (and (eq (get 'mt:*current-unit* 'block-mode) :variable) (not (eq (get 'mt:*current-unit* 'tape-type) :ct2000))) 'reel-mt-character-input-stream 'MT-CHARACTER-INPUT-STREAM) (if (and (eq (get 'mt:*current-unit* 'block-mode) :variable) (not (eq (get 'mt:*current-unit* 'tape-type) :ct2000))) 'reel-mt-input-stream 'MT-INPUT-STREAM)) (IF CHARACTERS (if (and (eq (get 'mt:*current-unit* 'block-mode) :variable) (not (eq (get 'mt:*current-unit* 'tape-type) :ct2000))) 'reel-mt-character-output-stream 'MT-CHARACTER-OUTPUT-STREAM) (if (and (eq (get 'mt:*current-unit* 'block-mode) :variable) (not (eq (get 'mt:*current-unit* 'tape-type) :ct2000))) 'reel-mt-output-stream 'MT-OUTPUT-STREAM))) :BYTE-SIZE BYTE-SIZE :UNIT UNIT :RECORD-SIZE RECORD-SIZE :DENSITY DENSITY :IBM-MODE IBM-MODE)) (DEFUN MAKE-MT-FILE-STREAM (&OPTIONAL &REST OPTIONS &KEY (DIRECTION :INPUT) (CHARACTERS :DEFAULT) (BYTE-SIZE :DEFAULT) (UNIT *NUPI-DEFAULT-UNIT*) (RECORD-SIZE *default-record-size*) (DENSITY 0) (IBM-MODE NIL) (PLIST NIL) (HEADER-STYLE :MIT) ;Default for write (PADDED T) &ALLOW-OTHER-KEYS &AUX STREAM TEM) "On input if called with PLIST, then assume header has been read and tape is positioned after header." (setq tape-header-length *NUPI-TAPE-HEADER-LENGTH*) (COND ((EQ DIRECTION :INPUT) (if plist nil ;don't read a new plist if header has been passed on tape (unwind-protect (MULTIPLE-VALUE-SETQ (PLIST HEADER-STYLE) (READ-MAGTAPE-HEADER (SETQ STREAM (APPLY 'MAKE-MT-STREAM :CHARACTERS T :BYTE-SIZE 8 :UNIT UNIT :DENSITY DENSITY OPTIONS)))) (if (streamp stream) (FUNCALL STREAM :CLOSE :RAW)))) (IF (NULL PLIST) (MAKE-EXPLORER-OPEN-ERROR unit) (progn (unless (GETF PLIST :PARTITION) ;Its a partition 6.22.87 (progn (AND (EQ BYTE-SIZE :DEFAULT) (SETQ BYTE-SIZE (GETF PLIST :BYTE-SIZE))) ;Moved 6.16.87 (AND (EQ CHARACTERS :DEFAULT) (IF (SETQ TEM (GETL (LOCF PLIST) '(:CHARACTERS))) (SETQ CHARACTERS (CADR TEM)) (let* ((type (getf plist :type)) (truename ;Don't guess, ask user. 6.16.87 (fs:make-pathname :host (or (si:parse-host (getf plist :host) t) si:local-host) ;Fix :directory (getf plist :directory) :name (getf plist :name) :type type :device (getf plist :device) :version (getf plist :version))) (canonical-type (send truename :canonical-type))) (MULTIPLE-VALUE-SETQ (CHARACTERS BYTE-SIZE) (FS:DETERMINE-IF-TYPE-KNOWN canonical-type type characters)) ;6.22.87 (unless byte-size ;nothing known, ask user 6.16.87 (MULTIPLE-VALUE-SETQ (CHARACTERS BYTE-SIZE) (FS:ASK-USER-FOR-CHARACTERS-AND-BYTE-SIZE TRUENAME CHARACTERS BYTE-SIZE)) (IF (NOT (MEMBER TYPE '(NIL :UNSPECIFIC) :TEST #'EQUAL)) (SETQ FS:*USER-DEFINED-TYPES* ;and remember user's answer. (ACONS TYPE (LIST CHARACTERS BYTE-SIZE) FS:*USER-DEFINED-TYPES*))))))) (AND (NULL BYTE-SIZE) (SETQ BYTE-SIZE (IF CHARACTERS 8 16))))) (setq stream (MAKE-INSTANCE (IF CHARACTERS (if (and (eq (get 'mt:*current-unit* 'block-mode) :variable) (not (eq (get 'mt:*current-unit* 'tape-type) :ct2000))) ; DAB 11-20-89 'reel-mt-file-character-input-stream (if (and *ASCII-PADDED-ENABLED* (getf plist :padded)) 'MT-FILE-CHARACTER-INPUT-STREAM-PADDED 'MT-FILE-CHARACTER-INPUT-STREAM)) (if (and (eq (get 'mt:*current-unit* 'block-mode) :variable) (not (eq (get 'mt:*current-unit* 'tape-type) :ct2000))) 'reel-mt-file-input-stream 'MT-FILE-INPUT-STREAM)) :BYTE-SIZE BYTE-SIZE :UNIT UNIT :RECORD-SIZE RECORD-SIZE :DENSITY DENSITY :PROPERTY-LIST PLIST :HEADER-FORMAT HEADER-STYLE :IBM-MODE IBM-MODE)) (IF (GETF PLIST :PARTITION) ;its a partition (send stream :set-expected-length ;record-size, bytes are 8-bit (* (GET (LOCF PLIST) :size) si:disk-block-byte-size)) ;size is in pages (PROGN (send stream :set-expected-length ;Not a partition (COND ((= BYTE-SIZE 16) ;expected is 8-bit bytes always (* 2 (OR (GETF PLIST :LENGTH-IN-BYTES) (GETF PLIST :LENGTH)))) (T (OR (GETF PLIST :LENGTH-IN-BYTES) ;which ever one (GETF PLIST :LENGTH))))) ;we're using today ! (SEND STREAM :SET-RECORD-SIZE (min (* (if (eq (get 'mt:*CURRENT-UNIT* 'BLOCK-MODE) :VARIABLE) VARIABLE-BLOCK-MAX-BLOCKS-PER-RQB MAX-BLOCKS-PER-RQB) SYS:DISK-BLOCK-BYTE-SIZE) (round-up-to-block (send stream :EXPECTED-LENGTH)))))) (send STREAM :SET-RUNNING-TOTAL 0) STREAM))) ((EQ DIRECTION :OUTPUT) (AND (EQ BYTE-SIZE :DEFAULT) (SETQ BYTE-SIZE (GETF PLIST :BYTE-SIZE))) (AND (EQ CHARACTERS :DEFAULT) (SETQ CHARACTERS (GETF PLIST :CHARACTERS))) ;6.16.87 (AND (NULL BYTE-SIZE) (SETQ BYTE-SIZE (IF CHARACTERS 8 16))) (let ((real-characters (if (getf plist :characters) t nil))) ;6.22.87 (setf (getf plist :characters) real-characters)) ;Remember as much as we can (when (and padded *ASCII-PADDED-ENABLED* (getf plist :characters)) ;7.14.87 (setf (getf plist :PADDED) T)) ;Declare PADDED in header written to tape. (unwind-protect (WRITE-MAGTAPE-HEADER (SETQ STREAM (APPLY 'MAKE-MT-STREAM :DIRECTION :OUTPUT :CHARACTERS T :BYTE-SIZE 8 :UNIT UNIT :RECORD-SIZE *NUPI-TAPE-HEADER-LENGTH* :DENSITY DENSITY OPTIONS)) PLIST HEADER-STYLE) (if (STREAMP STREAM) (FUNCALL STREAM :CLOSE :RAW))) (SETQ STREAM (MAKE-INSTANCE (IF CHARACTERS (if (and (eq (get 'mt:*current-unit* 'block-mode) :variable) (not (eq (get 'mt:*current-unit* 'tape-type) :ct2000))) 'reel-mt-file-character-output-stream 'MT-FILE-CHARACTER-OUTPUT-STREAM) (if (and (eq (get 'mt:*current-unit* 'block-mode) :variable) (not (eq (get 'mt:*current-unit* 'tape-type) :ct2000))) 'reel-mt-file-output-stream 'MT-FILE-OUTPUT-STREAM)) :BYTE-SIZE BYTE-SIZE :UNIT UNIT :RECORD-SIZE RECORD-SIZE :DENSITY DENSITY :PROPERTY-LIST PLIST :HEADER-FORMAT HEADER-STYLE :IBM-MODE IBM-MODE)) (UNLESS (GETF PLIST :PARTITION) (SEND STREAM :SET-RECORD-SIZE (MIN (* (if (eq (get 'mt:*current-unit* 'block-mode) :variable) variable-block-max-blocks-per-rqb max-blocks-per-rqb) sys:disk-block-byte-size) (ROUND-UP-TO-block (COND ((= BYTE-SIZE 16) (* 2 (OR (GETF PLIST :LENGTH-IN-BYTES) (GETF PLIST :LENGTH)))) (T (OR (GETF PLIST :LENGTH-IN-BYTES) ;which ever one (GETF PLIST :LENGTH)))))))) STREAM) (T (FERROR NIL "Probe opens not allowed on magtape.")))) ))