;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Private patches made by pld
;;; Reason:
;;;  TCP-BUFFERED-STREAM buffers are a resource
;;; Written 7-Jun-88 13:59:30 by pld (Peter L. DeWolf) at site Gigamos Cambridge
;;; while running on Azathoth from band 1
;;; with Experimental System 124.25, Experimental Local-File 74.1, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.1, Experimental Tape 23.6, Experimental Lambda-Diag 16.1, microcode 1756, SDU Boot Tape 3.14, SDU ROM 8, the old ones.



; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#55 at 7-Jun-88 13:59:41
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defresource simple-art-8b-buffer (size)
  :constructor (make-array size :element-type '(unsigned-byte 8.) :fill-pointer 0)
  :matcher (<= size (array-length object)))

;;;***TCP-STREAM-MIXIN

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#55 at 7-Jun-88 14:01:19
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-buffered-stream :build-buffers) ()
  (multiple-value-bind (send receive)
      (funcall socket :mss)
    (setq input-buffer-size receive)
    (setq output-buffer-size send))
  (dotimes (i input-buffer-limit)
    (let ((buffer (allocate-resource 'simple-art-8b-buffer input-buffer-size)))
      (send socket :receive buffer)))
  (dotimes (i output-buffer-limit)
    (let ((buffer (allocate-resource 'simple-art-8b-buffer output-buffer-size)))
      (push buffer output-buffer-list))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#55 at 7-Jun-88 14:01:20
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-buffered-stream :build-more-buffers) (&optional (new-input-limit input-buffer-limit)
								(new-output-limit output-buffer-limit))
  (when (> new-input-limit input-buffer-limit)
    (dotimes (i (- new-input-limit input-buffer-limit))
      (let ((buffer (allocate-resource 'simple-art-8b-buffer input-buffer-size)))
	(send socket :receive buffer)))
    (setq input-buffer-limit new-input-limit))
  (when (> new-output-limit output-buffer-limit)
    (dotimes (i (- new-output-limit output-buffer-limit))
      (let ((buffer (allocate-resource 'simple-art-8b-buffer output-buffer-size)))
	(push buffer output-buffer-list)))
    (setq output-buffer-limit new-output-limit)))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#55 at 7-Jun-88 14:01:21
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-buffered-stream :discard-buffer) (buffer)
  (deallocate-resource 'simple-art-8b-buffer buffer))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#55 at 7-Jun-88 14:01:30
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-buffered-stream :after :close) (ignore)
  (dolist (x (fifo-as-list input-buffer-fifo))
    (deallocate-resource 'simple-art-8b-buffer x))
  (setq input-buffer-fifo nil))
  (dolist (x output-buffer-list)
    (deallocate-resource 'simple-art-8b-buffer x))
  (setq output-buffer-list nil))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#55 at 7-Jun-88 14:01:33
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-unbuffered-stream :discard-buffer) ()
  )

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#55 at 7-Jun-88 14:01:39
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-stream-mixin :handle-replies) (&optional no-hang-p)
  (loop
    (cond ((send socket :listen)					;Activity on the socket
	   (let ((item (send socket :read-data)))
	     (case (first item)
	       (:open
		(send self :build-buffers)
		(return :open))
	       (:write-reply
		(incf bytes-written (fill-pointer (second item)))
		(send self :write-reply (second item))
		(return :write-reply))
	       (:data
		(let ((length (fill-pointer (second item)))
		      (offset (fourth item)))
		  (when offset			;Remember last known offset of urgent data
		    (setq urgent-offset (+ bytes-read offset 1))
		    (setq urgent-input t))
		  (incf bytes-read length)
		  (when (eq (third item) :eof)
		    (setq closing t))
		  (send self :read-reply (second item) urgent-offset))
		(return :read-reply))
	       (:urgent				;should signal this somehow...
		(setq urgent-input t))
	       (:closing						;Remote side has closed
		(setq closing t)
		(dolist (x (second item))
		  (send self :discard-buffer x))
		(return :remote-close))
	       (:reset
		(setq closing t)
		(setq open nil)
		(dolist (x (second item))
		  (send self :discard-buffer))
		(dolist (b (third item))
		  (send self :write-reply b))
		;;(cerror "Continue, treating as end-of-file" "Connection reset remotely")
		(return :reset))
	       (:close							;Socket closed out from under us
		(setq closing t)
		(setq open nil)
		(dolist (x (second item))
		  (send self :discard-buffer))
		;;(cerror "Continue, treating as end-of-file" "Connection reset locally")
		(return :local-close))
	       ((:network-unreachable :host-unreachable :protocol-unreachable :port-unreachable)
		(setq closing t)
		(setq open nil)
		(send socket :abort)
		(return :unreachable))
	       (:timeout
		(setq timeout t)
		(return :timeout))
	       (:closed
		(return :closed))
	       (otherwise
		;;Ignore it
		))))
	  (no-hang-p							;No activity and no-hang
	   (return nil))
	  (t								;No activity -- wait
	   (send self :wait-for-reply)))))

))