TITLE MMailbox Mailing lists for MMailr
	SUBTTL Written by Michael McMahon and Mark Crispin /MMcM/MRC/BillW

VWHO==0				;Who last edited MMAILBOX (0=developers)
VMAJOR==7			;TOPS-20 release 7.0
VMINOR==0
VMMLBX==^D63			;MMLBX's version number

	SEARCH MACSYM,MONSYM	;System definitions
	SALL			;Suppress macro expansions
	.DIRECTIVE FLBLST	;Sane listings for ASCIZ, etc.
	.TEXT "/NOINITIAL"	;Suppress loading of JOBDAT
	.TEXT "MMLBX/SAVE"	;Save as MMLBX.EXE
	.TEXT "/SYMSEG:PSECT:CODE" ;Put symbol table and patch area in CODE
	.TEXT "/SET:.LOW.:7000"	;Define lowseg PSECT
	.REQUIRE HSTNAM		;Host name routines
	.REQUIRE SYS:MACREL	;MACSYM support routines

; *******************************************************************
; *								    *
; *  MMailbox is an multiple network mailbox database program for   *
; * TOPS-20.  It was originally conceived by Mike McMahon (MIT	    *
; * (Artificial Intelligence Lab) and jointly developed for TOPS-20 *
; * with Mark Crispin (Stanford Computer Science Dept.).	    *
; *  The TENEX version of XMailbox was developed by Tom Rindfleisch *
; * (Stanford SUMEX Project) and Mike McMahon in January 1981.	    *
; *  MMailbox was developed from XMailbox version 127 for TCP/IP    *
; * and SMTP by Mark Crispin in September 1982.			    *
; *								    *
; *******************************************************************

;Entry points
;+0: GO		User, asks for address and types out answer
;+1: GO		Unused (reenter)
;+2: n/a	Version
;+3: MMLGO	Expansion entry, used by MMAILR
;+4: MMGO	Existence check entry, used by MM, FTPSER, MAISER, etc.

; Routines invoked externally

	EXTERN $GTPRO,$GTNAM

; AC definitions

F==0
A=1
B=2
C=3
D=4
E=5
I=6
J=7
T=10
TT=11
N=12
O=13
W=15
;CX=16
;P=17

QUOTE==42
LAB=="<"
RAB==">"

;;; Flags
FL%MRD==1B0			;Reading from MAILING-LISTS.TXT file
FL%ADI==1B1			;Allow file indirection
FL%PRV==1B2			;Override file protections
FL%RLY==1B3			;On if local address specified as relay address
FL%CMP==1B4			;Compiling binary file

;; This is where a superior inserts the address to be checked/expanded
	LOC 176
SUCES1:	0			;176 Auxillary value returned to superior
SUCCES:	0			;177 Value returned to superior
ADDRES:	BLOCK 100		;200 Where superior puts address to be expanded
EXPLST:	0			;300 Where expansion is put

	.PSECT DATA,10000	;Regular data starts here

RUNP:	-1			;Program has been run
WHEEL:	0			;We have caps to write new binary file
HAVSUP:	0			;We have a superior fork
MAISUP:	0			;Mail delivery process is superior
ENDPOS:	0			;Last pos before trailing space in MREAD/FREAD
MLSJFN:	0			;JFN for MAILING-LISTS.TXT
BINJFN:	0			;JFN for MAILING-LISTS.BIN
BINSIZ:	0			;Size of file in pages
PRGNAM:	BLOCK 2			;Program name
CMPPDP:	BLOCK 1			;Stack as of compiling
FNGFRK:	BLOCK 1			;Non-zero if we have FINGER mapped
BLKADR:	BLOCK 1			;Address of data block
HSTADR:	BLOCK 1			;Used by local host check
HSTTMP:	BLOCK ^D13		;Ditto

MLSBNM:	BLOCK <^D20>		;Filled in at INIT

NLOCAL==5
LCLADR: BLOCK NLOCAL
LCLPRO: BLOCK NLOCAL

NHSTCH==^D300			;Number of hosts to cache
HSTBFL: 0			;Flag - host cache is full
HSTBIX: 0			;Index into address and protocol tables
HSTBFR: HSTBSS			;Host string free space

HSTBAD: BLOCK NHSTCH+2		;Addresses
HSTBPR: BLOCK NHSTCH+2		;Protocols
HSTBSS: BLOCK 10*NHSTCH		;Strings
HSTBND:	BLOCK 20		;Slush from strings

HOSTTB:	NHSTCH			;TBLUK% table
	BLOCK NHSTCH

NPDL==777
PDL:	BLOCK NPDL		;Main stack
LPNPDL==100
LPPDL:	BLOCK LPNPDL		;Stack for finding forwarding loops

	.ENDPS

; Paged data areas

; Format of binary file documented here

	.PSECT BINDAT,100000	;MAILING-LISTS.BIN area

 BINADR==.			;Address where binary file starts
 BINPAG==<BINADR/1000>		;Page where binary file starts
BINFID:	BLOCK 1			;SIXBIT /MMLBX/
WRTTIM:	BLOCK 1			;Time of last write on text file
HSHMOD:	BLOCK 1			;Hash modulus
 BINHLN==.-BINADR		;Binary file header length
 HSHMD0==^D15013		;Magic prime number for hash modulus
 HSHFRE==1000			;Space at end of hash table
 HSHLEN==<<HSHMD0+BINHLN>!777>+HSHFRE-BINHLN ;Length of hash table
HSHTAB:	BLOCK HSHLEN		;The hash table itself
	BLOCK 1			;?? Is this still necessary ??
BINFRE:	BLOCK 100000-<.-BINADR>	;Binary file free storage
	.ENDPS

	.PSECT PAGDAT,400000
FNGADR:	BLOCK 1000		;Finger returned data address
 FNGPAG==<FNGADR/1000>		;Finger data page
TMPBUF:	BLOCK 20000		;Lots of space

STRSIZ==47777
STRBUF:	BLOCK <STRSIZ+1>/5
STRBF1:	BLOCK <STRSIZ+1>/5

	.ENDPS

	.PSECT FILDAT,500000

JFNPAG: BLOCK 100		;JFN to Page translations (firstpage,,lastpage)
JFNPTR: BLOCK 100		;JFN to byte pointer translation
FFP:	0			;First free page
FILADR=.+1000 & 777000		;Address of first file page
FILPAG=FILADR/1000		;First file page
MAXJFN=77

;Note: Files that are mapped into this PSECT are assumed to be opened
; and closed in stack order... (Last opened= first closed)
	.ENDPS

; Start of program

	.PSECT CODE,25000

EVEC:	JRST GO			;Start
	JRST GO			;Reenter
	BYTE(3)VWHO(9)VMAJOR(6)VMINOR(18)VMMLBX ;Version
	JRST MMLGO		;MMAILR entry (expansion)
	JRST MMGO		;Existance check entry (MM, etc.)
EVECL==.-EVEC

GO:	JSP A,INIT		;Map in database
	CALL UREAD		;Get address from user
	CALL CHECK		;Check for existence
	 JRST [	HRROI A,[ASCIZ/No such address/]
		JRST ERROR]	;+1 Non-ex
	 JRST [	TMSG <Local user, mail is not forwarded>
		JRST DONE]	;+2 Local user
	 JRST [	TMSG <Local file, mail is not forwarded>
		JRST DONE]	;+3 Local file
	 SKIPA			;+4 FINGER data
	  CALL EXPAND		;+5 Expand the address fully
	MOVEI J,EXPLST
	DO.
	  SKIPN E,(J)
	   JRST DONE
	  HRRO A,E
	  PSOUT%
	  IFXN. E,.LHALF
	    MOVEI A,"@"
	    PBOUT%
	    HLRO A,E
	    PSOUT%
	  ENDIF.
	  TMSG <
>
	  AOJA J,TOP.
	ENDDO.

MMGO:	JSP A,INIT
	SETOM HAVSUP		;Have a superior
	CALL CHECK
	 JRST [	SETZM SUCCES	;+1 No such user
		JRST DONE]
	 JRST [	MOVEI A,1
		MOVEM A,SUCCES	;+2 Local user, no forwarding
		JRST DONE]
	 JRST [	MOVEI A,2
		MOVEM A,SUCCES	;+3 Local file, no forwarding
		JRST DONE]
	 NOP			;+4 Forward address from FINGER database
	MOVEI A,3		;+5 Mailing list
	MOVEM A,SUCCES		;Has a mailing list entry
	JRST DONE		;And leave

MMLGO:	JSP A,INIT
	SETOM HAVSUP		;Have a superior
	SETOM MAISUP		;Flag mailer is superior
	CALL CHECK
	 JRST [	SETZM EXPLST	;+1 Not found, no expansion
		SETZM SUCCES
		JRST DONE]
	 NOP			;+2 Local user
	 JRST [	MOVSI A,ADDRES	;+3 Local file
		MOVEM A,EXPLST
		SETZM EXPLST+1
		MOVEI A,2
		MOVEM A,SUCCES
		JRST DONE]
	 JRST [ MOVEI A,3	;+4 Forward address from FINGER database
		MOVEM A,SUCCES
		JRST DONE]
	MOVEI A,3		;+5 Expanded address
	MOVEM A,SUCCES
	CALL EXPAND
	JRST DONE

;;; Common initialization
;;; Call: JSP A,INIT

INIT:	MOVE P,[IOWD NPDL,PDL]	;Init stack
	PUSH P,A		;Save return address
	SKIPL RUNP		;Have we been run before?
	IFSKP.
	  RESET%		;Once only - reset all I/O
	  SETO A,		;Get our names
	  MOVE B,[-2,,PRGNAM]
	  MOVEI C,.JISNM
	  GETJI%
	   NOP			;Shouldn't happen
	  SETZM BINJFN		;No binary JFN yet
	  SETZM FNGFRK		;No FINGER fork just yet
	ENDIF.
	SETZM FFP		;No filepages allocated yet
	SETZM HSTBIX		;Zero index
	SETZM HSTBFL		;Cache not full
	MOVEI A,HSTBSS		;Initial string sace pointer
	MOVEM A,HSTBFR
	MOVEI A,NHSTCH		;Set up TBLUK% table
	MOVEM A,HOSTTB
	SETZM HOSTTB+1
	MOVE A,[HOSTTB+1,,HOSTTB+2]
	BLT A,HOSTTB+NHSTCH-1
	SETZB F,HAVSUP		;No flags, no superior known as yet
	SETZM MAISUP		;Mailer not known as superior yet
	SETZM SUCES1		;No auxillary return value yet
	SETZM WHEEL		;Flag not a wheel just yet
	MOVX A,.FHSLF		;Enable all privs
	RPCAP%
	IOR C,B
	EPCAP%
	RPCAP%			;Watch for evil ACJ
	TXNE C,SC%WHL!SC%OPR	;Note if we are an enabled wheel
	 SETOM WHEEL
	MOVX A,GJ%SHT!GJ%OLD!GJ%PHY ;Physical only, short form, old file
	HRROI B,[ASCIZ/MAIL:MAILING-LISTS.TXT/]
	GTJFN%
	IFJER.
	  HRROI B,[ASCIZ/Cannot find mailing list file/]
	  JRST JSYERR
	ENDIF.
	MOVEM A,MLSJFN		;Save text JFN
	MOVE B,[1,,.FBWRT]	;Get time of last write
	MOVEI C,T
	GTFDB%
	HRLI A,.FBPRT		;Try to ensure right protection
	MOVX B,.RHALF
	MOVX C,777752
	SKIPE WHEEL		;If enabled
	 CHFDB%
	HRROI A,MLSBNM		;Set up binary file name
	HRRZ B,MLSJFN		;JFN of text file
	MOVE C,[110000,,1]	;Device and directory
	JFNS%
	HRROI B,[ASCIZ/MAILING-LISTS.BIN;P777752/]
	SETZ C,
	SOUT%			;Append our filename to it

;;; Map in binary file and see if we can use it

	DO.
	  SKIPE A,BINJFN	;Have a binary file?
	  IFSKP.
	    TXO F,FL%CMP	;No, must compile unless can find one
	    SETZM CMPPDP	;Don't have compiling stack yet
	    CALL MAPBIN		;Map in binary file
	     EXIT.		;Failed completely, must compile
	  ENDIF.
	  SKIPN WHEEL		;Have a binary file, only wheels may recompile
	  IFSKP.
	    SKIPE HAVSUP	;Have a superior?
	  ANSKP.		;No superior, allow recompile
	    MOVE B,[1,,.FBWRT]	;Get time of last write of binary file
	    MOVEI C,D		; into D
	    GTFDB%
	    CAML D,T		;Binary newer than text?
	     CAME T,WRTTIM	;Yes, does its WRTTIM match write time of text?
	  ANNSK.
	    CALL UMPBIN		;Binary file out of date, toss it
	    JXE F,FL%CMP,TOP.	;If didn't just map it in, try again
	  ELSE.
	    TXZ F,FL%CMP	;Not compiling any more
	    MOVE A,MLSJFN	;Nothing more to do, flush the text JFN
	    RLJFN%
	     NOP
	    RET			;Return, ready to go
	  ENDIF.
	ENDDO.

;; Compile new binary file
	MOVEM P,CMPPDP		;Save compiling stack
	MOVE A,MLSJFN		;Open text file
	CALL OPNTXT
	IFNSK.
	  HRROI B,[ASCIZ/Cannot open mailing list file/]
	  JRST JSYERR
	ENDIF.

;; Parse new file
	MOVE A,MLSJFN
	MOVEI N,BINFRE		;Where to put text
	MOVEI O,TMPBUF		;Where to expand addresses
	MOVEM T,WRTTIM		;Save new update time
	MOVE T,[SIXBIT/MMLBX/]
	MOVEM T,BINFID
	MOVEI T,HSHMD0		;Initialize hash modulus
	MOVEM T,HSHMOD
	DO.
	  CALL FILTYI
	  IFL. B
	    HRROI B,[ASCIZ/EOF in file before formfeed/]
	    JRST IERROR
	  ENDIF.
	  CAIE B,.CHFFD
	   LOOP.
	ENDDO.
	DO.			;Read name of mailing list
	  CALL MREAD		;Get a token
	  JUMPL B,ENDLP.	;EOF, done with file
	  CAIN B,"="
	  IFSKP.
	    HRROI B,[ASCIZ/Bad delimiter, not =/]
	    JRST IERROR
	  ENDIF.
	  MOVEI T,STRBUF	;Token name
	  CALL HSHLUK		;Find hash table index
	  IFSKP.
	    HRROI B,[ASCIZ/Duplicate mailing list name/]
	    JRST IERROR
	  ENDIF.
	  HRLM O,(I)		;Save first address
	  HRRM N,(I)		;,,name
	  CALL CPYSTR		;Put in copy of name
	  DO.			;Read component addresses
	    CALL MREAD		;Read entry name
	    PUSH P,B		;Save delimiter
	    CALL CANADR		;Make site,,name
	    MOVEM E,(O)
	    ADDI O,1
	    POP P,B
	    CAIE B,.CHCRT	;End of line
	     JUMPGE B,TOP.	;Or end of file?
	  ENDDO.
	  SETZM (O)
	  ADDI O,1
	  JUMPGE B,TOP.		;Back for more addresses
	ENDDO.
	MOVE O,N		;Put all addresses in file now

;; Expand all addresses just within file
	TXZ F,FL%ADI!FL%PRV	;Don't bother with indirect files
	MOVE W,[IOWD LPNPDL,LPPDL] ;Init forwarding loop stack
	MOVE I,[-HSHLEN,,HSHTAB]
	DO.
	  SKIPN (I)		;Is there an entry here?
	  IFSKP.
	    HRRZ E,(I)		;Get this address
	    PUSH W,E		;First one to check
	    HLRZ J,(I)		;Yes, get start of addresses
	    HRLM O,(I)		;Save relocated list pointer
	    DO.
	      SKIPN E,(J)	;An address there?
	      IFSKP.
		CALL CKLOOP	;Looping on this address?
		 JRST EXPLPX	;Yes
		PUSH W,E	;No, save the address being expanded
		CALL EXPAD0
		ADJSP W,-1	;Reduce loop stack
		AOJA J,TOP.
	      ENDIF.
	    ENDDO.
	    SETZM (O)		;Clear last entry
	    ADDI O,1
	    ADJSP W,-1		;Pop first address
	  ENDIF.
	  AOBJN I,TOP.
	ENDDO.
	MOVE B,[1,,.FBGEN]	;While we're here, get generation #
	MOVEI C,C		;Into C
	GTFDB%
	CALL CLSTXT		;Close text file
	 NOP
	SKIPN WHEEL		;Can we write new version?
	 RET
	MOVX A,GJ%FOU!GJ%SHT!GJ%PHY
	HLR A,C			;Try to keep generation #'s parallel
	HRROI B,MLSBNM
	GTJFN%
	IFJER.
	  HRROI B,[ASCIZ/Cannot find mailing list binary file/]
	  JRST JSYERR
	ENDIF.
	PUSH P,A
	MOVEI B,OF%WR
	OPENF%
	IFJER.
	  POP P,A		;Can't update binary file, no-op it
	  RLJFN%
	   NOP
	  RET
	ENDIF.
	POP P,A
	HRLZ B,A
	MOVE A,[.FHSLF,,BINPAG]
	MOVEI C,777-BINADR(O)
	LSH C,-<^D9>
	TXO C,PM%CNT!PM%RD!PM%WR!PM%CPY
	PMAP%
	HLRZ A,B
	CLOSF%
	 NOP
	TXZ F,FL%CMP		;No longer compiling binary file
	SETZM CMPPDP		;Don't have compiling stack any more
	CALL MAPBIN		;Map it back in for read now
	 JRST ERROR
	RET

;;;Bad input file error handler
IERROR:	PUSH P,A		;Save JFN
	HRROI A,STRBF1		;Place for error string
	SETZ C,
	SOUT%			;Print the error string
	HRROI B,[ASCIZ/ while parsing /]
	SOUT%
	POP P,B			;Restore JFN
	JFNS%
	JRST IERR1

;;; Canonicalize address
;;; Entry: STRBUF/ address from file
;;; Call: CALL CANADR
;;; Returns: +1
;;;	    E/ host name,,user name
;;; host name of FILHST is special, means destination is indirect file
FILHST==777777
CANADR:	SAVEAC <A,B,C>
	STKVAR <HSTPTR>
	HRRZ E,N		;Save start of name (will be copied here)
	MOVE A,[POINT 7,STRBUF]
	SETZ B,			;Where host pointer will be if any
	DO.
	  ILDB C,A
	  IFN. C
	    CAIN C,"@"
	     MOVE B,A		;Save pointer to last @
	    LOOP.
	  ENDIF.
	ENDDO.
	IFE. B			;If no host name, copy string and return
	  SAVEAC <T,TT>
	  MOVEI T,STRBUF	;Is this name in hash table?
	  CALL HSHLUK		;Well?
	   JRST CPYSTR		;No, just copy it then
	  HRRZ E,(I)		;Yes, use that value
	  RET
	ENDIF.
	CAME B,[POINT 7,STRBUF,6] ;Was the @ the first character?
	IFSKP.
	  HRLI E,FILHST		;Yes, local address indirect file
	  CALL CPYSTR
	ELSE.
	  SETZ C,		;Foreign address
	  DPB C,B		;Replace @ with null
	  CALL CPYSTR		;Copy the name
	  MOVEM B,HSTPTR
	  MOVE A,HSTPTR		;Get pointer to host
	  SETO C,		;Try all protocols
	  CALL GETPRO		;Look up host name
	  IFSKP.
	    MOVEM B,HSTADR	;Save host address returned
	    HRROI A,HSTTMP	;Store local name in scratch area
	    SETO B,		;Local host address for this protocol
	    CALL MYADDR		;Get local host address for this protocol
	    IFSKP.
	      CAMN B,HSTADR	;Is this our local host?
	       RET		;Yes, don't need host name
	    ENDIF.
	  ENDIF.
	  HRL E,N
	  MOVE A,HSTPTR		;Start of host name
	  HRLI N,(<POINT 7,0>)
	  DO.
	    ILDB B,A
	    IDPB B,N
	    JUMPN B,TOP.
	  ENDDO.
	  MOVEI N,1(N)		;Update free pointer
	ENDIF.
	RET

;;; Expand address from index in I
EXPAND:	MOVEI N,TMPBUF		;Where to put any strings we make
	MOVEI O,EXPLST		;Where expansion goes
	MOVE W,[IOWD LPNPDL,LPPDL] ;Init forwarding loop stack
	TXO F,FL%ADI!FL%PRV	;Allow file indirection
EXPAN0:	SAVEAC <E,J>
	HLRZ J,(I)		;Get start of addresses
	DO.
	  SKIPN E,(J)		;An address there?
	  IFSKP.
	    CALL CKLOOP		;Looping on this address?
	     JRST EXPLPX	;Yes
	    PUSH W,E		;No, save the address being expanded
	    CALL EXPAD0
	    ADJSP W,-1		;Reduce loop stack
	    AOJA J,TOP.
	  ENDIF.
	ENDDO.
	SETZM (O)		;Clear last entry
	RET

;;; Expand a single address in E into list accumulating in O
;;; No indirect file handling.  EXPADX allows indirect files
EXPADR:	TXZ F,FL%ADI!FL%PRV	;Don't allow indirect files here
EXPADX:	MOVE W,[IOWD LPNPDL,LPPDL] ;Init forwarding loop stack
EXPAD0:	IFXE. E,.LHALF		;Is there a host?
	  SAVEAC <T,I>
	  MOVE T,E
	  CALL HSHLUK		;Look it up
	  IFSKP.
	    CALLRET EXPAN0	;No, recurse
	  ENDIF.
	  MOVEM E,(O)		;No expansion
	  AOJA O,R		;Increment O and return
	ENDIF.
	IFXE. F,FL%ADI
	  MOVEM E,(O)		;No expansion
	  AOJA O,R		;increment O and return
	ENDIF.
	TLC E,FILHST
	TLCN E,FILHST
	IFSKP.
	  MOVEM E,(O)		;No expansion
	  AOJA O,R		; increment O and return
	ENDIF.

;; Read indirect file
	SAVEAC <A,B,T,E>	;Save current state
	STKVAR <INDJFN>		;Indirect file JFN

;;; This code is necesary to fix a security bug.  A malicious user could use
;;;mailer to divulge parts of a protected file by queueing a message
;;;referring to a protected file on the system.  The mailer's error report
;;;may have useful information about the contents of the protected file in it.
;;; This requires that all indirect files referenced as such through the
;;;mailsystem (as opposed to directly via MM) must be publicly readable.
;;;However, indirect files referenced through MAILING.LISTS do not have to
;;;be (note however that a protected indirect file may cause problems for an
;;;unprivileged invocation of MMailbox).
	IFXE. F,FL%PRV		;Agent of MAILING.LISTS?
	  SKIPE MAISUP		;No, is mailer our superior?
	   SKIPN WHEEL		;Do we have capabilities enabled?
	ANSKP.
	  PUSH P,C		;In case necessary
	  MOVEI A,.FHSLF	;Get current capabilities
	  RPCAP%
	  TXZE C,SC%WHL!SC%OPR	;Disable wheel/operator capabilities
	   EPCAP%
	  POP P,C
	ENDIF.
	HRRZ B,E
	HRLI B,(<POINT 7,0,6>)
	MOVX A,GJ%SHT!GJ%OLD!GJ%PHY!GJ%ACC
	GTJFN%
	IFJER.
	  AOS SUCES1		;Note hard error
	  HRROI B,[ASCIZ/Cannot find indirect file/]
	  JRST JSYERR
	ENDIF.
	MOVEM A,INDJFN
	CALL OPNTXT
	IFNSK.
	  MOVE A,INDJFN		;Flush the JFN we got
	  RLJFN%
	   NOP
	  HRROI B,[ASCIZ/Cannot open indirect file/]
	  JRST JSYERR
	ENDIF.
	IFXE. F,FL%PRV		;Did we turn our privileges off?
	  SKIPE MAISUP		;Yes, is mailer our superior?
	   SKIPN WHEEL		;Need to restore capabilities?
	ANSKP.
	  PUSH P,C		;In case necessary
	  MOVX A,.FHSLF		;Retrieve capabilities
	  RPCAP%
	  IOR C,B		;Enable all capabilities again
	  EPCAP%
	  POP P,C
	  MOVE A,INDJFN		;Restore JFN
	ENDIF.
	DO.
	  CALL FREAD		;Read file address
	  PUSH P,B
	  LDB B,[POINT 7,STRBUF,6] ;Get first byte of address
	  IFN. B		;If null, no address to expand
	    CALL CANADR		;Canonicalize
	    CALL CKLOOP		;Looping on this address?
	     JRST EXPLPX	;Yes
	    PUSH W,E		;No, save the address being expanded
	    CALL EXPAD0		;Expand this one
	    ADJSP W,-1		;Reduce loop stack
	  ENDIF.
	  POP P,B
	  JUMPGE B,TOP.
	ENDDO.
	MOVE A,INDJFN		;Indirect file JFN
	CALL CLSTXT		;Close off file
	IFNSK.
	  HRROI A,STRBF1	;Build error string in STRBF1
	  SETO B,		;Timestamp
	  SETZ C,
	  ODTIM%
	   ERJMP .+1
	  HRROI B,[ASCIZ/MMailbox: Cannot close indirect file "/]
	  SETZ C,
	  SOUT%
	  MOVE B,INDJFN		;JFN that lost
	  JFNS%
	  HRROI B,[ASCIZ/" - /]
	  SOUT%
	  HRLOI B,.FHSLF
	  ERSTR%
	   NOP
	   NOP 
	  HRROI A,STRBF1
	  PSOUT%
; For now don't consider this an error
	ENDIF.
	RET

; Here to bomb out on expansion loop
EXPLPX:	HRROI A,[ASCIZ/Loop while expanding address/]
	JRST ERROR

; Routine to check on expansion loop
; Entry:   e = address to be checked
;	   w = stack ptr for previous addresses in expansion path
; Call:    CALL CKLOOP
; Return:  +1, Loop detected
;	   +2, No loop

CKLOOP:	SAVEAC <A>		;Save working AC
	MOVE A,[IOWD LPNPDL,LPPDL] ;Start of stack
	DO.
	  CAMN A,W		;End yet?
	   RETSKP		;Yes, no loop
	  AOBJP A,CKLPX		;Screw-up if turns positive!
	  CAME E,0(A)		;Already expanded this address?
	   LOOP.		;No
	ENDDO.
	RET			;Yes, expansion loop

; Here on internal screw-up
CKLPX:	HRROI A,[ASCIZ/Address expansion screwup/]
	JRST ERROR

;;; Check for mailing list
;;; ADDRESS/ user supplied address
;;; CALL CHECK
;;; +1: Not found
;;; +2: Local user
;;; +3:	Local file
;;; +4: Have found forward address in FINGER database, returning list
;;; +5: Mailing list, I will have hash table index

CHECK:	TXZ F,FL%RLY		;Initially no local relaying done
	DO.
	  MOVE A,[POINT 7,ADDRES,6] ;See if "%" style relay address
	  SETZ D,		;Originally no "last" byte
	  DO.
	    ILDB C,A		;Check byte
	    CAIE C,"@"		;This may be useful for really stupid composers
	     CAIN C,"%"		;Possible route delimiter?
	      MOVE D,A		;Remember destination byte pointer
	    JUMPN C,TOP.	;Loop for further bytes
	  ENDDO.
	  JUMPE D,ENDLP.	;Any "%" seen?
	  MOVE A,D		;Yes, get pointer to string to check
	  SETO C,		;Try all protocols
	  CALL GETPRO		;Validate host name
	   RET			;No such host, address fails
	  MOVEM B,HSTADR	;Save host address returned
	  HRROI A,HSTTMP	;Store local name in scratch area
	  SETO B,		;Local host address for this protocol
	  CALL MYADDR		;Get local host address for this protocol
	  IFSKP.
	    CAME B,HSTADR	;Is this our local host?
	  ANSKP.
	    SETZ C,		;Yes, tie off address
	    DPB C,D		;Edit as appropriate
	    TXO F,FL%RLY	;Local, flag must simulate FINGER return
	    LOOP.		;Now recurse
	  ENDIF.
	  MOVEI C,"@"		;Not local host, change to "@"
	  DPB C,D		;Edit address
	  DMOVE A,[POINT 7,STRBUF ;Copy string where FNGSMX wants it
		   POINT 7,ADDRES]
	  CALL MOVSTR
	  JRST FNGSIM
	ENDDO.
	MOVEI T,ADDRES		;Address of user string
	CALL HSHLUK		;Look in hash table
	 JRST CHKUSR		;Failed, try other options
CPOP4J:	AOS (P)			;+5 mailing list
CPOP3J:	AOS (P)			;+4
CPOP2J:	AOS (P)			;+3
CPOP1J:	AOS (P)			;+2
	RET			;+1

CHKUSR:	LDB A,[POINT 7,ADDRES,6] ;Get first character of name
	CAIE A,"*"		;Allow filespec
	IFSKP.
	  IFXN. F,FL%RLY	;Was it relayed?
	    DMOVE A,[POINT 7,STRBUF ;Yes, must simulate FINGER then
		     POINT 7,ADDRES]
	    CALL MOVSTR
	    JRST FNGSIM
	  ENDIF.
	  MOVX A,GJ%SHT!GJ%OLD!GJ%PHY ;Else see if file exists
	  MOVE B,[POINT 7,ADDRES,6]
	  GTJFN%
	   ERJMP R		;No, barf address
	  RLJFN%		;Flush the JFN
	   ERJMP .+1
	  JRST CPOP2J		;And return +3 filespec
	ENDIF.
	CAIE A,"@"		;Allow indirect
	IFSKP.
	  DMOVE A,[POINT 7,STRBUF ;Copy string where FNGSMX wants it
		   POINT 7,ADDRES]
	  CALL MOVSTR
	  JRST FNGSMX		;Return it
	ENDIF.
	MOVX A,RC%EMO		;A.ne.B see if user name, require exact match
	LDB B,[POINT 7,ADDRES,6] ;Get first character of name
	CAIN B,"&"		;Allow special syntax meaning local user
	 SKIPA B,[POINT 7,ADDRES,6] ;It was, so slide over by 1
	  MOVE B,[POINT 7,ADDRES] ;Proposed user name string
	MOVE C,B		;See if null string
	ILDB C,C		;Get first byte in string
	JUMPE C,R		;If null, punt it completely
	RCUSR%			;Parse it
	 ERJMP R		;If garbage characters, punt it completely
	IFXE. A,RC%NOM!RC%AMB	;Was it a user name?
	  IFXN. F,FL%RLY	;Yes, was it relayed?
	    DMOVE A,[POINT 7,STRBUF ;Yes, must simulate FINGER then
		     POINT 7,ADDRES]
	    CALL MOVSTR
	    JRST FNGSIM
	  ENDIF.
	  RETSKP		;No, local user with no forwarding
	ENDIF.
	MOVE A,[POINT 7,ADDRES]	;Check to see if BUG-MM mail
	MOVE B,[POINT 7,[ASCIZ/BUG-MM/]]
	CALL CMPSTR		;Are the strings equal?
	IFNSK.
	  MOVE A,[POINT 7,STRBUF] ;Buffer to use
	  MOVEI B,[ASCIZ/Bug-MM@SIMTEL20.ARPA/] ;Default BUG-MM host
	  CALL MOVSTR		;Copy the string
	  JRST FNGSIM		;Simulate data returned from FINGER
	ENDIF.
	MOVE A,[POINT 7,ADDRES]	;Check to see if SYSTEM mail
	MOVE B,[POINT 7,[ASCIZ/SYSTEM/]]
	CALL CMPSTR		;Are the strings equal?
	 RETSKP			;+2 treat SYSTEM as local user

;;;Total non-match, see if FINGER will return any information on this string
	SKIPLE A,FNGFRK		;Have FINGER yet?
	 JRST HAVFNG		;Yes, skip FINGER loading
	JUMPL A,NOFING		;If FINGER fork negative, don't use it ever
	MOVX A,GJ%OLD!GJ%SHT	;Look up FINGER
	HRROI B,[ASCIZ/SYS:FINGER.EXE/]
	GTJFN%
	 ERJMP NOFING		;FINGER not present
	PUSH P,A		;Save JFN
	MOVX A,CR%CAP		;Create a new fork
	CFORK%
	IFJER.
	  POP P,A		;Can't get fork, punt
	  RLJFN%		;Flush the JFN
	   NOP
	  JRST NOFING
	ENDIF.
	MOVEM A,FNGFRK		;Save fork handle
	POP P,A			;Get JFN back
	HRL A,FNGFRK		;Fork handle,,JFN
	GET%
	MOVE A,[.FHSLF,,FNGPAG]	;Map FNGPAG of this fork
	HRLZ B,FNGFRK		;From page 777 of FINGER (well-known)
	HRRI B,777
	MOVX C,PM%RD!PM%WR!PM%PLD ;Read/write/preload
	PMAP%
HAVFNG:	MOVE A,[POINT 7,FNGADR]	;Have FINGER.  Where to put the string
	MOVEI B,ADDRES		;Source
	CALL MOVSTR		;Copy the string to FINGER
	MOVE A,FNGFRK		;Get back fork handle
	MOVEI B,3		;Start inferior at offset 3
	SFRKV%
	 ERJMP FNGERR		;FINGER doesn't support +3
	RFORK%			;Resume, in case it didn't get going
	WFORK%			;Sleep until fork is finished
	DMOVE A,PRGNAM		;Restore program name
	SETSN%
	 NOP			;No failure returns defined
	MOVE A,FNGFRK		;See if it finished okay
	RFSTS%
	HLRZ A,A
	CAIE A,.RFHLT		;Fork halted?
	 JRST FNGERR		;No, FINGER fork is sick
	SKIPN FNGADR+400	;Positive reply from FINGER?
	 JRST NOFING		;No
	MOVE A,[POINT 7,STRBUF]	;Where to put it
	MOVEI B,FNGADR+400	;FINGER returns username string here
	CALL MOVSTR		;Copy the strings
	MOVEI N,TMPBUF		;Where expansion goes
	CALL CANADR		;Make canonical address in E
	MOVEI O,EXPLST		;Where to put expression
	CALL EXPADR		;Expand net address
	SETZM (O)		;Tie off list
	JRST CPOP3J		;+4 data from FINGER

;;;Fatal error in FINGER fork; flush it...
FNGERR:	SETO A,			;Unmap shared page
	MOVE B,[.FHSLF,,FNGPAG]	;Mapped to FNGPAG
	SETZ C,
	PMAP%
	MOVE A,FNGFRK		;Get FINGER fork
	KFORK%			;Kill the fork
	SETOM FNGFRK		;Flag not to use FINGER again
;	JRST NOFING

;;;No FINGER or no match.  If a BUG-xxx, try for BUG-RANDOM-PROGRAM
NOFING:	HRROI A,[ASCIZ/BUG-/]	;Prefix for bug reports
	HRROI B,ADDRES		;User's string
	STCMP%
	IFXN. A,SC%SUB		;Is "BUG-" a subset of user's string?
	  MOVEI T,[ASCIZ/BUG-RANDOM-PROGRAM/] ;Yes, return BUG-RANDOM-PROGRAM
	  CALL HSHLUK
	   RET			;Not present, address fails utterly
	  JRST CPOP4J		;Return forwarded address
	ENDIF.
	HRROI A,[ASCIZ/HELP-/]	;Prefix for HELP
	HRROI B,ADDRES		;User's string
	STCMP%
	JXE A,SC%SUB,R		;Fail if not a substring
	MOVEI T,[ASCIZ/HELP-RANDOM-PROGRAM/]
	CALL HSHLUK		;Substring, return HELP-RANDOM-PROGRAM
	 RET			;Not present, address fails utterly
	JRST CPOP4J		;Return forwarded address

;;;Simulate return from FINGER, STRBUF/ address to return
FNGSIM:	TXZA F,FL%ADI		;Don't allow indirect files
FNGSMX:	 TXO F,FL%ADI		;This is an indirect file
	TXZ F,FL%PRV		;Don't override protections
	MOVEI N,TMPBUF		;Where expansion goes
	CALL CANADR		;Make canonical address in E
	MOVEI O,EXPLST		;Where to put expression
	CALL EXPADX		;Expand net address
	SETZM (O)		;Tie off list
	JRST CPOP3J		;+4 simulate data from FINGER

;;; Lookup string in hash table
;;; T/ address of string
;;; Returns +1, not found
;;; +2, found
;;; in either case, I has index to hash table
HSHLUK:	SAVEAC <A,B>
	STKVAR <HSHSTR,HSHIDX>
	HRLI T,(<POINT 7,0>)
	MOVEM T,HSHSTR		;Save string pointer
	CALL HASH		;Hash string into number
	MOVEM TT,HSHIDX		;Save first index
	MOVE T,HSHIDX
	DO.
	  IDIV T,HSHMOD		;Divide by modulus
	  SKIPN A,HSHTAB(TT)	;Look for entry here
	   EXIT.		;Not found, return
	  HRLI A,(<POINT 7,0>)
	  MOVE B,HSHSTR		;Given string
	  CALL CMPSTR		;Compare strings
	  IFSKP.
	    AOS T,HSHIDX
	    LOOP.
	  ENDIF.
	  AOS (P)		;Set success return
	ENDDO.
	MOVEI I,HSHTAB(TT)	;Return absolute pointer
	RET

	ENDSV.

;;; Hash string in T until null
HASH:	SAVEAC <C>
	SETZ TT,
	DO.
	  ILDB C,T
	  JUMPE C,ENDLP.
	  LSH TT,7
	  TRZ C,40		;Case independent
	  XORI TT,(C)
	  LOOP.
	ENDDO.
	TLC TT,(TT)		;Make positive (18-bits)
	HLRZ TT,TT
	RET

;;; Compare strings in A and B
;;; +1 same, +2 different
CMPSTR:	SAVEAC <C,D>
	DO.
	  ILDB C,A
	  CAIL C,"a"
	   CAILE C,"z"
	    CAIA
	     SUBI C,"a"-"A"
	  ILDB D,B
	  CAIL D,"a"
	   CAILE D,"z"
	    CAIA
	     SUBI D,"a"-"A"
	  CAME C,D
	  IFSKP.
	    JUMPN C,TOP.	;More to do
	    RET			;Strings match
	  ENDIF.
	ENDDO.
	RETSKP			;Strings don't match

;;; Copy string from STRBUF
;;;        N/ pointer to string free space
CPYSTR:	SAVEAC <A,B>
	MOVE A,[POINT 7,STRBUF]
CPYST1:	HRLI N,(<POINT 7,0>)
	DO.
	  ILDB B,A
	  IDPB B,N
	  JUMPN B,TOP.
	ENDDO.
	MOVEI N,1(N)		;Update free pointer
	RET

;;; Routine to move an ASCIZ string from B to A
; Entry:   a = destination string ptr
;	   b = source buffer address
; Call:    CALL MOVSTR
; Return:  +1
MOVSTR:	TXCE B,.LHALF		;Source str ptr supplied?
	 TXCN B,.LHALF
	  HRLI B,(<POINT 7,0>)	;No, make it a valid str ptr
	SAVEAC <C>
	DO.
	  ILDB C,B
	  JUMPE C,ENDLP.	;Quit on null
	  IDPB C,A
	  LOOP.
	ENDDO.

; Here to finish ASCIZ string
	PUSH P,A		;Save dest ptr so can continue string
	IDPB C,A
	POP P,A
	RET

;;; Cache the host names used, so as to avoid the full overhead of
;;; a GTHST% or GTDOM% every time we need to look up a host.

; Cache the lookup of our local address for each protocol, A/ pointer
;to string, C/ protocol ID

MYADDR:	STKVAR <HSTPTR>
	MOVEM A,HSTPTR
	SETZ A,
	DO.
	  CAME C,LCLPRO(A)	;This protocol?
	  IFSKP.
	    MOVE B,LCLADR(A)	;Get address
	    MOVE A,HSTPTR	;Restore string pointer
	    RETSKP
	  ENDIF.
	  SKIPE LCLPRO(A)	;End of current list, and not found yet?
	  IFSKP.
	    MOVEM C,LCLPRO(A)
	    EXCH A,HSTPTR	;Get back string pointer
	    CALL $GTNAM		;Get local host address for this protocol
	     RET		;Return failure
	    EXCH A,HSTPTR
	    MOVEM B,LCLADR(A)	;Save this address
	    EXCH A,HSTPTR
	    RETSKP
	  ENDIF.
	  CAIGE A,NLOCAL-1	;End of list?
	   AOJA A,TOP.
	ENDDO.
	MOVE A,HSTPTR		;Out of room
	CALLRET $GTNAM		;Just chain to normal routine...

	ENDSV.

GETPRO:	SAVEAC <N>
	STKVAR <HSTPTR,HSTPRO,HSTENT>
	MOVEM A,HSTPTR
	MOVEM C,HSTPRO
	MOVEI A,HOSTTB		;Host TBLUK table
	MOVE B,HSTPTR		;Get string
	TBLUK%
	IFXN. B,TL%EXM		;Exact match?
	  HRRZ A,(A)		;Get arguments
	  MOVE B,HSTBAD(A)	;Get address
	  MOVE C,HSTBPR(A)	;Get protocol
	  MOVE A,HSTPTR		;Return pointer
	  RETSKP
	ENDIF.
	MOVE A,HSTPTR		;Get back args to $GTPRO
	MOVE C,HSTPRO
	CALL $GTPRO
	 RET			;Return failure
	SKIPE HSTBFL		;Cache full?
	IFSKP.
	  AOS A,HSTBIX		;No, increment and fetch index
	  MOVEM B,HSTBAD(A)	;Save address
	  MOVEM C,HSTBPR(A)	; and protocol
	  HRLZ B,HSTBFR		;Where the string will go
	  HRR B,A		;Index to info for that host
	  MOVEM B,HSTENT
	  MOVE N,HSTBFR		;Get free space pointer
	  MOVE A,HSTPTR		;Get string pointer
	  CALL CPYST1		;Copy the string
	  MOVEM N,HSTBFR	;Save new free space pointer
	  CAILE N,HSTBND	;Out of free space?
	   SETOM HSTBFL		;Set full flag...
	  MOVEI A,HOSTTB	;Host TBLUK% table
	  MOVE B,HSTENT
	  TBADD%		;Add it to the table
	..TAGF (ERJMP,)		;I sure wish ANNJE. existed!
	  MOVE C,HSTBIX
	  MOVE A,HSTPTR
	  MOVE B,HSTBAD(C)	;Get address again
	  MOVE C,HSTBPR(C)	;Get protocol again
	ELSE.
	  SETOM HSTBFL		;set failure flag
	ENDIF.
	RETSKP

	ENDSV.

;;; File reading routines
;;; Entry: A/ jfn
;;; Call: CALL MREAD		;Read from MAILING-LISTS.TXT
;;;       CALL FREAD		;Read from an @ file
;;; Return: +1
;;;	   B/ delimiter character

;;; Read a token from MAILING-LISTS.TXT, terminated by space or NL or tab
MREAD:	TXOA F,FL%MRD		;Flag reading from MAILING-LISTS.TXT
FREAD:	 TXZ F,FL%MRD		;Flag reading from user file
	SAVEAC <C,D>
REDTOP:	MOVE C,[POINT 7,STRBUF]	;Where to put it
	MOVEM C,ENDPOS		;Mark beginning of trailing spaces
	MOVEI D,STRSIZ		;Maximum size
	CALL WITTYI		;Flush initial whitespace
	SKIPA			;Already have first character
REDLUP:	 CALL FILTYI		;Get next character from file
REDLP1:	JUMPL B,REDRET		;Eof always terminates
	CAIN B,.CHCRT		;EOL terminates and flushes
	 JRST SKPWHT
	JUMPE B,SKPWHT		;Null terminates and flushes
	CAIN B,"-"              ;Do funny thing with dash
	 JRST RDDASH
	CAIN B,QUOTE
	 JRST REDQOT
	JXN F,FL%MRD,REDCKM
	CAIE B," "		;Tack on spaces for now to be amputated later
	 CAIN B,.CHTAB
	  JRST REDSPA
	CAIN B,","
	 JRST REDRET
	CAIE B,":"
	 JRST REDCHR
	LDB B,[POINT 7,STRBUF,6]
	CAIE B,"*"		;Unless a filespec,
	 JRST REDTOP		;Ignore atoms terminated by :
	MOVEI B,":"		;Otherwise the colon really does go in
REDCHR:	SOJL D,REDTLG
	IDPB B,C
	MOVEM C,ENDPOS
	JRST REDLUP

REDTLG:	HRROI B,[ASCIZ/Atom too long/]
	JRST IERROR

REDRET:	SETZ D,
	IDPB D,ENDPOS
	RET

REDCKM:	CAIE B," "              ;Space terminates and flushes trailing space
	 CAIN B,.CHTAB
	  JRST SKPWHT
	CAIN B,"="
	 JRST REDRET
	JRST REDCHR

REDQOT:	CALL FILTYI		;Saw quote.  Quotes are not included in buffer
	IFL. B
	  HRROI B,[ASCIZ/EOF in the middle of a string/]
	  JRST IERROR
	ENDIF.
	CAIE B,QUOTE		;Second quote?
	IFSKP.
	  CALL FILTYI		;Peek at next character
	  CAIN B,QUOTE		;Was it a doubled quote?
	ANSKP.			;Yes, insert single quote in string
	  MOVEM C,ENDPOS	;No, end of quoted string
	  JRST REDLP1		;Enter loop with next character in B
	ENDIF.
	SOJL D,REDTLG		;No, insert quoted character into buffer
	IDPB B,C
	JRST REDQOT

;;;Skip trailing whitespace, enter SKPWHT with terminator in B
SKPWHT:	MOVE D,B		;Keep track of whether we get a CR
	DO.
	  CALL FILTYI		;Get a byte
	  CAIE B," "		;Space?
	   CAIN B,.CHTAB	;Or TAB?
	    LOOP.		;Yes, skip to next
	  JUMPE B,TOP.		;Skip nulls
	  DO.
	    CAIN B,.CHCRT	;Remember if we get a CR
	     JRST SKPWHT
	    CAIE B,"-"		;Dash?
	    IFSKP.
	      CALL REDDS1	;Followed by CR is no-op, else is good char 
	    ANSKP.
	      MOVE B,D
	      JRST SKPWHT
	    ENDIF.
	    JUMPL B,REDRET	;Return EOF
	    CAIE B,";"		;Comment?
	    IFSKP.
	      CALL REDCM1	;Yes, flush and check terminator
	      LOOP.
	    ENDIF.
	    CAIN B,"!"		;Inline comment?
	    IFSKP.
	      CALL BCKTXT	;Back up over character
	      MOVE B,D		;And return saved CR or terminator
	      JRST REDRET
	    ENDIF.
	    CALL REDXC1		;Yes, flush
	    CAIE B,"!"		;Ended on matching excl?
	     LOOP.		;No, check terminator
	  ENDDO.
	  LOOP.			;Yes, get next character and continue
	ENDDO.

REDSPA:	CALL WITTYI		;Yes, eat white space
	JRST REDLP1		;Go look at the next character

RDDASH:	CALL REDDS1             ;On dash, check for EOL
	 JRST REDLUP
	JRST REDCHR

;;; Skip leading whitespace
WITTYI:	CALL FILTYI
	JUMPE B,WITTYI		;Ignore nulls
	CAIN B,.CHTAB
	 JRST WITTYI
	CAIE B," "
	 CAIN B,.CHCRT
	  JRST WITTYI
	CAIN B,";"
	 JRST REDCMT		;Read a comment
	JXN F,FL%MRD,R
	CAIN B,"!"
	 JRST REDXCL
	CAIN B,"-"
	 JRST REDDSH		;Check for - crlf
	RET

REDCMT:	CALL REDCM1		;Read the comment
	JRST WITTYI		;And skip more leading whitespce

;;;Read and drop until EOL
REDCM1:	CALL FILTYI
	JUMPL B,R
	CAIE B,.CHCRT
	 JRST REDCM1
	RET

REDXCL:	CALL REDXC1		;Read the comment
	JRST WITTYI		;And skip more leading whitespce

REDXC1:	CALL FILTYI		;Saw an !, read to matching ! or newline
	JUMPL B,R
	CAIE B,"!"
	 CAIN B,.CHCRT
	  RET
	JRST REDXC1

REDDSH:	CALL REDDS1
	 JRST WITTYI
	RET

REDDS1:	CALL FILTYI
	JUMPL B,REDDS2
	CAIN B,.CHCRT
	 RET
	CALL BCKTXT
REDDS2:	MOVEI B,"-"
	JRST CPOP1J

;;; Read a single character, returns -1 at EOF, Just 15 for CRLF
FILTYI: CAIG A,MAXJFN		;Reasonable JFN?
	IFSKP.
	  HRROI A,[ASCIZ/Illegal JFN at FILTYI/]
	  JRST ERROR
	ENDIF.
	ILDB B,JFNPTR(A)	;Get a byte
	CAIE B,.CHCRT
	IFSKP.
	  ILDB B,JFNPTR(A)	;Get a byte
	  CAIE B,.CHLFD		;Treat stray CR's as CRLF
	   CALL BCKTXT
	  MOVX B,.CHCRT
	ENDIF.
	CAIN B,.CHLFD		;Stray LF = CR
	 MOVX B,.CHCRT
	SKIPN B			;Assume a NUL only at EOF...
	 SETO B,
	RET

BCKTXT: CAIG A,MAXJFN		;Reasonable JFN?
	IFSKP.
	  HRROI A,[ASCIZ/Illegal JFN at BCKTXT/]
	  JRST ERROR
	ENDIF.
	SAVEAC <B>
	SETO B,
	ADJBP B,JFNPTR(A)	;Back up the pointer
	MOVEM B,JFNPTR(A)
	RET

OPNTXT: CAIG A,MAXJFN		;Reasonable JFN?
	IFSKP.
	  HRROI A,[ASCIZ/Illegal JFN at OPNTXT/]
	  JRST ERROR
	ENDIF.
	MOVEI B,FILPAG
	SKIPN FFP		;Initialized yet?
	 MOVEM B,FFP		;No, do so...
	MOVX B,<<FLD ^D7,OF%BSZ>!OF%RD>
	OPENF%
	 ERJMP R
	PUSH P,A
	SIZEF%			;Get file size (in C)
	 SETZB B,C
	MOVE B,FFP		;First page to use
	HRLZM B,JFNPAG(A)
	ADDM C,FFP		;Update first free page
	HRLI B,.FHSLF		;.FHSLF,,FFP as destination
	HRLZ A,A		;Put JFN,,0 as source address
	TXO C,PM%CNT!PM%RD!PM%PLD!PM%CPY
	PMAP%			;Map the pages
	IFJER.
	  POP P,A
	  HRROI A,[ASCIZ/Indirect file PMAP failed/]
	  JRST ERROR
	ENDIF.
	POP P,A			;get JFN back
	MOVE B,FFP
	SUBI B,1
	HRRM B,JFNPAG(A)	;Save last page used by thiss file
	HLRZ B,JFNPAG(A)	;First page
	LSH B,^D9		;Address
	HRLI B,(POINT 7)	;Make a byte pointer
	MOVEM B,JFNPTR(A)
	RETSKP

CLSTXT:	SAVEAC <C>
	CAIG A,MAXJFN		;Reasonable JFN?
	IFSKP.
	  HRROI A,[ASCIZ/Illegal JFN at OPNTXT/]
	  JRST ERROR
	ENDIF.
	PUSH P,A
	HLR B,JFNPAG(A)		;Starting page
	HRR C,JFNPAG(A)		;Ending page
	SUB C,B
	ADDI C,1		;Number of pages
	MOVE A,FFP
	SUB A,C
	MOVEM A,FFP		;save updated first free page.
	SETO A,
	HRLI B,.FHSLF
	PMAP%
	POP P,A
	CLOSF%
	 ERJMP R
	RETSKP

;;; Map binary file
MAPBIN:	CALL UMPBIN		;Toss out what might have been there before
	MOVX A,GJ%OLD!GJ%SHT!GJ%PHY ;Try to get binary file
	HRROI B,MLSBNM
	GTJFN%
	IFJER.
	  HRROI A,[ASCIZ/Cannot find mailing list binary file/]
	  RET
	ENDIF.
	PUSH P,A		;Save JFN
	MOVEI B,OF%RD		;Now try to open it
	OPENF%
	IFJER.
	  POP P,A		;Get back JFN
	  RLJFN%		;Flush it
	   NOP
	  HRROI A,[ASCIZ/Cannot open mailing list binary file/]
	  RET
	ENDIF.
	POP P,BINJFN		;Set BINJFN now that it's open
	MOVE B,[1,,.FBBYV]
	MOVEI C,BINSIZ
	GTFDB%
	HRLZ A,A
	MOVE B,[.FHSLF,,BINPAG]
	HRRZ C,BINSIZ
	HRLI C,(PM%CNT!PM%RD!PM%CPY)
	PMAP%
	MOVE A,BINFID
	CAMN A,[SIXBIT/MMLBX/]
	IFSKP.
	  CALL UMPBIN		;Unmap the sucker
	  HRROI A,[ASCIZ/Bad format binary file/]
	  RET
	ENDIF.
	MOVE A,BINJFN		;Return with JFN in A
	RETSKP

;; Unmap old binary
UMPBIN:	SETO A,			;Unmap old binary
	MOVE B,[.FHSLF,,BINPAG]
	HRRZ C,BINSIZ
	TXO C,PM%CNT
	PMAP%
	SKIPE A,BINJFN
	 CLOSF%
	  NOP
	SETZM BINJFN
	RET

;;; Read an address from the user into ADDRES
UREAD:	TMSG <Address: >
	HRROI A,ADDRES
	MOVE B,[RD%CRF+500]
	HRROI C,[ASCIZ/Address: /]
	RDTTY%
	IFJER.
	  HRROI B,[ASCIZ/RDTTY% failed/]
	  JRST JSYERR
	ENDIF.
	SETZ C,
	DPB C,A
	RET

; Here on JSYS error
JSYERR:	HRROI A,STRBF1		;Place for error string
	SETZ C,
	SOUT%
	HRROI B,[ASCIZ/ - /]
	SOUT%
	HRLOI B,.FHSLF
	ERSTR%
	 NOP
	 NOP 
IERR1:	HRROI A,STRBF1

;;; General error handler
ERROR:	MOVEM A,SUCCES		;Failure, give error message
	SKIPE HAVSUP
	IFSKP.
	  ESOUT%
	  TMSG <
>
	ENDIF.
	TXZN F,FL%CMP		;Compiling binary file?
	IFSKP.
	  MOVE P,CMPPDP		;Yes, restore stack as of compiling
	  CALL MAPBIN		;Map binary file back in
	   JRST DONE		;Can't, give up!
	  TMSG <[Using previous version of database]
>
	  RET			;A-okay
	ENDIF.
DONE:	HALTF%
	JRST GO

...LIT:	LIT

END <EVECL,,EVEC>

; Local Modes:
; Mode: MACRO
; Comment Start:;
; Comment Begin:;
; End: