[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Dialnet Questions
Greetings,
The Problem:
To increase the throughput of dialnet.
The Situation:
We are government contractors using classified data with remote sites. The remote
sites each have an XL1200 with a framethrower, 8mw, 2x760mb drive. I have written code
(which works fine) to use the AT&T STU III (secure phone/terminal) as a modem for dialnet
communication (must use the stu-iii since we're dealing with classified data, hence we're
only concerned with communication to/from our own sites). The STU III looks just like a
(sort-of) Hayes compatible modem that runs at 4800 baud.
I've noticed when transmitting files (text) that the measured throughput is
considerably less than optimal (~10 min for 100k).
What I Thought:
Looking at the source code for dialnet (>rel-8-1>sys>dialnet>stream.lisp.2542) I
discovered that the "input-segment" and "output-buffer" sizes for the "dialnet-interface" was
127/130 bytes (something i considered rather small for today's modems). Therefore, I thought
that i could simply up the MAXIMUM-SEGMENT-LENGTH (and related defstructs) to something like
512 or 1024.
What I Did:
Given the above thought, I created a private patch file containing the associated
forms that needed to be changed or recompiled (since MAXIMUM-SEGMENT-LENGTH is a defconst).
Then I would a) halt the mailer, b) kill the "dialnet unit 1 answerer" process, c) load the
private patch file, d) eval the form (REENABLE-DIALNET-NETWORK) (after having compiled it),
and e) start the mailer.
This, of course, would be done on both machines at the same time (one in VA, one in
AZ).
What happened:
At first it appeared to work. The initial handshaking went ok, and dialnet was
entered. But the machines would timeout:
13:09:17 < Message 21001: Queued for deferred delivery to PEGASUS.GALAXY.MYSTECH.COM
13:09:33 ! Probe hosts: Requeueing 1 message for PEGASUS.GALAXY.MYSTECH.COM
13:09:33 < Message 21001: Beginning delivery from BOOTES.FIM-Huachuca.dialnet.symbolics.com to PEGASUS.GALAXY.MYSTECH.COM
13:10:17 + Background: Checking for mail queued to undeliverable hosts
13:15:50 < Message 21001: Timed out sending with MAIL-TO-USER (SMTP) -- PEGASUS.GALAXY.MYSTECH.COM on DIAL|DIAL to
(PEGASUS.GALAXY.MYSTECH.COM): SMTP timed out after 5 minutes 1 second while using host PEGASUS.GALA
XY.MYSTECH.COM:
Waiting for reply to message body
13:15:50 < Message 21001: Probe of PEGASUS.GALAXY.MYSTECH.COM was unsuccessful
13:15:51 < Message 21001: Failed delivery to PEGASUS.GALAXY.MYSTECH.COM
Returning to Normal:
I made another private-patch file identical to the one which increased the segment
sizes, to return them to normal. Following the same procedure as in "What I Did:" on both
hosts with the "normal" patch file dialnet would return to work correctly.
The BIG QUESTION:
a) Would increasing the segment size increase the throughput?
b) If (a), then what am I missing.
c) If (not (a)), is there some other way to increase the throughput? (obviously I
don't care about remaining compatible with other dialnet hosts)
Some Debugging:
I have altered (slightly) the formats going to *DIALNET-TRACE-STREAM*, as shown
below. I've also included the private-patch file I've made to bump the segment sizes. Also,
I've included the trace runs using my 1debug0 function.
Observations:
From the trace runs produced by the 1debug0 function, it would seem that the
output-buffer is getting re-transmitted 2-5 times, is this necessary or just a timing
problem? Because, if this is a timing problem, fixing this would increase the throughput
greatly.
Salutations:
I would really appreciate any guidance, suggestions, warnings, et al that you might
be able to give to me. If there is any additional information I can supply to clear
something up, please call (or mail back to Kim, who forwarded this to you).
Thanks,
TTFN
______________________________________
_ /| Bill Anderson
\'o.O' Mystech Associates, Inc.
=(___)= "in the desert"
U hm (602) 459-1827
Ackk!Ptt! wk (602) 538-227(4,5)
;;;; the TRACING functions/alterations
(defun 1debug0 (control-string &REST args)
(when *DIALNET-TRACE-STREAM*
(format *DIALNET-TRACE-STREAM* "~?" control-string args)
))
;;; Receive side, control process
(DEFMETHOD (:RECEIVE-INPUT-SEGMENT DIALNET-INTERFACE) ()
(CATCH 'INPUT-TIMEOUT
(LOOP NAMED TOP DOING
(LET ((CONTROL (SEND SELF :RAW-TYI)))
#+notnow
(WHEN *DIALNET-TRACE-STREAM*
(FORMAT *DIALNET-TRACE-STREAM* "~&~A~30TRCV ~3O Time ~O"
SELF CONTROL (TIME)))
(1debug0 "~&Receive Time:~O -- Control:~O" (TIME) CONTROL)
(IF (OR (NOT (LDB-TEST %%SEGMENT-CONTROL CONTROL))
(ZEROP (AREF *PARITY* CONTROL)))
(INCF CONTROL-BYTE-NOT-VALID)
;; If he is expecting the next sequence we will assign, he must
;; have received any retransmission.
(WHEN (= (LDB %%SEGMENT-SEQUENCE-EXPECTED CONTROL)
(LDB (BYTE 1 0) (1+ OUTPUT-SEQUENCE-NUMBER)))
(SETQ OUTPUT-BUFFER-BEING-TRANSMITTED NIL))
;; If there is no data in this segment, no resynch needed
(WHEN (NOT (LDB-TEST %%SEGMENT-DATA CONTROL))
(UNLESS FORCE-TRANSMISSION
(SETQ FORCE-TRANSMISSION :ACK))
(SETQ LAST-SEGMENT-RECEIVED-TIME (TIME))
(RETURN NIL))
(LET ((LENGTH (SEND SELF :RAW-TYI))
(INPUT-SEGMENT (INPUT-SEGMENT-N INPUT-SEQUENCE-NUMBER)))
(IF (LDB-TEST %%SEGMENT-CONTROL LENGTH)
(INCF CONTROL-BYTE-NOT-VALID)
(MULTIPLE-VALUE-BIND (CHECKSUM DATA-INVALID)
(STRING-IN-COMPUTING-CHECKSUM INPUT-SEGMENT LENGTH)
(COND (DATA-INVALID
(INCF DATA-BYTE-NOT-VALID))
(( CHECKSUM (SEND SELF :RAW-TYI))
(INCF CHECKSUM-ERRORS))
(T
;; We have now read a data segment, see if it is the one we
;; wanted.
(SETQ LAST-SEGMENT-RECEIVED-TIME (TIME))
(LET ((NEXT-P (= (LDB %%SEGMENT-DATA-SEQUENCE CONTROL)
(LDB (BYTE 1 0) INPUT-SEQUENCE-NUMBER))))
(IF NEXT-P
(INCF INPUT-SEQUENCE-NUMBER)
(INCF DUPLICATE-DATA))
(UNLESS FORCE-TRANSMISSION
(SETQ FORCE-TRANSMISSION :ACK))
(WHEN NEXT-P
(WHEN (LDB-TEST %%SEGMENT-BINARY CONTROL)
(SETQ LENGTH (CONVERT-SEGMENT-78 INPUT-SEGMENT 0 LENGTH T)))
(SETF (INPUT-SEGMENT-LENGTH INPUT-SEGMENT) LENGTH)
(SETF (INPUT-SEGMENT-CONTROL INPUT-SEGMENT) CONTROL)
(RETURN T))
;; Try to get next segment, don't need resynch
(RETURN NIL)))))))))
;; Here we need to resynch, look for a valid control character
(LOOP DOING
(LET ((CONTROL (SEND SELF :RAW-TYI)))
(WHEN (AND (LDB-TEST %%SEGMENT-CONTROL CONTROL)
(NOT (ZEROP (AREF *PARITY* CONTROL))))
(SEND RAW-STREAM :UNTYI CONTROL)
(RETURN-FROM TOP (VALUES))))))))
(defun 1array->str0 (array)
(LOOP FOR ind FROM 0 TO (+ (AREF array 1) 3)
AS char = (string (code-char (aref array ind)))
COLLECT char INTO chars
FINALLY (return (apply #'STRING-APPEND chars))
))
;;; Transmit side, control process
(DEFMETHOD (:TRANSMIT-OUTPUT-SEGMENT DIALNET-INTERFACE) ()
(LET* ((SEND-NO-DATA (OR (NOT OUTPUT-BUFFER-BEING-TRANSMITTED)
(EQ FORCE-TRANSMISSION :ACK)))
(CONTROL (IF SEND-NO-DATA
(DPB 1 %%SEGMENT-CONTROL 0)
(AREF OUTPUT-BUFFER 0))))
(SETQ CONTROL (DPB INPUT-SEQUENCE-NUMBER %%SEGMENT-SEQUENCE-EXPECTED CONTROL))
(WHEN (ZEROP (AREF *PARITY* CONTROL))
(SETQ CONTROL (DPB 1 %%SEGMENT-PARITY CONTROL)))
(IF SEND-NO-DATA
(SEND RAW-STREAM :TYO CONTROL)
(UNLESS FORCE-TRANSMISSION
(INCF RETRANSMISSIONS))
(ASET CONTROL OUTPUT-BUFFER 0)
(SEND RAW-STREAM :STRING-OUT OUTPUT-BUFFER 0 (+ (AREF OUTPUT-BUFFER 1) 3)))
(SEND RAW-STREAM :FORCE-OUTPUT)
(1debug0 "~&Transmt Time:~O -- Control:~O -- OutBuf:~A" (TIME) CONTROL (1array->str0 OUTPUT-BUFFER))
)
(UNLESS (AND OUTPUT-BUFFER-BEING-TRANSMITTED
(EQ FORCE-TRANSMISSION :ACK))
(SETQ LAST-TRANSMIT-TIME (TIME)))
(SETQ FORCE-TRANSMISSION NIL)
#+notnow
(WHEN *DIALNET-TRACE-STREAM*
(FORMAT *DIALNET-TRACE-STREAM* "~&~A~30TXMT ~S ~O" SELF OUTPUT-BUFFER-BEING-TRANSMITTED
LAST-TRANSMIT-TIME)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
the private-patch to bump segment sizes
;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*-
;;; Patch file for Private version 0.0
;;; Reason: Change the dialnet packet size to 512B.
;;; Written by Bill, 9/21/92 08:57:19
;;; while running on BOOTES from FEP0:>inc-fim-dbs-920717.ilod.1
;;; with Genera 8.1.1, Logical Pathnames Translation Files NEWEST, Site System 38.1,
;;; Experimental Auto Enable After N Minutes NEWEST, IP-TCP 435.4,
;;; Domain Name Server 422.0, Mailer 424.0, Statice Runtime 409.3, Statice 430.0,
;;; Statice Browser 406.0, DBFS Utilities 427.0, Statice Documentation 413.0,
;;; CLIM 28.5, CLIM Demo 28.2, CLIM Documentation 31.0, Color Editor 415.10,
;;; Graphics Toolkit 16.37, Graphics Support 426.5,
;;; Experimental SGD Genera Redefinitions 1, SGD Genera 8.1 Redefinitions 1.2,
;;; Genera Extensions 11.40, Essential Image Substrate 417.0,
;;; Ivory Color Support 9.3, Color 421.52, Color Demo 417.7, Images 426.17,
;;; Color System Documentation 4.0, SGD Book Design 2.0, FrameThrower 8.180,
;;; FrameThrower XL Interface 7.18, Image Substrate 425.0,
;;; S-Utilities Documentation 6.0, FT Utilities 4.4, FrameThrower Diagnostics 3.14,
;;; Field Mouse 2.30, Graphics Library 8.5, Experimental Fone Mate 34.0,
;;; ToolKit Modules 54.0, Editor Builder 42.0,
;;; Valuable Information Storage Environment 92.7,
;;; Valuable Information Storage Environment Server 115.23, Data Constructor 62.7,
;;; Report Generator 81.3, Initial Startup Screen 23.0, Budget System 17.6,
;;; Accept in Place 10.0, Programmatic Database Records Editor 24.0,
;;; Report Manager 34.1, COSTing System 26.0, ORCA Data Extraction System 8.1,
;;; ORganizations and Cost Analysis 12.0, New Organizations Module 20.13,
;;; CJB Special Application 13.0, Threat 50.1,
;;; Doctrinal Template Tool Substrate 21.0, Icon Tool 17.0,
;;; Friendly Systems Model 35.0, Commanders Requirements Analysis 40.0,
;;; OPerations Capabilities Analysis 15.2, Map Substrate 41.0,
;;; Friendly Equipment 10.0, Icon Tool Color Extensions 11.0, Vise Browser 4.0,
;;; Vise Maintenance 18.2, VISE Systems Editor 4.0, Experimental TOE Reports 40.1,
;;; cold load 1, Ivory Revision 4A (FPA enabled), FEP 325,
;;; FEP0:>I325-loaders.flod(8), FEP0:>I325-info.flod(8), FEP0:>I325-debug.flod(8),
;;; FEP0:>I325-lisp.flod(8), FEP0:>I325-kernel.fep(9), Boot ROM version 316,
;;; Device PROM version 325, 1024x798 B&W Screen, 1280x1024 B&W Screen,
;;; Machine serial number 577,
;;; Mode Line Patch (from SITE-SYSTEM:SITE-SYSTEM;ZWEI-HACKS;MODE-LINE-WINDOW-PATCH.LISP.1),
;;; Re-patch of :MOVE-REGION to fix bitblting problem. (from SITE-SYSTEM:SITE-SYSTEM;MOVE-REGION-PATCH.LISP.8),
;;; Recover Margins Correctly (from SITE-SYSTEM:SITE-SYSTEM;SET-PAGE-TYPE-PATCH.LISP.2),
;;; Custom Initial Window (from SITE-SYSTEM:SITE-SYSTEM;FIM-WINDOW-HAIR-PATCH.LISP.1),
;;; FrameThrower Microload 51 (from SYS:COLOR;FRAMETHROWER;PATCH;FRAMETHROWER-8-2.LISP.1),
;;; dis:Restore-file-from-tape fixes for 0-length and fep files (from SITE-SYSTEM:SITE-SYSTEM;RESTORE-FILE-FROM-TAPE-FIX.LISP.4).
(SYSTEM-INTERNALS:FILES-PATCHED-IN-THIS-PATCH-FILE
"SYS:DIALNET;STREAM.LISP.2543")
(NOTE-PRIVATE-PATCH "Private patch dialnet stream, changing the packet size (512B).")
;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:DIALNET;STREAM.LISP.2543")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Syntax: ZetaLisp; Mode: LISP; Package: DIAL; Base: 8; Patch-File: T -*-")
;;; This is the number of 8-bit bytes of data that you can get in 127. 7-bit bytes.
(DEFCONSTANT MAXIMUM-SEGMENT-LENGTH (// (* 511. 7) 8)) 2; bump it up to 512B
0;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:DIALNET;STREAM.LISP.2543")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Syntax: ZetaLisp; Mode: LISP; Package: DIAL; Base: 8; Patch-File: T -*-")
(DEFSTRUCT (INPUT-SEGMENT :ARRAY-LEADER :CONC-NAME
(:MAKE-ARRAY (:LENGTH 511. :TYPE 'SYS:ART-8B))) 2; bump it up to 512B
0 (LENGTH 0)
(CONTROL NIL) ; Filled in with control byte for user.
(STRING-CHAR-VIEW NIL)) ; Indirected to the binary view
;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:DIALNET;STREAM.LISP.2543")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Syntax: ZetaLisp; Mode: LISP; Package: DIAL; Base: 8; Patch-File: T -*-")
(DEFSTRUCT (INPUT-SEGMENT-STRING-CHAR-VIEW-ARRAY :ARRAY-LEADER :CONC-NAME
(:MAKE-ARRAY (:LENGTH 511. :TYPE 'SYS:ART-STRING))) 2; bump it up to 512B
0 (LENGTH 0)) ; gets adjusted to length of input-segment by :get-input-buffer
;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:DIALNET;STREAM.LISP.2543")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Syntax: ZetaLisp; Mode: LISP; Package: DIAL; Base: 8; Patch-File: T -*-")
(DEFUN MAKE-AN-INPUT-SEGMENT ()
(LET ((SEGMENT (MAKE-INPUT-SEGMENT)))
(SETF (INPUT-SEGMENT-STRING-CHAR-VIEW SEGMENT)
(MAKE-INPUT-SEGMENT-STRING-CHAR-VIEW-ARRAY :MAKE-ARRAY (:DISPLACED-TO SEGMENT)))
SEGMENT))
;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:DIALNET;STREAM.LISP.2543")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Syntax: ZetaLisp; Mode: LISP; Package: DIAL; Base: 8; Patch-File: T -*-")
(DEFSTRUCT (OUTPUT-SEGMENT :ARRAY-LEADER :CONC-NAME
(:MAKE-ARRAY (:LENGTH 514. :TYPE 'SYS:ART-8B))) 2; bump it up to 512B
0 (STRING-CHAR-VIEW NIL))
;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:DIALNET;STREAM.LISP.2543")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Syntax: ZetaLisp; Mode: LISP; Package: DIAL; Base: 8; Patch-File: T -*-")
(DEFUN MAKE-AN-OUTPUT-SEGMENT ()
(LET ((SEGMENT (MAKE-OUTPUT-SEGMENT)))
(SETF (OUTPUT-SEGMENT-STRING-CHAR-VIEW SEGMENT)
(CL:MAKE-ARRAY 514. :ELEMENT-TYPE 'CL:STRING-CHAR :DISPLACED-TO SEGMENT)) 2; bump it up to 512B
0 SEGMENT))
;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:DIALNET;STREAM.LISP.2543")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Syntax: ZetaLisp; Mode: LISP; Package: DIAL; Base: 8; Patch-File: T -*-")
;;; Transmit side, user process
(DEFMETHOD (:GET-OUTPUT-SEGMENT DIALNET-INTERFACE) (&OPTIONAL (ELEMENT-TYPE '(CL:UNSIGNED-BYTE 8)))
(PROCESS-WAIT "Serial Output"
#'(LAMBDA () (OR (NULL OUTPUT-BUFFER-BEING-TRANSMITTED)
(NEQ STATE :OPEN))))
(VALUES
(IF (SCL:EQUAL-TYPEP ELEMENT-TYPE '(CL:UNSIGNED-BYTE 8))
OUTPUT-BUFFER
(OUTPUT-SEGMENT-STRING-CHAR-VIEW OUTPUT-BUFFER))
; (SELECTOR ELEMENT-TYPE SCL:EQUAL-TYPEP
; (('(CL:UNSIGNED-BYTE 8)) OUTPUT-BUFFER)
; (('CL:STRING-CHAR (OUTPUT-SEGMENT-STRING-CHAR-VIEW OUTPUT-BUFFER)))
; (OTHERWISE (FERROR "Unsupported element type: ~A" ELEMENT-TYPE)))
2 (+ 2 MAXIMUM-SEGMENT-LENGTH))) 2; has to be re-compiled because it uses this constant
0;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:DIALNET;STREAM.LISP.2543")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Syntax: ZetaLisp; Mode: LISP; Package: DIAL; Base: 8; Patch-File: T -*-")
(DEFFLAVOR DIALNET-INTERFACE
((RAW-STREAM NIL)
(PROCESS NIL) ;Current background process handling us
(STATE :FREE) ;See above
(NETWORK NIL)
FOREIGN-PHONE-NUMBER ;Only valid when FOREIGN-HOST not NIL.
FOREIGN-ADDRESS
(FOREIGN-HOST NIL)
(STREAM-PROTOCOL NIL)
(USER-STREAM NIL) ;The user stream
(INPUT-SEGMENT-1 (MAKE-AN-INPUT-SEGMENT)) ; (cl:unsigned-byte 8)'s, with indirected cl:string-char
(INPUT-SEGMENT-2 (MAKE-AN-INPUT-SEGMENT)) ; ditto
(INPUT-SEQUENCE-NUMBER 0)
NEXT-USER-INPUT-SEGMENT
(CONTROL-BYTE-NOT-VALID 0)
(DATA-BYTE-NOT-VALID 0)
(CHECKSUM-ERRORS 0)
(DUPLICATE-DATA 0)
(OUTPUT-BUFFER (MAKE-AN-OUTPUT-SEGMENT))
(OUTPUT-BUFFER-BEING-TRANSMITTED NIL)
(OUTPUT-SEQUENCE-NUMBER -1)
(LAST-TRANSMIT-TIME 0)
(FORCE-TRANSMISSION NIL)
(RETRANSMISSIONS 0)
IDLE-START-TIME ;When we went into the IDLE state
(LAST-SEGMENT-RECEIVED-TIME 0)
(SCRATCH-BUFFER (CL:MAKE-ARRAY 511. :ELEMENT-TYPE '(CL:UNSIGNED-BYTE2 08))) 2;changed to 512B
0 (USING-MAILER-LOGGING NIL) ; Set to T when the :ANSWERER process ...
; ... notices a mailer log has been initialized.
)
()
(:INITABLE-INSTANCE-VARIABLES RAW-STREAM NETWORK)
(:GETTABLE-INSTANCE-VARIABLES STATE FOREIGN-HOST NETWORK)
(:WRITABLE-INSTANCE-VARIABLES FOREIGN-HOST)
(:REQUIRED-METHODS :CARRIER-DETECT-VALID))
;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:DIALNET;STREAM.LISP.2543")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Syntax: ZetaLisp; Mode: LISP; Package: DIAL; Base: 8; Patch-File: T -*-")
(DEFMACRO INPUT-SEGMENT-N (N)
`(IF (NOT (BIT-TEST 1 ,N))
INPUT-SEGMENT-1
INPUT-SEGMENT-2))
;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:DIALNET;STREAM.LISP.2543")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Syntax: ZetaLisp; Mode: LISP; Package: DIAL; Base: 8; Patch-File: T -*-")
(DEFMACRO INPUT-SEGMENT-FULL-P (INPUT-SEGMENT)
`(INPUT-SEGMENT-CONTROL ,INPUT-SEGMENT))
;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:DIALNET;STREAM.LISP.2543")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Syntax: ZetaLisp; Mode: LISP; Package: DIAL; Base: 8; Patch-File: T -*-")
(DEFMETHOD (:TOP-LEVEL-RUN-STATE-MACHINE DIALNET-INTERFACE) (&KEY WE-ARE-ORIGINATOR-P)
;; Must be run inside :TOP-LEVEL-GUTS, which sets up the UNWIND-PROTECT that will hang
;; up the phone if we get an error.
(DECLARE (SPECIAL MAILER:*MAILER-LOG*))
(FLET ((TRANSMIT-NEEDED ()
(OR FORCE-TRANSMISSION
(TIME-ELAPSED-P *RELIABLE-STREAM-RETRANSMIT-TIME* LAST-TRANSMIT-TIME))))
(BLOCK EXIT-LOOP
(LOOP WITH OLD-STATE = NIL ; State we check our current state against.
WITH OLD-STATE-TIME = (ZL:TIME) ; Time we entered this state.
WITH OLD-TRANSMIT-SEQUENCE = -3 ; Sequence numbers when we entered the state.
WITH OLD-RECEIVE-SEQUENCE = -3 ; -3 is never used anywhere (-1 is).
DOING
(FLET ((NO-PROGRESS? ()
(PROTOCOL-UNSYNCHRONIZED-TIMEOUT?
SELF OLD-STATE-TIME
:WE-ARE-ORIGINATOR-P WE-ARE-ORIGINATOR-P
:REASON (FORMAT NIL "Dialnet FSM state was ~S" STATE))))
(WHEN *WATCH-STATE-MACHINE*
(WHEN (NEQ OLD-STATE STATE)
;; Don't update OLD-STATE here; allow the WHEN below to do that.
(WHEN (MAILER-UP-ON-THIS-MACHINE)
(LETF ((SU:*LOG* MAILER:*MAILER-LOG*))
(SU:LOG-EVENT :NORMAL "~S" STATE)))))
(WHEN (NEQ STATE OLD-STATE)
;; Update all our state information: we've just changed states.
;; Do it atomically, just in case other processes can otherwise get in here.
;; (Of course, if somebody make changes to STATE since the WHEN above,
;; we could miss the change; maybe I should put the WHEN inside the locking
;; form, too. Presumably doing the lock every time around the loop isn't
;; too much overhead: this *is* Dialnet, after all.)
(PROCESS:WITH-NO-OTHER-PROCESSES ; This is probably overly conservative.
(SETF OLD-STATE STATE)
(SETF OLD-STATE-TIME (ZL:TIME))
(SETF OLD-TRANSMIT-SEQUENCE OUTPUT-SEQUENCE-NUMBER)
(SETF OLD-RECEIVE-SEQUENCE INPUT-SEQUENCE-NUMBER)))
(SELECTQ STATE
((:REQUEST-RECEIVED :FILLING-IN-REQUEST)
(WHEN (NO-PROGRESS?)
(RETURN-FROM EXIT-LOOP NIL)))
(:OPEN
(WHEN (AND (= OLD-TRANSMIT-SEQUENCE OUTPUT-SEQUENCE-NUMBER)
(= OLD-RECEIVE-SEQUENCE INPUT-SEQUENCE-NUMBER)
(NO-PROGRESS?)) ; Must be last in the chain so we don't signal a spurious error!
(RETURN-FROM EXIT-LOOP NIL)))
(:HANGUP
(RETURN-FROM EXIT-LOOP NIL))
(:IDLE
;; Timing out in this state is fine---it just means we waited a little bit
;; and there wasn't more work to do. It's not an error.
(WHEN (TIME-ELAPSED-P *OPEN-AND-IDLE-TIMEOUT* IDLE-START-TIME)
(RETURN-FROM EXIT-LOOP NIL))
(SEND SELF :CHECK-FOR-REQUEST))
(:REQUEST-SENT
(WHEN (NO-PROGRESS?)
(RETURN-FROM EXIT-LOOP NIL))
(SEND SELF :CHECK-FOR-REQUEST))
(OTHERWISE
;; The :BAD-STATE reason below used to be just "answer phone", which is
;; totally bogus if we happened to be called from :GET-CONNECTION-TO-HOST.
;; It also used to wedge the "Unit 1 Receiver" process in the debugger (or
;; waiting to type out), since there wasn't anything to catch the error. Geez!
(SEND SELF :BAD-STATE
(IF WE-ARE-ORIGINATOR-P
"make an outgoing phone connection"
"answer an incoming phone connection"))))
(IF (INPUT-SEGMENT-FULL-P (INPUT-SEGMENT-N INPUT-SEQUENCE-NUMBER))
(PROCESS-WAIT "Reliable Serial Top-level" #'TRANSMIT-NEEDED)
(SEND RAW-STREAM :INPUT-WAIT "Reliable Serial Top-level" #'TRANSMIT-NEEDED))
(LOOP REPEAT 2 DO ;2 buffers.
(WHEN (AND (NOT (INPUT-SEGMENT-FULL-P (INPUT-SEGMENT-N INPUT-SEQUENCE-NUMBER)))
(SEND RAW-STREAM :LISTEN))
(SEND SELF :RECEIVE-INPUT-SEGMENT)))
(WHEN (AND (NOT (INPUT-SEGMENT-FULL-P INPUT-SEGMENT-1))
(NOT (INPUT-SEGMENT-FULL-P INPUT-SEGMENT-2))
(TIME-ELAPSED-P *OPEN-SEGMENT-TIMEOUT* LAST-SEGMENT-RECEIVED-TIME))
(RETURN-FROM EXIT-LOOP NIL))
(WHEN (TRANSMIT-NEEDED)
(SEND SELF :TRANSMIT-OUTPUT-SEGMENT)))))))
;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:DIALNET;STREAM.LISP.2543")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Syntax: ZetaLisp; Mode: LISP; Package: DIAL; Base: 8; Patch-File: T -*-")
(DEFMETHOD (:GET-INPUT-SEGMENT DIALNET-INTERFACE) (NO-HANG-P &OPTIONAL (ELEMENT-TYPE '(CL:UNSIGNED-BYTE 8)))
(LET ((INPUT-SEGMENT
(LOOP DOING
(COND ((INPUT-SEGMENT-FULL-P NEXT-USER-INPUT-SEGMENT)
(RETURN NEXT-USER-INPUT-SEGMENT))
((OR NO-HANG-P
(NEQ STATE :OPEN))
(RETURN NIL))
(T
(PROCESS-WAIT "Serial Input"
#'(LAMBDA ()
(OR (INPUT-SEGMENT-FULL-P NEXT-USER-INPUT-SEGMENT)
(NEQ STATE :OPEN)))))))))
(WHEN INPUT-SEGMENT
(LET ((ISSCV (INPUT-SEGMENT-STRING-CHAR-VIEW INPUT-SEGMENT)))
(SETF (FILL-POINTER ISSCV) (FILL-POINTER INPUT-SEGMENT))
(IF (SCL:EQUAL-TYPEP ELEMENT-TYPE '(CL:UNSIGNED-BYTE 8))
INPUT-SEGMENT
ISSCV)))))
;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:DIALNET;STREAM.LISP.2543")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Syntax: ZetaLisp; Mode: LISP; Package: DIAL; Base: 8; Patch-File: T -*-")
(DEFMETHOD (:DISCARD-INPUT-SEGMENT DIALNET-INTERFACE) (BUFFER)
(UNLESS (EQ (CL:ETYPECASE (AREF BUFFER 0)
((CL:UNSIGNED-BYTE 8) BUFFER)
(CL:STRING-CHAR (SI:ARRAY-INDIRECT-TO BUFFER)))
NEXT-USER-INPUT-SEGMENT)
(FERROR "Returning the wrong buffer."))
;; Do this so don't get screwed by both buffers staying full while user takes
;; a long time and then a moderate time passes before the next segment can come
;; in.
(SETQ LAST-SEGMENT-RECEIVED-TIME (TIME))
(SETF (INPUT-SEGMENT-FULL-P NEXT-USER-INPUT-SEGMENT) NIL)
(SETQ NEXT-USER-INPUT-SEGMENT (IF (EQ NEXT-USER-INPUT-SEGMENT INPUT-SEGMENT-1)
INPUT-SEGMENT-2
INPUT-SEGMENT-1)))
;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:DIALNET;STREAM.LISP.2543")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Syntax: ZetaLisp; Mode: LISP; Package: DIAL; Base: 8; Patch-File: T -*-")
(DEFMETHOD (:RECEIVE-INPUT-SEGMENT DIALNET-INTERFACE) ()
(CATCH 'INPUT-TIMEOUT
(LOOP NAMED TOP DOING
(LET ((CONTROL (SEND SELF :RAW-TYI)))
(WHEN *DIALNET-TRACE-STREAM*
(FORMAT *DIALNET-TRACE-STREAM* "~&~A~30TRCV ~3O Time ~O"
SELF CONTROL (TIME)))
(IF (OR (NOT (LDB-TEST %%SEGMENT-CONTROL CONTROL))
(ZEROP (AREF *PARITY* CONTROL)))
(INCF CONTROL-BYTE-NOT-VALID)
;; If he is expecting the next sequence we will assign, he must
;; have received any retransmission.
(WHEN (= (LDB %%SEGMENT-SEQUENCE-EXPECTED CONTROL)
(LDB (BYTE 1 0) (1+ OUTPUT-SEQUENCE-NUMBER)))
(SETQ OUTPUT-BUFFER-BEING-TRANSMITTED NIL))
;; If there is no data in this segment, no resynch needed
(WHEN (NOT (LDB-TEST %%SEGMENT-DATA CONTROL))
(UNLESS FORCE-TRANSMISSION
(SETQ FORCE-TRANSMISSION :ACK))
(SETQ LAST-SEGMENT-RECEIVED-TIME (TIME))
(RETURN NIL))
(LET ((LENGTH (SEND SELF :RAW-TYI))
(INPUT-SEGMENT (INPUT-SEGMENT-N INPUT-SEQUENCE-NUMBER)))
(IF (LDB-TEST %%SEGMENT-CONTROL LENGTH)
(INCF CONTROL-BYTE-NOT-VALID)
(MULTIPLE-VALUE-BIND (CHECKSUM DATA-INVALID)
(STRING-IN-COMPUTING-CHECKSUM INPUT-SEGMENT LENGTH)
(COND (DATA-INVALID
(INCF DATA-BYTE-NOT-VALID))
(( CHECKSUM (SEND SELF :RAW-TYI))
(INCF CHECKSUM-ERRORS))
(T
;; We have now read a data segment, see if it is the one we
;; wanted.
(SETQ LAST-SEGMENT-RECEIVED-TIME (TIME))
(LET ((NEXT-P (= (LDB %%SEGMENT-DATA-SEQUENCE CONTROL)
(LDB (BYTE 1 0) INPUT-SEQUENCE-NUMBER))))
(IF NEXT-P
(INCF INPUT-SEQUENCE-NUMBER)
(INCF DUPLICATE-DATA))
(UNLESS FORCE-TRANSMISSION
(SETQ FORCE-TRANSMISSION :ACK))
(WHEN NEXT-P
(WHEN (LDB-TEST %%SEGMENT-BINARY CONTROL)
(SETQ LENGTH (CONVERT-SEGMENT-78 INPUT-SEGMENT 0 LENGTH T)))
(SETF (INPUT-SEGMENT-LENGTH INPUT-SEGMENT) LENGTH)
(SETF (INPUT-SEGMENT-CONTROL INPUT-SEGMENT) CONTROL)
(RETURN T))
;; Try to get next segment, don't need resynch
(RETURN NIL)))))))))
;; Here we need to resynch, look for a valid control character
(LOOP DOING
(LET ((CONTROL (SEND SELF :RAW-TYI)))
(WHEN (AND (LDB-TEST %%SEGMENT-CONTROL CONTROL)
(NOT (ZEROP (AREF *PARITY* CONTROL))))
(SEND RAW-STREAM :UNTYI CONTROL)
(RETURN-FROM TOP (VALUES))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
the dialnet TRACE for Mailing (normal segment sizes)
#<DYNAMIC-LISP-LISTENER Dynamic Lisp Listener 2 2006416176 exposed>
Transmt Time:16036351 -- Control:200 -- OutBuf:`DIAL 1 16025388569P
Transmt Time:16036353 -- Control:310 -- OutBuf:H?SMTP
Receive Time:16036370 -- Control:200
Transmt Time:16036371 -- Control:200 -- OutBuf:H?SMTP
Receive Time:16036372 -- Control:221
Transmt Time:16036373 -- Control:200 -- OutBuf:H?SMTP
Receive Time:16036402 -- Control:331
Transmt Time:16036403 -- Control:221 -- OutBuf:H?SMTP
Receive Time:16036410 -- Control:221
Transmt Time:16036411 -- Control:221 -- OutBuf:H?SMTP
Receive Time:16036413 -- Control:221
Transmt Time:16036414 -- Control:221 -- OutBuf:H?SMTP
Receive Time:16036423 -- Control:221
Transmt Time:16036423 -- Control:221 -- OutBuf:H?SMTP
Receive Time:16036476 -- Control:221
Receive Time:16036476 -- Control:221
Transmt Time:16036477 -- Control:221 -- OutBuf:H?SMTP
Receive Time:16036503 -- Control:361
Transmt Time:16036511 -- Control:200 -- OutBuf:H?SMTP
Transmt Time:16036512 -- Control:340 -- OutBuf:`0HELO BOOTES.FIM-Huachuca.dialnet.symbolics.com
Receive Time:16036516 -- Control:221
Transmt Time:16036517 -- Control:200 -- OutBuf:`0HELO BOOTES.FIM-Huachuca.dialnet.symbolics.com
Receive Time:16036543 -- Control:200
Receive Time:16036543 -- Control:200
Transmt Time:16036544 -- Control:200 -- OutBuf:`0HELO BOOTES.FIM-Huachuca.dialnet.symbolics.com
Receive Time:16036566 -- Control:301
Transmt Time:16036572 -- Control:221 -- OutBuf:`0HELO BOOTES.FIM-Huachuca.dialnet.symbolics.com
Transmt Time:16036574 -- Control:320 -- OutBuf:P<MAIL From:<Bill@BOOTES.FIM-Huachuca.dialnet.symbolics.com>
Receive Time:16036624 -- Control:221
Transmt Time:16036625 -- Control:221 -- OutBuf:P<MAIL From:<Bill@BOOTES.FIM-Huachuca.dialnet.symbolics.com>
Receive Time:16036661 -- Control:221
Transmt Time:16036662 -- Control:221 -- OutBuf:P<MAIL From:<Bill@BOOTES.FIM-Huachuca.dialnet.symbolics.com>
Receive Time:16036704 -- Control:221
Transmt Time:16036705 -- Control:221 -- OutBuf:P<MAIL From:<Bill@BOOTES.FIM-Huachuca.dialnet.symbolics.com>
Receive Time:16037007 -- Control:361
Transmt Time:16037010 -- Control:200 -- OutBuf:P<MAIL From:<Bill@BOOTES.FIM-Huachuca.dialnet.symbolics.com>
Transmt Time:16037012 -- Control:340 -- OutBuf:`+RCPT To:<pete@PEGASUS.GALAXY.MYSTECH.COM>
9s
Receive Time:16037037 -- Control:200
Transmt Time:16037040 -- Control:200 -- OutBuf:`+RCPT To:<pete@PEGASUS.GALAXY.MYSTECH.COM>
9s
Receive Time:16037064 -- Control:301
Transmt Time:16037065 -- Control:221 -- OutBuf:`+RCPT To:<pete@PEGASUS.GALAXY.MYSTECH.COM>
9s
Transmt Time:16037066 -- Control:320 -- OutBuf:PDATA
1:
Receive Time:16037110 -- Control:221
Transmt Time:16037111 -- Control:221 -- OutBuf:PDATA
1:
Receive Time:16037133 -- Control:361
Transmt Time:16037135 -- Control:200 -- OutBuf:PDATA
1:
Transmt Time:16037137 -- Control:340 -- OutBuf:`oDate: Tue, 22 Sep 1992 12:41-0600
From: Bill Anderson <Bill@BOOTES.FI
M-Huachuca.dialnet.symbolics.com>
Subjec^
Receive Time:16037176 -- Control:200
Transmt Time:16037177 -- Control:200 -- OutBuf:`oDate: Tue, 22 Sep 1992 12:41-0600
From: Bill Anderson <Bill@BOOTES.FI
M-Huachuca.dialnet.symbolics.com>
Subjec^
Transmt Time:16037201 -- Control:301 -- OutBuf:Aot: stupid
To: pl-m@BOOTES.FIM-Huachuca.dialnet.symbolics.com
Message-ID:
<19920922184120.2.BILL@BOOTES.FIM-Hu$
Receive Time:16037240 -- Control:221
Transmt Time:16037242 -- Control:200 -- OutBuf:Aot: stupid
To: pl-m@BOOTES.FIM-Huachuca.dialnet.symbolics.com
Message-ID:
<19920922184120.2.BILL@BOOTES.FIM-Hu$
Transmt Time:16037251 -- Control:340 -- OutBuf:`-achuca.dialnet.symbolics.com>
message