;;; -*- Mode:Lisp; Readtable:T; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.264
;;; Reason:
;;;  SI:RECEIVE-BAND & Friends:  If the user supplies a SUBSET-START argument,
;;;  and no SUBSET-N-BLOCKS argument, tell the other end, don't just let it
;;;  send starting from 0, while we write to where he told us.
;;; Written 9-May-88 04:10:16 by RWK at site Gigamos Cambridge
;;; while running on Claude Debussy from band 3
;;; with Experimental System 123.215, Experimental Local-File 73.3, Experimental FILE-Server 22.1, Experimental Unix-Interface 11.0, Experimental Tape 18.2, Experimental KERMIT 34.3, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, microcode 1756, SDU Boot Tape 3.14, SDU ROM 102, LOADED.



; From file DJ: L.SYS2; BAND.LISP#51 at 9-May-88 04:10:18
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; BAND  "

(DEFUNP BAND-TRANSFER-SERVER (&AUX CONN PKT STR TEM RQB BUF WRITE-P (QUANTUM 17.) PART-NAME
				   PART-BASE PART-SIZE PART-COMMENT SUB-START SUB-N NB TOP
				   (WINDOW 36.))
  (ERRSET
    (UNWIND-PROTECT
      (PROG ()
	(SETQ CONN (CHAOS:LISTEN "BAND-TRANSFER" WINDOW))
	(IF (CHAOS:UNWANTED-CONNECTION-P CONN)
	    (RETURN (CHAOS:UNWANTED-REJECT CONN))
	  (SETQ STR (CHAOS:PKT-STRING (CHAOS:READ-PKTS CONN)))	;Look at the RFC
	  (LET ((*READ-BASE* 10.))	;RFC is BAND-TRANSFER READ/WRITE band subset size comment
				;subset is NIL or list of rel start and n-blocks
	    (SETQ TEM (READ-FROM-STRING (STRING-APPEND "(" STR ")"))))
	  (AND (NULL BAND-TRANSFER-SERVER-ON)
	       (NOT (MEMBER USER-ID '(NIL "")))
	       (RETURN (CHAOS:REJECT CONN (FORMAT NIL "This machine is in use by ~A" USER-ID))))
	  (MULTIPLE-VALUE (PART-BASE PART-SIZE NIL PART-NAME)
	    (SYS:FIND-DISK-PARTITION (THIRD TEM)))
	  (OR PART-BASE
	      (RETURN (CHAOS:REJECT CONN (FORMAT NIL "No /"~A/" partition here." PART-NAME))))
	  (when (FOURTH TEM)
	    (SETQ SUB-START (FIRST (FOURTH TEM)) SUB-N (SECOND (FOURTH TEM)))
	    (unless sub-n
	      ;; Default SUB-N to the number of blocks remaining.
	      ;; Don't make the user do this calculation, and *ESPECIALLY*
	      ;; don't just transfer the wrong blocks if he doesn't supply
	      ;; this number!!!  NIL or unspecified means "all of the rest"
	      ;; just like in the sequence functions.  Even the >> ZetaLisp <<
	      ;; string functions work this way.  I wasted two hours of my
	      ;; time on this idiocy.  --RWK
	      (setq sub-n (- part-size sub-start))))
	  (COND ((STRING-EQUAL (SECOND TEM) "READ")
		 (SETQ WRITE-P NIL)
		 (SETQ PART-COMMENT (PARTITION-COMMENT PART-NAME 0)))
		((STRING-EQUAL (SECOND TEM) "WRITE")
		 (SETQ WRITE-P T)
		 (OR ( (FIFTH TEM) PART-SIZE)
		     (RETURN (CHAOS:REJECT CONN (FORMAT NIL "Partition too small, ~D>~D"
							(FIFTH TEM) PART-SIZE))))
		 (SETQ PART-SIZE (FIFTH TEM))
		 (SETQ PART-COMMENT (STRING (SIXTH TEM))))	;Comment to store later
		(T (RETURN (CHAOS:REJECT CONN "Illegal operation, must be READ or WRITE"))))
	  (AND SUB-START (OR (MINUSP SUB-START) (MINUSP SUB-N) (> (+ SUB-START SUB-N) PART-SIZE))
	       (RETURN (CHAOS:REJECT CONN "Subset outside of partition")))
	  (CHAOS:ACCEPT CONN)
	  (AND (EQ BAND-TRANSFER-SERVER-ON ':NOTIFY)
	       (PROCESS-RUN-FUNCTION "Notify" 'TV:NOTIFY NIL
				     "BAND-TRANSFER-SERVER: ~:[READ~;WRITE~] of ~A partition by ~A"
				     WRITE-P PART-NAME
				     (CHAOS:HOST-DATA (CHAOS:FOREIGN-ADDRESS CONN))))
	  (FUNCALL TV:WHO-LINE-FILE-STATE-SHEET ':ADD-SERVER CONN "BAND-TRANSFER")
	  (COND ((NOT WRITE-P)			;Send packet containing size, comment
		 (SETQ PART-SIZE (MEASURED-SIZE-OF-PARTITION PART-NAME))
		 (SETQ PKT (CHAOS:GET-PKT))
		 (CHAOS:SET-PKT-STRING PKT (FORMAT NIL "~D ~S" PART-SIZE PART-COMMENT))
		 (CHAOS:SEND-PKT CONN PKT)))
	  (AND SUB-START (SETQ PART-BASE (+ PART-BASE SUB-START)
			       PART-SIZE SUB-N))
	  (COND (WRITE-P (UPDATE-PARTITION-COMMENT PART-NAME "Incomplete Copy" 0)))
	  (SETQ RQB (SYS:GET-DISK-RQB QUANTUM)
		BUF (SYS:RQB-BUFFER RQB))
	  (SETQ DISK-ERROR-RETRY-COUNT 20.)	;Try to bypass hardware overrun problem
	  (WIRE-DISK-RQB RQB)
	  (SETQ TOP (+ PART-BASE PART-SIZE))
	  (DO ((BLOCK PART-BASE (+ BLOCK QUANTUM)))
	      (( BLOCK TOP))
	    (AND (< (SETQ NB (- TOP BLOCK)) QUANTUM)
		 (WIRE-DISK-RQB RQB (SETQ QUANTUM NB)))
	    (COND ((NOT WRITE-P)		;This can modify pages without setting
		   (DISK-READ-WIRED RQB 0 BLOCK)	; the modified bits, but as long as
						; we dont depend on data after its unwired,
						; it wont hurt.
		   (ARRAY-TO-NET BUF CONN (* QUANTUM PAGE-SIZE 2)))
		  (T (ARRAY-FROM-NET BUF CONN (* QUANTUM PAGE-SIZE 2))
		     (DISK-WRITE-WIRED RQB 0 BLOCK))))
	  (CHAOS:FINISH-CONN CONN)
	  (CHAOS:CLOSE-CONN CONN "Done")
	  (AND WRITE-P (UPDATE-PARTITION-COMMENT PART-NAME PART-COMMENT 0))))
      (AND RQB (SYS:RETURN-DISK-RQB RQB))
      (AND CONN (PROGN (FUNCALL TV:WHO-LINE-FILE-STATE-SHEET ':DELETE-SERVER CONN)
		       (CHAOS:REMOVE-CONN CONN))))
    NIL))

))

; From file DJ: L.SYS2; BAND.LISP#51 at 9-May-88 04:32:21
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; BAND  "

(DEFUNP BAND-TRANSFER-SERVER (&AUX CONN PKT STR TEM RQB BUF WRITE-P (QUANTUM 17.) PART-NAME
				   PART-BASE PART-SIZE PART-COMMENT SUB-START SUB-N NB TOP
				   (WINDOW 36.))
  (ERRSET
    (UNWIND-PROTECT
      (PROG ()
	(SETQ CONN (CHAOS:LISTEN "BAND-TRANSFER" WINDOW))
	(IF (CHAOS:UNWANTED-CONNECTION-P CONN)
	    (RETURN (CHAOS:UNWANTED-REJECT CONN))
	  (SETQ STR (CHAOS:PKT-STRING (CHAOS:READ-PKTS CONN)))	;Look at the RFC
	  (LET ((*READ-BASE* 10.))	;RFC is BAND-TRANSFER READ/WRITE band subset size comment
				;subset is NIL or list of rel start and n-blocks
	    (SETQ TEM (READ-FROM-STRING (STRING-APPEND "(" STR ")"))))
	  (AND (NULL BAND-TRANSFER-SERVER-ON)
	       (NOT (MEMBER USER-ID '(NIL "")))
	       (RETURN (CHAOS:REJECT CONN (FORMAT NIL "This machine is in use by ~A" USER-ID))))
	  (MULTIPLE-VALUE (PART-BASE PART-SIZE NIL PART-NAME)
	    (SYS:FIND-DISK-PARTITION (THIRD TEM)))
	  (OR PART-BASE
	      (RETURN (CHAOS:REJECT CONN (FORMAT NIL "No /"~A/" partition here." PART-NAME))))
	  (when (FOURTH TEM)
	    (SETQ SUB-START (FIRST (FOURTH TEM)) SUB-N (SECOND (FOURTH TEM)))
	    (unless sub-n
	      ;; Default SUB-N to the number of blocks remaining.
	      ;; Don't make the user do this calculation, and *ESPECIALLY*
	      ;; don't just transfer the wrong blocks if he doesn't supply
	      ;; this number!!!  NIL or unspecified means "all of the rest"
	      ;; just like in the sequence functions.  Even the >> ZetaLisp <<
	      ;; string functions work this way.  I wasted two hours of my
	      ;; time on this idiocy.  --RWK
	      (setq sub-n (- part-size sub-start))))
	  (COND ((STRING-EQUAL (SECOND TEM) "READ")
		 (SETQ WRITE-P NIL)
		 (SETQ PART-COMMENT (PARTITION-COMMENT PART-NAME 0)))
		((STRING-EQUAL (SECOND TEM) "WRITE")
		 (SETQ WRITE-P T)
		 (OR ( (FIFTH TEM) PART-SIZE)
		     (RETURN (CHAOS:REJECT CONN (FORMAT NIL "Partition too small, ~D>~D"
							(FIFTH TEM) PART-SIZE))))
		 (SETQ PART-SIZE (FIFTH TEM))
		 (SETQ PART-COMMENT (STRING (SIXTH TEM))))	;Comment to store later
		(T (RETURN (CHAOS:REJECT CONN "Illegal operation, must be READ or WRITE"))))
	  (AND SUB-START (OR (MINUSP SUB-START) (MINUSP SUB-N) (> (+ SUB-START SUB-N) PART-SIZE))
	       (RETURN (CHAOS:REJECT CONN "Subset outside of partition")))
	  (CHAOS:ACCEPT CONN)
	  (AND (EQ BAND-TRANSFER-SERVER-ON ':NOTIFY)
	       (PROCESS-RUN-FUNCTION "Notify" 'TV:NOTIFY NIL
				     "BAND-TRANSFER-SERVER: ~:[READ~;WRITE~] of ~A partition by ~A"
				     WRITE-P PART-NAME
				     (CHAOS:HOST-DATA (CHAOS:FOREIGN-ADDRESS CONN))))
	  (FUNCALL TV:WHO-LINE-FILE-STATE-SHEET ':ADD-SERVER CONN "BAND-TRANSFER")
	  (COND ((NOT WRITE-P)			;Send packet containing size, comment
		 (SETQ PART-SIZE (MEASURED-SIZE-OF-PARTITION PART-NAME))
		 (SETQ PKT (CHAOS:GET-PKT))
		 (CHAOS:SET-PKT-STRING PKT (FORMAT NIL "~D ~S" PART-SIZE PART-COMMENT))
		 (CHAOS:SEND-PKT CONN PKT)))
	  (AND SUB-START (SETQ PART-BASE (+ PART-BASE SUB-START)
			       PART-SIZE SUB-N))
	  (COND (WRITE-P (UPDATE-PARTITION-COMMENT PART-NAME "Incomplete Copy" 0)))
	  (SETQ RQB (SYS:GET-DISK-RQB QUANTUM)
		BUF (SYS:RQB-BUFFER RQB))
	  (SETQ DISK-ERROR-RETRY-COUNT 20.)	;Try to bypass hardware overrun problem
	  (WIRE-DISK-RQB RQB)
	  (SETQ TOP (+ PART-BASE PART-SIZE))
	  (DO ((BLOCK PART-BASE (+ BLOCK QUANTUM)))
	      (( BLOCK TOP))
	    (AND (< (SETQ NB (- TOP BLOCK)) QUANTUM)
		 (WIRE-DISK-RQB RQB (SETQ QUANTUM NB)))
	    (COND ((NOT WRITE-P)		;This can modify pages without setting
		   (DISK-READ-WIRED RQB 0 BLOCK)	; the modified bits, but as long as
						; we dont depend on data after its unwired,
						; it wont hurt.
		   (ARRAY-TO-NET BUF CONN (* QUANTUM PAGE-SIZE 2)))
		  (T (ARRAY-FROM-NET BUF CONN (* QUANTUM PAGE-SIZE 2))
		     (DISK-WRITE-WIRED RQB 0 BLOCK))))
	  (CHAOS:FINISH-CONN CONN)
	  (CHAOS:CLOSE-CONN CONN "Done")
	  (AND WRITE-P (UPDATE-PARTITION-COMMENT PART-NAME PART-COMMENT 0))))
      (AND RQB (SYS:RETURN-DISK-RQB RQB))
      (AND CONN (PROGN (FUNCALL TV:WHO-LINE-FILE-STATE-SHEET ':DELETE-SERVER CONN)
		       (CHAOS:REMOVE-CONN CONN))))
    NIL))

))

; From file DJ: L.SYS2; BAND.LISP#51 at 9-May-88 04:32:39
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; BAND  "

(DEFUNP RECEIVE-BAND (FROM-MACHINE FROM-PART TO-PART
		      &OPTIONAL SUBSET-START SUBSET-N-BLOCKS (TO-UNIT 0)
		      (WIREP (SI:SELECT-PROCESSOR ((:CADR :LAMBDA) T)
						  ((:EXPLORER :FALCON) NIL)))
		      &AUX CONN PKT STR TEM RQB BUF (QUANTUM 17.) (WINDOW 36.)
		      NB TOP PART-BASE ORIG-PART-BASE PART-SIZE PART-COMMENT (N-HUNDRED 0))
  "Read the FROM-PART partition from FROM-MACHINE into our partition TO-PART.
If SUBSET-START or SUBSET-N-BLOCKS is specified, they say which part
of the partition to transfer.  They are measured in blocks (or pages).
If a transfer dies, use the last number it printed, times 100.,
as SUBSET-START, to resume where it left off."
  ;; QUANTUM is number of disk blocks we write at once.
  ;; WINDOW is window size for net connection.
  ;; I think it is best if WINDOW is big enough to transfer a whole quantum.
 (UNWIND-PROTECT
   (PROGN
     (MULTIPLE-VALUE (PART-BASE PART-SIZE NIL TO-PART)
       (FIND-DISK-PARTITION-FOR-WRITE TO-PART NIL TO-UNIT))
     (WHEN PART-BASE
       (SETQ CONN (CHAOS:CONNECT FROM-MACHINE
				 (FORMAT NIL "BAND-TRANSFER READ ~A ~D"
					 FROM-PART (AND (or subset-start SUBSET-N-BLOCKS)
							(LIST (or SUBSET-START 0) SUBSET-N-BLOCKS)))
				 WINDOW))
       (OR SUBSET-START (SETQ SUBSET-START 0))
       ;; Receive packet containing size and comment
       (SETQ PKT (CHAOS:GET-NEXT-PKT CONN)
	     STR (CHAOS:PKT-STRING PKT))
       (SETQ TEM (LET ((*READ-BASE* 10.)) (READ-FROM-STRING STR)))
       (OR ( TEM PART-SIZE)
	   (RETURN (FORMAT NIL "Does not fit in local partition, ~D>~D" TEM PART-SIZE)))
       (SETQ PART-SIZE TEM)
       (SETQ TEM (STRING-SEARCH-CHAR #/SP STR))
       (SETQ PART-COMMENT (READ-FROM-STRING STR NIL (1+ TEM)))
       (FORMAT T "~&Receiving ~A's ~A into ~A: ~D blocks, ~A~%"
	       FROM-MACHINE FROM-PART TO-PART PART-SIZE PART-COMMENT)
       (CHAOS:RETURN-PKT PKT)
       (SETQ ORIG-PART-BASE PART-BASE)
       (SETQ PART-BASE (+ PART-BASE SUBSET-START)
	     PART-SIZE (- PART-SIZE SUBSET-START))
       (AND SUBSET-N-BLOCKS (SETQ PART-SIZE SUBSET-N-BLOCKS))
       (UPDATE-PARTITION-COMMENT TO-PART "Incomplete Copy" TO-UNIT)
       (SETQ RQB (SYS:GET-DISK-RQB QUANTUM)
	     BUF (SYS:RQB-BUFFER RQB))
       (SETQ DISK-ERROR-RETRY-COUNT 20.)	;Try to bypass hardware overrun problem
       (AND WIREP (WIRE-DISK-RQB RQB))
       (SETQ TOP (+ PART-BASE PART-SIZE))
       (DO ((BLOCK PART-BASE (+ BLOCK QUANTUM)))
	   (( BLOCK TOP))
	 (COND ((< (SETQ NB (- TOP BLOCK)) QUANTUM)
		(SETQ QUANTUM NB)
		(IF WIREP
		    (WIRE-DISK-RQB RQB QUANTUM))))
	 (AND ( (SETQ TEM (TRUNCATE (- BLOCK ORIG-PART-BASE) 100.)) N-HUNDRED)
	      (FORMAT T "~D " (SETQ N-HUNDRED TEM)))
	 (ARRAY-FROM-NET BUF CONN (* QUANTUM PAGE-SIZE 2))
	 (IF WIREP (DISK-WRITE-WIRED RQB TO-UNIT BLOCK) (DISK-WRITE RQB TO-UNIT BLOCK)))
       (CHAOS:CLOSE-CONN CONN "Done")
       (OR SUBSET-N-BLOCKS (UPDATE-PARTITION-COMMENT TO-PART PART-COMMENT TO-UNIT))))
   (AND RQB (SYS:RETURN-DISK-RQB RQB))
   (AND CONN (CHAOS:REMOVE-CONN CONN)))
 T)

))

; From file DJ: L.SYS2; BAND.LISP#51 at 9-May-88 04:32:46
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; BAND  "

(DEFUNP COMPARE-BAND (FROM-MACHINE FROM-PART TO-PART	
		      &OPTIONAL SUBSET-START SUBSET-N-BLOCKS (TO-UNIT 0)
		      &AUX CONN PKT STR TEM RQB BUF BUF1 (QUANTUM 17.) NB TOP ORIG-PART-BASE
			   PART-BASE PART-SIZE PART-COMMENT (N-HUNDRED 0))
  "Compare the FROM-PART partition from FROM-MACHINE with our partition TO-PART.
If SUBSET-START or SUBSET-N-BLOCKS is specified, they say which part
of the partition to compare.  They are measured in blocks (or pages).
If the operation dies, use the last number it printed, times 100.,
as SUBSET-START, to resume where it left off."
 (UNWIND-PROTECT
   (PROGN
     (MULTIPLE-VALUE (PART-BASE PART-SIZE) (FIND-DISK-PARTITION-FOR-READ TO-PART NIL TO-UNIT))
     (SETQ CONN (CHAOS:CONNECT FROM-MACHINE
			       (FORMAT NIL "BAND-TRANSFER READ ~A ~D"
				       FROM-PART (AND (or subset-start SUBSET-N-BLOCKS)
						      (LIST (or SUBSET-START 0) SUBSET-N-BLOCKS)))
			       QUANTUM))
     (OR SUBSET-START (SETQ SUBSET-START 0))
     ;; Receive packet containing size and comment
     (SETQ PKT (CHAOS:GET-NEXT-PKT CONN)
	   STR (CHAOS:PKT-STRING PKT))
     (SETQ TEM (LET ((*READ-BASE* 10.)) (READ-FROM-STRING STR)))
     (OR ( TEM PART-SIZE)
	 (RETURN (FORMAT NIL "Does not fit in local partition, ~D>~D" TEM PART-SIZE)))
     (SETQ PART-SIZE TEM)
     (SETQ TEM (STRING-SEARCH-CHAR #/SP STR))
     (SETQ PART-COMMENT (READ-FROM-STRING STR NIL (1+ TEM)))
     (FORMAT T "~&Comparing ~A with ~A from ~A: ~D blocks, ~A~%"
	     TO-PART FROM-PART FROM-MACHINE PART-SIZE PART-COMMENT)
     (CHAOS:RETURN-PKT PKT)
     (SETQ ORIG-PART-BASE PART-BASE)
     (SETQ PART-BASE (+ PART-BASE SUBSET-START)
	   PART-SIZE (- PART-SIZE SUBSET-START))
     (AND SUBSET-N-BLOCKS (SETQ PART-SIZE SUBSET-N-BLOCKS))
     (SETQ RQB (SYS:GET-DISK-RQB QUANTUM)
	   BUF (SYS:RQB-BUFFER RQB)
	   BUF1 (MAKE-ARRAY (ARRAY-LENGTH BUF) ':TYPE 'ART-16B))
     (SETQ DISK-ERROR-RETRY-COUNT 20.)		;Try to bypass hardware overrun problem
     (WIRE-DISK-RQB RQB)
     (SETQ TOP (+ PART-BASE PART-SIZE))
     (DO ((BLOCK PART-BASE (+ BLOCK QUANTUM)))
	 (( BLOCK TOP))
       (AND (< (SETQ NB (- TOP BLOCK)) QUANTUM)
	    (WIRE-DISK-RQB RQB (SETQ QUANTUM NB)))
       (AND ( (SETQ TEM (TRUNCATE (- BLOCK ORIG-PART-BASE) 100.)) N-HUNDRED)
	    (FORMAT T "~D " (SETQ N-HUNDRED TEM)))
       (ARRAY-FROM-NET BUF1 CONN (* QUANTUM PAGE-SIZE 2))
       (DISK-READ-WIRED RQB TO-UNIT BLOCK)
       (UNLESS (LET ((ALPHABETIC-CASE-AFFECTS-STRING-COMPARISON T))
		 (%STRING-EQUAL BUF 0
				BUF1 0
				(* #o2000 QUANTUM)))
	 (DO ((B BLOCK (1+ B)))
	     ((= B (+ BLOCK QUANTUM)))
	   (DO ((I (* (- B BLOCK) 1000) (1+ I))
		(N (* (1+ (- B BLOCK)) 1000))
		(NDIFFS 0))
	       ((= I N)
		(OR (ZEROP NDIFFS)
		    (LET ((SPT (AREF DISK-SECTORS-PER-TRACK-ARRAY 0))
			  (HPC (AREF DISK-HEADS-PER-CYLINDER-ARRAY 0)))
		      (FORMAT T "~&Block ~S (cyl ~O surf ~O sec ~O here, rel ~S) differs in ~D halfwords~%"
			      B (TRUNCATE B (* HPC SPT)) (TRUNCATE (\ B (* HPC SPT)) SPT)
			      (\ B SPT) (- B ORIG-PART-BASE) NDIFFS))))
	     (OR (= (AREF BUF I) (AREF BUF1 I)) (SETQ NDIFFS (1+ NDIFFS)))))))
     (CHAOS:CLOSE-CONN CONN "Done"))
   (AND RQB (SYS:RETURN-DISK-RQB RQB))
   (AND CONN (CHAOS:REMOVE-CONN CONN)))
 T)

))

; From file DJ: L.SYS2; BAND.LISP#51 at 9-May-88 04:32:55
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; BAND  "

(DEFUNP TRANSMIT-BAND (FROM-PART TO-MACHINE TO-PART
		       &OPTIONAL SUBSET-START SUBSET-N-BLOCKS
		       &AUX CONN TEM RQB BUF (QUANTUM 17.) NB TOP
			    PART-BASE ORIG-PART-BASE PART-SIZE PART-COMMENT (N-HUNDRED 0))
  "Write the FROM-PART partition on FROM-MACHINE from our partition TO-PART.
If SUBSET-START or SUBSET-N-BLOCKS is specified, they say which part
of the partition to transfer.  They are measured in blocks (or pages).
If a transfer dies, use the last number it printed, times 100.,
as SUBSET-START, to resume where it left off."
 (UNWIND-PROTECT
   (PROGN
     (MULTIPLE-VALUE (PART-BASE PART-SIZE) (FIND-DISK-PARTITION-FOR-READ FROM-PART))
     (SETQ PART-SIZE (MEASURED-SIZE-OF-PARTITION FROM-PART)
	   PART-COMMENT (PARTITION-COMMENT FROM-PART 0))
     (SETQ CONN (CHAOS:CONNECT TO-MACHINE
			       (FORMAT NIL "BAND-TRANSFER WRITE ~A ~D ~D ~S"
				       TO-PART
				       (AND (or subset-start SUBSET-N-BLOCKS)
					    (LIST (or SUBSET-START 0) SUBSET-N-BLOCKS))
				       PART-SIZE PART-COMMENT)))
     (OR SUBSET-START (SETQ SUBSET-START 0))
     (FORMAT T "~&Transmitting ~A to ~A on ~A: ~D blocks, ~A~%"
	     FROM-PART TO-PART TO-MACHINE PART-SIZE PART-COMMENT)
     (SETQ ORIG-PART-BASE PART-BASE)
     (SETQ PART-BASE (+ PART-BASE SUBSET-START)
	   PART-SIZE (- PART-SIZE SUBSET-START))
     (AND SUBSET-N-BLOCKS (SETQ PART-SIZE SUBSET-N-BLOCKS))
     (SETQ RQB (SYS:GET-DISK-RQB QUANTUM)
	   BUF (SYS:RQB-BUFFER RQB))
     (SETQ DISK-ERROR-RETRY-COUNT 20.)		;Try to bypass hardware overrun problem
     (WIRE-DISK-RQB RQB)
     (SETQ TOP (+ PART-BASE PART-SIZE))
     (DO ((BLOCK PART-BASE (+ BLOCK QUANTUM)))
	 (( BLOCK TOP))
       (AND (< (SETQ NB (- TOP BLOCK)) QUANTUM)
	    (WIRE-DISK-RQB RQB (SETQ QUANTUM NB)))
       (AND ( (SETQ TEM (TRUNCATE (- BLOCK ORIG-PART-BASE) 100.)) N-HUNDRED)
	    (FORMAT T "~D " (SETQ N-HUNDRED TEM)))
       (DISK-READ-WIRED RQB 0 BLOCK)	;Modifies pages without setting modified bits.
					;This is ok since it remains wired while we care.
	 (ARRAY-TO-NET BUF CONN (* QUANTUM PAGE-SIZE 2)))
     (CHAOS:FINISH-CONN CONN)
     (CHAOS:CLOSE-CONN CONN "Done"))
   (AND RQB (SYS:RETURN-DISK-RQB RQB))
   (AND CONN (CHAOS:REMOVE-CONN CONN)))
 T)

))