Trailing-Edge
-
PDP-10 Archives
-
BB-5255D-BM
-
4-sources/sndmsg.mac
There are 11 other files named sndmsg.mac in the archive. Click here to see a list.
;<4.ARPA-UTILITIES>SNDMSG.MAC.3, 4-Jan-80 09:48:27, EDIT BY R.ACE
;UPDATE COPYRIGHT DATES
;<4.ARPA-UTILITIES>SNDMSG.MAC.2, 10-Jul-79 05:33:50, EDIT BY R.ACE
;UPDATE COPYRIGHT NOTICE FOR RELEASE 4
;<HACKS>SNDMSG.MAC.4, 1-Jun-78 23:48:06, EDIT BY JBORCHEK
;PUT VERSION NUMBER IN ENTRY VECTOR
;<3.ARPA-UTILITIES>SNDMSG.MAC.4, 14-Nov-77 10:19:35, EDIT BY CROSSLAND
;CORRECT COPYRIGHT NOTICE
;<3.ARPA-UTILITIES>SNDMSG.MAC.3, 26-Oct-77 02:40:01, EDIT BY CROSSLAND
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-UTILITIES>SNDMSG.MAC.2, 30-Sep-77 11:16:54, EDIT BY CROSSLAND
;MAKE WORK WITH MULTIPLE STRUCTURES. MAIL FILES MUST BE ON PS:
;<A-SOURCES>SNDMSG.MAC.8, 30-Dec-76 22:08:55, EDIT BY CROSSLAND
;CONVERT VERSION NUMBER TO DEC STYLE VERSION NUMBER
;<A-UTILITIES>SNDMSG.MAC.7, 3-Dec-76 14:46:27, EDIT BY CLEMENTS
; REMOVE ABILITY TO CALL TECO AS A SUBR UNLESS ASSEMBLED WITH
; TECSUB==1, BECAUSE DEC TECO DOESN'T HAVE THE REQUIRED ENTRY POINT
; CHANGE ALL .SAV TO .EXE
;<A-UTILITIES>SNDMSG.MAC.5, 23-Nov-76 11:57:38, EDIT BY CLEMENTS
; PUT IN 1B9 IN CAPS OF TIMER FORK
; CHANGE NAME OF MAIL FILE TO MAIL.TXT
; ALSO MAIL.CPY
;<2MURPHY>SNDMSG.MAC.10, 10-Sep-76 18:23:35, EDIT BY MURPHY
;CHANGE STENEX TO MONSYM,MACSYM
;<FRENCH>FWDSND.MAC;19 3-Jun-76 11:58:03 EDIT BY FRENCH
;ADDED ALL OF THE FORWARDING STUFF (NOLCL:,FWDIT:,MEDOIT:,ETC)
;<SOURCES>SNDMSG.MAC;41 30-JUN-75 12:30:30 EDIT BY JOHNSON
; Make sure all flags in F are zeroed at start of ADDMSG.
; Thus text will NOT be raised.
;<SOURCES>SNDMSG.MAC;40 17-JUN-75 14:04:36 EDIT BY PLUMMER
; DONT STOP WAKING ON FORMATTING CONTROLS SO ^H STILL WORKS
; ... OLD HEADERS DELETED
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
TITLE SNDMSG
SUBTTL R.S.Tomlinson
SEARCH MONSYM,MACSYM
VWHO==0 ;LAST EDITED BY DEC
VMAJOR==3 ;MAJOR VERSION #
VMINOR==0 ;REVISION #
VEDIT==55 ;EDIT NUMBER
LOC <.JBVER==137>
VERSIO: <VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT ;VERSIONS FOR TYPEOUT
RELOC
SALL
; .DIRECT .FLBLST
.REQUIRE SYS:MACREL
IFNDEF TECSUB,<TECSUB==0>;ONE TO ALLOW TECO TO EDIT MESSAGE BODY -
;BUT DEC TECO DOESN'T HAVE THE RIGHT ENTRY
; POINT TO BE CALLED AS AN INFERIOR
; Accumulators
F=0
A=1
B=2
C=3
D=4
X=5
PTR=6
EPTR=7
Y=10
BPTR=11
FLG=12
SF=15
R=16
P=17
;LINE EDITING CHARACTERS
CDELCH==.CHDEL ;RUBOUT
CDELLN=="U"-100 ;CTRL-U
CRTYPE=="R"-100 ;CTRL-R
;MAPPING PARAMETERS FOR USE OF MAILBOX.EXE
FWDPAG==100 ;PAGE TO BE MAPPED
FWDADR==FWDPAG*1000 ;FIST ADDRESS
; Flags in F
QUIETF==400000
COMMAF==200000
BUFFUL==100000
FRWRDF==40000
QFILEF==20000
EDEOLF==10000
CCUSRF==4000
EOFF==2000
STHSTF==1000
BLANKF==400
NCFRMF==200 ; NEED TO CONFIRM GENERAL DELIVERY
FRSTCH==100 ; FIRST CHARACTER SEEN BY INSTR
AMBIGF==40 ;IN HOST NAME RECOGNIZER
MATCHF==20 ; ..
NUMF==10
RAISEF==4
FULLF==2
USEATF==1
; FLAGS IN FLG
NTLOGF==400000
RVRSF==200000
SUBJF==100000
TEXTF== 40000
WTBSYF==20000
;CHARACTER CODES
CR==15
LF==12
TAB==11
FILCHR=="*" ;CHARACTER TO SIGNAL FILE NAME IN ADDRESS INPUT
; Parameters
NFILS==10 ; Number of input files open at once
NUSRS==500 ; NUMBER OF USERS
NDIST==^D20 ; MAXIMUM NUMBER OF DISTRIBUTION LISTS
NHSTTB==2000 ;SPACE FOR HOST NAME TABLES
PDLL==100 ;LENGTH OF STACK
MAXMSG==^D250000 ; MAXIMUM MESSAGE SIZE
USRDUP==0 ;INDICATES A DUPLICATE USER
USRTO==1 ;INDICATES A "TO" USER
USRCC==2 ;INDICATES A "CC" USER
USRFL==3 ;INDICATES A FILE ADDRESS (NOT USER)
DEFINE FMSG (MSG)<
HRROI B,[ASCIZ \MSG\]
SETZ C,
SOUT>
;MACRO TO SKIP IF CHAR IN AC ARG IS NEITHER "@" NOR, IF NOTLGF IS SET,
; THE CHAR IN SPATCR.
DEFINE SKPNAT (ARG)<
TRNE FLG,NTLOGF ;;IS NTLOGF SET?
CAME ARG,SPATCR ;;YES. IS IT THE SPECIAL CHAR?
CAIN ARG,"@" ;;IS IT "@"
>
;MACRO TO ENCLOSE GROUP OF STATEMENTS SUCH THAT ^O DURING GROUP
; NOT ONLY CLEARS OUTPUT BUFFER, BUT ALSO SKIPS REST OF STATEMENT
; GROUP.
;RESTRICTION: STATEMENT GROUP (STMNTS) CANNOT CONTAIN A NESTED
; "TYPOUT" CALL
DEFINE TYPOUT(STMNTS,%SKPLB)<
MOVEI A,101 ;;EMPTY OUTPUT BUFF 1ST, SO ^O DURING
DOBE ;;PREVIOUS TYPE WON'T GET THIS TOO
MOVEM P,SAVEP2
MOVE R,[XWD 10000,%SKPLB]
MOVEM R,SUPRET ;;SET DEBRK ADDRESS
STMNTS
MOVEI A,101 ;;EMPTY OUTPUT BUFF, SO ^O DURING
DOBE ;THIS WON'T GET NEXT TYPE TOO
%SKPLB: SETZM SUPRET
MOVE P,SAVEP2
>
DEFINE CLSALL<
MOVEI A,400000
CLZFF
>
DEFINE UNMAP<
SETO A,
MOVE B,[400000,,FLAGPG]
PMAP
>
DEFINE UNMAP1<
SETO A,
MOVE B,[400000,,FWDPAG]
PMAP
>
DEFINE KILLML<
MOVE A,FLGMLS
TLNN A,400000 ;MAILBOX.EXE FORK ?
JRST .+8 ;NO
UNMAP1 ;YES, KILL IT ALL
MOVE A,FKMLSV ;FORK HANDLE
KFORK
MOVE A,FLMLSV ;JFN
HRLI A,(1B0)
CLOSF
JFCL
SETZM FLGMLS ;RESET MAILBOX.EXE FLAG
>
ENTVEC: JRST SNDMSG ;NORMAL STARTING ADDRESS
JRST GRIPE
<VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT ;VERSIONS FOR TYPEOUT
REPEAT 0,<JRST TTYTRB>
JRST TPSMSG
JRST ADDMSG
JRST TIPGRP
EVECL==.-ENTVEC
; MAIN ROUTINE FOR SNDMSG
SNDMSG: MOVE P,PDP
MOVE PTR,[POINT 7,STRING-1,34]
SETZ FLG, ;CLEAR FLG
SETOM SPATCR ; SET TO NO SPECIAL AT CHAR.
; JRST TO HERE FROM TPSMSG (WITH NTLOGF SET AND SPATCR SET UP).
SNDMS1: PUSHJ P,INIPSI ; INITIALIZE PSI SYSTEM
PUSHJ P,INITIM ; INITIALIZE TIMER FORK
PUSHJ P,INITTY ; INITIALIZE TTY MODES
PUSHJ P,INILH ; INITIALIZE LOCAL HOST STUFF
SETZM ,FLGMLS ;CLEAR MAILBOX.EXE FLAG
PUSHJ P,GTUSRT ; GET LIST OF "TO" USERS
SKIPGE NUSERS ; IF ANY ENTERED, GET "CC" USERS
PUSHJ P,GTUSRC
PUSHJ P,GETSBJ ; GET SUBJECT
PUSHJ P,GETTXT ; GET TEXT OF MESSAGE
SKIPGE X,NUSERS
JRST DUPCHK
SNDULP: PUSHJ P,GTUSRT ; GET "TO" USERS
SKIPL NUSERS
JRST SNDULP ; IF NONE ENTERED, TRY AGAIN
PUSHJ P,GTUSRC ; "TO" ENTERED - GET "CC" USERS
DUPCHK: MOVE X,NUSERS
MOVE A,[FLAGS,,FLAGS+1] ;ZERO FLAGS
SETZM FLAGS
BLT A,FLAGS+777
DUPLUP: SKIPE HOST(X) ;ONLY CHECK LOCAL ADDRESSES
JRST DUPNXT
MOVX A,RC%EMO ;EXACT MATCH ONLY
MOVE B,USRTAB(X)
RCUSR ;GET DIRECTORY NUMBER FOR LOCAL ADR
ERJMP DUPNXT
TXNE A,RC%NOM!RC%AMB ;DID IT MATCH
JRST DUPNXT ;NO
HRRZ A,C ;DIRECTORY NUMBER
IDIVI A,^D36 ;SET BIT FLAG CORRESPONDING TO DIR #
MOVSI C,400000
MOVN B,B
ROT C,(B)
MOVE B,FLAGS(A)
MOVEI D,USRDUP
TDOE B,C
HRLM D,USRFLG(X) ;FLAG WAS ON -THUS THIS IS A REPEAT
MOVEM B,FLAGS(A)
DUPNXT: AOBJN X,DUPLUP
MOVE X,NUSERS ;SET UP X AGAIN FOR SENDING
TRZ F,QFILEF ;NO MESSAGES TO FILES QUEUED YET
;WAKEUP ON ALL CHARACTERS
MOVEI A,100
RFMOD
TRO B,17B23
SFMOD
;Decide whether queue, send, etc.
QSCMD: MOVE A,DNETTM ;Default is to send, so
MOVEM A,NETTIM ; initialize net and local wait
MOVE A,DLOCTM ; times to default values
MOVEM A,LOCTIM
HRROI A,[ASCIZ /
Q,S,?,carriage-return: /]
PSOUT ;Prompt for command
PUSHJ P,GETCHR ;Get command character
JRST KILCMD ;Rubout, kill command
JRST SEND ;Carriage return, go to sending
CAIN A,"?"
JRST QSHLP
CAIN A,"Q"
JRST QCMD
CAIN A,"S"
JRST SCMD
HRROI A,[ASCIZ /Illegal command, type "?" for help./]
ESOUT ;Illegal command, type error message
JRST QSCMD ; and try again
KILCMD: HRROI A,[ASCIZ /XXX/] ;Type XXX and try again
PSOUT
JRST QSCMD
QSHLP: TYPOUT <
HRROI A,QMSG10
PSOUT > ;Type help message
JRST QSCMD ; and get new command
;Subroutine to get command character. Converts to upper case.
;Ignores carriage-return, space, tab.
;Returns +1 if rubout, +2 if linefeed or eol, +3 otherwise
; with character in 1.
GETCHR: PBIN ;Get character
CAIN A,CR
JRST GETCHR ;Ignore carriage-return
CAIN A,CDELLN
POPJ P, ;Return +1 if rubout
CAIN A,LF
JRST S1POPJ ;Return +2 if lf or eol
CAIN A," "
JRST GETCHR ;Ignore space
CAIN A,TAB
JRST GETCHR ;Ignore tab
CAIL A,140
SUBI A,40 ;Convert lower case to upper
AOS 0(P)
S1POPJ: AOS 0(P)
POPJ P,
QCMD: HRROI A,[ASCIZ /ueue /] ;Handle Q command
PSOUT
SETZ B, ;N not typed
SETZ C, ;L not typed
QLUP: PUSHJ P,GETCHR ;Get command char
JRST KILCMD ;Rubout, kill command
JRST QCR ;Carriage return, finish up
CAIN A,"N"
JRST QN
CAIN A,"L"
JRST QL
HRROI A,[ASCIZ / ?(N,L,or carriage-return) /]
PSOUT ;Ignore illegal command
JRST QLUP
QN: HRROI A,[ASCIZ /et /] ;N typed
PSOUT
SETOB B,NETTIM ;Set net time to -1 (means queue) and
JRST QLUP ; remember (in B) that N was typed.
QL: HRROI A,[ASCIZ /ocal /] ;L typed
PSOUT
SETOB C,LOCTIM ;Set local time to -1 (queue) and
JRST QLUP ; remember (in C) that L was typed
;End of command
QCR: JUMPN B,SEND ;If either L or N specified, go to
JUMPN C,SEND ; sending.
SETOM LOCTIM ;Neither specified - set both
SETOM NETTIM ; to queue
JRST SEND ;Then go to sending
SCMD: HRROI A,[ASCIZ /end /] ;HAndle S command
PSOUT
SETO B, ;N not typed
SETO C, ;L not typed
SETO D, ;W not typed
SLUP: PUSHJ P,GETCHR ;Get command char
JRST KILCMD ;Rubout, kill command
JRST SCR ;Carriage return, finish up
CAIN A,"N"
JRST SN
CAIN A,"L"
JRST SL
CAIN A,"W"
JRST SW
HRROI A,[ASCIZ / ?(N,L,carriage-return, or W) /]
PSOUT ;Ignore illegal command
JRST SLUP
SN: HRROI A,[ASCIZ /et /] ;N typed
PSOUT
MOVE B,DNETTM ;Set net time to default time and
MOVEM B,NETTIM ; remember in B that this was done.
JRST SLUP
SL: HRROI A,[ASCIZ /ocal /] ;L typed
PSOUT
MOVE C,DLOCTM ;Set local time to default time and
MOVEM C,LOCTIM ; remember in C that this was done.
JRST SLUP
SW: HRROI A,[ASCIZ /ait time=/] ;W typed
PSOUT
PUSH P,B ;Preserve B and C
PUSH P,C ;(memory of N and L commands)
MOVEI A,100 ;Read base 10 number from tty.
MOVEI C,^D10
NIN
JRST SWERR ;Error
JUMPLE B,SWERR ;Must be positive
MOVEM B,D ;OK, store wait time in D
BKJFN ;Back up so will process terminator
JFCL
SWPOP: POP P,C ;Restore B and C
POP P,B
JRST SLUP
SWERR: HRROI A,[ASCIZ / ?(must be positive number) /]
PSOUT ;Error, type msg and ignore
JRST SWPOP
;End of command
SCR: JUMPGE B,SCR2 ;If either N or L specified, go on
JUMPGE C,SCR2
MOVE B,DNETTM ;Neither specified, act as if both N and
MOVEM B,NETTIM ; L specified
MOVE C,DLOCTM
MOVEM C,LOCTIM
SCR2: JUMPL D,SEND ;If no wait time given, done
SKIPL B ;If N specifie, store given wait time
MOVEM D,NETTIM ; for net time
SKIPL C ;If L specified, store given wait time
MOVEM D,LOCTIM ; for local time
JRST SEND
; SEND TO ALL USERS
;Set flag telling whether forwarding possible.
SEND: TRO F,FRWRDF
MOVE A,FLGMLS
TLNE A,400000 ;MAILBOX.EXE ALREADY THERE?
JRST SNDLUP ;YEP
MOVE A,[1B2+1B17] ;NO-See if forwarding program exists
HRROI B,[ASCIZ /SYS:MAILBOX.EXE/]
GTJFN
TRZA F,FRWRDF ;No forwarding
RLJFN
JFCL
SNDLUP: MOVE A,USRTAB(X) ;INITIALIZE HOLDU AND HOLDH FOR THIS
MOVEM A,HOLDU ;ADDRESS - USRTAB(X) AND HOST(X)
MOVE A,HOST(X) ;MIGHT CHANGE WITH FORWARDING
MOVEM A,HOLDH
SETZM REPLY
MOVEI A,101
FMSG <
>
PUSHJ P,OUTUSR
HLRZ A,USRFLG(X) ;SKIP USER IF DUPLICATE
CAIN A,USRDUP
JRST SNDDUP
PUSHJ P,MAKHED ; GENERATE HEADING
SKIPE HOST(X) ; LOCAL?
JRST SNDNET ; NO
PUSHJ P,OPNMSG ; OPEN MAIL.TXT
JRST CANT
JRST QUEUE
PUSHJ P,OUTMRK ; OUTPUT DATE AND TIME STAMP
PUSHJ P,OUTMSG ; PUT OUT MESSAGE
CLOSF
JFCL
HRROI B,[ASCIZ / -- ok/]
JRST ENDSND
SNDDUP: HRROI B,[ASCIZ / --already done/]
JRST ENDSND
; Send message via network FTP MAIL facility
SNDNET: SKIPG NETTIM ;IF NETTIM <= 0, JUST QUEUE
JRST QUEUE
TRZ F,NCFRMF
MOVE A,TIMFRK
FFORK
MOVEM P,SAVEP
MOVEI B,TIMER
SFORK
RFORK
PUSHJ P,DOICP
JRST CANT
JRST QUEUE
PUSHJ P,WAITOK
JRST QUEUE
REMAIL: MOVE A,SJFN
HRROI B,[ASCIZ /MAIL /]
SETZ C,
SOUT
MOVE B,USRTAB(X)
SOUT
HRROI B,[ASCIZ /
/]
SOUT
MOVEI B,21
MTOPR
WATMR1: PUSHJ P,WAITOK
JRST WATMRF
CAMN C,GENDLV
JRST [ TRO F,NCFRMF ;SAYS POSSIBLE GENERAL DELIVERY
JRST FOUR50]
CAIN C,^D951 ;WANTS TO FORWARD?
JRST MEDOIT ;WE'LL DO IT HERE INSTEAD!!!
CAME C,GOMAIL
JRST WATMR1
WATMRG: MOVE A,TIMFRK
FFORK
MOVEI B,MONITR
SFORK
RFORK
PUSHJ P,OUTMSG
HRROI B,[ASCIZ /.
/]
SETZ C,
SOUT
MOVEI B,21
MTOPR
MOVE A,TIMFRK
WFORK
FFORK
MOVE A,SJFN
CLOSF
JFCL
MOVE A,RJFN
CLOSF
JFCL
HRROI B,[ASCIZ / -- ok/]
SETZM REPLY
JRST ENDSND
WATMRF: CAIN C,^D450 ;NO SUCH MAILBOX AT THIS SITE
JRST [TRZ F,NCFRMF ;NO GEENERAL DELIVRY
JRST FOUR50]
CAMN C,NEDLOG
JRST MITMUL
FTPERR: HRLZ D,MNQCOD
JUMPGE D,CANT
WATMRL: CAMN C,QCODES(D)
JRST QUEUE
AOBJN D,WATMRL
JRST CANT
MITMUL: HRROI B,[ASCIZ /USER NETML
/]
PUSHJ P,SWTOK ; TRY TO LOGIN
JFCL
CAME C,NEDPAS ; SPECIAL REQUEST FOR PASSWORD
JRST CANT ; WELL... WE TRIED
HRROI B,[ASCIZ /PASS NETML
/]
PUSHJ P,SWTOK
JFCL
CAME C,LOGOK
JRST CANT
JRST REMAIL
; TRY TO QUEUE THE MESSAGE
QUEUE: MOVE A,TIMFRK
FFORK
PUSHJ P,OPNQUE
JRST CANT
PUSHJ P,OUTMSG
MOVE A,SJFN
CLOSF
JFCL
MOVE B,USRTAB(X) ;SET FLAG IF QUEUEING
ILDB A,B
CAIN A,FILCHR
TRO F,QFILEF
PUSHJ P,MLFLG
JRST QUEUE1
HRROI B,[ASCIZ / -- queued/]
JRST ENDSND
QUEUE1: HRROI B,[ASCIZ / -- queued (unable to set flag for immediate processing)/]
JRST ENDSND
;SET MAILER FLAG
MLFLG: MOVE A,[400000,,FLAGPG]
RPACS
TDNE B,[1B5] ;IF PAGE EXISTS
TDNE B,[1B10] ;AND NOT PRIVATE
SKIPA
JRST GOTPAG ;IT IS ALREADY MAPPED
HRROI B,[ASCIZ /<SYSTEM>MAILER.FLAGS.1/]
MOVSI A,(1B2+1B17)
GTJFN
POPJ P,
PUSH P,A
MOVEI B,1B19+1B20+1B25
OPENF
JRST [ POP P,A
RLJFN
JFCL
POPJ P,]
POP P,A
HRLZS A
MOVE B,[400000,,FLAGPG]
MOVSI C,140000
PMAP
GOTPAG: GJINF
HRRZ C,A ;QUEUE IN LOGIN DIRECTORY
TRNE FLG,NTLOGF ;IF NOT LOGGED IN,
HRRZ C,B ; QUEUE IN CONNECTED DIRECTORY
;NOTE THIS ASSUMES IT IS ON STRUCTURE PS:
IDIVI C,44
MOVSI A,400000
MOVN D,C+1
ROT A,(D)
IORM A,FLAGPG*1000(C)
AOS 0(P)
POPJ P,
; DONT SEND
DONT: HRROI B,[ASCIZ / -- didn't/]
JRST ENDSND
; CAN'T SEND MESSAGE
CANT: MOVE A,TIMFRK
FFORK
TRNE FLG,NTLOGF
JRST CANT2
PUSHJ P,OPNUND
JRST CANT2
PUSHJ P,OUTMSG
MOVE A,SJFN
CLOSF
JFCL
CANT2: HRROI B,[ASCIZ / -- can't/]
ENDSND: TRZ F,NCFRMF ;CLEAR GENERAL DELIV. IF ON
MOVEI A,101
SETZ C,
SOUT
HRROI B,[ASCIZ / --/]
SETZ C,
SKIPE REPLY
SOUT
HRROI B,REPLY
SOUT
MOVE A,[400000,400000] ;DON'T KILL MAILBOX.EXE
CLZFF
MOVE A,HOLDU ;RESTORE ORIGINAL CONTENTS INCASE WE
MOVEM A,USRTAB(X) ;FORWARDED - THIS KEEPS ALL ADDRESSES
MOVE A,HOLDH ;CONSISTENT IN ALL MESSAGES EVEN IF MAIL
MOVEM A,HOST(X) ;DIDN'T ACTUALLY GO THERE.
AOBJN X,SNDLUP
KILLML ;WON'T NEED MAILBOX.EXE ANYMORE
;MESSAGE IF ANY MSGS QUEUED TO FILES
HRROI A,[ASCIZ /
*RUN MAILER TO DELIVER MESSAGES QUEUED FOR * FILES.
*THEY WILL NOT BE DELIVERED AUTOMATICALLY.
/]
TRNE F,QFILEF
PSOUT
IFDEF UTAHSW,<
;KEEPS A COPY OF ALL MESSAGES SENT TO SAVED.MESSAGES IF IT EXISTS
PUSHJ P,OPNSVD ;OPEN SAVED.MESSAGES
JRST ENDS.1 ;SAVED.MESSAGES DOES NOT EXIST
PUSHJ P,MAKHED ;MAKE MESSAGE HEADING ("TO" INSTEAD OF "CC")
PUSHJ P,OUTMRK ;OUTPUT DATE AND SIZE STAMP
PUSHJ P,OUTMSG ;OUTPUT THE MESSAGE
CLOSF ;CLOSE SAVED.MESSAGES
JFCL
ENDS.1:
>
UNMAP
CLSALL
HALTF
JRST SNDMSG
; MAIN GRIPE CODE
GRIPE: MOVE P,PDP
MOVE PTR,[POINT 7,STRING-1,34]
RESET
SETZ FLG, ;CLEAR FLG
SETOM SPATCR ; SET TO NO SPECIAL AT CHAR.
PUSHJ P,INIPSI
PUSHJ P,INITTY
GRIPE1: HRROI A,[ASCIZ /
Griping on subject of /]
PSOUT
MOVEI A,[XWD 501000,1
XWD 100,101
0
IFDEF UTAHSW,<POINT 7,[ASCIZ /HELP/]> ;UTAH DIR. FOR
;GRIPE FILES
IFNDEF UTAHSW,<POINT 7,[ASCIZ /SYSTEM/]>
POINT 7,[ASCIZ /GENERAL/]
POINT 7,[ASCIZ /GRIPES/]
0
0
0
0]
SETZ B,
GTJFN
JRST [ HRROI A,[ASCIZ /
No gripe file for that subject, use subsys name or "general"
/]
PSOUT
JRST GRIPE1]
MOVEM A,SJFN
PUSHJ P,GETTXT
TRZ F,USEATF ;MAKIHD-DONT INCLUDE SITE IN "FROM"
PUSHJ P,MAKIHD
PUSHJ P,MAKEHD
MOVE A,SJFN
MOVE B,[7B5+1B22]
OPENF
JRST [ HRROI A,[ASCIZ /
Can't open that file. Message saved on MAIL.CPY/]
PSOUT
CLSALL
HALTF
JRST GRIPE]
PUSHJ P,OUTMRK
PUSHJ P,OUTMSG
MOVE A,SJFN
CLOSF
JFCL
HRROI A,[ASCIZ /
Thank you for your constructive criticism./]
PSOUT
CLSALL
HALTF
JRST GRIPE
; MAIN CODE FOR GRIPE FOR NON-LOGGED USERS (I.E.TIP USERS)
; SITE NUMBER IN AC1
; USER NAME IN AC10-14 (UP TO 24 CHARS)
TIPGRP: MOVE P,PDP
MOVE PTR,[POINT 7,STRING-1,34]
PUSHJ P,TIPUSE
SETZM SPATCR
RESET
PUSHJ P,INITTY
SETZM HOSTN ;SET TO NO HOST TABLES
SETZM HSTNAM ;FOR USE BY MAKIHD IN "FROM.."
HRROI A,QMSG6
PSOUT
SETZ X,
MOVE B,[POINT 7,[ASCIZ /NCC/]]
MOVEM B,USRTAB(X)
MOVE B,[POINT 7,[ASCIZ /BBN/]]
MOVEM B,HOST(X)
PUSHJ P,OPNQUE
JRST [HRROI A,[ASCIZ/
CAN'T GET GRIPE FILE.
PLEASE TRY AGAIN LATER.
/]
PSOUT
HALTF
JRST TIPGRP]
PUSHJ P,GETSBJ
PUSHJ P,GETTXT
TRO F,USEATF ;SET FLAG SO MAKIHD WILL
PUSHJ P,MAKIHD ;INCLUDE SITE IN "FROM.."
PUSHJ P,MAKHSB
PUSHJ P,MAKEHD
PUSHJ P,OUTMSG
MOVE A,SJFN
CLOSF
JFCL
PUSHJ P,MLFLG ;SET MAILER FLAGS
JFCL ;IGNORE FAILURE TO SET FLAGS
UNMAP
HRROI A,[ASCIZ /
Thank you for your constructive criticism.
/]
PSOUT
CLSALL
HALTF
JRST TIPGRP
; DO TTY TROUBLE REPORT
TTYTRB: MOVE P,PDP
MOVE PTR,[POINT 7,STRING-1,34]
RESET
SETZ FLG, ;CLEAR FLG
SETOM SPATCR ; SET TO NO SPECIAL AT CHAR.
PUSHJ P,INIPSI
PUSHJ P,INITTY
SETZ X,
MOVE B,[POINT 7,TTYMAN]
MOVEM B,USRTAB(X)
SETZM HOST(X)
PUSHJ P,OPNQUE
JRST [ HRROI A,[ASCIZ /
TROUBLE FILE NOT AVAILABLE - PLEASE TRY AGAIN LATER/]
ESOUT
HALTF
JRST TTYTRB]
IFDEF UTAHSW,< HRROI A,[ASCIZ /
LOCATION OF TERMINAL & TERMINAL SERIAL # : /]
>
IFNDEF UTAHSW,< HRROI A,[ASCIZ /
LOCATION OF TERMINAL: /]
>
MOVEM A,PROMPT
PUSHJ P,GETSB
HRROI A,[ASCIZ /
DESCRIBE TROUBLE: /]
MOVEM A,PROMPT
PUSHJ P,GETTX1
TRZ F,USEATF ;MAKIHD-DONT INCLUDE SITE IN "FROM"
PUSHJ P,MAKIHD
SETZ C,
HRROI B,[ASCIZ /
LOC'N:/]
SOUT
SKIPN B,SUBJCT
HRROI B,[ASCIZ /NOT STATED/]
SOUT
PUSHJ P,MAKEHD
PUSHJ P,OUTMSG
MOVE A,SJFN
CLOSF
JFCL
PUSHJ P,MLFLG
JFCL
UNMAP
HRROI A,[ASCIZ /
THANK YOU FOR REPORTING YOUR DIFFICULTY.
IT WILL BE INVESTIGATED SHORTLY.
/]
PSOUT
HRROI A,[ASCIZ /(Message has been queued for delivery to /]
PSOUT
HRROI A,TTYMAN
PSOUT
HRROI A,[ASCIZ /)
/]
PSOUT
CLSALL
HALTF
JRST TTYTRB
; NAME OF TTY REPAIR MAN
IFDEF UTAHSW,<
TTYMAN: ASCIZ /JENSEN/ ;UTAH TTY REPAIR MAN
>
IFNDEF UTAHSW,<
TTYMAN: ASCIZ /PAIGE/
>
; MAIN CODE FOR SNDMSG FOR NON-LOGGED USERS (IE TIP USERS)
; Site number in AC1
; User name in AC10-AC14 (up to 24 chars)
TPSMSG: MOVE P,PDP
MOVE PTR,[POINT 7,STRING-1,34]
PUSHJ P,TIPUSE
MOVEI A,"%" ;USE % AS SPECIAL AT CHAR
MOVEM A,SPATCR
HRROI A,QMSG5
PSOUT ; GIVE SPECIAL MESSAGE.
HRROI A,QMSG6
PSOUT
JRST SNDMS1 ;CONTINUE AS FOR REGULAR ENTRANCE.
TIPUSE: MOVEM A,SITEN ;SITE ADDR OF USER IN AC 1
MOVEM PTR,FROMNM ;get user name.
MOVE A,PTR
MOVE B,[POINT 7,10]
SETZ C,
SOUT
MOVE PTR,A ;PUT NEW PTR BACK
IDPB C,PTR ;AND PUT IN ZERO BYTE.
PUSHJ P,GETSIT ; GET SITE NAME
MOVEI FLG,NTLOGF ;SET TO "NOT-LOGGED"
POPJ P,
;GET SITE NAME
GETSIT: MOVE A,PTR
MOVEM A,SITE
MOVE B,SITEN
MOVEI C,10
CVHST
NOUT ;USE NUMBER IF NAME NOT KNOWN
JFCL
MOVEM A,PTR
IBP PTR
POPJ P,
; ADD A MESSAGE TO A GIVEN FILE.
; AC1 - OUTPUT JFN (OF MESSAGE FILE).
; AC2 - B(0)=1 => ADD MESSAGE AT FRONT OF FILE.
; - B(1)=1 => SUBJECT IN AC7-AC16 (UP TO 39 CHARS)
; - B(2)=1 => TEXT ON FILE - SEE AC3
; - B(3)=1 => WAIT IF OUTPUT FILE BUSY
;AC3 - INPUT JFN OF TEXT IF B(2) IN AC2 SET
; ON SUCCESS HALTS WITH JFN IN AC1 (CLOSED BUT NOT RELEASED).
; ON FAILURE, HALTS WITH AC1 NOT CONTAINING JFN.
ADDMSG: MOVEM SAVACS ;SAVE AC0
MOVE [XWD 1,SAVACS+1] ;SAVE AC1-AC17
BLT SAVACS+17
MOVE P,PDP
MOVE PTR,[POINT 7,STRING-1,34]
MOVEM A,SJFN ;SAVE OUTPUT JFN.
SETZB FLG,F ; Zero all AC flags.
TLNE B,400000 ;SKIP IF NORMAL OUTPUT.
TRO FLG,RVRSF ;OUTPUT AT FRONT OF FILE.
TLNE B,40000
TRO FLG,WTBSYF
TLNE B,200000 ;SUBJECT PASSED?
JRST [TRO FLG,SUBJF ;SET FLAG
MOVEM PTR,SUBJCT ;STORE SUBJECT
MOVE A,PTR ;COPY IT FROM SAVED AC'S
MOVE B,[POINT 7,SAVACS+7]
SETZ C,
SOUT
CAMN PTR,A ;INDICATE NULL SUBJECT
SETZM SUBJCT
MOVE PTR,A
IDPB C,PTR
JRST .+1]
MOVE B,SAVACS+2 ;GET PASSED FLAGS
TLNE B,100000 ;TEXT PASSED?
JRST [ TRO FLG,TEXTF ;SET FLAG
MOVEM PTR,MSG ;STORE TEXT
MOVE A,SAVACS+3 ;JFN
MOVE B,[7B5+1B19] ;READ
OPENF
JRST [ SETO A, ;OPENF SHOULDN'T FAIL
JRST ADDHLT ]
MOVE B,PTR ;PLACE TO COPY TO
SETZ C,
SIN
MOVE PTR,B
IDPB C,PTR
HRLI A,(1B0) ;DON'T RELEASE JFN
CLOSF ;CLOSE INPUT FILE
JFCL
PUSHJ P,GTXTE
JRST .+1 ]
SETOM SPATCR ; SET TO NO SPECIAL AT CHAR.
TRNE FLG,SUBJF
TRNN FLG,TEXTF
PUSHJ P,INIPSI
PUSHJ P,INITTY ;INITIALIZE TTY PARAMS.
TRNN FLG,SUBJF ;SKIP SUBJECT IF GIVEN ALREADY
PUSHJ P,GETSBJ ;GET SUBJECT.
TRNN FLG,TEXTF ;SKIP TEXT IF GIVEN ALREADY
PUSHJ P,GETTXT ;GET MESSAGE TEXT.
TRZ F,USEATF ;MAKIHD-DONT INCLUDE SITE IN "FROM"
PUSHJ P,MAKIHD ;INITIAL PART OF HEADING.
PUSHJ P,MAKHSB ;SUBJECT.
PUSHJ P,MAKEHD ;END OF HEADING.
MOVE A,SJFN
MOVE B,[7B5+1B22]
TRNE FLG,RVRSF
MOVE B,[7B5+1B19+1B20+1B26] ;R W AND WAIT IF BUSY.
TRNE FLG,WTBSYF
OR B,[1B26]
OPENF
JRST [ SETZ B,
PUSHJ P,ERRPLY
HRROI A,REPLY
PSOUT
HRROI A,[ASCIZ /
CAN'T OPEN THAT FILE. MESSAGE SAVED ON MAIL.CPY./]
PSOUT
SETO A, ; MARK FAILURE.
JRST ADDHLT ]
TRNN FLG,RVRSF
JRST ADDMS1 ;APPEND MESSAGE.
MOVEM PTR,ENDPTR ;ADD MESSAGE AT BEGINNING.
MOVE A,SJFN
MOVE B,ENDPTR
MOVNI C,300000
SIN ;READ WHAT IS THERE ALREADY.
MOVEM C,OLDCNT ;SAVE COUNT.
SETZ B,0
SFPTR ;BACK TO START.
JFCL
ADDMS1: PUSHJ P,OUTMRK ;OUTPUT TIME STAMP.
PUSHJ P,OUTMSG ;OUTPUT MESSAGE.
MOVE A,SJFN
TRNN FLG,RVRSF
JRST ADDMS2 ;JUST CLOSE IT.
MOVE B,ENDPTR ;FIRST WRITE OLD CONTENTS.
MOVNI C,300000
SUB C,OLDCNT ;GET NEGATIVE BYTE COUNT.
SOUT
ADDMS2: HRLI A,(1B0) ; DO NOT RELEASE JFN.
CLOSF
JFCL
MOVE A,SJFN ; SUCCESS.
ADDHLT: PUSH P,A
CLSALL
POP P,A
HALTF
JRST .-1
; USER NAME INSTRUCTIONS
QMSG1: ASCIZ /
Type user names of the form <user name>@<host name>. Separate names
with comma, end with carriage return. Typing just @<host name>
causes that host to apply to subsequent users. Typing @<null string>
refers to the local host. Each user's message will indicate to whom
else the message was sent unless a named distribution list is
stated by using <distribution name>:. E.g. TENEX-users:Tomlinson,... .
If one or more distribution list names are specified, they are used
in place of the user names. Control-B (STX) may be used to substitute
the contents of a file for typed input.
/
; MESSAGE TYPING INSTRUCTIONS
QMSG2: ASCIZ /
Your message should be typed in and be terminated with control-Z (SUB).
/
QMSG7: ASCIZ /
A copy of the text of the message will be saved on the file
MAIL.CPY.nnn;S if you need to send it again.
/
QMSG3: ASCIZ /
Use the following control characters to edit:
RUBOUT character delete
B (STX) inserts the following file
U (DC1) line delete
R (DC2) retype current line or item
S (DC3) retypes entire text or all items
W (ETB) deletes last word
X (CAN) cancels entire item (start over) - ignored during text input
Z (SUB) terminates input
/
; Subject instructions
QMSG4: ASCIZ /
The subject should be a one line summary of the message or a null string
ended with carriage return.
/
QMSG5: ASCIZ /
In the following % may be used instead of @ wherever necessary.
/
QMSG6: ASCIZ /
^C (Control C) may be used to abort a message.
/
QMSG8: ASCIZ /
^O (CONTROL O) WILL SUPPRESS TYPEOUT.
/
QMSG9: ASCIZ \
Choices are:
F-You will be asked to type a file name and to confirm it. The file
will be appended to the text you have entered so far. You then
continue normal text input.
T-Your text as entered so far will be read into TECO and you can
proceed to edit it. You need not give any I/O commands in TECO.
When you exit TECO (with ";H"), your edited text replaces your
original text in SNDMSG. You then continue normal text input.
The original (unedited) text is saved on MAIL.CPY.nnn;S.
\
QMSG10: ASCIZ /
The command you give will cause SNDMSG either to try to send the
message immediately or to queue it for later delivery (automatic
delivery by the system MAILER).
Carriage-return terminates the command line.
Rubout aborts the command line.
Basic commands:
null - i.e. nothing but carriage return - SNDMSG will do whatever
the default is, currently to send the mail if possible.
Q - (queue) - The mail will be queued for all addresses except
files addressed with "*".
S - (send) - The mail will be sent (this is currently the default).
Basic Optional Command Arguments
S and Q may be followed (on the same line) by:
N - (net) - the command applies only to network (non-local) addresses.
L - (local) - the command applies only to local addresses.
Other Optional Command Arguments
S may also be followed (on the same line) by:
W - (wait) - to tell SNDMSG how long to wait to be able to send
the message. You will be asked to enter a (positive) number of
seconds. SNDMSG will wait that long for: (a) a busy local mailbox
to become free (default is to not wait at all); (b) a network
host to give permission to transmit the message (default is
30 seconds). Note that if N or L also appears in the S
command the effect of the W is restricted to net or local mail.
/
; INTERRUPT STUFF
LEVTAB: RETPC1
RETPC1
RETPC1
CHNTAB: XWD 1,TIMOUT
XWD 1,SUPOUT
XWD 1,MONERR
REPEAT ^D33,<0>
TIMOUT: MOVE A,[POINT 7,REPLY]
HRROI B,[ASCIZ /timed-out/]
SETZ C,
SOUT
MOVE P,[XWD 10000,QUEUE]
MOVEM P,RETPC1
MOVE P,SAVEP
DEBRK
TIMER: MOVE A,NETTIM
IMULI A,^D1000
DISMS
MOVEI A,777777
MOVSI B,(1B0)
IIC
HALTF
MONITR: MOVEI P,PDL2-1
PUSHJ P,WAITOK
JRST MONITF
CAIE C,^D256
JRST MONITR
HALTF
MONITF: MOVEI A,777777
MOVSI B,(1B2)
IIC
WAIT
MONERR: MOVE A,TIMFRK
FFORK
MOVEI B,SAVACS
RFACS
MOVE C,SAVACS+3
MOVE P,[XWD 10000,FTPERR]
MOVEM P,RETPC1
MOVE P,SAVEP
DEBRK
;HANDLE ^O INTERRUPT - SUPPRESS TTY OUTPUT
SUPOUT: PUSH P,A ;SAVE A,B
PUSH P,B
MOVEI A,101 ;IF OUTPUT BUFFER EMPTY, DO NOTHING
SOBE
SKIPA
JRST SUPDON
MOVEI A,101 ;CLEAR PRIMARY OUTPUT BUFFER
CFOBF
MOVEI A,17 ;TYPE ^O(EOL)
PBOUT
MOVEI A,.CHLFD
PBOUT
SUPDON: SKIPN SUPRET ;SPECIAL DEBREAK ADDRESS?
JRST SUPEND ;NO, JUST DISMISS
MOVE R,SUPRET ;YES, CLOBBER IT INTO RETURN PC
MOVEM R,RETPC1
SUPEND: POP P,B ;RESTORE A,B
POP P,A
DEBRK ;DISMISS INTERRUPT
; INITIALIZE PSI SYSTEM
INIPSI: RESET ; RESET THE WORLD
MOVEI A,400000 ; INITIALIZE INTERRUPT SYSTEM
MOVE B,[XWD LEVTAB,CHNTAB]
SIR
EIR
MOVSI B,(1B0+1B1+1B2)
AIC ; TURN ON CHANNELS 0&1&2
MOVE A,[XWD 17,1]
TRNN FLG,NTLOGF ;IF LOGGED-IN USER,
ATI ;ASSIGN ^O TO CHANNEL 1
SETZM SUPRET
POPJ P,
; INITIALIZE TIMER FORK
INITIM: MOVSI A,(1B0+1B1)
CFORK ; GET A FORK TO DO TIMING
HALTF
MOVEM A,TIMFRK ; REMEMBER FORK HANDLE
RPCAP ; MAKE IT ABLE TO INTERRUPT ME
TLO C,(1B9)
TLO B,(1B9)
EPCAP
POPJ P,
; INITIALIZE TTY STUFF
INITTY: MOVEI A,100 ; PRIMARY INPUT
MOVEM A,INFIL ; IS INITIAL INPUT FILE
MOVEI A,101 ;PRIMARY OUTPU
MOVE B,[BYTE (2) 1,0,0,1,1,1,1,2,0,3,3,3,3,3,1,1,1,0]
MOVE C,[BYTE (2) 0,0,1,1,1,0,0,1,1,0,1,1,1,3]
SFCOC ; NO ECHO ON CONTROL-A,B,H,Q,R,S,W,X ALT
TRZ F,QUIETF ; TURN ON RESPONSES
MOVE SF,[XWD -NFILS,FILSTK-1] ; INIT FILE STACK
POPJ P,
; INITIALIZE LOCAL HOST THINGS
INILH: MOVE A,[SIXBIT /LHOSTN/]
SYSGT ; GET LOCAL HOST NUMBER
JUMPGE B,[SETOM LHOSTN ;NO NET
POPJ P,]
MOVEM A,LHOSTN
MOVE A,PTR
MOVEM A,LHOST ; GET STRING FOR LOCAL HOST
MOVE B,LHOSTN ; NUMBER
MOVEI C,10
CVHST ; CONVERT TO STRING
NOUT ; IF FAILS, USE NUMERIC HOST
JFCL
MOVEM A,PTR ; REST OF STRINGS GO AFTER THIS
IBP PTR ; SKIP OVER NULL
MOVEI A,HSTTAB ;INITIAL FREE SPACE POINTER
MOVEM A,HSTFRE ; ..
MOVE A,['HOSTN ']
MOVEI B,HOSTN
PUSHJ P,SYSGET ;GET THE NUMBERS OF ALL HOSTS
MOVE A,['HSTNAM'] ;AND THE NAMES IN ASCIZ
MOVEI B,HSTNAM
PUSHJ P,SYSGET
POPJ P,
; GET USER LIST
GTUSRT: MOVSI A,-NDIST
MOVEM A,XDIST ; POINTER FOR STORING DISTRIBUTION NAMES
MOVSI X,-NUSRS ; ALLOW ONLY NUSRS USERS
HRROI A,[ASCIZ /
To (? for help): /]
MOVEI B,USRTO
JRST GETUSR
GTUSRC: HRROI A,[ASCIZ /
cc (? for help): /]
MOVEI B,USRCC
GETUSR: MOVEM A,PROMPT
MOVEM B,USRCAT
MOVEM X,BX
MOVE A,XDIST
MOVEM A,BXDIST
GETUS: MOVE A,PROMPT
PSOUT ; PROMPT
MOVE X,BX
MOVE A,BXDIST
MOVEM A,XDIST
SETZM DEFHST
SETZM DEFGRP
TRO F,FULLF ; BREAK ON PUNCT
TRO F,BLANKF ;IGNORE LEADING AND TRAILING BLANKS
MOVEM PTR,BPTR
RULUP: MOVEM PTR,USRTAB(X) ; SAVE BEGINNING OF STRING
MOVE A,DEFGRP ;GROUP IN RIGHT HALF
HRL A,USRCAT ; USER CATEGORY IN LEFT HALF
MOVEM A,USRFLG(X)
TRZ F,STHSTF
PUSHJ P,INSTR ; GET USER/HOST NAME
GETUS0: JRST [ MOVE PTR,BPTR
JRST GETUS]
RULUP1: CAIN A,"?" ; TERMINATOR = ??
JRST USRHLP ; YES, PRINT INSTRUCTIONS
CAIN A,":" ; DISTRIBUTION LIST?
JRST USRGRP
CAIN A,CDELLN ; ABORTED?
RUBOUT: JRST [ HRROI A,[ASCIZ /XXX /]
JRST UFLUSH] ; FLUSH USER
CAIN A,0
JRST [ CAMN EPTR,PTR
JRST USRMOR
MOVEI A,.CHLFD
JRST .+1 ]
SKPNAT A ; @ TERMINATOR?
JRST [ CAMN EPTR,PTR ;NULL STRING?
TRO F,STHSTF ;YES, READ STRING AS PERMANENT HOST
JRST RUL6 ] ; READ FOREIGN SITE NAME
CAIE A,.CHLFD
CAIN A,","
JRST [ CAME PTR,EPTR
JRST RUL1
IDPB A,EPTR
MOVEM EPTR,PTR
JRST RUL4 ]
CAIN A,"B"-100 ;^B - GET NEW FILE AND CONTINUE
JRST [ PUSHJ P,NEWFIL
JRST USRMOR ]
CAIN A,FILCHR
JRST USRFIL
CAIE A,33
JRST UBDTRM
CAMN PTR,EPTR
JRST USRAMB
SETZ A, ;PREFORM RECOGNITION
MOVE B,USRTAB(X) ;GET BACK TO BEGINNING OF STRING
RCUSR
ERJMP .+2
TXNE A,RC%NOM ;NO MATCH
JRST [SKIPE DEFHST ; IF WE ARE TALKING ABOUT ANOTHER HOST
JRST USRAMB ; JUST CALL IT AMBIGUOUS
HRROI A,[ASCIZ / No such local user - Recognition on local users only /]
JRST BADUS1] ; IF THIS HOST, CALL IT BAD
TXNE A,RC%AMB ;WAS IT AMBIGUOUS
JRST USRAMB
MOVE A,EPTR ; POINTER TO TAIL
MOVEM B,EPTR ; PASS OVER TAIL
PUSHJ P,UTAIL ; PRINT TAIL
USRMOR: PUSHJ P,INSTRC ;GET MORE INPUT
JRST GETUS0
JRST RULUP1
USRAMB: MOVEI A,7
PBOUT
JRST USRMOR
UFLUSH: PSOUT ;TYPE MSG FROM A
MOVE PTR,USRTAB(X) ;BACK UP POINTER
JRST RULUP ;LOOP FOR ANOTHER USER
;TYPE INSTRUCTIONS IN RESPONSE TO "?"
USRHLP: TYPOUT <
HRROI A,QMSG1
PSOUT
HRROI A,QMSG3
PSOUT
HRROI A,QMSG8 ;TYPE ^O MESSAGE
TRNN FLG,NTLOGF ;IF APPROPRIATE
PSOUT >
JRST USRTYP ; AND DO IT AGAIN
USRGRP: SKIPL B,XDIST
JRST [ HRROI A,[ASCIZ / Too many group names /]
JRST BADUS1 ]
SETZM DEFGRP
CAMN PTR,EPTR
JRST UGRP2
MOVE C,USRTAB(X)
MOVEM C,DIST(B)
HRLZ C,USRCAT ;USER CATEGORY IN LEFT HALF
MOVEM C,DSTFLG(B)
ADD B,[1,,1]
MOVEM B,XDIST
HRRZM B,DEFGRP
UGRP2: IDPB A,EPTR ; KEEP TERMINATOR
MOVE PTR,EPTR
JRST RULUP
RUL1: MOVE B,DEFHST
MOVEM B,HOST(X) ; REMEMBER DEFAULT
SKIPE DEFHST
JRST RUL63 ; SKIP CHECK IF OTHER HOST
MOVE B,USRTAB(X)
MOVEM A,SAVTER ; SAVE CHARACTER.
MOVX A,RC%EMO ;EXACT MATCH ONLY
RCUSR
ERJMP NOLCL
TXNE A,RC%NOM ;NO MATCH
JRST NOLCL ;NOT A LOCAL USER
TXNE A,RC%AMB ;AMBIGUOUS
JRST [HRROI A,[ASCIZ / Ambiguous local user /]
JRST BADUS1]
MOVE A,SAVTER ; RESTORE CHARACTER.
RUL63: IDPB A,EPTR ; STORE THE TERMINATOR FOR RETYPE
MOVEM EPTR,PTR ; KEEP THE STRING
CAIE A,","
CAIN A,.CHLFD
SKIPA
UBDTRM: JRST [ HRROI A,[ASCIZ / Bad terminator /]
JRST BADUS1 ]
TRZE F,STHSTF
JRST [ MOVE B,HOST(X) ;STORE HOST AS DEFAULT
MOVEM B,DEFHST
JRST RUL4 ] ;RE-USE SAME SLOT
AOBJP X,RUL3
RUL4: CAIN A,","
JRST RULUP ;COMMAS - CONTINUE GETTING USERS
USREOL: MOVE A,INFIL ;EOL
CAIE A,100 ;FROM PRIMARY INPUT?
JRST RULUP ;NO, DON'T TERMINATE USER LIST
MOVE A,EPTR ;DON'T TERMINATE IF EOL PRECEDED BY COMMA
BKJFN ;BACK UP
JFCL
CAMN A,BPTR ;IF NO PREVIOUS CHARS, EOL TERMINATES
JRST RUL3
LDB B,A ;GET PREVIOUS CHAR
CAIN B,","
JRST RULUP ;COMMA PRECEDED EOL
RUL3: HLRE A,X
ADDI A,NUSRS
MOVNS A
HRLZM A,NUSERS
HLRE A,XDIST
ADDI A,NDIST
MOVNS A
HRLZM A,DISTL
SETZ C,
MOVE A,BPTR
DPNULL: ILDB B,A
SKPNAT B
DPB C,A
CAIN B,","
DPB C,A
CAIE B,12
CAIN B,15
DPB C,A
CAIN B,":"
DPB C,A
JUMPN B,DPNULL
POPJ P,
RUL6: IDPB A,EPTR ; STORE THE TERMINATOR FOR RETYPE
MOVEM EPTR,PTR ; KEEP THE STRING
PUSHJ P,GETHST ; GET HOST NAME
JRST GETUS0 ; ABORT ALL
JRST RUBOUT ; FLUSH WHOLE USER SPEC
JRST BADUS1 ; FAILURE
MOVEM B,HOST(X) ; SAVE HOST
JRST RUL63
GETHST: PUSHJ P,INSTR ; GET STRING
POPJ P, ; GET OUT
SKIPN A ;REPLACE NULL (EOF)
MOVEI A,.CHLFD ; BY EOL
CAIN A,CDELLN ;LINE DELETE?
JRST SKPRET
CAMN EPTR,PTR
JRST [ CAIN A,33
JRST AMB33
SETZ B, ; NULL STRING, USE LOCAL
JRST SK3RET]
PUSH P,A ; SAVE TERMINATOR
MOVE A,PTR ; WHERE TO WRITE RECOGNIZED STRING
MOVE B,A ; IS ALSO SOURCE
SETZ C,
PUSHJ P,HSTSOU ; PERFORM RECOGNITION
TRNE F,AMBIGF ; AMBIGUOUS?
JRST HSTAMB
TRNN F,MATCHF ; Match found?
JRST NOMTCH
GOTHST: MOVE B,EPTR ; Save where tail starts
MOVEM A,EPTR ; Update EPTR
POP P,A ; Get terminator
CAIE A,33 ; ALTMODE?
JRST GETHS1
MOVE A,B ;START OF TAIL
PUSHJ P,UTAIL ;PRINT TAIL
HSTMOR: PUSHJ P,INSTRC ;GET MORE INPUT
JRST GETHST+1
JRST GETHST+2
GETHS1: MOVE B,PTR
SK3RET: AOS 0(P)
SK2RET: AOS 0(P)
SKPRET: AOS 0(P)
CPOPJ: POPJ P,
HSTAMB: POP P,A ; GET TERMINATOR
CAIN A,33 ; ALTMODE?
AMB33: JRST [ MOVEI A,7
PBOUT ; DING
JRST HSTMOR ]
HRROI A,[ASCIZ / Ambiguous host name /]
JRST SK2RET
NOMTCH: PUSH P,A ; SAVE POINTER TO END OF HOST NAME
MOVE A,PTR ; POINTER TO START OF HOST NAME
MOVEI C,10
NIN ;TRY INTERPRET NAME AS OCTAL NUMBER
JRST HSTBAD ;CAN'T READ AS NUMBER
LDB C,A ; ALSO BAD IF NUMBER ENDED BY NON-NULL
JUMPN C,HSTBAD
CAILE B,377 ;HOST NUMBERS MUST BE LESS THAN 400
JRST HSTBAD
POP P,A ; RESTORE A
MOVE B,0(P) ;TERMINATING CHARACTER
CAIE B,33 ;IF NOT ALTMODE, NUMBER OK
JRST GOTHST
HRROI A,[ASCIZ /[Can't complete host numbers]/]
PSOUT
POP P,A ;POP OFF TERMINATING CHAR
JRST HSTMOR ;CONTINUE INPUT
HSTBAD: POP P,A ;RESTORE A
HRROI A,[ASCIZ / No such host /]
SUB P,[1,,1]
JRST SK2RET
BADUSR: HRROI A,[ASCIZ / /]
BADUS1: ESOUT
MOVE A,INFIL
CAIE A,100
JRST [ SETZ C,
IDPB C,EPTR
MOVE A,PTR
PSOUT
HRROI A,[ASCIZ / -FILE INPUT ABORTED.../]
PSOUT
MOVE A,INFIL
PUSHJ P,ENDFIL
JRST .+1]
MOVE PTR,USRTAB(X)
SETZ C,
MOVE A,PTR
IDPB C,A
USRTYP: MOVE B,PROMPT
MOVE C,BPTR
PUSHJ P,RETYPE
JRST RULUP
;PRINT TAIL ADDED ON BY COMPLETION OF USER OR HOST DUE TO ESC
UTAIL: CAMN A,EPTR ;A IS TAIL START, EPTR IS END
HRROI A,[ASCIZ /[Name already complete]/] ;NO TAIL TO TYPE
PSOUT
POPJ P,
;HERE IF FIRST CHAR IN USER NAME IS FILCHR - GET A FILE NAME
USRFIL: TRNE FLG,NTLOGF
JRST [HRROI A,[ASCIZ /Non-logged-in users can't send to files/]
JRST BADUS1]
IDPB A,EPTR ;SAVE THE FILCHR
SETZM HOST(X) ;HOST IS ALWAYS LOCAL FOR FILES
MOVE A,USRFLG(X) ;SET CATEGORY TO FILE
HRLI A,USRFL
MOVEM A,USRFLG(X)
GJINF ;SET UP DEFAULT DIRECTORY TO BE LOGGED-IN
MOVE B,A ;LOGGED-IN DIR
HRROI A,LOGDIR ;WHERE TO WRITE DIR NAME
DIRST ;WRITE IT
JRST [ HRROI A,[ASCIZ /Unable to set up default directory/]
JRST BADUS1 ]
MOVE A,INFIL ;SET UP I/O JFN FOR GTJFN
CAIE A,100 ;INPUT IS INFIL,
SKIPA A,[377777] ;OUTPUT IS 101 IF INFIL=100, NIL OTHERWISE
MOVEI A,101
HRL A,INFIL
MOVEM A,FILJFN+1
SETZ B, ;NO STRING FOR THIS GTJFN
MOVEI A,FILJFN ;ARGUMENT BLOCK
GTJFN
JRST [ PUSH P,A ;SAVE ERROR CODE
MOVE A,INFIL ;GET FILE STATUS OF INPUT
GTSTS
POP P,A
MOVEM B,C ;STATUS NOW IN C
SETZ B,
CAIN A,GJFX4 ;ILLEGAL CHAR?
TLNN C,1000 ;EOF?
SKIPA ;NOT ILL CH OR EOF
HRROI B,[ASCIZ / Terminating character required after file name, before end of file./]
PUSHJ P,ERRPLY
HRROI A,REPLY
JRST BADUS1 ]
MOVEM A,USRJFN ;SAVE JFN
;WRITE COMPLETE FILE NAME INCLUDING VERSION INTO STRING AT EPTR
; AND UPDATE EPTR - OMIT DIRECTORY IF DIR=CONNECTED=LOGGED-IN
SETZ C, ;DEV,DIR,NAME,EXT,VER,PUNCT
MOVE A,EPTR ;WHERE TO WRITE NAME
HRRZ B,USRJFN ;JFN OF FILE
JFNS
MOVEM A,EPTR ;UPDATE EPTR
SETZ B, ;END WITH A NULL
IDPB B,A
MOVE A,USRJFN
RLJFN ;RELEASE THE JFN. DON'T NEED IT NOW.
JFCL
MOVE A,INFIL ;READ CHAR THAT TERMINATED FILE NAME
BKJFN
JFCL
MOVEI A,100 ;WAKE UP ON ALL CHARS
RFMOD
TRO B,17B23
SFMOD
TRZA F,FRSTCH ;HAVEN'T PROCESSED CHAR THAT TERMINATED GTJFN
TRMLUP: TRO F,FRSTCH
PUSHJ P,.BIN
CAIN A,CRTYPE ;^R - RETYPE FILE NAME
JRST [ SETZ B, ;NO PROMPT
MOVE C,PTR ;STRING TO RETYPE
PUSHJ P,RETYPE
JRST TRMLUP] ;LOOP FOR REAL TERMINATOR
CAIN A,"S"-100 ;^S - RETYPE ADDRESS LIST
JRST [ MOVE B,PROMPT
MOVE C,BPTR
PUSHJ P,RETYPE
JRST TRMLUP] ;LOOP FOR REAL TERMINATOR
CAIN A,CDELLN ;^Q - DELETE FILE NAME
JRST [ HRROI A,[ASCIZ /_
/]
JRST UFLUSH ]
CAIN A,"X"-100 ;^X - DELETE ADDRESS LIST
JRST GETUS0
CAIN A,CDELLN
JRST RUBOUT
CAIE A," " ;IGNORE SPACES
CAIN A,CR ;AND CARRIAGE RETURNS
JRST TRMLUP
CAIN A,33 ;ALTMODE
JRST [ TRNN F,FRSTCH
JRST TRMLUP ;IGNORE IF WAS GTJFN TERMINATOR
MOVEI A,7 ;OTHEWISE DING THEN IGNORE
PBOUT
JRST TRMLUP ]
CAIE A,0 ;TREAT EOF AND LF AS EOL
CAIN A,LF
MOVEI A,.CHLFD
JRST RUL63 ;OK, CONSIDER CHAR A FIELD TERMINATOR
;FATAL ERROR ROUTINE
FATERR: MOVEI A,.PRIOU ;GIVE HIM THE MESSAGE
MOVE B,[400000,,-1] ;THIS FORK LAST ERROR
SETZ C,
ERSTR
JFCL
JFCL
HALT
JRST SNDMSG
; GET SUBJECT LINE
GETSBJ: HRROI A,[ASCIZ /
Subject: /]
MOVEM A,PROMPT
GETSB: MOVE A,PROMPT
PSOUT
GETSB0: MOVEM PTR,BPTR
MOVEM PTR,SUBJCT
TRO F,FULLF
TRZ F,BLANKF ;NO SPECIAL TREATMENT OF BLANKS
PUSHJ P,INSTR
GETSB2: JRST [ MOVE PTR,BPTR
JRST GETSB]
CAIN A,"?"
JRST SBJHLP
CAIN A,CDELLN
JRST [ HRROI A,[ASCIZ /XXX/]
PSOUT
JRST GETSB]
CAIE A,33
CAIN A,0
JRST SBJMOR ;IGNORE NULL & ALTMODE
CAIN A,"B"-100 ;^B - GET NEW FILE AND CONTINUE
JRST [ PUSHJ P,NEWFIL
JRST SBJMOR ]
CAIE A,.CHLFD
JRST SBJSAV
CAMN PTR,EPTR
SETZM SUBJCT ; MARK NULL SUBJECT THIS WAY
MOVEM EPTR,PTR
IBP PTR
POPJ P,
SBJSAV: IDPB A,EPTR ;SAVE CHAR
SBJMOR: PUSH P,[GETSB2] ;CONTINUE GATHERING STRING
JRST INSTRC
SBJHLP: TYPOUT <
HRROI A,QMSG4
PSOUT >
JRST GETSB
; GET THE TEXT OF A MESSAGE
GETTXT: HRROI A,[ASCIZ /
Message (? for help):
/]
MOVEM A,PROMPT
GETTX1: MOVE A,PROMPT
PSOUT
GETTX0: MOVEM PTR,MSG
MOVEM PTR,BPTR
TRZ F,FULLF
TRZ F,BLANKF ;NO SPECIAL TREATMENT OF BLANKS
PUSHJ P,INSTR
GETTX: JRST GETTXT
CAIE A,0
CAIN A,CDELLN
TXTMOR: JRST [ PUSH P,[GETTX]
JRST INSTRC]
CAIN A,"B"-100
JRST TXCTLB
CAIN A,"?"
JRST TXTHLP
MOVEI A,.CHLFD
PBOUT
LDB A,EPTR ; IS THERE A LF
CAIE A,12 ; AT THE END?
JRST [ MOVE A,EPTR ; NO
HRROI B,[ASCIZ /
/]
SETZ C,
SOUT ; PUT ONE THERE
MOVEM A,EPTR
JRST .+1]
MOVEM EPTR,PTR
IBP PTR
PUSHJ P,MAKCPY
POPJ P,
;SUBROUTINE TO SAVE TEXT ON MAIL.CPY.N;T
;STORES JFN (UNRELEASED) AT MSGJFN, -1 IF FAILED
MAKCPY: PUSH P,[1]
GMCLP: MOVSI A,(1B0!1B1!1B5!1B17)
HRR A,0(P)
HRROI B,[ASCIZ /MAIL.CPY;P770000/]
GTJFN
JRST [ AOS A,0(P)
CAIG A,100
JRST GMCLP
POP P,A
JRST NOCOPY]
MOVEM A,0(P)
MOVE B,[XWD 70000,100000]
OPENF
JRST [ POP P,A
RLJFN
JFCL
JRST NOCOPY]
MOVE B,MSG
SETZ C,
SOUT
POP P,A
MOVEM A,MSGJFN ;SAVE JFN
TLO A,400000 ;DON'T RELEASE JFN WHEN CLOSE
CLOSF
JFCL
JRST GTXTE
NOCOPY: HRROI A,[ASCIZ /
Unable to save message on MAIL.CPY -
/]
PSOUT
SETOM MSGJFN ;NO MAIL.CPY - JFN=-1
MOVEI A,101
HRLOI B,400000
SETZ C,
ERSTR
JFCL
JFCL
GTXTE: MOVE A,MSG
PUSHJ P,CNTMSG ; COUNT LENGTH OF MESSAGE
MOVEM B,MSGLEN ; SAVE
POPJ P,
;TYPE INSTRUCTIONS IN RESPONSE TO "?"
TXTHLP: TYPOUT <
HRROI A,QMSG2
PSOUT
HRROI A,QMSG7
TRNN FLG,NTLOGF
PSOUT
HRROI A,QMSG3
PSOUT
HRROI A,QMSG8 ;TYPE ^O MESSAGE
TRNN FLG,NTLOGF ;IF APPROPRIATE
PSOUT >
JRST GETTX1
;HELP MESSAGE FOR ^B CHOICE
TXHLP2: TYPOUT <
HRROI A,QMSG9
PSOUT >
JRST CTLBQ
;HANDLE ^B
TXCTLB: PUSHJ P,PRMTTY
TXNEWF: JRST [ PUSHJ P,NEWFIL
JRST TXTMOR ]
IFN TECSUB,<
TRNE FLG,NTLOGF
JRST TXNEWF
>
IFE TECSUB,<
JFCL
JRST TXNEWF
>
CTLBQ: HRROI A,[ASCIZ /
(Insert File or Invoke TECO (F, T, or ?)? /]
PSOUT
MOVEI A,100
RFMOD
TRO B,17B23
SFMOD ;WAKE UP ON ALL CHARS
PBIN
CAIL A,140 ;CONVERT TO UPPER CASE
SUBI A,40
MOVEM A,B
HRROI A,[ASCIZ /)
/]
PSOUT
CAIN B,"?"
JRST TXHLP2
CAIN B,"F"
JRST TXNEWF
CAIE B,"T"
JRST TXTMOR
;WRITE TEXT ONTO MAIL.CPY.N;S
PUSHJ P,MAKCPY
SKIPGE MSGJFN ;SUCCEEDED?
JRST [ HRROI A,[ASCIZ /(? CANNOT INVOKE EDITOR)/]
PSOUT
JRST TXTMOR ]
;GET JFN FOR EDITOR (TECO)
MOVE A,[1B2+1B17] ;OLD FILE
HRROI B,[ASCIZ /SYS:TECO.EXE/]
GTJFN
JRST [ HRROI A,[ASCIZ /(? UNABLE TO GET SYS:TECO.EXE)/]
PSOUT
JRST TXTMOR ]
MOVEM A,EDJFN ;SAVE JFN
;CREATE FORK FOR EDITOR
MOVE A,[1B1] ;PASS DOWN CAPABILITIES
CFORK
JRST [ MOVE A,EDJFN
RLJFN
JFCL
HRROI A,[ASCIZ /(? UNABLE TO CREATE FORK FOR EDITOR)/]
PSOUT
JRST TXTMOR]
MOVEM A,EDFRKH ;SAVE FORK HANDLE
;GET EDITOR INTO FORK
HRL A,A ;FORK HANDLE
HRR A,EDJFN ;EDITOR JFN
GET
;SET UP FOR AND RUN EDITOR
MOVE A,MSGJFN ;JFN OF TEXT FILE IN AC1
MOVEM A,SAVACS+1
MOVE A,EDFRKH ;FORK HANDLE
MOVEI B,2 ;ENTRY 2
PUSHJ P,RUNFRK ;RUN IT
JRST EDBAD ;FAILURE RETURN
;EDITOR RAN OK, NOW GET EDITED TEXT
;RUN SPECIAL EDITOR ENTRY TO RETURN TEXT LOCATION
MOVE A,EDFRKH
MOVEI B,3 ;ENTRY 3
PUSHJ P,RUNFRK
JRST EDBAD ;CANT FIND OUT WHERE TEXT IS
;AC2 POINTS TO START OF TEXT, AC3 TO END (IN EDITOR ADDRESS SPACE)
;AC1 TELLS WHAT FORM AC2, AC3, TEXT ARE IN
MOVE A,SAVACS+1 ;INTERPRETATION CODE
CAIN A,1
;AC1=1 - AC2 AND AC3 ARE CHAR ADDRESSES OF BEGINNING AND END OF TEXT
; ALSO, TEXT CONTAINS EOL INSTEAD OF CRLF
JRST [ TRO F,EDEOLF ;MUST CONVERT EOL TO CRLF
JRST EDTXT ]
;AC1=2 - AC2 AND AC3 ARE CHAR ADDRESSES OF BEGINNING AND END OF TEXT
; TEXT CONTAINS CRLF
CAIN A,2
JRST [ TRZ F,EDEOLF ;DON'T CONVERT EOL TO CRLF
JRST EDTXT ]
JRST [ HRROI A,[ASCIZ /(? EDITOR RETURNED INFO IN WRONG FORM)/]
JRST EDBAD]
EDTXT: MOVE EPTR,BPTR ;WHERE TO WRITE TEXT
MOVE B,SAVACS+2 ;CHAR ADRR OF 1ST CHAR
CAML B,SAVACS+3 ;ANY CHARS? (START<END)
JRST EDTDON ;NO, DONE ALREADY
IDIVI B,5000 ;5000 CHARS/PAGE
MOVEM B,SAVACS+4 ;PAGE # STARTS AT IN EDITOR
MOVEM C,SAVACS+2 ;START CHAR RELATIVE TO START PAGE
IMULI B,5000
MOVE C,SAVACS+3 ;CHAR ADR PAST LAST CHAR
SUB C,B
MOVEM C,SAVACS+3 ;END CHAR RELATIVE TO START PAGE
;MAP NEXT PAGE FROM EDITOR
EDTLUP: MOVE A,SAVACS+4 ;PAGE IN EDITOR
HRL A,EDFRKH ;EDITOR FORK HANDLE
MOVE B,[400000,,FLAGPG] ;WINDOW PAGE IN SNDMSG
MOVE C,[1B2] ;READ ONLY
PMAP ;MAP THE PAGE
; CONSTRUCT START BYTE POINTER IN B
MOVE C,SAVACS+2 ;START CHAR
IDIVI C,5 ;C=WORD#,D=BYTE#
MOVEI B,FLAGPG*1000 ;START OF PAGE
ADD B,C ;ADD RELATIVE WORD IN PAGE
MOVEI A,7
DPB A,[POINT 6,B,11] ;BYTE SIZE=7
MOVEI A,^D36
IMULI D,7
SUB A,D
DPB A,[POINT 6,B,5] ;POSITION OF BYTE
MOVE C,SAVACS+3 ;END CHAR
CAILE C,5000 ;WITHIN CURRENT PAGE?
MOVEI C,5000 ;NO, ONLY GO TO END OF PAGE
SUB C,SAVACS+2 ;# OF CHARS TO GET FROM THIS PAGE
TRNN F,EDEOLF ;IF NEEDN'T SEARCH FOR EOL,
MOVN C,C ; USE NEG # OF CHARS
MOVE A,EPTR ;WHERE TO WRITE STRING
EDTLP2: MOVEI D,.CHLFD ;TERMINATE ON EOL
SOUT ;COPY THRU EOL, OR MAX # CHARS
NOTEOL: JUMPN C,EDTLP2 ;IF CHARS REMAIN, COPY MORE
MOVEM A,EPTR ;USED UP PAGE - SAVE WRITE ADR
;SET UP TO COPY NEXT PAGE
AOS SAVACS+4 ;NEXT PAGE #
SETZM SAVACS+2 ;START CHAR IS BEGINNING OF NEW PAGE
MOVE C,SAVACS+3 ;NEW END CHAR IS 1 PAGE CLOSER THAN WAS
SUBI C,5000 ;5000 CHARS IN A PAGE
MOVEM C,SAVACS+3
JUMPG C,EDTLUP ;IF CHARS REMAIN, GO ON TO NEXT PAGE
EDTDON: MOVE A,EPTR
SETZ C, ;DONE, PUT NULL AT END
IDPB C,A
SETO A, ;REMOVE EDITOR PAGE FROM SNDMSG MAP
MOVE B,[400000,,FLAGPG]
PMAP
;CLEAN UP AFTER EDITING AND CONTINUE TEXT INPUT
EDCLEN: MOVE A,EDFRKH ;KILL EDITOR FORK
KFORK
MOVE A,EDJFN
RLJFN
JFCL
HRROI A,[ASCIZ /(CONTINUE NORMAL TEXT INPUT)/]
PSOUT
JRST TXTMOR ;CONTINUE INPUT
;
;SOMETHING FAILED
EDBAD: PSOUT ;REASON FOR FAILURE IS IN A
HRROI A,[ASCIZ /(EDITING ABORTED)/]
PSOUT
JRST EDCLEN
;SUBROUTINE TO RUN EDITOR FORK -
;ACCEPTS IN 1 - FORK HANDLE
; IN 2 - RELATIVE ENTRY POINT TO START AT
;RETURNS +1 IF ERROR, ERROR STRING IN 1
; +2 IF SUCCESS
;CLOBBERS ACS 1,2,3
;SETS FORK ACS FROM SAVACS AND UPDATES THEM ON RETURN
;SAVES AND RESTORES MODE OF PRIM INP AND COC OF PRIM OUT FILES.
RUNFRK: PUSH P,B ;ENTRY POINT
PUSH P,A ;FORK HANDLE
MOVEI A,100 ;SAVE MODE OF PRIMARY INPUT
RFMOD
MOVEM B,SAVMOD
MOVEI A,101 ;SAVE COC WORDS OF PRIMARY OUTPUT
RFCOC
MOVEM B,SAVCOC
MOVEM C,SAVCOC+1
POP P,A ;FORK HANDLE
MOVEI B,SAVACS
SFACS ;SET FORK ACS FROM SAVACS
GEVEC ;CHECK IF FORK HAS DESIRED ENTRY
HLRZ C,B ;LENGTH OF ENT VEC
POP P,B ;DESIRED ENTRY
CAML B,C
JRST [ HRROI A,[ASCIZ /(? EDITOR LACKS REQUIRED ENTRY POINT)/]
POPJ P, ]
SFRKV ;START FORK
WFORK ;WAIT FOR FORK TO TERMINATE
PUSH P,A
MOVEI A,100 ;RESTORE MODE OF PRIMARY INPUT
MOVE B,SAVMOD
SFMOD
MOVEI A,101 ;RESTORE COC WORDS OF PRIMARY OUTPUT
MOVE B,SAVCOC
MOVE C,SAVCOC+1
SFCOC
POP P,A
MOVEI B,SAVACS
RFACS ;GET FORK ACS
RFSTS
HLRZ B,A ;REASON FOR TERMINATION
CAIE B,2 ;VOLUNTARY?
JRST [ HRROI A,[ASCIZ /(? EDITOR TERMINATED INVOLUNTARILY)/]
POPJ P, ]
AOS 0(P) ;SKIP RETURN
POPJ P,
; OPEN MAIL.TXT FILE
OPNMSG: MOVE D,LOCTIM
MOVE B,USRTAB(X) ;DOES ADDRESS START WITH FILCHR?
ILDB A,B
CAIN A,FILCHR
JRST [ MOVE A,[1B2+1B17] ;YES, SPECIAL FILE,
JRST OPNMS1 ] ;NOT MAIL.TXT
JUMPL D,OPMSK1 ;IF LOCTIM<0, JUST QUEUE
MOVE A,PTR
HRROI B,[ASCIZ /PS:</] ;ALL MAIBOXES ARE ON PS:
SETZ C,
SOUT
MOVE B,USRTAB(X)
SETZ C,
SOUT
HRROI B,[ASCIZ />MAIL.TXT.1/]
SOUT
MOVE B,PTR
MOVSI A,101001
OPNMS1: MOVEM A,SAVACS+1
MOVEM B,SAVACS+2 ;SAVE GTJFN ARGS
OPMLUP: MOVE A,SAVACS+1 ;GET GTJFN ARGS
MOVE B,SAVACS+2
GTJFN
JRST OPNMER
MOVEM A,SJFN
HRLI A,.FBCTL ;CHANGE CONTROL WORD
MOVX B,FB%DEL!FB%PRM ;CHANGE DELETED AND PERM. BITS
MOVX C,FB%PRM ;SET DELETED TO ZERO, PERM. TO 1
CHFDB ;UNDELETE FILE
ERJMP .+1 ;IGNORE ERRORS
OPNMS2: MOVE A,SJFN
MOVE B,[7B5+1B22]
OPENF
JRST [ PUSH P,A
MOVE A,SJFN
RLJFN
JFCL
POP P,A
CAIN A,OPNX9
SOJGE D,[MOVEI A,^D1000
DISMS
JRST OPMLUP ]
JRST OPNMER]
AOS 0(P)
OPMSK1: AOS 0(P)
POPJ P,
;Error replies for OPNMSG
OPNMER: SETZ B,
CAIN A,GJFX17
HRROI B,[ASCIZ /No such user./]
CAIN A,GJFX24
HRROI B,[ASCIZ /No such mailbox./]
CAIN A,GJFX35
HRROI B,[ASCIZ /Can't access directory now./]
CAIE A,OPNX23
CAIN A,OPNX6
HRROI B,[ASCIZ /Can't access mailbox now./]
CAIN A,OPNX9
HRROI B,[ASCIZ /Mailbox busy./]
;SKIP TO QUEUE
CAIE A,OPNX9 ;IF FILE BUSY
CAIN A,OPNX10 ;OR NO ROOM
JRST OPNMEQ ;Queue - skip return
MOVE C,USRTAB(X)
ILDB C,C
CAIN C,FILCHR ;To file, that's all.
JRST ERRPLY
CAIE A,GJFX35 ;ACCESS FAILURES-PLUG IN LOCAL HOST
CAIN A,OPNX6 ;NAME AND TRY OVER NET
SKIPA
CAIN A,OPNX23
JRST [MOVE A,[440700,,STRING] ;LOCAL HOST NAME
MOVEM A,HOST(X)
POP P,A ;DON'T NEED THIS STUFF
JRST SNDNET]
TRNN F,FRWRDF
JRST ERRPLY ;No forwarding
CAIE A,GJFX17
CAIN A,GJFX24
SKIPA
JRST ERRPLY ;Forwarding not appropriate.
CAIN A,GJFX17 ;Forwarding appropriate,
SKIPA
CAIN A,GJFX24 ;SEE IF IN MAILFWDING DATABASE
JRST [SETZ A,
TRO A,1
HRRM A,FLGMLS ;SAYS FROM OPNMER
JRST NOLCL]
OPNMEQ: AOS 0(P) ;Skip return
JRST ERRPLY
;WRITE STRING IN B INTO REPLY. IF B IS 0,
;WRITE ERROR STRING FOR ERR CODE IN A INTO REPLY
ERRPLY: JUMPE B,ERRPL2
HRROI A,REPLY
SETZ C,
SOUT
POPJ P,
ERRPL2: MOVE B,A ;ERROR CODE
HRLI B,400000 ;THIS FORK
HRROI A,REPLY ;STRING DESTINATION
SETZ C,
ERSTR ;ERROR STRING
JFCL ;IGNORE FAILURE
JFCL
IDPB C,A ; END WITH NULL
POPJ P,
IFDEF UTAHSW,<
;OPEN SAVED.MESSAGES FILE
OPNSVD: HRROI B,[ASCIZ /SAVED.MESSAGES /]
MOVSI A,(1B2!1B17)
GTJFN
POPJ P,0
MOVEM A,SJFN
MOVE B,[7B5!1B22!1B26]
OPENF
JRST [MOVE A,SJFN ;CAN'T OPEN SAVED.MESSAGES
RLJFN
JFCL
POPJ P,0]
AOS 0(P)
POPJ P,0 ;SUCCESSFUL, NORMAL RETURN
>
; OPEN UNDELIVERABLE FILE
OPNUND: HRROI B,[ASCIZ '/UNDELIVERABLE-MAIL/.']
JRST OPNQU2
; OPEN QUEUE FILE
OPNQUE: HRROI B,[ASCIZ /[--UNSENT-MAIL--]./]
OPNQU2: PUSH P,B
GJINF ;QUEUE IN LOGIN DIRECTORY
TRNE FLG,NTLOGF ;IF LOGGED IN, OTHERWISE
JRST [DIRST ;IN CONNECTED DIRECTORY
JRST [ POP P,B
POPJ P,]
JRST OPNQU3]
PUSH P,A ;LOGGED IN USER NUMBER
MOVE A,PTR
HRROI B,[ASCIZ /PS:</]
SETZ C,
SOUT
POP P,B ;LOGGED IN USER NUMBER
DIRST
JRST [ POP P,B
POPJ P,]
MOVEI C,">"
IDPB C,A
OPNQU3: POP P,B
SETZ C,
SOUT
MOVE B,USRTAB(X)
MOVEI D,"V"-100
OPNQUL: ILDB C,B
CAIL C,"A"
CAILE C,"Z"
JRST [ CAIL C,"0"
CAILE C,"9"
IDPB D,A
JRST .+1]
IDPB C,A
JUMPN C,OPNQUL
MOVEI B,"@"
DPB B,A
SKIPE B,HOST(X)
PUSHJ P,HSTSOU ;COMPLETE HOST NAME THEN SOUT
HRROI B,[ASCIZ /;P770000/]
SOUT
MOVE B,PTR
MOVSI A,400001
GTJFN
POPJ P,
MOVEM A,SJFN
HRLI A,.FBBYV ;SET UP TO SET RENTION COUNT TO 0
MOVX B,FB%RET
SETZ C,
CHFDB
ERJMP .+1
MOVE A,SJFN
MOVE B,[70000,,100000]
OPENF
JRST [ MOVE A,SJFN
RLJFN
JFCL
POPJ P,]
AOS 0(P)
POPJ P,
; OUTPUT USER NAME AT SITE STRING
OUTUSR: SETZ C,
MOVE B,USRTAB(X)
SOUT
SKIPN HOST(X)
POPJ P,
HRROI B,[ASCIZ / at /]
SOUT
MOVE B,HOST(X)
PUSHJ P,HSTSOU ;COMPLETE HOST NAME THEN SOUT
POPJ P,
; DO ICP TO FTP
DOICP: MOVE A,PTR
HRROI B,[ASCIZ /NET:0./]
SETZ C,
SOUT
MOVE B,HOST(X)
PUSHJ P,HSTSOU ;COMPLETE HOST NAME THEN SOUT
MOVN B,FTPSKT
MOVEI C,8
NOUT
HALT
HRROI B,[ASCIZ /;T/]
SETZ C,
SOUT
MOVE B,PTR
MOVSI A,1
GTJFN
JRST ICPERR ; NO SKIP -- NO SUCH HOST
AOS 0(P) ; AT LEAST ONE SKIP FROM HERE
MOVEM A,SJFN
MOVE B,[XWD 400000,200000]
OPENF
JRST ICPERR
BIN
MOVEM B,FSKT
CLOSF
JFCL
MOVE A,PTR
HRROI B,[ASCIZ /NET:2./]
SETZ C,
SOUT
MOVE B,HOST(X)
SOUT
MOVN B,FSKT
MOVEI C,10
NOUT
JFCL
HRROI B,[ASCIZ /;T/]
SETZ C,
SOUT
MOVE B,PTR
MOVSI A,1
GTJFN
JRST ICPERR
MOVEM A,SJFN
MOVE B,PTR
MOVSI A,1
GTJFN
JRST ICPERR
MOVEM A,RJFN
MOVE B,[XWD 103400,200000]
OPENF
JRST ICPERR
MOVE A,SJFN
MOVE B,[XWD 102400,100000]
OPENF
JRST ICPERR
AOS 0(P)
POPJ P,
;Error replies for DOICP
ICPERR: SETZ B,
CAIN A,GJFX19
HRROI B,[ASCIZ /No such host./]
CAIN A,OPNX20
HRROI B,[ASCIZ /Host not responding./]
CAIN A,OPNX21
HRROI B,[ASCIZ /Host refusing connection./]
CAIN A,OPNX9
SKIPA
CAIN A,OPNX10
HRROI B,[ASCIZ /Connection table problem./]
JRST ERRPLY
;HSTSOU - HOST SOUT ROUTINE - COMPLETES HOST NAMES AND DOES SOUT
HSTSOU: SKIPE HOSTN ;DID THE TABLES READ OK?
SKIPN HSTNAM ; ..
JRST SOUTPJ ;NO. JUST SOUT AS IT STANDS
PUSH P,A ;DESTINATION STRING
PUSH P,B ;SOURCE STRING TO RECOGNIZE
PUSH P,C ;COUPLE AC'S FOR TEMPS
PUSH P,D ; ..
PUSH P,X ;WILL USE AS COUNTER THRU TABLE
TRZ F,AMBIGF!MATCHF ;INITIALIZE NOT AMBIGUOUS OR MATCHED
MOVE X,HOSTN ;POINTER TO HOST NUMBERS AND NAME OFFSET
HSOUL2: MOVE B,0(X) ;GET A HOST NAME
ADD B,HSTNAM ;POINT TO TEXT STRING
HRLI B,440700 ;BYTE PTR
MOVE A,-3(P) ;USER'S NAME
HSOUL1: ILDB C,A ;CHAR FROM USER
ILDB D,B ;CHAR FROM TABLE
CAIG C,172 ;USER MAY BE LOWER CASE
CAIGE C,141
SKIPA ;NOT
TRZ C,40 ;LOWER. MAKE UPPER.
CAME C,D ;CHARACTERS MATCH?
JRST HSOUT1 ;NO
JUMPN C,HSOUL1 ;YES. LOOP UNLESS TO END OF STRINGS
HSOUTM: TRZ F,AMBIGF ; INDICATE SUCCESS FOR INTERESTED CALLER
TRO F,MATCHF
MOVE B,0(X) ;EXACT MATCH
ADD B,HSTNAM ;POINT TO STRING IN TABLE
HRLI B,440700
MOVEM B,-3(P) ;PUT IT IN AC B ON STACK
HSOUTR: POP P,X ;RESTORE ACS
POP P,D
POP P,C
POP P,B
POP P,A
SOUTPJ: SOUT
POPJ P,0
HSOUT1: JUMPN C,HSOUT2 ;IF NOT END OF USER STRING, NO MATCH.
SKIPL 0(X) ;SERVER BIT ON FOR THIS HOST?
JRST HSOUT2 ;NO. DONT RECOGNIZE IT.
TROE F,MATCHF ;YES. IT'S A MATCH. FIRST?
TRO F,AMBIGF ;NO. LOSES. AMBIGUOUS.
MOVEM X,HSOUTX ;STASH THE INDEX OF THE MATCH
HSOUT2: AOBJN X,HSOUL2 ;MOVE ON TO NEXT HOST NAME
MOVE B,HSOUTX ;TRIED ALL. POINT TO ANY MATCH
MOVE B,0(B)
ADD B,HSTNAM
HRLI B,440700 ;STRING POINTER, MAYBE TO A NAME.
TRNE F,MATCHF ;A MATCH?
TRNE F,AMBIGF ;AND NOT AMBIGUOUS?
SKIPA ;NOT A WIN
MOVEM B,-3(P) ;WINS. PUT IT ON STACK FOR SOUT
JRST HSOUTR ;AND RESTORE ACS, SOUT, RETURN.
; SEND A LINE AND WAIT FOR RESPONSE FROM FTP
SWTOK: MOVE A,SJFN
SETZ C,
SOUT
MOVEI B,21
MTOPR
JRST WAITOK
; GET A RESPONSE FROM FTP
WAITOK: MOVE A,RJFN
TRZ F,NUMF
SETZ C,
NINLP: BIN
CAIL B,200
JRST NINLP
CAIG B,"9"
CAIGE B,"0"
JRST NINDUN
TRO F,NUMF
IMULI C,^D10
ADDI C,-60(B)
JRST NINLP
NINDUN: SKIPA D,[POINT 7,REPLY]
NINDU1: BIN
JUMPE B,[GTSTS
TLNN B,1000
JRST NINDU1
MOVE A,[POINT 7,REPLY]
HRROI B,[ASCIZ/ Net connection closed./]
SETZ C,
SOUT
MOVE C,NETCLS
POPJ P, ]
IDPB B,D
CAIE B,12
JRST NINDU1
TRNN F,NUMF ; ANY NUMBER INPUT?
JRST WAITOK ; NO, GET ANOTHER
SETZ B,
IDPB B,D
CAIL C,^D400
CAIL C,^D600
AOS 0(P)
POPJ P,
; GENERATE FIRST PART OF HEADING
MAKIHD: MOVE A,PTR
MOVEM A,HEAD
HRROI B,[ASCIZ /Date: /]
SETZ C,
SOUT
MOVSI C,(1B5!1B7!1B10!1B12!1B13); IN FORM "15 MAY 1973 1346-EDT"
SETO B,
ODTIM
HRROI B,[ASCIZ /
From: /]
SETZ C,
SOUT
TRNE FLG,NTLOGF ; IS USER LOGGED IN?
JRST MAKIH1 ;NO, USE FROM NAME.
PUSH P,A
GJINF
MOVE B,A
POP P,A
DIRST
JFCL
JRST MAKIH2
MAKIH1: MOVE B,FROMNM ;USE FROM NAME
SOUT
MAKIH2: TRNN F,USEATF ;INCLUDE "AT..."?
POPJ P, ;NO, JUST RETURN
HRROI B,[ASCIZ / at /]; SAY WHAT HOST IT'S FROM
SETZ C,
SOUT
MOVE B,LHOST
TRNE FLG,NTLOGF ;IS USER LOGGED IN?
MOVE B,SITE ;NO, USE SITE NAME.
PUSHJ P,HSTSOU ;COMPLETE HOST NAME THEN SOUT
POPJ P,
; PUT SUBJECT LINE INTO HEADING
MAKHSB: SKIPN SUBJCT
POPJ P,
HRROI B,[ASCIZ /
Subject: /]
SETZ C,
SOUT
MOVE B,SUBJCT
SOUT
POPJ P,
; MAKE HEADING FOR SNDMSG
MAKHED: TRZ F,USEATF ;ASSUME NOT USING HOST NAME
TRNN FLG,NTLOGF ; IF THIS IS A NON-LOGGED USER OR
SKIPE HOST(X) ; IF THIS IS TO A DIFFERENT HOST
TRO F,USEATF ;USE HOST NAME
PUSHJ P,MAKIHD ; GENERATE INITIAL PART OF HEADING
PUSHJ P,MAKHSB
HRROI B,[ASCIZ /
To: /]
MOVEI C,USRTO
PUSHJ P,DOCC
HRROI B,[ASCIZ /
cc: /]
MOVEI C,USRCC
PUSHJ P,DOCC
PUSHJ P,MAKEHD
POPJ P,
DOCC: MOVEM B,PROMPT
MOVEM C,USRCAT
SETZ C,
PUSH P,A
TRZ F,COMMAF
SKIPL Y,DISTL
JRST DOUSRS ;NO GROUPS
TRZ F,CCUSRF ;FLAG DOING GROUPS
CCLUP1: HLRZ B,DSTFLG(Y)
CAMN B,USRCAT ;REJECT IF WRONG TYPE USER
PUSHJ P,CCADD ;ADD NEXT GROUP TO CC LIST
AOBJN Y,CCLUP1 ;LOOP THRU ALL GROUPS
DOUSRS: TRO F,CCUSRF ;FLAG DOING USERS
SKIPL Y,NUSERS
JRST DOCEND
CCLUP2: HRLZ B,USRCAT ;OMIT USERS HAVING GROUPS (RH NE 0)
CAMN B,USRFLG(Y) ; OR WRONG CATEGORY
PUSHJ P,CCADD
AOBJN Y,CCLUP2
DOCEND: SUB P,[XWD 1,1]
POPJ P,
CCADD: PUSH P,A
HRROI B,[ASCIZ /, /]
TRNN F,COMMAF
MOVE B,PROMPT
SOUT
TRNN F,CCUSRF
JRST [ MOVE B,DIST(Y)
SOUT
MOVEI B,":"
BOUT
JRST CCCHKE]
EXCH X,Y
CAMN X,Y ;IS THIS WHERE ITS GOING?
JRST [PUSH P,USRTAB(X) ;YES-THIS WILL KEEP ADDRESS
PUSH P,HOST(X) ;CONSISTENT WITH OTHER MESSAGES
PUSH P,A
MOVE A,HOLDU
MOVEM A,USRTAB(X)
MOVE A,HOLDH
MOVEM A,HOST(X)
POP P,A
JRST .+1]
PUSHJ P,OUTUSR
CAMN X,Y ;RESTORE IT FOR SENDING?
JRST [POP P,HOST(X) ;YES
POP P,USRTAB(X)
JRST .+1]
EXCH X,Y
CCCHKE: HRRZ B,A
SUBI B,@-2(P)
TROE F,COMMAF
CAIG B,^D13
JRST CCEND
POP P,A
MOVEI B,","
BOUT
TRZ F,COMMAF
MOVEM A,-1(P)
JRST CCADD
CCEND: SUB P,[XWD 1,1]
POPJ P,
; FINISH UP HEADING
MAKEHD: HRROI B,[ASCIZ /
/]
SETZ C,
SOUT
MOVEM A,PTR
IBP PTR
MOVE A,HEAD
PUSHJ P,CNTMSG ; GET ITS LENGTH
MOVEM B,HEDLEN
POPJ P,
; OUTPUT DATE AND SIZE STAMP
OUTMRK: MOVE A,SJFN
SETO B,
MOVSI C,(1B13) ;TIME ZONE
ODTIM
MOVEI B,","
BOUT
MOVE B,MSGLEN
ADD B,HEDLEN
ADDI B,9
MOVEI C,12
NOUT
JFCL
MOVEI B,";" ;ADD BIT FLAGS
BOUT
SETZ B,
MOVE C,[1B2+1B3+^D12B17+^D8]
NOUT ;BASE 8, 12 COLUMNS, LEADING-0-FILLED
JFCL
MOVEI B,15
BOUT
MOVEI B,12
BOUT
POPJ P,
; OUTPUT MESSAGE
OUTMSG: MOVE A,SJFN
MOVE B,HEAD
MOVN C,HEDLEN
SOUT
MOVE B,MSG
MOVN C,MSGLEN
SOUT
HRROI B,[ASCIZ /-------
/]
SETZ C,
SOUT
POPJ P,
; COUNT LENGTH OF MESSAGE
CNTMSG: SETZ B,
ILDB C,A
JUMPE C,CPOPJ
AOJA B,.-2
; Collect string
; If fullf = 1, then string is terminated by control-Z
; otherwise it is terminated by any punctuation (@ , eol altmode now)
; Initial ? always returns, rubout always returns
INSTR: TRZ F,BUFFUL
MOVE EPTR,PTR
INSTRC: MOVEI A,100
RFMOD
TRZ B,77B23
TRO B,16B23
SFMOD
TRZ F,FRSTCH
RLUP: PUSHJ P,.BIN
TRNE FLG,NTLOGF ;IS USER LOGGED IN?
JRST [ CAIE A,"C"-100 ;NO CHECK FOR ^C
JRST .+1 ;NONE. GO ON.
PBOUT
HALTF ;FOUND ONE. EXIT.
JRST RLUP ;ON CONT GO ON.
]
CAIN A,CDELCH
JRST [ CAMN EPTR,PTR
JRST DING
MOVEI A,"\"
PBOUT
LDB A,EPTR
PBOUT
PUSH P,A
MOVE A,EPTR
BKJFN
0
MOVE EPTR,A
POP P,A
CAIN A,12
JRST .
JRST RLUP]
CAIN A,CDELLN
JRST [ CAMN EPTR,PTR
JRST DING
MOVEI A,"_"
PBOUT
MOVEI A,.CHLFD
PBOUT
PUSHJ P,BKLIN
MOVEM A,EPTR
JRST RLUP]
CAIN A,"W"-100
JRST [ CAMN PTR,EPTR
JRST DING
PUSHJ P,BKWORD
MOVEI A,"_"
PBOUT
JRST RLUP]
CAIN A,CRTYPE
JRST [ PUSHJ P,BKLIN
MOVEM A,C ;START OF STRING
SETZ B, ;NO PROMPT
PUSHJ P,RETYPE
JRST RLUP]
CAIN A,"S"-100
JRST [ SETZ B,
PUSH P,EPTR
IDPB B,EPTR
POP P,EPTR
MOVE C,BPTR
MOVE B,PROMPT
PUSHJ P,RETYPE
JRST RLUP]
TRNE F,BLANKF ;IF FLAG ON,
JRST [ CAIN A," " ; SKIP LEADING BLANKS
CAME PTR,EPTR
JRST .+1
JRST RLUP ]
CAMN PTR,EPTR
CAIE A,"?"
CAIN A,CDELLN
JRST ENDIN
CAIE A,0
CAIN A,"Z"-100
JRST ENDIN
CAIN A,"B"-100
JRST ENDIN
TRNE F,FULLF
JRST [ CAIN A,15 ;FULLF ON
JRST RLUP ; IGNORE
CAIN A,"X"-100
JRST [ HRROI A,[ASCIZ /___
/]
PSOUT
POPJ P,]
CAIE A,","
CAIN A,.CHLFD
JRST ENDIN
CAIE A,33
CAIN A,":"
JRST ENDIN
CAMN EPTR,PTR ;FILCHR CAUSES RETURN ONLY IF
CAIE A,FILCHR ; APPEARS AS FIRST CHAR
SKIPA
JRST ENDIN
SKPNAT A
JRST ENDIN
JRST RLUPS]
CAIE A,33 ;FULLF OFF
CAIN A,"X"-100 ;IGNORE ALTMODE AND ^X
JRST RLUP
TROE F,FRSTCH
JRST RLUPS
PUSH P,A
MOVEI A,100
RFMOD
TRZ B,1B22 ;STOP WAKING ON PUNCTUATION
SFMOD
POP P,A
RLUPS: HRRZ B,EPTR
CAIL B,ESTRING-25
JRST [ TROE F,BUFFUL
JRST RLUP
HRROI A,[ASCIZ /
String buffer full. Finish input soon or you will lose.
/]
ESOUT
JRST RLUP]
CAIL A,140
CAILE A,177
JRST NOTLWR
TRNE F,RAISEF
TRZ A,40
NOTLWR: IDPB A,EPTR
PUSH P,EPTR
SETZ A,
IDPB A,EPTR
POP P,EPTR
JRST RLUP
BKWORD: MOVE A,EPTR
BKWRL1: LDB B,A
PUSHJ P,INVCHK
JRST BKWRD1
CAME A,PTR
BKJFN
JRST BKWRDN
JRST BKWRL1
BKWRD1: CAME A,PTR
BKJFN
JRST BKWRDN
LDB B,A
PUSHJ P,INVCHK
JRST BKWRD1
BKWRDN: MOVEM A,EPTR
SETZ B,
IDPB B,A
POPJ P,
INVCHK: CAILE B," "
CAIL B,177
AOS 0(P)
POPJ P,
BKLIN: MOVE A,EPTR
SETZ B,
IDPB B,A
MOVE A,EPTR
BKLINL: CAMN A,PTR
POPJ P,
BKJFN
0
LDB B,A
CAIN B,12
POPJ P,
JRST BKLINL
BKBLNK: PUSH P,A
MOVE A,EPTR
BKBL1: CAMN A,PTR
JRST BKBL2
LDB B,A
CAIN B," "
BKJFN
JRST BKBL2
JRST BKBL1
BKBL2: MOVEM A,EPTR
POP P,A
POPJ P,
DING: MOVEI A,7
PBOUT
JRST RLUP
ENDIN: TRNE F,BLANKF ;IF FLAG ON,
PUSHJ P,BKBLNK ; BACK UP OVER TRAILING BLANKS
SETZ B,
MOVE C,EPTR
IDPB B,C
AOS 0(P)
POPJ P,
;TYPE PROMPT STRING FROM B (NONE IF 0) THEN STRING FROM C -
; STARTS ON NEW LINE - CLOBBERS A
RETYPE: TYPOUT < MOVEI A,.CHLFD
PBOUT
SKIPE A,B ;TYPE PROMPT IF ANY
PSOUT
MOVE A,C ;TYPE STRING
PSOUT >
POPJ P,
; BYTE INPUT FROM MULTI-FILES
.BIN: PUSH P,B
MOVE A,INFIL
TRNE F,EOFF
JRST [ PUSHJ P,ENDFIL
POP P,B
JRST .BIN]
BIN
JUMPE B,[GTSTS
TLNN B,1000
JRST .-1
SETZ B,
TRO F,EOFF
JRST .+1 ]
MOVE A,B
POP P,B
POPJ P,
SYSGET: PUSH P,A ;PRESERVE AC'S
PUSH P,B
SETZM 0(B) ;IN CASE FAILS, CLEAR ANSWER.
SYSGT
JUMPE B,BAPOPJ ;RETURN IF NO TABLE
MOVE A,HSTFRE ;POINT TO FREE SPACE
HLL A,B ;PUT IN COUNT
MOVEM A,@0(P) ;THATS THE ANSWER
PUSH P,B ;NOW GET DATA. SAVE POINTER
HLLZ X,B ;AOBJN COUNTER
SYSGTL: MOVSI A,(X) ;ENTRY NUMBER IN TABLE
HRR A,0(P) ;TABLE NUMBER
GETAB
JRST SYSGTF ;FAILED!!
AOS C,HSTFRE ;MOVE ON DOWN THE FREE SPACE
CAILE C,HSTTAB+NHSTTB ;OVERFLOW TABLE?
JRST SYSGTF ;YES.
MOVEM A,-1(C) ;NO. STORE DATUM
AOBJN X,SYSGTL ;COUNT THRU TABLE
SYSGTY: POP P,(P) ;PEEL STACK
BAPOPJ: POP P,B
POP P,A
POPJ P,0
SYSGTF: SETZM @-1(P) ;FAILURE. CLOBBER ANSWER.
JRST SYSGTY ;AND RETURN
; POP FILE STACK
ENDFIL: CLOSF
JFCL
POP SF,INFIL
CAMN SF,[XWD -NFILS,FILSTK-1]
TRZ F,QUIETF
HRROI A,[ASCIZ /EOF)/]
TRNN F,QUIETF
PSOUT
TRZ F,EOFF
POPJ P,
; SET NEW INPUT FILE, PUSH FORMER
NEWFIL: PUSH SF,INFIL
TRNE FLG,NTLOGF ;IS USER LOGGED IN?
JRST [ HRROI A,[ASCIZ /(File capability not available non-logged-in users.)/]
PSOUT
JRST NONEWF ]
HRROI A,[ASCIZ /(Insert file: /]
TRNN F,QUIETF
PSOUT
PUSHJ P,PRMTTY ; Is INFIL primary input and a TTY?
SKIPA A,[1B2+3B17] ; No, no confirmation required
MOVE A,[1B2+1B4+3B17] ; Yes, confirmation required
MOVEI B,100
CAME B,INFIL
SKIPA B,[377777]
MOVEI B,101
HRL B,INFIL
GTJFN
JRST [ HRROI A,[ASCIZ / ?)/]
TRNN F,QUIETF
PSOUT
JRST NONEWF]
MOVEM A,INFIL
MOVE B,[XWD 70000,200000]
OPENF
JRST [ MOVE B,A
HRLI B,400000
MOVEI A,101
SETZ C,
TRNN F,QUIETF
ERSTR
JFCL
JFCL
MOVE A,INFIL
RLJFN
JFCL
HRROI A,[ASCIZ / can't open)/]
TRNN F,QUIETF
PSOUT
JRST NONEWF]
HRROI A,[ASCIZ /.../]
TRNN F,QUIETF
PSOUT
TRO F,QUIETF
POPJ P,
NONEWF: POP SF,INFIL
POPJ P,
;Return +2 if INFIL is primary input and a TTY, +1 otherwise.
; Clobbers A,B,C
PRMTTY: MOVE A,INFIL
CAIE A,100
POPJ P,
DVCHR
LDB A,[POINT 9,B,17]
CAIN A,12
AOS 0(P)
POPJ P,
NETCLS: ^D453 ;IF NET CONN CLOSED, PRETEND CODE WAS THIS
NEDLOG: ^D504 ; NEED TO LOG IN
NEDPAS: ^D330 ; NEED PASSWORD
LOGOK: ^D230 ; SUCCESSFUL LOGIN FOR MULTICS
GENDLV: ^D950
GOMAIL: ^D350
QCODES: ^D401 ; CODES IMPLYING QUEUEING
^D436
^D452
^D453
^D454
MNQCOD: -5 ; NEG OF NUMBER OF REPLY CODES THAT IMPLY QUEUEING
FTPSKT: 3
PDP: IOWD PDLL,PDL
DNETTM: ^D30 ;DEFAULT NET TIME-OUT TIME, SECS
DLOCTM: 0 ;DEFAULT LOCAL TIME-OUT TIME, SECS
;ARGUMENTS FOR LONG-FORM GTJFN IN ADDRESS LIST INPUT
FILJFN: 1B2 ;OLD VERSION
0 ;I/O JFN filled in later
0 ;normal default device
POINT 7,LOGDIR ;default directory is logged-in
POINT 7,[ASCIZ /SAVED/] ;Default file name
POINT 7,[ASCIZ /MESSAGES/] ;Default extension
0 ;normal default protection
0 ;normal default account
0 ;don't care what JFN
NOLCL: MOVE A,FLGMLS ;GET MAILBOX.EXE STATUS
TLNE A,400000
JRST ALREDY ;WAS ON, FORK IS THERE
MOVSI A,100001 ;WAS OFF, SEE IF MAILBOX.EXE IS AROUND
HRROI B,[ASCIZ/SYS:MAILBOX.EXE/]
GTJFN
JRST NOMLSV+7 ;NO
MOVEM A,FLMLSV ;YES, SAVE JFN
MOVSI A,(1B1) ;GET A FORK FOR MAILBOX.EXE
CFORK
JRST NOMLSV+3 ;CAN'T GET FORK
MOVEM A,FKMLSV ;SAVE FORK HANDLE
HRL A,FKMLSV ;FORK FOR GET
HRR A,FLMLSV ;FLE FOR GET
GET
HRLZ A,FKMLSV ;LH=FORK,RH=PAGE#0
MOVE B,[400000,,FWDPAG] ;THIS FORK
MOVSI C,140000 ;READ,WRITE ACCESS
PMAP
MOVE A,FLGMLS
TLO A,400000 ;SET MAILBOX.EXE FLAG
MOVEM A,FLGMLS
ALREDY: MOVE A,[FWDADR+140,,FWDADR+141]
SETZM FWDADR+140 ;CLEAR BUFFERS
BLT A,FWDADR+160
MOVE A,[440700,,FWDADR+140]
MOVE B,USRTAB(X)
MOVEI C,^D40
MOVEI D,0
SOUT
MOVE A,FKMLSV ;FORK HANDLE
MOVEI B,4 ;ANY SITE
MOVEM B,FWDACS+1
MOVEI B,FWDACS
SFACS ;SET FORK ACS
MOVEI B,2
SFRKV ;START
WFORK ;WAIT
RFSTS ;READ FORK STATUS
HLRZ A,A
CAIE A,2 ;WENT OK ?
JRST NOMLSV ;NO
MOVE A,FKMLSV ;YES, GET FORK HANDLE
MOVEI B,FWDACS
RFACS ;READ FORK ACS
MOVE C,FLGMLS
TRNE C,400001 ;FROM FOUR50 OR OPNMER?
JRST FWDING ;YES
SKIPG FWDACS+1 ;SUCCESS?
JRST NO10X ;NO
MOVE EPTR,USRTAB(X) ;YES, RESET POINTER
SETZ C, ;BYTE COUNTER
MOVE B,[POINT 7,FWDADR+140]
USRTRN: ILDB A,B ;TRANSFER REAL USER
CAIE A,0 ;TERMINATING NULL?
CAIN C,^D40 ;END OF FIELD?
JRST INSERT ;YES
IDPB A,EPTR
AOJA C,USRTRN
INSERT: MOVEI A,100 ;INSERT @
IDPB A,EPTR
MOVEM EPTR,PTR ;UPDATE PTR
SETZ C,
MOVE B,[POINT 7,FWDADR+150]
HSTTRN: ILDB A,B ;TRANSFER HOST
CAIE A,0 ;TERMINATING NULL?
CAIN C,^D40 ;END OF FIELD?
JRST FINTRN ;YES, FINISHED TRANSFER
IDPB A,EPTR
AOJA C,HSTTRN
FINTRN: MOVE A,SAVTER ;GET TERMINATOR
PUSHJ P,GETHST+2 ;PTR UPDATED WITHIN PUSHJ-POPJ
JRST GETUS0
JRST RUBOUT
JRST BADUS1
MOVEM B,HOST(X) ;SAVE HOST
JRST RUL63
NOMLSV: UNMAP1
MOVE A,FKMLSV
KFORK
MOVE A,FLMLSV
HRLI A,(1B0)
CLOSF
JFCL
MOVE A,FLGMLS
TRNE A,400000 ;FROM FOUR50?
JRST [SETZM FLGMLS ;YES,BUT NO FWDING
MOVEI C,^D450 ;GET FTP CODE
JRST WATMRF+2 ;FAILED-CAN'T FORWARD
]
TRNE A,1 ;FROM OPNMER?
JRST [SETZM FLGMLS ;YES, BUT NO FWDING
HRROI B,[ASCIZ/No such local mailbox, will queue for forwarding/]
JRST OPNMEQ]
SETZM ,FLGMLS ;RESET FLGMLS
HRROI A,[ASCIZ/ Forwarding not available - User must be local /]
JRST BADUS1
NO10X: HRROI A,[ASCIZ/ Either no such user or no such mailbox /]
JRST BADUS1
FOUR50: SETZ A,
TRO A,400000
HRRM A,FLGMLS ;SAYS FROM HERE
JRST NOLCL
FWDING: SKIPG FWDACS+1 ;SUCCESS?
JRST [MOVE A,FLGMLS
TRNE A,1 ;FROM OPNMER?
JRST [HRROI B,[ASCIZ/--Mailbox not local, can't find mailbox location, renamed as undeliverable/]
MOVE A,[440700,,REPLY]
SETZ C,
SOUT
POP P,A ;DON'T NEED THIS STUFF
SETZ A,
HRRM A,FLGMLS ;RESET FWDING PORTION
JRST CANT]
SETZ A,
HRRM A,FLGMLS
TRNE F,NCFRMF ;GENERAL DELIVERY?
JRST GENRL2
MOVEI C,^D450 ;NO-RESTORE FTP REPLY CODE
JRST WATMRF+2] ;WE TRIED
TRNE F,NCFRMF ;GENERAL DELIVERY?
JRST [PUSHJ P,WAITOK ;GET ANOTHER RESPONSE
JRST WATMRF ;SHOULDN'T GET HERE
CAMN C,GENDLV ;ANOTHER 950?
JRST . ;GET ANOTHER RESPONSE
JRST ASK ;SHOULD BE 350
]
ASK: MOVE A,TIMFRK ;ANSWER AT YOUR LEISURE
FFORK
MOVE A,FLGMLS
TRNE A,1 ;FROM OPNMER?
JRST [HRROI A,[ASCIZ/-- Mailbox not local, Forwarding to /]
PSOUT
MOVE A,[440700,,FWDADR+150]
PSOUT
HRROI A,[ASCIZ/.../]
PSOUT
POP P,A ;DON'T NEED THIS STUFF
SETZ A,
HRRM A,FLGMLS ;RESET FWDING PORTION
JRST FWDIT+2] ;GET MAILBOX AND SEND OVER NET
SETZ A, ;NO
HRRM A,FLGMLS ;RESET FWDING PORTION OF FLAG
HRROI A,[ASCIZ/ -- Location of /]
PSOUT
MOVE A,USRTAB(X)
PSOUT
HRROI A,[ASCIZ/'s mailbox not known to /]
PSOUT
MOVE A,HOST(X)
PSOUT
HRROI A,[ASCIZ/
However, a user named /]
PSOUT
MOVE A,USRTAB(X)
PSOUT
HRROI A,[ASCIZ/ has a mailbox at /]
PSOUT
MOVE A,[440700,,FWDADR+150]
PSOUT
IDIOT: HRROI A,[ASCIZ/
F,A or ?: /]
TRNE F,NCFRMF ;GENERAL DELIVERY
HRROI A,[ASCIZ/
G,F,A or ?: /]
PSOUT
MOVEI A,100
RFMOD
TRO B,77B23
SFMOD
PBIN
CAIE A,"F"
CAIN A,"f"
JRST FWDIT
CAIE A,"A"
CAIN A,"a"
JRST ABORT
TRNE F,NCFRMF ;GENERAL DELIVERY?
JRST [CAIE A,"G"
CAIN A,"g"
JRST GENRL
JRST QUEST
]
QUEST: CAIE A,"?"
JRST [MOVEI A,[BYTE (7) 7,77,0]
PSOUT
JRST IDIOT
]
TRNE F,NCFRMF ;GENERAL DELIVERY?
JRST [HRROI A,[ASCIZ/
G = general delivery to /]
PSOUT
MOVEI A,101
PUSHJ P,OUTUSR
HRROI A,[ASCIZ/
An operator will try to deliver the mail/]
PSOUT
JRST QUEST+4
]
HRROI A,[ASCIZ/
F = forward to /]
PSOUT
MOVE A,[440700,,FWDADR+140]
PSOUT
HRROI A,[ASCIZ/ at /]
PSOUT
MOVE A,[440700,,FWDADR+150]
PSOUT
HRROI A,[ASCIZ/
A = abort - rename message for /]
PSOUT
MOVEI A,101
PUSHJ P,OUTUSR
HRROI A,[ASCIZ/ as undeliverable
and place in /]
PSOUT
GJINF
MOVEI A,101
DIRST
JRST [HRROI A,[ASCIZ/CONNECTED DIRECTORY/]
PSOUT
JRST .+1]
HRROI A,[ASCIZ/ at /]
PSOUT
HRROI A,STRING ;LOCAL HOST NAME
PSOUT
HRROI A,[ASCIZ/
? = this explanation/]
PSOUT
JRST IDIOT
FWDIT: HRROI A,[ASCIZ/orwarding.../]
PSOUT
MOVE A,[440700,,FWDADR+140]
MOVEM A,USRTAB(X) ;REPLACE IT
MOVE A,[440700,,FWDADR+150]
MOVEM A,HOST(X)
MOVE A,[400000,,400000] ;KILL CURRENT NET CONNECTION
CLZFF ;BUT SAVE MAILBOX.EXE
JRST SNDNET
ABORT: HRROI A,[ASCIZ/borting.../]
PSOUT
TRNE FLG,NTLOGF
JRST XRENAM
PUSHJ P,OPNUND
JRST XRENAM
PUSHJ P,OUTMSG
MOVE A,SJFN
CLOSF
JFCL
HRROI B,[ASCIZ/ ok/]
ATELL: MOVE A,[440700,,REPLY]
SETZ C,
SOUT
MOVEI B,0
IDPB B,A
HRROI B,[ASCIZ//]
JRST ENDSND
XRENAM: HRROI B,[ASCIZ/ can't rename as undeliverable/]
JRST ATELL
GENRL: HRROI A,[ASCIZ/eneral delivery.../]
PSOUT
JRST WATMRG ;MAIL IT GENERALLY
GENRL2: HRROI A,REPLY ;PRINT 950 REPLY
PSOUT
PUSHJ P,WAITOK ;GET ANOTHER RESPONSE
JRST WATMRF ;SHOULDN'T GET HERE
CAMN C,GENDLV ;ANOTHER 950?
JRST GENRL2 ;PRINT ANOTHER 950 REPLY
JERK: MOVE A,TIMFRK ;NO-SHOULD BE 350
FFORK
SETZM REPLY
HRROI A,[ASCIZ/ Is general delivery ok for user /]
psout
MOVEI A,101
PUSHJ P,OUTUSR
HRROI A,[ASCIZ/? /]
PSOUT
MOVEI A,100
RFMOD
TRO B,77B23
SFMOD
PBIN
CAIE A,"Y"
CAIN A,"y"
JRST WATMRG
CAIE A,"N"
CAIN A,"n"
JRST [HRROI A,[ASCIZ/ -- A/]
PSOUT
JRST ABORT]
JRST JERK
;CLOSES CURRENT NET CONNECTION AND SETS UP PROPER USER AT HOST
;RETURNED BY THE CURRENT FTPSERVER
MEDOIT: MOVE A,TIMFRK ;STOP TIMER TIL NEXT SENDING
FFORK
MOVE A,[440700,,REPLY]
MOVE B,[440700,,[ASCIZ/ MAIL WILL BE FORWARDED TO /]]
STRCMP: ILDB D,B
CAIN D,0 ;FINISHED?
JRST ITSOK ;YES
ILDB C,A
CAIL C,"a"
CAILE C,"z"
SKIPA
TRZ C,40 ;CONVERT TO UPPER CASE
CAMN C,D ;SAME?
JRST STRCMP ;YES
JRST WATMR1 ;NO-SEND TO HOST(X)
ITSOK: MOVEM A,D ;JUST BEFORE NAME
MOVE A,SJFN
HRROI B,[BYTE (7) 3,102,131,105,.CHLFD,0] ;CNTRL-C,B,Y,E
SETZ C,
SOUT
MOVEI B,21
MTOPR ;DON'T WAIT FOR RESPONSE
MOVE A,[400000,,400000] ;SAVE MAILBOX.EXE IF THERE
CLZFF ;KILL NET CONNECTION
MOVE A,D ;STRING POINTER TO REPLY NAME at HOST
MOVE C,[440700,,NEWUSR]
MOVEM C,USRTAB(X)
NXTCHU: ILDB B,A ;GET USER
CAIE B,40 ;SPACE?
JRST [IDPB B,C
JRST NXTCHU] ;NO
MOVEI B,0 ;YES
IDPB B,C ;INSERT A NULL
MOVEI C,3 ;SKIP 3 MORE CHARACTERS
SKPCH2: ILDB B,A
SOJN C,SKPCH2
MOVE C,[440700,,NEWHST]
MOVEM C,HOST(X)
NXTCHH: ILDB B,A ;GET HOST
CAIE B,15 ;CR?
JRST [IDPB B,C
JRST NXTCHH] ;NO
MOVEI B,0 ;YES
IDPB B,C ;INSERT A NULL
HRROI A,[ASCIZ/ -- Forwarding to /]
PSOUT
MOVE A,HOST(X)
PSOUT
HRROI A,[ASCIZ/.../]
PSOUT
JRST SNDNET ;NOW USE IT TO SEND TO PROPER HOST
;LITERALS XLISTED
XLIST
LIT
LIST
; MASSIVE RE-ORGANIZATION
; VARIABLES
LOC 20000
FLAGPG==./1000
FLAGS: BLOCK 1000
NETTIM: BLOCK 1 ;TIME-OUT TIME FOR NET MAIL
LOCTIM: BLOCK 1 ;TIME-OUT TIME FOR LOCAL MAIL
PROMPT: BLOCK 1
SAVACS: BLOCK 20 ;TO SAVE ACCUMULATORS
EDFRKH: BLOCK 1 ;FORK HANDLE FOR EDITOR
SAVMOD: BLOCK 1 ;PRIMARY INPUT JFN MODE
SAVCOC: BLOCK 2 ;PRIMARY OUTPUT COC WORDS
MONITV: BLOCK 1
PDL2: BLOCK 4
PDL: BLOCK PDLL
FILSTK: BLOCK NFILS
INFIL: BLOCK 1
MSG: BLOCK 1
MSGLEN: BLOCK 1
HEAD: BLOCK 1
HEDLEN: BLOCK 1
SUBJCT: BLOCK 1
DEFHST: BLOCK 1
DEFGRP: BLOCK 1
USRCAT: BLOCK 1
BX: BLOCK 1
BXDIST: BLOCK 1
XDIST: BLOCK 1
DISTL: BLOCK 1
DIST: BLOCK NDIST
DSTFLG: BLOCK NDIST
HOST: BLOCK NUSRS
USRTAB: BLOCK NUSRS
USRFLG: BLOCK NUSRS
FILNAM: BLOCK NFILS
NUSERS: BLOCK 1
TIMFRK: BLOCK 1
SAVEP: BLOCK 1
SAVEP2: BLOCK 1
RETPC1: BLOCK 1
SUPRET: BLOCK 1
LHOSTN: BLOCK 1
LHOST: BLOCK 1
FSKT: BLOCK 1
RJFN: BLOCK 1
SJFN: BLOCK 1
MSGJFN: BLOCK 1 ;JFN OF MAIL.CPY
EDJFN: BLOCK 1 ;JFN FOR EDITOR
USRJFN: BLOCK 1 ;JFN FOR FILES IN ADDRESS LIST
ENDPTR: BLOCK 1
OLDCNT: BLOCK 1
SPATCR: BLOCK 1
LOGDIR: BLOCK 10 ;NAME OF LOGGED IN DIRECTORY
SITEN: BLOCK 1
SITE: BLOCK 1
FROMNM: BLOCK 1
HSTFRE: BLOCK 1 ;SPACE COUNTER INTO HSTTAB
HOSTN: BLOCK 1 ;POINTER TO HOST NUMBERS AND BITS
HSTNAM: BLOCK 1 ;POINTER TO HOST ASCII STRINGS
HSOUTX: BLOCK 1 ;TEMP FOR HSTSOU ROUTINE
REPLY: BLOCK 100
HSTTAB: BLOCK NHSTTB ;SPACE FOR HOST NAMES AND NUMBERS
FWDACS: BLOCK 20 ;FOR MAILBOX.EXE ACS
FLMLSV: BLOCK 1 ;MAILBOX.EXE JFN
FKMLSV: BLOCK 1 ;MAILBOX.EXE FORK HANDLE
FLGMLS: BLOCK 1 ;MAILBOX.EXE FLAG
SAVTER: BLOCK 1 ;FOR TERMINATING CHAR IN ADDRESS FIELD
NEWUSR: BLOCK 10 ;WHERE TO PUT USER RETURNED BY FTPSERVER
NEWHST: BLOCK 10 ;WHERE TO PUT HOST RETURNED BY FTPSERVER
HOLDU: BLOCK 1 ;HOLDS ORIGINAL USRTAB(X)CONTENTS
HOLDH: BLOCK 1 ;HOLDS ORIGINAL HOST(X) CONTENTS
STRING: BLOCK MAXMSG/5
ESTRING:
RELOC
END <EVECL,,ENTVEC>