;;; -*- Mode:Lisp; Readtable:T; Package:USER; Base:10; Patch-File:T -*- ;;; Private patches made by EFH ;;; Reason: ;;; ;;; Written 3-Jan-86 12:54:15 by EFH, ;;; while running on Waiting for Godot from band 2 ;;; with System 102.176, Local-File 56.13, FILE-Server 13.2, Unix-Interface 5.6, MagTape 40.23, ZMail 57.10, Tiger 20.10, KERMIT 26.25, MEDIUM-RESOLUTION-COLOR 17.4, Experimental Sited 1.0, Experimental window-maker 1.0, Experimental MICRO-COMPILATION-TOOLS 4.0, Experimental ObjectLISP 2.0, Experimental vista 1.0, Experimental IRIS 1.0, TCP-Kernel 30.12, TCP-User 57.11, TCP-Server 33.5, microcode 778. ; From file DRIVER-DEFS.LISP#> TCP.KERNEL; LAM6: (34) #10R TCP#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TCP"))) (COMPILER#:PATCH-SOURCE-FILE "TCP: KERNEL; DRIVER-DEFS  " (DEFVAR *EXINTR-REQUEST-TABLE* (MAKE-ARRAY 200)) (DEFUN EXINTR (&AUX (READ-MP (RMSG-AREA-LASTR RMSGAREA)) KP REQUEST-CODE REPLY-CODE GOT-NEW-REPLIES) (DO-FOREVER (COND ((NOT (ZEROP (LOGAND ; no new replies from exos ? (READ-UCHAR *DMA* (MSG-OFFSET READ-MP) 'MESSAGES-STATUS) (LOGIOR MQ-DONE MQ-EXOS)))) (COND (GOT-NEW-REPLIES ; if we already processed some (OUTB PORTB 0) ; bump board because we returned x2h msgs (SETQ GOT-NEW-REPLIES NIL)) ; go back to beginning of loop. (T (RETURN)))) ; otherwise, just punt (T (COND ((NOT GOT-NEW-REPLIES) ; if this is the first one (SETQ GOT-NEW-REPLIES T) (UNLESS (ZEROP (LOGAND (INB PORTB) 2)) (OUTB PORTA 1)))) (SETQ REQUEST-CODE (READ-UCHAR *DMA* (MSG-OFFSET READ-MP) 'MESSAGES-REQUEST)) (SETQ REPLY-CODE (READ-UCHAR *DMA* (MSG-OFFSET READ-MP) 'MESSAGES-REPLY)) (UNLESS (OR (EQ REQUEST-CODE NET-PANIC) ; these are emitted spontaneously by exos (EQ REQUEST-CODE NET-PRINTF) ; i.e. no corresponding request (EQ REQUEST-CODE IM-ALIVE)) ; was made by the host. (SETQ KP (FIND-KLUDGE (READ-LONG *DMA* (MSG-OFFSET READ-MP) 'MESSAGES-USERID)))) (LET ((TABLE *EXINTR-REQUEST-TABLE*) (HANDLER)) (IF (OR (< REQUEST-CODE 0) (NOT (< REQUEST-CODE (LENGTH TABLE))) (NOT (SETQ HANDLER (AREF TABLE REQUEST-CODE)))) (FERROR 'TCP-ERROR "unknown message type #x~X.~%" REQUEST-CODE)) (FUNCALL HANDLER READ-MP REQUEST-CODE KP REPLY-CODE)) (WITHOUT-INTERRUPTS (WRITE-UCHAR (LOGIOR MQ-EXOS MQ-DONE) ; return the message to exos *DMA* (MSG-OFFSET READ-MP) 'MESSAGES-STATUS) (SETF (RMSG-AREA-LASTR RMSGAREA) ; check out next msg in queue (SETQ READ-MP (MSG-LINK READ-MP)))))))) (DEFMACRO DEFEXINTR (NAME OTHER-CODES &BODY BODY) (LET ((BNAME (INTERN (FORMAT NIL "EXINTR_~A" NAME)))) `(PROGN (DEFUN ,BNAME (READ-MP REQUEST-CODE KP REPLY-CODE) READ-MP REQUEST-CODE KP REPLY-CODE ,@BODY) (SETUP-EXINTR ',BNAME ',(CONS NAME OTHER-CODES))))) (DEFUN SETUP-EXINTR (FNAME CODES) (DOLIST (CODE CODES) (WHEN (OR (NOT (ATOM CODE)) (RECORD-SOURCE-FILE-NAME (CAR CODES) 'DEFEXINTR)) (LET ((N (IF (ATOM CODE) (SYMEVAL CODE) (EVAL CODE)))) (WHEN (OR (NOT *EXINTR-REQUEST-TABLE*) (NOT (< N (LENGTH *EXINTR-REQUEST-TABLE*)))) (LET ((NEW (MAKE-ARRAY (1+ N)))) (REPLACE NEW *EXINTR-REQUEST-TABLE*) (SETQ *EXINTR-REQUEST-TABLE* NEW))) (SETF (AREF *EXINTR-REQUEST-TABLE* N) (FSYMEVAL FNAME)))))) (DEFEXINTR SOSOCKET () (SETF (KLUDGE-SOID KP) (READ-SHORT *DMA* (MSG-OFFSET READ-MP) 'MESSAGES-SOID)) (FINISH-KLUDGE KP REPLY-CODE)) (DEFEXINTR SOACCEPT (SOCONNECT SOSOCKETADDR) (LET ((ISADDR (NOT (ZEROP (READ-SHORT *DMA* (MSG-OFFSET READ-MP) 'SOCK-CMD-ISADDR))))) (IF ISADDR ;;; copy the sockaddr from dma into lisp (COPY-ARRAY-PORTION *DMA* (+ (MSG-OFFSET READ-MP) SOCK-CMD-SADDR-BASE) (+ (MSG-OFFSET READ-MP) SOCK-CMD-SADDR-BASE SIZEOF-SOCKADDR) (KLUDGE-SA KP) 0 SIZEOF-SOCKADDR)) (FINISH-KLUDGE KP REPLY-CODE))) (DEFEXINTR SOSELWAKEUP NIL (FERROR 'TCP-ERROR "SOSELWAKEUP Exos command not supported.~%")) (DEFEXINTR SOSELECT NIL (FERROR 'TCP-ERROR "SOSELECT Exos command not supported.~%")) (DEFEXINTR SOIOCTL NIL (LET ((LENGTH ; from 1 to 4 bytes of 'ioctl' data (SELECT (READ-SHORT *DMA* (MSG-OFFSET READ-MP) 'SOCK-IOCTL-IOCCMD) (FIONREAD 4) ((SIOCGKEEP SIOCGLINGER SIOCATMARK SIOCGPGRP) 2) (SIOCRCVOOB 1) (OTHERWISE 0)))) (SELECTQ LENGTH (1 (SETF (KLUDGE-DATA KP) (READ-UCHAR *DMA* (MSG-OFFSET READ-MP) 'SOCK-IOCTL-IOCDATA-CHAR))) (2 (SETF (KLUDGE-DATA KP) (READ-SHORT *DMA* (MSG-OFFSET READ-MP) 'SOCK-IOCTL-IOCDATA-SHORT))) (4 (SETF (KLUDGE-DATA KP) (READ-LONG *DMA* (MSG-OFFSET READ-MP) 'SOCK-IOCTL-IOCDATA-LONG)))) (FINISH-KLUDGE KP REPLY-CODE))) (DEFEXINTR EXIOCHTONS NIL (SETF (KLUDGE-DATA KP) (READ-SHORT *DMA* (MSG-OFFSET READ-MP) 'MESSAGES-SOID)) (FINISH-KLUDGE KP REPLY-CODE)) (DEFEXINTR LINK-NET-MODE NIL (SETF (KLUDGE-DATA KP) (CONS (READ-UCHAR *DMA* (MSG-OFFSET READ-MP) 'LINK-NMODE-OPTMASK) (READ-UCHAR *DMA* (MSG-OFFSET READ-MP) 'LINK-NMODE-MODE))) (FINISH-KLUDGE KP REPLY-CODE)) (DEFEXINTR LINK-NET-ADDRS NIL (SETF (KLUDGE-DATA KP) (READ-48BITS *DMA* (MSG-OFFSET READ-MP) 'LINK-NADDRESS-ADDR)) (FINISH-KLUDGE KP REPLY-CODE)) (DEFEXINTR LINK-NET-RECV NIL (SETF (KLUDGE-DATA KP) (READ-UCHAR *DMA* (MSG-OFFSET READ-MP) 'LINK-NRECV-REQMASK)) (FINISH-KLUDGE KP REPLY-CODE)) (DEFEXINTR LINK-NET-STSTCS NIL (SETF (KLUDGE-DATA KP) (READ-SHORT *DMA* (MSG-OFFSET READ-MP) 'LINK-NSTSTCS-NOBJECTS)) (FINISH-KLUDGE KP REPLY-CODE)) (DEFEXINTR LINK-RECV NIL (SETF (KLUDGE-DATA KP) (READ-SHORT *DMA* (MSG-OFFSET READ-MP) 'LINK-TR-LENGTH)) (FINISH-KLUDGE KP REPLY-CODE)) (DEFEXINTR LINK-XMIT NIL (FINISH-KLUDGE KP REPLY-CODE)) (DEFEXINTR SORECEIVE ((LOGIOR SORECEIVE NM-MAGIC-DATA)) (LET ((ISADDR (NOT (ZEROP (READ-SHORT *DMA* (MSG-OFFSET READ-MP) 'SOCK-PKT-ISADDR))))) (IF ISADDR (COPY-ARRAY-PORTION *DMA* (+ (MSG-OFFSET READ-MP) SOCK-PKT-SADDR-BASE) (+ (MSG-OFFSET READ-MP) SOCK-PKT-SADDR-BASE SIZEOF-SOCKADDR) (KLUDGE-SA KP) 0 SIZEOF-SOCKADDR)) (IF (= 1 ; is data in reply field instead of buffer ? (SETF (KLUDGE-COUNT KP) (READ-SHORT *DMA* (MSG-OFFSET READ-MP) 'SOCK-PKT-COUNT))) (UNLESS (ZEROP (LOGIOR NM-MAGIC-DATA REPLY-CODE)) (SETF (KLUDGE-DATA KP) (READ-UCHAR *DMA* (MSG-OFFSET READ-MP) 'SOCK-PKT-DATA)))) (FINISH-KLUDGE KP REPLY-CODE))) (DEFEXINTR SOSEND ((LOGIOR SOSEND NM-MAGIC-DATA) SOVERIFY SOCLOSE NET-DLOAD NET-START SOSELECT EXBDSTAT EXBDSTATRESET ;; NEW ADDED EXIOCSARP EXIOCGARP EXIOCDARP EXIOCADDRT EXIOCDELRT EXIOCSHOWRT EXIOCDISPRT) (FINISH-KLUDGE KP REPLY-CODE)) (DEFEXINTR SOHASOOB NIL ;;; for now, just print notification when a socket receives out-of-band data (LET ((PGRP (READ-SHORT *DMA* (MSG-OFFSET READ-MP) 'SOCK-HASOOB-SOPGRP))) (IF *EXOS-PANIC-NOTIFY* (TV:NOTIFY NIL "received out-of-band data (pgrp = ~D.).~%" PGRP)))) (DEFEXINTR NET-PANIC (NET-PRINTF) (LET ((SP (MAKE-STRING SIZEOF-PRDATA))) (COPY-ARRAY-PORTION *DMA* (+ (MSG-OFFSET READ-MP) SOCK-PRINTF-PRDATA-BASE) (+ (MSG-OFFSET READ-MP) SOCK-PRINTF-PRDATA-BASE SIZEOF-PRDATA) SP 0 SIZEOF-PRDATA) ;;; pretty up the message string (COND ((EQ REQUEST-CODE NET-PANIC) (SETQ SP (STRING-APPEND "PANIC: " SP)) (SETQ EX-NETDOWN-P T))) (SETQ SP (SUBSTRING SP 0 (COND ((STRING-SEARCH-CHAR 0 SP)) ((STRING-LENGTH SP))))) (DOTIMES (I (STRING-LENGTH SP)) (IF (OR (= (AREF SP I) (- #\Return #o200)) (= (AREF SP I) (- #\Line #o200))) (ASET #\Space SP I))) (COND ((OR *EXOS-NOTIFY* (AND *EXOS-PANIC-NOTIFY* (EQ REQUEST-CODE NET-PANIC))) (TV:NOTIFY NIL "Exos TCP: ~A~%" SP))) (IF (ZEROP (LOGAND REPLY-CODE NM-MAGIC-DATA)) (SETQ BDMAGICDATA 0) (SETQ BDMAGICDATA 1)) (EXLOG SP))) (DEFEXINTR IM-ALIVE NIL (SETQ EX-NETDOWN-P NIL) (AND *EXOS-NOTIFY* (TV:NOTIFY NIL (EXLOG "Exos TCP: exos is alive and kicking")))) ))