Google
 

Trailing-Edge - PDP-10 Archives - T10_DECMAIL_MS_V11_FT1_860414 - 10,7/mail/ms/msfil.mac
There are 7 other files named msfil.mac in the archive. Click here to see a list.
;This software is furnished under a license and may only be used
;  or copied in accordance with the terms of such license.
;
;Copyright (C) 1979,1980,1981,1982 by Digital Equipment Corporation
;	       1983,1984,1985,1986    Maynard, Massachusetts, USA


	TITLE MSFIL - File related support routines for MS

	SEARCH GLXMAC,MSUNV,MACSYM
TOPS20<	SEARCH MONSYM>
	PROLOG (MSFIL)

	CPYRYT
	MSINIT

	.DIRECTIVE FLBLST
	SALL

IFNDEF MHACK,<MHACK==0>		; BLISS hack switch

;Define globals

	GLOBS			; Storage
	GLOBRS			; Routines


;Internal routines
	INTERNAL CHECK0,CLOSEF,EXPUNG,GET1,GETFIL,GETHLP,GETJF2,GETLPT
	INTERNAL GETNEW,GETOUT,GETPRS,LPTMSG,MOVMSG,PARSEF,PUTMSG
	INTERNAL REMAP,SETREF,SETSFL,SHRAGN,UPDBIT,XCLENQ
TOPS20<	INTERNAL CLSJF2,UNMAPF>
TOPS10<	INTERNAL FILERR>

;External routines in MS.MAC

TOPS20<	EXTERNAL CHECKM>
	EXTERNAL ALCFOB,CHECKT,CHKDEL,CLRCTO
	EXTERNAL CLRFIB,CMDRES,CRIF,CRLF,CTCLOK,CTCOK,DELMSG
	EXTERNAL FNDCC,FNDDAT,FNDFRM,FNDMID,FNDREF,FNDRRR,FNDSDT
	EXTERNAL FNDSND,FNDSUB,FNDTO,FSCOPY,FSPEC0,MOVST0,MOVSTR
	EXTERNAL RECEN0,SSEARC,SUMMRY
	EXTERNAL UNSEEN, NFLAGD, NDELET
TOPS10<	EXTERNAL CHECKS,ECHOON,FILCRV,FILOPB,LKB,MSGA1,MSGSTR,MSIOWD
	EXTERNAL MYPPN,PBLOCK,RDELAY,MSGFD,ATTBLK,LOKAPP>

;External storage in MS.MAC
	EXTERNAL  CJFNBK,CRFPRT,CRFDIR,ENQBLK,FILPGM,FILPGS,FILSIZ,FILWRT,FLAGS2
	EXTERNAL  HLPTXT,IDXNUM,IDXSAV,LASTRD,MBOT,MSGFAD,MSGIFJ,MSGJF2
TOPS20< EXTERNAL  GTJFN2,JF2BUF,IDXFIL>
	EXTERNAL  MSGPAG,MSGSSQ,MTOP,OUTFOB,RELFOB,WBOT,WTOP,WWIDH



SUBTTL GETHLP - read help file

