;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*- ;;; Patch file for System version 124.33 ;;; Reason: ;;; The buffers used by a TCP buffered stream are now a resource. ;;; Written 7-Jun-88 16:13:03 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 file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#59 at 7-Jun-88 17:19:54 #10R TCP#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  " (global:defresource simple-art-8b-buffer (size) :constructor (make-array size :element-type '(unsigned-byte 8.) :fill-pointer 0) :matcher (<= size (array-length object))) )) ; From file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#59 at 7-Jun-88 17:20:23 #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 :abort) () (setq open nil) (when (funcall socket :abort) (do () ((eq (send self :handle-replies) :reset))))) )) ; From file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#59 at 7-Jun-88 17:20:34 #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 x)) (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 x)) ;;(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))))) )) ; From file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#59 at 7-Jun-88 17:20:42 #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 :send-timeout) (&aux ok) (unwind-protect (progn (cerror "Reset timeout and continue" "Send timed out") (funcall socket :reset-timeout) (setq timeout nil) (setq ok t)) (unless ok (send self :abort)))) )) ; From file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#59 at 7-Jun-88 17:20:49 #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 (global:allocate-resource 'simple-art-8b-buffer input-buffer-size))) (unless (send socket :receive buffer) (global:deallocate-resource 'simple-art-8b-buffer buffer)))) (dotimes (i output-buffer-limit) (let ((buffer (global:allocate-resource 'simple-art-8b-buffer output-buffer-size))) (push buffer output-buffer-list)))) )) ; From file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#59 at 7-Jun-88 17:20:54 #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 (global:allocate-resource 'simple-art-8b-buffer input-buffer-size))) (unless (send socket :receive buffer) (global:deallocate-resource 'simple-art-8b-buffer 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 (global:allocate-resource 'simple-art-8b-buffer output-buffer-size))) (push buffer output-buffer-list))) (setq output-buffer-limit new-output-limit))) )) ; From file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#59 at 7-Jun-88 17:21:00 #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) (global:deallocate-resource 'simple-art-8b-buffer buffer)) )) ; From file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#59 at 7-Jun-88 17:21:13 #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-input-buffer) (buffer) (cond (closing (send self :discard-buffer buffer)) ((funcall socket :receive buffer)) (t (send self :discard-buffer buffer)))) )) ; From file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#59 at 7-Jun-88 17:21:27 #10R TCP#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  " (global:defwrapper (tcp-buffered-stream :close) (ignore . body) `(unwind-protect (progn ,@body) (send self :discard-all-buffers))) )) ; From file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#59 at 7-Jun-88 17:21:32 #10R TCP#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  " (global:defwrapper (tcp-buffered-stream :abort) (ignore . body) `(unwind-protect (progn ,@body) (send self :discard-all-buffers))) )) ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#59 at 7-Jun-88 17:21:59 #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-all-buffers) () (let ((input-buffers (fifo-as-list input-buffer-fifo)) (output-buffers output-buffer-list)) (setq input-buffer-fifo nil) (setq output-buffer-list nil) (dolist (x input-buffers) (send self :discard-buffer (car x))) (dolist (x output-buffers) (send self :discard-buffer x)))) )) ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#59 at 7-Jun-88 17:22:12 #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) (ignore) ) )) ; From modified file DJ: L.WINDOW; PEEK.LISP#208 at 6-Jun-88 17:37:16 #8R TV#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TV"))) (COMPILER::PATCH-SOURCE-FILE "SYS: WINDOW; PEEK  " (defun peek-file-host-pre-process (item) (let* ((host (getf (tv:scroll-item-plist item) :host)) (access (getf (tv:scroll-item-plist item) :access)) (host-units (getf (tv:scroll-item-plist item) :host-units)) (new-access (send host :access)) (new-host-units (send-if-handles new-access :host-units))) (unless (and (eq access new-access) (equal host-units new-host-units)) (setf (getf (tv:scroll-item-plist item) :access) new-access) (setf (getf (tv:scroll-item-plist item) :host-units) new-host-units) (setf (cdr (tv:scroll-item-component-items item)) (append (send host :peek-file-system-header) (send host :peek-file-system)))))) )) ; From file DJ: L.NETWORK.KERNEL; CONFIGURE.LISP#103 at 7-Jun-88 17:25:56 #10R NETWORK#: #!:CL (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "NETWORK"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERNEL; CONFIGURE  " (defun cleanup () (unless (and (boundp '*loopback-interface*) *loopback-interface* (ni-enabled *loopback-interface*)) ;;Only do this if network is deconfigured (chaos:reset nil) (setq chaos:made-pkts nil) (setq chaos:pkts-made 0) (setq chaos:free-pkts nil) (setq chaos:los-pkts nil) (setq chaos:current-los-pkt-count 0) (setq net:*network-interfaces* nil) (setq net:*network-protocol-streams* nil) (setq ethernet:*3com-ethernet-interface* nil) (setq ethernet:*excelan-ethernet-interface* nil) (setq ethernet:explorer-ethernet-interface nil) (setq chaos:cadr-network-interface nil) (setq si:share-interface nil) (setq net:*loopback-interface* nil) (setq arp:*arp-stream* nil) (setq chaos:*chaos-stream* nil) (setq ip:*ip-stream* nil) (setq ip:*free-ip-headers* nil) (setq ip:*route-table* nil) (setq ip:*default-network-numbers* nil) (setq ip:*default-gateway* nil) (setq ip:*default-interface* nil) (setq ip:*network-list* nil) (setq ip:*queued-packet-fifo* (make-fifo)) (setq icmp:*icmp-stream* nil) (setq icmp:*free-icmp-messages* nil) (setq udp:*udp-stream* nil) (setq udp:*free-udp-buffers* nil) (setq udp:*free-udp-headers* nil) (setq tcp:*tcp-stream* nil) (setq tcp:*free-tcp-buffers* nil) (setq tcp:*free-tcp-headers* nil) (setq tcp:*send-blocked-sockets* (make-fifo)) (setq tcp:*send-blocked-control-packets* (make-fifo)) (setq tcp:*global-timeouts* nil) (setq tcp:*tcp-log* (make-fifo)) (setq tcpa:*udp-rwho-server-packets* nil) (si:clear-resource 'tcp:simple-art-8b-buffer) )) ))