Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	TITLE CAFARD Program to exchange mail via TTY line
	SUBTTL Written by Mark Crispin/MRC CMIRH 19 July 1984

; Copyright (C) 1984, 1985, 1986, 1987 Mark Crispin.  All rights reserved.

; Version components

CAFWHO==0			; who last edited Cafard (0=developers)
CAFVER==6			; Cafard's release version (matches monitor's)
CAFMIN==1			; Cafard's minor version
CAFEDT==^D53			; Cafard's edit version

;  This is an interim program, supposedly to be replaced by the real,
; wonderful program, written in a high-level language, knowing the
; answer to Life, the Universe, and Everything...
;
;  I fear that by the time you read these comments, gentle reader, that
; it is years after I wrote this program, and it is running everywhere.
; Hence the name Cafard -- this program might easily become as ubiquitous
; as a cockroach!
;
;  If you don't believe this is where the name comes from, I have another
; story, but it'll cost you a beer to hear it...

	SEARCH MACSYM,MONSYM	; system definitions
	SALL			; suppress macro expansions
	.DIRECTIVE FLBLST	; sane listings for ASCIZ, etc.
	.TEXT "/NOINITIAL"	; suppress loading of JOBDAT
	.TEXT "CAFARD/SAVE"	; save as CAFARD.EXE
	.TEXT "/SYMSEG:PSECT:CODE" ; put symbol table and patch area in CODE
	.REQUIRE HSTNAM		; host name routines
	.REQUIRE WAKEUP		; MMailr wakeup
	.REQUIRE CAFPRO		; Cafard protocol routines
	.REQUIRE CAFDTR		; Cafard DTR routines
	.REQUIRE SYS:MACREL	; MACSYM support routines
IFNDEF OT%822,OT%822==:1
	EXTERN $GTLCL,$SPCNS,$RMREL
	EXTERN $WAKE
	EXTERN $PINIT,$PBIN,$PSOUT,$PEOF
	EXTERN $DTRON,$DTROF

	SUBTTL Definitions

A=1				; JSYS, temporary AC's
B=2
C=3
D=4
E=5
PC=14				; JSP pointer

IFNDEF FILPGS,FILPGS==^D10	; number of file pages to PMAP% at a time
IFNDEF PDLLEN,PDLLEN==300	; stack length
IFNDEF AUTLEN,AUTLEN==^D40	; allow for a pretty big return path
IFNDEF LINBSZ,LINBSZ==^D40	; line buffer size in words
IFNDEF LINTBL,LINTBL==^D20	; max number of lines to try
IFNDEF NOTRYS,NOTRYS==^D10	; number of tries to open before giving up
IFNDEF LOOPMX,LOOPMX==^D10	; maximum number of iterations of a loop

; EMSG string
; Outputs an error message

DEFINE EMSG (STRING) <
 HRROI A,[ASCIZ&STRING&]
 ESOUT%
>;DEFINE EMSG

	SUBTTL Storage defintions

	.PSECT DATA,1000	; enter DATA psect

DEBUGP:	BLOCK 1			; non-zero if debugging
LINJFN:	BLOCK 1			; JFN of line protocol is happening on
LINBFR:	BLOCK LINBSZ		; line buffer
LINPTR:	BLOCK 1			; pointer to current byte in line buffer
LINCTR:	BLOCK 1			; number of bytes left in line buffer
PCSAVE:	BLOCK 1			; save PC on error
PDL:	BLOCK PDLLEN		; stack
AUTHOR:	BLOCK AUTLEN		; return-path copied here

	.ENDPS

	.PSECT PAGDAT,300000	; paged data

FILPAG:	BLOCK FILPGS*1000	; PMAP% readin area for file

	.ENDPS

	SUBTTL Start of program

	.PSECT CODE,100000	; enter CODE psect

; Entry vector

EVEC:	JRST CAFARD		; start address
	JRST DRAFAC		; reenter address
IFNDEF VI%DEC,VI%DEC==:1B18
	<FLD CAFWHO,VI%WHO>!<FLD CAFVER,VI%MAJ>!<FLD CAFMIN,VI%MIN>!VI%DEC!<FLD CAFEDT,VI%EDN>
EVECL==.-EVEC

CAFARD:	JSP PC,INIT		; do initialization crud
	CALL CONECT		; establish connection
	IFSKP.
	  TMSG <Sending mail...
>
	  CALL SENDER		; send what we have over
	ANSKP.
	  TMSG <Receiving mail...
>
	  CALL RECVER		; receive what the other end has for us
	  IFNSK.
	    TMSG <Mail receive lost
>
	  ENDIF.
	  CALL $WAKE		; wake up the mailer
	ELSE.
	  TMSG <Mail transmission lost
>
	ENDIF.
	CALL CLOSER		; close the connection
	HALTF%
	JRST CAFARD

DRAFAC:	JSP PC,INIT		; do initialization crud
	CALL SERVER		; do the server
	HALTF%
	JRST DRAFAC

INIT:	RESET%			; reset all I/O
	MOVE P,[IOWD PDLLEN,PDL] ; init stack
	SETZM LINCTR		; nothing in line input buffer
	JRST (PC)		; return to caller

SERVER:	MOVX A,GJ%SHT		; get JFN on our terminal
	HRROI B,[ASCIZ/TTY:/]
	GTJFN%
	 ERCAL FATAL
	MOVEM A,LINJFN		; save line JFN
	MOVX B,<<FLD 7,OF%BSZ>!OF%WR!OF%RD> ; open read/write
	OPENF%
	 ERCAL FATAL
	RFMOD%			; get current mode
	TRZ B,TT%DAM!TT%PGM	; binary mode
	SFMOD%
	 ERCAL FATAL
	STPAR%
	 ERCAL FATAL
	HRROI B,[ASCIZ/Cockroach
/]				; send expected greeting
	SETZ C,
	CALL $SOUT
	 RET
	CALL $PINIT		; initialize protocol
	CALL RECVER		; receive what the other end has for us
	IFSKP.
	  CALL $WAKE		; wake up the mailer
	  CALL SENDER		; send what we have over
	ANSKP.
	  HRROI B,[ASCIZ/hcaorkcoC
/]				; send expected greeting
	  SETZ C,
	  CALL $SOUT
	   RET
	ENDIF.
	RET

	SUBTTL Establish connection

