Trailing-Edge
-
PDP-10 Archives
-
msv11ck
-
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,SIZFIL,UNMAPF>
TOPS10< INTERNAL FILERR>
;External routines in MS.MAC
TOPS20< EXTERNAL CHECKM,CHNSIZ>
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,MYSTR>
EXTERNAL MSGPAG,MSGSSQ,MTOP,OUTFOB,RELFOB,WBOT,WTOP,WWIDH,GTFLAG
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
SKIPN GTFLAG ; Message been typed already ?
CIETYP ( There are no messages in %1J.) ; No, type warning then
SETOM GTFLAG ; Say message has been typed
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
HRL A,MSGJFN ; Get channel again for FILOP.
TLO A,(FO.UOC) ;Use Open Channel for delete
HRRI A,.FODLT ; Delete function
MOVEM A,FILOPB+.FOFNC ; Stuff into FILOP. block
SETZM FILOPB+.FOLEB ;Don't need filspec because of FO.UOC
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< SKIPN GTFLAG ; Message been typed already ?
CIETYP ( There are no messages in %1J.)
SETOM GTFLAG ; Say message has been typed
CALLRET CLOSEF] ;
>
TOPS10<
SKIPN GTFLAG ; Message been typed already ?
$TEXT (KBFTOR,<% There are no messages in ^F/MSGFD/>)
SETOM GTFLAG ; Say message has been typed
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
HRROI A,MYSTR ; We need to save the structure
MOVE B,MSGJFN ; Get JFN back for MAIL.TXT
MOVX C,<FLD(.JSAOF,JS%DEV)+JS%PAF> ; We just want STR:
JFNS% ; Put STR: in appropriate place
ERJMP .+1 ; Don't care about errors
MOVE A,MSGJFN ; Get back JFN for MAIL.TXT to continue
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 U,FILSIZ ; Save the old file size for comparison
MOVE B,[5,,.FBBYV]
MOVEI C,FILPGS
GTFDB ; Get the size stuff
ERJMP [JRETER (GTFDB failed on message file)
RET]
SETZM CHNSIZ ; Assume no change in file size
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.
>
CAME U,FILSIZ ; Compare latest file size with previous
SETOM CHNSIZ ; A change in size occurred
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)
SKIPN CHNSIZ ; Has size of the file changed?
JRST NOTFRT ; No, so do not do a total reparse
SETZ M, ; Reparse the entire file
MOVEI B,MSGIDX ; Address of the index area
ASH B,^D-9 ; Change to its page number
HRLI B,.FHSLF ; Unmap for this process
MOVEI C,MSGIDN ; Number of pages to unmap
HRLI C,(PM%CNT) ;
SETOM A ; Indicate want to unmap pages
PMAP
ERJMP [WARN (Can not unmap the index file)
RET]
NOTFRT: > ;End of TOPS20
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
MOVEI D,MS%ISA ; Number of attempts on Inv. simul. access
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 CHEKIT ; Check the error
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
CHEKIT: SOSL D ; Have we done this enough times?
JRST CHKIT1 ; Yes, return error this time
CAIN A,OPNX9 ; Invalid simultaneous access?
JRST SIMULT ; Yes, pause, and retry
CHKIT1: JRETER <Can't update message file - >
RET
SIMULT: MOVEI A,^D1000 ; Sleep for 1 second
DISMS% ; Zzzzzzzzz.....
MOVE A,MSGJF2 ; Recapture the JFN
JRST GETJ2A ; Try to open it again
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: GJINF ;[MDR] Connected dir. in AC2
HRROI A,IDXFIL ;Where to place the file spec
DIRST ;[MDR] Translate conn dir to string
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
; *** Edit 2694 to MSFIL.MAC by JROSSELL on 8-Apr-86
; If PARSEF detects that the mail file has changed size, have it assume that
; another reader exists and reparse the mail file. This is for TOPS20 only and
; must be used due to a lack of a complete global ENQ/DEQ mechanism.
; *** Edit 2695 to MSFIL.MAC by APPELLOF on 25-Apr-86
; Fix TOPS-10 code to delete mail file when last message is expunged.
; *** Edit 2701 to MSFIL.MAC by RASPUZZI on 20-May-86
; Make MS create MSxxxx.TMP file in connected directory instead of the
; directory where the MAIL.TXT file resides.
; *** Edit 2706 to MSFIL.MAC by RASPUZZI on 27-May-86
; Teach MS not to use POBOX: when writing files. Instead, find out what STR: is
; being used (saved in MYSTR) and go from there.
; *** Edit 2708 to MSFIL.MAC by PRATT on 30-May-86
; Fix problem with multiple "There are no messages in MAIL.TXT" messages.
; *** Edit 2715 to MSFIL.MAC by RASPUZZI on 6-Jun-86
; Make MS more flexible when encountering "Invalid simultaneous access" on
; MAIL.TXT by trying to open the file 1 time per second for 5 seconds just in
; case MX has the file opened for incoming mail.