Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
mm-new/cafard.mac
There is 1 other file named cafard.mac in the archive. Click here to see a list.
TITLE CAFARD Program to exchange mail via TTY line
SUBTTL Written by Mark Crispin/MRC CMIRH 19 July 1984
; Copyright (C) 1984, 1985 Mark Crispin. All rights reserved.
; Version components
CAFWHO==0 ; who last edited Cafard (0=developers)
CAFVER==5 ; Cafard's release version (matches monitor's)
CAFMIN==4 ; Cafard's minor version
CAFEDT==^D43 ; 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
EXTERN $GTLCL,$SPCNS,$SPCSN,$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 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
.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>
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
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,.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.
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.
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