DLGCTX:	TRVAR <DLGJFN,DLGPTR,<LINTAB,LINTBL+1>,<LINSTR,10>,TRYCNT,LOOPTR,LOOPCN,LOSFLG>
	MOVX A,NOTRYS		; establish try count
	MOVEM A,TRYCNT
	SETOM LOOPTR		; initialize loop pointer
	SETZM LOSFLG		; "not losing" (yet)
	JRST (PC)

CONECT:	JSP PC,DLGCTX		; establish dialog context
	MOVX A,GJ%SHT!GJ%OLD	; try to find dialog file
	HRROI B,[ASCIZ/OPEN-DIALOG.TXT/]
	GTJFN%
	IFJER.
	  EMSG <Can't get dialog file - >
	  CALLRET LSTERR
	ENDIF.
	MOVEM A,DLGJFN		; save JFN we got
	MOVX B,<<FLD 7,OF%BSZ>!OF%RD> ; open 7-bit read
	OPENF%
	IFJER.
	  EMSG <Can't open dialog file - >
	  CALLRET LSTERR
	ENDIF.
	MOVSI E,-LINTBL		; make pointer to line table
	HRRI E,LINTAB
	DO.
	  MOVX C,^D8		; all lines are octal
	  NIN%			; get
	  IFJER.
	    EMSG <Bogus line number in dialog file - >
	    CALLRET LSTERR
	  ENDIF.
	  MOVEM B,(E)		; save line number we got
	  BKJFN%
	   ERCAL FATAL
	  BIN%			; check out next character
	  CAIE B,"/"		; start of speed?
	  IFSKP.
	    MOVX C,^D10		; get speed
	    NIN%
	    IFJER.
	      EMSG <Bogus speed in dialog file - >
	      CALLRET LSTERR
	    ENDIF.
	    HRLM B,(E)		; save speed we got
	  ENDIF.
	  BKJFN%		; sigh...
	   ERCAL FATAL
	  DO.
	    BIN%		; see if another line
	    CAIE B,.CHTAB	; ignore whitespace
	     CAIN B,.CHSPC
	      LOOP.
	    CAIE B,"!"		; start of comment?
	    IFSKP.
	      DO.
		BIN%		; get comment character
		CAIE B,"!"	; end of comment?
		 LOOP.		; no, continue eating comment characters
	      ENDDO.
	      LOOP.		; resume whitespace scan
	    ENDIF.
	  ENDDO.
	  CAIN B,","		; saw a comma?
	   AOBJN E,TOP.		; yes, get another line
	ENDDO.
	IFGE. E			; if ran out of room
	  EMSG <Line table too long in dialog file
>
	  RET
	ENDIF.
	CAIN B,.CHCRT		; saw expected return?
	 BIN%			; yes, get line feed
	CAIN B,.CHLFD		; saw expected line feed?
	IFSKP.
	  EMSG <Extra crud in line table in dialog file
>
	  RET
	ENDIF.
	RFPTR%			; get current file position pointer
	 ERCAL FATAL
	MOVEM B,DLGPTR
	SETOM 1(E)		; indicate end of table
	DO.
	  MOVSI E,-LINTBL	; make pointer to line table
	  HRRI E,LINTAB
	  DO.
	    SKIPGE (E)		; line to grab
	     EXIT.		; no more lines
	    DO.
	      MOVX A,<ASCII/TTY/> ; start TTY string name
	      MOVEM A,LINSTR
	      MOVE A,[POINT 7,LINSTR,20]
	      HRRZ B,(E)	; line number
	      MOVX C,^D8	; in octal
	      NOUT%
	       ERCAL FATAL
	      MOVX B,":"	; finally a device indicator
	      IDPB B,A
	      SETZ B,		; tie off with null
	      IDPB B,A
	      MOVX A,GJ%SHT	; try to get TTY
	      HRROI B,LINSTR
	      GTJFN%
	       ERJMP ENDLP.	; lost, try next line
	      MOVEM A,LINJFN	; save JFN for later
	      MOVX B,<<FLD 7,OF%BSZ>!OF%WR!OF%RD> ; open read/write
	      OPENF%		; try to open the line
	      IFJER.
		TMSG <Line >
		MOVX A,.PRIOU	; output line #
		HRRZ B,(E)
		MOVX C,^D8
		NOUT%
		 ERJMP .+1
		TMSG < can't be opened - >
		CALL LSTERR
		MOVE A,LINJFN	; foo, release the JFN
		RLJFN%
		 ERJMP .+1
		SETZM LINJFN	; no line JFN any more
		EXIT.		; try next line
	      ENDIF.
	      CFIBF%		; clear out any input
	       ERCAL FATAL
	      CFOBF%		; and any output
	       ERCAL FATAL
	      RFMOD%		; get current mode
	       ERCAL FATAL
	      TXZ B,TT%DAM!TT%PGM ; binary mode
	      SFMOD%
	       ERCAL FATAL
	      STPAR%
	       ERCAL FATAL
	      TMSG <Calling out on line >
	      MOVX A,.PRIOU	; output line #
	      HRRZ B,(E)
	      MOVX C,^D8
	      NOUT%
	       ERJMP .+1
	      TMSG <