GETHLP:	STKVAR <<HLPFOB,2>,HLPIFN>
	MOVEI A,FDXSIZ		; Allocate an FD
	$CALL M%GMEM		;  ..
	JUMPF GTHLPE		; No room
	HRLZM A,.FDLEN(B)	; Stuff length
   TOPS20<
	HRLI A,[ASCIZ /HLP:MS.HLP/]
	HRRI A,.FDSTG(B)	; Point to filespec area
	BLT A,FDXSIZ-1(B)
   >
   TOPS10<
	MOVE A,[SIXBIT /HLP/]	; Init filespec
	MOVEM A,.FDSTR(B)
	MOVE A,[SIXBIT /MS/]
	MOVEM A,.FDNAM(B)
	MOVE A,[SIXBIT /HLP/]
	MOVEM A,.FDEXT(B)
   >;End TOPS10
	MOVE A,B		; Set up for ALCFOB
	CALL ALCFOB		; Allocate and link FOB
	 JRST GTHLPE		; No room
	MOVX C,FB.LSN		; Don't try to strip LSN's here
	ANDCAM C,FOB.CW(B)	;  ..
	DMOVEM A,HLPFOB		; Save FOB addr and size
	$CALL F%IOPN		; Open help file for input
	JUMPF [	MOVE A,1+HLPFOB		; Point to FOB
		MOVE A,FOB.FD(A)	; Point to FD for error message
		$TEXT (KBFTOR,<%Can't read help file ^F/(A)/ because: ^E/[-1]/>)
		JRST GTHLP9]
	MOVEM A,HLPIFN		; Save IFN
	MOVX B,FI.SIZ		; Get length of file in bytes
	$CALL F%INFO
	ADDI A,<1000*5>-1	; Round up
	IDIVI A,<1000*5>	; Compute pages needed
	$CALL M%AQNP		; Snarf them
	JUMPF [	WARN (Can't read help file -- insufficient memory)
		RET]
	LSH A,^D9		; Compute address of block of pages
	HRLI A,(POINT 7,)	; Form byte pointer
	MOVEM A,HLPTXT		; Save
	MOVE D,A		; Better AC
;	JRST GETHP0
GETHP0:	MOVE A,HLPIFN
	$CALL F%IBUF		; Get next chunk
	JUMPF [	CAIE A,EREOF$		; EOF?
		JRST [CMERR (Can't read help file)]
		SETZ A,			; Insure ASCIZ
		IDPB A,D		; ..
		MOVE A,HLPIFN		; Get IFN back
		$CALL F%REL		; Close file
		JRST GTHLP9]
   TOPS10<			; *** Dumb GLXLIB bug patch
	TLNN B,770000		; Bogus byte pointer returned?
	TLO B,010000		; Yes, fix it up then
   >;End TOPS10
	MOVE C,A		; Byte count
	MOVE A,B		; Pointer to buffer just read
	MOVE O,D		; Destination
	CALL FSCOPY		; Move those bytes
	MOVE D,O		; Retain updated destination pointer
	JRST GETHP0		; Do for all hunks


;Here if no room for chunks

GTHLPE:	WARN (Can't read help file -- insufficient memory)


;Here to release chunks

GTHLP9:	DMOVE A,HLPFOB
	CALLRET RELFOB

SUBTTL GET command support code

;Here from GET command, with B pointing to JFN or FD for TOPS10
; to open a message file

GET1::	STKVAR <NEWJFN,<OLDPGS,5>>
	MOVEM B,NEWJFN		; Save the jfn away
	MOVEI A,OLDPGS		; Save old FDB info
	HRLI A,FILPGS
	BLT A,4+OLDPGS
	MOVE A,NEWJFN		; Do this before OPENF so LASTRD is correct
   TOPS20<
	CALL SIZFIL		; Get the size of the file, etc.
	 JRST GETER1		; Something is not-quite-right
	MOVE A,NEWJFN		; Get JFN back
	MOVX B,OF%RD!OF%FDT	; Force read date/time update
	OPENF
	 JRST GETERR		; Woops, he goofed
	PUSH P,LASTRD		; Save read date-time
	CALL SIZFIL		; Re-check file length, now that it's open
	 JRST [	WARN <Can't determine size of message file>
		MOVE A,NEWJFN		;
		CALL CJFNS		; Close the new file
		POP P,LASTRD		; Restore read date
		JRST GETER2]
	POP P,LASTRD		; Restore read date
	SKIPN FILSIZ		; Is the new file empty?
	JRST [ MOVE A,NEWJFN		; Yes, indicate so
	       CIETYP ( There are no messages in %1J.)
	       MOVE A,NEWJFN		;
	       CALL CJFNS		; Close the new file, release JFNs
	       JRST GETER2]		; Restore old file size info
	MOVE B,NEWJFN		;

;Note, if F%MOD is turned on, this file is opened as READ only
	CALL GTSJFN		; Open the new file as READ/WRITE
	JRST [ MOVE A,NEWJFN
	       CALL CJFNS		; Could not open as READ/WRITE
	       JRST GETER2]		; Restore old file size info
   >;End TOPS20
   TOPS10<
	MOVE A,NEWJFN		; Get FD pointer back
	CALL INILKB		; Init LOOKUP/ENTER block
	CALL FILOPR		; Open for read
	 JRST [	CALL FILERR		; Type appropriate error message
		CALL CLRCTO		; Clear ctrl-O
		$TEXT (KBFTOR,<%Can't open message file ^F/@NEWJFN/>)
		MOVEI A,^D10		; Insure user gets ten seconds
		CALL RDELAY		;  to read this message
		JRST GETER1]		; Clean up and quit
	SETOM LOKAPP		; We don't have an append interlock now.
	EXCH A,NEWJFN		; Remember IFN, get FD address back
	HLRZ B,.FDLEN(A)	; Get length of FD
	HRLZ A,A		; Form BLT ptr to copy to safe place
	HRRI A,MSGFD		; Here's where it'll go
	ADDI B,MSGFD-1		; Last address to move
	BLT A,(B)		; Move it
	CALL SIZLKB		; Get FILSIZ, etc. from LOOKUP block
	  JFCL			; Account for always skip return
   >;End TOPS10
	; ..
	; ..

;.GET continued...

TOPS20<	CALL UNMAPF >		; Flush current message file
	PUSH P,F		; Preserve F%MOD
	CALL CLOSEF		;  close old JFN
	POP P,F			;  ..
TOPS20<	MOVE A,GTJFN2		; Get the new READ/WRITE JFN
	MOVEM A,MSGJF2		; Place in the usual place
	SETZM GTJFN2 >		; No longer in use
	MOVE A,NEWJFN		;  and setup new JFN
	MOVEM A,MSGJFN
	CALL GETFLL		; Go parse and do magic
TOPS10<	SKIPG MSGJFN		; Did we win a file?
	 JRST GETER1 >		; No, release stray JFN and quit
	SETZM LCNT		; Clear the count of msgs in last sequence
	SETOM MSGSSQ		; And the last list too, just in case
	TXO F,F%F1		; Maybe want headers (for MOD)
	TXNN F,F%AMOD		; No headers of auto MOD
	TXNN F,F%MOD		; If MOD hack - print headers
	TXZ F,F%F1		; No headers, but get new
;	TXZE F,F%F2		; Skip headers (expunge just done)?
;	JRST GET2		; Yes, don't type stuff
	TXNN F,F%AMOD		; No summary if auto MOD
	CALL SUMMRY		; And a summary of the files contents
GET2:
TOPS10<	CALL ECHOON >		; In case monitor command
	RET

GETERR:	JRETER (Can't open message file)
GETER1:
   TOPS20<
	MOVE A,NEWJFN		; Flush new jfn (old file still intact)
	RLJFN
	 JFCL
   >;End TOPS20
   TOPS10<
	MOVEI A,MSGFD		; Re-init LOOKUP/ENTER block
	CALL INILKB		;  ..
   >;End TOPS10
GETER2:	MOVEI A,FILPGS		; Restore file size poop
	HRLI A,OLDPGS
	BLT A,FILPGS+4
	TXZ F,F%MOD		; Turn off MOD
	JRST GET2		; Clean up and quit

SUBTTL EXPUNGE support code

SYSWRN:				; for neatness in code on this page
TOPS10<	WARN (Use the command GET STD:MAIL.TXT to expunge messages)>
TOPS20<	WARN (Use the command GET POBOX:<SYSTEM>MAIL.TXT to expunge messages)>
	RET

EXPUNG::SKIPN NDELET		; If there aren't any deleted messages
	 RET			; We can leave work early
	TXNE F,F%MOD		; MOD hack? (System mail?)
	 JRST SYSWRN		; Issue warning msg and quit

; Initialization for Expunge

	TRVAR <MMSGPG,MMSGDX,MWRTOP,MWRBOT,PR1,PR2,PR3,NPCNT,WRADR,WRTOP,WRBOT,WRPAG,WRPGN,WVOL>
EXPN03:	SETZB L,M		; Zero offset, start with first msg
 	CALL CTCLOK		; Yes, prevent ^C from stopping this scramblage
 	 JRST [	WARN <Cannot expunge deleted messages - another reader exists>
 		RET]		; Quit now
TOPS10<	MOVE A,MSGJFN		; Prevent incoming mail while this goes on
	CALL APPNQ0		;  ..
	 JRST [	WARN (Cannot expunge deleted messages - mail is arriving)
		CALL CTCOK
		RET]
	CALL CHECK0		; See if any new mail
	 JRST EXPN02		; None exists, no problem
	CALL CTCOK		; Oops, some arrived -- release expunge lock
	CALL APPDEQ		; Release append interlock
	CALL CLOSEF		; Better go reparse it all
	MOVEI B,MSGFD		; Read file again
	TXO F,F%AMOD		; (Crock - sigh) don't type summary
	CALL GET1		; To prevent loss of new messages
	TXZ F,F%AMOD
	JRST EXPN03		; OK, try it again
>;End TOPS10

EXPN02:	MOVE A,NDELET		; Number of deleted messages
	SOS A			; Number of deleted messages with zero offset
	CAMN A,LASTM		; Have we deleted all the messages?
	 JRST EXPDEL		; Yes, then go delete the file
	CALL GETJF2		; Get write JFN so no one interferes
	 JRST [	WARN <Can't open file for write, so cannot expunge>
		CALL CTCOK		; Unlock file
TOPS10<		CALL APPDEQ >
		RET]
; Get pages for writing

 	$CALL M%FPGS		; How many pages do we have free?
	MOVE B,A
	SUBI B,MSGIDN
 	JUMPLE B,[ WARN (Can't get pages for expunging)
TOPS20<		   CALL CLWJFN >	; Close the READ/WRITE JFN
;			(CLSFL2,RELJF2,CTCOK,APPDEQ AND MAYBE MORE)

 	       	  RET]
	CAMLE B,WWIDH		; If too much
	MOVE B,WWIDH		; Be modest
 	MOVE A,B 		; Take them
	MOVEM B,WRPGN		;
	IMULI B,5000		; Write window volume
	MOVEM B,WVOL
TOPS10<	SETZM WRBOT		; Init the write window bottom
	SOS B			; and
	MOVEM B,WRTOP		; top
>
	$CALL M%AQNP
	MOVEM A,WRPAG		; Page number
	ASH A,^D9		; Address
	MOVEM A,WRADR
TOPS10<	CALL CHECKT>		; In case new mail
TOPS20<	CALL CHECKM>		; In case new mail
	SETZB X,MMSGDX		; Init count of bytes saved
	CITYPE < Expunging deleted messages >	; Type message
	$CALL K%FLSH		; This can take a while
	SETZB O,V		; Init pointer to output area

;Main expunge loop starts here

EXPN00:	MOVX A,M%DELE		; Deleted bit
	GTMBL (M,B)		; Get ptr to message block
	TDNN A,MSGBTS(B)	; Is it deleted?
	 JRST EXPN20		; No, must save it

EXPN10:
TOPS20<	JUMPN L,EXPN15
	MOVE V,X
	MOVE O,V
	PUSH P,B
	CALL WRMAP
	POP P,B
EXPN15:	>
	MOVE A,MSGALN(B)	; Get length of deleted msg
	SUB L,A			; Increment count of byte offset
	JRST EXPN30		; And go process next msg
;Message is NOT deleted, save it

EXPN20:	MOVE C,MSGALN(B)	; Length of message
	ADD X,C			; Keep track of total
TOPS20<	JUMPE L,EXPN30 >	; If no bytes deleted yet, no moving
	MOVE V,MSGALL(B)	; Get starting byte of message
	MOVNM C,PR3		;STORE CHAR COUNT
	MOVEM V,PR1		;SAVE CHAR POINTERS
	MOVEM O,PR2
	TRNA
EXP19:	MOVN C,C		; Make C positive
EXP21:	CALL GTBFL		;MAKE IT NOT SLEEPING
	CAML O,WRBOT
	CAMLE O,WRTOP
	CALL WRMAP
	MOVE B,WTOP
	SUB B,V			;ARE WE ALL RIGHT IN TERMS OF READING ?
	AOS B
	CAMGE B,C
	MOVE C,B		;NO, TAKE AS MUCH AS POSSIBLE NOW
     	MOVE B,WRTOP
	SUB B,O			;HOW ABOUT WRITING ?
	AOS B
	CAMGE B,C		;DO SAME TRICK
	MOVE C,B
	SUB O,WRBOT
	EXCH V,O
	MOVE A,WRADR
	IMULI A,5
	ADD V,A
	CHR2BP			; Get byte pointer to WRITE AREA
	EXCH A,O		;POINTER TO O, V TO A
	MOVE V,A
	SUB V,WBOT
	MOVE A,MSGFAD
	IMULI A,5
	ADD V,A
	CHR2BP			; Get byte pointer to READ AREA
	ADDM C,PR3		;CORRECT BYTE NUMBER LEFT
	ADDM C,PR2		;AND CHAR POINTER
	ADDM C,PR1
	CALL FSCOPY		; Do a fast string copy
	MOVE V,PR1		;RESTORE CHAR POINTERS
	MOVE O,PR2
	SKIPE C,PR3		; All done?
	JRST EXP19		; No
;	JRST EXP22		; Yes, proceed
EXP22:	GTMBL (M,B)		; Get ptr to message block
	ADDM L,MSGALL(B)	; Update positions
	ADDM L,MSGBOD(B)
	SKIPE MSGSND(B)		; Sender:
	 ADDM L,MSGSND(B)	;
	SKIPE MSGSUB(B)		; Subject
	 ADDM L,MSGSUB(B)
	SKIPE MSGFRM(B)		; From:
	 ADDM L,MSGFRM(B)
	SKIPE MSGTO(B)		; To:
	 ADDM L,MSGTO(B)
	SKIPE MSGCC(B)		; Cc:
	 ADDM L,MSGCC(B)
	SKIPE MSGMID(B)		; Message Id:
	 ADDM L,MSGMID(B)
	SKIPE MSGREF(B)		; References:
	 ADDM L,MSGREF(B)

EXPN30:	CAMGE M,LASTM		; At the last msg?
	 AOJA M,EXPN00		; No, do next then
TOPS10<	MOVE A,X		; Get the number of bytes saved
	CALL SIZEXP		; And update all the appropriate information
	 JFCL >			; Simply cannot happen
TOPS20<	MOVE B,X		; See how many pages touched
	IDIVI B,BY2PAG
	SKIPE C
	 AOS B
	MOVEM B,NPCNT		; Save new count for later
>
	SETZB B,D		; Make a null in case needed
	MOVE V,X		; Form byte ptr to last byte unfilled
	SUB V,WRBOT
	MOVE C,WRADR 		; First word in message file
	IMULI C,5		; First byte
	ADD V,C			; Plus bytes OK gives last unfilled
	CHR2BP			;  ..
EXPN31:	TLNN A,760000		; Have we zapped to a word boundary?
	JRST EXPN35		; Yes, we're OK then
	IDPB B,A		; No, zero rest of this word
	AOJA D,EXPN31		; Count nulls added and pad to word boundary
EXPN35:
TOPS20<
	CALL UNMAPF		; Release the read window, and
	CALL UNMAP		; release the write window to prevent PMAP error
	HRRZ C,FILPGS		; Number we had mapped to start
	SUB C,NPCNT		; Less number touched
	JUMPE C,EXPN36		; All pages touched
	SETO A,
	HRLI C,(PM%CNT)
	HRLZ B,MSGJF2		;  in the file
	HRR B,NPCNT		; Start here
	PMAP			; ...
	 ERJMP EXPNER		; Pages mapped elsewhere
>;End TOPS20

TOPS10<
	MOVE B,X		; Get bytes to write
	SUB B,WRBOT		; And subtracting what has gone before
	ADDI B,4		; Force roundup
	IDIVI B,5		; Compute words
	CALL EXPOUT		; Write these bytes out
>;End TOPS10

	; ..
	; ..

EXPN36:
   TOPS20<
	MOVE B,NPCNT		; Get back count of pages touched
	HRRM B,FILPGS		; Set up new count of pages
	MOVE A,MSGJF2
	HRLI A,.FBSIZ
	SETO B,
	MOVE C,X		; Update byte count
	CHFDB
	 ERJMP [JWARN (Can't set byte count for message file)
		JRST .+1]
	LDB B,[POINT 6,FILPGS,11]	; Get byte size
	CAIN B,7		; If not 7,
	 JRST EXPN32
	HRLI A,.FBBYV		; Make it be
	MOVSI B,(FB%BSZ)
	MOVSI C,(7B11)
	CHFDB
	 ERJMP [JWARN (Can't set byte size for message file)
		JRST EXPN32]
;	JRST EXPN32
>;End TOPS20
; Here to update Message Index
EXPN32:	SETZB X,M		; Update message numbers
	SKIPGE MSGIFJ		; More than 512 messages?
	IFNSK.			; No skip if < 512
	 SETZM MWRBOT		; Zero bottom boundary
	 MOVEI A,777		; Set upper boundary
	 MOVEM A,MWRTOP		; To 777 (511.) messages
	 MOVEI A,MSGIDX		; Set up size of a window
	 MOVEM A,MMSGDX		; And save it here
	ELSE.			; Otherwise, if > 512 messages
TOPS10<	 halt >
tops20<	 MOVEI A,MSGIDN		; Ask for this many pages
	 $CALL M%AQNP		; Ask GLXLIB
	 JUMPF [ WARN <Expunge failed due to insufficient memory.>
		 MOVE A,WRPGN	; Release the previously acquired memory
		 MOVE B,WRPAG	;
		 $CALL M%RLNP	;
		 CALL CLSJF2	; Close EXPUNGE JFN
		 JRST RELJF2 ]	; Punt
	 MOVEM A,MMSGPG		; Save Page number of buffer
	 ASH A,^D9		; Make it into an address
	 MOVEM A,MMSGDX	>	; And save that too.
	ENDIF.			; All done
EXPN41:	GTMBL (M,B)		; Get ptr to message block
;Here we have old message number M, about to be deleted or become message
; number X. Fix the SAME array accordingly.
	MOVE	C,[POINT 18,MSGSSQ]
	SKIPA	D,C
DRPSAM:	IDPB	A,D
FIXSAM:	ILDB	A,C
	CAIN	A,-1
	JRST	ALLFXD
	CAIE	A,(M)		;REFERENCE TO CURRENT MESSAGE?
	JRST	DRPSAM		;NO, LEAVE IT ALONE FOR NOW
	MOVX	A,M%DELE	;YES, SEE IF DELETED
	TDNN	A,MSGBTS(B)	;IF DELETED, NEGLECT TO WRITE IT BACK
	IDPB	X,D		;(POSSIBLY) CHANGED, WRITE NEW VALUE IN
	JRST	FIXSAM
ALLFXD:	IDPB	A,D
	MOVX A,M%DELE
	TDNE A,MSGBTS(B)	; Deleted?
	 JRST EXPN42		; Yes, skip it then
	CAMN X,M		; No, still none deleted?
	 AOJA X,EXPN42		; Yes, keep looking
	SKIPE MMSGDX		; Is there an index window?
	 JRST EXMOVE		; No, don't map it
tops10<	halt >
tops20<
EXPP1:	MOVE A,X
	TRZ A,777
	MOVEM A,MWRBOT
	MOVE B,A
	ADDI B,777
	MOVEM B,MWRTOP
	ASH A,^D-9
	IMULI A,MSGIDN		;FILE PAGE NUMBER
	HRL A,MSGIFJ
	MOVE B,MMSGPG
	HRLI B,.FHSLF		;PROCESS DATA
	MOVEI C,MSGIDN
	HRLI C,(PM%CNT!PM%WR)	;GET THE PAGES
	PMAP
>
EXMOVE:	MOVE A,X		;WRITE MESSAGE NUMBER
	CAML A,MWRBOT
	CAMLE A,MWRTOP
tops20<	JRST EXRMP >		;REMAP IF NOT GOOD
tops10< halt >
	SUB A,MWRBOT
	IMULI A,MSGIDN
	ADD A,MMSGDX		; Write address in A
	GTMBL (M,B)		; get index for read
	HRL A,B
	HRRZ B,A
	ADDI B,MSGIDN-2
	BLT A,(B)		;MOVE IT
	AOJA X,EXPN42		; No, move this msg's data down n places, where

TOPS20<
EXRMP:	SETOM A			;UNMAP OLD PAGES
	MOVE B,MMSGPG
	HRLI B,.FHSLF
	MOVEI C,MSGIDN
	HRLI C,(PM%CNT)
	PMAP			;UNMAP
	JRST EXPP1		;GET NEW PAGES
>
EXPN42:	CAMGE M,LASTM		; Done?
	 AOJA M,EXPN41		; No, step to next message
	SOJ X,
	MOVEM X,LASTM		; Yes, update new count
	MOVE M,X		; And current message #
TOPS20<	PUSH P,LASTRD		; Don't hack last read date
	CALL UNMAP		;UNMAP PAGES
	HRRZ A,MSGJF2		; Write JFN
	CALL SIZFIL		; Update knowledge of file size
	 WARN <Internal error - SIZFIL failed at EXPN42>
	POP P,LASTRD
>
	$TEXT (KBFTOR,<- OK>)	; Type reassurance
	CALL CLSJF2		; And go close it up
	MOVE A,WRPGN
	MOVE B,WRPAG		;RELEASE THE MEMORY
	$CALL M%RLNP
tops20<
	SKIPGE MSGIFJ		;DO WE HAVE INDEX FILE ?
	JRST EXPNGT		; And REG-GET the file
	SETOM A
	MOVE B,MMSGPG
	HRLI B,.FHSLF		;YES, UNMAP PAGES
	MOVEI C,MSGIDN
	HRLI C,(PM%CNT)
	PMAP
;	JRST EXPNGT		;NOW REPARSE FILE FROM THE 'M' MESSAGE

EXPNGT:	HRROI A,STRBUF
	MOVE B,MSGJFN		; One we do have
	SETZ C,
	JFNS
	MOVSI A,(GJ%OLD!GJ%SHT)
	HRROI B,STRBUF
	GTJFN
	 ERJMP [JRETER (Cannot get second JFN on file)
		RET]
	TXO F,F%AMOD
	MOVE B,A		; Put JFN in the right AC for GET1
	CALL GET1
	TXZ F,F%AMOD
	RET
>;End TOPS20

TOPS10<	CALL APPDEQ		; Release append interlock
	CALL CLOSEF		; Close first opening as well
	TXO F,F%F2		; Don't type status of file
	MOVEI B,MSGFD		; Point to FD we used to open this file
	CALL GET1		; Get and parse file again, and return
	TXZ F,F%F2		; Remember to turn this off
	RET			; Home, James
;				  Ideally we would call parsef.....
;	CALLRET PARSEF		; Reparse the file from 1st message that moved


EXPOUT:	MOVNS B			; Negate for IOWD
	HRLZS B			; Position for same
	HRR B,WRADR		; Address of buffer
	SUBI B,1		;  minus one
	MOVEM B,MSIOWD		; Store IOWD
	SETZM MSIOWD+1		; Tie off list
	MOVE B,[OUT MSIOWD]	; Instruction to write file
	MOVE A,MSGJF2		; Get channel for write
	LSH A,^D23		; Into right position
	IOR B,A			; Form complete instruction
	XCT B
	 RET			; OK
	  FATAL (Can't update message file during expunge)

>;End TOPS10
;Here when all messages deleted

EXPDEL:	CITYPE < All messages deleted, deleting file.
>
	CALL DEQFIL		; DEQ the lock on message file
   TOPS20<
	CALL UNMAPF
	MOVE A,MSGJFN		; Close the message file
	TXO A,CO%NRJ		; But keep the JFN around
	CLOSF			; Close it
	 JWARN (Cannot close message file)
	MOVE A,MSGJFN		; Get the JFN back
	DELF			; Now delete the message file
	 JWARN (Cannot delete message file)
	CALL CTCOK
	SKIPG MSGIFJ		;DO WE HAVE BLOCK FILE ?
	JRST EXPNN 		;NO
	MOVEI B,MSGIDX
	ASH B,^D-9
	HRLI B,.FHSLF
	MOVEI C,MSGIDN
	HRLI C,(PM%CNT)
	SETOM A
	PMAP			;UNMAP PAGES
	HRR B,MMSGPG		;IN BOTH PLACES
	PMAP
	MOVEI A,MSGIDN
	$CALL M%RLNP		;RRELEASE THE MEMORY
	MOVX A,CO%NRJ
	HRRZ A,MSGIFJ
	CLOSF			; Close it
	 JWARN (Cannot close index file)
	MOVX A,DF%EXP		;EXPUNGE IT
	DELF
	 JRST .+1
	SETZM MBOT
	MOVEI A,777
	MOVEM A,MTOP

   >;End TOPS20

   TOPS10<
	CALL CLSJF2		; Close second opening, if any
	CALL APPDEQ		; Release append interlock
	MOVE A,MSGJFN		; Get channel of first opening
	LSH A,^D23		; Get into AC field
	TLO A,(CLOSE)		; Close it first
	XCT A			;  ..
	HRL A,MSGJFN		; Get channel again for FILOP.
	HRRI A,.FODLT		; Delete function
	MOVEM A,FILOPB+.FOFNC	; Stuff into FILOP. block
	MOVEI A,.RBTIM		;Set up length of lookup block again
	MOVEM A,LKB		;Because we read a RIB over it.
	MOVE A,[.FOPPN+1,,FILOPB]
	FILOP. A,
	 WARN (Cannot delete message file)
   >;End TOPS10

EXPNN:	SETOM MSGJFN		; Mark that we have no JFNs
TOPS20<	SETZM MSGJF2>
TOPS10<	SETOM MSGJF2>
	SETOM MSGIFJ
	SETZM WBOT
	SETZM WTOP
	RET

   TOPS20<

; Here if expunge lost

EXPNER:	$STOP (BFD, Bad Filepage Delete)
	CALL UNMAPF
	CALL UNMAP 		; Unmap all pages
	CALL CLSJF2		; Close file
	CALL RELJF2		;  and release JFN
	CALL GETFIL		; Re-read and parse mail file
	RET			; Return

   >;End TOPS20

TOPS10<

APPNQ0:	AOSE	LOKAPP		; Do I already have the interlock?
	  RETSKP		; Yes, don't get it again
	TXO A,EQ.FBL		; Suppress level numbers
	MOVEM A,APPBLK+.ENQFL+.ENQRI+1
	MOVE A,[.ENQAA,,APPBLK]
	ENQ. A,
	 JRST	[SOS LOKAPP	;DIDN'T GET IT, FIX COUNT
		 RET]		; Probably another writer
	RETSKP			; Win!!

;Release the append lock

APPDEQ:	SOSL	LOKAPP		; Count depth of lock
	  RET			; Someone higher than me still has it
	SETOM	LOKAPP		; Just in case...
	MOVE A,[.DEQID,,APPQID]
	DEQ. A,
	 WARN (Can't release message file append interlock)
	RET
>;End TOPS10

; ROUTINE MAPS PROCESS TO THE WRITE FILE ACCORDING TO O

WRMAP:
TOPS10<	MOVE B,O		; Save new bottom of
	MOVEM B,WRBOT		; the write window
	ADD B,WVOL		; And compute new
	SOS B			; top of the
	MOVEM B,WRTOP		; write window
	MOVE B,WVOL		; Bytes written
	IDIVI B,5		; Make that words
	CALLRET EXPOUT		; Output them and return
>;End TOPS10

TOPS20<	PUSH P,C		;IMPORTANT
	SKIPE L			;IF NOT FIRST ENTRY
	CALL UNMAP		;UNMAP STUFF
	MOVE B,O		;BYTE NUMBER
	IDIVI B,5000		;FILE PAGE NUMBER
	MOVE A,B		;SAVE IT
	IMULI B,5000		;WRITE WINDOW BOTTOM CHAR POINTER
	MOVEM B,WRBOT		;SAVE IT
	ADD B,WVOL 		;TO CONTROL WRITING
	SOS B
	MOVEM B,WRTOP		;STORE IT
	MOVE C,WRPGN
	HRL A,MSGJF2		;AND JFN
	MOVE B,WRPAG		;PROCESS PAGE
	HRLI B,.FHSLF
	HRLI C,(PM%CNT!PM%WR!PM%PLD)
	PMAP			;MAP IT OUT
	POP P,C
	RET

UNMAP:	SETOM A
	MOVE B,WRPAG
	HRLI B,.FHSLF
	MOVE C,WRPGN
	HRLI C,(PM%CNT)
	PMAP
	RET
>
SUBTTL Expunge command - ENQ/DEQ Routines

;Get shared ENQ on message file (so potential expungers know not to)

SHRENQ:
   TOPS20<
	MOVSI A,(EN%SHR+EN%BLN)	; ENQ for shared access, ignore level numbers
	HRR A,MSGJFN		; Lock the message file
	MOVEM A,ENQBLK+.ENQLV	;  ..
	MOVEI A,.ENQAA		; Acquire the lock now
	MOVEI B,ENQBLK		; Address of arg block
	ENQ			; This should always work
	 ERJMPR	SHRENF
	RETSKP
SHRENF:	CAIN A,OPNX9
	 RET
	JCERR (Cannot lock message file)
   >;End TOPS20
   TOPS10<
	MOVE A,MSGJFN		; Get IFN of message file
	MOVX B,NQID		; Use standard ID
	MOVEM B,ENQBLK+.ENQRI	;  ..
	JRST SHRNQ1
SHRNQ0:	MOVX B,NQID+1		; Use alternate ID
	MOVEM B,ENQBLK+.ENQRI	;  ..
SHRNQ1:	IOR A,[EQ.FSR+EQ.FBL]	; ENQ for shared access, ignore level numbers
	MOVEM A,ENQBLK+.ENQFL+.ENQRI+1	; Save in ENQ. block
	MOVE A,[.ENQAA,,ENQBLK]	; Acquire the lock now, fail if can't
	ENQ. A,			;  ..
	 JRST [	CAIN A,ENQQE%		; Insufficient ENQ/DEQ quota?
		WARN (You have no ENQ-DEQ quota -- see your system administrator)
		RET]
	RETSKP
   >;End TOPS10
;Make existing shared lock exclusive, to prevent scramblage
;Returns +1: Another reader exists, can't scramble the bits
;	 +2: Success, we're only reader and now have file locked

XCLENQ:
   TOPS20<
	MOVSI A,(EN%BLN)	; Ignore level numbers, non-shared ENQ
	HRR A,MSGJFN		; JFN of message file
	MOVEM A,ENQBLK+.ENQLV	; Stuff into ENQ block
	MOVEI A,.ENQMA		; Modify existing lock (make exclusive)
	MOVEI B,ENQBLK		;  ..
	ENQ			;  ..
	 ERJMP R		; Can't - must be other readers
   >;End TOPS20

   TOPS10<
	CALL DEQFIL		; Cannot upgrade a lock, therefore give it away
	MOVE A,MSGJFN		; Get IFN of message file
	IOR A,[EQ.FBL]		; Ignore level numbers, exclusive access
	MOVEM A,ENQBLK+.ENQFL+.ENQRI+1	;  ..
	MOVX A,NQID		; Use standard ENQ ID
	MOVEM A,ENQBLK+.ENQRI	;  ..
	MOVE A,[.ENQAA,,ENQBLK]	; Get exclusive access
	ENQ. A,			;  ..
	 JRST [	CALL SHRENQ		; Probably another reader
		 JFCL			; Restore shared lock
		RET]			;  and return failure
   >;End TOPS10
	RETSKP			; Success
;Make existing, possibly exclusive, lock shared again

SHRAGN:
   TOPS20<
	MOVSI A,(EN%BLN+EN%SHR)	; Make ENQ shared again
	HRR A,MSGJFN		; JFN of message file
	MOVEM A,ENQBLK+.ENQLV
	MOVEI A,.ENQMA		; Modify access
	MOVEI B,ENQBLK
	ENQ			;  ..
	 ERJMP .+1		; We might not have obtained exclusive access
   >;End TOPS20
   TOPS10<
	MOVE A,MSGJFN		; Get IFN of message file
	IOR A,[EQ.FBL+EQ.FSR]	; Make shared, ignore level numbers
	MOVEM A,ENQBLK+.ENQFL+.ENQRI+1	;  ..
	MOVX A,NQID		; Use standard ENQ ID
	MOVEM A,ENQBLK+.ENQRI	;  ..
	MOVE A,[.ENQMA,,ENQBLK]
	ENQ. A,
	 JFCL			; Might already be shared
   >;End TOPS10
	RET


;Release the lock on a message file entirely

DEQFIL:
   TOPS20<
	MOVEI A,.DEQID		; Unlock file first
	MOVEI B,NQID		;  ..
	DEQ
	 ERJMPS	.+1
	RET
   >;End TOPS20

   TOPS10<
	SKIPA A,[.DEQID,,NQID]	; Release this specific lock
DEQFL0:	MOVE A,[.DEQID,,NQID+1]	; Alternate ID (for other users' mail files)
	DEQ. A,			;  ..
	 WARN (Cannot release lock on message file - error code %1O)
	RET
   >;End TOPS10

SUBTTL Routines to open output files and write messages to them

;GETOUT - Parse filespec and open for append
;GETNEW - Same, but open for write
;GETPRS - Parse filespec only, don't open

GETPRS:	TXO F,F%F2		; Note parse-only
GETNEW:	TXZA F,F%F1		; Note flavor
GETOUT:	TXO F,F%F1		;  ..
   TOPS20<
	MOVX A,GJ%MSG		; Just message
	MOVEM A,CJFNBK+.GJGEN
	SETZM CJFNBK+.GJNAM	; No default name
	HRROI A,CRFPRT		; Default protection
	SKIPE CRFPRT		;  if explicitly specified
	MOVEM A,CJFNBK+.GJPRO	;  ..
   >;End TOPS20

   TOPS10<
	SKIPN CRFDIR		; Default directory given?
	JRST GETOU0		; No
	MOVE A,[CRFDIR,,CJFNBK+.FDPPN]	; Yes, fill it in before parse
	BLT A,CJFNBK+FDXSIZ-1
>;End TOPS10
GETOU0:	MOVEI A,[FLDDB. (.CMCFM,,,,,[FLDDB. (.CMFIL,CM%SDH,,<filespec>)])]
	CALL FSPEC0		; Parse filespec and set up FOB
	 JRST [TXZ F,F%F2		; Don't leave bits lying around
	       RET]
	DMOVEM A,OUTFOB		; Remember this FOB
TOPS10<
	MOVEI A,ATTBLK		; Set up default protection
	SKIPE CRFPRT		; If we have used the SET DEF PROT command
	MOVEM A,FOB.AB(B)	;  then have GALAXY use it for the open.
>
	TXZE F,F%F2		; Only want to parse filespec?
	RETSKP			; Yes, just quit now
	MOVE C,[$CALL F%OOPN]	; Decide which open flavor to use
	TXNE F,F%F1		; Want append instead of clobber?
	MOVE C,[$CALL F%AOPN]	; Yes, do append call
	XCT C			; Open the file
	JUMPF [	MOVE A,OUTFOB+1		; Get FOB address
		MOVE A,FOB.FD(A)	; Point to FD for error message
		$TEXT (KBFTOR,<?Can't open ^F/(A)/ for write because: ^E/[-1]/>)
		SETZM OUTIFN
		DMOVE A,OUTFOB		; Deallocate chunks
		CALLRET RELFOB]		;  and return
	MOVEM A,OUTIFN		; Save IFN
	RETSKP

;Open LPT for output
;Return	+1: failure, message already printed
;	+2: success, IFN of printer in OUTIFN

GETLPT:	STKVAR <LPTFD>
	MOVEI A,FDXSIZ		; Allocate space for largest FD
	$CALL M%GMEM		;  ..
	JUMPF GETLPE		; No room
	HRLZM A,.FDLEN(B)	; Stuff length into FD
	MOVEM B,LPTFD		; Save address
	MOVE A,B

; This code ends up specifying /UNIT:0 by the time GALAXY gets around
; to actually printing the message.  There's no reason to limit MS
; listings to only unit 0, so....

REPEAT 0,<

   TOPS20<
	HRLI A,(POINT 7,)	; Form byte pointer
	ADDI A,.FDSTG		; Where filespec goes
	MOVEI B,[ASCIZ /LL:MS-Output.LST/]
	CALL MOVST0
	MOVE A,LPTFD		; Restore FD address
   >;End TOPS20
   TOPS10<
	DMOVE B,[SIXBIT /LL/
		 SIXBIT /MS-OUT/]
	DMOVEM B,.FDSTR(A)
	MOVE B,[SIXBIT /LST/]
	MOVEM B,.FDEXT(A)
   >;End TOPS10
	CALL ALCFOB		; Allocate and link FOB
	 JRST GETLPE		; No room
	DMOVEM A,OUTFOB		; Save address
	$CALL F%OOPN		; Open for write
	JUMPF GETLPX		; Hmmm...  go try LPT instead of LL
	MOVEM A,OUTIFN		; Save IFN
	RETSKP


GETLPX:	MOVE A,LPTFD		; Try LPT, LL didn't work

>	; End of REPEAT 0 to remove LL: code

   TOPS20<
	HRLI A,(POINT 7,)
	ADDI A,.FDSTG
	MOVEI B,[ASCIZ /LPT:MS-Output.LST/]
	CALL MOVST0
	MOVE A,LPTFD		; Restore FD address
   >;End TOPS20
   TOPS10<
	MOVE B,[SIXBIT /LPT/]
	MOVEM B,.FDSTR(A)
   >;End TOPS10
	CALL ALCFOB		; Allocate and link FOB
	 JRST GETLPE		; No room
	DMOVEM A,OUTFOB		; Save address
	$CALL F%OOPN		;  ..
	JUMPF [	DMOVE A,OUTFOB		; Don't lose chunks
		CALL RELFOB
		JRST GETLPE]
	MOVEM A,OUTIFN		; Save IFN
	RETSKP

GETLPE:	$TEXT (KBFTOR,<?Can't open LPT for output because: ^E/[-1]/>)
	RET			; Failure return
MOVMSG:	CALL CHKDEL
	 RET
	CALL PUTMS1
	SKIPN OUTIFN		; If file still open, PUTMS1 worked OK
	RET			; Oops, there was an error, don't delete it
	CALLRET DELMSG		; Move deletes message

LPTMSG:	CALL PUTMSG		; Put it out there
	MOVX A,M%DELE		; Skip for deleted messages
	GTMBL (M,B)		; Get ptr to message block
	TDNE A,MSGBTS(B)	;  ..
	 RET
	SKIPN A,OUTIFN
	RET			; Just quit if file went away
	MOVEI B,14		; Form feed
	$CALL F%OBYT
	RET


;PUTMSG - write message to a file, IFN in OUTIFN
; Constructs new header line from scratch, in case file damage
; has garbaged the one in the message file.  At worst, this will
; make a bad assumption about the message date (today, if real
; date can't be found)

PUTMSG:	CALL CHKDEL		; Not deleted msgs
	 RET
PUTMS1:	GTMBL (M,B)		; Get ptr to message block
	MOVE V,MSGBOD(B)	; Get start of the message body
	CALL SETSFL		; Make sure we are all right
	HRRZ A,MSGBTS(B)	; Get message bits
 	$TEXT (PUTMSW,<^H/MSGDAT(B)/,^D/MSGBON(B)/;^O12R0/A/>)
	SKIPN C,MSGBON(B)	; Length
	RET			; Zero length (file damage) -- don't write
	SKIPN OUTIFN		; Did $TEXT encounter error?
	JRST PUTERR		; Yes, quit now
PUTMS2:	CALL GTBFL
	AOS V
	MOVE B,A
	MOVE A,OUTIFN
	$CALL F%OBYT		; Write to the file
	JUMPF PUTERR
	SOJG C,PUTMS2		; Count down bytes
	MOVE A,OUTIFN
	$CALL F%CHKP		; Force buffers out
	JUMPF PUTERR		; Oops, report error

; This code ends up creating a second output file for the print/list commands
; so unless it breaks something else...

REPEAT 0,<
	MOVE A,OUTIFN		; OK, close the file
	$CALL F%REL		;  to force correct updating
	DMOVE A,OUTFOB		;  and reopen it
	$CALL F%AOPN		;  ..
	JUMPF PUTERR
	MOVEM A,OUTIFN

>	; End of Repeat 0

	RET

PUTMSW:	MOVE B,A		; Put byte in right AC for F%OBYT
	SKIPE A,OUTIFN		; Where to write this one
	$CALL F%OBYT
	JUMPF [	SETZM OUTIFN		; Flag error for caller
		RET]
	RET

;Here on error writing msg

PUTERR:	CALL CLRCTO		; Clear ctrl-O
	CALL CLRFIB		; Clear typehead
	MOVE A,FLAGS2		; Want sequence messages?
	TXNN A,F2%NSQ		;  ?
	JRST [	MOVE B,MSGSEQ
		ADD B,[POINT 18,0,17]
		CAME L,B
		CALL PRTSQS		; Yes, print close of sequence
		JRST .+1]
	SETOM LSTMSG		; Re-init message sequence printer state
	CALL CRIF		; Get to left margin
	$TEXT (KBFTOR,<?Cannot write message because: ^E/[-1]/>)
	SKIPE A,OUTIFN		; Abort file
	$CALL F%RREL		;  ..
	SETZM OUTIFN
	$TEXT (KBFTOR,<? Skipping messages: ^A>)
PUTER0:	MOVE A,FLAGS2
	TXNN A,F2%NSQ		; If not suppressing sequence display,
	CALL PRTSEQ		;  print start of sequence
	CALL NXTSEQ		; Skip to end of list
	 RET			; Return when done, SEQUE0 will do the PRTSQS
	JRST PUTER0
;Check to see if new mail has appeared
;Return	+1: no new mail
;	+2: new mail exists, caller should parse it

CHECK0:	SKIPG MSGJFN		; Have a file?
	 CALLRET CHKNEW		; No - see if new file appeared
	PUSH P,FILSIZ		; Save current size
	PUSH P,LASTRD		; Don't hack last read date/time
TOPS20<	MOVE A,MSGJFN >
TOPS10<	MOVEI A,MSGFD >
	CALL SIZFIL		; Get the current poop on it
	 JRST [	WARN (Can't determine existence of new mail)
		POP P,LASTRD
		POP P,(P)	; Clean PDL
		JRST CLOSEF]	; Return error
	POP P,LASTRD		; Restore last read date/time
	POP P,T			; Get back old size
	EXCH T,FILSIZ		; Restore old size, save new in t
	MOVE A,FILWRT
	CAMN T,FILSIZ		; File size changed?
	 RET			; No, nothing changed
	MOVEM T,FILSIZ		; Yes - store new size info
	RETSKP			;  and skip return

; Update last time the mail file was read

   TOPS10<

SETREF:	$CALL I%NOW
	MOVE C,A		; Save time
	$CALL I%NOW		; Wait for time to elapse
	CAMN C,A
	JRST .-2
	MOVEM A,LASTRD
	RET
   >

; Set read date-time for JFN in 1

   TOPS20<
SETREF:	PUSH P,A		; Save jfn
	$CALL I%NOW
	MOVE C,A		; Save time
	$CALL I%NOW		; Wait for time to elapse
	CAMN C,A
	JRST .-2
	MOVE C,A		; Set read date to now
	MOVEM C,LASTRD		; Update last time file was read
	POP P,A			; JFN to update
	HRLI A,.FBREF
	SETO B,			; Cause we are going to reparse
	CHFDB
	 ERJMP .+1		; Maybe no access, dont worry
	RET
   >;End TOPS20


;Check if MAIL.TXT has appeared

CHKNEW:	CALL GETFIL		; Has it?
	 RET			; Nope - return
	SETOM LASTM		; Flag for full parse
	SETZ M,			; Current message
	RETSKP

; Close the file

CLOSEF:	SKIPG MSGJFN		; Any message JFN?
	 JRST CLOSF1		; No, skip this
	CALL DEQFIL		; Release ENQ lock
	MOVE A,MSGJFN
TOPS20<	CLOSF			; Close it
	JRST [ CAIE A,CLSX1		; Closed already?
	       JWARN (Cannot close message file)
	       JRST .+1]		;
>
TOPS10<	CALL CLSFIL >		; Close it

	SKIPGE MSGIFJ		;DO WE HAVE BLOCK FILE ?
	JRST CLOSF2		;NO
;NEED STUFF HERE
TOPS20<
	MOVEI B,MSGIDX
	ASH B,^D-9
	HRLI B,.FHSLF
	MOVEI C,MSGIDN
	HRLI C,(PM%CNT)
	SETOM A
	PMAP			;UNMAP PAGES
	MOVX A,CO%NRJ
	HRR A,MSGIFJ
	CLOSF			; Close it
	 JWARN (Cannot close index file)
	MOVX A,DF%EXP		;EXPUNGE IT
	HRR A,MSGIFJ
	DELF
	 JRST .+1
	SETZM MBOT
	MOVEI A,777
	MOVEM A,MTOP
>
CLOSF2:	SETZM MSGIDX
	MOVE A,[MSGIDX,,MSGIDX+1]; Clean up index area
	BLT A,MSGIDX+MSGIDN*1000-1
	SETOM MSGIFJ
CLOSF1:	SETZM MSGSEQ
	SETOM MSGJFN
TOPS20<	SKIPN A,MSGJF2		; Is there a READ/WRITE JFN?
	 JRST CLOSF4		; No
	JUMPGE A,[		; Yes, is the READ/WRITE file open?
	  	RLJFN		; Release the JFN
		JWARN (Cannot release the second JFN on the message file)
		JRST CLOSF4 ]
	TXZ A,RWJFNO		; Turn off the open bit
	CLOSF			;
	JWARN (Cannot close the second JFN on the message file)
CLOSF4: SETZM MSGJF2 >		; No more READ/WRITE JFN
TOPS10<	SKIPLE A,MSGJF2		;
	CALL CLSJF2 		;
	SETOM MSGJF2 >		;
	TXZ F,F%AMOD!F%MOD	; Clear MOD hack bits
	RET
;Unmap pages from file

TOPS20<
UNMAPF:	SKIPN C,FILPGM
	  RET
	SETO A,
	HRRZ C,FILPGM
	MOVE B,MSGPAG
	HRLI B,.FHSLF
	HRLI C,(PM%CNT)
	PMAP
	SETZM FILPGM
	RET
>;End TOPS20
 SUBTTL File parsing subroutines

GETFIL:	CALL FNDFIL		; Try to find it first
	 RET			; Not there, forget it
TOPS10<
GETFLL:>			;
	SKIPN FILSIZ		; Is the file empty?
	JRST [	MOVE A,MSGJFN		; Yes, get JFN into A for message
TOPS20<		CIETYP ( There are no messages in %1J.)
		CALLRET CLOSEF]		;

>
TOPS10<		$TEXT (KBFTOR,<% There are no messages in ^F/MSGFD/>)
		LSH A,^D23		; Release message file channel
		IOR A,[RELEASE]
		XCT A

		SETOM MSGJFN
		RET]
>
TOPS20<	CALL GETJF2		; Open as READ/WRITE
	CALLRET CLOSEF		; Couldn't, quit now
GETFLL:>			;
	CALL SHRENQ		; Get shared ENQ on file
	 WARN (Can't lock message file)
	SETZM UNSEEN		; New message file so no new messages
	SETZM NDELET		; Or deleted
	SETZM NFLAGD		; Or flaged
	SETZ M,			; Must parse all messages
TOPS20<	CALL PARSEF		;
	CALLRET CLSJF2 >	; Close the READ/WRITE JFN
TOPS10<	CALLRET PARSEF >	; And return
; Try to find a MAIL.TXT

FNDFIL:
   TOPS20<
	MOVE A,[POINT 7,STRBUF]	; Get string pointer
	MOVEI B,[ASCIZ /POBOX:</]
	CALL MOVSTR
	MOVEI B,MYDIRS		; Login directory string
	CALL MOVSTR
	MOVEI B,[ASCIZ />MAIL.TXT.1/]
	CALL MOVST0
	MOVSI A,(GJ%OLD!GJ%SHT)
	HRROI B,STRBUF
	GTJFN
	 JRST FNDFL4
	MOVEM A,MSGJFN		; Save the jfn away
	CALL SIZFIL		; Before opening, to get last read correct
	 JRST CLOSEF		; Error message already printed
	MOVE A,MSGJFN		; Get JFN back again
	MOVEI B,OF%RD!OF%FDT	; Force read date/time update
	OPENF
	 JRST FNDFL5
	PUSH P,LASTRD		; Save last read date
	CALL SIZFIL		; Re-check file size, now that it's open
	IFNSK.			; No skip return is an error
	 POP P,LASTRD		; Restore stack
	 JRST CLOSEF		; And go close the file
	ENDIF.
	POP P,LASTRD		; Restore the last read date.
	RETSKP			; Skip return
   >;End TOPS20

   TOPS10<
	MOVEI A,MSGFD		; Message file FD
	MOVEI B,FDXSIZ		; Size of FD
	HRLZM B,.FDLEN(A)	; Store size
	MOVE B,[SIXBIT /DSK/]	; Get structure for MAIL.TXT
	MOVEM B,.FDSTR(A)	;  ..
	MOVE B,[SIXBIT /MAIL/]
	MOVEM B,.FDNAM(A)
	MOVE B,[SIXBIT /TXT/]
	MOVEM B,.FDEXT(A)
	MOVE C,MYDIR		; Point to my U-block
	MOVE B,UB.PPN(C)
	MOVEM B,.FDPPN(A)
	CALL INILKB		; Init FILOP.'s LOOKUP/ENTER block
	CALL FILOPR		; Open for read
	 JRST [	JUMPE A,R	; If not found, just quit
		CALL FILERR	; Else type FILOP. error message
		WARN <%Can't open message file>
		RET]
	MOVEM A,MSGJFN		; Save channel no. of message file
	CALLRET SIZLKB		; Get FILSIZ, etc. from LOOKUP block
   >;End TOPS10

   TOPS20<
FNDFL4:	SKIPG A,MSGJFN		; Get rid of stray jfns
	JRST FNDFLX		; None, I guess...
	RLJFN
	 JFCL

FNDFLX:	SETOM MSGJFN
	RET			; Return

FNDFL5:	CAIN A,OPNX2		; Empty file?
	JRST FNDFL4		; Yes - tread as non-ex
	CITYPE <% Cannot open MAIL.TXT.1>
	JRST FNDFL4
   >;End TOPS20
   TOPS10<

;INILKB - Init LOOKUP/ENTER block pointed to by FILOP. block
;Call:	A/ address of FD for file
;Return	+1: always

INILKB:	HLRZ B,.FDLEN(A)	; Get length of this FD
	CAIG B,.FDPPN+1		; Is there room for an SFD spec?
	JRST INILK1		; No, don't fetch crud then
	MOVE C,.FDPPN(A)	; Get PPN or path pointer
	TLNN C,-1		; Which flavor?
	JRST INILK2		; PPN, use it
	SETZM PBLOCK		; Path, zero path block
	MOVE C,[PBLOCK,,PBLOCK+1]
	BLT C,PBLOCK+7		;  ..
	HRLI C,.FDPPN(A)	; BLT the path block from the FD
	HRRI C,PBLOCK+2		;  to out path block
	ADDI B,PBLOCK+1-.FDPPN	;  ..
	BLT C,(B)		;  ..
	MOVEI C,PBLOCK		; Point lookup block at
	MOVEM C,LKB+.RBPPN	;  our path block
	JRST INILK3

INILK1:	MOVE C,.FDPPN(A)	; Move PPN
INILK2:	MOVEM C,LKB+.RBPPN	;  ..
INILK3:	MOVE B,.FDNAM(A)	; Name
	MOVEM B,LKB+.RBNAM	;  ..
	MOVE B,.FDEXT(A)	; Extension also clears access date
	MOVEM B,LKB+.RBEXT	;  and Hi order 3 bits of creation date
	MOVEI B,7777		; Clear low 12 bits of creation date
	ANDCAM B,LKB+.RBPRV	;  so it will not get reset
	MOVE B,.FDSTR(A)	; Structure name
	MOVEM B,MSGSTR		; Doesn't go in LOOKUP block
	MOVEI B,.RBTIM		; Length of block
	MOVEM B,LKB+.RBCNT	;  ..
	RET
;FILOPW - Open file for write (superseding)
;FILOPU - Open file for update, single-access
;FILOPR - Open file for read in multiple-access mode
;Call:	with LKB inited
;Return	+1: No channels left or file can't be opened
;	+2: OK, with channel in A

FILOPW:	MOVX A,.FOWRT		; Open for write only
	JRST FILOP0
FILOPU:	SKIPA A,[.FOSAU]	; Multiple access update
FILOPR:	MOVX A,.FORED		; Read
FILOP0:	HRRZM A,FILOPB+.FOFNC	; Stuff into FILOP. block
	SETZM LKB+.RBSIZ	; Zero unused stuff in LOOKUP/ENTER block
	MOVE B,[LKB+.RBSIZ,,LKB+.RBSIZ+1]
	BLT B,LKB+.RBTIM
	STKVAR <CHAN>
	$CALL F%FCHN		; Get a free channel
	JUMPF [	WARN <Can't open file, no free channels>
		RET]
	MOVEM A,CHAN		; Remember for later
	HRLM A,FILOPB+.FOFNC	; Stuff into FILOP. block
	MOVX A,.IODMP		; Dump mode
	MOVEM A,FILOPB+.FOIOS	;  ..
	MOVE A,MSGSTR		; Structure name
	MOVEM A,FILOPB+.FODEV	;  ..
	SETZM FILOPB+.FOBRH	; No buffers
	SETZM FILOPB+.FONBF	;  ..
	MOVEI A,LKB		; Point to LOOKUP block
	MOVEM A,FILOPB+.FOLEB
	SETZM FILOPB+.FOPAT	; No paths supported yet
	MOVE A,MYPPN		; Do access checking
	MOVEM A,FILOPB+.FOPPN	;  ..
	MOVSI A,(1B0)		; Light bit saying "use privileges"
	IORM A,FILOPB+.FOFNC	;  ..
	MOVE A,[.FOPPN+1,,FILOPB]
	FILOP. A,		; Open the file
	 JRST [	EXCH A,CHAN		; Save error code, fetch channel
		CALL CLSFIL		; Release this channel
		MOVE A,CHAN		; Return error code to caller
		RET]			; Failure return
	MOVE A,CHAN		; Return channel to caller
	RETSKP


;FILERR - Type error message corresponding to FILOP. failure
;Call with error code in A

FILERR:	CALL CRIF		; Left margin please
	CAIL A,ERFNF%		; Range check
	CAILE A,ERJCH%		;  ..
	JRST FILER0
	MOVE A,ERRTAB(A)	; Get ptr to appropriate error message
	$TEXT (KBFTOR,<%File operation failed:  ^Q/A/>)
	RET

FILER0:	$TEXT (KBFTOR,<%File operation failed:  unknown FILOP. error ^O/A/>)
	RET
	SUBTTL	SET/CLEAR the "new mail" bit

NEWMAL::SKIPG	A,MSGJF2	; Get secondary JFN
	 RET			; Quit if it's not open
	HRLI	A,.FORNM	; We are going to rename this puppy
	TRO	A,(FO.PRV!FO.UOC) ; Using the existing channel and our privs
	MOVSM	A,FILOPB+.FOFNC	; Set up function word for FILOP.
	MOVE	A,[LKB,,LKB+1]
	SETZM	LKB
	BLT	A,LKB+.RBTIM
	MOVEI	A,MSGFD		; Reinit the lookup block
	CALL	INILKB		; Which will be used as a RENAME block
	SETZM	LKB+.RBPPN	; Always use same path
	SKIPE	A,UNSEEN	; If there is unseen mail
	MOVEI	A,1		; Set the "new mail" bit
	MOVEM	A,LKB+.RBFFB	; Set flag into new RIB word
	MOVE	A,[RB.DEC!FLD(.RBDAS,RB.DTY)!FLD(.RBOMS,RB.DTO)]
	MOVEM	A,LKB+.RBTYP	; Flag "DEC format", "ASCII data", "MS OTS"
	MOVEI	A,.IODMP	; Dump mode is as good as any
	MOVEM	A,FILOPB+.FOIOS	; for renaming a file
	MOVE	A,MSGSTR
	MOVEM	A,FILOPB+.FODEV
	SETZM	FILOPB+.FOBRH
	SETZM	FILOPB+.FONBF
	MOVSI	A,LKB		; Set up RENAME block pointer
	MOVEM	A,FILOPB+.FOLEB
	SETZM	FILOPB+.FOPAT	; No returned path
	MOVE	A,MYPPN		; Use my PPN for priv checking
	MOVEM	A,FILOPB+.FOPPN
	MOVE	A,[.FOPPN+1,,FILOPB]
	FILOP.	A,		; Try to rename the file away
	  JFCL			; Don't care if it fails
NEWMA1:	MOVEI	B,.FOREL
	HRL	B,MSGJF2
	MOVE	A,[1,,B]
	FILOP.	A,		; Release the channel
	  JFCL
	RET
;LOOKUP/ENTER error message table

DEFINE ERRT(STRING),<
	POINT 7,[ASCIZ |STRING|]
>

ERRTAB:	ERRT <ERFNF% (0) - File not found>
	ERRT <ERIPP% (1) - Nonexistent UFD>
	ERRT <ERPRT% (2) - Protection failure>
	ERRT <ERFBM% (3) - File being modified>
	ERRT <ERAEF% (4) - File already exists>
	ERRT <ERISU% (5) - Illegal sequence of monitor calls>
	ERRT <ERTRN% (6) - Device or data error>
	ERRT <ERNSF% (7) - Not a save file>
	ERRT <ERNEC% (10) - Not enough core>
	ERRT <ERDNA% (11) - Device not available>
	ERRT <ERNSD% (12) - No such device>
	ERRT <ERILU% (13) - Illegal monitor call>
	ERRT <ERNRM% (14) - No room or quota exceeded>
	ERRT <ERWLK% (15) - File structure is write-locked>
	ERRT <ERNET% (16) - Insufficient monitor table space>
	ERRT <ERPOA% (17) - Partial allocation only>
	ERRT <ERBNF% (20) - Block not free on allocated position>
	ERRT <ERCSD% (21) - Cannot supersede a directory>
	ERRT <ERDNE% (22) - Cannot delete nonempty directory>
	ERRT <ERSNF% (23) - SFD not found>
	ERRT <ERSLE% (24) - Search list empty>
	ERRT <ERLVL% (25) - SFDs nested too deeply>
	ERRT <ERNCE% (26) - Can't create file on any structure in search list>
	ERRT <ERSNS% (27) - GETSEG of nonexistent segment>
	ERRT <ERFCU% (30) - Cannot update file>
	ERRT <ERLOH% (31) - Page overlap error>
	ERRT <ERNLI% (32) - Not logged in>
	ERRT <ERENQ% (33) - File has ENQ locks outstanding>
	ERRT <ERBED% (34) - Bad EXE file directory>
	ERRT <ERBEE% (35) - File's extension is not EXE>
	ERRT <ERDTB% (36) - EXE file directory too big>
	ERRT <ERENC% (37) - Network capacity exceeded>
	ERRT <ERTNA% (40) - Task not available>
	ERRT <ERUNN% (41) - Unknown network node specified>
	ERRT <ERSIU% (42) - SFD is in use (rename)>
	ERRT <ERNDR% (43) - File has an NDR block>
	ERRT <ERJCH% (44) - Job count too high (A.T. read count overflow)>

   >;End TOPS10
SUBTTL File parsing subroutines - SIZFIL -  Get size of current file

SIZFIL:	STKVAR <SAVJFN,CHN0,<IOLIST,2>>
	MOVEM A,SAVJFN		; Save JFN (or addr of FD)
   TOPS10<
	MOVE A,MSGJFN		; Get channel number
	CALL APPNQ0		; Get the append interlock
	  RETSKP		; Can't get it, don't change file size info
	HRLZ B,MSGJFN		; Channel number for FILOP.
	HRRI B,.FOUSI		; Set up useti function
	SETZ C,			;  to block 0 (prime RIB)
	MOVE A,[2,,B]
	FILOP. A,		; Position to read RIB
	  PJRST APPDEQ		; Failed, just release lock and return
	HRRI B,.FOINP		; Function to read file (channel still in left)
	MOVEI C,IOLIST		; point to iolist
	MOVE A,[IOWD .RBMAX,LKB] ; Read into standard place
	MOVEM A,(C)
	SETZM 1(C)
	MOVE A,[2,,B]
	FILOP. A,		;Read the first part of the RIB
	  PJRST APPDEQ		;Failed, just release lock and return
	CALL APPDEQ		;Release append lock now

SIZLKB:	MOVE A,LKB+.RBSIZ	; Get word count for file
	IMULI A,5		; Form byte count
SIZEXP:	MOVEM A,FILSIZ		; Save number of bytes
	ADDI A,BY2PAG-1		; Round up
	IDIVI A,BY2PAG		;  ..
	MOVEM A,FILPGS		;  and pages (blocks)
	MOVE A,LKB+.RBTIM	; Get creation date/time
	MOVEM A,FILCRV		; Store
	MOVEM A,FILWRT		; TOPS10 doesn't offer append date
	RETSKP
   >;End TOPS10

;(TOPS20 portion on next page)
;SIZFIL - (Fall through from previous page)

   TOPS20<
	MOVE B,[5,,.FBBYV]
	MOVEI C,FILPGS
	GTFDB			; Get the size stuff
	 ERJMP [JRETER (GTFDB failed on message file)
		RET]
REPEAT 0,<
	TXNN F,F%MOD		; MOD wanted
	IFSKP.			; Skip means MOD is set
	 SETO A,		; Yes - get d/t last login then
	 HRROI B,D
	 MOVEI C,.JILLN		; For this job
	 GETJI			; Instead of d/t last read
	  SETZ D,		; use 0 if can't obtain it
	 MOVEM D,LASTRD		; Save it as last read
	ENDIF.
>
	LDB U,[POINT 6,FILPGS,11] ; Get byte size
	MOVE V,FILSIZ		; Else get the size now
	CAIN U,7		; If 7 bit,
	 JRST SIZFL3		; Are almost done
	CAIN U,^D36		; 36 bit is easier
	 JRST SIZFL2
	MOVEI T,^D36
	IDIVI T,(U)		; Get number of bytes in a word
	IDIVI V,(T)		; Get number of words
SIZFL2:	IMULI V,5		; Into bytes
SIZFL3:	MOVEM V,FILSIZ		; Save the size
	IDIVI V,BY2PAG		; Since we may have the file open, the
	SKIPE V+1		; Page count may be too little
	 AOJ V,			; So, we must check against the
	HRRZ T,FILPGS		; Size according to the byte count
	MOVE A,SAVJFN		; Else - try to find first free page
	GTSTS			; Only do this if file open
	TXNN B,GS%OPN
	IFNSK.			; No skip, file isn't open
	 CAMLE V,T		; Use smaller page count,
	  MOVE V,T		; to prevent illegal memory reads
	 HRRM V,FILPGS		;  ..
	 RETSKP
	ENDIF.			;
	FFFFP			; Look for first free page
	 JFCL			; Check error in a second
	HRRZ B,A		; Save this page number
	CAMGE B,V		; Is first free page before EOF?
	IFNSK.			; Yes, it is
	 MOVE V,B		; Keep that as the EOF page count
	 HRL A,SAVJFN		; Get JFN back
	 FFUFP%			; See if there are any other used pages
	  JFCL			; This JSYS skip returns
	 HRRZS A		; Clear JFN
	 CAIN A,FFUFX3		; No used page found?
	 IFSKP.			; None found, this is real page count
	  HRRZS A		; Clear jfn from LH
	  WARN <File has bad format - missing pages %2D thru %1D>
	  WARN <MS cannot parse messages beyond this hole.>
	  CALL CRLF		; Finish line
	  MOVE A,B		; Set up the right page count for later
	 ENDIF.			;
	ENDIF.			; Otherwise...
	HRRM V,FILPGS		; Save the real page count again
	IMULI V,BY2PAG		; Compute byte count
	CAMGE V,FILSIZ		; If FDB byte count too big,
	MOVEM V,FILSIZ		;  prevent ill mem reads in PARSEF
	RETSKP
   >;End TOPS20

SUBTTL File parsing subroutines - PARSEF - Parse the file from message (M) on


PARSEF:
TOPS20<	CALL UNMAPF >		; Get rid of unwanted pages (We need this here)
	JUMPN M,PARSF1		; We aren't started from the beginning
	SETZ V,			; starting at first page
	JRST PARSF2		; And go map it all in
PARSF1:	SOS M
	GTMBL (M,T)		; Pointer to msg block for last msg
	AOS M
	MOVE V,MSGALL(T)	; Get start of last msg
	ADD V,MSGALN(T)		; Move to start of next message
PARSF2:	CALL RMP1		; Map the messages into the window

;Here after reading a new chunk of message file - parse new stuff
;
;	D/	Real start of first header line of the message
;	M/	Current message number
;	T/	Address of message index block (from GTMBL)
;	V/	Current character position while scanning
;	W/	-1 if garbage precedes this message, 0 otherwise

PARS10:
   IFN MHACK,<			; If using BLISS parser,
	CHR2BP			; Convert to byte pointer
	PUSH P,A		; Push arg 1
	MOVE A,MSGFAD		; Address of message buffer
	IMULI A,5		; Byte address of buffer
	SUB V,A			; Compute number of bytes already parsed
	MOVE A,FILSIZ		; Get size of file in bytes
	SUB A,V			; Compute bytes left unparsed
	PUSH P,A		; Push arg 2
	CALL PARSE%##		; Go parse remaining messages
	ADJSP P,-2		; Pop args from stack
	RET			;  and return
   >;End IFN MHACK

   IFE MHACK,<			; Old code
	GTMBL (M,T)		; Get next message index block
	MOVEM V,MSGALL(T)	; Start of whole message
	SETZB W,MSGBTS(T)	; Invalidate this index block until parsed.
	MOVE D,V		; Remember the alleged start of this message
	JRST PARS12		; Lets find out
;
;	Here to parse the message header line preceding the message body
;
PARS11:	MOVE D,V		; Remember the real start of this message
	SETO W,			; And flag that there is garbage in front
PARS12:	CAML V,FILSIZ		; Check for EOF
	 JRST FILEOF		; All done, punt
	CALL GTBFL		; Get character FROM THE FILE
	AOS V			; Bump character position
	CAIE A,.CHLFD		; Carriage return?
	SKIPN A			; Null?
	 JRST PARS11		; Get next line
	CAIE A,","		; Look for a comma
	 JRST PARS12		; Not a comma, keep looking
	MOVEI C,^D10		; Decimal
	CALL .NIN		; Read the length field
	CAIE A,";"		; Genuine count, and not some random number?
	 JRST PARS11		; Go get next line
	MOVEM B,MSGBON(T)	; Save alleged length of message
	MOVEI C,10		; Octal
	CALL .NIN		; Get the message bits
	CAIE A,.CHCRT		; Better be terminated with CR
	 JRST PARS11		; Go get next line
	HRRZM B,MSGBTS(T)	; Save message bits in dynamic part
	HRLM B,MSGBTS(T)	; And save the "in file" part
	TRNN B,M%SEEN		; Is this message new?
	 AOS UNSEEN		; Yes, increment count
	TRNE B,M%DELE		; Is this message deleted?
	 AOS NDELET		; Yep, add to the number deleted
	TRNE B,M%ATTN		; Is this message flagged?
	 AOS NFLAGD		; Uh huh, remember another one
	CAML V,FILSIZ		; Check for EOF
	 JRST FILEOF		; And punt
	CALL GTBFL		; Get the next character
	AOS V			; Bump character position
	CAIE A,.CHLFD		; Is this a linefeed?
	 JRST PARS11		; Go get next line
	SKIPN W			; Any bad characters to add to previous message?
	IFSKP.			; Skip means there are, so
	  MOVEM D,MSGALL(T)	; Save the real starting position of the message
	  PUSH P,T		; Save the message block index
	  SOSL M		; Go back one message
	  IFSKP.		; Skip means we haven't seen any messages yet.
	    WARN <File has bad format - First message is preceded by junk>
	    $CALL K%FLSH	; Flush output
	    JRST PARS14		; Set back to first message
	  ENDIF.		; Rejoin message fix-up code
	  GTMBL (M,T)		; Get index of previous message
	  MOVE B,D		; Copy start of current message
	  SUB B,MSGALL(T)	; Calculate distance from previous message
	  MOVEM B,MSGALN(T)	; Save it
	  MOVE B,D		; Get the start of current message again
	  SUB B,MSGBOD(T)	; Calculate distance from prev. msg. body
	  MOVEM B,MSGBON(T)	; Save it too
PARS14:	  AOS M			; Bump message number back up
	  POP P,T		; Restore the message block index
	ENDIF.
	MOVEM V,MSGBOD(T)	; Save start of real message
	MOVE A,V		; Start of real message
	MOVE B,MSGBON(T)	; Get the alleged length
	ADD A,B			; Add alleged length
	CAMG A,FILSIZ		; Does that go beyond the known file length?
	IFSKP.			; Skip means we have to adjust message length
	  WARN <Last message has invalid length field, truncating.>
	  WARN <Any new messages will cause file damage.>
	  WARN <DELETE or MOVE last message to correct this problem.>
	  $CALL K%FLSH		; Flush output
	  MOVE A,FILSIZ		; Get the file length
	  SUB A,V		; Calculate the real message length
	  MOVEM A,MSGBON(T)	; And save it again
	  MOVE A,FILSIZ		; This is now the end of this message
	ENDIF.			; and continue
	PUSH P,A		; Save it for later
	MOVE B,MSGALL(T)	; Where it started
	SUB A,B			; Length of whole thing
	MOVEM M,MSGNUM(T)	; Save message number
	MOVEM A,MSGALN(T)	; Save it too
	MOVE A,MSGBTS(T)	; Get message bits
	TRNN A,M%ATTN		; Flagged?
	 TRNN A,M%SEEN		;  or not seen?
	   CALL PRSMS0		; Yes to either, parse msg and flag valid
TOPS20<
	POP P,V			; Recover ending address
	CAMGE V,FILSIZ		; See if EOF yet
	AOJA M,PARS10		;no, keep going
>
TOPS10<
	MOVE V,FILSIZ		;Get size of file
	SUB V,(P)		; Calculate bytes remaining
	CAIGE V,5		; Less than 5? (one word's worth)
	 JRST PARS15		; Yes, we're effectively done.
	POP P,V			; Got 5 or more chars left
	AOJA M,PARS10		; So keep going
PARS15:	POP P,V			; Restore last address either way
>
PARSEX:	MOVEM M,LASTM		;STORE MESSAGES COUNT
	RET
; FILEOF - End of file error recovery
;
;	Called with:
;		V/ Current position in file
;		T/ Address of message index block for current message
;		M/ Current message number
;
;	Returns:
;	+1 - End of file, M/ previous msg, T/ previous msg index block
;	+2 - Not end of file

FILEOF:	SETZM MSGALL(T)		; Clear this index block
	SOSL M			; Back up one message
	IFSKP.			; Skip if that was the first message
	 WARN <File has bad format - no messages found.>
	 $CALL K%FLSH		; Flush output
	 SETZ M,		; Reset message number
	 RET			; And punt
	ENDIF.			;
	WARN <File has bad format - cannot find start of last message.>
	WARN <DELETE or MOVE last message to correct this problem.>
	$CALL K%FLSH		; Flush output
	GTMBL (M,T)		; Get index block for that message
	MOVE A,FILSIZ		; Get EOF mark
	SUB A,MSGALL(T)		; Calculate real length
	MOVEM A,MSGALN(T)	; Save it
	MOVE A,FILSIZ		; Get EOF again
	SUB A,MSGBOD(T)		; Calculate length of message body
	MOVEM A,MSGBON(T)	; Save it too.
	JRST PARSEX		; And punt
; (Still inside IFE MHACK)

SUBTTL File parsing subroutines - PRSMSG, PRSMS0 - parse single message

;PRSMSG - Parse a single message, preserving all temp ACs
;PRSMS0 - Parse message for code willing to have ACs stomped on

PRSMSG:	$SAVE <A,B,C,D,E>	; For sensitive callers
PRSMS0: PUSH P,M		; Save M as msg number
	GTMBL (M,MX)		; Get ptr to message block
	MOVE V,MSGBOD(MX)	; Get beginning of message body
	MOVE W,MSGBON(MX)	; Get size of whole message
	CALL SETSFL		; Set stuff for file searching
	MOVE A,MSGFAD		; Correct char pointer
	IMULI A,5
	ADD V,A
	SUB V,WBOT
	MOVEI T,[ASCIZ /

/]				; Search for end of header area (2 CRLFs)
	CALL SSEARC
	 JRST [	MOVE W,MSGBON(MX)	; Not found, assume whole msg
		MOVEM W,MSGHDN(MX)	;  is one big header
		JRST PRSMS1]		; ..
	BP2CHR			;CONVERT BYTE POINTER
	ADD V,WBOT
	MOVE B,MSGFAD		;TO CHAR POINTER
	IMULI B,5		;FROM THE BEGINNING
	SUB V,B			;OF THE FILE
	SUB V,MSGBOD(MX)	; Compute length of header area
	MOVEM V,MSGHDN(MX)	;  and save it away
PRSMS1:	MOVX A,M%VALI		; Flag that this msg has valid info
	IORM A,MSGBTS(MX)	;  ..

	CALL FNDSUB		; Find the subject
	MOVEM V,MSGSUB(MX)
	MOVEM W,MSGSUN(MX)	; Save position and size

	CALL FNDSND		; Find sender
	MOVEM V,MSGSND(MX)
	MOVEM W,MSGSNN(MX)

	CALL FNDFRM		; Find the from
	MOVEM V,MSGFRM(MX)	; Where
	MOVEM W,MSGFRN(MX)	; Size

	CALL FNDTO		; Find "to" list
	MOVEM V,MSGTO(MX)	; Where
	MOVEM W,MSGTON(MX)	; Size of first line
	MOVEM X,MSGTOK(MX)	; Size of entire field

	CALL FNDCC
	MOVEM V,MSGCC(MX)	; Find Carbon-copy
	MOVEM X,MSGCCN(MX)

	CALL FNDMID		; Find message-ID
	MOVEM V,MSGMID(MX)
	MOVEM X,MSGMIN(MX)

	CALL FNDREF		; Find Reference
	MOVEM V,MSGREF(MX)
	MOVEM X,MSGRFN(MX)

	CALL FNDRRR		; Return receipt requested
	MOVEM V,MSGRRR(MX)
	MOVEM W,MSGRRN(MX)

	CALL FNDDAT		; Find the date
	MOVEM B,MSGDAT(MX)	; Receive date
	AOJN B,PRSMS2		; Not found (ie., -1)?
	CALL FNDSDT		; Yes, try for send date then
	MOVEM B,MSGDAT(MX)	;  ..
PRSMS2:	MOVE V,MSGBOD(MX)	; Get character pointer
	SUB V,WBOT
	MOVE A,MSGFAD
	IMULI A,5
	ADD V,A
	CHR2BP			; Form byte pointer
	POP P,M			; Restore M as msg number
	RET			; All done!

   >;End IFE MHACK
   IFE MHACK,<

;.NIN - Parse a number pointed to by V (IN FILE ), radix in C

.NIN:	SETZ B,
.NIN1:	CALL GTBFL		; Get char from file
	AOS V
	CAML V,FILSIZ		; Do we fall off the edge of the world
	 JRST .NIN2		; Explain this one to the queen
	CAIL A,"0"
	 CAILE A,"0"-1(C)
	 RET			; Done
	IMULI B,(C)
	ADDI B,-"0"(A)
	JRST .NIN1

.NIN2:	POP P,A			; Remove return address off of stack
	JRST FILEOF		; and move on to EOF recovery

;Check to see if byte pointer in A has gone past EOF
;Return	+1: No, byte pointer is OK
;	+2: Yes, you've run off the end

CHKEOF:	BP2CHR			; Convert to character pointer
CHKEF0:	MOVE B,MSGFAD		; Word address of 1st word in file
	IMULI B,5		; Byte address of 1st byte
	MOVE C,V		; Don't clobber V
	SUB C,B			; Compute byte offset into file
	CAMGE C,FILSIZ		; Off the end yet?
	RET			; No, nonskip
	RETSKP			; Yes, skip

   >;End IFE MHACK

 SUBTTL UPDBIT - update the file copy of the message bits

UPDBIT:	STKVAR <IOWDT,BLKNO,BTPTR,MBITS,BLINC,WRTPGS>
	GTMBL (M,B)		; Get ptr to message block
	LDB A,[POINT 12,MSGBTS(B),17]
	HRRZ B,MSGBTS(B)	; Get new copy of bits
	MOVEM B,MBITS		; Save in case CHECKS and PARSEF clobber
	TXNN F,F%MOD		; MOD hack - exit now
	CAIN B,(A)		; Old matches new?
	 RET			; Yes, no need to do any more
	CALL CTCLOK		; ENQ for exclusive access
	 JRST [	WARN <Can't update message bits -- another reader exists>
		CALL CRIF	;
		RET]
	CALL GETJF3		; Get a second jfn if dont already
	 CALLRET CTCOK 		; Error, try to reenable CTRL-C
	SETZM WRTPGS		; No update I/O buffer yet
TOPS10<	MOVEI A,400		; Need 2 blocks for I/O (in case msg bits cross
	$CALL M%GMEM		;  page boundary)
	JUMPF UPDBTM		; Memory allocation error
	MOVEM B,WRTPGS		; Save address of buffer
>
TOPS20<	MOVEI A,2		; Need 2 pages for I/O (in case msg bits cross
	$CALL M%AQNP		;  page boundary)
	JUMPF UPDBTM		; Insufficient memory
	LSH A,^D9		; Convert page number to address
	MOVEM A,WRTPGS		; Save address of buffer
>
	GTMBL (M,B)		; Get ptr to message block
	MOVE V,MSGALL(B)	; Start of the message header
	CALL SETSFL
	PUSH P,V
	SUB V,WBOT
	MOVE A,MSGFAD
	IMULI A,5
	ADD V,A
	CHR2BP			; Get byte pointer
	POP P,V
UPDBT1:	ILDB B,A		; Get char
	CAIN B,15		; At end of line??
	 JRST [	CMERR (File has bad format - Cannot find message flags)
		JRST UPDBTX]
	CAIE B,";"		; At start of bits?
	 JRST UPDBT1
	SUB A,MSGFAD		; Get relative pointer
	MOVEM A,BTPTR		; Save that pointer
	HLRZ B,A
	CAIN B,010700
	 AOJ A,
	ANDI A,-1
TOPS20<	MOVE C,WBOT		; Window displacement
	IDIVI C,5000
	IDIVI A,1000		; Get page number we need
	ADD A,C
	HRL A,MSGJF2
	CAIL B,775		; If near end of page
	 SKIPA C,[PM%CNT+PM%WR+PM%RD+2]	; Map two pages
	 MOVSI C,(PM%WR!PM%RD)
	MOVE B,WRTPGS		; Address of buffer
	LSH B,-^D9		; Convert to page number
	HRLI B,.FHSLF		; This fork
	PMAP
>;End TOPS20

TOPS10<	MOVE B,WBOT		; Starting byte of the window
	IDIVI B,5		; Convert to words
	ADD A,B 		; Words from start of file
	IDIVI A,200		; Get block number minus one
	MOVEI A,1(A)		; Correct block number
	MOVEM A,BLKNO		; Save for later
	MOVE C,MSGJFN		; Get channel for message file
	LSH C,^D23		; Move to AC field
	IOR C,[USETI]		; Get instruction
	HRR C,BLKNO		; Get correct block number
	XCT C			; Point to it
	MOVE A,WRTPGS		; Get address of buffer
	SUBI A,1		;  minus one (for IOWD)
	HRLI A,-200		; Assume only one block of I/O
	CAIL B,175		; Need to read two blocks?
	HRLI A,-400		; Yes, get bigger word count
	MOVEM A,IOWDT		; Save for later
	MOVEM A,MSIOWD		;  and save in place for IN UUO
	SETZM MSIOWD+1		; Tie off list
	MOVE A,MSGJFN		; Get channel back
	LSH A,^D23		; Put in right place
	IOR A,[IN MSIOWD]	; Form instruction to read stuff
	XCT A			; Snarf
	 SKIPA			; Good stuff
	  FATAL (Can't read message file to update bits)
>;End TOPS10
	MOVE A,BTPTR		; Get back byte pointer
TOPS20<	TRZ A,777000 >		; Just relative to page
TOPS10<	TRZ A,777600 >		; Just relative to block
	ADD A,WRTPGS		; Offset right
	MOVEM A,UPDPTR		; Save pointer for TOR
	MOVE B,MBITS		; Bits to write to file
	$TEXT (UPDBT9,<^O12R0/B/^A>)	; 12 digits, zero-filled, right-justified
	GTMBL (M,A)		; Get ptr to message block
	DPB B,[POINT 12,MSGBTS(A),17]	; This is now the file version
   TOPS20<
	SETO A,
	MOVE B,WRTPGS		; Get address of buffer
	LSH B,-^D9		; Form page number
	HRLI B,.FHSLF		; This fork
	MOVE C,[PM%CNT+2]
	PMAP			; Unmap the pages
	JRST UPDBTX		; Clean up and return
   >;End TOPS20

   TOPS10<
	GTMBL (M,A)		; Get ptr to message block
	HRRM B,MSGBTS(A)	; In case GETJF3/CHECKS/GET1 wiped these out
	MOVE A,BTPTR		; Must also update in-core version
	ADD A,MSGFAD		;  ..
	MOVEM A,UPDPTR		;  of file bits because TOPS10 can't map
	$TEXT (UPDBT9,<^O12R0/B/^A>)	; 12 digits, zero-filled, right-justified
	SETZM BLINC		; Init block increment to zero
	HLRZ A,IOWDT		; Get count part of IOWD used to read block(s)
	MOVE B,BLKNO		; Get first block number read
	CAIN A,-400		; Did we read two blocks?
	  JRST [MOVEI C,200	; Yes, set block increment
		MOVEM C,BLINC	;  up by 1 block (200 words)
		ADDI B,1	; Bump number of last block read
		JRST .+1]	; Continue
	MOVE C,FILSIZ		; Get number of bytes in file
	ADDI C,BY2PAG-1		; Cause roundup
	IDIVI C,BY2PAG		; Compute "pages" (blocks) in file
	MOVE A,IOWDT		; Get original IOWD back
	CAIN C,(B)		; Did we diddle last block of file?
	  JRST [MOVE C,FILSIZ	; Yes, get file size back
		ADDI C,4	; Force roundup
		IDIVI C,5	; Compute word length of file
		ANDI C,177	; Drop block no. part of length
		SKIPN C		; Is last block completely filled?
		MOVEI C,200	; Yes, write whole block
		ADD C,BLINC	; Account for possibility of 2 blocks
		MOVN C,C	; Form new word count
		HRL A,C		; Fix up IOWD
		JRST .+1]
	MOVEM A,MSIOWD		; Save IOWD
	SETZM MSIOWD+1
	MOVE A,MSGJF2		; Get channel number to write on
	LSH A,^D23		; Put in AC field
	TLO A,(USETO)		; Form USETO instruction
	HRR A,BLKNO		; Where to point
	XCT A			; Get there
	TLC A,(<OUT >^!<USETO >); Change to OUT instruction
	HRRI A,MSIOWD		; Point to IOWD
	XCT A			; Write updated blocks
	 JRST UPDBTX		; Success, clean up and return
	  FATAL (Can't update message bits)
	  CALL CRIF		;
   >;End TOPS10

;Here on normal return

UPDBTX:
   TOPS10<
	MOVEI A,400		; Release buffer space
	MOVE B,WRTPGS		;  ..
	$CALL M%RMEM		;  ..
	CALLRET CLSJF2		; Unlock and close file and return
   >;End TOPS10
   TOPS20<
	MOVEI A,2		; Release buffer pages
	MOVE B,WRTPGS		; Address
	LSH B,-^D9		; Form page number
	$CALL M%RLNP		; Release 'em
	CALLRET CLSJF2		; Unlock and close file and return
   >;End TOPS20

;Here on memory allocation failure

UPDBTM:	WARN <Can't update message bits because:  insufficient memory>
	CALL CRIF		;
	CALLRET CLSJF2

;Here from $TEXT macro above to write messge bit digits

UPDBT9:	JUMPE A,[$RET]		; Don't write nulls
	CAIE A,15		; Don't do CR or LF either
	CAIN A,12		;  ..
	$RET			;  ..
	IDPB A,UPDPTR		; Store where UPDPTR tells us to
	$RET
CLSJF2:
TOPS10<	MOVE A,MSGJF2>		;
TOPS20<	HRRZ A,MSGJF2		;
	TXNE F,F%MOD		; MOD?
	JRST CLSJ2A		; Yes, just close the file
	SIZEF			; Get page count for file
	 ERJMP [JRETER <SIZEF failure for message file>
		HRRZ A,MSGJF2		;  at least try to close it
		JRST CLSJ2A]
	HRLZS A			; JFN ,, start at page zero
	MOVEI B,(C)		; Count of pages to update
	UFPGS
	 ERJMP [JRETER <UFPGS failure for message file>
		JRST .+1]
	HRRZ A,MSGJF2		; Get JFN back
CLSJ2A:	TXO A,CO%NRJ		; Keep this JFN around
	CLOSF
	ERJMP [ CAIN A,CLSX1		; Already closed?
		JRST CLSJ2B		; Yes,
		JWARN (Cannot close second JFN on message file)
		JRST CLSJ2C]		;
CLSJ2B:	HRRZ A,MSGJF2		; In case error , get JFN again
	MOVEM A,MSGJF2		; JFN, but now closed
CLSJ2C:	CALL SETREF		; Set read date-time
>;End TOPS20

TOPS10<	CALL NEWMAL
	SETOM MSGJF2
>
	CALL CTCOK		; Allow ctrl-C again if disabled
	RET			; Done



TOPS20<
RELJF2:	HRRZ A,MSGJF2
	RLJFN			; release JFN
	 JFCL			; Maybe error?
	SETZM MSGJF2		; No longer have one
	RET

CLWJFN:	HRRZ A,MSGJF2		; Pick up the READ/WRITE JFN
	TXO A,CO%NRJ		; Don't release it
	CLOSF			;
	JRST [ WARN (Cannot close the second JFN of the message file)
	       RET]
	HRRZ A,MSGJF2		; Pick up the READ/WRITE JFN
	MOVEM A,MSGJF2		; Save updated status
	RET			;

CJFNS:	CLOSF			; Close it
	WARN (Cannot close JFN on the new message file)
	SKIPN A,GTJFN2		; Is there a second JFN?
	RET			; No
	CLOSF			; Yes, Close it
	JRST [ CAIN A,CLSX1!DESX3	; File already closed or JFN not
	       JRST CJFNS2		; assigned? Yes
	       WARN (Cannot close second JFN on the new message file)
	       RET]			;
CJFNS2:	SETZM GTJFN2		; No longer have a JFN
	RET			;

>;End TOPS20

;GETJF2 - Open message file for write (expunge)
;GETJF3 - Open for update (UPDBIT)
;
;(These two routines are the same on TOPS20, but differ on TOPS10)

TOPS10<
GETJF2:	MOVEI A,MSGFD		; Init LOOKUP/ENTER block
	CALL INILKB		;  ..
	MOVE A,MSGJFN		; Get open channel number
	MOVEM A,PBLOCK		; Stuff into path block
	MOVE A,[10,,PBLOCK]	; Set up to read path
	HRRZM A,LKB+.RBPPN	; Point to path block for opening write file
	PATH. A,		;  to be the same as currently open mail file
	  JFCL
	CALL FILOPW		; Open message file for write
	 JRST [	CALL FILERR	; Type FILOP. error string
		WARN <Second open on message file failed>
		RET]
	MOVEM A,MSGJF2		; Remember channel
	CALL CHECK0		; Any new messages pending?
	 JRST RSKP		; No, all set then
	MOVE A,MSGJF2		; Yes, recover channel number
	RESDV. A,		; Abort this opening
	 FATAL <Can't abort second opening of message file>
	SETOM MSGJF2		; Leave tracks
	CALL CHECKS		; Read and parse new mail
	JRST GETJF2		; Now try again

GETJF3:	MOVEI A,MSGFD		; Init LOOKUP/ENTER block
       	CALL INILKB		;  ..
       	CALL FILOPU		; Open message file for update
       	 JRST [	CALL FILERR	; Type FILOP. error string
       		WARN <Second open on message file failed>
       		RET]
       	MOVEM A,MSGJF2		; Remember channel
       	CALL CHECK0		; Any new messages pending?
       	 JRST RSKP		; No, all set then
       	MOVE A,MSGJF2		; Yes, recover channel number
       	RESDV. A,		; Abort this opening
       	 FATAL <Can't abort second opening of message file>
       	SETOM MSGJF2		; Leave tracks
       	CALL CHECKS		; Read and parse new mail
       	JRST GETJF3		; Now try again

;Utility routine to close and release a channel in A

CLSFIL:	LSH A,^D23
	IOR A,[CLOSE]
	XCT A
	TLC A,(<CLOSE >^!<RELEASE>)
	XCT A
	RET
>;End TOPS10

TOPS20<
GETJF2:
GETJF3:	SKIPE MSGJF2		; Have one already?
	 JRST GETJ2A		; Yes, use it
	HRROI A,STRBUF
	MOVE B,MSGJFN		; One we do have
	SETZ C,
	JFNS
	MOVSI A,(GJ%OLD!GJ%SHT)
	HRROI B,STRBUF
	GTJFN
	 ERJMP [JRETER (Cannot get second JFN on file)
		RET]
	MOVEM A,MSGJF2		; Save jfn
GETJ2A:	SKIPG A,MSGJF2		; Is the file open?
	RETSKP			; Yes, so return
	MOVX B,7B5+OF%RD!OF%WR!OF%PDT	; Open file for write as well (it is
	OPENF			; now write-locked against new msgs).
	 ERJMP [JRETER <Can't update message file - another mailer exists>
		RET]
	MOVE A,MSGJF2		; Pick up the READ/WRITE JFN
	TXO A,RWJFNO		; Mark as open
	MOVEM A,MSGJF2		; Save the updated status
	RETSKP			; Return success

GTSJFN:	HRROI A,JF2BUF		; Point to where to put the file name
	SETZ C,			; No format control bits
	JFNS			; Get the file spec
	ERJMP [ JRETER (Cannot get file specification on file)
		RET]
	MOVSI A,(GJ%OLD!GJ%SHT)	;
	HRROI B,JF2BUF		; Point to the file spec
	GTJFN			; Get the second JFN
	ERJMP [ JRETER (Cannot get second JFN on file)
		SETZM GTJFN2	;
		RET]		;
	MOVEM A,GTJFN2		; Save the READ/WRITE JFN
	MOVX B,7B5+OF%RD!OF%WR!OF%PDT ; Yes, Open for READ only
	TXNE F,F%MOD		; MOD turned on?
	MOVX B,7B5+OF%RD!OF%PDT ; Open for READ/WRITE
	OPENF			;
	ERJMP [ JRETER <Can't update message file>
		MOVE A,GTJFN2	; Get the READ/WRITE JFN
		RLJFN		; And release it
		JFCL		;
		SETZM GTJFN2	;
		RET]		;
	MOVE A,GTJFN2		; Get the READ/WRITE JFN
	TXO A,RWJFNO		; Mark as open
	MOVEM A,GTJFN2		; Save the updated status
	RETSKP			;
>;End TOPS20
;This routine gets a byte from the mapped mail file
;	V/ character pointer (from file start)
;on return	A/byte

GTBFL::	PUSH P,B
	CAML V,WBOT	;LESS THAN WINDOW BOTTOM
	CAMLE V,WTOP	;OR MORE THAN WINDOW TOP
	CALL REMAP	;YES, REMAP
	MOVE A,V
	SUB A,WBOT	;OFFSET IN THE WINDOW
	IDIVI A,5	;IN WORDS
	ADD A,MSGFAD
	ADD A,[ POINT 7,0,6	;MAKE THE BYTE POINTER
		POINT 7,0,13
		POINT 7,0,20
		POINT 7,0,27
		POINT 7,0,34](B)
	LDB A,A
	POP P,B
	RET			;DONE

;REMAPS FILE V -REFERENCE ADDRESS
;PAGE CONTAINING (V) GOES TO THE TOP OF THE WINDOW
; Possible enhancement: always fill window as much as possible.  i.e. don't
; read just the last few pages in

REMAP::	MOVE	A,V		; Character pointer
	SUB	A,WBOT		; Are we already mapped into the
	JUMPL	A,RMP1		; first page of
	CAIG	A,777		;  the window?
	RET			; Yes, they were probably just testing us then
RMP1:	SKIPL	V		; If byte count is illegal
	CAMLE	V,FILSIZ	; Protest
	 $STOP (CPR, Character Pointer Out of Range)
	$SAVE	<B,C,D,E>	; Save away some ACs

TOPS20<	CALL	UNMAPF		; Tops-20 feels a need to let go of these pages
	MOVE	A,V		; Char number
	IDIVI	A,BY2PAG	; File page/block number
	PUSH	P,A		; Store it
	HRRZ	B,FILPGS	; Total pages in file
	SUB	B,A     	; How many left
	MOVE	C,WWIDH		; Window size
	CAMGE	B,C		; Left more than window can hold ?
	 MOVE	C,B		; No, take as many as nessesary
	MOVEM	C,FILPGM	; Store it
	HRL	A,MSGJFN	; And jfn
 	MOVE	B,MSGPAG	; Mapping place
	HRLI	B,.FHSLF	; Our fork
	HRLI	C,(PM%CNT!PM%RD!PM%CPY!PM%PLD) ; Start the I/O now, please
	PMAP
	MOVE	C,FILPGM	; Restore stuff
	POP	P,A
	IMULI	A,BY2PAG	;CALCULATE WINDOW FRAME
	MOVEM	A,WBOT		;STORE IT
	IMULI	C,BY2PAG
	SUBI	C,1
	ADD	C,A
	CAMLE	C,FILSIZ
	 MOVE	C,FILSIZ
	MOVEM	C,WTOP
	RET
>;End TOPS20
TOPS10<	MOVEI	A,.FOUSI	; FILOP function USETI
	HRL	A,MSGJFN	; Channel number
	MOVE	B,V		; Char number
	IDIVI	B,BY2PAG	; File block number
	AOS	B		; Round up
	MOVE	C,[2,,A]	; Length and address
	FILOP.	C,		; Point file at block with V
	 $STOP	(UOB, USETI Out of Bounds)

	HRRI 	A,.FOINP	; Next FILOP. will be an INPUT
	SOS	B		; Get back to blocks, numbering from zero
	IMULI	B,BY2PAG	; Convert blocks to bytes
	MOVEM	B,WBOT		; This will be the bottom of the window
	MOVE	C,FILSIZ	; Size of the file in bytes
	SUB	C,B		; Number of bytes left in the file
	MOVE	D,WWIDH		; Number of PAGES window is long
	IMULI	D,5000		; Which is this many bytes
	CAMGE	C,D		; We want the smaller of the two
	 MOVE	D,C		; ...
	MOVEM	D,FILPGM	; Save the number of in core bytes
	ADD	B,D		; Last byte in core
	SOS	B		; OFF BY ONE
	MOVEM	B,WTOP		; Which is the top of the window
	IDIVI	D,5		; Convert bytes to words
	MOVN	C,D
	HRLZ	C,C
	MOVEI	D,MSGA1
	SOS	D

	MOVEI	B,C
	HRR	C,D
	SETZ	D,
	MOVE	E,[2,,A]
	FILOP.	E,
	 $STOP	(ERF, Error Reading File)
	RET
>
; ROUTINE RETURNS A MESSAGE BLOCK POINTER IN THE SPECIFIED REGISTER
; CALL :	JSP F,GTMBL
;		MESSAGE NUMBER ADRESS,,BLOCK ADRESS
; USE THE MACRO GTMBL

GTMIND::DMOVEM A,IDXSAV		; Save AC's
	MOVEM C,IDXSAV+2	;
	HLRZ A,(F) 		;SOURCE ADRESS
	CAIN A,A		;A ITSELF ?
	 SKIPA A,IDXSAV		;YES, RESTORE
	MOVE A,(A)		;MESSAGE NUMBER
	CAMG A,MTOP		;Is the message number above the top?
	CAMGE A,MBOT		; is it below the lowest mapped index block?
	 CALL MMAP		; Call the routine to map the index window
 	TRZ A,777000		;OFFSET IN THE WINDOW
	IMULI A,MSGIDN		;IN WORDS
	ADDI A,MSGIDX		;PLUS REAL WINDOW TOP
	HRRZ B,(F)   		;DESTINATION ADRESS
	CAIL B,A		; Is the destination one of the
	CAILE B,C		; Work registers?
	 SKIPA			; No skip means it's not A,B, or C
	  MOVEI B,IDXSAV-1(B)	; So store it in the right TEMP area
	MOVEM A,(B)		; Put the results in the destination
	DMOVE A,IDXSAV		; Restore AC's
	MOVE C,IDXSAV+2		;
	JRST 1(F)		;SKIP RETURN, ROUTINE RETURNS A MESSAGE
				;BLOCK POINTER IN THE SPECIFIED REGISTER

; MMAP - Map the Message Index file window
;
;	A/ Index block number

MMAP:	MOVEM A,IDXNUM		;STORE MESSAGE NUMBER
	SKIPL MSGIFJ            ;DO WE HAVE A FILE ?
	 JRST MMAP1		;YES
	CAIG A,777 		;MAYBE WE DO NOT NEED A FILE
	 JRST [ MOVEI B,777	;NO, WE DON'T, INITIALIZE LIMITS
		MOVEM B,MTOP
		SETZM MBOT
		RET ]		; and do the work
TOPS10<
MMAP1:	HALT	>		;NEED STUFF HERE
TOPS20<
	CALL OPNFIL		;Open the index file
	RET			;An error occurred
	HRLZ B,A		;FILE PAGE ZERO
	MOVEI A,MSGIDX
	ASH A,^D-9		;WINDOW PAGE NUMBER
	HRLI A,.FHSLF
	MOVEI C,MSGIDN
	HRLI C,(PM%CNT)
	PMAP			;FLUSH PAGES
	 ERJMP [ JWARN (UNEXPECTED PMAP ERROR)
		JRST CMDRES]	;GO AWAY
MMAP1:	SETOM A			;WILL UNMAP
	MOVEI B,MSGIDX
	ASH B,^D-9		;FIRST PAGE NUMBER
	HRLI B,.FHSLF
	MOVEI C,MSGIDN		;NUMBER OF PAGES
	TXO C,PM%CNT
	PMAP			;UNMAP OLD PAGES
      	MOVE A,IDXNUM 		;MESSAGE NUMBER
	ASH A,^D-9
	IMULI A,MSGIDN		;FILE PAGE NUMBER
	HRL A,MSGIFJ		;FILE JFN
	MOVEI B,MSGIDX		;PROCESS PAGE NUMBER
	ASH B,^D-9
	HRLI B,.FHSLF		;AND DESIGNATOR
	MOVEI C,MSGIDN		;NUMBER OF PAGES
	HRLI C,(PM%CNT!PM%WR!PM%RD!PM%PLD)	; Start the I/O now, please
	PMAP
	 ERJMP [ JWARN (UNEXPECTED PMAP ERROR)
		JRST CMDRES]	;GO AWAY
	MOVE A,IDXNUM 		;MESSAGE NUMBER
	MOVE B,A
	TRZ B,777   		;UPDATE BOUNDARIES
	MOVEM B,MBOT
	ADDI B,777
	MOVEM B,MTOP
	RET
>; End TOPS20
;	WINDOW SETTING FOR FILE SEARCHING
;	ROUTINE MAKES SURE THAT THERE IS AT LEAST 1 PAGE TO THE TOP OF WINDOW

SETSFL::$SAVE <A,B,C,D>		; Save AC's for caller
	CAMLE V,FILSIZ		; Is pointer beyond known file length?
	IFNSK.			; No skip means it is
	 PUSH P,LASTRD		; Save last read date
	 PUSH P,V		; SIZFIL smashes this
	 MOVE A,MSGJFN		; So get the message file JFN
	 CALL SIZFIL		; And update the file length
	  WARN <Internal error - SIZFIL failed at SETSFL>
	 POP P,V		; Restore pointer
	 POP P,LASTRD		; and last read date
	 CAMLE V,FILSIZ		; Check it again
	  $STOP (BMX, Bad Message Index - Beyond EOF)
	ENDIF.			; all set
 	MOVE A,V
	ADDI A,BY2PAG+5		; Make sure a page or more is around
	CAMLE A,FILSIZ		; Are we getting carried away?
	 MOVE A,FILSIZ		; Let's not cause unnecessary thrashing
	CAML V,WBOT		; Are the pointers below bottom of window?
	CAMLE A,WTOP		; Or above the top?
	 CALL REMAP		; Yes, so remap
	RET			; Done
TOPS20<
OPNFIL:	$SAVE<D>		;Save a working register
OPNFI2:	HRROI A,IDXFIL		;Where to place the file spec
	MOVE B,MSGJFN		;FIRST TRY WITH MAIL DIRECTORY
	MOVX C,1B2!1B5!1B35	;TRANSLATE DIRECTORY
	JFNS			;Pick up the device and directory name
	 ERJMP JFNSER		;Should not happen
	MOVEI C,"M"		;Pick up first part of file name
	IDPB C,A		;And include as part of the file spec
	MOVEI C,"S"
	IDPB C,A
	MOVE C,A		;GTAD destroys A
	GTAD			;Want 4 numerics to finish file name
	MOVNI D,4		;D is for loop control
NXTDIG:	IDIVI A,^D10		;Peel off another integer
	ADDI B,60		;Make it ASCIZ
	IDPB B,C		;Place in the file spec
	AOJN D,NXTDIG		;Get the next integer
	MOVE B,C		;B is the destination for the SIN%
	HRROI A,[ASCIZ /.TMP.1/] ;The string to be copied
	SETZ C,			;String ends with a nul{
	SIN
	ERJMP .+1		;Should never happen
	MOVX A,GJ%NEW!GJ%TMP!GJ%SHT
	HRROI B,IDXFIL		;Pointer to the file spec
	GTJFN
	 ERJMP [CAIE A,GJFX27		;File already exist?
		JRST GJFNE		;No, some other error
		JRST OPNFI2 ]		;Try a different file name
      	MOVEM A,MSGIFJ			;SAVE JFN
	MOVX B,OF%RD!OF%WR
	OPENF			;OPEN IT
	 ERJMP OPNERR		;Failed to open
	RETSKP
JFNSER:	JWARN (Cannot obtain file specification for index file)
	SKIPA
GJFNE:	JWARN(Cannot get index file JFN)
	SKIPA
OPNERR:	JWARN(Cannot open index file)
	RET
>;End of TOPS20

	END

; *** Edit 2474 to MSFIL.MAC by PRATT on 18-Nov-85
; Changes for TOPS10 to make MS.MAC smaller
; *** Edit 2475 to MSFIL.MAC by PRATT on 18-Nov-85
; Make FILERR internal
; *** Edit 2480 to MSFIL.MAC by PRATT on 20-Nov-85
; Make sure UNMAPF is internal only for the -20


; *** Edit 2484 to MSFIL.MAC by SANTEE on 21-Nov-85
; Clean up the various edit histories.
; *** Edit 2485 to MSFIL.MAC by MAYO on 21-Nov-85
;
; *** Edit 2486 to MSFIL.MAC by PRATT on 22-Nov-85
; Copyright statements
; *** Edit 2493 to MSFIL.MAC by MAYO on 5-Dec-85
; Make sure the info in MSGSSQ (the SAME array) gets properly translated across
; EXPUNGEs. Prevents users from being able to undelete messages they've already
; expunged.
; *** Edit 2602 to MSFIL.MAC by PRATT on 6-Dec-85
; Catch other case of MAIL window not being mapped after an EXPUNGE
; *** Edit 2614 to MSFIL.MAC by SANTEE on 18-Dec-85
; Keep the number of messages deleted, new, and flagged up-to-date. This makes
; several paths faster and we end up doing alot less work. Also, with windowing
; it is important on the -10 to know if we have any work to do at expunge time.
; Some minor code rearrangements were made in related areas for speed up
; purposes. Finally some comments were added or lined up and paging was
; adjusted in some places.
; *** Edit 2616 to MSFIL.MAC by JROSSELL on 18-Dec-85
; When a message is read or typed; or when SKIM, SUMMARIZE, HEADERS, GET or
; NEXT is given - update the last time the mail file was read. On TOPS20 also
; update the FDB.
; *** Edit 2621 to MSFIL.MAC by SANTEE on 20-Dec-85
; Rearrange Expunge code to take advantage of the now up-to-date NDELET word.
; While we're there rearrange code a little for efficiecy.
; *** Edit 2622 to MSFIL.MAC by PRATT on 23-Dec-85
; Fix "MOVE or DELETE" length invalid error, SET DEF DIR, SET DEF PROT (-10)
; *** Edit 2623 to MSFIL.MAC by PRATT on 23-Dec-85
; Fix lost EXTERN from the last edit
; *** Edit 2624 to MSFIL.MAC by PRATT on 30-Dec-85
; Also add missing edit around PARSEX
; *** Edit 2625 to MSFIL.MAC by PRATT on 2-Jan-86
; Don't propmt for <crlf> if ? typed (in GETOU0)
; *** Edit 2630 to MSFIL.MAC by JROSSELL on 6-Jan-86
; LASTRD is not restored from the stack upon a SIZFIL error in routine GET1.
; This results in the stack becoming corrupt.
; *** Edit 2631 to MSFIL.MAC by PRATT on 7-Jan-86
; More massive changes to Expunge (courtesy of Mark and Ned)
; *** Edit 2634 to MSFIL.MAC by JROSSELL on 10-Jan-86
; Open up a second JFN as READ/WRITE in places where we don't want another
; process writing to the mail file.

; *** Edit 2636 to MSFIL.MAC by APPELLOF on 15-Jan-86
; Finish SET DEFAULT DIRECTORY for TOPS-10
; *** Edit 2639 to MSFIL.MAC by JROSSELL on 22-Jan-86
; When doing a SYSTEM command, do not open the system mail file as READ/WRITE
; *** Edit 2640 to MSFIL.MAC by APPELLOF on 24-Jan-86
; SET/CLEAR the "new mail" bit in mail file RIB on TOPS-10 Bit is lit if there
; are unseen messages. Bit is cleared if there are no unseen messages.
; *** Edit 2641 to MSFIL.MAC by APPELLOF on 27-Jan-86
; Re-apply preceeding edit properly
; *** Edit 2643 to MSFIL.MAC by SANTEE on 27-Jan-86
; Purge extra "Can't determine siz..." message and some general clean up.
; *** Edit 2647 to MSFIL.MAC by SANTEE on 28-Jan-86
; Fix a bug that would blow up a mail file if you recieved mail at just the
; wrong instant. Also, try harder to not leave junk on the end of the mail file
; during expunge.
; *** Edit 2655 to MSFIL.MAC by APPELLOF on 15-Feb-86
; Fix MS-10 to rename or re-write MAIL.TXT to the same path where it was found
; *** Edit 2670 to MSFIL.MAC by SANTEE on 3-Mar-86
; FILSIZ on the -10 didn't reflect the zero offset (one too high). Also, since
; we are no longer reading USERS.TXT we need to lookup MAIL.TXT on DSK:.
; *** Edit 2676 to MSFIL.MAC by JROSSELL on 6-Mar-86
; Prevent PMAP errors when there are more than 512 messages by giving the .TMP
; file a unique name.
; *** Edit 2678 to MSFIL.MAC by SANTEE on 7-Mar-86
; Edit 2670 changed FILSIZ but caused other problems. Remove this part of the
; edit.
; *** Edit 2680 to MSFIL.MAC by SANTEE on 16-Mar-86
; Turn F%F2 off after EXPUNGE. Wierdness happens if you do not. -10 only.
; *** Edit 2681 to MSFIL.MAC by SANTEE on 16-Mar-86
; Rewrite a large portion of PARSEF in an attempt to 1) make the paranoia code
; work (what we do if message byte sizes seem to disagree with what is in the
; file) and 2) to make the whole shebang faster in the process.
; *** Edit 2685 to MSFIL.MAC by SANTEE on 24-Mar-86
; Last edit to PARSEF broke parsing starting in the middle of the file. Set up
; the AC we are going to use rather than another random one. 
; *** Edit 2689 to MSFIL.MAC by APPELLOF on 26-Mar-86
; Prevent ERF (Error Reading File) on TOPS-10 if MX is appending when we check
; the size of the mail file. Also cut down on the number of LOOKUPs we do. 
; *** Edit 2693 to MSFIL.MAC by APPELLOF on 4-Apr-86
; Fix problem with deleting file after expunge of all messages. Restore LOOKUP
; block length that we blew while reading in a RIB