;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.116
;;; Reason:
;;;  Speedup for 16-bit files in FTP-ACCESS: The binary stream uses art-16b
;;;  arrays, the TCP stream uses art-8b arrays, and these are simply
;;;  displaced onto each other, rather than forcing data copies.
;;; Written 19-Nov-87 17:32:00 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.115, Experimental Local-File 73.2, Experimental FILE-Server 22.1, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.0, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Site Data Editor 8.4, microcode 1754, SDU Boot Tape 3.12, SDU ROM 8.



; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP-ACCESS.LISP#39 at 19-Nov-87 17:33:13
#10R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP-ACCESS  "


(defmethod (ftp-input-binary-stream :next-input-buffer) (&optional no-hang-p)
  ;; maybe change this in the future to call :next-input-buffer
  ;; copy the contents, then call :discard-input-buffer on actual.
  (ecase byte-size
    (8
     (send actual :next-input-buffer no-hang-p))
    (16
     (multiple-value-bind (array start end)
	 (send actual :next-input-buffer no-hang-p)
       (when array
	 (when (oddp (- end start))
	   (error "16 bit stream, but odd byte count in input buffer"))
	 (let ((length (ceiling (- end start) 2)))
	   (values (make-array length
			       :element-type '(unsigned-byte 16)
			       :displaced-to array
			       :displaced-index-offset start)
		   0
		   length)))))))

))

; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP-ACCESS.LISP#39 at 19-Nov-87 17:33:18
#10R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP-ACCESS  "


(defmethod (ftp-input-binary-stream :discard-input-buffer) (array)
  (ecase byte-size
    (8
     (send actual :discard-input-buffer array))
    (16
     (send actual :discard-input-buffer (net:original-array array)))))


))

; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP-ACCESS.LISP#39 at 19-Nov-87 17:33:28
#10R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP-ACCESS  "


(defmethod (ftp-output-binary-stream :new-output-buffer) ()
  (declare (values array start end))
  (ecase byte-size
    (8
     (send actual :new-output-buffer))
    (16
     (let* ((array (send actual :new-output-buffer))
	    (length (floor (array-length array) 2)))
       (values (make-array length
			   :element-type '(unsigned-byte 16)
			   :displaced-to array)
	       0
	       length)))))


))

; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP-ACCESS.LISP#39 at 19-Nov-87 17:33:31
#10R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP-ACCESS  "


(defmethod (ftp-output-binary-stream :send-output-buffer) (array end)
  (ecase byte-size
    (8
     (send actual :send-output-buffer array end))
    (16
     (send actual :send-output-buffer (net:original-array array) (* end 2)))))

))

; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP-ACCESS.LISP#39 at 19-Nov-87 17:33:32
#10R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP-ACCESS  "


(defmethod (ftp-output-binary-stream :discard-output-buffer) (array)
  (ecase byte-size
    (8
     (send actual :discard-output-buffer array))
    (16
     (send actual :discard-output-buffer (net:original-array array)))))

))