>
	      MOVE A,LINJFN	; get JFN for line
	      CALL $DTROF	; drop DTR first
	      MOVX A,^D1000	; wait a second
	      DISMS%
	      MOVE A,LINJFN	; now assert DTR
	      CALL $DTRON
	      MOVX A,^D1000	; wait a second
	      DISMS%
	      HLRZ C,(E)	; get speed if any
	      IFN. C		; was there any?
		MOVE A,LINJFN	; yes, set the speed
		MOVX B,.MOSPD
		HLL C,(E)	; in both halfwords
		MTOPR%
		 ERCAL FATAL
	      ENDIF.
	      MOVE A,DLGJFN	; reset dialog to point to start
	      MOVE B,DLGPTR
	      SFPTR%
	       ERCAL FATAL
	      SETOM LOOPTR	; initialize loop pointer
	      DO.
		MOVE A,DLGJFN
		BIN%		; get dialog command
		IFNJE.
		  XCT DLGRTB(B)	; do dialog grammar for this character
		   LOOP.
		  SKIPN LOSFLG	; lost in dialog or grammar?
		   SETZM TRYCNT	; grammar punted, give up!
		  MOVE A,LINJFN	; either way, close the line
		  CFIBF%
		   ERJMP .+1
		  CFOBF%
		   ERJMP .+1
		  CALL $DTROF	; drop DTR...
		  CLOSF%
		   ERJMP .+1
		  SETZM LINJFN	; no line JFN any more
		ELSE.
		  SETZM TRYCNT	; end of file, success, no more retries
		ENDIF.
	      ENDDO.
	    ENDDO.
	    SKIPE TRYCNT	; do we need to retry still?
	     AOBJN E,TOP.	; yes, try next line in list
	  ENDDO.
	  SKIPN TRYCNT		; do we need to retry?
	  IFSKP.
	    SOSG TRYCNT		; yes, count off another retry
	    IFSKP.
	      MOVX A,^D60000	; wait a minute and try again
	      DISMS%
	      LOOP.		; still have a few more
	    ENDIF.
	    EMSG <Exhausted connection retries
>
	    RET
	  ENDIF.
	ENDDO.
	MOVE A,DLGJFN		; now close off the JFN
	CLOSF%
	 ERJMP .+1		; ignore failure
	SKIPN LINJFN		; still have the line?
	 RET			; no, return failure
	CALL $PINIT		; initialize protocol
	RETSKP			; return success

	SUBTTL Close connection

CLOSER:	JSP PC,DLGCTX		; establish dialog context
	MOVX A,GJ%SHT!GJ%OLD	; try to find dialog file
	HRROI B,[ASCIZ/CLOSE-DIALOG.TXT/]
	GTJFN%
	 ERJMP R		; so no close dialog file exists!
	MOVEM A,DLGJFN		; save JFN we got
	MOVX B,<<FLD 7,OF%BSZ>!OF%RD> ; open 7-bit read
	OPENF%
	IFJER.
	  EMSG <Can't open connection close dialog file - >
	  CALLRET LSTERR
	ENDIF.
	DO.
	  MOVE A,DLGJFN
	  BIN%			; get dialog command
	  IFNJE.
	    XCT DLGRTB(B)	; do dialog grammar for this character
	     LOOP.
	  ENDIF.
	ENDDO.
	MOVE A,LINJFN		; end of file, close the line JFN
	CFIBF%			; clear buffers
	 ERJMP .+1
	CFOBF%
	 ERJMP .+1
	CALL $DTROF		; drop DTR...
	CLOSF%
	 ERJMP .+1
	SETZM LINJFN		; no line JFN any more
	MOVE A,DLGJFN		; now close off the dialog JFN
	CLOSF%
	 ERJMP .+1		; ignore failure
	RET			; return

	SUBTTL Open/Close dialog grammar and execution

; Dialog grammar vector

