;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*- ;;; Patch file for CDI version 1.16 ;;; Reason: ;;; Last tape system patches (right? right!) ;;; Written 11-Jul-86 11:10:58 by Gibson at site CDI Dallas ;;; while running on EXPLORER-1 from band 1 ;;; with System 110.232, Lambda-Diag 7.17, Experimental Local-File 68.7, FILE-Server 18.4, Unix-Interface 9.1, ZMail 65.14, Object Lisp 3.4, Tape 6.39, Site Data Editor 3.3, Tiger 24.0, KERMIT 31.3, Gateway 4.15, TCP-Kernel 39.7, TCP-User 62.7, TCP-Server 45.5, MEDIUM-RESOLUTION-COLOR 3.4, MICRO-COMPILATION-TOOLS 3.2, System Revision Level 3.93, Experimental Window-Maker 2.0, Experimental CDI 1.15, microcode 1564, CDI Beta III. ; From file S2: >Lambda-3>TAPE>TFRAME-COMS.LISP.41 at 11-Jul-86 11:11:10 #10R TFRAME#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TFRAME"))) (COMPILER::PATCH-SOURCE-FILE "SYS: TAPE; tframe-coms lisp " (define-command BACKUP-FILESYSTEM (BACKUP) "L: Back up the whole local file system. {M: from pathname option}" :left (let ((file-list (with-status ("Surveying directories ...") (case *backup-mode* (:incremental (tape:list-new-files)) (:full (tape:list-all-files)))))) (when file-list (tape:backup-files file-list si:local-host :tape-info-function 'backup-file-info-generator :set-backup-bits *record-files-as-backed-up* :compare *verify-files*))) :middle (when *global-pathname-arg* (let* ((pathname (fs:parse-pathname *global-pathname-arg*)) (file-list (with-status ("Surveying directories for pathname: ~A" pathname) (tape:full-directory-list pathname :inferiors t :filter-keywords (when (eq *backup-mode* :incremental) '(:not-backed-up t)))))) (when file-list (tape:backup-files file-list (send pathname :host) :tape-info-function 'backup-file-info-generator :set-backup-bits *record-files-as-backed-up* :compare *verify-files*)))) :documentation "~ Backup a filesystem. If the left button is used, the domain of files is all files in the filesystem. If the middle button is used, the \"global pathname argument\" must specify a wildcarded pathname which is passed to FS:DIRECTORY-LIST to determine a list of the files to backup. Various options will affect the backup as documented.") )) ; From file S2: >Lambda-3>TAPE>lmfl-format.lisp.201 at 11-Jul-86 11:11:17 #10R TAPE#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TAPE"))) (COMPILER::PATCH-SOURCE-FILE "SYS: tape; LMFL-FORMAT lisp " (defmethod (lmfl-format :write-file) (device file &key (end-of-tape-action :continue) silent) (check-device device) (check-type file (or string pathname list)) (check-type end-of-tape-action (member :continue :error :return)) (let ((pathname (if (consp file) (fs:parse-pathname (car file)) (fs:parse-pathname file))) (properties (if (consp file) (cdr file)))) (with-open-file (instream pathname :direction :input :characters (or (getf properties :characters) :default)) (unless properties (setq properties (send instream :plist))) (block write-file (unless silent (format t "~&Writing file: ~a" pathname)) (Setq current-plist nil) (let ((props (check-plist-validity (or properties (send instream :plist)))) (byte-factor (/ (file-byte-size instream) 8)) (chunk-size (floor (send device :optimal-chunk-size record-size) record-size)) (truename (send instream :truename)) number-of-records last-record-fill) ;; +++ kludge to indicate byte size actually used to write the file to tape +++ ;; +++ problem occurs on unknown file types -- confusion about byte size +++ (When (Null (Getf props :byte-size)) (nconc props (list :byte-size (file-byte-size instream)))) (condition-case (condition) (send self :write-file-header device truename props) (physical-end-of-tape (ecase end-of-tape-action (:error (signal 'end-of-tape-writing-header :file-plist (cons nil props) :device device)) (:continue (setq tape-modified nil) (Get-Next-Tape "Physical end of tape. Continue on next tape. Unloading..." self device) (send self :write-file-header device truename props)) (:return (return-from write-file (make-condition 'end-of-tape-writing-header :file-plist (cons nil props) :device device)))))) (using-resource (buffer si:dma-buffer (* chunk-size (/ record-size *bytes-per-page*))) (multiple-value-bind (a b) (floor (* (send instream :length) byte-factor) record-size) (setq number-of-records (if (zerop b) a (add1 a)) last-record-fill (/ (if (zerop b) record-size b) byte-factor))) (do* ((record-count 0) (rs (/ record-size byte-factor)) (records-this-pass (min (- number-of-records record-count) chunk-size) (min (- number-of-records record-count) chunk-size)) (last-bunch (<= (- number-of-records record-count) chunk-size) (<= (- number-of-records record-count) chunk-size)) (buffer-array (ecase byte-factor (1 (si:dma-buffer-8b buffer)) (2 (si:dma-buffer-16b buffer))))) ((= record-count number-of-records) (condition-case (condition) (send device :write-filemark) (physical-end-of-tape)) t) (send instream :string-in nil buffer-array 0 (if (not last-bunch) (* records-this-pass rs) ;; stupid format lossage (array-initialize buffer-array 0 (+ (* (sub1 records-this-pass) rs) last-record-fill) (* records-this-pass rs)) (+ (* (sub1 records-this-pass) rs) last-record-fill))) (condition-case (condition) (send device :write-array buffer-array records-this-pass record-size) (physical-end-of-tape (ecase end-of-tape-action ((:error :return) (let ((cond (make-condition 'end-of-tape-writing-file :file-plist (cons nil props) :device device :bytes-transferred (* (+ record-count (send condition :data-transferred)) rs)))) (case end-of-tape-action (:return (return-from write-file cond)) (:error (signal cond))))) (:continue (setq tape-modified nil) (Get-Next-Tape "Physical end of tape encountered. Continue on next tape. Unloading..." self device) (let ((records-written (send condition :data-transferred))) (send self :write-file-header device (fs:parse-pathname "lm:continuation.file#0") (let ((bytes-left (- (or (send-if-handles instream :length-in-bytes) (send instream :length)) (* (+ record-count records-written) rs)))) (list :byte-size (file-byte-size props) :length-in-bytes bytes-left :length-in-blocks (ceiling (* bytes-left byte-factor) *bytes-per-page*) :continuation-properties props))) (using-resource (temp-buffer si:dma-buffer (* (- records-this-pass records-written) (/ rs *bytes-per-page*))) (copy-array-portion buffer-array (* records-written rs) (* records-this-pass record-size) (case byte-factor (1 (si:dma-buffer-8b temp-buffer)) (2 (si:dma-buffer-16b temp-buffer))) 0 (* (- records-this-pass records-written) rs)) (send device :write-array (si:dma-buffer-8b temp-buffer) (- records-this-pass records-written) record-size)) (incf record-count records-this-pass))))) (:no-error (incf record-count records-this-pass))))))))) ) ;;; Need to do a better job than this. (properties may be in a different order, etc.) )) ; From file S2: >Lambda-3>TAPE>TFRAME-COMS.LISP.41 at 11-Jul-86 11:11:49 #10R TFRAME#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TFRAME"))) (COMPILER::PATCH-SOURCE-FILE "SYS: TAPE; tframe-coms lisp " (Defun Space-Forward-Files (format device n) (with-status ("Spacing Forward ~d Files ..." n) (Send format :next-file device n))) (define-command FORWARD-FILES (control) "Space forward N files. L: use global numeric argument {M: Enter from Keyboard}" :left (Space-Forward-Files tape:*selected-format* tape:*selected-device* *global-numeric-arg*) :middle (let ((number (prompt-and-read :number "~&Number of file to space forward by >> "))) (if (typep number '(integer 1)) (Space-Forward-Files tape:*selected-format* tape:*selected-device* number) (tv:beep) (format t "~&~%Number must be an integer greater than 1!~%"))) :documentation "~ This moves the tape forward by files. If the left mouse button is used, then the \"global numeric argument\" determined the number of files to space over. If the middle button is used, the number of files must be specified by the user.") ))