;;; -*- Mode:Lisp; Readtable:T; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.2
;;; Reason:
;;;  Attempt to make band transfers reliable.  Clean up old code.
;;;  Remove calls to obsolete machine-dependent functions.
;;; Written 25-May-88 15:05:10 by pld (Peter L. DeWolf) at site Gigamos Cambridge
;;; while running on Azathoth from band 2
;;; with Experimental System 124.1, Experimental Local-File 74.0, Experimental File-Server 23.0, Experimental Unix-Interface 12.0, Experimental ZMail 72.0, Experimental Tape 23.0, Experimental Lambda-Diag 16.0, microcode 1756, SDU Boot Tape 3.14, SDU ROM 8.



; From modified file DJ: L.SYS2; BAND.LISP#51 at 25-May-88 15:05:47
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; BAND  "


(DEFUN 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 TOP
			     (WINDOW 36.))
  (CONDITION-CASE (ERROR)
      (UNWIND-PROTECT
	  (BLOCK NIL
	    (SETQ CONN (CHAOS:LISTEN "BAND-TRANSFER" WINDOW))
	    (AND (CHAOS:UNWANTED-CONNECTION-P CONN)
		 (RETURN (CHAOS:UNWANTED-REJECT CONN)))
	    (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))))
	    (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 ")"))))
	    (MULTIPLE-VALUE-SETQ (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))))
	    (SEND TV:WHO-LINE-FILE-STATE-SHEET :ADD-SERVER CONN "BAND-TRANSFER")
	    (UNLESS 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))
	    (WHEN WRITE-P
	      (UPDATE-PARTITION-COMMENT PART-NAME "Incomplete Copy" 0))
	    (SETQ RQB (SYS:GET-DISK-RQB QUANTUM)
		  BUF (SYS:RQB-BUFFER RQB))
	    (SETQ TOP (+ PART-BASE PART-SIZE))
	    (DO ((BLOCK PART-BASE (+ BLOCK QUANTUM)))
		((>= BLOCK TOP))
	      (SETQ QUANTUM (MIN QUANTUM (- TOP BLOCK)))
	      (COND ((NOT WRITE-P)
		     (DISK-READ RQB 0 BLOCK)
		     (ARRAY-TO-NET BUF CONN (* QUANTUM PAGE-SIZE 2)))
		    (T
		     (ARRAY-FROM-NET BUF CONN (* QUANTUM PAGE-SIZE 2))
		     (DISK-WRITE 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))
	(WHEN CONN
	  (SEND TV:WHO-LINE-FILE-STATE-SHEET :DELETE-SERVER CONN)
	  (CHAOS:REMOVE-CONN CONN)))
    (ERROR NIL)))

))

; From modified file DJ: L.SYS2; BAND.LISP#51 at 25-May-88 15:05:49
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; BAND  "