DLGRTB:	NOP			; ^@ ignored
	CALL GBOGUS		; ^A bogus character
	CALL GBOGUS		; ^B bogus character
	CALL GBOGUS		; ^C bogus character
	CALL GBOGUS		; ^D bogus character
	CALL GBOGUS		; ^E bogus character
	CALL GBOGUS		; ^F bogus character
	CALL GBOGUS		; ^G bogus character
	CALL GBOGUS		; ^H bogus character
	NOP			; ^I whitespace ignored
	NOP			; ^J whitespace ignored
	CALL GBOGUS		; ^K bogus character
	NOP			; ^L whitespace ignored
	NOP			; ^M whitespace ignored
	CALL GBOGUS		; ^N bogus character
	CALL GBOGUS		; ^O bogus character
	CALL GBOGUS		; ^P bogus character
	CALL GBOGUS		; ^Q bogus character
	CALL GBOGUS		; ^R bogus character
	CALL GBOGUS		; ^S bogus character
	CALL GBOGUS		; ^T bogus character
	CALL GBOGUS		; ^U bogus character
	CALL GBOGUS		; ^V bogus character
	CALL GBOGUS		; ^W bogus character
	CALL GBOGUS		; ^X bogus character
	CALL GBOGUS		; ^Y bogus character
	CALL GBOGUS		; ^Z bogus character
	CALL GBOGUS		; ^[ bogus character
	CALL GBOGUS		; ^\ bogus character
	CALL GBOGUS		; ^] bogus character
	CALL GBOGUS		; ^^ bogus character
	CALL GBOGUS		; ^_ bogus character
	NOP			; SPACE whitespace ignored
	CALL GCOMNT		; ! comment toggle
	CALL GSTEXT		; " send text
	CALL GBOGUS		; # bogus character
	CALL GBOGUS		; $ bogus character
	CALL GBOGUS		; % bogus character
	CALL GBOGUS		; & bogus character
	CALL GBOGUS		; ' bogus character
	CALL GBOGUS		; ( bogus character
	CALL GBOGUS		; ) bogus character
	CALL GBOGUS		; * bogus character
	NOP			; + success clause, ignored here
	CALL GBOGUS		; , bogus character
	NOP			; - failure clause, ignored here
	CALL GBOGUS		; . bogus character
	CALL GBOGUS		; / bogus character
	CALL GBOGUS		; 0 bogus character
	CALL GBOGUS		; 1 bogus character
	CALL GBOGUS		; 2 bogus character
	CALL GBOGUS		; 3 bogus character
	CALL GBOGUS		; 4 bogus character
	CALL GBOGUS		; 5 bogus character
	CALL GBOGUS		; 6 bogus character
	CALL GBOGUS		; 7 bogus character
	CALL GBOGUS		; 8 bogus character
	CALL GBOGUS		; 9 bogus character
	CALL GBOGUS		; : bogus character
	CALL GBOGUS		; ; bogus character
	CALL GBEGIN		; < begin loop
	CALL GEQUAL		; = test for desired string
	SETOM LOOPTR		; > end of loop
	CALL GBOGUS		; ? bogus character
	CALL GBOGUS		; @ bogus character
	CALL GBOGUS		; A bogus character
	CALL GBOGUS		; B bogus character
	CALL GBOGUS		; C bogus character
	CALL GBOGUS		; D bogus character
	CALL GEAT		; E eat input
	CALL GBOGUS		; F bogus character
	CALL GBOGUS		; G bogus character
	CALL GBOGUS		; H bogus character
	CALL GBOGUS		; I bogus character
	CALL GBOGUS		; J bogus character
	CALL GBOGUS		; K bogus character
	CALL GLOSE		; L dialog lossage
	CALL GBOGUS		; M bogus character
	CALL GBOGUS		; N bogus character
	CALL GBOGUS		; O bogus character
	CALL GBOGUS		; P bogus character
	CALL GBOGUS		; Q bogus character
	CALL GBOGUS		; R bogus character
	CALL GBOGUS		; S bogus character
	CALL GBOGUS		; T bogus character
	CALL GBOGUS		; U bogus character
	CALL GBOGUS		; V bogus character
	CALL GWAIT		; W wait 250 ms
	CALL GLEXIT		; X exit loop
	CALL GBOGUS		; Y bogus character
	CALL GBOGUS		; Z bogus character
	CALL GMESAG		; [ output to terminal
	CALL GBOGUS		; \ bogus character
	CALL GBOGUS		; ] bogus character
	CALL GLOOP		; ^ go to top of loop
	CALL GBOGUS		; _ bogus character
	CALL GBOGUS		; ` bogus character
	CALL GBOGUS		; a bogus character
	CALL GBOGUS		; b bogus character
	CALL GBOGUS		; c bogus character
	CALL GBOGUS		; d bogus character
	CALL GEAT		; e eat input
	CALL GBOGUS		; f bogus character
	CALL GBOGUS		; g bogus character
	CALL GBOGUS		; h bogus character
	CALL GBOGUS		; i bogus character
	CALL GBOGUS		; j bogus character
	CALL GBOGUS		; k bogus character
	CALL GLOSE		; l dialog lossage
	CALL GBOGUS		; m bogus character
	CALL GBOGUS		; n bogus character
	CALL GBOGUS		; o bogus character
	CALL GBOGUS		; p bogus character
	CALL GBOGUS		; q bogus character
	CALL GBOGUS		; r bogus character
	CALL GBOGUS		; s bogus character
	CALL GBOGUS		; t bogus character
	CALL GBOGUS		; u bogus character
	CALL GBOGUS		; v bogus character
	CALL GWAIT		; w wait 250 ms
	CALL GLEXIT		; x exit loop
	CALL GBOGUS		; y bogus character
	CALL GBOGUS		; z bogus character
	CALL GBOGUS		; { bogus character
	CALL GBOGUS		; | bogus character
	CALL GBOGUS		; } bogus character
	NOP			; ~ end of conditional, ignored
	CALL GBOGUS		; RUBOUT bogus character

; Bogus command

GBOGUS:	EMSG <Bogus command character in dialog file: >
	MOVX A,.PRIOU
	BOUT%
	TMSG <
>
	RETSKP			; indicate we should punt

; "L" dialog lossage

GLOSE:	SETOM LOSFLG		; flag dialog lossage
	RETSKP

; "<" begin loop

GBEGIN:	SKIPGE LOOPTR		; already in a loop?
	IFSKP.
	  EMSG <Nested loops not allowed
>
	  RETSKP		; maybe remove this restriction someday
	ENDIF.
	MOVE A,DLGJFN		; note this pointer
	RFPTR%			; pointer to start of test string
	IFJER.
	  CALL FATAL		; strange lossage
	  RETSKP
	ENDIF.
	MOVEM B,LOOPTR
	MOVNI B,LOOPMX		; maximum number of times loops run
	MOVEM B,LOOPCN
	RET

; "^" resume iteration

GLOOP:	SKIPL B,LOOPTR		; already in a loop?
	IFSKP.
	  EMSG <"^" outside of loop
>
	  RETSKP		; maybe remove this restriction someday
	ENDIF.
	AOSLE LOOPCN		; ran out of iterations?
	 RET			; yes, no-op now
	MOVE A,DLGJFN		; reset point pointer
	SFPTR%
	IFJER.
	  CALL FATAL		; strange lossage
	  RETSKP
	ENDIF.
	RET

; "X" exit loop

GLEXIT:	MOVE A,DLGJFN		; end of loop search
	DO.
	  BIN%
	   ERJMP R
	  CAIN B,">"		; found end of loop?
	   EXIT.		; yes, continue from that point
	  CAIE B,""""		; quoted string?
	   CAIN B,"!"		; comment?
	  IFNSK.
	    MOVE C,B		; yes, search for end of string first
	    DO.
	      BIN%
	       ERJMP R
	      CAME B,C		; end of string yet?
	       LOOP.		; no
	    ENDDO.
	  ELSE.
	    CAIE B,"["		; terminal string?
	    IFSKP.
	      DO.
		BIN%
		 ERJMP R
		CAIE B,"]"	; end of string yet?
		 LOOP.		; no
	      ENDDO.
	    ENDIF.
	  ENDIF.
	  LOOP.			; keep searching
	ENDDO.
	RET

; "E" eat excess input

GEAT:	MOVX C,^D6
	DO.
	  CALL $SIBE		; any characters available for us?
	  IFSKP.
	    MOVX A,^D500	; not expired yet, wait 1/2 second
	    DISMS%
	    SOJGE C,TOP.	; and try again
	  ELSE.
	    CALL $BIN		; read byte from input
	     RETSKP
	    LOOP.
	  ENDIF.
	ENDDO.
	RET

; "W" wait 250 ms

GWAIT:	MOVX A,^D250		; sleep a bit
	DISMS%
	RET

; "!" comment toggle

GCOMNT:	DO.
	  MOVE A,DLGJFN		; get a comment byte
	  BIN%
	  IFNJE.
	    CAIE B,"!"		; end of comment?
	     LOOP.
	  ENDIF.
	ENDDO.
	RET

; `"' output text to the line we're doing protocol on

