;;; -*- Mode: Common-Lisp; Package: MT; Base: 10.; Patch-File: T -*- ;;; Reason: Fixed error message in restore-partition. ;;; 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. ;;; Written 07/06/89 14:40:26 by BERGER, ;;; while running on ARIES from band LOD1 ;;; With SYSTEM 6.10, VIRTUAL-MEMORY 6.1, EH 6.3, MAKE-SYSTEM 6.0, MICRONET 6.0, LOCAL-FILE 6.0, ;;; BASIC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.1, NETWORK-NAMESPACE 6.0, ;;; DISK-IO 6.0, DISK-LABEL 6.0, BASIC-FILE 6.2, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0, ;;; COMPILER 6.6, TV 6.12, DATALINK 6.0, CHAOSNET 6.0, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.1, ;;; SYSLOG 6.1, STREAMER-TAPE 6.3, UCL 6.0, INPUT-EDITOR 6.0, METER 6.1, ZWEI 6.3, ;;; DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.1, DATALINK-DISPLAYS 6.0, ;;; FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.2, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.0, ;;; IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.0, TELNET 6.0, VT100 6.0, ;;; NAMESPACE-EDITOR 6.0, PROFILE 6.1, VISIDOC 6.2, TI-CLOS 6.10, CLEH 6.4, IP 3.47, ;;; Experimental BUG 11.10, Experimental CLX 6.2, CLUE 6.8, X11M 6.1, microcode 429, ;;; Band Name: 6.0 + patches 6/26 #!C ; From file PART-STREAM.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; PART-STREAM.#" (DEFUN RESTORE-PARTITION (TO-UNIT TO-PART &OPTIONAL &KEY (BUF-SIZE 6) (N-BUFFERS 5) (OUT-STREAM *STANDARD-OUTPUT*) &AUX MT-CLOSURE proceed-option) "Stream copy a partition from tape to TO-PART partition on TO-UNIT. Buf-size (in Kbytes) and n-buffers define the buffer pool." (let ((aborted-p T) cpu-type TO-PART-BASE) ;use to see if user answered NO on clobber query.. (UNWIND-PROTECT (LET (FROM-PART-BASE FROM-PART-SIZE TO-PART-SIZE FROM-UNIT FROM-PART PART-COMMENT STARTING-HUNDRED TO-END partition-namestring) (SETQ FROM-UNIT *CURRENT-UNIT* FROM-PART "") ;always a tape! oops... how do we get unit number? (SETQ TO-UNIT (SI::DECODE-UNIT-ARGUMENT TO-UNIT (FORMAT () "writing ~A partition" TO-PART) () T)) (MULTIPLE-VALUE-SETQ (TO-PART-BASE TO-PART-SIZE NIL TO-PART nil partition-namestring) ; 3/23/87 mp (SYSTEM:FIND-DISK-PARTITION-FOR-WRITE TO-PART () TO-UNIT)) (do ((Completed? nil) ; DAB 03-21-89 (restart-on-block 0)) ; DAB 03-21-89 ((eq completed? :complete)) ; DAB 03-21-89 (setq MT-CLOSURE (SI::DECODE-UNIT-ARGUMENT "MT:" (FORMAT () "reading ~A partition" FROM-PART))) (MULTIPLE-VALUE-SETQ (FROM-PART-BASE FROM-PART-SIZE NIL FROM-PART) (SYSTEM:FIND-DISK-PARTITION-FOR-READ FROM-PART () MT-CLOSURE)) (ASSURE-PARTITION-OR-FERROR MT-CLOSURE) (IF TO-PART-BASE (block restore-block (SETQ PART-COMMENT (SYSTEM:PARTITION-COMMENT () MT-CLOSURE)) (FORMAT OUT-STREAM "~&Copying ~S" PART-COMMENT) (SYSTEM:UPDATE-PARTITION-COMMENT partition-namestring "Incomplete Copy" TO-UNIT) ;it was to-part 3/23/87 mp (SETQ STARTING-HUNDRED (OR (SEND MT-CLOSURE :GET :STARTING-OFFSET) 0)) (unless (zerop restart-on-block) (when (SEND MT-CLOSURE :GET :MULTI-MEDIA) (format t "%Multi-media: sh:~d;mM:~d" starting-hundred (SEND MT-CLOSURE :GET :MULTI-MEDIA)) (unless (= starting-hundred (SEND MT-CLOSURE :GET :MULTI-MEDIA)) (if (setf proceed-option (handle-eom-and-maybe-proceed (format nil "The tape seems to be out of order.~%The starting offset of this tape is ~a, we were expecting ~a.~%Do you what to continue with another tape?" starting-hundred restart-on-block) out-stream T)) (unless (eql proceed-option :proceed) (return-from restore-block)) ;YES, continue (return (setf completed? :complete)))))) (UNLESS (ZEROP STARTING-HUNDRED) (FORMAT OUT-STREAM " starting at ~D. hundred Kbyte offset." STARTING-HUNDRED)) (ADDRESS-CHECK TO-PART-BASE TO-PART-SIZE partition-namestring ;it was TO-PART 3/23/87 mp (+ TO-PART-BASE (* 100 STARTING-HUNDRED)) ;init (- FROM-PART-SIZE (* 100 STARTING-HUNDRED))) ;total needed (SETQ TO-END (+ TO-PART-BASE (MIN FROM-PART-SIZE TO-PART-SIZE))) (SETQ FROM-PART-SIZE (- FROM-PART-SIZE (* STARTING-HUNDRED 100))) (MULTIPLE-VALUE-SETQ (N-BUFFERS BUF-SIZE) (BUFFER-POOL-ADJUST (MIN TO-PART-SIZE FROM-PART-SIZE) N-BUFFERS BUF-SIZE)) (setf (values completed? restart-on-block) (STREAM-DATA-COPY FROM-UNIT TO-UNIT (+ TO-PART-BASE (* 100 STARTING-HUNDRED)) ;start-up-adr TO-END ;end size N-BUFFERS BUF-SIZE OUT-STREAM STARTING-HUNDRED)) ;;; DAB 04-03-89 If we hit the end of tape lets give the user a chance to continue. (if (eq completed? :end-of-tape) (if (handle-eom-and-maybe-proceed "The end of tape was encountered before completing the restore.~%Do you what to continue with another tape?" out-stream) () ;YES, continue (return (setf completed? :complete))) ;No, then just return. (WHEN (EQ completed? :COMPLETE) (SYSTEM:UPDATE-PARTITION-COMMENT partition-namestring PART-COMMENT TO-UNIT) ;; it was to-part (when (setq cpu-type (send mt-closure :get :cpu-type)) ;3/23/87 mp (si:set-partition-cpu-type partition-namestring to-unit cpu-type))) ))) ) ; DAB 03-21-89 DO (setf aborted-p nil) ) ;let unwind protects (when (closurep mt-closure) (unless aborted-p (setq aborted-p (null to-part-base))) (si:set-in-closure mt-closure 'mt:*abort-flag* aborted-p)) (SI::DISPOSE-OF-UNIT MT-CLOSURE)))) ))