(FILECREATED " 9-Feb-85 16:33:26" {ERIS}<LISPCORE>LIBRARY>TCPDEBUG.;1 21705
previous date: " 5-Feb-85 16:59:23" {ERIS}<SCHOEN>TCPDEBUG.;2)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TCPDEBUGCOMS)
(RPAQQ TCPDEBUGCOMS ((COMS (* standard TCP small servers)
(FNS TCP.SINK.SERVER \TCP.SINK.PROCESS TCP.ECHO.SERVER \TCP.ECHO.PROCESS))
(COMS (* TCP tracing and debugging info)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS LIGHTGRAYSHADE))
(GLOBALVARS TCPTRACEFLG TCPTRACEFILE TCPTRACEMENU \TCP.ELAPSED.TIME
\TCP.DEBUGGABLE)
(INITVARS TCPTRACEFLG TCPTRACEFILE TCPTRACEMENU \TCP.ELAPSED.TIME
NETTRACETITLEREG)
(VARS (\TCP.DEBUGGABLE T))
(BITMAPS NETTRACEICON NETTRACEMASK)
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
ICONW)
(FNS TCP.PRINT.SEGMENT \TCP.PRINT.ELAPSED.TIME \TCP.PRINT.SEGMENT.QUEUE
TCPTRACE \TCPTRACEMENU.ITEMFN \TCPTRACEMENU.DISPLAYFN TCP.DRIBBLE))
(COMS (* miscellaneous TCP debugging)
(GLOBALVARS \TCP.LOSSAGE \TCP.LOOPBACK.QUEUE \TCP.LOOPBACK.EVENT
\TCP.MASTER.SOCKET)
(INITVARS \TCP.LOSSAGE \TCP.LOOPBACK.QUEUE \TCP.LOOPBACK.EVENT)
(FNS TCP.DEBUG TCP.WATCHER DUMMY\IP\Transmit\Packet \TCP.CHECK.INPUT.QUEUE
TCP.FAUCET TCP.ECHOTEST TCP.QUIET.ECHOTEST TCP.SINKTEST
GENERATE.RANDOM.CHARS COPYBYTESTREAM TCP.COPYTOWINDOW TEST.CHECKSUM)))
)
(* standard TCP small servers)
(DEFINEQ
(TCP.SINK.SERVER
(LAMBDA (PORT) (* ecc "14-May-84 16:32")
(bind STREAM do (if (SETQ STREAM (TCP.OPEN NIL NIL (OR PORT \TCP.SINK.PORT)
(QUOTE PASSIVE)
(QUOTE INPUT)
T))
then (ADD.PROCESS (BQUOTE (\TCP.SINK.PROCESS , STREAM))
(QUOTE NAME)
"TCP Sink")))))
(\TCP.SINK.PROCESS
(LAMBDA (STREAM) (* ecc "14-May-84 16:32")
(RESETSAVE NIL (LIST (FUNCTION CLOSEF)
STREAM))
(until (EOFP STREAM) do (BIN STREAM))))
(TCP.ECHO.SERVER
(LAMBDA (PORT) (* ecc "14-May-84 16:35")
(bind STREAM do (if (SETQ STREAM (TCP.OPEN NIL NIL (OR PORT \TCP.ECHO.PORT)
(QUOTE PASSIVE)
(QUOTE INPUT)
T))
then (ADD.PROCESS (BQUOTE (\TCP.ECHO.PROCESS , STREAM , (TCP.OTHER.STREAM
STREAM)))
(QUOTE NAME)
"TCP Echo")))))
(\TCP.ECHO.PROCESS
(LAMBDA (INSTR OUTSTR) (* ecc "25-May-84 18:16")
(RESETSAVE NIL (LIST (FUNCTION CLOSEF)
INSTR))
(RESETSAVE NIL (LIST (FUNCTION CLOSEF)
OUTSTR))
(until (EOFP INSTR)
do (BOUT OUTSTR (BIN INSTR))
(if (NOT (READP INSTR))
then (FORCEOUTPUT OUTSTR)))))
)
(* TCP tracing and debugging info)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ LIGHTGRAYSHADE 1025)
(CONSTANTS LIGHTGRAYSHADE)
)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TCPTRACEFLG TCPTRACEFILE TCPTRACEMENU \TCP.ELAPSED.TIME \TCP.DEBUGGABLE)
)
(RPAQ? TCPTRACEFLG NIL)
(RPAQ? TCPTRACEFILE NIL)
(RPAQ? TCPTRACEMENU NIL)
(RPAQ? \TCP.ELAPSED.TIME NIL)
(RPAQ? NETTRACETITLEREG NIL)
(RPAQQ \TCP.DEBUGGABLE T)
(RPAQ NETTRACEICON (READBITMAP))
(72 72
"AOOOOOOOOOOOOOOOL@@@"
"COOOOOOOOOOOOOOON@@@"
"G@@@@@@@@@@@@@@@G@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"G@@@@@@@@@@@@@@@G@@@"
"COOOOOOOOOOOOOOON@@@"
"AOOOOOOOOOOOOOOOL@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"F@@@DIBDL@@@@@@@@@@@"
"F@@@DIBDL@@@@@@@@@@@"
"F@@@DIBDL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"F@@@@@@@L@@@@@L@@@@@"
"F@@@@@@@L@@@@@N@@@@@"
"F@@@@@@@L@@@@@K@@@@@"
"GH@@@@@CLCOOOOIH@@@@"
"F@@@@@@@LGOOOOHL@@@@"
"F@@@@@@@LD@@@@@F@@@@"
"F@@@@@@@LD@@@@@C@@@@"
"GOOOOOOOLD@@@@@A@@@@"
"F@@@@@@@LD@@@@@B@@@@"
"F@@@@@@@LD@@@@@D@@@@"
"F@@@@@@@LGOOOOHH@@@@"
"GH@@@@@CL@@@@@I@@@@@"
"F@@@@@@@L@@@@@J@@@@@"
"F@@@@@@@L@@@@@L@@@@@"
"F@@@@@@@L@@@@@H@@@@@"
"GH@@@@@CL@@@@@@@@@@@"
"F@@@@@@@L@@@@@@@@@@@"
"F@@@@@@@L@@@@@@@@@@@"
"F@@@@@@@L@@@@@@@@@@@"
"GOOOOOOOL@@D@@@@@@@@"
"F@@@@@@@L@@L@@@@@@@@"
"F@@@@@@@L@AL@@@@@@@@"
"F@@@@@@@L@BL@@@@@@@@"
"GH@@@@@CL@DOOOOOH@@@"
"F@@@@@@@L@HOOOOOH@@@"
"F@@@@@@@LA@@@@@AH@@@"
"F@@@@@@@LB@@@@@AH@@@"
"GOOOOOOOLD@@@@@AH@@@"
"F@@@@@@@LB@@@@@AH@@@"
"F@@@D@@@LA@@@@@AH@@@"
"F@@@D@@@L@HOOOOO@@@@"
"F@@@@@@@L@DL@@@@@@@@"
"F@@@D@@@L@BL@@@@@@@@"
"F@@@D@@@L@AL@@@@@@@@"
"F@@@@@@@L@@H@@@@@@@@"
"F@@@D@@@L@@@@@@@@@@@"
"F@@@D@@@L@@@@@@@@@@@"
"F@@@@@@@L@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"F@@@@@@@L@@@@@@@@@@@"
"F@@@@@@@L@@@@@@@@@@@"
"F@@@@@@@L@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@")
(RPAQ NETTRACEMASK (READBITMAP))
(72 72
"AOOOOOOOOOOOOOOOL@@@"
"COOOOOOOOOOOOOOON@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"COOOOOOOOOOOOOOON@@@"
"AOOOOOOOOOOOOOOOL@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@L@@@@@"
"GOOOOOOOL@@@@@N@@@@@"
"GOOOOOOOL@@@@@O@@@@@"
"GOOOOOOOLCOOOOOH@@@@"
"GOOOOOOOLGOOOOOL@@@@"
"GOOOOOOOLGOOOOON@@@@"
"GOOOOOOOLGOOOOOO@@@@"
"GOOOOOOOLGOOOOOO@@@@"
"GOOOOOOOLGOOOOON@@@@"
"GOOOOOOOLGOOOOOL@@@@"
"GOOOOOOOLGOOOOOH@@@@"
"GOOOOOOOL@@@@@O@@@@@"
"GOOOOOOOL@@@@@N@@@@@"
"GOOOOOOOL@@@@@L@@@@@"
"GOOOOOOOL@@@@@H@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@D@@@@@@@@"
"GOOOOOOOL@@L@@@@@@@@"
"GOOOOOOOL@AL@@@@@@@@"
"GOOOOOOOL@CL@@@@@@@@"
"GOOOOOOOL@GOOOOOH@@@"
"GOOOOOOOL@OOOOOOH@@@"
"GOOOOOOOLAOOOOOOH@@@"
"GOOOOOOOLCOOOOOOH@@@"
"GOOOOOOOLGOOOOOOH@@@"
"GOOOOOOOLCOOOOOOH@@@"
"GOOOOOOOLAOOOOOOH@@@"
"GOOOOOOOL@OOOOOO@@@@"
"GOOOOOOOL@GL@@@@@@@@"
"GOOOOOOOL@CL@@@@@@@@"
"GOOOOOOOL@AL@@@@@@@@"
"GOOOOOOOL@@H@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@")
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
ICONW)
(DEFINEQ
(TCP.PRINT.SEGMENT
(LAMBDA (SEGMENT FILE NOFROMTOFLG DATAFLG) (* ejs: "27-Jan-85 16:52")
(PROG ((SEPR "")
(COMMA ",")
(SEQ (fetch TCP.SEQ of SEGMENT))
(LEN (\TCP.DATA.LENGTH SEGMENT))
(FLAGS (fetch TCP.CTRL of SEGMENT))
TOP BASE)
(if (NOT NOFROMTOFLG)
then (printout FILE "from " # (\IP.PRINT.ADDRESS (fetch TCP.SRC.ADDR of SEGMENT)
FILE)
":"
(fetch TCP.SRC.PORT of SEGMENT)
" to " # (\IP.PRINT.ADDRESS (fetch TCP.DST.ADDR of SEGMENT)
FILE)
":"
(fetch TCP.DST.PORT of SEGMENT)
T))
(printout FILE SEQ)
(SETQ TOP (SUB1 (IPLUS SEQ LEN (\TCP.SYN.OR.FIN FLAGS T))))
(if (\32BIT.LT SEQ TOP)
then (printout FILE ".." TOP))
(printout FILE "/" (fetch TCP.ACK of SEGMENT)
" [")
(if (BITTEST FLAGS \TCP.CTRL.URG)
then (printout FILE SEPR "URG")
(SETQ SEPR COMMA))
(if (BITTEST FLAGS \TCP.CTRL.ACK)
then (printout FILE SEPR "ACK")
(SETQ SEPR COMMA))
(if (BITTEST FLAGS \TCP.CTRL.PSH)
then (printout FILE SEPR "PSH")
(SETQ SEPR COMMA))
(if (BITTEST FLAGS \TCP.CTRL.RST)
then (printout FILE SEPR "RST")
(SETQ SEPR COMMA))
(if (BITTEST FLAGS \TCP.CTRL.SYN)
then (printout FILE SEPR "SYN")
(SETQ SEPR COMMA))
(if (BITTEST FLAGS \TCP.CTRL.FIN)
then (printout FILE SEPR "FIN")
(SETQ SEPR COMMA))
(printout FILE "] window = " (fetch TCP.WINDOW of SEGMENT)
" checksum = "
(fetch TCP.CHECKSUM of SEGMENT)
" length = " LEN T)
(if (AND DATAFLG (NOT (ZEROP LEN)))
then (printout FILE "Contents:")
(SETQ BASE (fetch TCP.CONTENTS of SEGMENT))
(for (I ← 0) to (SUB1 LEN) do (PRIN1 (CHARACTER (\GETBASEBYTE BASE I))
FILE))
(TERPRI FILE)))))
(\TCP.PRINT.ELAPSED.TIME
(LAMBDA (FILE) (* ecc "23-Apr-84 12:32")
(if (MEMB (QUOTE TIME)
TCPTRACEFLG)
then (PROG ((NOW (SETUPTIMER 0 NIL (QUOTE MILLISECONDS)))
INTERVAL)
(SETQ INTERVAL (IDIFFERENCE NOW (OR \TCP.ELAPSED.TIME NOW)))
(SETQ \TCP.ELAPSED.TIME NOW)
(printout FILE (IQUOTIENT INTERVAL 1000)
"." .I3..T (IMOD INTERVAL 1000)
" ")))))
(\TCP.PRINT.SEGMENT.QUEUE
(LAMBDA (CALLER QUEUE FILE) (* ecc "18-Apr-84 14:38")
(PROG ((SEGMENT (fetch SYSQUEUEHEAD of QUEUE)))
(printout FILE .TAB0 0 CALLER ":" T)
(while SEGMENT
do (TCP.PRINT.SEGMENT SEGMENT FILE T)
(SETQ SEGMENT (fetch QLINK of SEGMENT))))))
(TCPTRACE
(LAMBDA NIL (* ejs: "29-Jan-85 15:08")
(PROG (MW)
(if (WINDOWP TCPTRACEFILE)
then (TOTOPW TCPTRACEFILE)
(RETURN))
(SETQ TCPTRACEFILE (CREATEW))
(WINDOWPROP TCPTRACEFILE (QUOTE ICONFN)
(FUNCTION (LAMBDA (WINDOW)
(TITLEDICONW (create TITLEDICON
ICON ← NETTRACEICON
MASK ← NETTRACEMASK
TITLEREG ← NETTRACETITLEREG)
(QUOTE TCP)
(QUOTE (HELVETICA 8))
NIL T (QUOTE TOP)))))
(WINDOWADDPROP TCPTRACEFILE (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (WINDOW)
(if (EQ WINDOW TCPTRACEFILE)
then (SETQ TCPTRACEFLG NIL)
(SETQ TCPTRACEFILE T)))))
(DSPFONT (FONTCREATE (QUOTE GACHA)
8)
TCPTRACEFILE)
(DSPSCROLL T TCPTRACEFILE)
(if (NOT (type? MENU TCPTRACEMENU))
then (SETQ TCPTRACEMENU (create MENU
TITLE ← "TCP Trace Window"
ITEMS ←(QUOTE (("Incoming" RECV
"Trace incoming segments")
("Time" TIME
"Print elapsed time between events")
("Transitions" TRANSITION
"Trace connection state transitions")
("Outgoing" SEND
"Trace outgoing segments")
("Contents" CONTENTS
"Print contents of segments when tracing")
("Checksums" CHECKSUM
"Trace segments with bad checksums")))
MENUROWS ← 2
CENTERFLG ← T
WHENSELECTEDFN ←(FUNCTION \TCPTRACEMENU.ITEMFN))))
(ATTACHMENU TCPTRACEMENU TCPTRACEFILE (QUOTE TOP))
(SETQ MW (CAR (WINDOWPROP TCPTRACEFILE (QUOTE ATTACHEDWINDOWS))))
(WINDOWADDPROP MW (QUOTE REPAINTFN)
(FUNCTION \TCPTRACEMENU.DISPLAYFN))
(WINDOWADDPROP MW (QUOTE RESHAPEFN)
(FUNCTION \TCPTRACEMENU.DISPLAYFN)))))
(\TCPTRACEMENU.ITEMFN
(LAMBDA (ITEM MENU MOUSEKEY) (* ecc "23-Apr-84 13:37")
(PROG (FLG)
(if (NULL ITEM)
then (RETURN))
(SETQ FLG (CADR ITEM))
(if (MEMB FLG TCPTRACEFLG)
then (SHADEITEM ITEM MENU WHITESHADE)
(SETQ TCPTRACEFLG (DREMOVE FLG TCPTRACEFLG))
else (SHADEITEM ITEM MENU LIGHTGRAYSHADE)
(SETQ TCPTRACEFLG (CONS FLG TCPTRACEFLG))))))
(\TCPTRACEMENU.DISPLAYFN
(LAMBDA (WINDOW) (* ecc "23-Apr-84 13:49")
(PROG ((MENU (CAR (WINDOWPROP WINDOW (QUOTE MENU)))))
(for ITEM in (fetch ITEMS of MENU) when (MEMB (CADR ITEM)
TCPTRACEFLG)
do (SHADEITEM ITEM MENU LIGHTGRAYSHADE)))))
(TCP.DRIBBLE
(LAMBDA (FORM FILE) (* ecc "18-Apr-84 14:39")
(if (NULL FILE)
then (SETQ FILE (QUOTE {DSK}TCP.Transcript)))
(RESETLST (RESETSAVE TCPTRACEFILE (OPENFILE FILE (QUOTE OUTPUT)))
(RESETSAVE TCPTRACEFLG T)
(RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
TCPTRACEFILE))
(PRINT FORM TCPTRACEFILE)
(TERPRI TCPTRACEFILE)
(EVAL FORM))))
)
(* miscellaneous TCP debugging)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TCP.LOSSAGE \TCP.LOOPBACK.QUEUE \TCP.LOOPBACK.EVENT \TCP.MASTER.SOCKET)
)
(RPAQ? \TCP.LOSSAGE NIL)
(RPAQ? \TCP.LOOPBACK.QUEUE NIL)
(RPAQ? \TCP.LOOPBACK.EVENT NIL)
(DEFINEQ
(TCP.DEBUG
(LAMBDA (ON?) (* edited: "21-May-84 13:56")
(if ON?
then (TCP.STOP)
(if (NOT (DEFINEDP (QUOTE REAL\IP\Transmit\Packet)))
then (MOVD (QUOTE IP\Transmit\Packet)
(QUOTE REAL\IP\Transmit\Packet)))
(MOVD (QUOTE DUMMY\IP\Transmit\Packet)
(QUOTE IP\Transmit\Packet))
(if (NULL \TCP.LOOPBACK.EVENT)
then (SETQ \TCP.LOOPBACK.EVENT (CREATE.EVENT)))
(if (NULL \TCP.LOOPBACK.QUEUE)
then (SETQ \TCP.LOOPBACK.QUEUE (create SYSQUEUE)))
(if (NOT (FIND.PROCESS (QUOTE TCP.WATCHER)))
then (ADD.PROCESS (QUOTE (TCP.WATCHER))))
else (if (DEFINEDP (QUOTE REAL\IP\Transmit\Packet))
then (MOVD (QUOTE REAL\IP\Transmit\Packet)
(QUOTE IP\Transmit\Packet)))
(DEL.PROCESS (QUOTE TCP.WATCHER))
(\TCP.INIT))))
(TCP.WATCHER
(LAMBDA NIL (* ecc " 3-May-84 11:10")
(* process to handle software loopback of segments)
(RESETSAVE NIL (LIST (FUNCTION \FLUSH.PACKET.QUEUE)
\TCP.LOOPBACK.QUEUE))
(bind SEGMENT
do (SETQ SEGMENT (\DEQUEUE \TCP.LOOPBACK.QUEUE))
(if SEGMENT
then (\TCP.PACKET.FILTER SEGMENT \TCP.PROTOCOL)
else (AWAIT.EVENT \TCP.LOOPBACK.EVENT)))))
(DUMMY\IP\Transmit\Packet
(LAMBDA (EPKT) (* ejs: " 5-Jan-85 16:57")
(* Software loopback.)
(PROG ((OK (NOT (AND \TCP.LOSSAGE (EQ (RAND 1 \TCP.LOSSAGE)
1))))
SEGMENT)
(CHECK (OR (NULL (fetch QLINK of EPKT))
(SHOULDNT "transmitting queued segment")))
(if OK
then (SETQ SEGMENT (\ALLOCATE.ETHERPACKET))
(\BLT (\IPDATABASE SEGMENT)
(\IPDATABASE EPKT)
(FOLDHI (ADD1 (fetch (IP IPTOTALLENGTH) of EPKT))
BYTESPERWORD)))
(if (EQ (fetch EPREQUEUE of EPKT)
(QUOTE FREE))
then (\RELEASE.ETHERPACKET EPKT)
elseif (type? SYSQUEUE (fetch EPREQUEUE of EPKT))
then (\ENQUEUE (fetch EPREQUEUE of EPKT)
EPKT))
(if OK
then (\ENQUEUE \TCP.LOOPBACK.QUEUE SEGMENT)
(NOTIFY.EVENT \TCP.LOOPBACK.EVENT)))))
(\TCP.CHECK.INPUT.QUEUE
(LAMBDA (TCB) (* edited: "22-May-84 15:32")
(* perform consistency check on the input queue)
(PROG ((QUEUE (fetch TCB.INPUT.QUEUE of TCB))
CURSEG SEQ1 TOP1 NEXTSEG SEQ2 TOP2)
(SETQ CURSEG (fetch SYSQUEUEHEAD of QUEUE))
LOOP(if (NULL CURSEG)
then (RETURN T))
(SETQ SEQ1 (fetch TCP.SEQ of CURSEG))
(SETQ TOP1 (IPLUS SEQ1 (fetch TCP.DATA.LENGTH of CURSEG)))
(if (AND (\32BIT.LEQ SEQ1 (fetch TCB.RCV.NXT of TCB))
(\32BIT.GT TOP1 (fetch TCB.RCV.NXT of TCB)))
then (SHOULDNT "incorrect RCV.NXT")
(RETURN NIL))
(SETQ NEXTSEG (fetch QLINK of CURSEG))
(if (NULL NEXTSEG)
then (RETURN T))
(SETQ SEQ2 (fetch TCP.SEQ of NEXTSEG))
(SETQ TOP2 (IPLUS SEQ2 (fetch TCP.DATA.LENGTH of NEXTSEG)))
(if (\32BIT.LT SEQ2 SEQ1)
then (SHOULDNT "input queue out of order")
(RETURN NIL))
(SETQ CURSEG NEXTSEG)
(GO LOOP))))
(TCP.FAUCET
(LAMBDA (HOST PORT NLINES) (* ecc "14-May-84 17:29")
(PROG ((STREAM (if HOST
then (TCP.OPEN HOST (OR PORT \TCP.SINK.PORT)
NIL
(QUOTE ACTIVE)
(QUOTE OUTPUT))
else (TCP.OPEN NIL NIL \TCP.FAUCET.PORT (QUOTE PASSIVE)
(QUOTE OUTPUT)))))
(RESETLST (RESETSAVE NIL (LIST (FUNCTION CLOSEF)
STREAM))
(GENERATE.RANDOM.CHARS STREAM NLINES)))))
(TCP.ECHOTEST
(LAMBDA (HOST NLINES) (* ecc "14-May-84 17:07")
(PROG ((STREAM (TCP.OPEN HOST \TCP.ECHO.PORT NIL (QUOTE ACTIVE)
(QUOTE OUTPUT))))
(ADD.PROCESS (BQUOTE (TCP.COPYTOWINDOW , (TCP.OTHER.STREAM STREAM))
(QUOTE NAME)
"TCP Echo Tester"))
(GENERATE.RANDOM.CHARS STREAM NLINES)
(TCP.CLOSE.SENDER STREAM))))
(TCP.QUIET.ECHOTEST
(LAMBDA (HOST NLINES) (* ecc "25-May-84 13:24")
(PROG ((STREAM (TCP.OPEN HOST \TCP.ECHO.PORT NIL (QUOTE ACTIVE)
(QUOTE OUTPUT))))
(ADD.PROCESS (BQUOTE (\TCP.SINK.PROCESS , (TCP.OTHER.STREAM STREAM))
(QUOTE NAME)
"TCP Echo Tester"))
(GENERATE.RANDOM.CHARS STREAM NLINES)
(TCP.CLOSE.SENDER STREAM))))
(TCP.SINKTEST
(LAMBDA (PORT VISIBLEFLG) (* ecc "14-May-84 17:28")
(TCP.COPYTOWINDOW (TCP.OPEN NIL NIL (OR PORT \TCP.SINK.PORT)
(QUOTE PASSIVE)
(QUOTE INPUT))
VISIBLEFLG)))
(GENERATE.RANDOM.CHARS
(LAMBDA (STREAM NLINES) (* ecc "18-Apr-84 16:46")
(bind (N ← 0) while (NEQ N NLINES)
do (add N 1)
(printout STREAM "This is line number " N "." T)
(BLOCK))))
(COPYBYTESTREAM
(LAMBDA (INSTR OUTSTR VISIBLEFLG) (* ecc "18-Apr-84 16:43")
(if VISIBLEFLG
then (bind (N ← 1)
(C ← NIL) until (EOFP INSTR)
do (SETQ C (BIN INSTR))
(printout OUTSTR N ": " C)
(if (AND (ILEQ C 127)
(IGEQ C 32))
then (printout OUTSTR " (" # (BOUT OUTSTR C)
")"))
(TERPRI OUTSTR)
(add N 1))
else (until (EOFP INSTR) do (BOUT OUTSTR (BIN INSTR))))))
(TCP.COPYTOWINDOW
(LAMBDA (STREAM VISIBLEFLG) (* ecc "14-May-84 17:05")
(RESETLST (RESETSAVE NIL (LIST (FUNCTION CLOSEF)
STREAM))
(PROG ((WIN (CREATEW NIL "Stream Output")))
(DSPSCROLL T WIN)
(COPYBYTESTREAM STREAM WIN VISIBLEFLG)
(printout WIN .TAB0 0 "[End of stream]")))))
(TEST.CHECKSUM
(LAMBDA (STR STR2) (* ecc "24-Apr-84 13:11")
(if (NULL STR2)
then (\COMPUTE.CHECKSUM (\ADDBASE (fetch (STRINGP BASE) of STR)
(fetch (STRINGP OFFST) of STR))
(fetch (STRINGP LENGTH) of STR))
else (\16BIT.COMPLEMENT (\16BIT.1C.PLUS (\COMPUTE.CHECKSUM (\ADDBASE (fetch (STRINGP BASE)
of STR)
(fetch (STRINGP OFFST)
of STR))
(fetch (STRINGP LENGTH)
of STR)
T)
(\COMPUTE.CHECKSUM (\ADDBASE (fetch (STRINGP BASE)
of STR2)
(fetch (STRINGP OFFST)
of STR2))
(fetch (STRINGP LENGTH)
of STR2)
T))))))
)
(PUTPROPS TCPDEBUG COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1487 3035 (TCP.SINK.SERVER 1497 . 1912) (\TCP.SINK.PROCESS 1914 . 2155) (
TCP.ECHO.SERVER 2157 . 2619) (\TCP.ECHO.PROCESS 2621 . 3033)) (6974 13597 (TCP.PRINT.SEGMENT 6984 .
9217) (\TCP.PRINT.ELAPSED.TIME 9219 . 9740) (\TCP.PRINT.SEGMENT.QUEUE 9742 . 10116) (TCPTRACE 10118 .
12215) (\TCPTRACEMENU.ITEMFN 12217 . 12726) (\TCPTRACEMENU.DISPLAYFN 12728 . 13099) (TCP.DRIBBLE 13101
. 13595)) (13864 21626 (TCP.DEBUG 13874 . 14878) (TCP.WATCHER 14880 . 15426) (
DUMMY\IP\Transmit\Packet 15428 . 16506) (\TCP.CHECK.INPUT.QUEUE 16508 . 17798) (TCP.FAUCET 17800 .
18329) (TCP.ECHOTEST 18331 . 18795) (TCP.QUIET.ECHOTEST 18797 . 19268) (TCP.SINKTEST 19270 . 19524) (
GENERATE.RANDOM.CHARS 19526 . 19796) (COPYBYTESTREAM 19798 . 20353) (TCP.COPYTOWINDOW 20355 . 20743) (
TEST.CHECKSUM 20745 . 21624)))))
STOP