GSTEXT:	ACVAR <PRV>
	DO.
	  MOVE A,DLGJFN		; get a text byte to output
	  BIN%
	  IFNJE.
	    CAIN B,""""		; end of text?
	  ANSKP.
	    CAIN B,.CHLFD	; no, is this a line feed?
	     CAIE PRV,.CHCRT	; yes, was previous character CR?
	    IFNSK.
	      CALL $BOUT	; send character to line
	       RETSKP
	      MOVE PRV,B	; save as previous character
	    ENDIF.
	    LOOP.		; do next byte
	  ENDIF.
	ENDDO.
	RET

	ENDAV.

; "[" output message to our terminal

GMESAG:	DO.
	  MOVE A,DLGJFN		; get a text byte to output
	  BIN%
	  IFNJE.
	    CAIN B,"]"		; end of text?
	  ANSKP.
	    MOVX A,.PRIOU	; output to terminal
	    BOUT%
	    LOOP.
	  ENDIF.
	RET

; "=" test for desired string

GEQUAL:	STKVAR <TSTCHR,TSTBEG,TSTTMO>
	SETZ C,			; clear running timeout value
	MOVE A,DLGJFN		; get expected quote
	DO.
	  BIN%
	   ERJMP .+1		; EOF is pretty losing...
	  CAIL B,"0"		; numeric?
	   CAILE B,"9"
	    EXIT.		; not a digit!
	  IMULI C,^D10		; a digit, another decade...
	  ADDI C,-"0"(B)	; add in new digit
	  LOOP.
	ENDDO.
	SKIPN C			; was a timeout given?
	 MOVX C,1		; allow at least 1 second
	LSH C,1			; timeout ticks are in 1/2 seconds
	MOVEM C,TSTTMO		; set timeout
	CAIN B,""""		; was it what we wanted?
	IFSKP.
	  EMSG <Missing required quote