(DEFUN RECEIVE-BAND (FROM-MACHINE FROM-PART TO-PART
		     &OPTIONAL SUBSET-START SUBSET-N-BLOCKS (TO-UNIT 0)
		     &AUX CONN PKT STR TEM RQB BUF (QUANTUM 17.) (WINDOW 36.)
		     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
      (BLOCK NIL
	(MULTIPLE-VALUE-SETQ (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 TOP (+ PART-BASE PART-SIZE))
	  (DO ((BLOCK PART-BASE (+ BLOCK QUANTUM)))
	      ((>= BLOCK TOP))
	    (SETQ QUANTUM (MIN QUANTUM (- TOP BLOCK)))
	    (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))
	    (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 modified file DJ: L.SYS2; BAND.LISP#51 at 25-May-88 15:05:51
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; BAND  "


(DEFUN 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.) (WINDOW 36.)
		     TOP PART-BASE ORIG-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
      (BLOCK NIL
	(MULTIPLE-VALUE-SETQ (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
				  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 "~&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 TOP (+ PART-BASE PART-SIZE))
	(DO ((BLOCK PART-BASE (+ BLOCK QUANTUM)))
	    ((>= BLOCK TOP))
	  (SETQ QUANTUM (MIN QUANTUM (- TOP BLOCK)))
	  (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 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 modified file DJ: L.SYS2; BAND.LISP#51 at 25-May-88 15:05:53
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; BAND  "


(DEFUN TRANSMIT-BAND (FROM-PART TO-MACHINE TO-PART
		      &OPTIONAL SUBSET-START SUBSET-N-BLOCKS
		      &AUX CONN TEM RQB BUF (QUANTUM 17.) 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
      (BLOCK NIL
	(MULTIPLE-VALUE-SETQ (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 TOP (+ PART-BASE PART-SIZE))
	(DO ((BLOCK PART-BASE (+ BLOCK QUANTUM)))
	    ((>= BLOCK TOP))
	  (SETQ QUANTUM (MIN QUANTUM (- TOP BLOCK)))
	  (AND (//= (SETQ TEM (TRUNCATE (- BLOCK ORIG-PART-BASE) 100.)) N-HUNDRED)
	       (FORMAT T "~D " (SETQ N-HUNDRED TEM)))
	  (DISK-READ RQB 0 BLOCK)
	  (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)

))


;;;And the following, noticed while tracking down band transfer unreliability:
;;;SOMEBODY made (si:wire-disk-rqb) be a function that simply called
;;;(si:wire-disk-rqb-old) with the same arguments.  Nobody else in the system
;;;calls (si:wire-disk-rqb-old).  Get rid of useless extra layer....


; From file DJ: L.IO; DISK.LISP#419 at 25-May-88 15:07:42
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; DISK  "

(DEFUN WIRE-DISK-RQB (RQB &OPTIONAL (N-PAGES (rqb-npages rqb))
		      		    (WIRE-P T)
				    SET-MODIFIED
			  &AUX (LONG-ARRAY-FLAG (%P-LDB %%ARRAY-LONG-LENGTH-FLAG RQB))
			       (LOW (%POINTER-DIFFERENCE
				      (%POINTER RQB)
				      (%POINTER-PLUS (ARRAY-LEADER-LENGTH RQB) 2)))
			       (HIGH (%POINTER-PLUS (%POINTER RQB)
				      (%POINTER-PLUS 1
				       (%POINTER-PLUS LONG-ARRAY-FLAG
						      (FLOOR (ARRAY-LENGTH RQB) 2))))))
  (lambda-or-cadr-only)
  (DO ((LOC (LOGAND LOW (- PAGE-SIZE)) (%POINTER-PLUS LOC PAGE-SIZE)))
      (( (%POINTER-DIFFERENCE LOC HIGH) 0))
    (%WIRE-PAGE LOC WIRE-P SET-MODIFIED))
  ;; Having wired the rqb, if really wiring set up CCW-list N-PAGES long
  ;; and CLP to it, but if really unwiring make CLP point to NXM as err check
  (IF (NOT WIRE-P)
      (SETF (AREF RQB %DISK-RQ-CCW-LIST-POINTER-LOW)  #o177777	;Just below TV buffer
            (aref RQB %DISK-RQ-CCW-LIST-POINTER-HIGH) #o76)
    (DO ((CCWX 0 (1+ CCWX))
	 (VADR (%POINTER-PLUS LOW PAGE-SIZE)
	       (%POINTER-PLUS VADR PAGE-SIZE))	;Start with 2nd page of rqb array
	 (PADR))
	(( CCWX N-PAGES)	;Done, set END in last CCW
	 (SETQ PADR (%PHYSICAL-ADDRESS (%POINTER-PLUS (%POINTER RQB)
					(%POINTER-PLUS 1
					 (%POINTER-PLUS LONG-ARRAY-FLAG
							(FLOOR %DISK-RQ-CCW-LIST 2))))))
	 (SETF (aref RQB %DISK-RQ-CCW-LIST-POINTER-LOW) PADR)
	 (SETF (aref RQB %DISK-RQ-CCW-LIST-POINTER-HIGH) (LSH PADR -16.)))
      (SETQ PADR (%PHYSICAL-ADDRESS VADR))
      (SETF (AREF RQB (+ %DISK-RQ-CCW-LIST (* 2 CCWX)))
	    (+ (LOGAND (- PAGE-SIZE) PADR)		;Low 16 bits
	       (IF (= CCWX (1- N-PAGES)) 0 1)))		;Chain bit
      (SETF (AREF RQB (+ %DISK-RQ-CCW-LIST 1 (* 2 CCWX)))
	    (LSH PADR -16.)))))				;High 6 bits

(fundefine 'si:wire-disk-rqb-old)

))