;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*- ;;; Patch file for System version 123.7 ;;; Reason: ;;; Allow :stream-flavor keyword for (tcpa:define-network-service) ;;; Written 28-Aug-87 16:26:32 by pld (Peter L. DeWolf) at site LMI Cambridge ;;; while running on Azathoth from band 2 ;;; with Experimental System 123.5, Experimental Local-File 73.0, Experimental FILE-Server 22.0, 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 6.0, microcode 1754, SDU Boot Tape 3.12, SDU ROM 102. ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; GENERIC-SERVER.LISP#20 at 28-Aug-87 16:26:33 #10R TCP-APPLICATION#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP-APPLICATION"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; GENERIC-SERVER  " (defmacro define-network-service (name protocol-name transport-protocol documentation &body keywords) "Causes the system to create a socket to listen on LISTEN-PORT. TRANSPORT-PROTOCOL may be either :TCP or :UDP for stream and datagram oriented services respectively. When somebody connects to this port a process is created in which the TOPLEVEL-FUNCTION is called on a stream connected to the active socket. The stream and socket are automatically closed when the function exits. If AUTO-ENABLE? is non-NIL, this server will enabled by calls to (enable-all-network-services), which is run whenever TCP is initialized." (declare (arglist name protocol-name transport-protocol documentation &key toplevel-function listen-port auto-enable? stream-flavor)) `(*define-network-service ',name ',protocol-name ',transport-protocol ',documentation ,@keywords)) (defun *define-network-service (name protocol-name transport-protocol documentation &key toplevel-function listen-port auto-enable? stream-flavor) (when (global:record-source-file-name name 'define-network-service) (setf (documentation name 'network-service) (or documentation name)) (let ((service (set name (make-network-service)))) (pushnew name *network-services*) (setf (network-service-name service) protocol-name) (setf (network-service-transport-protocol service) transport-protocol) (setf (network-service-listen-port service) (eval listen-port)) (setf (network-service-toplevel-function service) toplevel-function) (setf (network-service-auto-enable? service) auto-enable?) (setf (network-service-stream-flavor service) stream-flavor) (setf (network-service-active-servers service) nil) (setf (network-service-listening-server service) nil) (setf (network-service-lock service) nil)) name)) ))