>
	  RETSKP
	ENDIF.
	RFPTR%			; pointer to start of test string
	IFJER.
	  CALL FATAL		; strange lossage
	  RETSKP
	ENDIF.
	MOVEM B,TSTBEG
	DO.
	  MOVE A,DLGJFN		; get byte to compare with
	  BIN%
	   ERJMP R
	  CAIN B,""""		; end of test string?
	  IFSKP.
	    MOVEM B,TSTCHR	; save character to test for
	    DO.
	      CALL $SIBE	; any characters available for us?
	      IFSKP.
		SOSGE TSTTMO	; no, has timeout expired?
		IFSKP.
		  MOVX A,^D500	; not expired yet, wait 1/2 second
		  DISMS%
		  LOOP.		; and try again
		ENDIF.
		SETO B,		; "time out" character
	      ELSE.
		CALL $BIN	; read byte from input
		 RETSKP
	      ENDIF.
	    ENDDO.
	    IFGE. B		; exit if timed out
	      CAMN B,TSTCHR	; was it what we expected?
	       LOOP.		; yes, try for another
	      MOVEM B,TSTCHR	; no, save what we got
	      MOVE A,DLGJFN	; reset test string and get first byte
	      MOVE C,TSTBEG
	      RIN%
	      CAMN B,TSTCHR	; matches last character we got?
	       LOOP.		; yes, continue search from here
	      BKJFN%		; oh well, back up to it again
	       ERJMP .+1
	      LOOP.		; and continue search
	    ENDIF.
	    MOVE A,DLGJFN	; search for end of string
	    DO.
	      BIN%		; get random character
	       ERJMP R
	      CAIE B,""""	; end of search string yet?
	       LOOP.		; not yet
	    ENDDO.
	    MOVX C,"-"		; must search for failure clause
	  ELSE.
	    MOVX C,"+"		; search for success clause
	  ENDIF.
	ENDDO.
	MOVE A,DLGJFN		; clause search
	DO.
	  BIN%
	   ERJMP R
	  CAIE B,"~"		; end of conditional or
	   CAMN B,C		;  found what we are looking for?
	    EXIT.		; yes, continue from that point
	  CAIE B,""""		; quoted string?
	   CAIN B,"!"		; comment?
	  IFNSK.
	    MOVE D,B		; yes, search for end of string first
	    DO.
	      BIN%
	       ERJMP R
	      CAME B,D		; end of string yet?
	       LOOP.		; no
	    ENDDO.
	  ELSE.
	    CAIE B,"["		; terminal string?
	    IFSKP.
	      DO.
		BIN%
		 ERJMP R
		CAIE B,"]"	; end of string yet?
		 LOOP.		; no
	      ENDDO.
	    ENDIF.
	  ENDIF.
	  LOOP.			; keep searching
	ENDDO.
	RET

	ENDSV.

	ENDTV.			; end of dialog conventions

	SUBTTL Send mail to remote

SENDER:	STKVAR <QUEJFN,CURPAG,<FILSIZ,2>>
	MOVX A,GJ%IFG!GJ%OLD!GJ%SHT!.GJALL ; look at all the mail queued for us
	HRROI B,[ASCIZ/-MAIL.*.*/]
	GTJFN%
	IFNJE.
	  MOVEM A,QUEJFN	; found it, save the JFN
	  DO.
	    HRRZ A,QUEJFN	; open up file
	    MOVX B,<<FLD 7,OF%BSZ>!OF%RD> ; for 7-bit read
	    OPENF%
	     ERCAL FATAL
	    MOVE B,[2,,.FBBYV]	; get file I/O and byte size info
	    MOVEI C,FILSIZ	; into FILSIZ/FILSIZ+1
	    GTFDB%		; NOTE: depends upon .FBSIZ=.FBBYV+1
	    MOVE B,1+FILSIZ	; get byte count
	    LOAD C,FB%BSZ,FILSIZ ; get file byte size
	    CAIN C,7		; 7-bit bytes?
	    IFSKP.
	      CAIE C,^D36	; allow 36-bit files
	       RET		; otherwise lose!!
	      IMULI B,5		; 5 7-bit bytes per 36-bit word
	    ENDIF.
	    MOVEM B,FILSIZ	; save file size
	    SETZM CURPAG	; start at beginning of file
	    DO.
	      MOVS A,QUEJFN	; file to map from
	      HRR A,CURPAG	; current page to map from
	      MOVX B,<.FHSLF,,<FILPAG/1000>> ; map into this process at FILPAG
	      MOVX C,PM%CNT!PM%RD!PM%PLD!FILPGS ; preload FILPGS pages for read
	      PMAP%		; map the pages
	      HRROI A,FILPAG	; 7-bit bytes
	      MOVX B,FILPGS*5*^D512 ; number of bytes in this page set
	      EXCH B,FILSIZ	; bytes to do yet in C
	      CAMG B,FILSIZ	; more bytes after this page set?
	      IFSKP.
		SUB B,FILSIZ	; yes, account for this page set in count
		EXCH B,FILSIZ	; full page set to output
	      ELSE.
		SETZM FILSIZ	; no, this is the last page set to do
	      ENDIF.
	      CALL $PSOUT	; send it out
	       RET		; failed
	      SKIPG FILSIZ	; more to do yet?
	      IFSKP.
		MOVEI A,FILPGS	; yes, bump CURPAG by number of pages just done
		ADDM A,CURPAG
		LOOP.		; do next set of pages
	      ENDIF.
	      SETO A,		; unmap file pages so we can close the file
	      MOVX B,<.FHSLF,,<FILPAG/1000>>
	      MOVX C,PM%CNT!FILPGS
	      PMAP%
	    ENDDO.
	    CALL $PEOF		; send EOF
	     RET		; hard error
	    HRRZ A,QUEJFN	; close the file
	    TXO A,CO%NRJ
	    CLOSF%
	     ERJMP .+1
	    HRRZ A,QUEJFN	; all done, flush this file
	    TXO A,DF%NRJ	; don't flush the JFN
	    DELF%
	     ERJMP .+1		; shouldn't happen, but don't barf
	    MOVE A,QUEJFN	; get next file
	    GNJFN%
	     ERJMP ENDLP.	; no more files
	    LOOP.
	  ENDDO.
	ENDIF.
	CALL $PEOF		; send EOF
	 RET			; hard error
	RETSKP			; and return

	ENDSV.

	SUBTTL Receive mail from remote and queue

RECVER:	STKVAR <<HSTBUF,^D20>,<TMPBUF,^D20>,TMPPTR,MLQJFN,SAVCHR,ATPTR,BEGPTR,AUTPTR,AUTCNT>
	HRROI A,HSTBUF		; get local name
	CALL $GTLCL
	 RET			; can't possibly happen
	DO.
	  CALL $PBIN		; get character from line
	   RET			; the link died
	  JUMPL B,ENDLP.	; if EOF, nothing more to do
	  MOVEM B,SAVCHR	; save character
	  DO.
	    HRROI A,TMPBUF	; build queued mail filename
	    HRROI B,[ASCIZ/MAILQ:[--QUEUED-MAIL--].NEW-/]
	    SETZ C,
	    SOUT%		; set up initial part of name
	     ERCAL FATAL
	    MOVEM A,TMPPTR	; save string pointer
	    GTAD%		; get system date/time
	    MOVE B,A		; now output it in octal
	    MOVE A,TMPPTR
	    MOVX C,^D8
	    NOUT%
	     ERCAL FATAL
	    HRROI B,[ASCIZ/-CAFARD-J/] ; add originating process name
	    SETZ C,
	    SOUT%
	     ERCAL FATAL
	    MOVEM A,TMPPTR
	    GJINF%
	    MOVE A,TMPPTR
	    HRRZ B,C		; insert job number for unique name
	    MOVX C,^D10		; in decimal
	    NOUT%
	     ERCAL FATAL
	    HRROI B,[ASCIZ/.-1;P770000/] ; next generation, protection 770000
	    SETZ C,
	    SOUT%
	     ERCAL FATAL
	    MOVX A,GJ%NEW!GJ%FOU!GJ%PHY!GJ%SHT ; want new file
	    HRROI B,TMPBUF
	    GTJFN%		; try to get JFN on it
	    IFJER.
	      MOVX A,^D3000	; wait three seconds and try again
	      DISMS%
	      LOOP.
	    ENDIF.
	    MOVEM A,MLQJFN	; save JFN we got
	    MOVX B,<<FLD 7,OF%BSZ>!OF%WR> ; open for write, 7-bit bytes
	    OPENF%
	    IFJER.
	      MOVE A,MLQJFN	; OPENF% failed, release the JFN
	      RLJFN%
	       ERJMP .+1
	      SETZM MLQJFN	; forget about it
	      MOVX A,^D3000	; wait 3 seconds
	      LOOP.		; and try again
	    ENDIF.
	  ENDDO.
	  MOVE B,SAVCHR		; restore first character
	  CAIE B,.CHCRT		; was there a sender argument?
	  IFSKP.
	    CALL $PBIN		; Nein, fress das LF
	    IFSKP.
	      CAIE B,.CHLFD	; Es muss hier ein LF sein!
	    ANSKP.
	    ELSE.
	      TXO A,CZ%ABT	; Scheisse!
	      CLOSF%
	       ERJMP .+1
	      RET		; Goetterdaemmerung...
	    ENDIF.
	  ELSE.
	    MOVX B,.CHFFD	; yes, output form feed first
	    BOUT%
	     ERCAL FATAL
	    HRROI B,[ASCIZ/=RETURN-PATH:/]
	    SOUT%		; output return path header
	     ERCAL FATAL
	    MOVE B,SAVCHR	; output first character of return path
	    MOVE C,[POINT 7,AUTHOR] ; init beginning of author pointer
	    MOVEM C,BEGPTR
	    IDPB B,C		; copy first character
	    MOVEM C,AUTPTR
	    SETZM ATPTR		; init pointer to atsign
	    MOVX C,<AUTLEN*5>-1	; bytes remaining in buffer
	    MOVEM C,AUTCNT
	    BOUT%
	     ERCAL FATAL
	    DO.
	      CALL $PBIN	; get a byte
	      IFSKP.
	      ANDGE. B		; must not be end of file here
		BOUT%		; output byte to file
		 ERCAL FATAL
		CAIE B,"\"	; quote next character?
		IFSKP.
		  CALL $PBIN	; get a byte
		  IFSKP.
		  ANDGE. B	; must not be end of file here
		    SOSL AUTCNT	; space left in buffer?
		     IDPB B,AUTPTR ; yes, add char to author
		    BOUT%	; output byte to file
		     ERCAL FATAL
		  ELSE.
		    TXO A,CZ%ABT ; protocol error or link died, abort this file
		    CLOSF%
		     ERJMP .+1
		    RET		; return lossage
		  ENDIF.
		ENDIF.
		CAIE B,""""	; quoted string?
		IFSKP.
		  DO.
		    CALL $PBIN	; get a byte
		    IFSKP.
		    ANDGE. B	; must not be end of file here
		      BOUT%	; output byte to file
		       ERCAL FATAL
		      CAIN B,"""" ; end of quoted string?
		       EXIT.	; yes, get out now!
		      CAIE B,"\" ; quote next character?
		      IFSKP.
			CALL $PBIN ; get a byte
			IFSKP.
			ANDGE. B ; must not be end of file here
			  SOSL AUTCNT ; space left in buffer?
			   IDPB B,AUTPTR ; yes, add char to author
			  BOUT%	; output byte to file
			   ERCAL FATAL
			ELSE.
			  TXO A,CZ%ABT ; protocol error or link died
			  CLOSF%
			   ERJMP .+1
			  RET	; return lossage
			ENDIF.
		      ENDIF.
		      SOSL AUTCNT ; space left in buffer?
		       IDPB B,AUTPTR ; yes, add char to author
		    ELSE.
		      TXO A,CZ%ABT ; protocol error or link died
		      CLOSF%
		       ERJMP .+1
		      RET	; return lossage
		    ENDIF.
		  ENDDO.
		ENDIF.
		SOSL AUTCNT	; space left in buffer?
		 IDPB B,AUTPTR	; yes, add char to author
		CAIE B,"@"	; hostname starts now?
		IFSKP.
		  MOVE C,AUTPTR	; yes, save pointer to atsign
		  MOVEM C,ATPTR
		ENDIF.
		CAIE B,":"	; encountered colon in A-D-L??
		IFSKP.
		  MOVE C,AUTPTR	; yes, all previous is routing garbage
		  MOVEM C,BEGPTR ; so start from here
		  SETZM ATPTR	; and forget any @ seen
		ENDIF.
		CAIE B,.CHLFD	; at end of line?
		 LOOP.		; do next byte
	      ELSE.
		TXO A,CZ%ABT	; protocol error or link died, abort this file
		CLOSF%
		 ERJMP .+1
		RET		; return lossage
	      ENDIF.
	    ENDDO.
	    SETZ B,		; tie off with NUL
	    IDPB B,AUTPTR
	    SKIPE ATPTR		; @ found?
	     SKIPGE AUTCNT	; yes, copy unless buffer overflowed
	    IFSKP.
	      MOVX B,.CHFFD	; specify sender
	      BOUT%
	      MOVEI B,"_"
	      BOUT%
	      MOVE B,ATPTR	; replace @ in copied string with NUL
	      SETZ C,
	      DPB C,B
	      SOUT%		; output host
	       ERCAL FATAL
	      MOVE B,BEGPTR
	      SOUT%		; output username
	       ERCAL FATAL
	      HRROI B,[ASCIZ/
/]
	      SOUT%		; and final CRLF
	       ERCAL FATAL
	    ENDIF.
	  ENDIF.
	  MOVX B,.CHFFD		; output form feed first
	  BOUT%
	   ERCAL FATAL
	  HRROI B,HSTBUF
	  SETZ C,
	  SOUT%
	   ERCAL FATAL
	  HRROI B,[ASCIZ/
/]
	  SOUT%
	   ERCAL FATAL
	  DO.			; loop to slurp up recipient list
	    CALL $PBIN		; get a byte
	    IFSKP.
	      IFGE. B
		BOUT%		; output byte to file
		 ERCAL FATAL
		CAIE B,.CHFFD	; end of recipient list?
		 LOOP.		; no, do next byte
	      ENDIF.
	    ELSE.
	      TXO A,CZ%ABT	; the link died, abort this file
	      CLOSF%
	       ERJMP .+1
	      RET		; return lossage
	    ENDIF.
	  ENDDO.
	  HRROI B,[ASCIZ/
Received: from /]		; write Received: line
	  SETZ C,
	  SOUT%
	   ERCAL FATAL
	  GJINF%
	  HRROI A,TMPBUF	; try to get foreign name
	  CALL $SPCNS
	  IFSKP.
	    HRROI A,TMPBUF	; remove relative domain
	    CALL $RMREL
	    MOVE A,MLQJFN
	    HRROI B,TMPBUF	; write foreign host
	    SETZ C,
	    SOUT%
	     ERCAL FATAL
	  ELSE.
	    MOVE A,MLQJFN	; standby just in case
	    HRROI B,[ASCIZ/???/]
	    SETZ C,
	    SOUT%
	     ERCAL FATAL
	  ENDIF.
	  HRROI B,[ASCIZ/ by /]
	  SOUT%
	   ERCAL FATAL
	  HRROI A,HSTBUF	; remove relative domain
	  CALL $RMREL
	  MOVE A,MLQJFN
	  HRROI B,HSTBUF	; write local host
	  SOUT%
	   ERCAL FATAL
	  HRROI B,[ASCIZ/ with Cafard; /]
	  SOUT%
	   ERCAL FATAL
	  SETO B,		; output current date/time
	  MOVX C,OT%DAY!OT%SPA!OT%TMZ!OT%SCL!OT%822 ; RFC 822 standard date/time
	  ODTIM%
	   ERCAL FATAL
	  DO.			; loop to slurp message
	    CALL $PBIN		; get a byte
	    IFSKP.
	      IFGE. B
		BOUT%		; output byte to file
		 ERCAL FATAL
		LOOP.		; do next byte
	      ENDIF.
	    ELSE.
	      TXO A,CZ%ABT	; the link died, abort this file
	      CLOSF%
	       ERJMP .+1
	      RET		; return lossage
	    ENDIF.
	  ENDDO.
	  CLOSF%		; close off the file
	   ERJMP .+1
	  LOOP.			; do next message
	ENDDO.
	RETSKP

	ENDSV.

	SUBTTL I/O routines

; $SIBE - Skip if bytes available from line
;	CALL $SIBE
; Returns +1: Number of bytes available in B
;	  +2: No bytes available

$SIBE::	SKIPLE B,LINCTR		; anything in line input buffer?
	IFSKP.
	  SAVEAC <A>
	  MOVE A,LINJFN		; no, do the system call
	  SIBE%
	ANSKP.
	  RETSKP
	ENDIF.
	RET

; $BIN - Get byte from line
;	CALL $BIN
; Returns +1: Hard failure
;	  +2: Success, with byte in B

$BIN::	SAVEAC <A,C>
	SOSL LINCTR		; anything in line input buffer?
	IFSKP.
	  CALL $SIBE		; any input in buffer for me?
	   SKIPA C,B		; yes, get that many bytes
	    MOVX C,1		; else just get one byte
	  CAILE C,5*LINBSZ	; bounds check
	   MOVX C,5*LINBSZ	; guess we should reassemble!
	  MOVEM C,LINCTR	; note number of bytes this time
	  MOVE A,LINJFN		; line designator
	  MOVE B,[POINT 7,LINBFR]
	  MOVEM B,LINPTR	; re-initialize pointer
	  MOVN C,LINCTR		; number of bytes
	  SIN%			; slurp up the data
	   ERJMP R
	  SOS LINCTR		; count this byte as having been et
	ENDIF.
	ILDB B,LINPTR		; read a single byte
	MOVX A,.PRIOU
	SKIPE DEBUGP
	 BOUT%
	RETSKP

; $BOUT - Send character to line
; Accepts:
;	B/ character
;	CALL $BOUT
; Returns +1: Hard failure
;	  +2: Success

$BOUT::	SAVEAC <A>
	MOVE A,LINJFN		; output string to terminal
	BOUT%
	 ERJMP R
	MOVX A,.PRIOU
	SKIPE DEBUGP
	 BOUT%
	RETSKP

; $SOUT - Send string to line
; Accepts:
;	B/ string to output
;	C/ size of string to output
;	CALL $SOUT
; Returns +1: Hard failure
;	  +2: Success

$SOUT::	SAVEAC <A>
	STKVAR <<ARGS,2>>
	DMOVEM B,ARGS
	MOVX A,.PRIOU
	SKIPE DEBUGP
	 SOUT%
	MOVE A,LINJFN		; output string to terminal
	DMOVE B,ARGS
	SOUT%
	 ERJMP R
	RETSKP

; $BLOCK - Block for a short duration
;	CALL $BLOCK
; Returns +1: Always

$BLOCK::SAVEAC <A>
	MOVX A,^D250		; block for 250ms
	DISMS%
	RET

	SUBTTL Other crud

; Output last JSYS error

FATAL:	EXCH 16,(P)		; save PC for message
	MOVEM 16,PCSAVE
	EXCH 16,(P)
	SAVEAC <A,B,C>
	EMSG <PC >
	MOVX A,.PRIOU
	HRRZ B,PCSAVE
	MOVX C,^D8
	NOUT%
	 ERJMP .+1
	TMSG <: >
	CALL LSTERR
	HALTF%
	RET

LSTERR:	MOVX A,.PRIOU		; output to terminal
	HRLOI B,.FHSLF		; this fork,,last error
	SETZ C,			; no limit
	ERSTR%
	 JRST ERRUND		; undefined error number
	 NOP			; can't happen
	TMSG <
>
	RET

ERRUND:	EMSG <Undefined error >
	MOVX A,.FHSLF		; get error number
	GETER%
	MOVX A,.PRIOU		; output it
	HRRZS B			; only right half where error code is
	MOVX C,^D8		; in octal
	NOUT%
	 ERJMP R		; ignore error here
	TMSG <
>
	RET

	XLIST
	LIT
	LIST

	END EVECL,,EVEC